Declaratieve Talen/Oplossing Keigrafen: verschil tussen versies

Uit Wina Examenwiki
Naar navigatie springen Naar zoeken springen
← Oudere bewerking
Beau (overleg | bijdragen)
137 bewerkingen
Beau (overleg | bijdragen)
137 bewerkingen
juiste oef
 
Regel 1: Regel 1:
==== Oplossing ====
Dit is een mogelijke oplossing:


==== Een oplossing: ====
verbonden(A,B) :- boog(A,B).
 
  verbonden(A,B) :- boog(B,A).
  import List
   
   
  iso::(Eq t,Eq u)=>([t],[(t,t)])->([u],[(u,u)])->[(t,u)]
  verplaatsKeien(Van, Naar, Aantal, Knopen, Waarden, NieuweWaarden) :-
-------------------------------------------------------
        member(Van, Knopen),
iso graaf1 graaf2 =
        member(Naar, Knopen),
let
        verbonden(Van, Naar),
(knopen1,bogen1) = graaf1
        index(Knopen, Van, VanPos),
(knopen2,bogen2) = graaf2
        index(Knopen, Naar, NaarPos),
cond1 = length knopen1 /= length knopen2
        index(Waarden, VanAantal, VanPos),
cond2 = length bogen1 /= length bogen2
        index(Waarden, NaarAantal, NaarPos),
in
        numlist(1,VanAantal, Poss),
if cond1
        member(Aantal, Poss),
then error "Knooplijsten zijn van verschillende lengte!!!"
        VanAantal2 is VanAantal - Aantal,
else if cond2
        NaarAantal2 is NaarAantal + Aantal - 1,
    then error "Booglijsten zijn van verschillende lengte!!!"
        setElementAt(Waarden,VanPos,VanAantal2, NieuweWaardenTmp),
    else vergelijk bogen1 bogen2 (combs knopen1 knopen2)
        setElementAt(NieuweWaardenTmp,NaarPos,NaarAantal2, NieuweWaarden).
   
   
  iso2::(Eq t,Eq u)=>([t],[(t,t)])->([u],[(u,u)])->Bool
  kei_bereikbaar(Knoop) :-
-----------------------------------------------------
        findall(K, knoop(K, _), Knopen),
iso2 graaf1 graaf2 =
        findall(W, knoop(_, W), Waarden),
let
        kei_bereikbaar2(Knoop, Knopen, Waarden, []).
(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
  kei_bereikbaar2(Knoop, Knopen, Waarden, _) :-
------------------------------------------------------------
        index(Knopen, Knoop, Pos),
vergelijk2 _ _ [] = False
        index(Waarden, Aantal, Pos),
vergelijk2 _ _ [[]] = False
        Aantal > 0.
vergelijk2 b1 b2 (comb:rest) | controleer b1 b2 comb = True
  kei_bereikbaar2(Knoop, Knopen, Waarden, Gedaan) :-
    | otherwise = vergelijk2 b1 b2 rest
        knoop(Van, _),
 
        index(Knopen, Van, Pos),
  controleer::(Eq t,Eq u)=>[(t,t)]->[(u,u)]->[(t,u)]->Bool
        index(Waarden, VanAantal, Pos),
--------------------------------------------------------
        VanAantal > 1,
controleer [] [] _ = True
        knoop(Naar, _),
controleer (x:xs) lijst koppels =
        % A -> B => nutteloos om B -> A te doen:
let
        not(member((Naar, Van), Gedaan)),
(tvan,tnaar) = x
        NieuwGedaan = [(Van, Naar) | Gedaan],
uvan = head [b|(a,b)<-koppels,a==tvan]
        verplaatsKeien(Van,Naar,_,Knopen,Waarden,NieuweWaarden),
unaar = head [b|(a,b)<-koppels,a==tnaar]
        kei_bereikbaar2(Knoop, Knopen, NieuweWaarden, NieuwGedaan).
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
  kei_goed :-
-------------------------------------------------------
        forall(knoop(Knoop, _), kei_bereikbaar(Knoop)).
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)])]
  kei_nijg :-
-----------------------------------------------------
        findall(K, knoop(K, _), Knopen),
maakDeelGraaf graaf =
        findall(W, knoop(_, W), Waarden),
let
        kei_nijg2(Knopen, Waarden, []).
(knopen,bogen) = graaf
deelKnopen = maakDeelKnopen knopen
in
combineerMetBogen deelKnopen bogen
   
   
  combineerMetBogen::(Eq u)=>[ [u] ]->[(u,u)]->[([u],[(u,u)])]
  kei_nijg2(_, Waarden, _) :-
  ----------------------------------------------------------
        forall(member(X, Waarden), X > 0).
combineerMetBogen [] _ = []
  kei_nijg2(Knopen, Waarden, Gedaan) :-
combineerMetBogen (el:rest) bogen = (el,(bogen2 el bogen)):(combineerMetBogen rest bogen)
        knoop(Van, _),
where
        index(Knopen, Van, Pos),
bogen2::(Eq u)=>[u]->[(u,u)]->[(u,u)]
        index(Waarden, VanAantal, Pos),
-------------------------------------
        VanAantal > 1,
bogen2 _ [] = []
        knoop(Naar, _),
bogen2 knopen (boog:rest) =
        % A -> B => nutteloos om B -> A te doen:
let
        not(member((Naar, Van), Gedaan)),
(van,naar) = boog
        NieuwGedaan = [(Van, Naar) | Gedaan],
