5

I am trying to write a crossword solver I have got this code but I can't Understand some parts of it:

size(5).
black(1,3).
black(2,3).
black(3,2).
black(4,3).
black(5,1).
black(5,5).

words([do,ore,ma,lis,ur,as,po, so,pirus, oker,al,adam, ik]) .

:- use_module(library(lists),[nth1/3, select/3]).

crossword(Puzzle) :-
    words(WordList),
    word2chars(WordList,CharsList),
    make_empty_words(EmptyWords) ,
    fill_in(CharsList,EmptyWords),
    word2chars(Puzzle,EmptyWords).

word2chars([],[]).
word2chars([Word|RestWords] ,[Chars|RestChars] ) :-
    atom_chars(Word,Chars),
    word2chars(RestWords,RestChars).

fill_in([],[]).
    fill_in([Word|RestWords],Puzzle) :-
    select(Word,Puzzle,RestPuzzle),
    fill_in(RestWords,RestPuzzle).

make_empty_words(EmptyWords) :-
    size(Size),
    make_puzzle(Size,Puzzle),
    findall(black(I,J),black(I,J),Blacks) ,
    fillblacks(Blacks,Puzzle),
    empty_words(Puzzle,EmptyWords).

    make_puzzle(Size,Puzzle) :-
    length(Puzzle,Size),
    make_lines(Puzzle,Size).

make_lines([],_).
make_lines([L|Ls],Size) :-
    length(L,Size),
    make_lines(Ls,Size).
    fillblacks([],_).

fillblacks([black(I,J)|Blacks],Puzzle) :-
    nth1(I,Puzzle,LineI),
    nth1(J,LineI,black),
    fillblacks(Blacks,Puzzle).

empty_words(Puzzle,EmptyWords) :-
    empty_words(Puzzle,EmptyWords,TailEmptyWords),
    size(Size),
    transpose(Size,Puzzle,[],TransposedPuzzle),
    empty_words(TransposedPuzzle,TailEmptyWords,[] ).

empty_words([],Es,Es).
empty_words([L|Ls],Es,EsTail) :-
    empty_words_on_one_line(L,Es,Es1) ,
    empty_words(Ls,Es1,EsTail).

empty_words_on_one_line([], Tail, Tail).

empty_words_on_one_line([V1,V2|L],[[V1,V2|Vars]|R],Tail) :-
    var(V1), var(V2), !,
    more_empty(L,RestL,Vars),
    empty_words_on_one_line(RestL,R,Tail) .

empty_words_on_one_line([_| RestL],R, Tail) :-
    empty_words_on_one_line(RestL,R,Tail) .

more_empty([],[],[]).
more_empty([V|R],RestL,Vars) :-
    ( var(V) ->
    Vars = [V|RestVars],
    more_empty(R,RestL,RestVars)
    ;
    RestL = R,
    Vars = []
    ).

transpose(N,Puzzle,Acc,TransposedPuzzle) :-
    ( N == 0 ->
    TransposedPuzzle = Acc
    ;
    nth_elements(N,Puzzle,OneVert),
    M is N - 1,
    transpose(M,Puzzle,[OneVert|Acc], TransposedPuzzle)
    ).

nth_elements(_,[],[]).
nth_elements(N,[X|R],[NthX| S]) :-
    nth1(N,X,NthX),
    nth_elements(N,R,S).

This code is used for solving crosswords like this:

enter image description here

enter image description here

What are symbols ; -> used for?

My main problem is understanding the rules , transpose and more_empty. Any explanation to help me understand the code would be appreciated.

Flux
  • 9,805
  • 5
  • 46
  • 92
