Dinesman's multiple-dwelling problem
You are encouraged to solve this task according to the task description, using any language you may know.
The task is to solve Dinesman's multiple dwelling problem but in a way that most naturally follows the problem statement given below. Solutions are allowed (but not required) to parse and interpret the problem text, but should remain flexible and should state what changes to the problem text are allowed. Flexibility and ease of expression are valued.
Examples may be be split into "setup", "problem statement", and "output" sections where the ease and naturalness of stating the problem and getting an answer, as well as the ease and flexibility of modifying the problem are the primary concerns.
Example output should be shown here, as well as any comments on the examples flexibility.
- The problem
- Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors. Baker does not live on the top floor. Cooper does not live on the bottom floor. Fletcher does not live on either the top or the bottom floor. Miller lives on a higher floor than does Cooper. Smith does not live on a floor adjacent to Fletcher's. Fletcher does not live on a floor adjacent to Cooper's. Where does everyone live?
Ada
Uses an enum type People to attempt to be naturally reading. Problem is easily changed by altering subtype Floor, type people and the somewhat naturally reading constraints in the Constrained function. If for example you change the floor range to 1..6 and add Superman to people, all possible solutions will be printed. <lang Ada>with Ada.Text_IO; use Ada.Text_IO; procedure Dinesman is
subtype Floor is Positive range 1 .. 5;
type People is (Baker, Cooper, Fletcher, Miller, Smith);
type Floors is array (People'Range) of Floor;
type PtFloors is access all Floors;
function Constrained (f : PtFloors) return Boolean is begin
if f (Baker) /= Floor'Last and
f (Cooper) /= Floor'First and
Floor'First < f (Fletcher) and f (Fletcher) < Floor'Last and
f (Miller) > f (Cooper) and
abs (f (Smith) - f (Fletcher)) /= 1 and
abs (f (Fletcher) - f (Cooper)) /= 1
then return True; end if;
return False;
end Constrained;
procedure Solve (list : PtFloors; n : Natural) is
procedure Swap (I : People; J : Natural) is
temp : constant Floor := list (People'Val (J));
begin list (People'Val (J)) := list (I); list (I) := temp;
end Swap;
begin
if n = 1 then
if Constrained (list) then
for p in People'Range loop
Put_Line (p'Img & " on floor " & list (p)'Img);
end loop;
end if;
return;
end if;
for i in People'First .. People'Val (n - 1) loop
Solve (list, n - 1);
if n mod 2 = 1 then Swap (People'First, n - 1);
else Swap (i, n - 1); end if;
end loop;
end Solve;
thefloors : aliased Floors;
begin
for person in People'Range loop
thefloors (person) := People'Pos (person) + Floor'First;
end loop;
Solve (thefloors'Access, Floors'Length);
end Dinesman;</lang>
- Output:
BAKER on floor 3 COOPER on floor 2 FLETCHER on floor 4 MILLER on floor 5 SMITH on floor 1
Bracmat
<lang Bracmat>( Baker Cooper Fletcher Miller Smith:?people & ( constraints
=
. !arg
: ~(? Baker)
: ~(Cooper ?)
: ~(Fletcher ?|? Fletcher)
: ? Cooper ? Miller ?
: ~(? Smith Fletcher ?|? Fletcher Smith ?)
: ~(? Cooper Fletcher ?|? Fletcher Cooper ?)
)
& ( solution
= floors persons A Z person
. !arg:(?floors.?persons)
& ( !persons:
& constraints$!floors
& out$("Inhabitants, from bottom to top:" !floors)
| !persons
: ?A
%?`person
(?Z&solution$(!floors !person.!A !Z))
)
)
& solution$(.!people) & );</lang>
Inhabitants, from bottom to top: Smith Cooper Baker Fletcher Miller
C
<lang C>#include <stdio.h>
- include <stdlib.h>
int verbose = 0;
- define COND(a, b) int a(int *s) { return (b); }
typedef int(*condition)(int *);
/* BEGIN problem specific setup */
- define N_FLOORS 5
- define TOP (N_FLOORS - 1)
int solution[N_FLOORS] = { 0 }; int occupied[N_FLOORS] = { 0 };
enum tenants { baker = 0, cooper, fletcher, miller, smith, phantom_of_the_opera, };
char *names[] = { "baker", "cooper", "fletcher", "miller", "smith", };
COND(c0, s[baker] != TOP); COND(c1, s[cooper] != 0); COND(c2, s[fletcher] != 0 && s[fletcher] != TOP); COND(c3, s[miller] > s[cooper]); COND(c4, abs(s[smith] - s[fletcher]) != 1); COND(c5, abs(s[cooper] - s[fletcher]) != 1);
- define N_CONDITIONS 6
condition cond[] = { c0, c1, c2, c3, c4, c5 };
/* END of problem specific setup */
int solve(int person)
{
int i, j;
if (person == phantom_of_the_opera) {
/* check condition */
for (i = 0; i < N_CONDITIONS; i++) {
if (cond[i](solution)) continue;
if (verbose) { for (j = 0; j < N_FLOORS; j++) printf("%d %s\n", solution[j], names[j]); printf("cond %d bad\n\n", i); } return 0; }
printf("Found arrangement:\n"); for (i = 0; i < N_FLOORS; i++) printf("%d %s\n", solution[i], names[i]); return 1; }
for (i = 0; i < N_FLOORS; i++) { if (occupied[i]) continue; solution[person] = i; occupied[i] = 1; if (solve(person + 1)) return 1; occupied[i] = 0; } return 0; }
int main()
{
verbose = 0;
if (!solve(0)) printf("Nobody lives anywhere\n");
return 0;
}</lang>Output<lang>Found arrangement:
2 baker
1 cooper
3 fletcher
4 miller
0 smith</lang>C, being its compiled self, is not terribly flexible in dynamically changing runtime code content. Parsing some external problem specification would be one way, but for a small problem, it might as well just recompile with conditions hard coded. For this program, to change conditions, one needs to edit content between BEGIN and END of problem specific setup. Those could even be setup in an external file and gets #included if need be.
D
This code uses second lazy permutations function of Permutations#Lazy_version.
As for flexibility: the solve code works with an arbitrary number of people and predicates. <lang d>import std.stdio, std.math, std.algorithm, std.traits; import permutations2: permutations; // from rosettacode
void main() {
enum Names { Baker, Cooper, Fletcher, Miller, Smith }
immutable(bool function(in Names[]) pure nothrow)[] predicates = [
s => s[Names.Baker] != s.length-1,
s => s[Names.Cooper] != 0,
s => s[Names.Fletcher] != 0 && s[Names.Fletcher] != s.length-1,
s => s[Names.Miller] > s[Names.Cooper],
s => abs(cast(int)(s[Names.Smith] - s[Names.Fletcher])) != 1,
s => abs(cast(int)(s[Names.Cooper] - s[Names.Fletcher])) != 1];
foreach (sol; permutations([EnumMembers!Names]))
//if (predicates.all!(p => p(sol))())
if (!predicates.canFind!(p => !p(sol))())
writeln(sol);
}</lang>
- Output:
[Fletcher, Cooper, Miller, Smith, Baker]
Forth
This solution takes advantage of several of Forth's strengths. Forth is able to picture a number in any base from 2 to 36.
This program simply iterates through all numbers between 01234 and 43210 (base 5). To see whether this is a permutation worth testing, a binary mask is generated. If all 5 bits are set (31 decimal), this is a possible candidate. Then all ASCII digits of the generated number are converted back to numbers by subtracting the value of ASCII "0". Finally each of the conditions is tested.
Although this is not ANS Forth, one should have little trouble converting it.
<lang forth> 0 enum baker \ enumeration of all tenants
enum cooper enum fletcher enum miller
constant smith
create names \ names of all the tenants
," Baker" ," Cooper" ," Fletcher" ," Miller" ," Smith" \ get name, type it
does> swap cells + @c count type ." lives in " ;
5 constant #floor \ number of floors
- floor 1- constant top \ top floor
0 constant bottom \ we're counting the floors from 0
- num@ c@ [char] 0 - ; ( a -- n)
- floor chars over + num@ ; ( a n1 -- a n2)
\ is it a valid permutation?
- perm? ( n -- a f)
#floor base ! 0 swap s>d <# #floor 0 ?do # loop #> over >r bounds do 1 i num@ lshift + loop 31 = r> swap decimal \ create binary mask and check
\ test a solution
- solution? ( a -- a f)
baker floor top <> \ baker on top floor?
if cooper floor bottom <> \ cooper on the bottom floor?
if fletcher floor dup bottom <> swap top <> and
if cooper floor swap miller floor rot >
if smith floor swap fletcher floor rot - abs 1 <>
if cooper floor swap fletcher floor rot - abs 1 <>
if true exit then \ we found a solution!
then
then
then
then
then false \ nice try, no cigar..
\ main routine
- dinesman ( --)
2932 194 do i perm? if solution? if leave else drop then else drop then loop #floor 0 do i names i chars over + c@ 1+ emit cr loop drop
- \ show the solution
dinesman</lang> Output:
Baker lives in 3 Cooper lives in 2 Fletcher lives in 4 Miller lives in 5 Smith lives in 1
Haskell
The List monad is perfect for this kind of problem. One can express the problem statements in a very natural and concise way:
<lang haskell>import Data.List (permutations) import Control.Monad (guard)
dinesman :: [(Int,Int,Int,Int,Int)] dinesman = do
-- baker, cooper, fletcher, miller, smith are integers representing -- the floor that each person lives on, from 1 to 5 -- Baker, Cooper, Fletcher, Miller, and Smith live on different floors -- of an apartment house that contains only five floors. [baker, cooper, fletcher, miller, smith] <- permutations [1..5] -- Baker does not live on the top floor. guard $ baker /= 5 -- Cooper does not live on the bottom floor. guard $ cooper /= 1 -- Fletcher does not live on either the top or the bottom floor. guard $ fletcher /= 5 && fletcher /= 1 -- Miller lives on a higher floor than does Cooper. guard $ miller > cooper -- Smith does not live on a floor adjacent to Fletcher's. guard $ abs (smith - fletcher) /= 1 -- Fletcher does not live on a floor adjacent to Cooper's. guard $ abs (fletcher - cooper) /= 1 -- Where does everyone live? return (baker, cooper, fletcher, miller, smith)
main :: IO () main = do
print $ head dinesman -- print first solution: (3,2,4,5,1) print dinesman -- print all solutions (only one): [(3,2,4,5,1)]</lang>
Or as a list comprehension: <lang haskell> import Data.List (permutations) main = print [ (b,c,f,m,s) | [b,c,f,m,s] <- permutations [1..5], b/=5,c/=1,f/=1,f/=5,m>c,abs(s-f)>1,abs(c-f)>1] </lang>
Icon and Unicon
This solution uses string invocation to call operators and the fact the Icon/Unicon procedures are first class values. The procedure names could also be given as strings and it would be fairly simple to read the names and all the rules directly from a file. Each name and rule recurses and relies on the inherent backtracking in the language to achieve the goal.
The rules explicitly call stop() after showing the solution. Removing the stop would cause the solver to try all possible cases and report all possible solutions (if there were multiple ones).
<lang Icon>invocable all global nameL, nameT, rules
procedure main() # Dinesman
nameT := table() nameL := ["Baker", "Cooper", "Fletcher", "Miller", "Smith"] rules := [ [ distinct ],
[ "~=", "Baker", top() ],
[ "~=", "Cooper", bottom() ],
[ "~=", "Fletcher", top() ],
[ "~=", "Fletcher", bottom() ],
[ ">", "Miller", "Cooper" ],
[ notadjacent, "Smith", "Fletcher" ],
[ notadjacent, "Fletcher", "Cooper" ],
[ showsolution ],
[ stop ] ]
if not solve(1) then
write("No solution found.")
end
procedure dontstop() # use if you want to search for all solutions end
procedure showsolution() # show the soluton
write("The solution is:")
every write(" ",n := !nameL, " lives in ", nameT[n])
return
end
procedure eval(n) # evaluate a rule
r := copy(rules[n-top()]) every r[i := 2 to *r] := rv(r[i]) if get(r)!r then suspend
end
procedure rv(x) # return referenced value if it exists return \nameT[x] | x end
procedure solve(n) # recursive solver
if n > top() then { # apply rules
if n <= top() + *rules then
( eval(n) & solve(n+1) ) | fail
}
else # setup locations
(( nameT[nameL[n]] := bottom() to top() ) & solve(n + 1)) | fail
return
end
procedure distinct(a,b) # ensure each name is distinct
if nameT[n := !nameL] = nameT[n ~== key(nameT)] then fail suspend
end
procedure notadjacent(n1,n2) # ensure n1,2 are not adjacent
if not adjacent(n1,n2) then suspend
end
procedure adjacent(n1,n2) # ensure n1,2 are adjacent
if abs(n1 - n2) = 1 then suspend
end
procedure bottom() # return bottom
return if *nameL > 0 then 1 else 0
end
procedure top() # return top
return *nameL
end</lang>
Output:
The solution is: Baker lives in 3 Cooper lives in 2 Fletcher lives in 4 Miller lives in 5 Smith lives in 1
J
This problem asks us to pick from one of several possibilities. We can represent these possibilities as permutations of the residents' initials, arranged in order from lowest floor to top floor:
<lang j>possible=: ((i.!5) A. i.5) { 'BCFMS'</lang>
Additionally, we are given a variety of constraints which eliminate some possibilities:
<lang j>possible=: (#~ 'B' ~: {:"1) possible NB. Baker not on top floor possible=: (#~ 'C' ~: {."1) possible NB. Cooper not on bottom floor possible=: (#~ 'F' ~: {:"1) possible NB. Fletcher not on top floor possible=: (#~ 'F' ~: {."1) possible NB. Fletcher not on bottom floor possible=: (#~ </@i."1&'CM') possible NB. Miller on higher floor than Cooper possible=: (#~ 0 = +/@E."1~&'SF') possible NB. Smith not immediately below Fletcher possible=: (#~ 0 = +/@E."1~&'FS') possible NB. Fletcher not immediately below Smith possible=: (#~ 0 = +/@E."1~&'CF') possible NB. Cooper not immediately below Fletcher possible=: (#~ 0 = +/@E."1~&'FC') possible NB. Fletcher not immediately below Cooper</lang>
The answer is thus:
<lang j> possible SCBFM</lang>
(bottom floor) Smith, Cooper, Baker, Fletcher, Miller (top floor)
Mathematica
<lang Mathematica>floor[x_,y_]:=Flatten[Position[y,x]]1 Select[Permutations[{"Baker","Cooper","Fletcher","Miller","Smith"}],
( floor["Baker",#] < 5 )
&&( Abs[floor["Fletcher",#] - floor["Cooper",#]] > 1 ) &&( Abs[floor["Fletcher",#] - floor["Smith",#]] > 1 ) &&( 1 < floor["Cooper",#] < floor["Miller",#] ) &&( 1 < floor["Fletcher",#] < 5 ) &] 1 //Reverse //Column
-> Miller Fletcher Baker Cooper Smith</lang>
Perl 6
We use permutations because "different floors" are specified. The next_perm subroutine is a variant of the one from the Permutations task. <lang perl6>sub next_perm ( @a is copy ) {
my $j = @a.end - 1; return Nil if --$j < 0 while [>] @a[ $j, $j+1 ];
my $aj = @a[$j]; my $k = @a.end; $k-- while [>] $aj, @a[$k]; @a[ $j, $k ] .= reverse;
my $r = @a.end; my $s = $j + 1; @a[ $r--, $s++ ] .= reverse while $r > $s; return @a;
}
- Contains only five floors. 5! = 120 permutations.
for [1..5], &next_perm ...^ !* -> [ $b, $c, $f, $m, $s ] {
say "Baker=$b Cooper=$c Fletcher=$f Miller=$m Smith=$s"
if $b != 5 # Baker !live on top floor.
and $c != 1 # Cooper !live on bottom floor.
and $f != 1|5 # Fletcher !live on top or the bottom floor.
and $m > $c # Miller lives on a higher floor than Cooper.
and $s != $f-1|$f+1 # Smith !live adjacent to Fletcher
and $f != $c-1|$c+1 # Fletcher !live adjacent to Cooper
;
}</lang>
Output:
Baker=3 Cooper=2 Fletcher=4 Miller=5 Smith=1
PicoLisp
Using Pilog (PicoLisp Prolog). The problem can be modified by changing just the 'dwelling' rule (the "Problem statement"). This might involve the names and number of dwellers (the list in the first line), and statements about who does (or does not) live on the top floor (using the 'topFloor' predicate), the bottom floor (using the 'bottomFloor' predicate), on a higher floor (using the 'higherFloor' predicate) or on an adjecent floor (using the 'adjacentFloor' predicate). The logic follows an implied AND, and statements may be arbitrarily combined using OR and NOT (using the 'or' and 'not' predicates), or any other Pilog (Prolog) built-in predicates. If the problem statement has several solutions, they will be all generated. <lang PicoLisp># Problem statement (be dwelling (@Tenants)
(permute (Baker Cooper Fletcher Miller Smith) @Tenants) (not (topFloor Baker @Tenants)) (not (bottomFloor Cooper @Tenants)) (not (or ((topFloor Fletcher @Tenants)) ((bottomFloor Fletcher @Tenants)))) (higherFloor Miller Cooper @Tenants) (not (adjacentFloor Smith Fletcher @Tenants)) (not (adjacentFloor Fletcher Cooper @Tenants)) )
- Utility rules
(be topFloor (@Tenant @Lst)
(equal (@ @ @ @ @Tenant) @Lst) )
(be bottomFloor (@Tenant @Lst)
(equal (@Tenant @ @ @ @) @Lst) )
(be higherFloor (@Tenant1 @Tenant2 @Lst)
(append @ @Rest @Lst) (equal (@Tenant2 . @Higher) @Rest) (member @Tenant1 @Higher) )
(be adjacentFloor (@Tenant1 @Tenant2 @Lst)
(append @ @Rest @Lst)
(or
((equal (@Tenant1 @Tenant2 . @) @Rest))
((equal (@Tenant2 @Tenant1 . @) @Rest)) ) )</lang>
Output:
: (? (dwelling @Result)) @Result=(Smith Cooper Baker Fletcher Miller) # Only one solution -> NIL
Prolog
Using CLPFD
Works with SWI-Prolog and library(clpfd) written by Markus Triska.
<lang Prolog>:- use_module(library(clpfd)).
- - dynamic top/1, bottom/1.
% Baker does not live on the top floor rule1(L) :- member((baker, F), L), top(Top), F #\= Top.
% Cooper does not live on the bottom floor. rule2(L) :- member((cooper, F), L), bottom(Bottom), F #\= Bottom.
% Fletcher does not live on either the top or the bottom floor. rule3(L) :- member((fletcher, F), L), top(Top), bottom(Bottom), F #\= Top, F #\= Bottom.
% Miller lives on a higher floor than does Cooper. rule4(L) :- member((miller, Fm), L), member((cooper, Fc), L), Fm #> Fc.
% Smith does not live on a floor adjacent to Fletcher's. rule5(L) :- member((smith, Fs), L), member((fletcher, Ff), L), abs(Fs-Ff) #> 1.
% Fletcher does not live on a floor adjacent to Cooper's. rule6(L) :- member((cooper, Fc), L), member((fletcher, Ff), L), abs(Fc-Ff) #> 1.
init(L) :- % we need to define top and bottom assert(bottom(1)), length(L, Top), assert(top(Top)),
% we say that they are all in differents floors bagof(F, X^member((X, F), L), LF), LF ins 1..Top, all_different(LF),
% Baker does not live on the top floor rule1(L),
% Cooper does not live on the bottom floor. rule2(L),
% Fletcher does not live on either the top or the bottom floor. rule3(L),
% Miller lives on a higher floor than does Cooper. rule4(L),
% Smith does not live on a floor adjacent to Fletcher's. rule5(L),
% Fletcher does not live on a floor adjacent to Cooper's. rule6(L).
solve(L) :-
bagof(F, X^member((X, F), L), LF),
label(LF).
dinners :- retractall(top(_)), retractall(bottom(_)), L = [(baker, _Fb), (cooper, _Fc), (fletcher, _Ff), (miller, _Fm), (smith, _Fs)], init(L), solve(L), maplist(writeln, L). </lang>
Output :
?- dinners. baker,3 cooper,2 fletcher,4 miller,5 smith,1 true ; false.
true ==> predicate succeeded.
false ==> no other solution.
About flexibility : each name is associated with a floor, (contiguous floors differs from 1).
Bottom is always 1 but Top is defined from the number of names.
Each statement of the problem is translated in a Prolog rule, (a constraint on the floors), we can add so much of rules that we want, and a modification of one statement only modified one rule.
To solve the problem, library clpfd does the job.
Plain Prolog version
<lang Prolog>select([A|As],S):- select(A,S,S1),select(As,S1). select([],_).
dinesmans(X) :-
%% Baker, Cooper, Fletcher, Miller, and Smith live on different floors %% of an apartment house that contains only five floors. select([Baker,Cooper,Fletcher,Miller,Smith],[1,2,3,4,5]),
%% Baker does not live on the top floor. Baker =\= 5,
%% Cooper does not live on the bottom floor. Cooper =\= 1,
%% Fletcher does not live on either the top or the bottom floor. Fletcher =\= 1, Fletcher =\= 5,
%% Miller lives on a higher floor than does Cooper. Miller > Cooper,
%% Smith does not live on a floor adjacent to Fletcher's. 1 =\= abs(Smith - Fletcher),
%% Fletcher does not live on a floor adjacent to Cooper's. 1 =\= abs(Fletcher - Cooper),
%% Where does everyone live?
X = ['Baker'(Baker), 'Cooper'(Cooper), 'Fletcher'(Fletcher),
'Miller'(Miller), 'Smith'(Smith)].
main :- bagof( X, dinesmans(X), L )
-> maplist( writeln, L), nl, write('No more solutions.')
; write('No solutions.').
</lang>
Ease of change (flexibility) is arguably evident in the code. The output:
[Baker(3), Cooper(2), Fletcher(4), Miller(5), Smith(1)] No more solutions.
Testing as soon as possible
<lang Prolog>dinesmans(X) :-
%% 1. Baker, Cooper, Fletcher, Miller, and Smith live on different floors %% of an apartment house that contains only five floors. Domain = [1,2,3,4,5],
%% 2. Baker does not live on the top floor. select(Baker,Domain,D1), Baker =\= 5,
%% 3. Cooper does not live on the bottom floor. select(Cooper,D1,D2), Cooper =\= 1,
%% 4. Fletcher does not live on either the top or the bottom floor. select(Fletcher,D2,D3), Fletcher =\= 1, Fletcher =\= 5,
%% 5. Miller lives on a higher floor than does Cooper. select(Miller,D3,D4), Miller > Cooper,
%% 6. Smith does not live on a floor adjacent to Fletcher's. select(Smith,D4,_), 1 =\= abs(Smith - Fletcher),
%% 7. Fletcher does not live on a floor adjacent to Cooper's. 1 =\= abs(Fletcher - Cooper),
%% Where does everyone live?
X = ['Baker'(Baker), 'Cooper'(Cooper), 'Fletcher'(Fletcher),
'Miller'(Miller), 'Smith'(Smith)].
</lang>
Running it produces the same output, but more efficiently. Separate testing in SWI shows 1,328 inferences for the former, 379 inferences for the latter version. Moving rule 7. up below rule 4. brings it down to 295 inferences.
PureBasic
<lang PureBasic>Prototype cond(Array t(1))
Enumeration #Null
#Baker #Cooper #Fletcher #Miller #Smith
EndEnumeration
Procedure checkTenands(Array tenants(1), Array Condions.cond(1))
Protected i, j
Protected.cond *f
j=ArraySize(Condions())
For i=0 To j
*f=Condions(i) ; load the function pointer to the current condition
If *f(tenants()) = #False
ProcedureReturn #False
EndIf
Next
ProcedureReturn #True
EndProcedure
Procedure C1(Array t(1))
If Int(Abs(t(#Fletcher)-t(#Cooper)))<>1 ProcedureReturn #True EndIf
EndProcedure
Procedure C2(Array t(1))
If t(#Baker)<>5 ProcedureReturn #True EndIf
EndProcedure
Procedure C3(Array t(1))
If t(#Cooper)<>1 ProcedureReturn #True EndIf
EndProcedure
Procedure C4(Array t(1))
If t(#Miller) >= t(#Cooper) ProcedureReturn #True EndIf
EndProcedure
Procedure C5(Array t(1))
If t(#Fletcher)<>1 And t(#Fletcher)<>5 ProcedureReturn #True EndIf
EndProcedure
Procedure C6(Array t(1))
If Int(Abs(t(#Smith)-t(#Fletcher)))<>1 ProcedureReturn #True EndIf
EndProcedure
If OpenConsole()
Dim People(4)
Dim Conditions(5)
Define a, b, c, d, e, i
;
;- Load all conditions
Conditions(i)=@C1(): i+1
Conditions(i)=@C2(): i+1
Conditions(i)=@C3(): i+1
Conditions(i)=@C4(): i+1
Conditions(i)=@C5(): i+1
Conditions(i)=@C6()
;
; generate and the all legal combinations
For a=1 To 5
For b=1 To 5
If a=b: Continue: EndIf
For c=1 To 5
If a=c Or b=c: Continue: EndIf
For d=1 To 5
If d=a Or d=b Or d=c : Continue: EndIf
For e=1 To 5
If e=a Or e=b Or e=c Or e=d: Continue: EndIf
People(#Baker)=a
People(#Cooper)=b
People(#Fletcher)=c
People(#Miller)=d
People(#Smith)=e
If checkTenands(People(), Conditions())
PrintN("Solution found;")
PrintN("Baker="+Str(a)+#CRLF$+"Cooper="+Str(b)+#CRLF$+"Fletcher="+Str(c))
PrintN("Miller="+Str(d)+#CRLF$+"Smith="+Str(e)+#CRLF$)
EndIf
Next
Next
Next
Next
Next
Print("Press ENTER to exit"): Input()
EndIf</lang>
Solution found; Baker=3 Cooper=2 Fletcher=4 Miller=5 Smith=1
Python
By parsing the problem statement
This example parses the statement of the problem as given and allows some variability such as the number of people, floors and constraints can be varied although the type of constraints allowed and the sentence structure is limited
- Setup
Parsing is done with the aid of the multi-line regular expression at the head of the program.
<lang python>import re from itertools import product
problem_re = re.compile(r"""(?msx)(?:
- Multiple names of form n1, n2, n3, ... , and nK
(?P<namelist> [a-zA-Z]+ (?: , \s+ [a-zA-Z]+)* (?: ,? \s+ and) \s+ [a-zA-Z]+ )
- Flexible floor count (2 to 10 floors)
| (?: .* house \s+ that \s+ contains \s+ only \s+
(?P<floorcount> two|three|four|five|six|seven|eight|nine|ten ) \s+ floors \s* \.)
- Constraint: "does not live on the n'th floor"
|(?: (?P<not_live> \b [a-zA-Z]+ \s+ does \s+ not \s+ live \s+ on \s+ the \s+
(?: top|bottom|first|second|third|fourth|fifth|sixth|seventh|eighth|ninth|tenth) \s+ floor \s* \. ))
- Constraint: "does not live on either the I'th or the J'th [ or the K'th ...] floor
|(?P<not_either> \b [a-zA-Z]+ \s+ does \s+ not \s+ live \s+ on \s+ either
(?: \s+ (?: or \s+)? the \s+ (?: top|bottom|first|second|third|fourth|fifth|sixth|seventh|eighth|ninth|tenth))+ \s+ floor \s* \. )
- Constraint: "P1 lives on a higher/lower floor than P2 does"
|(?P<hi_lower> \b [a-zA-Z]+ \s+ lives \s+ on \s+ a \s (?: higher|lower)
\s+ floor \s+ than (?: \s+ does) \s+ [a-zA-Z]+ \s* \. )
- Constraint: "P1 does/does not live on a floor adjacent to P2's"
|(?P<adjacency> \b [a-zA-Z]+ \s+ does (?:\s+ not)? \s+ live \s+ on \s+ a \s+
floor \s+ adjacent \s+ to \s+ [a-zA-Z]+ (?: 's )? \s* \. )
- Ask for the solution
|(?P<question> Where \s+ does \s+ everyone \s+ live \s* \?)
) """)
names, lennames = None, None floors = None constraint_expr = 'len(set(alloc)) == lennames' # Start with all people on different floors
def do_namelist(txt):
" E.g. 'Baker, Cooper, Fletcher, Miller, and Smith'"
global names, lennames
names = txt.replace(' and ', ' ').split(', ')
lennames = len(names)
def do_floorcount(txt):
" E.g. 'five'"
global floors
floors = '||two|three|four|five|six|seven|eight|nine|ten'.split('|').index(txt)
def do_not_live(txt):
" E.g. 'Baker does not live on the top floor.'"
global constraint_expr
t = txt.strip().split()
who, floor = t[0], t[-2]
w, f = (names.index(who),
('|first|second|third|fourth|fifth|sixth|' +
'seventh|eighth|ninth|tenth|top|bottom|').split('|').index(floor)
)
if f == 11: f = floors
if f == 12: f = 1
constraint_expr += ' and alloc[%i] != %i' % (w, f)
def do_not_either(txt):
" E.g. 'Fletcher does not live on either the top or the bottom floor.'"
global constraint_expr
t = txt.replace(' or ', ' ').replace(' the ', ' ').strip().split()
who, floor = t[0], t[6:-1]
w, fl = (names.index(who),
[('|first|second|third|fourth|fifth|sixth|' +
'seventh|eighth|ninth|tenth|top|bottom|').split('|').index(f)
for f in floor]
)
for f in fl:
if f == 11: f = floors
if f == 12: f = 1
constraint_expr += ' and alloc[%i] != %i' % (w, f)
def do_hi_lower(txt):
" E.g. 'Miller lives on a higher floor than does Cooper.'"
global constraint_expr
t = txt.replace('.', ).strip().split()
name_indices = [names.index(who) for who in (t[0], t[-1])]
if 'lower' in t:
name_indices = name_indices[::-1]
constraint_expr += ' and alloc[%i] > alloc[%i]' % tuple(name_indices)
def do_adjacency(txt):
E.g. "Smith does not live on a floor adjacent to Fletcher's."
global constraint_expr
t = txt.replace('.', ).replace("'s", ).strip().split()
name_indices = [names.index(who) for who in (t[0], t[-1])]
constraint_expr += ' and abs(alloc[%i] - alloc[%i]) > 1' % tuple(name_indices)
def do_question(txt):
global constraint_expr, names, lennames
exec_txt =
for alloc in product(range(1,floors+1), repeat=len(names)):
if %s:
break
else:
alloc = None
% constraint_expr
exec(exec_txt, globals(), locals())
a = locals()['alloc']
if a:
output= ['Floors are numbered from 1 to %i inclusive.' % floors]
for a2n in zip(a, names):
output += [' Floor %i is occupied by %s' % a2n]
output.sort(reverse=True)
print('\n'.join(output))
else:
print('No solution found.')
print()
handler = {
'namelist': do_namelist, 'floorcount': do_floorcount, 'not_live': do_not_live, 'not_either': do_not_either, 'hi_lower': do_hi_lower, 'adjacency': do_adjacency, 'question': do_question, }
def parse_and_solve(problem):
p = re.sub(r'\s+', ' ', problem).strip()
for x in problem_re.finditer(p):
groupname, txt = [(k,v) for k,v in x.groupdict().items() if v][0]
#print ("%r, %r" % (groupname, txt))
handler[groupname](txt)</lang>
- Problem statement
This is not much more than calling a function on the text of the problem! <lang python>if __name__ == '__main__':
parse_and_solve("""
Baker, Cooper, Fletcher, Miller, and Smith
live on different floors of an apartment house that contains
only five floors. Baker does not live on the top floor. Cooper
does not live on the bottom floor. Fletcher does not live on
either the top or the bottom floor. Miller lives on a higher
floor than does Cooper. Smith does not live on a floor
adjacent to Fletcher's. Fletcher does not live on a floor
adjacent to Cooper's. Where does everyone live?""")
print('# Add another person with more constraints and more floors:')
parse_and_solve("""
Baker, Cooper, Fletcher, Miller, Guinan, and Smith
live on different floors of an apartment house that contains
only seven floors. Guinan does not live on either the top or the third or the fourth floor.
Baker does not live on the top floor. Cooper
does not live on the bottom floor. Fletcher does not live on
either the top or the bottom floor. Miller lives on a higher
floor than does Cooper. Smith does not live on a floor
adjacent to Fletcher's. Fletcher does not live on a floor
adjacent to Cooper's. Where does everyone live?""")</lang>
- Output
This shows the output from the original problem and then for another, slightly different problem to cover some of the variability asked for in the task.
Floors are numbered from 1 to 5 inclusive. Floor 5 is occupied by Miller Floor 4 is occupied by Fletcher Floor 3 is occupied by Baker Floor 2 is occupied by Cooper Floor 1 is occupied by Smith # Add another person with more constraints and more floors: Floors are numbered from 1 to 7 inclusive. Floor 7 is occupied by Smith Floor 6 is occupied by Guinan Floor 4 is occupied by Fletcher Floor 3 is occupied by Miller Floor 2 is occupied by Cooper Floor 1 is occupied by Baker
By using the Amb operator
In this example, the problem needs to be turned into valid Python code for use with the Amb operator. Setup is just to import Amb.
The second set of results corresponds to this modification to the problem statement:
Baker, Cooper, Fletcher, Miller, Guinan, and Smith live on different floors of an apartment house that contains only seven floors. Guinan does not live on either the top or the third or the fourth floor. Baker does not live on the top floor. Cooper does not live on the bottom floor. Fletcher does not live on either the top or the bottom floor. Miller lives on a higher floor than does Cooper. Smith does not live on a floor adjacent to Fletcher's. Fletcher does not live on a floor adjacent to Cooper's. Where does everyone live
<lang python>from amb import Amb
if __name__ == '__main__':
amb = Amb()
maxfloors = 5
floors = range(1, maxfloors+1)
# Possible floors for each person
Baker, Cooper, Fletcher, Miller, Smith = (amb(floors) for i in range(5))
for _dummy in amb( lambda Baker, Cooper, Fletcher, Miller, Smith: (
len(set([Baker, Cooper, Fletcher, Miller, Smith])) == 5 # each to a separate floor
and Baker != maxfloors
and Cooper != 1
and Fletcher not in (maxfloors, 1)
and Miller > Cooper
and (Smith - Fletcher) not in (1, -1) # Not adjacent
and (Fletcher - Cooper) not in (1, -1) # Not adjacent
) ):
print 'Floors are numbered from 1 to %i inclusive.' % maxfloors
print '\n'.join(sorted(' Floor %i is occupied by %s'
% (globals()[name], name)
for name in 'Baker, Cooper, Fletcher, Miller, Smith'.split(', ')))
break
else:
print 'No solution found.'
print
print '# Add another person with more constraints and more floors:' # The order that Guinan is added to any list of people must stay consistant amb = Amb()
maxfloors = 7
floors = range(1, maxfloors+1)
# Possible floors for each person
Baker, Cooper, Fletcher, Miller, Guinan, Smith = (amb(floors) for i in range(6))
for _dummy in amb( lambda Baker, Cooper, Fletcher, Miller, Guinan, Smith: (
len(set([Baker, Cooper, Fletcher, Miller, Guinan, Smith])) == 6 # each to a separate floor
and Guinan not in (maxfloors, 3, 4)
and Baker != maxfloors
and Cooper != 1
and Fletcher not in (maxfloors, 1)
and Miller > Cooper
and (Smith - Fletcher) not in (1, -1) # Not adjacent
and (Fletcher - Cooper) not in (1, -1) # Not adjacent
) ):
print 'Floors are numbered from 1 to %i inclusive.' % maxfloors
print '\n'.join(sorted(' Floor %i is occupied by %s'
% (globals()[name], name)
for name in 'Baker, Cooper, Fletcher, Miller, Guinan, Smith'.split(', ')))
break
else:
print 'No solution found.'
print
</lang>
- Output
Floors are numbered from 1 to 5 inclusive. Floor 1 is occupied by Smith Floor 2 is occupied by Cooper Floor 3 is occupied by Baker Floor 4 is occupied by Fletcher Floor 5 is occupied by Miller # Add another person with more constraints and more floors: Floors are numbered from 1 to 7 inclusive. Floor 1 is occupied by Baker Floor 2 is occupied by Cooper Floor 3 is occupied by Miller Floor 4 is occupied by Fletcher Floor 5 is occupied by Guinan Floor 6 is occupied by Smith
Simple Solution
<lang python>from itertools import permutations
class Names:
Baker, Cooper, Fletcher, Miller, Smith = range(5) seq = [Baker, Cooper, Fletcher, Miller, Smith] strings = "Baker Cooper Fletcher Miller Smith".split()
predicates = [
lambda s: s[Names.Baker] != len(s)-1, lambda s: s[Names.Cooper] != 0, lambda s: s[Names.Fletcher] != 0 and s[Names.Fletcher] != len(s)-1, lambda s: s[Names.Miller] > s[Names.Cooper], lambda s: abs(s[Names.Smith] - s[Names.Fletcher]) != 1, lambda s: abs(s[Names.Cooper] - s[Names.Fletcher]) != 1];
for sol in permutations(Names.seq):
if all(p(sol) for p in predicates):
print " ".join(Names.strings[s] for s in sol)</lang>
- Output:
Fletcher Cooper Miller Smith Baker
Ruby
<lang ruby>def dinesman(floors, names, criteria)
# the "bindVars" method returns a context where the "name" variables are bound to values
eval "
def bindVars(#{names.map {|n| n.downcase}.join ','})
return binding
end
"
expression = criteria.map {|c| "(#{c.downcase})"}.join " and "
floors.permutation.each do |perm| b = bindVars *perm return b if b.eval(expression) end nil
end
floors = (1..5).to_a names = %w(Baker Cooper Fletcher Miller Smith) criteria = [
"Baker != 5", "Cooper != 1", "Fletcher != 1", "Fletcher != 5", "Miller > Cooper", "(Smith - Fletcher).abs != 1", "(Fletcher - Cooper).abs != 1",
]
b = dinesman(floors, names, criteria)
if b.nil?
puts "no solution"
else
puts "Found a solution:"
len = names.map {|n| n.length}.max
residents = names.inject({}) {|r, n| r[b.eval(n.downcase)] = n; r}
floors.each {|f| puts " Floor #{f}: #{residents[f]}"}
end</lang>
output
Found a solution: Floor 1: Smith Floor 2: Cooper Floor 3: Baker Floor 4: Fletcher Floor 5: Miller
Run BASIC
<lang runbasic>people$ = "Baler,Cooper,Fletcher,Miller,Smith"
for baler = 1 to 4 ' can not be in room 5
for cooper = 2 to 5 ' can not be in room 1
for fletcher = 2 to 4 ' can not be in room 1 or 5
for miller = 1 to 5 ' can be in any room
for smith = 1 to 5 ' can be in any room
if miller > cooper and abs(smith - fletcher) > 1 and abs(fletcher - cooper) > 1 then
if baler + cooper + fletcher + miller + smith = 15 then ' that is 1 + 2 + 3 + 4 + 5
rooms$ = baler;cooper;fletcher;miller;smith
bad = 0
for i = 1 to 5 ' make sure each room is unique
rm$ = chr$(i + 48)
r1 = instr(rooms$,rm$)
r2 = instr(rooms$,rm$,r1+1)
if r2 <> 0 then bad = 1
next i
if bad = 0 then goto [roomAssgn] ' if it is not bad it is a good assignment
end if
end if
next smith
next miller
next fletcher
next cooper
next baler print "Cam't assign rooms" ' print this if it can not find a solution wait
[roomAssgn] Print "Room Assignment" for i = 1 to 5 print mid$(rooms$,i,1);" ";word$(people$,i,",");" "; ' print the room assignments
next i</lang>
Room Assignment 3 Baler 2 Cooper 4 Fletcher 5 Miller 1 Smith
Scala
<lang Scala>object Dinesman extends App {
val tenants = List("Baker", "Cooper", "Fletcher", "Miller", "Smith")
val floors = (1 to tenants.size).toList
// define the predicates
import scala.math.abs
val predicates =
List((perm: Map[String, Int]) => !(perm("Baker")==floors.size)
,(perm: Map[String, Int]) => !(perm("Cooper")==1)
,(perm: Map[String, Int]) => !(perm("Fletcher")==1 || perm("Fletcher")==floors.size)
,(perm: Map[String, Int]) => !(perm("Miller")<=perm("Cooper"))
,(perm: Map[String, Int]) => !(abs(perm("Smith")-perm("Fletcher"))==1)
,(perm: Map[String, Int]) => !(abs(perm("Fletcher")-perm("Cooper"))==1)
)
val p: Seq[(String, Int)] => Boolean = perm => !predicates.map(_(perm.toMap)).contains(false)
tenants.permutations.map(_ zip floors).toList
.map(perm=>Pair(perm,p(perm))).filter(_._2==true).map(p=>p._1.toList)
match {
case Nil => println("no solution")
case xss => { println("solutions: "+xss.size)
xss.foreach{l=>
println("possible solution:")
l.foreach(p=>println(" "+p._1+ " lives on floor number "+p._2))
}
}
}
}</lang> Output:
solutions: 1 possible solution: Smith lives on floor number 1 Cooper lives on floor number 2 Baker lives on floor number 3 Fletcher lives on floor number 4 Miller lives on floor number 5
We can extend this problem by adding a tenant resp. adding conditions: <lang Scala>...
val tenants = List("Baker", "Cooper", "Fletcher", "Miller", "Smith", "Rollo")
...
val predicates =
List((perm: Map[String, Int]) => !(perm("Baker")==floors.size)
...
,(perm: Map[String, Int]) => !(perm("Rollo")==floors.size || perm("Rollo")==3 || perm("Rollo")==4)
,(perm: Map[String, Int]) => !(perm("Rollo")>perm("Smith"))
,(perm: Map[String, Int]) => !(perm("Rollo")<perm("Fletcher"))
)
...</lang> Output:
solutions: 1 possible solution: Baker lives on floor number 1 Cooper lives on floor number 2 Miller lives on floor number 3 Fletcher lives on floor number 4 Rollo lives on floor number 5 Smith lives on floor number 6
Tcl
It's trivial to extend this problem to deal with more floors and people and more constraints; the main internally-generated constraint is that the names of people should begin with an upper case character so that they are distinct from internal variables. This code also relies on the caller encoding the conditions as expressions that produce a value that is/can be interpreted as a boolean.
<lang tcl>package require Tcl 8.5 package require struct::list
proc dinesmanSolve {floors people constraints} {
# Search for a possible assignment that satisfies the constraints
struct::list foreachperm p $floors {
lassign $p {*}$people set found 1 foreach c $constraints { if {![expr $c]} { set found 0 break } } if {$found} break
}
# Found something, or exhausted possibilities
if {!$found} {
error "no solution possible"
}
# Generate in "nice" order
foreach f $floors {
foreach person $people { if {[set $person] == $f} { lappend result $f $person break } }
} return $result
}</lang> Solve the particular problem: <lang tcl>set soln [dinesmanSolve {1 2 3 4 5} {Baker Cooper Fletcher Miller Smith} {
{$Baker != 5}
{$Cooper != 1}
{$Fletcher != 1 && $Fletcher != 5}
{$Miller > $Cooper}
{abs($Smith-$Fletcher) != 1}
{abs($Fletcher-$Cooper) != 1}
}] puts "Solution found:" foreach {where who} $soln {puts " Floor ${where}: $who"}</lang> Output:
Solution found: Floor 1: Smith Floor 2: Cooper Floor 3: Baker Floor 4: Fletcher Floor 5: Miller
UNIX Shell
<lang bash>#!/bin/bash
NAMES=(Baker Cooper Fletcher Miller Smith)
CRITERIA=(
'Baker != TOP' 'Cooper != BOTTOM' 'Fletcher != TOP' 'Fletcher != BOTTOM' 'Miller > Cooper' '$(abs $(( Smith - Fletcher )) ) > 1' '$(abs $(( Fletcher - Cooper )) ) > 1'
)
- Code below here shouldn't need to change to vary parameters
let BOTTOM=0 let TOP=${#NAMES[@]}-1
- Not available as a builtin
function abs {
let n=$1 if (( n < 0 )); then let n=-n; fi echo "$n"
}
- Algorithm we use to iterate over the permutations
- requires that we start with the array sorted lexically
NAMES=($(printf "%s\n" "${NAMES[@]}" | sort)) while true; do
# set each name to its position in the array
for (( i=BOTTOM; i<=TOP; ++i )); do
eval "${NAMES[i]}=$i"
done
# check to see if we've solved the problem
let solved=1
for criterion in "${CRITERIA[@]}"; do
if ! eval "(( $criterion ))"; then
let solved=0
break
fi
done
if (( solved )); then
echo "From bottom to top: ${NAMES[@]}"
break
fi
# Bump the names list to the next permutation
let j=TOP-1
while (( j >= BOTTOM )) && ! [[ "${NAMES[j]}" < "${NAMES[j+1]}" ]]; do
let j-=1
done
if (( j < BOTTOM )); then break; fi
let k=TOP
while (( k > j )) && [[ "${NAMES[k]}" < "${NAMES[j]}" ]]; do
let k-=1
done
if (( k <= j )); then break; fi
t="${NAMES[j]}"
NAMES[j]="${NAMES[k]}"
NAMES[k]="$t"
for (( k=1; k<=(TOP-j); ++k )); do
a=BOTTOM+j+k
b=TOP-k+1
if (( a < b )); then
t="${NAMES[a]}"
NAMES[a]="${NAMES[b]}"
NAMES[b]="$t"
fi
done
done</lang>
Sample output:
From bottom to top: Smith Cooper Baker Fletcher Miller