Declaratieve Talen/Oplossing formule boom

Oplossing

   form1 = (Of (En (Niet 'a') (Niet 'b')) (En (Wel 'a') (Niet 'c')))
   tree1 = (Node 'a' (Node 'b' (Blad True) (Blad False))
                     (Node 'c' (Blad True) (Blad False)))
   
   tree2 = (Node 'a' (Node 'b' (Blad True) (Blad False))
                     (Node 'c' (Blad False) (Blad False)))
   
   data Boom t = Node t (Boom t) (Boom t)
                   | Blad Bool deriving Show
   
   data Formule t = En (Formule t) (Formule t)
                   | Of (Formule t) (Formule t)
                   | Niet t
                   | Wel t
                   deriving Show
   
   boom_is_formule :: (Eq t) => (Boom t) -> (Formule t) -> Bool
   boom_is_formule boom formule = verdiep boom formule []
    
   verdiep :: (Eq t) => (Boom t) -> (Formule t) -> [(t, Bool)] -> Bool
   verdiep (Node var l r) formule waarden =
           (verdiep l formule (waarden ++ [(var, False)]))
                   && (verdiep r formule (waarden ++ [(var, True)]))
   verdiep (Blad False) formule waarden =
           berekenFormule formule waarden == False
   verdiep (Blad True) formule waarden =
           berekenFormule formule waarden == True


   berekenFormule :: (Eq t) => (Formule t) -> [(t, Bool)] -> Bool
   berekenFormule (En a b) waarden =
           (berekenFormule a waarden) && (berekenFormule b waarden)
   berekenFormule (Of a b) waarden =
           (berekenFormule a waarden) || (berekenFormule b waarden)
   berekenFormule (Niet a) waarden =
           let waarde = [y | (x,y) <- waarden, x==a]
           in
                   if (length(waarde) == 1) then
                           [y | (x,y) <- waarden, x==a] == [False]
                   else
                           False
   
   berekenFormule (Wel a) waarden =
           let waarde = [y | (x,y) <- waarden, x==a]
           in
                   if (length(waarde) == 1) then
                           [y | (x,y) <- waarden, x==a] == [True]
                   else
                           False

Is die controle lengte(waarde)==1 nodig? Bij een correcte boom kan x maar één maal voorkomen. De code wordt dan gewoon:

berekenFormule (Niet a) waarden =
          [y | (x,y) <- waarden, x==a] == [False]
                  
berekenFormule (Wel a) waarden =
         [y | (x,y) <- waarden, x==a] == [True]

--Beau 16 jun 2006 16:43 (CEST)

Alternatieve oplossing

Deze oplossing is vollediger, in de zin dat ze ook toelaat (Niet formule t) te gebruiken. Bovendien geeft ze ook een handige implementatie van show voor formules.

data Formule t = En (Formule t) (Formule t)|Of (Formule t) (Formule t) |Wel t|Niet (Formule t)
	deriving Eq --We zullen Eq enkel gebruiken op formules van de vormen Wel t en (Niet Wel t).  In dit geval is de afgeleide Eq wel degelijk de     logische equivalentie van formules.  In andere gevallen zouden we 
instance Show t => Show (Formule t) where
	show (En a b)= "("++show a++")" ++ " ^ " ++ "(" ++ show b ++")"
	show (Of a b)= "("++show a++")" ++ " v " ++ "(" ++ show b ++")"
	show (Wel a) = show a
	show (Niet a) = " ~"++ "("++show a++")"

data Fboom t = Knoop t (Fboom t) (Fboom t)| Blad Bool

formule_is_waar :: (Eq t)=>Fboom t->Formule t->Bool
formule_is_waar x a = formule_is_waar_2 x (herschrijf a)
	where
	formule_is_waar_2 boom (Of a b)= (formule_is_waar_2 boom a)||(formule_is_waar_2 boom b)
	formule_is_waar_2 boom x = formule_is_waar_lijst boom (zetOmNaarLijst x) False

--De laatste boolean die we meegeven houdt bij of we al dan niet al een bewuste keuze gemaakt hebben.  Dit is nodig voor het nagaan of een formule   als  "Niet b" al dan niet waar is.  Tot voor we b tegenkomen mag "Niet b"
formule_is_waar_lijst :: (Eq t)=> Fboom t-> [Formule t]->Bool->Bool
formule_is_waar_lijst (Blad x) _ False = True
formule_is_waar_lijst (Blad x) _ _ = x
formule_is_waar_lijst (Knoop x l r) lijst bool
	| elem (Wel x) lijst = formule_is_waar_lijst l lijst True
	| elem (Niet (Wel x)) lijst = formule_is_waar_lijst r lijst True 
	| bool =  (formule_is_waar_lijst l lijst True)&&(formule_is_waar_lijst r lijst True)
	| otherwise = (formule_is_waar_lijst l lijst False)&&(formule_is_waar_lijst r lijst False)

