Declaratieve Talen/oplossingenPalindromen
Naar navigatie springen
Naar zoeken springen
Een eerste oplossing voor vraag 1
% Warning: Does not generate all solutions.
%
% Substitutes elements which occur the least in the list.
% The cost is defined as the number of subsitutions, hence
% the length of the list minus the times the most common element occurs.
% Torben Gernaey & Sven Thijssen
allesgelijk(List, Cost, Result) :-
map_elements(List, UnsortedMap),
sort(UnsortedMap, SortedLowToHighMap),
reverse(SortedLowToHighMap, SortedHighToLowMap),
most_common(SortedHighToLowMap, Times, Element),
substitute(List, Element, Result),
length(List, Length),
Cost is Length - Times.
map_elements(List, Map) :-
map_elements(List, [], Map).
map_elements([], Map, Map).
map_elements([Element|List], Map, Result) :-
\+ member(pair(_, Element), Map),
append([pair(1, Element)], Map, NewMap),
map_elements(List, NewMap, Result).
map_elements([Element|List], Map, Result) :-
member(pair(_, Element), Map),
update_element(Element, Map, [], NewMap),
map_elements(List, NewMap, Result)
update_element(_, [], Result, Result).
update_element(Element, [pair(Value, Key)|Map], Temp, Result) :-
Element \= Key,
update_element(Element, Map, [pair(Value, Key)|Temp], Result).
update_element(Element, [pair(Value, Element)|Map], Temp, Result) :-
NewValue is Value + 1,
update_element(Element, Map, [pair(NewValue, Element)|Temp], Result).
most_common([pair(Times,Element)|_], Times, Element).
substitute([], _, []).
% Not necessary to split, since all elements will be the same.
% Other solution:
% substitute([_|List], Element, [Element|Result]) :-
% substitute(List, Element, Result).
substitute([X|List], Element, [Element|Result]) :-
X \= Element,
substitute(List, Element, Result).
substitute([Element|List], Element, [Element|Result]) :-
substitute(List, Element, Result).
Een andere (redelijk lange) oplossing met A* voor vraag 2
--Nick.dewaele (overleg) 31 dec 2017 18:48 (CET)
%===== vraag 1 ======
% waar als Elem het vaakst voorkomende element is in List
mostCommonElement(List, Elem, NumOccurences) :-
% er zijn snellere manieren om dit te doen, maar dit is niet de essentie
sort(List, Ls), % verwijdert dubbels
findall(Count-E, (
member(E,Ls),
findall(E, member(E,List), Occurences),
length(Occurences, Count)
), ElemCounts),
sort(1, @>=, ElemCounts, Sorted),
Sorted = [MaxNumOcc-_ | _],
findall(Count-E, (
member(Count-E, Sorted),
Count =:= MaxNumOcc
), PossibleAnswers),
member(NumOccurences-Elem, PossibleAnswers).
% In 'allesgelijk' ga je alles behalve 1 element veranderen. Het is uiteraard optimaal
% als dat element het meest voorkomende is. Dus we nemen een herhaling van het vaakst voorkomende element.
allesgelijk(List, Cost, Seq) :-
mostCommonElement(List, E, NumOcc),
length(List, Len),
Cost is Len - NumOcc,
replicate(Len, E, Seq).
% herhaal iets N keer
replicate(N, Thing, [Thing|Res]) :-
N > 0,
Nmin1 is N - 1,
replicate(Nmin1, Thing, Res).
replicate(0,_,[]).
% ===== vraag 2 =====
% vervang alle voorkomens van een letter in een woord door een andere opgegeven letter
substitute(Word, LetterToReplace, ReplacingLetter, Res, NumReplacements) :-
substitute(Word, LetterToReplace, ReplacingLetter, 0, Res, NumReplacements).
substitute([Letter|Word], LetterToReplace, ReplacingLetter, AccReplacements, [NewLetter|NewWord], NumReplacements) :-
(Letter = LetterToReplace ->
NewLetter = ReplacingLetter,
NewAcc is AccReplacements + 1
;
NewLetter = Letter,
NewAcc = AccReplacements
),
substitute(Word, LetterToReplace, ReplacingLetter, NewAcc, NewWord, NumReplacements).
substitute([],_,_,Acc,[],Acc).
isPalindrome(P) :- numUnmatchedPairs(P, 0).
% Geeft het aantal keer dat het i-de en het n-i -de karakter verschillend zijn (met n de lengte van het woord)
numUnmatchedPairs(L, N) :-
reverse(L, Lrev),
length(L, Len),
HalfLen is floor(Len / 2),
countUnmatched(L, Lrev, HalfLen, 0, N).
countUnmatched([H1|T1], [H2|T2], I, Acc, Res) :-
I > 0,
Imin1 is I - 1,
( H1 = H2 ->
NewAcc = Acc
;
NewAcc is Acc + 1
),
countUnmatched(T1, T2, Imin1, NewAcc, Res).
countUnmatched(_,_,0,Acc,Acc).
heuristic(L, H) :- numUnmatchedPairs(L,H).
% voorstelling van een knoop: F_Kost-node(Woord, Letters_die_al_een_andere_letter_vervangen, Laast_vervangen_letter Kost)
aStar([F-node(Word, _, _, Cost) | _], _, Cost, Word) :-
% we hebben hier een heuristiek die enkel nul wordt bij palindromen
F =:= Cost,
!.
aStar([_-node(Word, ReplacingLetters, LastReplaced, G) | Q], Alphabet, ResCost, ResWord) :-
sort(Word, LettersOfCurrentWord),
% zoek alle buren.
% 1) Vervang nooit een letter (zeg b) die al een andere letter (zeg a) vervangt (zeg: b vervangen door c)
% Dan betaal je twee keer om je a's te vervangen en dat is suboptimaal. Dan zal in een andere tak wel
% een knoop ontwikkeld worden waar eerst de a's c's worden en dan de b's c's worden
%
% 2) Het zou kunnen gebeuren dat je dubbels genereert: bijvoorbeeld met een pad dat
% eerst a->b en dan c->d vervangt en dan een pad dat c->d en dan a->b doet
% Om dat te vermijden vervang je een letter nooit als er al een letter is die later in het
% alfabet komt en al vervangen is
findall(NeighborF-node(Neighbor, [ReplacingLetter | ReplacingLetters], ReplacedLetter, NewG), (
% kies een letter die je wilt vervangen
member(ReplacedLetter, LettersOfCurrentWord),
\+ member(ReplacedLetter, ReplacingLetters), % zie puntje 1
appearsAfterIn(ReplacedLetter, LastReplaced, Alphabet), % zie puntje 2
% kies een letter die de nieuwe vervangt
member(ReplacingLetter, LettersOfCurrentWord),
ReplacedLetter \= ReplacingLetter,
% voer de substitutie uit en bepaal de kost
substitute(Word, ReplacedLetter, ReplacingLetter, Neighbor, DeltaG),
NewG is G + DeltaG,
heuristic(Neighbor, H),
NeighborF is NewG + H
), Neighbors),
insertAll(Neighbors, Q, NewQ),
aStar(NewQ, Alphabet, ResCost, ResWord).
insertAll(Nodes, Q, Res) :-
append(Nodes, Q, Concat),
sort(1, @=<, Concat, Res).
% waar asa A na B voorkomt in de opgegeven lijst
appearsAfterIn(A,B,[H|T]) :-
A \= H,
(B = H -> true; appearsAfterIn(A,B,T)).
palindroom(Word, Cost, Seq) :-
sort(Word, Alphabet),
heuristic(Word, H),
aStar([H-node(Word, [], emptySymbol, 0)], [emptySymbol|Alphabet], Cost, Seq).
Een andere oplossing
--Jelle.de coninck (overleg) 8 jan 2018 20:26 (CET)
De oplossing voor vraag 2 is redelijk elegant maar de code is 50%+ edge case handling ¯\_(ツ)_/¯
% DEEL 1
allesgelijk(Seq1,Kost,Seq0) :-
findall(N-X,(member(X,Seq1),occurrences(X,Seq1,N)),L), % zoek het aantal voorkomens van elk element
max_member(N-_,L), % N = hoogste aantal voorkomens
member(N-E,L), % E = element met N voorkomens (backtrackt over alle opties)
length(Seq1,Len),
Kost is Len - N,
replicate(E,Len,Seq0).
% replicate(X,N,Out) => Out == [X for _ in range(N)]
replicate(_,0,[]).
replicate(E,N,[E|R]) :- N > 0, M is N - 1, replicate(E,M,R).
% occurrences(X,L,N) => N == het aantal voorkomens van X in L
occurrences(_,[],0).
occurrences(X,[X|R],N) :-
!,
occurrences(X,R,M),
N is M + 1.
occurrences(X,[_|R],N) :- occurrences(X,R,N).
% DEEL 2
% strategie:
% een palindroom van even lengte is van de vorm L ++ R met reverse(L,R)
% een palindroom van oneven lengte is van de vorm L ++ x ++ R met reverse(L,R) en x één enkel element
% we kunnen de gegeven sequentie opsplitsen in 2 delen van gelijke lengte, L' en R'
% (en eventueel een middelste element x)
% stel we draaien R' om en leggen het element per element naast L'
% (a) als een paar elementen overeenkomt moeten we niets doen
% (b) als een paar niet overeenkomt moeten we één van de twee kiezen en het andere vervangen door een kopie van het eerste
% dan hebben we één letter vervangen dus kost += 1
% het palindroom is dan L' ++ R' (of L' ++ x ++ R')
% de functie match(L',R',Out) geeft alle mogelijke "aangepaste" L', het palindroom is dan Out ++ x ++ (reverse Out)
% de functie palindroom is vooral fuckery om de input op te splitsen als L' ++ x ++ R'
palindroom(Seq1,Kost,Seq2) :-
length(Seq1,Len),
HLen is floor(Len / 2), % Lengte van L' en R'
HCeil is ceil(Len / 2), % Index van x
reverse(Seq1,RSeq1),
take(HLen,Seq1,S), % S == L'
take(HLen,RSeq1,R), % R == R'
take(HCeil,Seq1,C),
append(S,M,C), % C == [x] of []
match(S,R,O,Kost),
reverse(O,RO),
append(O,M,OM),
append(OM,RO,Seq2).
% match(L',R',Out,Kost) => for index,elem in enumerate(Out): (elem == L'[index] or elem == R'[index])
match([],[],[],0).
match([S|R1],[S|R2],[S|O],K) :- !,match(R1,R2,O,K). % geval (a), cut zodat er niet over (b) wordt gebacktrackt
match([S1|R1],[S2|R2],[S|O],K) :- % geval (b)
(S = S1
;
S = S2),
match(R1,R2,O,K1),
K is K1 + 1.
% take(N,L,Out) => Out == L[N:]
take(0,_,[]).
take(N,[X|L],[X|R]) :- M is N - 1, take(M,L,R).