Declaratieve Talen/oplossingenPalindromen

Een eerste oplossing

% 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*

--Nick.dewaele (overleg) 31 dec 2017 18:48 (CET)

% 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.
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,_,[]).

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

% ===== vraag 2 =====

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: Heuristische_Kost-node(Woord, Letters_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).