--We verwachten hier een lijst zonder "Of" in.  Hier wordt voor gezorgd door formule_is_waar (die alle offen naar buiten brengt en de formule  vervolgens in stukken kapt)
zetOmNaarLijst:: Formule t -> [Formule t]
zetOmNaarLijst (En a b)= (zetOmNaarLijst a)++(zetOmNaarLijst b)
zetOmNaarLijst x = [x]


herschrijf::Formule t -> Formule t
herschrijf (Niet (Niet x)) = herschrijf x
herschrijf (Niet (En a b)) = Of (herschrijf (Niet a)) (herschrijf (Niet b))
herschrijf (Niet (Of a b)) = herschrijf $ En (herschrijf (Niet a)) (herschrijf (Niet b))
herschrijf (En (Of a b) c) = herschrijf $ Of (En (herschrijf a) (herschrijf c)) (En (herschrijf b) (herschrijf c))
herschrijf (En  c (Of a b))= herschrijf $ Of (En (herschrijf a) (herschrijf c)) (En (herschrijf b) (herschrijf c))
herschrijf (Of a b) = Of (herschrijf a) (herschrijf b) 
herschrijf x = x


--Let op met het gebruik van deze boom.  Logisch gezien is deze boom een ramp (door het feit dat "e" tweemaal een blad True als kinderen heeft).  In deze boom is het mogelijk dat een formule waar is en zijn tegengestelde ook (beschouw bijvoorbeeld de formule waar_in_boom1.  Dit kan je verklaren door te zeggen dat (a en b en d) waar is, maar NIET (a en b en d) ook (want NIET b is reeds waar).  Indien je een van de bladeren van "e" vervangt door False krijg je een veel logischere testboom
testboom::Fboom String
testboom = Knoop "a" (Knoop "b" (Knoop "d" (Blad False) (Blad True)) (Knoop "e" (Blad True) (Blad True))) (Knoop "c" (Blad True) (Blad False))
waar_in_boom1::Formule String
waar_in_boom1= En (En (Wel "a") (Wel "b")) (Niet (Wel "d"))
waar_in_boom2::Formule String
waar_in_boom2= Of (En (En (Wel "a") (Wel "b")) (Wel "d")) (En (En (Wel "a") (Wel "b")) (Niet (Wel "d"))) 
niet_waar_in_boom::Formule String
niet_waar_in_boom= En (En (En (Wel "a") (Wel "b")) (Wel "d")) (En (En (Wel "a") (Wel "b")) (Niet (Wel "d")))

Nog een oplossing

import List

data Boom t = Node t (Boom t) (Boom t) | Blad Bool deriving Show
data Formule t = 
	  (Formule t) `En` (Formule t)
	| (Formule t) `Of` (Formule t)
	| Niet t
	| Wel t
	deriving (Show, Eq)
-------------------------------------------------------------------------------- 
boom_is_formule::Eq t => Boom t -> Formule t -> Bool
boom_is_formule boom formule =
	formulewaardes == boomwaardes
	where
		(kbs, boomwaardes) = unzip $ doorloop boom
		formulewaardes = map (waarde formule) kbs

--Genereert een lijst van knowledgebases en hun waarheidswaarde via de 
--paden van de boom
doorloop::Boom t -> [([Formule t], Bool)]
doorloop boom = doorloop2 [] boom
doorloop2 kb (Node term bwaar bvals) = 
	doorloop2 (Wel term : kb) bwaar
	++ doorloop2 (Niet term : kb) bvals
doorloop2 kb (Blad waarde) = [(kb, waarde)]

-- de lijst formules zijn van vorm 'Wel t'/'Niet t' en vormen de knowledgebase
waarde::Eq t => Formule t -> [Formule t] -> Bool
waarde (f1 `Of` f2) kb = waarde f1 kb || waarde f2 kb
waarde (f1 `En` f2) kb = waarde f1 kb && waarde f2 kb
waarde term kb = elem term kb
		--aanname: geen contradicties zoals 'Wel a' en 'Niet a' 
		--tegelijk in de knowledgebase