Declaratieve Talen/Oplossing Graaf-isomorfie

Een oplossing:

import List

iso::(Eq t,Eq u)=>([t],[(t,t)])->([u],[(u,u)])->[(t,u)]
-------------------------------------------------------
iso graaf1 graaf2 = 
	let
		(knopen1,bogen1) = graaf1
		(knopen2,bogen2) = graaf2
		cond1 = length knopen1 /= length knopen2
		cond2 = length bogen1 /= length bogen2
	in
		if cond1
		then error "Knooplijsten zijn van verschillende lengte!!!"
		else if cond2
		     then error "Booglijsten zijn van verschillende lengte!!!"
		     else vergelijk bogen1 bogen2 (combs knopen1 knopen2)

iso2::(Eq t,Eq u)=>([t],[(t,t)])->([u],[(u,u)])->Bool
-----------------------------------------------------
iso2 graaf1 graaf2 =
	let
		(knopen1,bogen1) = graaf1
		(knopen2,bogen2) = graaf2
		cond1 = length knopen1 /= length knopen2
		cond2 = length bogen1 /= length bogen2
	in
		if cond1 || cond2
		then False
		else vergelijk2 bogen1 bogen2 (combs knopen1 knopen2)

vergelijk::(Eq t,Eq u)=>[(t,t)]->[(u,u)]->[ [(t,u)] ]->[(t,u)]
--------------------------------------------------------------
vergelijk _ _ [] = error "Geen gelijkenis gevonden"
vergelijk _ _ [[]] = error "Geen gelijkenis gevonden"
vergelijk b1 b2 (comb:rest) | controleer b1 b2 comb = comb
			    | otherwise = vergelijk b1 b2 rest

vergelijk2::(Eq t,Eq u)=>[(t,t)]->[(u,u)]->[ [(t,u)] ]->Bool
------------------------------------------------------------
vergelijk2 _ _ [] = False
vergelijk2 _ _ [[]] = False
vergelijk2 b1 b2 (comb:rest) | controleer b1 b2 comb = True
			     | otherwise = vergelijk2 b1 b2 rest

controleer::(Eq t,Eq u)=>[(t,t)]->[(u,u)]->[(t,u)]->Bool
--------------------------------------------------------
controleer [] [] _ = True
controleer (x:xs) lijst koppels =
		let
			(tvan,tnaar) = x
			uvan = head [b|(a,b)<-koppels,a==tvan]
			unaar = head [b|(a,b)<-koppels,a==tnaar]
		in
			if (zitInLijst (uvan,unaar) lijst)
			then controleer xs (verwijderUitLijst (uvan,unaar) lijst) koppels
			else False
		where 
			zitInLijst::(Eq u)=>(u,u)->[(u,u)]->Bool
			----------------------------------------
			zitInLijst _ [] = False
			zitInLijst (u,v) ((x,y):rest) | (u==x) && (v==y) = True
						      | otherwise = zitInLijst (u,v) rest
			
			verwijderUitLijst::(Eq u)=>(u,u)->[(u,u)]->[(u,u)]
			--------------------------------------------------
			verwijderUitLijst _ [] = []
			verwijderUitLijst (u,v) ((x,y):rest) | (u==x) && (v==y) = rest
							     | otherwise = (x,y):(verwijderUitLijst (u,v) rest)

subiso::(Ord t,Ord u)=>([t],[(t,t)])->([u],[(u,u)])->Bool
-------------------------------------------------------
subiso graaf1 graaf2 =
	let
		(knopen1,bogen1) = graaf1
		(knopen2,bogen2) = graaf2
	in	
		check graaf1 (maakDeelGraaf graaf2)
	where
		check::(Ord u,Ord t)=>([t],[(t,t)])->[([u],[(u,u)])]->Bool
		----------------------------------------------------------
		check _ [] = False
		check g1 (sub:rest) | iso2 g1 sub = True
				    | otherwise   = check g1 rest

maakDeelGraaf::(Ord u)=>([u],[(u,u)])->[([u],[(u,u)])]
-----------------------------------------------------
maakDeelGraaf graaf =
	let
		(knopen,bogen) = graaf
		deelKnopen = maakDeelKnopen knopen
	in
		combineerMetBogen deelKnopen bogen

combineerMetBogen::(Eq u)=>[ [u] ]->[(u,u)]->[([u],[(u,u)])]
----------------------------------------------------------
combineerMetBogen [] _ = []
combineerMetBogen (el:rest) bogen = (el,(bogen2 el bogen)):(combineerMetBogen rest bogen)
	where
		bogen2::(Eq u)=>[u]->[(u,u)]->[(u,u)]
		-------------------------------------
		bogen2 _ [] = []
		bogen2 knopen (boog:rest) =
			let
				(van,naar) = boog
			in
				if ((van `elem` knopen) && (naar `elem` knopen))
				then boog:(bogen2 knopen rest)
				else bogen2 knopen rest

maakDeelKnopen::(Ord u)=>[u]->[ [u] ]
-------------------------------------
maakDeelKnopen knopen = nub [sort y|x<-(perms knopen),y<-inits x]

combs::[t]->[u]->[ [(t,u)] ]
----------------------------
combs g1 g2 = combineer g1 (perms g2)
	where
		combineer::[t]->[ [u] ]->[ [(t,u)] ]
		------------------------------------
		combineer _ [[]] = [[]]
		combineer lijst (x:xs) = (zip lijst x):(combineer lijst xs)

perms::[u]->[ [u] ]
-------------------
perms [] = [[]]
perms (x:xs) = concatMap (interleave x) (perms xs)

interleave::u->[u]->[ [u] ]
---------------------------
interleave x [] = [ [x] ]
interleave x (y:ys) = [x:y:ys]++map (y:) (interleave x ys)