# Dinesman's multiple-dwelling problem

**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?*

## Contents |

## [edit] 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.

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;

- Output:

BAKER on floor 3 COOPER on floor 2 FLETCHER on floor 4 MILLER on floor 5 SMITH on floor 1

## [edit] AutoHotkey

See Dinesman's multiple-dwelling problem/AutoHotkey.

## [edit] BBC BASIC

Each of the statements is represented by an equivalent conditional expression (**stmt1$**, **stmt2$** etc.) as indicated in the comments, where the variables **Baker**, **Cooper** etc. evaluate to the appropriate floor number. So long as each statement can be expressed in this way, and there is a unique solution, changes to the problem text can be accommodated.

REM Floors are numbered 0 (ground) to 4 (top)

REM "Baker, Cooper, Fletcher, Miller, and Smith live on different floors":

stmt1$ = "Baker<>Cooper AND Baker<>Fletcher AND Baker<>Miller AND " + \

\ "Baker<>Smith AND Cooper<>Fletcher AND Cooper<>Miller AND " + \

\ "Cooper<>Smith AND Fletcher<>Miller AND Fletcher<>Smith AND " + \

\ "Miller<>Smith"

REM "Baker does not live on the top floor":

stmt2$ = "Baker<>4"

REM "Cooper does not live on the bottom floor":

stmt3$ = "Cooper<>0"

REM "Fletcher does not live on either the top or the bottom floor":

stmt4$ = "Fletcher<>0 AND Fletcher<>4"

REM "Miller lives on a higher floor than does Cooper":

stmt5$ = "Miller>Cooper"

REM "Smith does not live on a floor adjacent to Fletcher's":

stmt6$ = "ABS(Smith-Fletcher)<>1"

REM "Fletcher does not live on a floor adjacent to Cooper's":

stmt7$ = "ABS(Fletcher-Cooper)<>1"

FOR Baker = 0 TO 4

FOR Cooper = 0 TO 4

FOR Fletcher = 0 TO 4

FOR Miller = 0 TO 4

FOR Smith = 0 TO 4

IF EVAL(stmt2$) IF EVAL(stmt3$) IF EVAL(stmt5$) THEN

IF EVAL(stmt4$) IF EVAL(stmt6$) IF EVAL(stmt7$) THEN

IF EVAL(stmt1$) THEN

PRINT "Baker lives on floor " ; Baker

PRINT "Cooper lives on floor " ; Cooper

PRINT "Fletcher lives on floor " ; Fletcher

PRINT "Miller lives on floor " ; Miller

PRINT "Smith lives on floor " ; Smith

ENDIF

ENDIF

ENDIF

NEXT Smith

NEXT Miller

NEXT Fletcher

NEXT Cooper

NEXT Baker

END

**Output:**

Baker lives on floor 2 Cooper lives on floor 1 Fletcher lives on floor 3 Miller lives on floor 4 Smith lives on floor 0

## [edit] Bracmat

The rules constitute the body of the 'constraints' function. Each statement of the problem is translated into a pattern. Patterns are the rhs of the ':' operator. Constraints can be added or deleted as you like. If the problem is underspecified, for example by deleting one or more patterns, all solutions are output, because the line following the output statement forces Bracmat to backtrack. Patterns are read as follows: the '~' means negation, a '?' is a wildcard that can span zero or more floors, a '|' means alternation. If in a pattern there is no wildcard to the left of a person's name, the pattern states that the person must live in the bottom floor. If in a pattern there is no wildcard to the right of a person's name, the pattern states that the person must live in the top floor. If in a pattern name A is left of name B, the pattern states that person A is living in a lower floor than person B. Patterns can be alternated with the '|' (OR) operator. The match operator ':', when standing between two patterns, functions as an AND operation, because both sides must match the subject argument 'arg'. The names of the people can be changed to anything, except empty strings. Bracmat supports UTF-8 encoded Unicode characters, but falls back to ISO 8859-1 if a string cannot be parsed as UTF-8. If a name contains characters that can be misinterpreted as operators, such as '.' or ' ', the name must be enclosed in double quotes. If there are no reserved characters in a name, double quotes are optional.

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

& ~ { The ~ always fails on evaluation. Here, failure forces Bracmat to backtrack and find all solutions, not just the first one. }

| !persons

: ?A

