% Crossword puzzle % % Given an empty (or almost empty) framework of a crossword puzzle and % a set of words. The problem is to place the words into the framework. % % werner.hett@hta-bi.bfh.ch Time-stamp: <8-Oct-2000 14:46 hew> % modified argument order in select/3 predicate (SWI 3.3 -> 3.4) % 15-May-2001 hew % % The particular crossword puzzle is specified in a text file which % first lists the words (one word per line) in an arbitrary order. Then, % after an empty line, the crossword framework is defined. In this % framework specification, an empty character location is represented % by a dot (.). In order to make the solution easier, character locations % can also contain predefined character values. (See example files p99*.dat; % note that p99c.dat does not have a solution). % % Words are strings (character lists) of at least two characters. % A horizontal or vertical sequence of character places in the % crossword framework is called a site. Our problem is to find a % compatible way of placing words onto sites. :- ensure_loaded('p99-readfile.pl'). % used to read the data file % main program section ----------------------------------------------------- crossword :- write('usage: crossword(File)'), nl, write('or crossword(File,Opt) with Opt one of 0,1, or 2'), nl, write('or crossword(File,Opt,debug) for extra output'), nl. :- crossword. % crossword/1 runs without optimization (not recommended for large files) crossword(FileName) :- crossword(FileName,0). % crossword/2 runs with a given optimization and no debug output crossword(FileName,Opt) :- crossword(FileName,Opt,nodebug). % crossword/3 runs with a given optimization and a given debugging modus crossword(FileName,Opt,Debug) :- read_lines(FileName,Lines), % from file p99-readfile.pl % read_lines returns a list of character-lists separate(Lines,Words,FrameLines), length(Words,NWords), construct_squares(FrameLines,Squares,MaxRow,MaxCol), debug_write(Debug,Squares), construct_sites(Squares,MaxRow,MaxCol,Sites), length(Sites,NSites), check_lengths(NWords,NSites), solve(Words,Sites,Opt,Debug), % do the real work show_result(Squares,MaxRow,MaxCol). debug_write(debug,X) :- !, write(X), nl, nl. debug_write(_,_). check_lengths(N,N) :- !. check_lengths(NW,NS) :- NW \= NS, write('Number of words does not correspond to number of sites.'), nl, fail. % input preparation ---------------------------------------------------- % parse the data file and separate the word list from the framework % description separate(Lines,Words,FrameLines) :- trim_lines(Lines,LinesT), parse_non_empty_lines(LinesT-L1,Words), % difference lists! parse_empty_lines(L1-L2), parse_non_empty_lines(L2-L3,FrameLines), parse_empty_lines(L3-[]). % remove white space at the end of the lines trim_lines([],[]). trim_lines([L|Ls],[LT|LTs]) :- trim_line(L,LT), trim_lines(Ls,LTs). trim_line(L,LT) :- reverse(L,RL), rm_white_space(RL,RLT), reverse(RLT,LT). rm_white_space([X|Xs],L) :- char_type(X,white), !, rm_white_space(Xs,L). rm_white_space(L,L). % separate the word lines from the frame lines parse_non_empty_lines([L|L1]-L2,[L|Ls]) :- L \= [], !, parse_non_empty_lines(L1-L2,Ls). parse_non_empty_lines(L-L,[]). parse_empty_lines([[]|L1]-L2) :- !, parse_empty_lines(L1-L2). parse_empty_lines(L-L). % A square is a position for a single character. As Prolog term a square % has the form sq(Row,Col,X), where X denotes the character and Row and % Col define the position within the puzzle frame. Squares is simply % the list of all sq/3 terms. construct_squares(FrameLines,Squares,MaxRow,MaxCol) :- % (+,-,+,+) construct_squares(FrameLines,SquaresList,1), flatten(SquaresList,Squares), maxima(Squares,0,0,MaxRow,MaxCol). construct_squares([],[],_). % (+,-,+) construct_squares([FL|FLs],[SL|SLs],Row) :- construct_squares_row(FL,SL,Row,1), Row1 is Row+1, construct_squares(FLs,SLs,Row1). construct_squares_row([],[],_,_). % (+,-,+,+) construct_squares_row(['.'|Ps],[sq(Row,Col,_)|Sqs],Row,Col) :- !, Col1 is Col+1, construct_squares_row(Ps,Sqs,Row,Col1). construct_squares_row([X|Ps],[sq(Row,Col,X)|Sqs],Row,Col) :- char_type(X,alpha), !, Col1 is Col+1, construct_squares_row(Ps,Sqs,Row,Col1). construct_squares_row([_|Ps],Sqs,Row,Col) :- Col1 is Col+1, construct_squares_row(Ps,Sqs,Row,Col1). % maxima(Squares,0,0,MaxRow,MaxCol) :- determine maximum dimensions maxima([],MaxRow,MaxCol,MaxRow,MaxCol). maxima([sq(Row,Col,_)|Sqs],AccRow,AccCol,MaxRow,MaxCol) :- AccRow1 is max(AccRow,Row), AccCol1 is max(AccCol,Col), maxima(Sqs,AccRow1,AccCol1,MaxRow,MaxCol). % construction of sites ----------------------------------------------- % construct_sites/4 traverses the framework twice in order to % collect all the sites in the list Sites construct_sites(Squares,MaxRow,MaxCol,Sites) :- % (+,+,+,-) construct_sites_h(Squares,MaxRow,MaxCol,1,SitesH,[]), % horizontal construct_sites_v(Squares,MaxRow,MaxCol,1,Sites,SitesH). % vertical % horizontal sites construct_sites_h(_,MaxRow,_,Row,Sites,Sites) :- Row > MaxRow, !. construct_sites_h(Squares,MaxRow,MaxCol,Row,Sites,AccSites) :- construct_sites_h(Squares,MaxRow,MaxCol,Row,1,AccSites1,AccSites), Row1 is Row+1, construct_sites_h(Squares,MaxRow,MaxCol,Row1,Sites,AccSites1). construct_sites_h(_,_,MaxCol,_,Col,Sites,Sites) :- Col > MaxCol, !. construct_sites_h(Squares,MaxRow,MaxCol,Row,Col,Sites,AccSites) :- construct_site_h(Squares,Row,Col,Site,Incr), !, Col1 is Col+Incr, AccSites1 = [Site|AccSites], construct_sites_h(Squares,MaxRow,MaxCol,Row,Col1,Sites,AccSites1). construct_sites_h(Squares,MaxRow,MaxCol,Row,Col,Sites,AccSites) :- Col1 is Col+1, construct_sites_h(Squares,MaxRow,MaxCol,Row,Col1,Sites,AccSites). construct_site_h(Squares,Row,Col,[X,Y|Cs],Incr) :- memberchk(sq(Row,Col,X),Squares), Col1 is Col+1, memberchk(sq(Row,Col1,Y),Squares), Col2 is Col1+1, continue_site_h(Squares,Row,Col2,Cs,3,Incr). continue_site_h(Squares,Row,Col,[X|Cs],Acc,Incr) :- memberchk(sq(Row,Col,X),Squares), !, Acc1 is Acc+1, Col1 is Col+1, continue_site_h(Squares,Row,Col1,Cs,Acc1,Incr). continue_site_h(_,_,_,[],Incr,Incr). % vertical sites construct_sites_v(_,_,MaxCol,Col,Sites,Sites) :- Col > MaxCol, !. construct_sites_v(Squares,MaxRow,MaxCol,Col,Sites,AccSites) :- construct_sites_v(Squares,MaxRow,MaxCol,1,Col,AccSites1,AccSites), Col1 is Col+1, construct_sites_v(Squares,MaxRow,MaxCol,Col1,Sites,AccSites1). construct_sites_v(_,MaxRow,_,Row,_,Sites,Sites) :- Row > MaxRow, !. construct_sites_v(Squares,MaxRow,MaxCol,Row,Col,Sites,AccSites) :- construct_site_v(Squares,Row,Col,Site,Incr), !, Row1 is Row+Incr, AccSites1 = [Site|AccSites], construct_sites_v(Squares,MaxRow,MaxCol,Row1,Col,Sites,AccSites1). construct_sites_v(Squares,MaxRow,MaxCol,Row,Col,Sites,AccSites) :- Row1 is Row+1, construct_sites_v(Squares,MaxRow,MaxCol,Row1,Col,Sites,AccSites). construct_site_v(Squares,Row,Col,[X,Y|Cs],Incr) :- memberchk(sq(Row,Col,X),Squares), Row1 is Row+1, memberchk(sq(Row1,Col,Y),Squares), Row2 is Row1+1, continue_site_v(Squares,Row2,Col,Cs,3,Incr). continue_site_v(Squares,Row,Col,[X|Cs],Acc,Incr) :- memberchk(sq(Row,Col,X),Squares), !, Acc1 is Acc+1, Row1 is Row+1, continue_site_v(Squares,Row1,Col,Cs,Acc1,Incr). continue_site_v(_,_,_,[],Incr,Incr). % -------------------------------------------------------------------------- :- ensure_loaded('p28.pl'). % lsort and lfsort % solve/4 does the optimization of the word and site lists solve(Words,Sites,0,Debug) :- !, % unsorted solve(Words,Sites,Debug). solve(Words,Sites,1,Debug) :- !, % length sorted lsort(Words,Words1,desc), lsort(Sites,Sites1,desc), solve(Words1,Sites1,Debug). solve(Words,Sites,2,Debug) :- % length frequency sorted lfsort(Words,Words1), lfsort(Sites,Sites1), solve(Words1,Sites1,Debug). % solve/3 does the debug_write of the prepared Words and Sites % and then calls solve/2 to do the real work solve(Words,Sites,Debug) :- debug_write(Debug,Words), debug_write(Debug,Sites), solve(Words,Sites). % solve/2 does the real work: find the right site for every word solve([],[]). solve([W|Words],Sites) :- select(W,Sites,SitesR), solve(Words,SitesR). % -------------------------------------------------------------------------- show_result(Squares,MaxRow,MaxCol) :- show_result(Squares,MaxRow,MaxCol,1), nl. show_result(_,MaxRow,_,Row) :- Row > MaxRow, !. show_result(Squares,MaxRow,MaxCol,Row) :- show_result(Squares,MaxRow,MaxCol,Row,1), nl, Row1 is Row+1, show_result(Squares,MaxRow,MaxCol,Row1). show_result(_,_,MaxCol,_,Col) :- Col > MaxCol, !. show_result(Squares,MaxRow,MaxCol,Row,Col) :- (memberchk(sq(Row,Col,X),Squares), !, write(X); write(' ')), Col1 is Col+1, show_result(Squares,MaxRow,MaxCol,Row,Col1). % ------------------------------------------------------------------------- % Benchmark results <8-Oct-2000 14:45 hew> % On a 330 MHz Pentium II the following results have been measured % with SWI-Prolog version 3.3.10 for i686-linux under SuSE Linux 6.3 % ?- time(crossword('p99b.dat',0)). % 439,743,691 inferences in 1975.34 seconds (222617 Lips) % ?- time(crossword('p99b.dat',1)). % 19,644,100 inferences in 76.37 seconds (257223 Lips) % ?- time(crossword('p99b.dat',2)). % 152,880 inferences in 0.94 seconds (162638 Lips)