post correspondence in prolog

% Author: Michal Hantl, han345
% Date: 27/04/2010


% resici algoritmus ------------------------------------------------------------

solve_post(List1, List2, Sequence):-
  sequence([], [], List1, List2, List1, List2, Sequence, 1, [], [], 32).


sequence(T1, T2, List1, List2, [W1|LT1], [W2|LT2], Sequence, Pos, Used, Progress, Limit):-
 
  % omezeni maximalni delky
  (NewLimit is (Limit -1), (Limit >= 0)),
  (

    % pokud jsou obe posloupnosti stejne dlouhe
    % a pouzili jsme vsechna slova obou sekvenci tak jsme hotovi.
    ((T1 = [], T2 = [],
     length(Used, UsedLen), length(List1, ListLen), UsedLen = ListLen),
      (Sequence = Progress)
    );
    
    % pokud je pokracovani sekvenci prazdne, dopln ho
    ((T1 = [] ; T2 = []),
      append(T1, W1, Word1), append(T2, W2, Word2),

      % pokud zacinaji stejnym posmenem,
      (start_with_same_letter(Word1, Word2, R1, R2),
      
        % zaznamenej, ze jsme pouzili dane slovo
        (member(Pos, Used), (NextUsed = Used); append(Used, [Pos], NextUsed)),
        
        % pridej slovo, ktere jsme pouzili do posloupnosti
        append(Progress, [Pos], NewProgress),
        
        % a pokracuj
        sequence(R1, R2, List1, List2, List1, List2, Sequence, 1, NextUsed, NewProgress, NewLimit)
      );
      
      % nezacinaji stejnym pismenem,
      % zkusime dalsi pozici
      NextPos is (Pos + 1),
      sequence(T1, T2, List1, List2, LT1, LT2, Sequence, NextPos, Used, Progress, Limit)
    );

    % pokud sekvence zacinaji stejnym pismenem, muzeme pokracovat
    start_with_same_letter(T1, T2, R1, R2),
    append([W1], LT1, L1), append([W2], LT2, L2),
    sequence(R1, R2, List1, List2, L1, L2, Sequence, Pos, Used, Progress, Limit)
  ).


start_with_same_letter([Letter|Word1], [Letter|Word2], Word1, Word2).
  
  
% ziskani slov ze sekvence -----------------------------------------------------
  
sequence_to_words(List, [N|Sequence], CharSequence):-
  nth1(N, List, Characters), sequence_to_words(List, Sequence, CharSequenceTail),
  append([Characters], CharSequenceTail, CharSequence).

sequence_to_words(_, [], []).

  

% priklad postova problemu -----------------------------------------------------

example(Sequence, CharSequence1, CharSequence2):-
  % zadani
  List1 = [[a], [a, b], [b,b,a]],
  List2 = [[b,a,a], [a,a], [b,b]],

  % najdi reseni
  solve_post(List1, List2, Sequence),
  
  % najdi znaky reseni
  sequence_to_words(List1, Sequence, CharSequence1),
  sequence_to_words(List2, Sequence, CharSequence2).
  


  

% spusť example(S, C1, C2)