%?`person

(?Z&solution$(!floors !person.!A !Z))

)

)

& solution$(.!people)

| { After outputting all solutions, the lhs of the | operator fails. The rhs of the | operator, here an empty string, is the final result. }

);

Inhabitants, from bottom to top: Smith Cooper Baker Fletcher Miller

## [edit] C

#include <stdio.h>Output

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

};

const 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;

}

Found arrangement: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

2 baker

1 cooper

3 fletcher

4 miller

0 smith

`#include`

d if need be.
## [edit] Clojure

This solution uses the contributed package *clojure.core.logic*, a miniKanren-based logic solver (and contributed *clojure.tools.macro* as well). The "setup" part of this code defines relational functions (or constraints) for testing "immediately above", "higher", and "on nonadjacent floors". These are used (along with the package's "permuteo" constraint) to define a constraint *dinesmano* which searches for all the resident orders that satisfy the criteria. The criteria are listed in one-to-one correspondence with the problem statement. Te problem statement could be changed to any mixture of these constraint types, and additional constraint functions could be defined as necessary. The final part of the code searches for all solutions and prints them out.

(ns rosettacode.dinesman

(:use [clojure.core.logic]

[clojure.tools.macro :as macro]))

; whether x is immediately above (left of) y in list s; uses pattern matching on s

(defne aboveo [x y s]

([_ _ (x y . ?rest)])

([_ _ [_ . ?rest]] (aboveo x y ?rest)))

; whether x is on a higher floor than y

(defne highero [x y s]

([_ _ (x . ?rest)] (membero y ?rest))

([_ _ (_ . ?rest)] (highero x y ?rest)))

; whether x and y are on nonadjacent floors

(defn nonadjacento [x y s]

(conda

((aboveo x y s) fail)

((aboveo y x s) fail)

(succeed)))

(defn dinesmano [rs]

(macro/symbol-macrolet [_ (lvar)]

(all

(permuteo ['Baker 'Cooper 'Fletcher 'Miller 'Smith] rs)

(aboveo _ 'Baker rs) ;someone lives above Baker

(aboveo 'Cooper _ rs) ;Cooper lives above someone

(aboveo 'Fletcher _ rs)

(aboveo _ 'Fletcher rs)

(highero 'Miller 'Cooper rs)

(nonadjacento 'Smith 'Fletcher rs)

(nonadjacento 'Fletcher 'Cooper rs))))

(let [solns (run* [q] (dinesmano q))]

(println "solution count:" (count solns))

(println "solution(s) highest to lowest floor:")

(doseq [soln solns] (println " " soln)))

- Output:

solution count: 1 solution(s) highest to lowest floor: (Miller Fletcher Baker Cooper Smith)

## [edit] D

This code uses the second lazy permutations function of **Permutations#Lazy_version**.

As for flexibility: the solve code works with an arbitrary number of people and predicates.

import std.stdio, std.math, std.algorithm, std.traits, permutations2;

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(s[Names.Smith] - s[Names.Fletcher]) != 1,

s => abs(s[Names.Cooper] - s[Names.Fletcher]) != 1];

permutations([EnumMembers!Names])

.filter!(solution => predicates.all!(pred => pred(solution)))

.writeln;

}

- Output:

[This output is incorrect: it has Fletcher on the bottom floor, Baker on the top, and Cooper and Fletcher adjacent.]

[[Fletcher, Cooper, Miller, Smith, Baker]]

### [edit] Simpler Version

import std.stdio, std.math, std.algorithm, permutations2;

void main() {

["Baker", "Cooper", "Fletcher", "Miller", "Smith"]

.permutations

.filter!(s =>

s.countUntil("Baker") != 4 && s.countUntil("Cooper") &&

s.countUntil("Fletcher") && s.countUntil("Fletcher") != 4 &&

s.countUntil("Miller") > s.countUntil("Cooper") &&

abs(s.countUntil("Smith") - s.countUntil("Fletcher")) != 1 &&

abs(s.countUntil("Cooper") - s.countUntil("Fletcher")) != 1)

.writeln;

}

The output is the same.

## [edit] Erlang

The people is an argument list. The rules is an argument list of options. Only rules that have a function in the program can be in the options. The design of the rules can be argued. Perhaps {cooper, does_not_live_on, 0}, etc, would be better for people unfamiliar with lisp.

-module( dinesman_multiple_dwelling ).

-export( [solve/2, task/0] ).

solve( All_persons, Rules ) ->

[house(Bottom_floor, B, C, D, Top_floor) || Bottom_floor <- All_persons, B <- All_persons, C <- All_persons, D <- All_persons, Top_floor <- All_persons,

lists:all( fun (Fun) -> Fun( house(Bottom_floor, B, C, D, Top_floor) ) end, rules( Rules ))].

task() ->

All_persons = [baker, cooper, fletcher, miller, smith],

Rules = [all_on_different_floors, {not_lives_on_floor, 4, baker}, {not_lives_on_floor, 0, cooper}, {not_lives_on_floor, 4, fletcher}, {not_lives_on_floor, 0, fletcher},

{on_higher_floor, miller, cooper}, {not_adjacent, smith, fletcher}, {not_adjacent, fletcher, cooper}],

[House] = solve( All_persons, Rules ),

[io:fwrite("~p lives on floor ~p~n", [lists:nth(X, House), X - 1]) || X <- lists:seq(1,5)].

house( A, B, C, D, E ) -> [A, B, C, D, E].

is_all_on_different_floors( [A, B, C, D, E] ) ->

A =/= B andalso A =/= C andalso A =/= D andalso A =/= E

andalso B =/= C andalso B =/= D andalso B =/= E

andalso C =/= D andalso C =/= E

andalso D =/= E.

is_not_adjacent( Person1, Person2, House ) ->

is_not_below( Person1, Person2, House ) andalso is_not_below( Person2, Person1, House ).

is_not_below( _Person1, _Person2, [_Person] ) -> true;

is_not_below( Person1, Person2, [Person1, Person2 | _T] ) -> false;

is_not_below( Person1, Person2, [_Person | T] ) -> is_not_below( Person1, Person2, T ).

is_on_higher_floor( Person1, _Person2, [Person1 | _T] ) -> false;

is_on_higher_floor( _Person1, Person2, [Person2 | _T] ) -> true;

is_on_higher_floor( Person1, Person2, [_Person | T] ) -> is_on_higher_floor( Person1, Person2, T ).

rules( Rules ) -> lists:map( fun rules_fun/1, Rules ).

rules_fun( all_on_different_floors ) -> fun is_all_on_different_floors/1;

rules_fun( {not_lives_on_floor, N, Person} ) -> fun (House) -> Person =/= lists:nth(N + 1, House) end;

rules_fun( {on_higher_floor, Person1, Person2} ) -> fun (House) -> is_on_higher_floor( Person1, Person2, House ) end;

rules_fun( {not_below, Person1, Person2} ) -> fun (House) -> is_not_below( Person1, Person2, House ) end;

rules_fun( {not_adjacent, Person1, Person2} ) -> fun (House) -> is_not_adjacent( Person1, Person2, House ) end.

- Output:

8> dinesman_multiple_dwelling:task(). smith lives on floor 0 cooper lives on floor 1 baker lives on floor 2 fletcher lives on floor 3 miller lives on floor 4

## [edit] Factor

All rules are encoded in the ``meets-constraints?`` word. Any variations to the rules requires modifying ``meets-constraints?``

USING: kernel

combinators.short-circuit

math math.combinatorics math.ranges

sequences

qw prettyprint ;

IN: rosetta.dinesman

: /= ( x y -- ? ) = not ;

: fifth ( seq -- elt ) 4 swap nth ;

: meets-constraints? ( seq -- ? )

{

[ first 5 /= ] ! Baker does not live on the top floor.

[ second 1 /= ] ! Cooper does not live on the bottom floor.

[ third { 1 5 } member? not ] ! Fletcher does not live on either the top or bottom floor.

[ [ fourth ] [ second ] bi > ] ! Miller lives on a higher floor than does Cooper.

[ [ fifth ] [ third ] bi - abs 1 /= ] ! Smith does not live on a floor adjacent to Fletcher's.

[ [ third ] [ second ] bi - abs 1 /= ] ! Fletcher does not live on a floor adjacent to Cooper's.

} 1&& ;

: solutions ( -- seq )

5 [1,b] all-permutations [ meets-constraints? ] filter ;

: >names ( seq -- seq )

[ 1 - qw{ baker cooper fletcher miller smith } nth ] map ;

: dinesman ( -- )

solutions [ >names . ] each ;

- Output:

{ "fletcher" "cooper" "miller" "smith" "baker" }

## [edit] 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.

All conditions are confined to a single word. The algorithm "as is" will work up to 10 floors. After that, we have to take into consideration that characters A-Z are used as digits. That will work up to 36 floors.

Although this is not ANS Forth, one should have little trouble converting it.

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

;

( a --)

: .solution #floor 0 do i names i chars over + c@ 1+ emit cr loop drop ;

\ main routine

: dinesman ( --)

2932 194 do

i perm? if solution? if .solution leave else drop then else drop then

loop

; \ show the solution

dinesman

Output:

Baker lives in 3 Cooper lives in 2 Fletcher lives in 4 Miller lives in 5 Smith lives in 1

## [edit] Haskell

The List monad is perfect for this kind of problem. One can express the problem statements in a very natural and concise way:

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

Or as a list comprehension:

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]

## [edit] 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).

invocable allOutput:

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

The solution is: Baker lives in 3 Cooper lives in 2 Fletcher lives in 4 Miller lives in 5 Smith lives in 1

## [edit] 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:

possible=: ((i.!5) A. i.5) { 'BCFMS'

Additionally, we are given a variety of constraints which eliminate some possibilities:

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

The answer is thus:

possible

SCBFM

(bottom floor) Smith, Cooper, Baker, Fletcher, Miller (top floor)

## [edit] Java

**Code:**

import java.util.*;

class DinesmanMultipleDwelling

{

private static void generatePermutations(String[] apartmentDwellers, Set<String> set, String curPermutation)

{

for (String s : apartmentDwellers)

{

if (!curPermutation.contains(s))

{

String nextPermutation = curPermutation + s;

if (nextPermutation.length() == apartmentDwellers.length)

set.add(nextPermutation);

else

generatePermutations(apartmentDwellers, set, nextPermutation);

}

}

return;

}

private static boolean topFloor(String permutation, String person)

{ return permutation.endsWith(person); }

private static boolean bottomFloor(String permutation, String person)

{ return permutation.startsWith(person); }

public static boolean livesAbove(String permutation, String upperPerson, String lowerPerson)

{ return permutation.indexOf(upperPerson) > permutation.indexOf(lowerPerson); }

public static boolean adjacent(String permutation, String person1, String person2)

{ return (Math.abs(permutation.indexOf(person1) - permutation.indexOf(person2)) == 1); }

private static boolean isPossible(String s)

{

// Conditions here

if (topFloor(s, "B"))

return false;

if (bottomFloor(s, "C"))

return false;

if (topFloor(s, "F") || bottomFloor(s, "F"))

return false;

if (!livesAbove(s, "M", "C"))

return false;

if (adjacent(s, "S", "F"))

return false;

if (adjacent(s, "F", "C"))

return false;

return true;

}

public static void main(String[] args)

{

Set<String> set = new HashSet<String>();

generatePermutations(new String[] { "B", "C", "F", "M", "S" }, set, "");

for (Iterator<String> iterator = set.iterator(); iterator.hasNext(); )

{

String permutation = iterator.next();

if (!isPossible(permutation))

iterator.remove();

}

for (String s : set)

System.out.println("Possible arrangement: " + s);

}

}

Output:

Possible arrangement: SCBFM

## [edit] Mathematica

Loads all names into memory as variables, then asserts various restrictions on them before trying to resolve them by assuming that they're integers. This works by assuming that the names are the floors the people are on. This method is slow but direct.

{Baker, Cooper, Fletcher, Miller, Smith};

(Unequal @@ %) && (And @@ (0 < # < 6 & /@ %)) &&

Baker < 5 &&

Cooper > 1 &&

1 < Fletcher < 5 &&

Miller > Cooper &&

Abs[Smith - Fletcher] > 1 &&

Abs[Cooper - Fletcher] > 1 //

Reduce[#, %, Integers] &

- Output:

Baker == 3 && Cooper == 2 && Fletcher == 4 && Miller == 5 && Smith == 1

### [edit] Alternate Version

A much quicker and traditional method. This generates all permutations of a list containing the five names as strings. The list of permutations is then filtered using the restrictions given in the problem until only one permutation is left.

p = Position[#1, #2][[1, 1]] &;

Permutations[{"Baker", "Cooper", "Fletcher", "Miller", "Smith"}, {5}];

Select[%, #[[5]] != "Baker" &];

Select[%, #[[1]] != "Cooper" &];

Select[%, #[[1]] != "Fletcher" && #[[5]] != "Fletcher" &];

Select[%, #~p~"Miller" > #~p~"Cooper" &];

Select[%, Abs[#~p~"Smith" - #~p~"Fletcher"] > 1 &];

Select[%, Abs[#~p~"Cooper" - #~p~"Fletcher"] > 1 &]

- Output:

{{"Smith", "Cooper", "Baker", "Fletcher", "Miller"}}

## [edit] Perl 6

We use permutations because "different floors" are specified. The next_perm subroutine is a variant of the one from the Permutations task.

sub next_perm ( @a is copy ) {Output:

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

;

}

Baker=3 Cooper=2 Fletcher=4 Miller=5 Smith=1

## [edit] 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 adjacent 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 in picoLisp) built-in predicates. If the problem statement has several solutions, they will be all generated.

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

Output:

: (? (dwelling @Result)) @Result=(Smith Cooper Baker Fletcher Miller) # Only one solution -> NIL

## [edit] Prolog

### [edit] Using CLPFD

Works with SWI-Prolog and library(clpfd) written by **Markus Triska**.

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

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.

### [edit] Plain Prolog version

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

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.

### [edit] Testing as soon as possible

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

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.

## [edit] 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

Solution found; Baker=3 Cooper=2 Fletcher=4 Miller=5 Smith=1

## [edit] Python

### [edit] 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.

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)

- Problem statement

This is not much more than calling a function on the text of the problem!

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?""")

- 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

### [edit] 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

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

- 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

### [edit] Simple Solution

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)

- Output:

Fletcher Cooper Miller Smith Baker

## [edit] Racket

This is a direct translation of the problem constraints using an `amb` operator to make the choices (and therefore continuations to do the search). Since it's a direct translation, pretty much all aspects of the problem can change. Note that a direct translation was preferred even though it could be made to run much faster.

#lang racket

;; A quick `amb' implementation

(define fails '())

(define (fail) (if (pair? fails) ((car fails)) (error "no more choices!")))

(define (amb xs)

(let/cc k (set! fails (cons k fails)))

(if (pair? xs) (begin0 (car xs) (set! xs (cdr xs)))

(begin (set! fails (cdr fails)) (fail))))

(define (assert . conditions) (when (memq #f conditions) (fail)))

;; Convenient macro for definining problem items

(define-syntax-rule (with: all (name ...) #:in choices body ...)

(let* ([cs choices] [name (amb cs)] ... [all `([,name name] ...)]) body ...))

;; ===== problem translation starts here =====

;; Baker, Cooper, Fletcher, Miller, and Smith live on different floors

;; of an apartment house that contains only five floors.

(with: residents [Baker Cooper Fletcher Miller Smith] #:in (range 1 6)

;; Some helpers

(define (on-top x) (for/and ([y residents]) (x . >= . (car y))))

(define (on-bottom x) (for/and ([y residents]) (x . <= . (car y))))

(define (adjacent x y) (= 1 (abs (- x y))))

(assert

;; ... live on different floors ...

(assert (= 5 (length (remove-duplicates (map car residents)))))

;; Baker does not live on the top floor.

(not (on-top Baker))

;; Cooper does not live on the bottom floor.

(not (on-bottom Cooper))

;; Fletcher does not live on either the top or the bottom floor.

(not (on-top Fletcher))

(not (on-bottom Fletcher))

;; Miller lives on a higher floor than does Cooper.

(> Miller Cooper)

;; Smith does not live on a floor adjacent to Fletcher's.

(not (adjacent Smith Fletcher))

;; Fletcher does not live on a floor adjacent to Cooper's.

(assert (not (adjacent Fletcher Cooper))))

;; Where does everyone live?

(printf "Solution:\n")

(for ([x (sort residents > #:key car)]) (apply printf " ~a. ~a\n" x)))

Output:

Solution: 5. Miller 4. Fletcher 3. Baker 2. Cooper 1. Smith

## [edit] REXX

This REXX version tries to keep the rules as simple as possible, with easy-to-read **if** statments.

Names of the tenants can be easily listed, and the floors are numbered according to the American system,

that is, the ground floor is the 1^{st} floor, the next floor up is the 2^{nd} floor, etc.

The REXX program is broken up into several parts:

- preamble where names and floors are defined.
- iterating all possibilities (permutations would be better and faster).
- evaluation of the possibilities.
- elimination of possibilities because of cohabitation (tenants must live on separate floors).
- elimination of possibilities according to the rules.
- displaying the possible solution(s), if any.
- displaying the number of solutions found.

Note that the **TH** subroutine has extra boilerplate to handle larger numbers.

With one more REXX statement, the tenants could be listed by the order of the floors they live on;

(currently, the tenants are listed in the order they are listed in the **names** variable).

The "rules" that contain **==** could be simplified to **=** for readability.

/*REXX pgm: Dinesman's multiple-dwelling problem with "natural" wording.*/

names= 'Baker Cooper Fletcher Miller Smith' /*names of the tenants.*/

floors=5; top=floors; bottom=1; #=floors; sols=0

/*floor 1 is the ground floor. */

do !.1=1 for #;do !.2=1 for #;do !.3=1 for #;do !.4=1 for #;do !.5=1 for #

do p=1 for words(names); _=word(names,p); upper _; call value _,!.p

end /*p*/

/* [↓] don't live on same floor.*/

do j=1 for #-1; do k=j+1 to #; if !.j==!.k then iterate !.5; end;end

call Waldo /* ◄───────────────────where the rubber meets the road.*/

end /*!.5*/; end /*!.4*/; end /*!.3*/; end /*!.2*/; end /*!.1*/

say; say 'found' sols "solution"s(sols)'.'

exit /*stick a fork in it, we're done.*/

/*──────────────────────────────────Waldo subroutine────────────────────*/

Waldo:

if Baker == top then return

if Cooper == bottom then return

if Fletcher == bottom | Fletcher == top then return

if Miller \> Cooper then return

if Smith == Fletcher-1 | Smith == Fletcher+1 then return

if Fletcher == Cooper-1 | Fletcher == Cooper+1 then return

say; sols=sols+1 /*list tenants in order in list. */

do p=1 for words(names); _=word(names,p)

say right(_,20) 'lives on the' !.p||th(!.p) "floor."

end /*p*/

return

/*──────────────────────────────────one-liner subroutines───────────────*/

s: if arg(1)=1 then return ''; return 's' /*a simple pluralizer funct.*/

th:procedure;parse arg x;x=abs(x);return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4))

**output**

Baker lives on 3rd floor. Cooper lives on 2nd floor. Fletcher lives on 4th floor. Miller lives on 5th floor. Smith lives on 1st floor. found 1 solution.

## [edit] Ruby

### [edit] By parsing the problem

Inspired by the Python version.

def solve( problem )

lines = problem.split(".")

names = lines.first.scan( /[A-Z]\w*/ )

re_names = Regexp.union( names )

# Later on, search for these keywords (the word "not" is handled separately).

words = %w(first second third fourth fifth sixth seventh eighth ninth tenth

bottom top higher lower adjacent)

re_keywords = Regexp.union( words )

predicates = lines[1..-2].flat_map do |line| #build an array of lambda's

keywords = line.scan( re_keywords )

name1, name2 = line.scan( re_names )

keywords.map do |keyword|

l = case keyword

when "bottom" then ->(c){ c.first == name1 }

when "top" then ->(c){ c.last == name1 }

when "higher" then ->(c){ c.index( name1 ) > c.index( name2 ) }

when "lower" then ->(c){ c.index( name1 ) < c.index( name2 ) }

when "adjacent" then ->(c){ (c.index( name1 ) - c.index( name2 )).abs == 1 }

else ->(c){ c[words.index(keyword)] == name1 }

end

line =~ /\bnot\b/ ? ->(c){not l.call(c) } : l # handle "not"

end

end

names.permutation.detect{|candidate| predicates.all?{|predicate| predicate.(candidate)}}

end

The program operates under these assumptions:

- Sentences end with a ".".
- Every capitalized word in the first sentence is a name, the rest is ignored.
- There are as many floors as there are names.
- The only relevant words beside the names are: first, second, third,.., tenth, bottom, top, higher, lower, adjacent,(and) not. The rest, including the last sentence, is ignored.

Program invocation:

#Direct positional words like top, bottom, first, second etc. can be combined; they refer to one name.

#The relative positional words higher, lower and adjacent can be combined; they need two names, not positions.

demo1 = "Abe Ben Charlie David. Abe not second top. not adjacent Ben Charlie.

David Abe adjacent. David adjacent Ben. Last line."

demo2 = "A B C D. A not adjacent D. not B adjacent higher C. C lower D. Last line"

problem1 = "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?"

# from the Python version:

problem2 = "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?"

[demo1, demo2, problem1, problem2].each{|problem| puts solve( problem ) ;puts }

- Output:

Ben David Abe Charlie B A C D Smith Cooper Baker Fletcher Miller Baker Cooper Miller Fletcher Guinan Smith

### [edit] Simple solution

names = %i( Baker Cooper Fletcher Miller Smith )

predicates = [->(c){ :Baker != c.last },

->(c){ :Cooper != c.first },

->(c){ :Fletcher != c.first && :Fletcher != c.last },

->(c){ c.index(:Miller) > c.index(:Cooper) },

->(c){ (c.index(:Smith) - c.index(:Fletcher)).abs != 1 },

->(c){ (c.index(:Cooper) - c.index(:Fletcher)).abs != 1 }]

puts names.permutation.detect{|candidate| predicates.all?{|predicate| predicate.call(candidate)}}

- Output:

Smith Cooper Baker Fletcher Miller

## [edit] Run BASIC

This program simply iterates by looking at each room available for each person. It then looks to see if it meets the requirements for each person by looking at the results of the iteration. It makes sure the room numbers add up to 15 which is the requirement of adding the floors in 1 + 2 + 3 + 4 + 5 = 15. However there are instances where the rooms add to 15 but the room numbers are not unique. So.. it makes sure each person has a unique number. This then meets the requirements.

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

Room Assignment 3 Baler 2 Cooper 4 Fletcher 5 Miller 1 Smith

## [edit] 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))

}

}

}

}

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:

...

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

)

...

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

## [edit] 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.

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

}

Solve the particular problem:

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"}

Output:

Solution found: Floor 1: Smith Floor 2: Cooper Floor 3: Baker Floor 4: Fletcher Floor 5: Miller

## [edit] UNIX Shell

#!/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

Sample output:

From bottom to top: Smith Cooper Baker Fletcher Miller

## [edit] XPL0

include c:\cxpl\codes;

int B, C, F, M, S;

for B:= 1 to 4 do \Baker does not live on top (5th) floor

for C:= 2 to 5 do \Cooper does not live on bottom floor

if C#B then \Cooper & Baker live on different floors

for F:= 2 to 4 do \Fletcher doesn't live on top or bottom

if F#B & F#C & F#C-1 & F#C+1 then \ and she's not adjacent to Cooper

for M:= 1 to 5 do

if M#F & M#B & M>C then \Miller lives above Cooper

for S:= 1 to 5 do \Smith is not adjacent to Fletcher

if S#M & S#F & S#C & S#B & S#F-1 & S#F+1 then \show

[Text(0, "Baker "); IntOut(0, B); CrLf(0); \all

Text(0, "Cooper "); IntOut(0, C); CrLf(0); \possible

Text(0, "Fletcher "); IntOut(0, F); CrLf(0); \solutions

Text(0, "Miller "); IntOut(0, M); CrLf(0);

Text(0, "Smith "); IntOut(0, S); CrLf(0);

]

Output:

Baker 3 Cooper 2 Fletcher 4 Miller 5 Smith 1

- Programming Tasks
- Solutions by Programming Task
- Ada
- AutoHotkey
- BBC BASIC
- Bracmat
- C
- Clojure
- D
- Erlang
- Factor
- Forth
- Haskell
- Haskell examples needing attention
- Examples needing attention
- Icon
- Unicon
- J
- Java
- Java examples needing attention
- Mathematica
- Perl 6
- Perl 6 examples needing attention
- PicoLisp
- Prolog
- PureBasic
- PureBasic examples needing attention
- Python
- Racket
- REXX
- Ruby
- Run BASIC
- Scala
- Tcl
- Tcllib
- GUISS/Omit
- UNIX Shell
- UNIX Shell examples needing attention
- XPL0
- XPL0 examples needing attention
- Puzzles