Declaratieve Talen/Oplossing boom betegelen

Een oplossing

import List

data Boom t = Knoop1 t (Boom t) | Knoop2 t (Boom t) (Boom t) | Blad t deriving Show
data Tegel t = Tknoop1 t (Tegel t) | Tknoop2 t (Tegel t) (Tegel t) | Tblad t | Leeg deriving Show

tegel::(Eq t)=>Boom t->[Tegel t]->Bool
--------------------------------------
tegel boom tegels = 
 	let
		goeieTegels = filter (\x -> controleerTegel boom x) tegels
		restBomen = [geefRest boom y |y<-goeieTegels]
	in
		if ((length goeieTegels)>0)
		then tegel2 restBomen tegels
		else False

tegel2::(Eq t)=>[ [Boom t] ]->[Tegel t]->Bool
---------------------------------------------
tegel2 [] _ = False
tegel2 (boomlijst:rest) tegels
	| length (filter (==False) [tegel x tegels|x<-boomlijst]) == 0 = True
	| otherwise = tegel2 rest tegels

controleerTegel::(Eq t)=>Boom t->Tegel t->Bool
----------------------------------------------
controleerTegel (Blad x) (Tblad y) = x==y
controleerTegel (Blad x) (Leeg) = True
controleerTegel (Blad x) _ = False
controleerTegel (Knoop1 x b) (Tknoop1 y tb) = 
	if (x==y)
	then controleerTegel b tb
	else False
controleerTegel (Knoop1 _ _) (Leeg) = True
controleerTegel (Knoop1 x _) (Tblad y) = x==y
controleerTegel (Knoop1 _ _) _ = False
controleerTegel (Knoop2 x lb rb) (Tknoop2 y ltb rtb) = 
	if (x==y)
	then (controleerTegel lb ltb) && (controleerTegel rb rtb)
	else False
controleerTegel (Knoop2 _ _ _) (Leeg) = True
controleerTegel (Knoop2 x _ _) (Tblad y) = x==y
controleerTegel (Knoop2 _ _ _) _ = False

geefRest::(Eq t)=>Boom t->Tegel t->[Boom t]
-------------------------------------------
geefRest _ (Tblad y) = []
geefRest w (Leeg) = [w] 
geefRest (Knoop1 x b) (Tknoop1 y tb) = geefRest b tb
geefRest (Knoop2 x lb rb) (Tknoop2 y ltb rtb) =(geefRest lb ltb)++(geefRest rb rtb)

Een andere oplossing

data Boom t = Knoop1 t (Boom t) | Knoop2 t (Boom t) (Boom t) | Blad t
data Tegel t = Tknoop1 t (Tegel t) | Tknoop2 t (Tegel t) (Tegel t) | Tblad t | Leeg

tegel:: (Eq t) =>(Boom t) -> [(Tegel t)] -> Bool
-------------------------------
tegel (Blad t) tegels = 
	let mogelijke_tegels =[(Tblad t) | (Tblad a) <- tegels, a == t]
	in not $ null mogelijke_tegels
	
tegel (Knoop1 t subboom) tegels =
	let mogelijke_tegels_tknoop1 =[(Tknoop1 t sub) | (Tknoop1 v1 sub) <- tegels, v1 == t, topTvalue sub == topvalue subboom]
	    mogelijke_tegels_tblad = [(Tblad t) | (Tblad a) <- tegels, a == t]
	in ((not $ null mogelijke_tegels_tknoop1) && subtegel subboom tegels) ||
	   ((not $ null mogelijke_tegels_tblad) && tegel subboom tegels)
	   
tegel (Knoop2 t sub_links sub_rechts) tegels =
	let mogelijke_tegels_tknoop2 =[(Tknoop2 t sub_l sub_r) | (Tknoop2 v1 sub_l sub_r) <- tegels, v1 == t, topTvalue sub_l == topvalue sub_links, topTvalue sub_r == topvalue sub_rechts]
	    mogelijke_tegels_tknoop1_l =[(Tknoop1 t sub) | (Tknoop1 v1 sub) <- tegels, v1 == t, topTvalue sub == topvalue sub_links]
	    mogelijke_tegels_tknoop1_r =[(Tknoop1 t sub) | (Tknoop1 v1 sub) <- tegels, v1 == t, topTvalue sub == topvalue sub_rechts]
	    mogelijke_tegels_tblad = [(Tblad t) | (Tblad a) <- tegels, a == t]
	in ((not $ null mogelijke_tegels_tknoop1_l) && subtegel sub_links tegels && tegel sub_rechts tegels) ||
	   ((not $ null mogelijke_tegels_tblad) && tegel sub_links tegels && tegel sub_rechts tegels) ||
	   ((not $ null mogelijke_tegels_tknoop1_r) && subtegel sub_rechts tegels && tegel sub_links tegels) ||
	   ((not $ null mogelijke_tegels_tknoop2) && subtegel sub_rechts tegels && subtegel sub_links tegels) 