in
        verplaatsKeien(Van,Naar,_,Knopen,Waarden,NieuweWaarden),
if ((van `elem` knopen) && (naar `elem` knopen))
        kei_nijg2(Knopen, NieuweWaarden, NieuwGedaan).
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] ]
  index([], _, _) :- 0 = 1.
-------------------
index([RijHoofd|_], Element, Index) :-
  perms [] = [[]]
        RijHoofd = Element,
  perms (x:xs) = concatMap (interleave x) (perms xs)
        Index = 0.
  index([RijHoofd|Rest], Element, Index) :-
        nonvar(Element),
        RijHoofd \= Element,
        index(Rest, Element, SubIndex),
        Index is 1 + SubIndex.
  index([_|Rest], Element, Index) :-
        nonvar(Index),
        SubIndex is Index - 1,
        index(Rest, Element, SubIndex).
   
   
  interleave::u->[u]->[ [u] ]
  setElementAt([], _, _) :- 0 = 1.
---------------------------
setElementAt([_|Rest], 0, X, NieuweRij) :-
interleave x [] = [ [x] ]
        NieuweRij = [X|Rest].
  interleave x (y:ys) = [x:y:ys]++map (y:) (interleave x ys)
  setElementAt([RijHoofd|Rest], A, X, NieuweRij) :-
        A > 0,
        A2 is A - 1,
        setElementAt(Rest,A2,X,Rest2),
        NieuweRij = [RijHoofd|Rest2].

Huidige versie van 17 jun 2006 10:54

Oplossing

Dit is een mogelijke oplossing: 

verbonden(A,B) :- boog(A,B).
verbonden(A,B) :- boog(B,A).

verplaatsKeien(Van, Naar, Aantal, Knopen, Waarden, NieuweWaarden) :-
        member(Van, Knopen),
        member(Naar, Knopen),
        verbonden(Van, Naar),
        index(Knopen, Van, VanPos),
        index(Knopen, Naar, NaarPos),
        index(Waarden, VanAantal, VanPos),
        index(Waarden, NaarAantal, NaarPos),
        numlist(1,VanAantal, Poss),
        member(Aantal, Poss),
        VanAantal2 is VanAantal - Aantal,
        NaarAantal2 is NaarAantal + Aantal - 1,
        setElementAt(Waarden,VanPos,VanAantal2, NieuweWaardenTmp),
        setElementAt(NieuweWaardenTmp,NaarPos,NaarAantal2, NieuweWaarden).

kei_bereikbaar(Knoop) :-
        findall(K, knoop(K, _), Knopen),
        findall(W, knoop(_, W), Waarden),
        kei_bereikbaar2(Knoop, Knopen, Waarden, []).

kei_bereikbaar2(Knoop, Knopen, Waarden, _) :-
        index(Knopen, Knoop, Pos),
        index(Waarden, Aantal, Pos),
        Aantal > 0.
kei_bereikbaar2(Knoop, Knopen, Waarden, Gedaan) :-
        knoop(Van, _),
        index(Knopen, Van, Pos),
        index(Waarden, VanAantal, Pos),
        VanAantal > 1,
        knoop(Naar, _),
        % A -> B => nutteloos om B -> A te doen:
        not(member((Naar, Van), Gedaan)),
        NieuwGedaan = [(Van, Naar) | Gedaan],
        verplaatsKeien(Van,Naar,_,Knopen,Waarden,NieuweWaarden),
        kei_bereikbaar2(Knoop, Knopen, NieuweWaarden, NieuwGedaan).

kei_goed :-
        forall(knoop(Knoop, _), kei_bereikbaar(Knoop)).

kei_nijg :-
        findall(K, knoop(K, _), Knopen),
        findall(W, knoop(_, W), Waarden),
        kei_nijg2(Knopen, Waarden, []).

kei_nijg2(_, Waarden, _) :-
        forall(member(X, Waarden), X > 0).
kei_nijg2(Knopen, Waarden, Gedaan) :-
        knoop(Van, _),
        index(Knopen, Van, Pos),
        index(Waarden, VanAantal, Pos),
        VanAantal > 1,
        knoop(Naar, _),
        % A -> B => nutteloos om B -> A te doen:
        not(member((Naar, Van), Gedaan)),
        NieuwGedaan = [(Van, Naar) | Gedaan],
        verplaatsKeien(Van,Naar,_,Knopen,Waarden,NieuweWaarden),
        kei_nijg2(Knopen, NieuweWaarden, NieuwGedaan).

index([], _, _) :- 0 = 1.
index([RijHoofd|_], Element, Index) :-
        RijHoofd = Element,
        Index = 0.
index([RijHoofd|Rest], Element, Index) :-
        nonvar(Element),
        RijHoofd \= Element,
        index(Rest, Element, SubIndex),
        Index is 1 + SubIndex.
index([_|Rest], Element, Index) :-
        nonvar(Index),
        SubIndex is Index - 1,
        index(Rest, Element, SubIndex).

setElementAt([], _, _) :- 0 = 1.
setElementAt([_|Rest], 0, X, NieuweRij) :-
        NieuweRij = [X|Rest].
setElementAt([RijHoofd|Rest], A, X, NieuweRij) :-
        A > 0,
        A2 is A - 1,
        setElementAt(Rest,A2,X,Rest2),
        NieuweRij = [RijHoofd|Rest2].
Overgenomen van "http://examens.wina.be/index.php?title=Declaratieve_Talen/Oplossing_Keigrafen&oldid=4248"