Fii, Prolog - rextester

Language: Layout:

:- use_module(library(clpfd)). %for transpose

%sort words by length then hand things off to puzsol predicate

puzzle_solution(Puz,Ws):-

sort_ws(Ws,Ss),
  allslots(Puz,LS),

puzsol(LS,Ss).

%finished when word list is empty

puzsol(_,[]).

%solve for one word then recursively for the rest of the words

puzsol(LS,[Le-W|Ws]):-

%try first the original then the transpose, each time naming the result P

(P=Puz;transpose(Puz,P)),

member(Le-S,LS),

%fill in the slot with this word

fill(S,W),

%solve for the rest of the words

puzsol(P,Ws).

%left edge is always a slot because there might not be a # before it. If it IS a # no need to check that because a word won't fit there anyeay

slot(L,L).

%a slot has anything to the left, a # A, then a var or a non-# B, and consists of B followed by the rest of the line

slot(L,[B|C]):-

append([_,[A,B],C],L),

%check first that A isn't a var so = will not bind the var to #

\+var(A), A='#',

%any var or non-# can start the slot

(var(B);B\='#').

%get length of the slot itself
slotlength([],0):- !.
slotlength([H|_],0):-
  \+var(H),H='#',!.
slotlength([_|T],Le):-
  slotlength(T,Le2),
  Le is Le2+1.

allslots(Puz, LSsr):-
  bagof(L-S, L^W^S^M^((P=Puz;transpose(Puz,P)),member(M,P),slot(M,S),slotlength(S,L)),LS),
  keysort(LS,LSs),
  reverse(LSs,LSsr).

%any empty slot can be filled with an empty word, allows words to run up to the rightmost edge

fill([],[]).

%if the slot is not empty but the word is empty, the very next thing after the word had better be a #

fill([H|_],[]):-

%check for non-var first so assignment to # is not made

\+var(H),H='#'.

%copy word into slot from head to tail

fill([H|T],[H|T2]):- fill(T,T2).

%sort words by length, long to short

sort_ws(Ws, Ssr):-

%assign a key of negative the length so that larger ones will come before smaller ones

findall(L-W,(member(W,Ws),length(W,L)),Lws),

%do the sort

keysort(Lws,Ss),
  reverse(Ss,Ssr).

[ - ] Show input
Absolute running time: 0.43 sec, cpu time: 0.28 sec, memory peak: 6 Mb, absolute service time: 0,56 sec