From 3c9c68e54e85940b9d168ab952b6dc6d784d40a3 Mon Sep 17 00:00:00 2001 From: Gregory Bednov Date: Fri, 10 Jan 2025 20:50:49 +0300 Subject: [PATCH] Delete Ternary directory --- Ternary/Statement.hi | Bin 2488 -> 0 bytes Ternary/Statement.hs | 30 ------------------- Ternary/Term.hs | 34 ---------------------- Ternary/Universum.hi | Bin 1557 -> 0 bytes Ternary/Universum.hs | 22 -------------- Ternary/Vee.hs | 68 ------------------------------------------- 6 files changed, 154 deletions(-) delete mode 100644 Ternary/Statement.hi delete mode 100644 Ternary/Statement.hs delete mode 100644 Ternary/Term.hs delete mode 100644 Ternary/Universum.hi delete mode 100644 Ternary/Universum.hs delete mode 100644 Ternary/Vee.hs diff --git a/Ternary/Statement.hi b/Ternary/Statement.hi deleted file mode 100644 index e843aee6b0782421becfe931ae48021c77e4732f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 2488 zcmZSlbuNX)(!j)m;r8lPD=%$o{=0$k!t*KD?mc<<=>{VM1Lt-I2KKEC4D2=x42%p6 zcNeU_c&Pj7$t#SnHf{L$=Frn)j~S1A+Vt+^=4G3tE}eY)v1NYi_a4SAuP*I-{qxYo zdyHFlHND#U{=**2WfvYTy}YZj>j-1V$5s8y-#s{!*m-c-kHq!ao@FnEt7hG zpJhCG==j#PO%uA;GPWN$)6u}5V*t0z{J4F3}P}fFtac)vof%;b1^V;Ffem6 zFmo|5b2BjWFfj8nF!M1m^D{6DFfa=;Ffb`|GB7Z+w6A{hb<&r+CvP(TJ-+DD-}?=p zwlFdY?51p3FXYVKw8?2UmK}Tw6S|3v9aB^25g_ z&scT!&r`;=`(H0QduiHLU62Oxw~MY$+1IzMeGlV=sWXqR=;~UM#K6G7CUN2U%CEDo zzgv8Q@!aCK=T(1nl_m>>m&3Jt0{+@}4=0BETocnmiooU;af9_}8 zI^pKNSBrYCZ)ap-l>GDY%c5!9d#2B1TypKyl;^KbZTP~-D7Agd>VNBgbRCafa%JPP z{fEwPc4L-$f8@d5ZwFSt-o&`+_MBG@zvu1y!N@E<r+=-mcEZJ&V6?WMtrCU|`zFz$nAIp|Rl^2gqb*M%G774R1IY z85mic8ycQ)FfcGM${=xALB@haKndXI?s5px;9+23j>PHCiO6QcI4EY$J~8!PPt$?} zPZ%429$&in-`XQN47>~s%(bi+pdM#nSg>jJ`Oh;S&e_5^{rLU%pG#LhD`MbdU|?Q| zq~>nh;&YSc?LPO9@koE$g9Qy|n^GD085o$4BB{A?XL{es&pRjQ?ECbm{qD8>E0Y)m z7#NseASpTcZ~Cm8+jc&`!T7#&)1&DxE-dX}WDsOvVBtkl)Us&Vm5aX{-kJ6-+`RPK zi51)Z8H5-ZSPYPqyzh84fAQkJ#tV#lzCU`k|IdOI=NK7;85meXkrX{U{%7gOp5MK4 ztFAsL%YDv{LmEn0hg{<+T|T{oOx^y>DOYkRjbGKexTu*^kL({$?E z%ttf7z0cp?+H!dElBLU18N?VESPrmWf(PM|p1I%t{W<)ugK^oEzrEY$eqZ^Dk%^HJ zDJ?KCz>^vSBNGE72NNiLp(tQrV!aPdfs8UpOa>+f1||?-BV7v%=~}=EpEQSo3Pe=T z67&l@=?-HhT?;4aS{N8UtzCKN`p)&IwlThX`E$|34GX$&gR(vY+iRQ|5xKx%W5PH87;ZWFi6tEA8Ogc@MVYxgAfbSw z%v?R!iV|Vx{JfH){2V>Uf`XjPkgDfjlmd2% zdum>4QD$eZDKjszB)_Ow52QGtC^eZEEDz%8`J`5GgUoZz zNh~f-EoSj7NzG*e1s-!)YARzQCp=`Cic1(BnH<#_U71|f89kXi)fxSn{MC6?(p(GS ziuhI1K&B$|LGFU{Syf7s)g9Tuq&k@63g);%IG$jRCxqh<=J>1gsFWnb4d7HMDe}!v JDa}b`006|LMu7kT diff --git a/Ternary/Statement.hs b/Ternary/Statement.hs deleted file mode 100644 index a855150..0000000 --- a/Ternary/Statement.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Ternary.Statement (Statement(..), st) where -import Ternary.Term (Vee, Term(..), Item(..)) -data Statement a = A a a -- Affirmo (general affirmative) - | I a a -- affIrmo (private affirmative) - | E a a -- nEgo (general negative) - | O a a -- negO (private negative) - | A' a a - | I' a a - | E' a a - | O' a a - deriving (Eq, Show, Read) - -inv :: (Eq a) => Term a -> Term a -inv (Term p x) = Term (not p) x - -i :: (Eq a) => Bool -> Term a -> Term a -> Vee a -i v x y - | x == inv y = error "x and not x under the same Vee, refusing to calculate" - | x /= y = Term v . Item $ [x, y] - | x == y = Term v . Item $ [x] - -st :: (Eq a) => Statement a -> Vee a -st (A x y) = i False (Term True x) (Term False y) -st (I x y) = i True (Term True x) (Term True y) -st (E x y) = i False (Term True x) (Term True y) -st (O x y) = i True (Term True x) (Term False y) -st (A' x y) = i False (Term False x) (Term False y) -st (I' x y) = i True (Term False x) (Term True y) -st (E' x y) = i False (Term False x) (Term True y) -st (O' x y) = i True (Term False x) (Term False y) diff --git a/Ternary/Term.hs b/Ternary/Term.hs deleted file mode 100644 index ea694ad..0000000 --- a/Ternary/Term.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Ternary.Term (Term(..), Item(..), Vee) where -import Data.List (concatMap, null, (++), (\\)) -import Prelude (Applicative, Bool (False, True), Eq, Functor, - Read, Show, String, fmap, map, pure, show, - (&&), (/=), (<*>), (==), (||)) - -data Term a = Term Bool a deriving (Read) -newtype Item a = Item [a] deriving (Read) -type Vee a = Term (Item (Term a)) - -instance Functor Item where - fmap f (Item a) = Item (map f a) - -instance Applicative Item where - pure x = Item [x] - (Item fs) <*> (Item xs) = Item [f x | f <- fs, x <- xs] - -instance (Eq a) => Eq (Item a) where - (Item x) == (Item y) = null dxy && null dyx - where - dxy = x \\ y - dyx = y \\ x - -instance (Eq a) => Eq (Term a) where - Term v x == Term w y = (v==w) && (x==y) - Term v x /= Term w y = (v/=w) || (x/=y) - -instance Show (Term String) where - show (Term False y) = y ++ "`" - show (Term True y) = y - -instance Show (Term (Item (Term String))) where - show (Term x i) = show (Term x "V") ++ concatMap show (it i) - where it (Item ii) = ii diff --git a/Ternary/Universum.hi b/Ternary/Universum.hi deleted file mode 100644 index 32ae6200b1c2527267e181c22a449453acff1f13..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1557 zcmZSlbuNX)(!j)mVcpr|KaZUK)h^I9dEbwQ%?CGJWMp7q6JcOriC|!0k!E0EWMG)F z>*J)xo+~%wuFRXd{{O>YyMHrYx_@x~^(C(-?PmNod-9joLl+LHY&t)|4$X9o~3>D zldqG$+&y`d@$d0Pm;T;w__PJALGqjS$JMg}$p z1}0P13ylrWIKatZ)BPv^mVS7BZyMw6+1n57>|gf(0wV)E0|QeOlA_5_$ zz~vbjnIS;|@+$)?m;@6nU=m6!Tz&k^$~(XAzGU1uZ&laf3zxtC2E`)-b0q_#6x=jM zW=7UWO$~227#SE@n;ROQa4;}1FiL@vCqjHn130W0Sh=B+42-NWF_2mYhTbpJ`<@-& z{P8Q}uI)1q&g{GT;u#|-i!uKt*)k>u;w?vV5X9FkEDXnget+3=f7$%Zb$dSEYdz4s zNe(Q<1Bz>KzLx=6Aj`nO$S4OQ={OUoPa5SdyscR+^Vwl3%3f zoS#=*B8np9nUb1Ul37y84Hosy&&$tD5eKt_Q*$%Zi}Fhg^gQ!QK#tDg1&fDN7NqL= z7o~t*;+~q9T9lbwEC6zrr@x+SMRICENoIZ?FGwILBv{WaCo#PkqSGxuCnYf{CzTUy zj!$NB2@ja%pOXUOum=>S=9H$Sa)Y!w=Oh*vrxvq#mZavgfI@~jEH#xekw4L`C_gv2 zB(WqlH#M)Mn6nfXjGXWQ<#a5{EH23}$w_5*Nli;E%_(7Z%`GUY Universum -> [Vee a] -> [Vee a] -universum Aristotle facts = - [Term True (Item [Term x v]) - | v <- aFromStatements facts, - x <- [False, True]] -universum Empty _ = [] -universum Default xs = xs - -aFromStatements :: (Eq a) => [Vee a] -> [a] -aFromStatements = nub . concatMap (extract . getItem . getVee) - where - getItem (Item x) = x - getVee (Term _ i) = i - extract terms = [v | (Term _ v) <- terms] diff --git a/Ternary/Vee.hs b/Ternary/Vee.hs deleted file mode 100644 index 19f8753..0000000 --- a/Ternary/Vee.hs +++ /dev/null @@ -1,68 +0,0 @@ -module Ternary.Vee (isObvious, newFact, cleared, think) where -import Data.List (head, intersect, length, nub, null, union, (\\)) -import Data.Maybe (Maybe (Nothing), mapMaybe) -import Prelude (Bool (False, True), Eq, any, foldr, fst, map, - not, notElem, otherwise, return, snd, ($), (&&), - (.), (/=), (<$>), (<*>), (=<<), (==)) -import Ternary.Term (Item (..), Term (..), Vee) -isSubsetOf :: (Eq a) => [a] -> [a] -> Bool -a `isSubsetOf` b = nda && not ndb - where - nda = null $ a \\ b - ndb = null $ b \\ a - -isObvious :: (Eq a) => Vee a -> Vee a -> Bool -isObvious (Term x (Item a)) (Term y (Item b)) - | x /= y = False - | x = a `isSubsetOf` b - | not x = b `isSubsetOf` a - -newFact :: (Eq a) => Vee a -> Vee a -> ([Vee a], Maybe (Vee a)) -newFact a@(Term True _) b@(Term False _) = newFact b a -newFact (Term False (Item iF)) tT@(Term True (Item iT)) - | length ldF /= 1 = ([], Nothing) - | otherwise = - if d'F `notElem` iT - then (return tT, return (Term True (Item (d'F:iT)))) - else ([], Nothing) - where - ldF = iF \\ iT - d'F = notT . head $ ldF - notT (Term x v) = Term (not x) v -newFact (Term False (Item i0)) (Term False (Item i1)) - | length e /= 1 = ([], Nothing) - | otherwise = - if null d0 && null d1 - then (map (Term False . Item) [i0, i1], vee0) - else ([], vee0) - where - notT (Term x v) = Term (not x) v - terms = (i0 `intersect` i1) `union` d0 `union` d1 - e = map notT i0 `intersect` i1 - d0 = (i0 \\ i1) \\ map notT e - d1 = (i1 \\ i0) \\ e - vee0 = return (Term False (Item terms)) -newFact _ _ = ([], Nothing) - -pseudofix :: (Eq a) => (a -> a) -> a -> a -pseudofix f x0 - | y == y' = y - | otherwise = y' - where - y = f x0 - y' = f y - -next :: (Eq a) => ([Vee a], [Vee a]) -> ([Vee a], [Vee a]) -next (o,n) = (o `union` n \\ (fst =<< r), mapMaybe snd r) - where - r = newFact <$> o <*> n - -applyFacts :: (Eq a) => [Vee a] -> [Vee a] -> [Vee a] -applyFacts old new = fst $ pseudofix next (old, new) - -cleared :: (Eq a) => [Vee a] -> [Vee a] -cleared vees = nub [vee | vee <- vees, not $ any (isObvious vee) vees] - -think :: (Eq a) => ([Vee a]->[Vee a]) -> [Vee a] -> [Vee a] -think addition = foldr (applyFacts . withUni . return) [] where - withUni vees = applyFacts (addition vees) vees