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):
        X
        X X X X X
        X X X X
        X X X X
      X X X X X
              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 find 955,514,879 other members of its solution "family" quite easily, through:

candidate permutation: There are (4!)⁵ 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.

This means that the total number of solutions is 955514880 × 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.

<syntaxhighlight lang="prolog">nut1( Solutions ) :-

   Norwegian = 1,
   German    = 2,
   English   = 3,
   French    = 4,
   Spanish   = 5,
   candidates( [Norwegian,German,English,French,Spanish], Candidates ),
   matrix( Cells ),
   findall( x, % We don't care about the actual solution
       allocate(Cells, Candidates),
       Allocations
       ),
   length( Allocations, Solutions ).</syntaxhighlight>

allocate( +Cells, +Candidates )

holds when each cell in Cells holds a candidate from Candidates.

<syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :-

   allocation( Cells, 1, Candidates ).</syntaxhighlight>

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 all the cell's adjacent successors to have different subject(s) from it.

<syntaxhighlight lang="prolog">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 ).</syntaxhighlight>

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.

<syntaxhighlight lang="prolog">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 = [_|_].</syntaxhighlight>

matrix( ?Matrix )

holds when Matrix is a list of 'cells' ordered by their (x,y) 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.

<syntaxhighlight lang="prolog">matrix( Matrix ) :-

   layout( Layout ),
   matrix1( Layout, _Index, Matrix ).

matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :-

   location_cell( Row, Column, Index, Cell ),
   findall(
       (Row1, Column1),
       (   successor( (Row, Column), (Row1, Column1) ),
           adjacent(Row, Row1),
           adjacent(Column, Column1)
       ),
       AdjacentSuccessorLocations
   ),
   location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ),
   adjacent_successors( Cell, AdjacentSuccessors ),
   matrix1( Layout, Index, Matrix ).</syntaxhighlight>

cell( ?Subject, ?Cell )

holds when Cell is the cell representation for Subject.

block( ?Subject, ?Block )

holds when Block is a cell representation that is incompatible with Subject.

<syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight>

adjacent_successors( ?Cell, ?AdjacentSuccesors )

holds when AdjacentSuccesors is the set of successors of Cell that are adjacent to it.

<syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight>

blocked( +Blocked, ?Subject )

holds when all the cells in Blocked are incompatible with Subject.

<syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :-

   block( Subject, Cell ),
   blocked( Blocked, Subject ).</syntaxhighlight>

adjacent( +Coordinate0, ?Coordinate1 )

holds when Coordinate0 and Coordinate1 are the same or differ by 1.

<syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :-

   N1 is N0 + 1.

adjacent( N0, N1 ) :-

   N1 is N0 - 1.</syntaxhighlight>

location_cells( ?Locations, ?Index, ?Cells )

holds when Index is a 6 × 6 array, Locations is a list of (Row,Column) pairs and Cells is the list of matching cells dereferenced from Index.

<syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :-

   location_cell( Row, Column, Index, Cell ),
   location_cells( Locs, Index, Cells ).</syntaxhighlight>

location_cell( ?Row, ?Column, ?Index, ?Cell )

holds when Index is a 6 × 6 array with Cell at location (Row,Column).

<syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :-

   select_nth( Row, Index, IndexRow ),
   select_nth( Column, IndexRow, Cell ).</syntaxhighlight>

select_nth( ?N, ?Array, ?Element )

holds when Element is the Nth element of Array.

<syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight>

successor( ?Coordinates0, ?Coordinates1 )

holds when Coordinates0 and Coordinates1 are valid cell positions and Coordinates0 <Coordinates1.

<syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :-

   layout( Layout ),
   append( _Prefix, [Coordinates0|Successors], Layout ),
   member( Coordinates1, Successors ).</syntaxhighlight>

candidates( ?Subjects, ?Candidates )

holds when there are 4 Candidates for each subject in Subjects.

<syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :-

   candidates( Subjects, Candidates ).</syntaxhighlight>

layout( ?Layout )

holds when Layout is the sequence of all (x,y) co-ordinates of valid 'cells'.

<syntaxhighlight lang="prolog">layout( [

      (1,2),
      (2,2),(2,3),(2,4),(2,5),(2,6),
      (3,2),(3,3),(3,4),(3,5),
      (4,2),(4,3),(4,4),(4,5),
(5,1),(5,2),(5,3),(5,4),(5,5),
                        (6,5)
       ] ).</syntaxhighlight>

Load a small library of puzzle utilities.

<syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight>

The code is available as plain text here.

Result

This program reports 29870 solutions.