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)

alternatief voor het eerste deel

iso_f::(Eq t,Eq u)=>([t],[(t,t)])->([u],[(u,u)])->[(t,u)]--iso_f geeft de bijectie f, iso gewoon een bool
----------------------------------------------------
iso_f ((v1:[]),e1) ((v2:[]),e2) = [(v1,v2)]
iso_f ((v1:v1s),e1) (v2,e2) = 
	let graad_v1 = length [(a,b) | (a,b) <- e1, (a==v1 ||b==v1)]
	    candidates = knopen_met_graad graad_v1 v2 e2
	    subgraaf = graaf_zonder v1 ((v1:v1s),e1)
	in iso_f2 v1 subgraaf (v2,e2) candidates

iso_f2::(Eq t,Eq u)=>t ->([t],[(t,t)])->([u],[(u,u)])-> [u]->[(t,u)] 
-----------------------------------------------------------
iso_f2 v1 subgraaf graaf [] = []
iso_f2 v1 subgraaf graaf (c1:candidates) =
	let iso_graaf = graaf_zonder c1 graaf
	in 
		if not $ null (iso_f subgraaf iso_graaf) 
		then (v1,c1):(iso_f subgraaf iso_graaf)
		else (iso_f2 v1 subgraaf graaf candidates)
 
graaf_zonder:: (Eq t) => t -> ([t],[(t,t)]) -> ([t],[(t,t)]) --wist t uit de lijst van knopen en alle bogen naar/van t
--------------------------------------------------
graaf_zonder knoop (knopen, bogen)= 
	let nieuwe_knopen = [y |y <- knopen, y /= knoop]
	    nieuwe_bogen = [(begin, eind) | (begin, eind) <-bogen, begin /= knoop, eind /= knoop]
	in (nieuwe_knopen, nieuwe_bogen)

knopen_met_graad::(Eq t) => Int -> [t] ->[(t,t)] -> [t]--lijst met knopen van graad 'Int'
------------------------------------------
knopen_met_graad x [] bogen = []
knopen_met_graad x (k:ks) bogen =
	let graadk = length [(a,b) | (a,b) <- bogen, (a==k ||b==k)]
	in
		if graadk == x
		then k:knopen_met_graad x ks bogen
		else knopen_met_graad x ks bogen

voor de duidelijkheid iso die gewoon een bool geeft, iso_f is hier een uitbreiding op:

iso::(Eq t,Eq u)=>([t],[(t,t)])->([u],[(u,u)])->Bool
----------------------------------------------------
iso ((v1:[]),e1) ((v2:[]),e2) = True
iso ((v1:v1s),e1) (v2,e2) = 
	let graad_v1 = length [(a,b) | (a,b) <- e1, (a==v1 ||b==v1)]
	    candidates = knopen_met_graad graad_v1 v2 e2
	    subgraaf = graaf_zonder v1 ((v1:v1s),e1)
	in iso2 subgraaf (v2,e2) candidates
	 
iso2::(Eq t,Eq u)=>([t],[(t,t)])->([u],[(u,u)])-> [u]->Bool --iso met een van de grafen na verwijderen van een candidate?
-----------------------------------------------------------
iso2 subgraaf graaf [] = False
iso2 subgraaf graaf (c1:candidates) =
	let iso_graaf = graaf_zonder c1 graaf
	in (iso subgraaf iso_graaf) || (iso2 subgraaf graaf candidates)   

--Beau 17 jun 2006 15:48 (CEST)