Cheating Linguists
- Constrained Permutations in Prolog
Problem posted to comp.lang.prolog by Daniel Dudley
Problem Statement
A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font):
figure( [ " X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X " ] ).The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners.
A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean.
Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same?
Note
“Several solutions” doesn't really cover it! Assuming that by ‘a solution’ we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 238,878,719 other members of its solution “family” through:
- candidate permutation: There are (4!)5 permutations of the candidates within the cells allocated to their subjects;
- subject permutation: we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells;
- These are divided by the (4) degrees of rotational symmetry.
This means that the total number of solutions is 238878720 × D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation.
Finding D is the more interesting problem solved by this program.
nut1( ?Solutions )
Solutions is the number of distinct solutions to the subject/cell allocation problem for any five different subjects.
nut1( Solutions ) :-
Norwegian = 1,
German = 2,
English = 3,
French = 4,
Spanish = 5,
candidates( [Norwegian,German,English,French,Spanish], Candidates ),
cells( Cells ),
count_solutions( allocate(Cells,Candidates), Solutions ).
allocate( +Cells, +Candidates )
holds when each cell in Cells holds a candidate from Candidates.
allocate( Cells, Candidates ) :-
allocation( Cells, 1, Candidates ).
allocation( +Cells, +NextSubject, +Subjects )
holds when Cells is a representation of a distinct solution to the subject/cell allocation problem. NextSubject is the highest subject that can be allocated next, while Subjects is the list of subjects needing allocation to Cells.
Each subject is represented by a list, in which each occurrence of the subject number represents a candidate.
We guarantee distinct solutions by ensuring that the allocation is made on the following basis:
- For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations.
- The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject – to eliminate subject permutations.
Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it.
allocation( [], _Next, [] ).
allocation( [Cell|Cells], Next, Subjects ) :-
allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ),
cell( Candidate, Cell ),
adjacent_successors( Cell, AdjacentSuccessors ),
blocked( AdjacentSuccessors, Candidate ),
allocation( Cells, Next1, Subjects1 ).
allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )
holds when Candidate is taken from Subjects leaving Subjects1. Candidate is represented by a subject number ≤ Next. Next1 is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order.
allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :-
Subject = [Candidate|Candidates],
Candidate =< Next,
Next1 is max(Candidate+1,Next),
residual_candidates( Candidates, Subjects, Subjects1 ).
allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :-
Subject = [Candidate0|_Candidates],
Candidate0 < Next,
allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ).
residual_candidates( [], Subjects, Subjects ).
residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :-
Candidates = [_|_].
cells( ?Layout )
holds when Layout is a list of cells ordered by their row × column coordinates.
Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it.
cells( Layout ) :-
findall( location_cell(Row,Column,_Cell), location(Row, Column), Cells ),
sort( Cells, Ordered ),
cells1( Ordered, Layout ).
cells1( [], [] ).
cells1( [location_cell(Row,Column,Cell)|Successors], [Cell|Matrix] ) :-
adjacent_successors( Cell, AdjacentSuccessors ),
cells2( Successors, Row, Column, AdjacentSuccessors ),
cells1( Successors, Matrix ).
cells2( [], _Row, _Column, [] ).
cells2( [location_cell(Row1,Column1,Cell)|Layout], Row, Column, Adjacent ) :-
( adjacent( Row, Row1 ),
adjacent( Column, Column1 ) ->
Adjacent = [Cell|Adjacent1]
; otherwise ->
Adjacent = Adjacent1
),
cells2( Layout, Row, Column, Adjacent1 ).
location( ?Row, ?Column )
holds when Row and Column are the (unary) row and column offsets of
an "X" in figure/1.
location( Row, Column ) :-
X is "X",
figure( Drawing ),
offset( Cells, Drawing, Row ),
offset( X, Cells, Column ).
cell( ?Subject, ?Cell )
holds when Cell is the cell representation for Subject.
cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).
block( ?Subject, ?Block )
holds when Block is a cell representation that is incompatible with Subject.
block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).
adjacent_successors( ?Cell, ?AdjacentSuccesors )
holds when AdjacentSuccesors is the set of successors of Cell that are adjacent to it.
adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).
blocked( +Blocked, ?Subject )
holds when all the cells in Blocked are incompatible with Subject.
blocked( [], _Subject ).
blocked( [Cell|Blocked], Subject ) :-
block( Subject, Cell ),
blocked( Blocked, Subject ).
candidates( ?Subjects, ?Candidates )
holds when there are 4 Candidates for each subject in Subjects.
candidates( [], [] ).
candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :-
candidates( Subjects, Candidates ).
offset( +Element, +List, ?Offset )
When Element has unary Offset from the head of List.
offset( Element, List, Position ) :-
offset1( List, Element, 0, Position ).
offset1( [Element|_Rest], Element, N, N ).
offset1( [_Head|List], Element, N0, N ):-
offset1( List, Element, s(N0), N ).
adjacent( +Coordinate0, ?Coordinate1 )
holds when Coordinate0 and Coordinate1 are the same or differ by 1.
adjacent( N, N ). adjacent( N, s(N) ). adjacent( s(N), N ).
Load a small library of Puzzle Utilities.
:- ensure_loaded( misc ).
The code is available as plain text here.
Result
This program reports 29870 solutions.