Ninety-Nine Picat Problems
|
Eight queens problem
This is a classical problem in computer science. The
objective is to place eight queens on a chessboard so that
no two queens are attacking each other; i.e., no two queens
are in the same row, the same column, or on the same
diagonal.
import cp.
queens(N,Qs) =>
Qs = new_array(N),
Qs :: 1..N,
foreach (I in 1..N-1, J in I+1..N)
Qs[I] #!= Qs[J],
abs(Qs[I]-Qs[J]) #!= J-I
end,
solve([ff],Qs).
Another famous problem is this one: How can a knight jump on
an NxN chessboard in such a way that it visits every square
exactly once?
import cp.
knights(N) =>
M is N*N,
Vars = new_list(M),
computeDomain(Vars,1,N),
circuit(Vars),
solve([ffc],Vars),
Vect = to_array(Vars),
output(Vect,1,0,N,M).
computeDomain([],_P,_N) => true.
computeDomain([V|Vs],P,N) =>
encode_pos(Row,Col,P,N),
Dists = jmp_dists(),
Dom = [NextP : (DR,DC) in Dists, Row1 = Row+DR, Col1 = Col+DC,
Row1 >= 1, Row1 =< N, Col1 >= 1, Col1 =< N,
encode_pos(Row1,Col1,NextP,N)],
V :: Dom,
computeDomain(Vs,P+1,N).
jmp_dists() = [(1,2),(2,1),(2,-1),(1,-2),(-1,-2),(-2,-1),(-2,1),(-1,2)].
encode_pos(Row,Col,P,N),integer(P) =>
Row is (P-1)//N+1,
Col is (P-1) mod N+1.
encode_pos(Row,Col,P,N) =>
P is (Row-1)*N+Col.
output(_Vect,_I,Count,_N,M),Count>=M => true.
output(Vect,I,Count,N,M) =>
NI = Vect[I],
output_move(I,NI,N),
Count1 is Count+1,
output(Vect,NI,Count1,N,M).
output_move(P1,P2,N) =>
encode_pos(R1,C1,P1,N),
encode_pos(R2,C2,P2,N),
print($move(R1,C1,R2,C2)),print('. ').
Several years ago I met a mathematician who was intrigued
by a problem for which he didn't know a solution. His name
was Von Koch, and I don't know whether the problem has been
solved since.
Von Koch's Conjecture: Given a tree with N nodes (and hence N-1 edges).
Find a way to enumerate the nodes from 1 to n and, accordingly, the
edges from 1 to N-1 in such a way, that for each edge K the difference
of its node numbers equals to K. The conjecture is that this is always
possible.
import sat.
vonkoch ?=>
graph(Id,Graph),
once vonkoch(Graph,Enum),
printf("%w: ",Id),
println(Enum),
fail.
vonkoch => true.
vonkoch(Graph,Enum) =>
MaxE= len(Graph),
MaxV = MaxE+1,
LabMap = new_map(),
Triples = [{LabV1,LabV2,LabE} : $(V1-V2) in Graph,
LabE :: 1..MaxE,
register(V1,LabV1,LabMap,MaxV),
register(V2,LabV2,LabMap,MaxV),
abs(LabV1-LabV2) #= LabE],
all_distinct([LabE : {_,_,LabE} in Triples]),
all_distinct(LabMap.values()),
solve(Triples),
Enum = LabMap.to_list().
register(V,LabV,LabMap,_MaxV), LabMap.has_key(V) =>
LabV = LabMap.get(V).
register(V,LabV,LabMap,MaxV) =>
LabV :: 1..MaxV,
LabMap.put(V,LabV).
index (-,-)
graph(1,[a-b,b-c,c-d,c-e]).
graph(2,[d-a,a-g,b-c,e-f,b-e,a-b]).
graph(3,[g-a,i-a,a-h,b-a,k-d,c-d,m-q,p-n,q-n,e-q,e-c,f-c,c-a]).
graph(4,[a]).
An arithmetic puzzle
Given a list of integer numbers, find a correct way of
inserting arithmetic signs (operators) such that the result
is a correct equation.
Example:
Picat> test_equation([2,3,5,7,11]).
% equation(L,LT,RT): L is the list of numbers which are the leaves
% in the arithmetic terms LT and RT - from left to right. The
% arithmetic evaluation yields the same result for LT and RT.
equation(L,LT,RT) =>
split(L,LL,RL), % decompose the list L
term(LL,LT), % construct the left term
term(RL,RT), % construct the right term
LT =:= RT. % evaluate and compare the terms
% term(L,T): L is the list of numbers which are the leaves in
% the arithmetic term T - from left to right.
term([X],T) => T = X. % a number is a term in itself
term(L,T) => % general case: binary term
split(L,LL,RL), % decompose the list L
term(LL,LT), % construct the left term
term(RL,RT), % construct the right term
binterm(LT,RT,T). % construct combined binary term
% binterm(LT,RT,T): T is a combined binary term constructed from
% left-hand term LT and right-hand term RT
binterm(LT,RT,T) ?=> T = $(LT+RT).
binterm(LT,RT,T) ?=> T = $(LT-RT).
binterm(LT,RT,T) ?=> T = $(LT*RT).
binterm(LT,RT,T), RT !== 0 => T = $(LT/RT).
% split(L,L1,L2): split the list L into non-empty parts L1 and L2
% such that their concatenation is L
split(L,L1,L2) => append(L1,L2,L), L1 = [_|_], L2 = [_|_].
% test_equation(L): find all solutions to the problem as given by the list of
% numbers L, and print them out, one solution per line.
test_equation(L) =>
equation(L,LT,RT),
printf("%w = %w\n",LT,RT),
fail.
test_equation(_L) => true.
English number words
On financial documents, like cheques, numbers must
sometimes be written in full words. Example: 175 must be
written as one-seven-five. Write a predicate full_words/1
to print (non-negative) integer numbers in full words.
% full_words(N): print the number N in full words (English)
% (non-negative integer) (+)
full_words(N) =>
Str = N.to_string(),
Words = [numberword(Digit) : Digit in Str],
append(Words0,[LastWord],Words),
foreach(Word in Words0)
write(Word), write('-')
end,
write(LastWord).
index(+,-)
numberword('0') = zero.
numberword('1') = one.
numberword('2') = two.
numberword('3') = three.
numberword('4') = four.
numberword('5') = five.
numberword('6') = six.
numberword('7') = seven.
numberword('8') = eight.
numberword('9') = nine.
Sudoku
Every spot in the puzzle belongs to a (horizontal) row and
a (vertical) column, as well as to one single 3x3 square
(which we call "square" for short). At the beginning, some
of the spots carry a single-digit number between 1 and 9.
The problem is to fill the missing spots with digits in
such a way that every number between 1 and 9 appears
exactly once in each row, in each column, and in each square.
import cp.
% sudoku(Puzzle): solve the given Sudoku puzzle and print the
% problem statement as well as the solution to the standard output
% (list-of-integers, partially instantiated)
sudoku(Puzzle) ?=>
printPuzzle(Puzzle), nl,
Board = new_array(9,9),
fillBoard(Puzzle,Board,1),
N = 9, M = 3,
Board :: 1..N,
foreach (Row in Board) all_distinct(Row) end,
foreach (J in 1..N)
all_distinct([Board[I,J] : I in 1..N])
end,
M = round(sqrt(N)),
foreach (I in 1..M..N-M, J in 1..M..N-M)
all_distinct([Board[I+K,J+L] : K in 0..M-1, L in 0..M-1])
end,
solve(Board),
printPuzzle(Puzzle),
fail.
sudoku(_) => true.
fillBoard([],_Board,_Row) => true.
fillBoard([P1,P2,P3,P4,P5,P6,P7,P8,P9|Puzzle],Board,Row) =>
Board[Row] = {P1,P2,P3,P4,P5,P6,P7,P8,P9},
fillBoard(Puzzle,Board,Row+1).
printPuzzle([]) => true.
printPuzzle(Xs) => nl,
printBand(Xs,Xs1),
print('--------+---------+--------'), nl,
printBand(Xs1,Xs2),
print('--------+---------+--------'), nl,
printBand(Xs2,_).
printBand(Xs,Xs3) =>
printRow(Xs,Xs1), nl,
print(' | |'), nl,
printRow(Xs1,Xs2), nl,
print(' | |'), nl,
printRow(Xs2,Xs3), nl.
printRow(Xs,Xs3) =>
printTriplet(Xs,Xs1), print(' | '),
printTriplet(Xs1,Xs2), print(' | '),
printTriplet(Xs2,Xs3).
printTriplet(Xs,Xs3) =>
printElement(Xs,Xs1), print(' '),
printElement(Xs1,Xs2), print(' '),
printElement(Xs2,Xs3).
printElement([X|Xs],XsR), var(X) => print('.'), XsR = Xs.
printElement([X|Xs],XsR) => print(X), XsR = Xs.
printCounter(0) => print('No solution'), nl.
printCounter(1) => print('1 solution'), nl.
printCounter(K) => print(K), print(' solutions'), nl.
% ---------------------------------------------------------
test_sudoku(N) => puzzle(N,P), sudoku(P).
puzzle(1,P) =>
P = [_,_,4,8,_,_,_,1,7, 6,7,_,9,_,_,_,_,_, 5,_,8,_,3,_,_,_,4,
3,_,_,7,4,_,1,_,_, _,6,9,_,_,_,7,8,_, _,_,1,_,6,9,_,_,5,
1,_,_,_,8,_,3,_,6, _,_,_,_,_,6,_,9,1, 2,4,_,_,_,1,5,_,_].
puzzle(2,P) =>
P = [3,_,_,_,7,1,_,_,_, _,5,_,_,_,_,1,8,_, _,4,_,8,_,_,_,_,_,
_,_,6,2,_,_,3,_,_, _,_,1,_,5,_,8,_,_, _,_,3,_,_,8,2,_,_,
_,_,_,_,_,3,_,4,_, _,6,4,_,_,_,_,7,_, _,_,_,9,6,_,_,_,1].
puzzle(3,P) =>
P = [1,7,_,_,_,9,_,_,4, _,_,_,_,_,_,7,_,_, 5,_,_,3,_,_,2,_,_,
_,8,_,_,_,_,5,3,6, _,_,_,_,8,_,_,_,_, 6,9,1,_,_,_,_,8,_,
_,_,7,_,_,4,_,_,2, _,_,2,_,_,_,_,_,_, 3,_,_,5,_,_,_,7,1].
% an example with many solutions
puzzle(4,P) =>
P = [1,_,_,_,_,9,_,_,4, _,_,_,_,_,_,7,_,_, 5,_,_,3,_,_,2,_,_,
_,8,_,_,_,_,5,_,6, _,_,_,_,8,_,_,_,_, 6,9,1,_,_,_,_,8,_,
_,_,7,_,_,4,_,_,2, _,_,2,_,_,_,_,_,_, 3,_,_,5,_,_,_,7,1].
puzzle(5,P) =>
P = [_,6,5,_,_,_,7,2,_, 3,_,7,_,_,_,1,_,8, 2,9,_,_,1,_,_,3,4,
_,_,_,5,_,7,_,_,_, _,_,1,_,_,_,8,_,_, _,_,_,2,_,1,_,_,_,
8,1,_,_,2,_,_,5,7, 7,_,2,_,_,_,9,_,1, _,5,4,_,_,_,6,8,_].
puzzle(6,P) =>
P = [5,_,2,_,_,3,_,_,_, 4,6,_,_,7,_,9,_,_, _,_,3,4,_,_,_,_,_,
9,5,_,_,6,_,_,_,_, _,4,_,_,_,_,_,9,_, _,_,_,_,9,_,_,1,7,
_,_,_,_,_,7,2,_,_, _,_,9,_,4,_,_,3,5, _,_,_,3,_,_,7,_,6].
% an example with an error in the problem statement (5 appears
% twice in the top left square)
puzzle(e1,P) =>
P = [5,_,2,_,_,3,_,_,_, 4,6,5,_,7,_,9,_,_, _,_,3,4,_,_,_,_,_,
9,5,_,_,6,_,_,_,_, _,4,_,_,_,_,_,9,_, _,_,_,_,9,_,_,1,7,
_,_,_,_,_,7,2,_,_, _,_,9,_,4,_,_,3,5, _,_,_,3,_,_,7,_,6].
% another example with an error in the problem statement (garbage
% in the first row
puzzle(e2,P) =>
P = [x,_,2,_,_,3,_,_,_, 4,6,_,_,7,_,9,_,_, _,_,3,4,_,_,_,_,_,
9,5,_,_,6,_,_,_,_, _,4,_,_,_,_,_,9,_, _,_,_,_,9,_,_,1,7,
_,_,_,_,_,7,2,_,_, _,_,9,_,4,_,_,3,5, _,_,_,3,_,_,7,_,6].
% some more examples from the Sonntagszeitung
puzzle(8,P) =>
P = [4,8,_,_,7,_,_,_,_, _,_,9,6,8,_,3,_,7, 3,_,7,4,_,_,_,5,_,
_,_,_,3,_,_,_,2,_, 9,5,_,7,2,1,_,6,8, _,1,_,_,_,4,_,_,_,
_,4,_,_,_,2,7,_,1, 8,_,2,_,4,7,5,_,_, _,_,_,_,5,_,_,8,4].
puzzle(9,P) =>
P = [_,1,_,_,_,_,_,2,4, 5,_,_,_,4,_,_,8,6, 6,_,4,1,_,_,_,_,_,
_,_,_,8,_,6,9,_,_, 8,_,_,_,_,_,_,_,2, _,_,6,4,_,3,_,_,_,
_,_,_,_,_,7,2,_,8, 1,6,_,_,9,_,_,_,5, 7,4,_,_,_,_,_,9,_].
puzzle(10,P) =>
P = [_,9,7,_,_,5,_,_,4, _,_,_,_,_,9,_,_,_, _,_,5,_,4,_,2,_,7,
_,8,6,_,_,3,_,_,_, _,_,_,_,2,_,_,_,_, _,_,_,5,_,_,3,4,_,
5,_,3,_,7,_,6,_,_, _,_,_,6,_,_,_,_,_, 9,_,_,8,_,_,1,7,_].
% a puzzle rated "not fun" by
% http://dingo.sbs.arizona.edu/~sandiway/sudoku/examples.html
puzzle(11,P) =>
P = [_,2,_,_,_,_,_,_,_, _,_,_,6,_,_,_,_,3, _,7,4,_,8,_,_,_,_,
_,_,_,_,_,3,_,_,2, _,8,_,_,4,_,_,1,_, 6,_,_,5,_,_,_,_,_,
_,_,_,_,1,_,7,8,_, 5,_,_,_,_,9,_,_,_, _,_,_,_,_,_,_,4,_].
% a "super hard puzzle" by
% http://www.menneske.no/sudoku/eng/showpuzzle.html?number=2155141
puzzle(12,P) =>
P = [_,_,_,6,_,_,4,_,_, 7,_,_,_,_,3,6,_,_, _,_,_,_,9,1,_,8,_,
_,_,_,_,_,_,_,_,_, _,5,_,1,8,_,_,_,3, _,_,_,3,_,6,_,4,5,
_,4,_,2,_,_,_,6,_, 9,_,3,_,_,_,_,_,_, _,2,_,_,_,_,1,_,_].
% some puzzles from Spektrum der Wissenschaft 3/2006, p.100
% leicht
puzzle(13,P) =>
P = [_,2,6,4,5,8,3,_,_, 1,7,_,_,_,_,_,4,_, _,8,_,_,_,_,_,_,_,
_,_,_,_,_,_,9,8,_, _,_,_,5,9,_,1,_,4, 7,_,_,2,_,1,_,5,_,
_,_,_,_,4,_,_,3,_, _,_,_,8,_,_,5,_,_, 6,_,_,_,_,7,_,9,1].
% mittel
puzzle(14,P) =>
P = [9,_,_,6,3,_,_,_,4, _,1,_,2,5,8,_,_,_, _,_,_,7,_,_,_,_,8,
6,4,_,_,2,_,5,_,_, _,_,_,_,_,_,_,_,_, 8,2,_,5,_,_,_,9,_,
_,_,_,_,_,_,8,7,_, 3,_,_,_,_,5,_,4,_, _,_,1,_,7,6,_,_,_].
% schwer
puzzle(15,P) =>
P = [_,_,_,_,_,_,_,_,7, _,_,_,_,_,_,6,3,4, _,_,_,9,4,_,_,2,_,
5,_,1,7,_,_,8,6,_, _,_,9,_,_,_,_,_,3, _,_,_,_,8,_,_,_,_,
4,3,_,5,_,_,_,_,_, _,1,_,_,6,8,_,_,_, _,_,_,_,_,3,1,_,9].
% hoellisch (!)
puzzle(16,P) =>
P = [_,_,_,_,3,_,_,_,_, _,1,5,_,_,_,6,_,_, 6,_,_,2,_,_,3,4,_,
_,_,_,6,_,_,_,8,_, _,3,9,_,_,_,5,_,_, 5,_,_,_,_,_,9,_,2,
_,_,_,_,_,_,_,_,_, _,_,_,9,7,_,2,5,_, 1,_,_,_,5,_,_,7,_].
% Spektrum der Wissenschaft 3/2006 Preisraetsel (angeblich hoellisch !)
puzzle(17,P) =>
P = [_,1,_,_,6,5,4,_,_, _,_,_,_,8,4,1,_,_, 4,_,_,_,_,_,_,7,_,
_,5,_,1,9,_,_,_,_, _,_,3,_,_,_,7,_,_, _,_,_,_,3,7,_,5,_,
_,8,_,_,_,_,_,_,3, _,_,2,6,5,_,_,_,_, _,_,9,8,1,_,_,2,_].
% the (almost) empty grid
puzzle(99,P) =>
P = [1,2,3,4,5,6,7,8,9, _,_,_,_,_,_,_,_,_, _,_,_,_,_,_,_,_,_,
_,_,_,_,_,_,_,_,_, _,_,_,_,_,_,_,_,_, _,_,_,_,_,_,_,_,_,
_,_,_,_,_,_,_,_,_, _,_,_,_,_,_,_,_,_, _,_,_,_,_,_,_,_,_].
Nonograms
The puzzle goes like this: Essentially, each row and column
of a rectangular bitmap is annotated with the respective
lengths of its distinct strings of occupied cells. The
person who solves the puzzle must complete the bitmap given
only these lengths.
import sat.
% nonogram(RowNums,ColNums,Solution): given the specifications for
% the rows and columns in RowNums and ColNums, respectively, the puzzle
% is solved by Solution, which is a row-by-row representation of
% the filled puzzle grid.
nonogram(RowNums,ColNums,Solution) =>
NRows = length(RowNums),
NCols = length(ColNums),
Board = new_array(NRows,NCols),
Board :: 0..1,
foreach (R in 1..NRows)
sum([Board[R,C] : C in 1..NCols]) #= sum(RowNums[R])
end,
foreach (C in 1..NCols)
sum([Board[R,C] : R in 1..NRows]) #= sum(ColNums[C])
end,
foreach (R in 1..NRows)
RowRects = [{RecStart,RecEnd,RowNums[R,Rect]} : Rect in 1..len(RowNums[R])],
constrain_rects(RowRects,Board[R])
end,
foreach (C in 1..NCols)
Col = [Board[R,C] : R in 1..NRows],
ColRects = [{RecStart,RecEnd,ColNums[C,Rect]} : Rect in 1..len(ColNums[C])],
constrain_rects(ColRects,Col)
end,
once solve(Board),
Solution = [Board[R].to_list() : R in 1..NRows].
constrain_rects([],_) => true.
constrain_rects([{RecStart,RecEnd,RectLen}|Rects],Row) =>
Max = len(Row),
[RecStart,RecEnd] :: 1..Max,
RecEnd-RecStart + 1 #= RectLen,
foreach (C in 1..len(Row))
C #>= RecStart #/\ C #=< RecEnd #=> Row[C]
end,
if Rects = [{RecStart2,_,_}|_] then
RecEnd+1 #< RecStart2
end,
constrain_rects(Rects,Row).
% Printing the solution ----------------------------------------------------
print_nonogram([],ColNums,[]) => print_colnums(ColNums).
print_nonogram([RowNums1|RowNums],ColNums,[Row1|Rows]) =>
print_row(Row1),
print_rownums(RowNums1),
print_nonogram(RowNums,ColNums,Rows).
print_row([]) => print(' ').
print_row([X|Xs]) => print_replace(X,Y), print(' '), print(Y), print_row(Xs).
index (+,-)
print_replace(0,' ').
print_replace(1,'*').
print_rownums([]) => nl.
print_rownums([N|Ns]) => print(N), print(' '), print_rownums(Ns).
print_colnums(ColNums) =>
M = max([len(ColNum) : ColNum in ColNums]),
print_colnums(ColNums,ColNums,1,M).
print_colnums(_,[],M,M) => nl.
print_colnums(ColNums,[],K,M), K < M =>
nl,
K1 is K+1, print_colnums(ColNums,ColNums,K1,M).
print_colnums(ColNums,[Col1|Cols],K,M), K =< M =>
print_kth(K,Col1), print_colnums(ColNums,Cols,K,M).
print_kth(K,List),K <= len(List) => printf("%2d",List[K]).
print_kth(_,_) => print(' ').
% --------------------------------------------------------------------------
% Test with some "real" puzzles from the Sunday Telegraph:
test_nono(Name) =>
specimen_nonogram(Name,Rs,Cs),
nonogram(Rs,Cs,Solution), nl,
writeln(Solution),
print_nonogram(Rs,Cs,Solution).
% Results for the nonogram 'Hen':
% ?- time(test('Hen',0)). - without optimization
% 16,803,498 inferences in 39.30 seconds (427570 Lips)
% ?- time(test('Hen',1)). - with optimization
% 5,428 inferences in 0.02 seconds (271400 Lips)
% specimen_nonogram( Title, Rows, Cols):
% NB Rows, Cols and the "solid" lengths are enlisted
% top-to-bottom or left-to-right as appropriate
index (-,-,-)
specimen_nonogram(
'Hen',
[[3], [2,1], [3,2], [2,2], [6], [1,5], [6], [1], [2]],
[[1,2], [3,1], [1,5], [7,1], [5], [3], [4], [3]]
).
specimen_nonogram(
'Jack & The Beanstalk',
[[3,1], [2,4,1], [1,3,3], [2,4], [3,3,1,3], [3,2,2,1,3],
[2,2,2,2,2], [2,1,1,2,1,1], [1,2,1,4], [1,1,2,2], [2,2,8],
[2,2,2,4], [1,2,2,1,1,1], [3,3,5,1], [1,1,3,1,1,2],
[2,3,1,3,3], [1,3,2,8], [4,3,8], [1,4,2,5], [1,4,2,2],
[4,2,5], [5,3,5], [4,1,1], [4,2], [3,3]],
[[2,3], [3,1,3], [3,2,1,2], [2,4,4], [3,4,2,4,5], [2,5,2,4,6],
[1,4,3,4,6,1], [4,3,3,6,2], [4,2,3,6,3], [1,2,4,2,1], [2,2,6],
[1,1,6], [2,1,4,2], [4,2,6], [1,1,1,1,4], [2,4,7], [3,5,6],
[3,2,4,2], [2,2,2], [6,3]]
).
specimen_nonogram(
'WATER BUFFALO',
[[5], [2,3,2], [2,5,1], [2,8], [2,5,11], [1,1,2,1,6], [1,2,1,3],
[2,1,1], [2,6,2], [15,4], [10,8], [2,1,4,3,6], [17], [17],
[18], [1,14], [1,1,14], [5,9], [8], [7]],
[[5], [3,2], [2,1,2], [1,1,1], [1,1,1], [1,3], [2,2], [1,3,3],
[1,3,3,1], [1,7,2], [1,9,1], [1,10], [1,10], [1,3,5], [1,8],
[2,1,6], [3,1,7], [4,1,7], [6,1,8], [6,10], [7,10], [1,4,11],
[1,2,11], [2,12], [3,13]]
).
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.
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.
Words are strings (character lists) of at least two characters.
A horizontal or vertical sequence of character places in the
crossword puzzle framework is called a site. Our problem is to
find a compatible way of placing words onto sites.
import cp, util.
crossword(File) =>
Lines = read_file_lines(File).strip([""]), % strip of empty lines at the ends
once append(WLines,[""|FLines],Lines), % separate word and framework lines
Words = [WLine.to_codes().to_array() : WLine in WLines], % "LINUX" becomes {76,73,78,85,88}
WordLens = [len(Word) : Word in Words].sort_remove_dups(),
WordTable = new_map(),
foreach (Len in WordLens)
WordsOfLen = [Word : Word in Words, len(Word) == Len],
WordTable.put(Len,WordsOfLen)
end,
%
NRows = len(FLines),
NCols = max([len(FLine) : FLine in FLines]),
Framework = new_array(NRows,NCols),
foreach ({Row,FLine} in zip(1..NRows,FLines))
fill_framework(FLine,Row,1,Framework)
end,
%
vars(Framework) :: ord('A')..ord('Z'),
%
foreach (R in 1..NRows)
constrain_h_sites(R,1,NCols,Framework,WordTable)
end,
foreach (C in 1..NCols)
constrain_v_sites(C,1,NRows,Framework,WordTable)
end,
println('solving...'),
solve(Framework),
%
foreach (R in 1..NRows)
foreach (C in 1..NCols)
print(cond(Framework[R,C] == 0, ' ', chr(Framework[R,C])))
end,
nl
end.
fill_framework([],R,C,Framework) =>
foreach (I in C..Framework[1].len)
Framework[R,I] = 0
end.
fill_framework([Char|Line],R,C,Framework) =>
(Char == ' ' -> Framework[R,C] = 0; true),
fill_framework(Line,R,C+1,Framework).
constrain_h_sites(_R,C,NCols,_Framework,_WordTable), C >= NCols => true.
constrain_h_sites(R,C,NCols,Framework,WordTable), Framework[R,C] !== 0, Framework[R,C+1] !== 0 =>
ToC = C+2,
while (ToC =< NCols && Framework[R,ToC] !==0)
ToC := ToC+1
end,
Len = ToC-C,
VarWord = {Framework[R,I] : I in C..ToC-1},
table_in(VarWord, WordTable.get(Len)),
constrain_h_sites(R,ToC,NCols,Framework,WordTable).
constrain_h_sites(R,C,NCols,Framework,WordTable) =>
constrain_h_sites(R,C+1,NCols,Framework,WordTable).
constrain_v_sites(_C,R,NRows,_Framework,_WordTable), R >= NRows => true.
constrain_v_sites(C,R,NRows,Framework,WordTable), Framework[R,C] !== 0, Framework[R+1,C] !== 0 =>
ToR = R+2,
while (ToR =< NRows && Framework[ToR,C] !== 0)
ToR := ToR+1
end,
Len = ToR-R,
VarWord = {Framework[I,C] : I in R..ToR-1},
table_in(VarWord, WordTable.get(Len)),
constrain_v_sites(C,ToR,NRows,Framework,WordTable).
constrain_v_sites(C,R,NRows,Framework,WordTable) =>
constrain_v_sites(C,R+1,NRows,Framework,WordTable).
/*
% p7_09a.dat
LINUX
PROLOG
PERL
ONLINE
GNU
XML
NFS
SQL
EMACS
WEB
MAC
...... .
. . . .
. ..... .
. . . ...
. ... .
...
% p7_09b.dat
AAL
DER
TAL
TAT
ISEL
TELL
ZANK
ZEUS
ALSEN
BLASE
EOSIN
ETTAL
KARRE
LIANE
NEEFS
NONNE
OSTEN
STUHL
TIARA
ANKARA
EGERIA
GRANAT
HIRTEN
MISERE
SAMPAN
TILSIT
WAGGON
FORTUNA
ITALIEN
MADONNA
MELASSE
REAUMUR
RIVIERA
SEKUNDE
SERBIEN
SKELETT
SKRUPEL
STETTIN
STOIKER
HANNIBAL
REGISTER
RELIGION
STANNIOL
TRUEFFEL
UNTERTAN
USAMBARA
VENDETTA
TUEBINGEN
TURKMENEN
ALLENSTEIN
ATTRAKTION
BRIEFTAUBE
TATTERSALL
PROTEKTORAT
TEMPERAMENT
KRANKENKASSE
CHRONOGRAPHIE
TRAUBENZUCKER
WALZER
. ......... .............
. . . . . .
. ........... ....... .
. . . . . .
...... .... . ...... . .
. . . . . . .
. . ...... ..... .......
. . . . ... . . .
........ . . . .....
. . . . . . . . .
. . . ....... . .
...... . . . .....
. . . . . .
. ......... ........ .
. . . . . . . .
.... . . . ....... . .
. . . . . . . ... .
. . . . . .......... . .
..... . . . . . . .
. . . ... . . . .
. .......... . . . . .
. . . . . . . .
..... ........ ....... .
. . . . . .
........ ....... .....
% p7_09c.dat (no solution)
AAL
DER
TAL
TAT
ISEL
TELL
ZANK
ZEUS
ALSEN
BLASE
EOSIN
ETTAL
KARREN
LIANE
NEEFS
NONNE
OSTEN
STUHL
TIARA
ANKARA
EGERIA
GRANAT
HIRTEN
MISERE
SAMPAN
TILSIT
WAGGON
FORTUNA
ITALIEN
MADONNA
MELASSE
REAUMUR
RIVIERA
SEKUNDE
SERBIEN
SKELETT
SKRUPEL
STETTIN
STOIKER
HANNIBAL
REGISTER
RELIGION
STANNIOL
TRUEFFEL
UNTERTAN
USAMBARA
VENDETTA
TUEBINGEN
TURKMENEN
ALLENSTEIN
ATTRAKTION
BRIEFTAUBE
TATTERSALL
PROTEKTORAT
TEMPERAMENT
KRANKENKASSE
CHRONOGRAPHIE
TRAUBENZUCKER
WALZER
. ......... .............
. . . . . .
. ........... ....... .
. . . . . .
...... .... . ...... . .
. . . . . . .
. . ...... ..... .......
. . . . ... . . .
........ . . . .....
. . . . . . . . .
. . . ....... . .
...... . . . .....
. . . . . .
. ......... ........ .
. . . . . . . .
.... . . . ....... . .
. . . . . . . ... .
. . . . . .......... . .
..... . . . . . . .
. . . ... . . . .
. .......... . . . . .
. . . . . . . .
..... ........ ....... .
. . . . . .
........ ....... .....
% p7_09d.dat
BANI
HAUS
NETZ
LENA
ANKER
ARIEL
GASSE
INNEN
ORADE
SESAM
SIGEL
ANGOLA
AZETAT
EKARTE
NATTER
NENNER
NESSEL
RITTER
SOMMER
TAUNUS
TRANIG
AGENTUR
ERRATEN
ERREGER
GELEISE
HAENDEL
KAROSSE
MANAGER
OSTEREI
SIDERIT
TERRIER
ANATOMIE
ANPASSEN
BARKASSE
BEDANKEN
DEKADENT
EINLADEN
ERLASSEN
FRAGMENT
GARANTIE
KRAWATTE
MEISTERN
REAKTION
TENTAKEL
TRIANGEL
UEBERALL
VERGEBEN
AFRIKANER
BESTELLEN
BULLAUGEN
SANTANDER
VERBERGEN
ALLENSTEIN
AUSTRALIEN
BETEILIGEN
NATALITAET
OBERHAUSEN
UNTERSTAND
LEUMUND
........ ........ .......
. . . . . . .
. . . .......... . . .
....... . . . ........
. . . . . . . . . . . .
. . . . ...... . . . .
. . . . . ........ .
. . ...... . . . . . . .
. . . . . . . . .
...... ...... . . ......
. . . . . . . . .
....... . . . ....... .
. . . . . .
. . ....... ........ .
. . . . . .
...... . ....... ........
. . . . . . .
. . ......... . . .
. . . . . . . .....
. . ....... . . .
.......... . . . .
. . . . ......... .
. ......... . . . .
. . . . . . .
........ ......... .....
*/