# 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.