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 zcmb7FX;4#F6uvhvVG$5_t+v`$EZt14wbMG&KS-lxrVfr!XF8q!2=LU*goM64sKzn4PJ}n`PiM}iI!Nb^F zIUUPSU~a{Pys7PG$6>r-_oTcdt~^Q+qJc3t5^A%;!qPnuZ?Q)=mOY=?Ih9rio6{zn zmHv@2B!Da+OYDg?_NUjBL2XGz#I@>_;XN>EIIHJoQRZwkER5+YH^?J8iy<4nvuvD` z-z<)ZPk`zAhPW|9L;f6udyCadQ{Kxk?XT(W_Y@V?Ed?iuz0)-V_g_>hCsa_?ea9eO zN-lp1iG8=~N*;EO3}?5&x|yV)@w>$VCR}&)>Y+7y{VY^_Hb9jJmcR;FN42&@w_b^< zJ6Jlp@NafUtfmQ{8?eq{_yySK1?ASNb>l`O3{5V*>aR(gzX!o4v~~}`cRBg~(oriM znSh+30O>O;2p}g=Djh*2S~qhzI4ovx11y#$YgTlztw(d!GIdTzRY)=fHmItcx5kV# zkGblsiy2%QHP@-HOEJM)4Pnh)5v}olz!t^)`K>Xpna5mp*2TPCccU*NKvp>d{THWPo4pDl?Mmd`AQ^y(|JJ-`+ud1@x9GQ}r$6_t!Vg40)3L-9{_ z8KDrM8^X3T69vf??X64Fsjs6_3o`U|S;ekk8aqK$7%-1;p1Sl|X+7xRC&us6PiY5a}-3Lc0XOw4lQ zTR0ovg68f<69Zr-H@l~^k9G2lHj&-ONO>n0V_&G#?lQcr!>=M+Rp%P6W>m zKrmX=8vqX>G)vxNh5y{Y5~)#qb4&BN)EK za1_H=s3D1c$JpL{foQ8cNs0KBAJ>iM)1)^kqHR|h^zF^|;7drWQ$IL!Pawk@8z+Tg zK5cd3qUT{BO5kmasWZsn@-EZcoy8)W5(~LbK0ZQ$C!ZGlPTH+;6eYg2?R!4W=brQx zdD3EviDTZlt&10wwnK;kt-uoV3u6;obdwNUkg8 z#bk1d6p@s`Q?do8<>HEx@+5s|fmmdRiL>r*D1H6~i6!=U6vdqEEXns`47ZEoOO|IS zQt0bN9&jfw)7&$BNtRsaIqLkJnfiu>~Vi2FWcaF&O*LKLQ2>!sE%x0 zJmMTlLcaA{Wmys$IN9f9Ob+mIh&--mnWbbeuM>Y3xUTZ$bf%bHC nvS84Wad?cwd*!$=j>{{@m2q4hZIOB{fVBfnofdof3Q6!E#HB`o 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 zcmb7DTToj?7~aiEASod9W~rBYL;Ga(L1*k^OH0MEL#LqQIHNPC&P?0KoqY{ayqB4GS!utT^4!=$AvK zxi_|_ylorM<+hcLR4!(N>Slz*r^tzcR^Zm&M! znohsEloDT+j&=fw!z({f;w(X1co-QIc= z=kt?{vujza6Mds_({6BWx-}~%Zo<(!oo#iq#WtrAcHbRJcMMk)reeY8dFQ>_wW5&+ z6}@n@1rJh9xsUjpw!0{H2G@8KdnB2Hl7m z67bj)&#EEMtjjNimBalx_ZIr=S0M~Gn~Ym^k5lbmR1P&%-|GCeDU3K?(A(NGGCNc2 zg1svx3G+A1+AWBhg+B;+eAGVz@PQzw%u!=W%q_G*z1P^WV(l4H;S}Bh41qxCp3>_L zH_N8FVUG33v8{p>YY_xKNPA!4jMK~sxognqp53ZiUYyK>zZaW3TJ_c2P6$x1d7tk~ z+L-H}HqVuJORW}zW-h5hcM_o4yzlp=Os!-jyW?%m4rtQ#xmu0dn;!uY$|>KM(_pFk zqsv;7KMaSi-tTpGl(yGHfZXzW1g>2}D^FS+?LU-eyz{VcqT$h4<5)0{2L$!II=VYg zTY>iq1RQd}-wOdKH`*Pwc^%v*uwGDiZfQSX~h23iCSOn8r&7VRDpdenO znMJ!oI=-HJyh+3L3JCn3i70o6!?^&YujXHwvp0Fxpv7EhE4*^&{v0ZZ7Tf&ai}BF< z|8?j(%IoNag;Rx`+btx$oG+p|pZ!Xqou5QYn*0lPoG3u*)$F{q3Q%Buk3J z)QV`9X2eKRu}A+!g-a*}D`jK-IQ9aqprw*yTpUTsr7;YxR*J(FEH*6*;P|LmB_)nv zB%G7;l!9WU(W)S9D?9?3il&sTlvV^_;!;#3vQNgSp3V%TWfJnTj1qBmK9;Ije=drU zN$|k;B16g463P!x4V9596{X^bvy_~VJ41X*QIHHI!x&l~$&!dh##JKqP8&tL4Hcbc yP&JyBQNCxXuSm6w6`YeR+1P*(Hu~hQ=7&embP 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