@@ -7,6 +7,7 @@
77module Main where
88
99import LAoP.Matrix.Type
10+import qualified LAoP.Relation as R
1011import LAoP.Utils
1112import LAoP.Dist
1213import GHC.TypeLits
@@ -71,6 +72,72 @@ grass_wet = row [0,1] . kp1
7172rainning :: Matrix Double (Bool, (Bool, Bool)) One
7273rainning = row [0,1] . kp2 . kp2
7374
75+-- Alcuin Puzzle
76+
77+data Being = Farmer | Fox | Goose | Beans
78+ deriving (Bounded, Enum, Eq, Show, Generic)
79+
80+data Bank = LeftB | RightB
81+ deriving (Bounded, Enum, Eq, Show, Generic)
82+
83+eats :: Being -> Being -> Bool
84+eats Fox Goose = True
85+eats Goose Beans = True
86+eats _ _ = False
87+
88+eatsR :: R.Relation Being Being
89+eatsR = R.toRel eats
90+
91+cross :: Bank -> Bank
92+cross LeftB = RightB
93+cross RightB = LeftB
94+
95+crossR :: R.Relation Bank Bank
96+crossR = R.fromF' cross
97+
98+-- | Initial state, everyone in the left bank
99+locationLeft :: Being -> Bank
100+locationLeft _ = LeftB
101+
102+locationLeftR :: R.Relation Being Bank
103+locationLeftR = R.fromF' locationLeft
104+
105+-- | Initial state, everyone in the right bank
106+locationRight :: Being -> Bank
107+locationRight _ = RightB
108+
109+locationRightR :: R.Relation Being Bank
110+locationRightR = R.fromF' locationRight
111+
112+-- Properties
113+
114+-- Being at the same bank
115+sameBank :: R.Relation Being Bank -> R.Relation Being Being
116+sameBank = R.ker
117+
118+-- Risk of somebody eating somebody else
119+canEat :: R.Relation Being Bank -> R.Relation Being Being
120+canEat w = sameBank w `R.intersection` eatsR
121+
122+-- "Starvation" property.
123+inv :: R.Relation Being Bank -> Bool
124+inv w = (w `R.comp` canEat w) `R.sse` (w `R.comp` farmer)
125+ where
126+ farmer :: R.Relation Being Being
127+ farmer = R.fromF' (const Farmer)
128+
129+-- Arbitrary state
130+bankState :: Being -> Bank -> Bool
131+bankState Farmer LeftB = True
132+bankState Fox LeftB = True
133+bankState Goose RightB = True
134+bankState Beans RightB = True
135+bankState _ _ = False
136+
137+bankStateR :: R.Relation Being Bank
138+bankStateR = R.toRel bankState
139+
140+-- Main
74141main :: IO ()
75142main = do
76143 putStrLn "Monty Hall Problem solution:"
@@ -85,3 +152,5 @@ main = do
85152 prettyPrint (grass_wet . state)
86153 putStrLn "\n Probability of rain:"
87154 prettyPrint (rainning . state)
155+ putStrLn "\n Is the arbitrary state a valid state? (Alcuin Puzzle)"
156+ print (inv bankStateR)