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:

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.

nut1( Solutions ) :-
    matrix( Allocation ),
    findall(
        alloc, % Don't store distinct solutions
        allocation( Allocation ),
        Allocations
        ),
    length( Allocations, Solutions ).

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:

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.

allocation( [], _Next, [] ).
allocation( [Cell|Cells], Next, Subjects ) :-
    candidate( Subjects, Next, Candidate, Subjects1, Next1 ),
    cell( Candidate, Cell ),
    forbidden( Cell, Forbidden ),
    blocked( Forbidden, Candidate ),
    allocation( Cells, Next1, Subjects1 ).

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.

candidate( [[Candidate|Candidates]|Subjects], Next, Candidate, Subjects1, Next1 ) :-
    Candidate =< Next,
    Next1 is max(Candidate+1,Next),
    residual_candidates( Candidates, Subjects, Subjects1 ).
candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :-
    Subject = [Candidate0|_Candidates],
    Candidate0 < Next,
    candidate( Subjects, Next, Candidate, Subjects1, Next1 ).

residual_candidates( [], Subjects, Subjects ).
residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :-
    Candidates = [_|_].

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 a set of 'forbidden' locations: those successors of the cell that are adjacent to it.

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)
        ),
        ForbiddenLocations
    ),
    location_cells( ForbiddenLocations, Index, Forbidden ),
    forbidden( Cell, Forbidden ),
    matrix1( Layout, Index, Matrix ).

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,_) ).

forbidden( ?Cell, ?Forbidden ) holds when Forbidden is the set of successors of Cell which are adjacent to it.

forbidden( cell(_,_,_,_,_,Forbidden), Forbidden ).

blocked( +Forbidden, ?Subject ) holds when all the cells in Forbidden are incompatible with Subject.

blocked( [], _Subject ).
blocked( [Cell|Forbidden], Subject ) :-
    block( Subject, Cell ),
    blocked( Forbidden, Subject ).

adjacent( +Coordinate0, ?Coordinate1 ) holds when Coordinate0 and Coordinate1 are the same or differ by 1.

adjacent( N, N ).
adjacent( N0, N1 ) :-
    N1 is N0 + 1.
adjacent( N0, N1 ) :-
    N1 is N0 - 1.

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

location_cells( [], _Index, [] ).
location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :-
    location_cell( Row, Column, Index, Cell ),
    location_cells( Locs, Index, Cells ).

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

location_cell( Row, Column, Index, Cell ) :-
    select_nth( Row, Index, IndexRow ),
    select_nth( Column, IndexRow, Cell ).

select_nth( ?N, ?Array, ?Element ) holds when Element is the Nth element of Array.

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

successor( ?Coordinates0, ?Coordinates1 ) holds when Coordinates0 and Coordinates1 are valid cell positions and Coordinates0 <Coordinates1.

successor( Coordinates0, Coordinates1 ) :-
    layout( Layout ),
    append( _Prefix, [Coordinates0|Successors], Layout ),
    member( Coordinates1, Successors ).

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

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)
        ] ).

Load a small library of puzzle utilities

:- ensure_loaded( misc ).

Result

This program reports 29870 solutions.

The code is available as plain text here.
Home
Valid XHTML Basic 1.0!