Declaratieve Talen/Oplossing Graaf-isomorfie: verschil tussen versies

Uit Wina Examenwiki
Naar navigatie springen Naar zoeken springen
Bas (overleg | bijdragen)
80 bewerkingen
Geen bewerkingssamenvatting
 
Beau (overleg | bijdragen)
137 bewerkingen
alternatieve oplossing
 
(2 tussenliggende versies door 2 gebruikers niet weergegeven)
Regel 1: Regel 1:
==== Oplossing ====
==== Een oplossing: ====
Dit is een mogelijke oplossing:


  verbonden(A,B) :- boog(A,B).
  import List
verbonden(A,B) :- boog(B,A).
   
   
  verplaatsKeien(Van, Naar, Aantal, Knopen, Waarden, NieuweWaarden) :-
  iso::(Eq t,Eq u)=>([t],[(t,t)])->([u],[(u,u)])->[(t,u)]
        member(Van, Knopen),
-------------------------------------------------------
        member(Naar, Knopen),
iso graaf1 graaf2 =
        verbonden(Van, Naar),
let
        index(Knopen, Van, VanPos),
(knopen1,bogen1) = graaf1
        index(Knopen, Naar, NaarPos),
(knopen2,bogen2) = graaf2
        index(Waarden, VanAantal, VanPos),
cond1 = length knopen1 /= length knopen2
        index(Waarden, NaarAantal, NaarPos),
cond2 = length bogen1 /= length bogen2
        numlist(1,VanAantal, Poss),
in
        member(Aantal, Poss),
if cond1
        VanAantal2 is VanAantal - Aantal,
then error "Knooplijsten zijn van verschillende lengte!!!"
        NaarAantal2 is NaarAantal + Aantal - 1,
else if cond2
        setElementAt(Waarden,VanPos,VanAantal2, NieuweWaardenTmp),
    then error "Booglijsten zijn van verschillende lengte!!!"
        setElementAt(NieuweWaardenTmp,NaarPos,NaarAantal2, NieuweWaarden).
    else vergelijk bogen1 bogen2 (combs knopen1 knopen2)
   
   
  kei_bereikbaar(Knoop) :-
  iso2::(Eq t,Eq u)=>([t],[(t,t)])->([u],[(u,u)])->Bool
        findall(K, knoop(K, _), Knopen),
-----------------------------------------------------
        findall(W, knoop(_, W), Waarden),
iso2 graaf1 graaf2 =
        kei_bereikbaar2(Knoop, Knopen, Waarden, []).
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)
   
   
  kei_bereikbaar2(Knoop, Knopen, Waarden, _) :-
  vergelijk::(Eq t,Eq u)=>[(t,t)]->[(u,u)]->[ [(t,u)] ]->[(t,u)]
        index(Knopen, Knoop, Pos),
--------------------------------------------------------------
        index(Waarden, Aantal, Pos),
vergelijk _ _ [] = error "Geen gelijkenis gevonden"
        Aantal > 0.
vergelijk _ _ [[]] = error "Geen gelijkenis gevonden"
kei_bereikbaar2(Knoop, Knopen, Waarden, Gedaan) :-
vergelijk b1 b2 (comb:rest) | controleer b1 b2 comb = comb
        knoop(Van, _),
      | otherwise = vergelijk b1 b2 rest
        index(Knopen, Van, Pos),
 
        index(Waarden, VanAantal, Pos),
vergelijk2::(Eq t,Eq u)=>[(t,t)]->[(u,u)]->[ [(t,u)] ]->Bool
        VanAantal > 1,
------------------------------------------------------------
        knoop(Naar, _),
vergelijk2 _ _ [] = False
        % A -> B => nutteloos om B -> A te doen:
vergelijk2 _ _ [[]] = False
        not(member((Naar, Van), Gedaan)),
vergelijk2 b1 b2 (comb:rest) | controleer b1 b2 comb = True
        NieuwGedaan = [(Van, Naar) | Gedaan],
    | otherwise = vergelijk2 b1 b2 rest
        verplaatsKeien(Van,Naar,_,Knopen,Waarden,NieuweWaarden),
        kei_bereikbaar2(Knoop, Knopen, NieuweWaarden, NieuwGedaan).
   
   
  kei_goed :-
  controleer::(Eq t,Eq u)=>[(t,t)]->[(u,u)]->[(t,u)]->Bool
        forall(knoop(Knoop, _), kei_bereikbaar(Knoop)).
