Declaratieve Talen/oplossingenPalindromen: verschil tussen versies
Naar navigatie springen
Naar zoeken springen
Nieuwe pagina aangemaakt met '% 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...' |
Geen bewerkingssamenvatting |
||
(4 tussenliggende versies door 2 gebruikers niet weergegeven) | |||
Regel 1: | Regel 1: | ||
== Een eerste oplossing voor vraag 1 == | |||
map_elements(List, Map) :- | % Warning: Does not generate all solutions. | ||
% | |||
map_elements([], Map, Map). | % Substitutes elements which occur the least in the list. | ||
map_elements([Element|List], Map, Result) :- | % 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([Element|List], Map, 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(_, [], Result, Result). | ||
update_element(Element, [pair(Value, Key)|Map], Temp, 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) :- | 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). | most_common([pair(Times,Element)|_], Times, Element). | ||
substitute([], _, []). | substitute([], _, []). | ||
% Not necessary to split, since all elements will be the same. | % Not necessary to split, since all elements will be the same. | ||
% Other solution: | % Other solution: | ||
% substitute([_|List], Element, [Element|Result]) :- | % substitute([_|List], Element, [Element|Result]) :- | ||
% substitute(List, Element, Result). | % substitute(List, Element, Result). | ||
substitute([X|List], Element, [Element|Result]) :- | substitute([X|List], Element, [Element|Result]) :- | ||
X \= Element, | |||
substitute(List, Element, Result). | |||
substitute([Element|List], Element, [Element|Result]) :- | substitute([Element|List], Element, [Element|Result]) :- | ||
substitute(List, Element, Result). | |||
== Een andere (redelijk lange) oplossing met A* voor vraag 2== | |||
--[[Gebruiker:Nick.dewaele|Nick.dewaele]] ([[Overleg gebruiker:Nick.dewaele|overleg]]) 31 dec 2017 18:48 (CET) | |||
<code> | |||
%===== 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). | |||
</code> | |||
== Een andere oplossing == | |||
--[[Gebruiker:Jelle.de coninck|Jelle.de coninck]] ([[Overleg gebruiker: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 ¯\_(ツ)_/¯ | |||
<code> | |||
% 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). | |||
</code> |
Huidige versie van 8 jan 2018 19:28
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).