Freelancer
  • 836
  • 1
  • 14
  • 47
  • possible duplicate of [How to fill in the parameters of predicates by input in prolog?](http://stackoverflow.com/questions/27675219/how-to-fill-in-the-parameters-of-predicates-by-input-in-prolog) – false Dec 28 '14 at 16:54
  • 1
    It's not a duplicate it just has the same code but with different questions asked about it! In the http://stackoverflow.com/questions/27675219/how-to-fill-in-the-parameters-of-predicates-by-input-in-prolog A question about how to modify the code for getting some kind of result is asked but this question is asking about some parts of code being hard to understand! – Freelancer Dec 28 '14 at 16:58
  • Why do you again post the same ill formatted code? I tried to help you in your previous posting, please look at the difference. – false Dec 28 '14 at 16:58
  • 2
    ill formatted?! I have Got this code from a reliable source a book named `THE FIRST 1 0 PROLOG PROGRAMMING CONTESTS` how can you judge about the code like this? It's prolog and it's hard to understand but it's not ill formatted. I had some other question about the code so I posted a different question. So what's the problem? – Freelancer Dec 28 '14 at 17:02
  • 1
    The link for the book `THE FIRST 1 0 PROLOG PROGRAMMING CONTESTS` : http://dtai.cs.kuleuven.be/ppcbook/ppcbook.pdf – Freelancer Dec 28 '14 at 17:04
  • 3
    The indentation in the book is impeccable. You have added extra confusing lines and bad indentation as in `transpose/4` and many more. – false Dec 28 '14 at 17:22
  • 1
    @false It's the exact copy of the book's code I haven't changed any thing. see for yourself. – Freelancer Dec 28 '14 at 17:35
  • 1
    For an explanation of `,`, `;`, and `->` see, for example, [Control Predicates](http://www.swi-prolog.org/pldoc/doc_for?object=section%282,%274.8%27,swi%28%27/doc/Manual/control.html%27%29%29) – lurker Dec 29 '14 at 14:03
  • 4
    For an explanatino of `,`, `;`, and `->`, see, for example, [Control Predicates](http://www.swi-prolog.org/pldoc/doc_for?object=section%282,%274.8%27,swi%28%27/doc/Manual/control.html%27%29%29). Are you attempting to work through Prolog contest problems without first learning the fundamentals of the language syntax? – lurker Dec 29 '14 at 14:21
  • 3
    Dumping that much code and asking "how dis works" is never a good way to ask a question. Also: you have messed up the identation. Also: is your question about ( Condition -> Action ; Else )? Or about transposing? Or about unification? –  Jan 07 '15 at 05:28
  • I am just a beginner in prolog and maybe I am making a big jump trying to understand such code. I wanted to know the reason such predicate like transpose is being used and how it is implemented.I meant asking a general question about the logic of the code not some one explaining it completely.But I think you are right it is not really a good way of asking question I'll keep it in mind. – Freelancer Jan 07 '15 at 13:59

3 Answers3

2

-> and ; are Prolog's control flow, like the if-then-else satement in other languages. So:

transpose(N,Puzzle,Acc,TransposedPuzzle) :-
    ( N == 0 ->
    TransposedPuzzle = Acc
    ;
    nth_elements(N,Puzzle,OneVert),
    M is N - 1,
    transpose(M,Puzzle,[OneVert|Acc], TransposedPuzzle)
    ).

translates to psuedocode:

def transpose(N, Puzzle, Acc)
    if N == 0
        return Acc
    else
        OneVert = nth_elements(N, Puzzle)
        transpose(N-1, Puzzle, [OneVert, Acc])

or:

def transpose(N, Puzzle, Acc)
    while N > 0
        OneVert = nth_elements(N, Puzzle)
        Acc = [OneVert, Acc]
        N = N - 1
    return Acc

That should give you some idea what it does. I suggest you translate the more_empty function into psuedocode yourself (or just step through it in your head), and try to work it out from there.

Zaz
  • 46,476
  • 14
  • 84
  • 101
  • Prolog is not one of my strong languages, so apologies if I've made any mistakes. – Zaz Jan 07 '15 at 17:43
1

These are Prolog's if-then-else control structure.

The syntax is as follows:

condition -> then statements/decelerations ; else statements/declerations

Avi Tshuva
  • 246
  • 2
  • 12
1

In addition to the correct answers of Josh and Avi Tshuva stating that a -> b ; c is like "if a then b else c", I would like to explain that -> and ; are individual operators which can be used separately.

; is logical disjunction, ie. logical "or". So x; y means "x or y". This makes the conditional statement a bit confusing because a -> b ; c reads like "a implies b or c" which is obviously not what it means! Even if you parenthesize it like "(a implies b) or c" you get a different meaning from the conditional statement because in this incorrect interpretation, c will always be tried, even if (a implies b) succeeds.

The difference is because -> has some "non-logical" semantics. From SWI-Prolog docs:

:Condition -> :Action

If-then and If-Then-Else. The ->/2 construct commits to the choices made at its left-hand side, destroying choice points created inside the clause (by ;/2), or by goals called by this clause. Unlike !/0, the choice point of the predicate as a whole (due to multiple clauses) is not destroyed. The combination ;/2 and ->/2 acts as if defined as:
If -> Then; _Else :- If, !, Then. If -> _Then; Else :- !, Else. If -> Then :- If, !, Then.
Please note that (If -> Then) acts as (If -> Then ; fail), making the construct fail if the condition fails. This unusual semantics is part of the ISO and all de-facto Prolog standards.

(note that in the above quote, If, Then etc. are variables!)

So beware of anything with an implicit cut!

Hugh Allen
  • 6,509
  • 1
  • 34
  • 44