Declaratieve Talen/oplossingenPalindromen

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).