subtegel::(Eq t) =>(Boom t) -> [(Tegel t)] -> Bool
--------------------------------------------------
subtegel (Knoop1 t subboom) tegels = tegel subboom tegels
subtegel (Knoop2 t sub1 sub2) tegels = tegel sub1 tegels && tegel sub2 tegels
subtegel (Blad t) tegels = True


topvalue::(Boom t) -> t
-----------------------
topvalue (Blad t) = t
topvalue (Knoop1 v subboom) = v
topvalue (Knoop2 v s1 s2) = v

topTvalue::(Tegel t) -> t
-----------------------
topTvalue (Tblad t) = t
topTvalue (Tknoop1 v subboom) = v
topTvalue (Tknoop2 v s1 s2) = v

--Beau 16 jun 2006 21:18 (CEST)

Nog een andere oplossing

data Boom t = Knoop1 t (Boom t) | Knoop2 t (Boom t) (Boom t) | Blad t deriving (Eq,Show)
data Tegel t = Tknoop1 t (Tegel t) | Tknoop2 t (Tegel t) (Tegel t) | Tblad t | Leeg deriving (Eq,Show)

tegel::(Eq t)=>(Boom t)->[(Tegel t)]->Bool
tegel boom tegels |((lengte/=0)&&(boomgeraaktBedekt nietBedekteBomen tegels)) = True
		  | otherwise = False
		  where
			[(topTegel, nietBedekteBomen)] = zoekTegelvoorTop boom tegels
			lengte = length [(topTegel, nietBedekteBomen)] 
			
			


zoekTegelvoorTop::(Eq t)=>(Boom t)->[(Tegel t)]->[((Tegel t),[Boom t])]
-----------------------------------------------------
 
zoekTegelvoorTop boom [] = []

zoekTegelvoorTop boom (tegel:xs) |fst(betegeling) = [(tegel,snd(betegeling))] 
                                 |otherwise = zoekTegelvoorTop boom xs
				 where betegeling = (betegel boom tegel)


betegel::(Eq t)=>(Boom t)->(Tegel t)->(Bool,[Boom t])
-------------------------------------------

--Knoop1
betegel (Knoop1 waarde boom) tegel@(Tknoop1 waardet tegel1) | waarde == waardet = (betegel boom tegel1)
							    | otherwise = (False,[])

betegel (Knoop1 waarde boom) tegel@(Tblad waardet)  |waarde == waardet = (True,[boom])
						    |otherwise = (False,[])

betegel (Knoop1 waarde boom) Leeg = (True,[boom])

betegel boom@(Knoop1 _ _) x = (False,[])

--Knoop2

betegel (Knoop2 waarde l r) tegel@(Tknoop2 waardet tl tr)|waarde==waardet  = ((fst(links)&&fst(rechts)),(snd(links)++snd(rechts)))
						         |otherwise = (False,[])
							  where links = (betegel l tl)
							        rechts = (betegel r tr)


betegel (Knoop2 waarde l r) tegel@(Tblad waardet)|waarde==waardet = (True,[l,r])
						 |otherwise = (False,[])

betegel (Knoop2 waarde l r) Leeg = (True,[l,r])

betegel boom@(Knoop2 _ _ _) x = (False,[])

--Blad

betegel (Blad t) (Tblad s) | s==t = (True,[])
		           | otherwise = (False,[])
betegel (Blad t) (Leeg) = (True,[])

betegel boom@(Blad _) x = (False,[])


boomgeraaktBedekt::(Eq t)=>[(Boom t)]->[(Tegel t)]->Bool
boomgeraaktBedekt [] tegels = True
boomgeraaktBedekt (b:bs) tegels |((length betegeling) /= 0) = boomgeraaktBedekt bs tegels
				|otherwise = False
				where betegeling = zoekTegelvoorTop b tegels

--Greet