--------------------------------------------------------
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)
   
   
  kei_nijg :-
  subiso::(Ord t,Ord u)=>([t],[(t,t)])->([u],[(u,u)])->Bool
        findall(K, knoop(K, _), Knopen),
-------------------------------------------------------
        findall(W, knoop(_, W), Waarden),
subiso graaf1 graaf2 =
        kei_nijg2(Knopen, Waarden, []).
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]
   
   
  kei_nijg2(_, Waarden, _) :-
  combs::[t]->[u]->[ [(t,u)] ]
        forall(member(X, Waarden), X > 0).
----------------------------
  kei_nijg2(Knopen, Waarden, Gedaan) :-
combs g1 g2 = combineer g1 (perms g2)
        knoop(Van, _),
where
        index(Knopen, Van, Pos),
combineer::[t]->[ [u] ]->[ [(t,u)] ]
        index(Waarden, VanAantal, Pos),
------------------------------------
        VanAantal > 1,
combineer _ [[]] = [[]]
        knoop(Naar, _),
combineer lijst (x:xs) = (zip lijst x):(combineer lijst xs)
        % A -> B => nutteloos om B -> A te doen:
 
        not(member((Naar, Van), Gedaan)),
perms::[u]->[ [u] ]
        NieuwGedaan = [(Van, Naar) | Gedaan],
-------------------
        verplaatsKeien(Van,Naar,_,Knopen,Waarden,NieuweWaarden),
perms [] = [[]]
        kei_nijg2(Knopen, NieuweWaarden, NieuwGedaan).
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
   
   
  index([], _, _) :- 0 = 1.
  iso_f2::(Eq t,Eq u)=>t ->([t],[(t,t)])->([u],[(u,u)])-> [u]->[(t,u)]
index([RijHoofd|_], Element, Index) :-
-----------------------------------------------------------
        RijHoofd = Element,
iso_f2 v1 subgraaf graaf [] = []
        Index = 0.
iso_f2 v1 subgraaf graaf (c1:candidates) =
index([RijHoofd|Rest], Element, Index) :-
let iso_graaf = graaf_zonder c1 graaf
        nonvar(Element),
in
        RijHoofd \= Element,
if not $ null (iso_f subgraaf iso_graaf)
        index(Rest, Element, SubIndex),
then (v1,c1):(iso_f subgraaf iso_graaf)
        Index is 1 + SubIndex.
else (iso_f2 v1 subgraaf graaf candidates)
  index([_|Rest], Element, Index) :-
 
        nonvar(Index),
graaf_zonder:: (Eq t) => t -> ([t],[(t,t)]) -> ([t],[(t,t)]) --wist t uit de lijst van knopen en alle bogen naar/van t
        SubIndex is Index - 1,
--------------------------------------------------
        index(Rest, Element, SubIndex).
  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)
   
   
  setElementAt([], _, _) :- 0 = 1.
  knopen_met_graad::(Eq t) => Int -> [t] ->[(t,t)] -> [t]--lijst met knopen van graad 'Int'
  setElementAt([_|Rest], 0, X, NieuweRij) :-
------------------------------------------
        NieuweRij = [X|Rest].
knopen_met_graad x [] bogen = []
  setElementAt([RijHoofd|Rest], A, X, NieuweRij) :-
  knopen_met_graad x (k:ks) bogen =
        A > 0,
let graadk = length [(a,b) | (a,b) <- bogen, (a==k ||b==k)]
        A2 is A - 1,
in
        setElementAt(Rest,A2,X,Rest2),
if graadk == x
        NieuweRij = [RijHoofd|Rest2].
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) 
 
--[[Gebruiker:Beau|Beau]] 17 jun 2006 15:48 (CEST)

Huidige versie van 17 jun 2006 13:48

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)

Overgenomen van "http://examens.wina.be/index.php?title=Declaratieve_Talen/Oplossing_Graaf-isomorfie&oldid=4258"