/* THE NUTCRACKER SUITE - NUT # 1 * * 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 955514879 others quite easily, 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. * * This means that the total number of solutions is 955514880 x D where D is * the number of solutions which cannot be derived from each other by * 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 ), matrix( Cells ), findall( x, allocate(Cells, Candidates), Allocations ), % Don't store distinct solutions length( Allocations, 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, +Candidates ) 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(1) and * constrain all the cell's adjacent successors to have different subject(s) * from it. * 1) Bart Demoen alerted me to the fact that it is very much faster to * allocate candidates to cells than to allocate cells to candidates. * */ allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), forbidden( Cell, Forbidden ), blocked( Forbidden, Candidate ), allocation( Cells, Next1, Subjects1 ). /* allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 ) 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( [[Candidate|Candidates]|Subjects], Next, Candidate, Subjects1, Next1 ) :- 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 = [_|_]. /* 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' cells: 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( ?SubjectNumber, ?Cell ) holds when Cell is the cell representation for * SubjectNumber. */ 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( ?SubjectNumber, ?Block ) holds when Block is a cell representation that * is incompatible with SubjectNumber. */ 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 the * 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, ?Cells ) 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 ). /* candidates( ?Subjects, ?Candidates ) holds when there are 4 Candidates * for each Subject. */ candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ). /* layout( ?Layout ) holds when Layout is the sequence of the (x,y) coordinates 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)] ). :- ensure_loaded( misc ).