Dinesman's multiple-dwelling problem: Difference between revisions

Added various BASIC dialects (Chipmunk Basic, QBasic and True BASIC)
m (→‎{{header|C sharp}}: Regularize header markup to recommended on category page)
(Added various BASIC dialects (Chipmunk Basic, QBasic and True BASIC))
 
(15 intermediate revisions by 10 users not shown)
Line 28:
{{trans|Nim}}
 
<langsyntaxhighlight lang="11l">-V
BAKER = 0
COOPER = 1
Line 51:
I !floors.next_permutation()
print(‘No solution found.’)
L.break</langsyntaxhighlight>
 
{{out}}
Line 66:
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.
<langsyntaxhighlight Adalang="ada">with Ada.Text_IO; use Ada.Text_IO;
procedure Dinesman is
subtype Floor is Positive range 1 .. 5;
Line 111:
end loop;
Solve (thefloors'Access, Floors'Length);
end Dinesman;</langsyntaxhighlight>
{{out}}
<pre>BAKER on floor 3
Line 124:
The constraints for each person could be changed by providing a different PROC(INT)BOOL in the initialisation of the inhabitants.
Changing the number of inhabitants would require adding or removing loops from the solution finding code.
<langsyntaxhighlight lang="algol68"># attempt to solve the dinesman Multiple Dwelling problem #
 
# SETUP #
Line 193:
FI
OD
OD</langsyntaxhighlight>
{{out}}
<pre>
Line 202:
0 Smith
</pre>
 
=={{header|AppleScript}}==
<syntaxhighlight lang="applescript">on Dinesman()
set output to {}
(* American floor numbering used in these comments to match AppleScript's 1-based indices. *)
-- Baker's not on the fifth floor.
repeat with Baker from 1 to 4
-- Cooper's not on the first floor. Nor on the fifth as Miller's somewhere above him.
-- Fletcher's also not on these floors, so both are in the middle three. They're also
-- at least two floors apart, so one must be on the second and the other on the fourth.
repeat with Cooper from 2 to 4 by 2
if (Cooper ≠ Baker) then
set Fletcher to 6 - Cooper
-- Miller's somewhere above Cooper.
if (Fletcher ≠ Baker) then repeat with Miller from (Cooper + 1) to 5
-- Try to fit Smith in somewhere not adjacent to Fletcher.
if ((Miller ≠ Fletcher) and (Miller ≠ Baker)) then repeat with Smith from 1 to 5
if ((Smith is not in {Baker, Cooper, Fletcher, Miller}) and ¬
((Fletcher - Smith > 1) or (Smith - Fletcher > 1))) then
tell {missing value, missing value, missing value, missing value, missing value}
set {item Baker, item Cooper, item Fletcher, item Miller, item Smith} to ¬
{"Baker", "Cooper", "Fletcher", "Miller", "Smith"}
set end of output to {bottomToTop:it}
end tell
end if
end repeat
end repeat
end if
end repeat
end repeat
return {numberOfSolutions:(count output), solutions:output}
end Dinesman
 
return Dinesman()</syntaxhighlight>
 
{{output}}
<syntaxhighlight lang="applescript">{numberOfSolutions:1, solutions:{{bottomToTop:{"Smith", "Cooper", "Baker", "Fletcher", "Miller"}}}}</syntaxhighlight>
 
=={{header|AutoHotkey}}==
Line 207 ⟶ 245:
 
=={{header|AWK}}==
<syntaxhighlight lang="awk">
<lang AWK>
# syntax: GAWK -f DINESMANS_MULTIPLE-DWELLING_PROBLEM.AWK
BEGIN {
Line 247 ⟶ 285:
}
function abs(x) { if (x >= 0) { return x } else { return -x } }
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 261 ⟶ 299:
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<langsyntaxhighlight BASIC256lang="basic256">print "Los apartamentos están numerados del 0 (bajo) al 4 (ático)."
print "Baker, Cooper, Fletcher, Miller y Smith viven en apartamentos diferentes."
print "- Baker no vive en el último apartamento (ático)."
Line 287 ⟶ 325:
next Cooper
next Baker
end</langsyntaxhighlight>
{{out}}
<pre>
Line 297 ⟶ 335:
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.
 
<langsyntaxhighlight lang="bbcbasic"> REM Floors are numbered 0 (ground) to 4 (top)
REM "Baker, Cooper, Fletcher, Miller, and Smith live on different floors":
Line 344 ⟶ 382:
NEXT Cooper
NEXT Baker
END</langsyntaxhighlight>
{{out}}
<pre>
Line 354 ⟶ 392:
</pre>
 
==={{header|Chipmunk Basic}}===
{{trans|FreeBASIC}}
{{works with|Chipmunk Basic|3.6.4}}
<syntaxhighlight lang="vbnet">100 cls
110 print "Los apartamentos están numerados del 0 (bajo) al 4 (ático)."
120 print "Baker, Cooper, Fletcher, Miller y Smith viven en apartamentos diferentes."
130 print "- Baker no vive en el último apartamento (ático)."
140 print "- Cooper no vive en el piso inferior (bajo)."
150 print "- Fletcher no vive ni en el ático ni en el bajo."
160 print "- Miller vive en un apartamento más alto que Cooper."
170 print "- Smith no vive en un apartamento adyacente al de Fletcher."
180 print "- Fletcher no vive en un apartamento adyacente al de Cooper."
190 print
200 for baker = 0 to 3
210 for cooper = 1 to 4
220 for fletcher = 1 to 3
230 for miller = 0 to 4
240 for smith = 0 to 4
250 if baker <> cooper and baker <> fletcher and baker <> miller and baker <> smith and cooper <> fletcher then
260 if cooper <> miller and cooper <> smith and fletcher <> miller and fletcher <> smith and miller <> smith then
270 if miller > cooper and abs(smith-fletcher) <> 1 and abs(fletcher-cooper) <> 1 then
280 print "Baker vive en el piso ";baker
290 print "Cooper vive en el piso ";cooper
300 print "Fletcher vive en el piso ";fletcher
310 print "Miller vive en el piso ";miller
320 print "Smith vive en el piso ";smith
330 endif
340 endif
350 endif
360 next smith
370 next miller
380 next fletcher
390 next cooper
400 next baker
410 end</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|Commodore BASIC}}===
The statements have been rearranged below so as to eliminate the maximum number of iterations; they could all be placed in the innermost loop and achieve the same result, just more slowly.
 
<syntaxhighlight lang="basic">100 T=5:REM TOP FLOOR
110 FOR B=1 TO T
120 : REM BAKER DOES NOT LIVE ON THE TOP FLOOR
130 : IF B=T THEN 420
140 : FOR C=1 TO T
150 : IF C=B THEN 410: REM ONE PERSON PER FLOOR
160 : REM COOPER DOES NOT LIVE ON THE BOTTOM FLOOR
170 : IF C=1 THEN 410
180 : FOR F=1 TO T
190 : IF F=B OR F=C THEN 400: REM ONE PERSON PER FLOOR
200 : REM FLETCHER DOES NOT LIVE ON TOP OR BOTTOM
210 : IF F=1 OR F=T THEN 400
220 : REM FLETCHER DOES NOT LIVE ADJACENT TO COOPER
230 : IF ABS(F-C)=1 THEN 400
240 : FOR M=1 TO T
250 : IF M=B OR M=C OR M=F THEN 390: REM ONE PERSON PER FLOOR
260 : REM MILLER LIVES ABOVE COOPER
270 : IF M < C THEN 390
280 : FOR S=1 TO T
290 : IF S=B OR S=C OR S=F OR S=M THEN 380: REM ONE PERSON PER FLOOR
300 : REM SMITH DOES NOT LIVE ADJACENT TO FLETCHER
310 : IF ABS(F-S)=1 THEN 380
320 : PRINT "BAKER IS ON"B
330 : PRINT "COOPER IS ON"C
340 : PRINT "FLETCHER IS ON"F
350 : PRINT "MILLER IS ON"M
360 : PRINT "SMITH IS ON"S
370 : END
380 : NEXT S
390 : NEXT M
400 : NEXT F
410 : NEXT C
420 NEXT B
430 PRINT "NO SOLUTION"</syntaxhighlight>
 
{{Out}}
<pre>BAKER IS ON 3
COOPER IS ON 2
FLETCHER IS ON 4
MILLER IS ON 5
SMITH IS ON 1</pre>
 
==={{header|FreeBASIC}}===
<langsyntaxhighlight lang="freebasic">Print "Los apartamentos estan numerados del 0 (bajo) al 4 (atico)."
Print "Baker, Cooper, Fletcher, Miller y Smith viven en apartamentos diferentes."
Print "- Baker no vive en el ultimo apartamento (atico)."
Line 388 ⟶ 508:
Next Cooper
Next Baker
Sleep</langsyntaxhighlight>
{{out}}
<pre>
Line 408 ⟶ 528:
 
==={{header|IS-BASIC}}===
<langsyntaxhighlight ISlang="is-BASICbasic">100 PROGRAM "Dinesman.bas"
110 PRINT "Floors are numbered 0 (ground) to 4 (top).":PRINT "Baker, Cooper, Fletcher, Miller, and Smith live on different floors."
120 PRINT "- Baker does not live on the top floor.":PRINT "- Cooper does not live on the bottom floor."
Line 426 ⟶ 546:
260 NEXT
270 NEXT
280 NEXT</langsyntaxhighlight>
 
==={{header|PureBasic}}===
{{incomplete|PureBasic|Examples should state what changes to the problem text are allowed.}}
<langsyntaxhighlight PureBasiclang="purebasic">Prototype cond(Array t(1))
 
Enumeration #Null
Line 529 ⟶ 649:
Next
Print("Press ENTER to exit"): Input()
EndIf</langsyntaxhighlight>
<pre>Solution found;
Baker=3
Line 537 ⟶ 657:
Smith=1</pre>
====Port of [http://rosettacode.org/wiki/Dinesman%27s_multiple-dwelling_problem#C C code solution]====
<syntaxhighlight lang="purebasic">
<lang PureBasic>
EnableExplicit
 
Line 638 ⟶ 758:
CloseConsole( )
 
End</langsyntaxhighlight>
 
<pre>Found arrangement:
Line 646 ⟶ 766:
4 miller
0 smith</pre>
 
==={{header|QBasic}}===
{{trans|FreeBASIC}}
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
{{works with|True BASIC}}
<syntaxhighlight lang="qbasic">PRINT "Los apartamentos están numerados del 0 (bajo) al 4 (ático)."
PRINT "Baker, Cooper, Fletcher, Miller y Smith viven en apartamentos diferentes."
PRINT "- Baker no vive en el último apartamento (ático)."
PRINT "- Cooper no vive en el piso inferior (bajo)."
PRINT "- Fletcher no vive ni en el ático ni en el bajo."
PRINT "- Miller vive en un apartamento más alto que Cooper."
PRINT "- Smith no vive en un apartamento adyacente al de Fletcher."
PRINT "- Fletcher no vive en un apartamento adyacente al de Cooper."
PRINT
FOR baker = 0 TO 3
FOR cooper = 1 TO 4
FOR fletcher = 1 TO 3
FOR miller = 0 TO 4
FOR smith = 0 TO 4
IF baker <> cooper AND baker <> fletcher AND baker <> miller AND baker <> smith AND cooper <> fletcher THEN
IF cooper <> miller AND cooper <> smith AND fletcher <> miller AND fletcher <> smith AND miller <> smith THEN
IF miller > cooper AND ABS(smith - fletcher) <> 1 AND ABS(fletcher - cooper) <> 1 THEN
PRINT "Baker vive en el piso "; baker
PRINT "Cooper vive en el piso "; cooper
PRINT "Fletcher vive en el piso "; fletcher
PRINT "Miller vive en el piso "; miller
PRINT "Smith vive en el piso "; smith
END IF
END IF
END IF
NEXT smith
NEXT miller
NEXT fletcher
NEXT cooper
NEXT baker
END</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|Run BASIC}}===
Line 652 ⟶ 811:
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.
 
<langsyntaxhighlight lang="runbasic">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
Line 669 ⟶ 828:
next cooper
next baler
print "Can't assign rooms" ' print this if it can not find a solution</langsyntaxhighlight>
<pre>baler: 3 copper: 2 fletcher: 4 miller: 5 smith: 1</pre>
 
==={{header|True BASIC}}===
{{trans|FreeBASIC}}
{{works with|QBasic}}
<syntaxhighlight lang="qbasic">PRINT "Los apartamentos están numerados del 0 (bajo) al 4 (ático)."
PRINT "Baker, Cooper, Fletcher, Miller y Smith viven en apartamentos diferentes."
PRINT "- Baker no vive en el último apartamento (ático)."
PRINT "- Cooper no vive en el piso inferior (bajo)."
PRINT "- Fletcher no vive ni en el ático ni en el bajo."
PRINT "- Miller vive en un apartamento más alto que Cooper."
PRINT "- Smith no vive en un apartamento adyacente al de Fletcher."
PRINT "- Fletcher no vive en un apartamento adyacente al de Cooper."
PRINT
FOR baker = 0 TO 3
FOR cooper = 1 TO 4
FOR fletcher = 1 TO 3
FOR miller = 0 TO 4
FOR smith = 0 TO 4
IF baker <> cooper AND baker <> fletcher AND baker <> miller AND baker <> smith AND cooper <> fletcher THEN
IF cooper <> miller AND cooper <> smith AND fletcher <> miller AND fletcher <> smith AND miller <> smith THEN
IF miller > cooper AND ABS(smith - fletcher) <> 1 AND ABS(fletcher - cooper) <> 1 THEN
PRINT "Baker vive en el piso "; baker
PRINT "Cooper vive en el piso "; cooper
PRINT "Fletcher vive en el piso "; fletcher
PRINT "Miller vive en el piso "; miller
PRINT "Smith vive en el piso "; smith
END IF
END IF
END IF
NEXT smith
NEXT miller
NEXT fletcher
NEXT cooper
NEXT baker
END</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|uBasic/4tH}}===
{{trans|BBC Basic}}
<syntaxhighlight lang="text">REM Floors are numbered 0 (ground) to 4 (top)
 
FOR B = 0 TO 4
Line 734 ⟶ 930:
REM "Fletcher does not live on a floor adjacent to Cooper's"
160 PUSH ABS(F-C)#1
RETURN</langsyntaxhighlight>
 
Output:
Line 750 ⟶ 946:
==={{header|Yabasic}}===
{{trans|FreeBASIC}}
<langsyntaxhighlight Yabasiclang="yabasic">print "Los apartamentos estan numerados del 0 (bajo) al 4 (atico)."
print "Baker, Cooper, Fletcher, Miller y Smith viven en apartamentos diferentes."
print "- Baker no vive en el ultimo apartamento (atico)."
Line 777 ⟶ 973:
next Cooper
next Baker
end</langsyntaxhighlight>
{{out}}
<pre>
Line 785 ⟶ 981:
==={{header|ZX Spectrum Basic}}===
{{trans|BBC_BASIC}}
<langsyntaxhighlight lang="zxbasic">10 REM Floors are numbered 0 (ground) to 4 (top)
20 REM "Baker, Cooper, Fletcher, Miller, and Smith live on different floors":
30 REM "Baker does not live on the top floor"
Line 795 ⟶ 991:
90 FOR b=0 TO 4: FOR c=0 TO 4: FOR f=0 TO 4: FOR m=0 TO 4: FOR s=0 TO 4
100 IF B<>C AND B<>F AND B<>M AND B<>S AND C<>F AND C<>M AND C<>S AND F<>M AND F<>S AND M<>S AND B<>4 AND C<>0 AND F<>0 AND F<>4 AND M>C AND ABS (S-F)<>1 AND ABS (F-C)<>1 THEN PRINT "Baker lives on floor ";b: PRINT "Cooper lives on floor ";c: PRINT "Fletcher lives on floor ";f: PRINT "Miller lives on floor ";m: PRINT "Smith lives on floor ";s: STOP
110 NEXT s: NEXT m: NEXT f: NEXT c: NEXT b</langsyntaxhighlight>
 
=={{header|Bracmat}}==
Line 820 ⟶ 1,016:
If there are no reserved characters in a name, double quotes are optional.
 
<langsyntaxhighlight Bracmatlang="bracmat">( Baker Cooper Fletcher Miller Smith:?people
& ( constraints
=
Line 846 ⟶ 1,042:
& 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. }
);</langsyntaxhighlight>
<pre>Inhabitants, from bottom to top: Smith Cooper Baker Fletcher Miller</pre>
 
=={{header|C}}==
<langsyntaxhighlight Clang="c">#include <stdio.h>
#include <stdlib.h>
 
Line 929 ⟶ 1,125:
if (!solve(0)) printf("Nobody lives anywhere\n");
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>Found arrangement:
Line 945 ⟶ 1,141:
=={{header|C++}}==
{{Works with|C++14}}
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <array>
#include <cmath>
Line 984 ⟶ 1,180:
 
return EXIT_SUCCESS;
}</langsyntaxhighlight>
 
=={{header|C sharp|C#}}==
Line 993 ⟶ 1,189:
For each solution, it will output an array of integers that represent the tenants ordered by floor number, from the bottom floor to the top.
 
<langsyntaxhighlight lang="csharp">public class Program
{
public static void Main()
Line 1,060 ⟶ 1,256:
if (index == position) yield return newElement;
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,068 ⟶ 1,264:
This challenge is badly stated. It is trivial to state/add any variant as a where clause (and to the enum) in the Linq query. Need more information in order to automatically parse such statements and there is no specification of this in the challenge.
{{works with|C sharp|C#|7}}
<langsyntaxhighlight lang="csharp">using System;
using System.Collections.Generic;
using static System.Linq.Enumerable;
Line 1,106 ⟶ 1,302:
 
public static IEnumerable<T> ToSingleton<T>(this T item) { yield return item; }
}</langsyntaxhighlight>
{{out}}
<pre>Smith Cooper Baker Fletcher Miller
Line 1,112 ⟶ 1,308:
 
=={{header|Ceylon}}==
<langsyntaxhighlight lang="ceylon">shared void run() {
function notAdjacent(Integer a, Integer b) => (a - b).magnitude >= 2;
Line 1,135 ⟶ 1,331:
print(solutions.first else "No solution!");
}</langsyntaxhighlight>
{{out}}
<pre>baker lives on 3
Line 1,151 ⟶ 1,347:
and additional constraint functions could be defined as necessary.
The final part of the code searches for all solutions and prints them out.
<langsyntaxhighlight lang="clojure">(ns rosettacode.dinesman
(:use [clojure.core.logic]
[clojure.tools.macro :as macro]))
Line 1,188 ⟶ 1,384:
(println "solution(s) highest to lowest floor:")
(doseq [soln solns] (println " " soln)))
</syntaxhighlight>
</lang>
{{out}}
<pre>solution count: 1
Line 1,196 ⟶ 1,392:
=={{header|Common Lisp}}==
This solution uses the [https://www.cliki.net/screamer screamer] package to develop a constraint based solution. Two versions are shown, both produce the same answer. The first solves it by assigning a number to each man, the second by creating a list of all the men. The purpose of showing both solutions is to demonstrate that screamer can be used to solve constraints with various types.
<langsyntaxhighlight lang="lisp">
(defpackage :dinesman
(:use :cl
Line 1,240 ⟶ 1,436:
(fail))
(format t "(~{~A~^ ~})~%" building))))
</syntaxhighlight>
</lang>
 
=={{header|Crystal}}==
Line 1,246 ⟶ 1,442:
This example modifies the Enumerable(T) mixin and adds a method index! that requires each index not to be nil.
 
<langsyntaxhighlight Rubylang="ruby">module Enumerable(T)
def index!(element)
index(element).not_nil!
Line 1,263 ⟶ 1,459:
]
 
puts residents.permutations.find { |p| predicates.all? &.call p }</langsyntaxhighlight>
 
=={{header|D}}==
 
 
{{incorrect|D| <br><br> The output is incorrect: <br><br>
it has Fletcher on the bottom floor, <br>
Baker on the top, <br>
and Cooper and Fletcher adjacent. <br><br>}}
 
 
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.
<syntaxhighlight lang="d">
<lang d>import std.stdio, std.math, std.algorithm, std.traits, permutations2;
import std.stdio, std.math, std.algorithm, std.traits, std.array, permutations2:permutations;
 
void main() {
 
enum Names { Baker, Cooper, Fletcher, Miller, Smith }
 
immutable(bool function(in Names[]) pure nothrow)[] predicates = [
s => s[.countUntil(Names.Baker]) != 4 && s.lengthcountUntil(Names.Cooper) - 1!= 0,
s => s.countUntil(Names.Fletcher) != 4 && s => s[.countUntil(Names.Cooper]Fletcher) != 0,
s => s[.countUntil(Names.Fletcher]Miller) != 0 &&> s[.countUntil(Names.Fletcher] != s.length-1Cooper),
s => abs(s[.countUntil(Names.Miller]Smith) >- s[.countUntil(Names.Cooper]Fletcher)) != 1,
s => abs(s[.countUntil(Names.Smith]Cooper) - s[.countUntil(Names.Fletcher])) != 1,
];
s => abs(s[Names.Cooper] - s[Names.Fletcher]) != 1];
 
permutations([EnumMembers!Names]).filter!(solution => predicates.all!(pred => pred(solution)))
.filter!(solution => predicates.all!(pred => pred(solution)))
.writeln;
}</lang>
}</syntaxhighlight>
{{out}}
<pre>[[FletcherSmith, Cooper, MillerBaker, SmithFletcher, BakerMiller]]</pre>
 
===Simpler Version===
<syntaxhighlight lang="d">
<lang d>void main() {
void main() {
import std.stdio, std.math, std.algorithm, permutations2;
import std.stdio, std.math, std.algorithm, permutations2:permutations;
 
["Baker", "Cooper", "Fletcher", "Miller", "Smith"]
.permutations
.filter!(s =>
s.countUntil("Baker") != 4 && s.countUntil("Cooper") != 0 &&
s.countUntil("Fletcher") != 0 && 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;
}</langsyntaxhighlight>
 
The output is the same.
 
=={{header|EasyLang}}==
{{trans|11l}}
<syntaxhighlight>
proc nextperm . a[] .
n = len a[]
k = n - 1
while k >= 1 and a[k + 1] <= a[k]
k -= 1
.
if k = 0
a[] = [ ]
return
.
l = n
while a[l] <= a[k]
l -= 1
.
swap a[l] a[k]
k += 1
while k < n
swap a[k] a[n]
k += 1
n -= 1
.
.
for i = 1 to 5
floors[] &= i
.
BAKER = 1
COOPER = 2
FLETCHER = 3
MILLER = 4
SMITH = 5
names$[] = [ "Baker" "Cooper" "Fletcher" "Miller" "Smith" ]
#
repeat
if floors[BAKER] <> 5 and floors[COOPER] <> 1 and floors[FLETCHER] <> 1 and floors[FLETCHER] <> 5
if floors[MILLER] > floors[COOPER] and abs (floors[SMITH] - floors[FLETCHER]) <> 1 and abs (floors[FLETCHER] - floors[COOPER]) <> 1
for i to 5
print names$[i] & " lives on floor " & floors[i]
.
break 1
.
.
nextperm floors[]
until len floors[] = 0
.
</syntaxhighlight>
 
{{out}}
<pre>
Baker lives on floor 3
Cooper lives on floor 2
Fletcher lives on floor 4
Miller lives on floor 5
Smith lives on floor 1
</pre>
 
=={{header|EchoLisp}}==
The problem is solved using the '''amb''' library. The solution separates the constrainst procedure from the solver procedure. The solver does not depend on names, number of floors. This flexibility allows to easily add floors, names, constraints. See Antoinette example below, Antoinette is very close ❤️ to Cooper, and wants a prime numbered floor.
===Setup - Solver===
<langsyntaxhighlight lang="scheme">
(require 'hash)
(require' amb)
Line 1,344 ⟶ 1,595:
(make-hash)) ;; hash table : "name" -> floor
)
</syntaxhighlight>
</lang>
=== Problem data - constraints ===
<langsyntaxhighlight lang="scheme">
(define names '("baker" "cooper" "fletcher" "miller" "smith" ))
 
Line 1,368 ⟶ 1,619:
(amb-require (not (touch "fletcher" "cooper")))
)
</syntaxhighlight>
</lang>
{{out}}
<langsyntaxhighlight lang="scheme">
(task names)
→ ((baker . 2) (cooper . 1) (fletcher . 3) (miller . 4) (smith . 0))
</syntaxhighlight>
</lang>
=== Changing data - constraints ===
<langsyntaxhighlight lang="scheme">
;; add a name/floor
(define names '("baker" "cooper" "fletcher" "miller" "smith" "antoinette"))
Line 1,390 ⟶ 1,641:
)
 
</syntaxhighlight>
</lang>
{{out}}
<langsyntaxhighlight lang="scheme">
(task names)
→ ((baker . 0) (cooper . 1) (fletcher . 3) (miller . 4) (smith . 5) (antoinette . 2))
</syntaxhighlight>
</lang>
 
=={{header|Elixir}}==
{{trans|Ruby}}
'''Simple solution:'''
<langsyntaxhighlight lang="elixir">defmodule Dinesman do
def problem do
names = ~w( Baker Cooper Fletcher Miller Smith )a
Line 1,426 ⟶ 1,677:
end
 
Dinesman.problem</langsyntaxhighlight>
 
{{out}}
Line 1,443 ⟶ 1,694:
The design of the rules can be argued.
Perhaps {cooper, does_not_live_on, 0}, etc, would be better for people unfamiliar with lisp.
<syntaxhighlight lang="erlang">
<lang Erlang>
-module( dinesman_multiple_dwelling ).
 
Line 1,487 ⟶ 1,738:
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.
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,499 ⟶ 1,750:
 
=={{header|ERRE}}==
<langsyntaxhighlight ERRElang="erre">PROGRAM DINESMAN
 
BEGIN
Line 1,546 ⟶ 1,797:
END FOR ! Cooper
END FOR ! Baker
END PROGRAM</langsyntaxhighlight>
{{out}}
<pre>
Line 1,558 ⟶ 1,809:
=={{header|F_Sharp|F#}}==
This task uses [[Permutations_by_swapping#F.23]]
<langsyntaxhighlight lang="fsharp">
// Dinesman's multiple-dwelling. Nigel Galloway: September 23rd., 2020
type names = |Baker=0 |Cooper=1 |Miller=2 |Smith=3 |Fletcher=4
Line 1,566 ⟶ 1,817:
&& fG n names.Cooper names.Fletcher && (Array.findIndex((=)names.Cooper) n) < (Array.findIndex((=)names.Miller) n))
|>Seq.iter(Array.iteri(fun n g->printfn "%A lives on floor %d" g n))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,577 ⟶ 1,828:
=={{header|Factor}}==
All rules are encoded in the ``meets-constraints?`` word. Any variations to the rules requires modifying ``meets-constraints?``
<langsyntaxhighlight lang="factor">USING: kernel
combinators.short-circuit
math math.combinatorics math.ranges
Line 1,604 ⟶ 1,855:
 
: dinesman ( -- )
solutions [ >names . ] each ;</langsyntaxhighlight>
{{out}}
<pre>{
Line 1,623 ⟶ 1,874:
Although this is not ANS Forth, one should have little trouble converting it.
{{works with|4tH|3.6.20}}
<langsyntaxhighlight lang="forth"> 0 enum baker \ enumeration of all tenants
enum cooper
enum fletcher
Line 1,673 ⟶ 1,924:
; \ show the solution
 
dinesman</langsyntaxhighlight>
{{out}}
<pre>
Line 1,684 ⟶ 1,935:
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 1,805 ⟶ 2,056:
fmt.Println(t, f)
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,818 ⟶ 2,069:
The List monad is perfect for this kind of problem. One can express the problem statements in a very natural and concise way:
{{works with|GHC|6.10+}}
<langsyntaxhighlight lang="haskell">import Data.List (permutations)
import Control.Monad (guard)
 
Line 1,854 ⟶ 2,105:
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)]</langsyntaxhighlight>
 
Or as a list comprehension (syntactic sugar for a list monad):
<langsyntaxhighlight lang="haskell">import Data.List (permutations)
 
main :: IO ()
Line 1,876 ⟶ 2,127:
abs (s - f) > 1,
abs (c - f) > 1
]</langsyntaxhighlight>
{{out}}
<pre>[("Baker lives on 3","Cooper lives on 2","Fletcher lives on 4","Miller lives on 5","Smith lives on 1")]</pre>
Line 1,885 ⟶ 2,136:
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).
 
<langsyntaxhighlight Iconlang="icon">invocable all
global nameL, nameT, rules
 
Line 1,955 ⟶ 2,206:
procedure top() # return top
return *nameL
end</langsyntaxhighlight>
 
{{out}}
Line 1,970 ⟶ 2,221:
We can represent these possibilities as permutations of the residents' initials, arranged in order from lowest floor to top floor:
 
<langsyntaxhighlight lang="j">possible=: ((i.!5) A. i.5) { 'BCFMS'</langsyntaxhighlight>
 
Additionally, we are given a variety of constraints which eliminate some possibilities:
 
<langsyntaxhighlight 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
Line 1,982 ⟶ 2,233:
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</langsyntaxhighlight>
 
The answer is thus:
 
<langsyntaxhighlight lang="j"> possible
SCBFM</langsyntaxhighlight>
 
(bottom floor) Smith, Cooper, Baker, Fletcher, Miller (top floor)
Line 1,994 ⟶ 2,245:
'''Code:'''
 
<langsyntaxhighlight lang="java">import java.util.*;
 
class DinesmanMultipleDwelling {
Line 2,080 ⟶ 2,331:
}
}
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,097 ⟶ 2,348:
The predicates here can be varied, and the depth of concatMap nestings can be adjusted to match the number of unknowns in play, with each concatMap binding one name, and defining the list of its possible values.
 
<langsyntaxhighlight JavaScriptlang="javascript">(() => {
'use strict';
 
Line 2,150 ⟶ 2,401:
 
// --> [{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}]
})();</langsyntaxhighlight>
 
{{Out}}
<langsyntaxhighlight JavaScriptlang="javascript">[{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}]</langsyntaxhighlight>
 
====Less flexibility====
Line 2,164 ⟶ 2,415:
ES6 splat assignment allows us to bind all five names in a single application of concatMap. We now also need a '''permutations''' function of some kind.
 
<langsyntaxhighlight JavaScriptlang="javascript">(() => {
'use strict';
 
Line 2,219 ⟶ 2,470:
// --> [{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}]
})();
</syntaxhighlight>
</lang>
 
<langsyntaxhighlight JavaScriptlang="javascript">[{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}]</langsyntaxhighlight>
 
=={{header|jq}}==
Line 2,230 ⟶ 2,481:
The solution presented here does not blindly generate all permutations. It can be characterized as a constraint-oriented approach.
 
<langsyntaxhighlight lang="jq"># Input: an array representing the apartment house, with null at a
# particular position signifying that the identity of the occupant
# there has not yet been determined.
Line 2,245 ⟶ 2,496:
def bottom: 0;
def higher(j): . > j;
def adjacent(j): (. - j) | (. == 1 or . == -1);</langsyntaxhighlight>
'''Solution''':
<langsyntaxhighlight lang="jq">[]
| resides("Baker"; . != top) # Baker does not live on the top floor
| resides("Cooper"; . != bottom) # Cooper does not live on the bottom floor
Line 2,255 ⟶ 2,506:
| index("Fletcher") as $Fletcher
| resides("Smith"; adjacent($Fletcher) | not) # Smith does not live on a floor adjacent to Fletcher's.
| select( $Fletcher | adjacent( $Cooper ) | not ) # Fletcher does not live on a floor adjacent to Cooper's.</langsyntaxhighlight>
'''Out''':
<syntaxhighlight lang="sh">
<lang sh>
$ jq -n -f Dinesman.jq
[
Line 2,265 ⟶ 2,516:
"Fletcher",
"Miller"
]</langsyntaxhighlight>
 
=={{header|Julia}}==
{{works with|Julia|0.6}}
 
<langsyntaxhighlight lang="julia">using Combinatorics
 
function solve(n::Vector{<:AbstractString}, pred::Vector{<:Function})
Line 2,292 ⟶ 2,543:
 
solutions = solve(Names, predicates)
foreach(x -> println(join(x, ", ")), solutions)</langsyntaxhighlight>
 
{{out}}
Line 2,300 ⟶ 2,551:
Tested with Kona.
 
<syntaxhighlight lang="k">
<lang k>
perm: {x@m@&n=(#?:)'m:!n#n:#x}
filter: {y[& x'y]}
Line 2,313 ⟶ 2,564:
p: reject[{adjacent[`Cooper; `Fletcher; x]}; p]
p: reject[{(x ? `Fletcher)_in (0 4)}; p]
</syntaxhighlight>
</lang>
Output:
<pre>
Line 2,320 ⟶ 2,571:
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">// version 1.1.3
 
typealias Predicate = (List<String>) -> Boolean
Line 2,369 ⟶ 2,620:
}
}
}</langsyntaxhighlight>
 
{{out}}
Line 2,383 ⟶ 2,634:
 
=={{header|Lua}}==
<langsyntaxhighlight lang="lua">local wrap, yield = coroutine.wrap, coroutine.yield
local function perm(n)
local r = {}
Line 2,445 ⟶ 2,696:
end
 
print(solve (conds, tenants))</langsyntaxhighlight>
{{Output}}
<pre> Baker lives on floor 3
Line 2,452 ⟶ 2,703:
Miller lives on floor 5
Smith lives on floor 1</pre>
=={{header|M2000 Interpreter}}==
===== Using Permutation Step Function =====
<syntaxhighlight lang="m2000 interpreter">
Module Dinesman_s_multiple_dwelling_problem {
// this is the standard perimutation function
// which create a lambda function:
// pointer_to_array=Func(&BooleanVariable)
// when BooleanVariable = true we get the last permutation
Function PermutationStep (a as array) {
c1=lambda (&f, a) ->{
=a : f=true
}
integer m=len(a)
if m=0 then Error "No items to make permutations"
c=c1
While m>1
c1=lambda c2=c,p=0%, m=(,) (&f, a, clear as boolean=false) ->{
if clear then m=(,)
if len(m)=0 then m=a
=cons(car(m),c2(&f, cdr(m)))
if f then f=false:p++: m=cons(cdr(m), car(m)) : if p=len(m) then p=0 : m=(,):: f=true
}
c=c1
m--
End While
=lambda c, a (&f, clear as boolean=false) -> {
=c(&f, a, clear)
}
}
boolean k
object s=("Baker", "Cooper", "Fletcher", "Miller", "Smith")
StepA=PermutationStep(s)
while not k
s=StepA(&k)
if s#val$(4)= "Baker" then continue
if s#val$(0)="Cooper" then continue
if s#val$(0)="Fletcher" then continue
if s#val$(4)="Fletcher" then continue
if s#pos("Cooper")> s#pos("Miller") then continue
if abs(s#pos("Smith")-s#pos("Fletcher"))=1 then continue
if abs(s#pos("Cooper")-s#pos("Fletcher"))=1 then continue
exit // for one solution
end while
object c=each(s)
while c
Print array$(c)+" lives on floor "+(c^+1)
end while
}
Dinesman_s_multiple_dwelling_problem
</syntaxhighlight>
{{out}}
<pre>
Smith lives on floor 1
Cooper lives on floor 2
Baker lives on floor 3
Fletcher lives on floor 4
Miller lives on floor 5
</pre>
 
===== Using Amp function =====
 
<syntaxhighlight lang="m2000 interpreter">
Module Using_AmbFunction {
Enum Solution {First, Any=-1}
Function Amb(way as Solution, failure) {
read a
c1=lambda i=0, a, (&any, &ret) ->{
any=(array(a,i),)
ret=any
i++
ok=i=len(a)
if ok then i=0
=ok
}
m=stack.size
if m=0 then Error "At least two arrays needed"
c=c1
while m>0 {
read a
c1=lambda c2=c, i=0, a, (&any, &ret) ->{
any=(array(a,i),)
ret=(,) : ok=false : anyother=(,)
ok=c2(&anyother, &ret)
ret=cons(ret, any)
if ok then i++
ok=i=len(a)
if ok then i=0
=ok
}
c=c1 : m--
}
ok=false
any=(,)
flush
while not ok
ret=(,)
ok=c(&any, &ret)
s=stack(ret)
if not failure(! s) then data ret : if way>0 then ok=true
End While
if empty then
ret=(("",),)
else
ret=array([])
end if
=ret
}
Range=lambda (a, f) ->{
for i=a to f-1: data i: next
=array([])
}
Baker=range(1, 5)
Cooper=range(2, 6)
Fletcher=range(2, 5)
Miller=range(1,6)
Smith=range(1,6)
failure=lambda (Baker, Cooper, Fletcher, Miller, Smith)->{
if Baker=Cooper or Baker=Fletcher or Baker=Miller or Baker=Smith then =true:exit
if Cooper=Fletcher or Cooper =Miller or Cooper=Smith then =true:exit
if Fletcher=Miller or Fletcher=Smith or Miller=Smith then =true:exit
if Miller<Cooper or abs(Cooper-Fletcher)=1 or abs(Smith-Fletcher)=1 then =true:exit
}
all=amb(Any, failure, Baker, Cooper, Fletcher, Miller, Smith)
k=each(all)
s=("Baker", "Cooper", "Fletcher", "Miller", "Smith")
while k
z=array(k)
zz=each(z, , -2)
while zz
? s#val$(zz^)+" ("+array(zz)+"), ";
end while
zz=each(z, -1)
while zz
? s#val$(zz^)+" ("+array(zz)+") "
end while
end while
}
Using_AmbFunction
 
</syntaxhighlight>
{{out}}
<pre>
Baker (3), Cooper (2), Fletcher (4), Miller (5), Smith (1)
</pre>
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
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.
<syntaxhighlight lang="mathematica">
<lang Mathematica>
{Baker, Cooper, Fletcher, Miller, Smith};
(Unequal @@ %) && (And @@ (0 < # < 6 & /@ %)) &&
Line 2,465 ⟶ 2,862:
Abs[Cooper - Fletcher] > 1 //
Reduce[#, %, Integers] &
</syntaxhighlight>
</lang>
{{out}}
<langsyntaxhighlight Mathematicalang="mathematica">Baker == 3 && Cooper == 2 && Fletcher == 4 && Miller == 5 && Smith == 1</langsyntaxhighlight>
 
===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.
 
<syntaxhighlight lang="mathematica">
<lang Mathematica>
p = Position[#1, #2][[1, 1]] &;
Permutations[{"Baker", "Cooper", "Fletcher", "Miller", "Smith"}, {5}];
Line 2,481 ⟶ 2,878:
Select[%, Abs[#~p~"Smith" - #~p~"Fletcher"] > 1 &];
Select[%, Abs[#~p~"Cooper" - #~p~"Fletcher"] > 1 &]
</syntaxhighlight>
</lang>
 
{{out}}
<langsyntaxhighlight Mathematicalang="mathematica">{{"Smith", "Cooper", "Baker", "Fletcher", "Miller"}}</langsyntaxhighlight>
 
=={{header|MiniZinc}}==
<syntaxhighlight lang="minizinc">
<lang MiniZinc>
%Dinesman's multiple-dwelling problem. Nigel Galloway, September 25th., 2020
include "alldifferent.mzn";
Line 2,500 ⟶ 2,897:
constraint res[Cooper] < res[Miller];
output["\(n) resides on floor \(res[n])\n" | n in names]
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,511 ⟶ 2,908:
 
=={{header|Nim}}==
<langsyntaxhighlight Nimlang="nim">import algorithm
 
type
Line 2,532 ⟶ 2,929:
if not floors.nextPermutation():
echo "No solution found."
break</langsyntaxhighlight>
 
{{out}}
Line 2,547 ⟶ 2,944:
'''Setup'''
 
<langsyntaxhighlight lang="perl">use strict;
use warnings;
use feature <state say>;
Line 2,602 ⟶ 2,999:
if ('.join(' && ', @expressions).');
} @f;';
}</langsyntaxhighlight>
 
Note that it can easily be extended by modifying the <code>%predicates</code> and <code>%nouns</code> hashes at the top.
Line 2,625 ⟶ 3,022:
Thus, the problem statement from the task description translates to:
 
<langsyntaxhighlight lang="perl">parse_and_solve(<DATA>);
 
__DATA__
Line 2,634 ⟶ 3,031:
Miller higher than Cooper
Smith not adjacent to Fletcher
Fletcher not adjacent to Cooper</langsyntaxhighlight>
 
{{out}}
Line 2,646 ⟶ 3,043:
=={{header|Phix}}==
Simple static/hard-coded solution (brute force search)
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">enum</span> <span style="color: #000000;">Baker</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">Cooper</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">Fletcher</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">Miller</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">Smith</span>
Line 2,667 ⟶ 3,064:
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">permute</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">5</span><span style="color: #0000FF;">)))</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 2,678 ⟶ 3,075:
Something more flexible. The nested rules worked just as well, and
of course the code will cope with various content in names/rules.
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">names</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"Baker"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Cooper"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Fletcher"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Miller"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Smith"</span><span style="color: #0000FF;">},</span>
Line 2,724 ⟶ 3,121:
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">permute</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">))))</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</langsyntaxhighlight>-->
Same output
 
=={{header|Picat}}==
===Constraint modelling===
<syntaxhighlight lang="picat">import util.
import cp.
 
dinesman_cp =>
println(dinesman_cp),
N = 5,
X = [Baker, Cooper, Fletcher, Miller, Smith],
X :: 1..N,
 
all_different(X),
 
% Baker does not live on the fifth floor.
Baker #!= 5,
 
% Cooper does not live on the first floor.
Cooper #!= 1,
 
% Fletcher does not live on either the fifth or the first floor.
Fletcher #!= 5,
Fletcher #!= 1,
 
% Miller lives on a higher floor than does Cooper.
Miller #> Cooper,
 
% Smith does not live on a floor adjacent to Fletcher'.
abs(Smith-Fletcher) #> 1,
 
% Fletcher does not live on a floor adjacent to Cooper's.
abs(Fletcher-Cooper) #> 1,
 
solve(X),
 
println([baker=Baker, cooper=Cooper, fletcher=Fletcher, miller=Miller, smith=Smith]).</syntaxhighlight>
 
{{out}}
<pre>[baker = 3,cooper = 2,fletcher = 4,miller = 5,smith = 1]</pre>
 
===Using permutations===
<syntaxhighlight lang="picat">%
% floors: 1: bottom .. 5: top floor
%
constraints([B,C,F,M,S]) =>
B != 5, % Baker not top floor
C != 1, % Cooper not bottom floor
F != 1, F != 5, % Fletcher not botton nor top floor
M > C, % Miller higher floor than Cooper
not adjacent(S, F), % Smith and Fletcher not adjacent
not adjacent(F, C). % Fletcher and Cooper not adjacent
 
adjacent(A,B) => abs(A-B) == 1.
 
dinesman2 =>
println(dinesman2),
foreach([B,C,F,M,S] in permutations(1..5), constraints([B,C,F,M,S]))
println([baker=B, cooper=C, fletcher=F, miller=M, smith=S])
end.
</syntaxhighlight>
 
{{out}}
<pre>[baker = 3,cooper = 2,fletcher = 4,miller = 5,smith = 1]</pre>
 
=={{header|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.
<langsyntaxhighlight PicoLisplang="picolisp"># Problem statement
(be dwelling (@Tenants)
(permute (Baker Cooper Fletcher Miller Smith) @Tenants)
Line 2,755 ⟶ 3,215:
(or
((equal (@Tenant1 @Tenant2 . @) @Rest))
((equal (@Tenant2 @Tenant1 . @) @Rest)) ) )</langsyntaxhighlight>
{{out}}
<pre>: (? (dwelling @Result))
Line 2,763 ⟶ 3,223:
=={{header|PowerShell}}==
{{trans|BBC BASIC}}
<syntaxhighlight lang="powershell">
<lang PowerShell>
# Floors are numbered 1 (ground) to 5 (top)
 
Line 2,832 ⟶ 3,292:
}
}
</syntaxhighlight>
</lang>
The solution sorted by name:
<syntaxhighlight lang="powershell">
<lang PowerShell>
$multipleDwellings
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 2,848 ⟶ 3,308:
</pre>
The solution sorted by floor:
<syntaxhighlight lang="powershell">
<lang PowerShell>
$multipleDwellings | Sort-Object -Property Floor -Descending
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 2,867 ⟶ 3,327:
Works with SWI-Prolog and library(clpfd) written by '''Markus Triska'''.
 
<langsyntaxhighlight Prologlang="prolog">:- use_module(library(clpfd)).
 
:- dynamic top/1, bottom/1.
Line 2,949 ⟶ 3,409:
solve(L),
maplist(writeln, L).
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,970 ⟶ 3,430:
===Plain Prolog version===
 
<langsyntaxhighlight Prologlang="prolog">select([A|As],S):- select(A,S,S1),select(As,S1).
select([],_).
 
Line 3,003 ⟶ 3,463:
-> maplist( writeln, L), nl, write('No more solutions.')
; write('No solutions.').
</syntaxhighlight>
</lang>
 
Ease of change (flexibility) is arguably evident in the code. [http://ideone.com/8n9IQ The output]:
Line 3,013 ⟶ 3,473:
 
===Testing as soon as possible===
<langsyntaxhighlight Prologlang="prolog">dinesmans(X) :-
%% 1. Baker, Cooper, Fletcher, Miller, and Smith live on different floors
%% of an apartment house that contains only five floors.
Line 3,039 ⟶ 3,499:
X = ['Baker'(Baker), 'Cooper'(Cooper), 'Fletcher'(Fletcher),
'Miller'(Miller), 'Smith'(Smith)].
</syntaxhighlight>
</lang>
 
[http://ideone.com/1vYTV 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.
Line 3,051 ⟶ 3,511:
Parsing is done with the aid of the multi-line regular expression at the head of the program.
 
<langsyntaxhighlight lang="python">import re
from itertools import product
 
Line 3,182 ⟶ 3,642:
groupname, txt = [(k,v) for k,v in x.groupdict().items() if v][0]
#print ("%r, %r" % (groupname, txt))
handler[groupname](txt)</langsyntaxhighlight>
 
;Problem statement
 
This is not much more than calling a function on the text of the problem!
<langsyntaxhighlight lang="python">if __name__ == '__main__':
parse_and_solve("""
Baker, Cooper, Fletcher, Miller, and Smith
Line 3,208 ⟶ 3,668:
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?""")</langsyntaxhighlight>
 
;Output
Line 3,244 ⟶ 3,704:
adjacent to Cooper's. Where does everyone live</pre>
 
<langsyntaxhighlight lang="python">from amb import Amb
if __name__ == '__main__':
Line 3,301 ⟶ 3,761:
print 'No solution found.'
print
</syntaxhighlight>
</lang>
 
{{out}}
Line 3,322 ⟶ 3,782:
===Simple Solutions===
 
<langsyntaxhighlight lang="python">from itertools import permutations
 
class Names:
Line 3,339 ⟶ 3,799:
for sol in permutations(Names.seq):
if all(p(sol) for p in predicates):
print(" ".join(x for x, y in sorted(zip(Names.strings, sol), key=lambda x: x[1])))</langsyntaxhighlight>
{{out}}
<pre>Smith Cooper Baker Fletcher Miller</pre>
Line 3,347 ⟶ 3,807:
{{Trans|Haskell}}
{{Works with|Python|3.7}}
<langsyntaxhighlight lang="python">'''Dinesman's multiple-dwelling problem'''
 
from itertools import permutations
Line 3,368 ⟶ 3,828:
1 < abs(c - f)
])
])</langsyntaxhighlight>
{{Out}}
<pre>[('Baker on 3', 'Cooper on 2', 'Fletcher on 4', 'Miller on 5', 'Smith on 1')]</pre>
Line 3,375 ⟶ 3,835:
Which we could then disaggregate and comment a little more fully, replacing the list comprehension with a direct use of the list monad bind operator (concatMap):
 
<langsyntaxhighlight lang="python">'''Dinesman's multiple-dwelling problem'''
 
from itertools import chain, permutations
Line 3,435 ⟶ 3,895:
# MAIN ---
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{Out}}
<pre>Baker in 3, Cooper in 2, Fletcher in 4, Miller in 5, Smith in 1.</pre>
Line 3,441 ⟶ 3,901:
=={{header|R}}==
 
<syntaxhighlight lang="r">
<lang R>
names = unlist(strsplit("baker cooper fletcher miller smith", " "))
 
Line 3,458 ⟶ 3,918:
if (0 == length(seq)) func(built)
else for (x in seq) do.perms( seq[!seq==x], func, c(x, built)) }
</syntaxhighlight>
</lang>
 
Testing:
 
<syntaxhighlight lang="r">
<lang R>
> do.perms(names, test)
From bottom to top: --> smith cooper baker fletcher miller
Line 3,470 ⟶ 3,930:
user system elapsed
0 0 0
</syntaxhighlight>
</lang>
 
=={{header|Racket}}==
Line 3,476 ⟶ 3,936:
This is a direct translation of the problem constraints using an <tt>amb</tt> 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.
 
<langsyntaxhighlight lang="racket">
#lang racket
 
Line 3,520 ⟶ 3,980:
(printf "Solution:\n")
(for ([x (sort residents > #:key car)]) (apply printf " ~a. ~a\n" x)))
</syntaxhighlight>
</lang>
 
{{out}}
Line 3,538 ⟶ 3,998:
{{trans|Perl}}
 
<syntaxhighlight lang="raku" perl6line>use MONKEY-SEE-NO-EVAL;
 
sub parse_and_solve ($text) {
Line 3,579 ⟶ 4,039:
Smith not adjacent to Fletcher
Fletcher not adjacent to Cooper
END</langsyntaxhighlight>
 
Supports the same grammar for the problem statement, as the Perl solution.
Line 3,590 ⟶ 4,050:
===Simple solution===
{{Works with|rakudo|2015-11-15}}
<syntaxhighlight lang="raku" perl6line># Contains only five floors. 5! = 120 permutations.
for (flat (1..5).permutations) -> $b, $c, $f, $m, $s {
say "Baker=$b Cooper=$c Fletcher=$f Miller=$m Smith=$s"
Line 3,600 ⟶ 4,060:
and $f != $c-1|$c+1 # Fletcher !live adjacent to Cooper
;
}</langsyntaxhighlight>
 
Adding more people and floors requires changing the list that's being used for the permutations, adding a variable for the new person, a piece of output in the string and finally to adjust all mentions of the "top" floor.
Line 3,632 ⟶ 4,092:
The "rules" that contain &nbsp; '''==''' &nbsp; could be simplified to &nbsp; '''=''' &nbsp; for readability.
 
<langsyntaxhighlight lang="rexx">/*REXX program solves the Dinesman's multiple─dwelling problem with "natural" wording.*/
names= 'Baker Cooper Fletcher Miller Smith' /*names of multiple─dwelling tenants. */
#tenants= words(names) /*the number of tenants in the building*/
Line 3,672 ⟶ 4,132:
say right(tenant, 35) 'lives on the' @.p || th(@.p) "floor."
end /*p*/ /* [↑] "||" is REXX's concatenation. */
return /* [↑] show tenants in order in NAMES.*/</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the internal default values and definitions:}}
<pre>
Line 3,684 ⟶ 4,144:
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
floor1 = "return baker!=cooper and baker!=fletcher and baker!=miller and
baker!=smith and cooper!=fletcher and cooper!=miller and
Line 3,713 ⟶ 4,173:
next
next
</syntaxhighlight>
</lang>
Output:
<pre>
Line 3,726 ⟶ 4,186:
===By parsing the problem===
Inspired by the Python version.
<langsyntaxhighlight lang="ruby">def solve( problem )
lines = problem.split(".")
names = lines.first.scan( /[A-Z]\w*/ )
Line 3,752 ⟶ 4,212:
names.permutation.detect{|candidate| predicates.all?{|predicate| predicate.(candidate)}}
end</langsyntaxhighlight>
 
The program operates under these assumptions:
Line 3,761 ⟶ 4,221:
 
Program invocation:
<langsyntaxhighlight lang="ruby">#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.
 
Line 3,786 ⟶ 4,246:
adjacent to Cooper's. Where does everyone live?"
 
[demo1, demo2, problem1, problem2].each{|problem| puts solve( problem ) ;puts }</langsyntaxhighlight>
{{Output}}
<pre>
Line 3,815 ⟶ 4,275:
===Simple solution===
{{Trans|D}}
<langsyntaxhighlight lang="ruby">names = %i( Baker Cooper Fletcher Miller Smith )
 
predicates = [->(c){ :Baker != c.last },
Line 3,824 ⟶ 4,284:
->(c){ (c.index(:Cooper) - c.index(:Fletcher)).abs != 1 }]
 
puts names.permutation.detect{|candidate| predicates.all?{|predicate| predicate.call(candidate)}}</langsyntaxhighlight>
{{Output}}
<pre>
Line 3,835 ⟶ 4,295:
 
===Using grep===
<langsyntaxhighlight lang="ruby">
N = %w(Baker Cooper Fletcher Miller Smith)
b,c,f,m,s = N
Line 3,847 ⟶ 4,307:
(?=.*(#{f}..+#{c}|#{c}..+#{f}))/x).
first
</syntaxhighlight>
</lang>
<pre>
"Smith Cooper Baker Fletcher Miller"
</pre>
 
=={{header|Rust}}==
<syntaxhighlight lang = "rust">use itertools::Itertools;
 
 
fn main() {
for p in (1..6).permutations(5) {
let baker: i32 = p[0];
let cooper: i32 = p[1];
let fletcher: i32 = p[2];
let miller: i32 = p[3];
let smith: i32 = p[4];
if baker != 5 && cooper != 1 && fletcher != 1 && fletcher != 5 && cooper < miller &&
(smith - fletcher).abs() > 1 && (cooper - fletcher).abs() > 1 {
print!("Baker on {baker}, Cooper on {cooper}, ");
println!("Fletcher on {fletcher}, Miller on {miller}, Smith on {smith}.");
break;
}
}
}
</syntaxhighlight>{{out}}
<pre>
Baker on 3, Cooper on 2, Fletcher on 4, Miller on 5, Smith on 1.
</pre>
 
=={{header|Scala}}==
<langsyntaxhighlight Scalalang="scala">import scala.math.abs
 
object Dinesman3 extends App {
Line 3,879 ⟶ 4,363:
}
}
}</langsyntaxhighlight>
{{out}}
Solutions: 1
Line 3,890 ⟶ 4,374:
===Extended task===
We can extend this problem by adding a tenant resp. adding conditions:
<langsyntaxhighlight Scalalang="scala">import scala.math.abs
 
object Dinesman3 extends App {
Line 3,920 ⟶ 4,404:
}
}
}</langsyntaxhighlight>
{{out}}
Solutions: 1
Line 3,932 ⟶ 4,416:
===Enhanced Solution ===
Combine the rules with the person names and separated the original task with an extension.
<langsyntaxhighlight lang="scala">import scala.math.abs
 
object Dinesman2 extends App {
Line 3,978 ⟶ 4,462:
}
}
}</langsyntaxhighlight>
 
=={{header|Sidef}}==
===By parsing the problem===
{{trans|Ruby}}
<langsyntaxhighlight lang="ruby">func dinesman(problem) {
var lines = problem.split('.')
var names = lines.first.scan(/\b[A-Z]\w*/)
Line 3,994 ⟶ 4,478:
 
# Build an array of lambda's
var predicates = lines.ftfirst(-1, lines).endlast(-1).map{ |line|
var keywords = line.scan(re_keywords)
var (name1, name2) = line.scan(re_names)...
Line 4,016 ⟶ 4,500:
predicates.all { |predicate| predicate(candidate) } && return candidate
}
}</langsyntaxhighlight>
 
Function invocation:
<langsyntaxhighlight lang="ruby">var demo1 = "Abe Ben Charlie David. Abe not second top. not adjacent Ben Charlie.
David Abe adjacent. David adjacent Ben. Last line."
 
Line 4,040 ⟶ 4,524:
adjacent to Cooper's. Where does everyone live?"
 
[demo1, demo2, problem1, problem2].each{|problem| say dinesman(problem).join("\n"); say '' }</langsyntaxhighlight>
{{out}}
<pre>
Line 4,069 ⟶ 4,553:
===Simple solution===
{{trans|Ruby}}
<langsyntaxhighlight lang="ruby">var names = %w(Baker Cooper Fletcher Miller Smith)
 
var predicates = [
Line 4,085 ⟶ 4,569:
break
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,097 ⟶ 4,581:
=={{header|Tailspin}}==
===Simple solution===
<langsyntaxhighlight lang="tailspin">
templates permutations
when <=1> do [1] !
Line 4,126 ⟶ 4,610:
-> $(last..first:-1)
-> '$...;$#10;' -> !OUT::write
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 4,137 ⟶ 4,621:
 
===Re-using the solver we created for the Zebra puzzle===
<langsyntaxhighlight lang="tailspin">
// We add a zero to be able to express e.g. "not top floor"
def floors: [0..5 -> (floor:$)];
Line 4,162 ⟶ 4,646:
'No more solutions
' -> !OUT::write
</syntaxhighlight>
</lang>
 
{{out}}
Line 4,181 ⟶ 4,665:
that produce a value that is/can be interpreted as a boolean.
{{tcllib|struct::list}}
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
package require struct::list
 
Line 4,211 ⟶ 4,695:
}
return $result
}</langsyntaxhighlight>
 
Solve the particular problem:
<langsyntaxhighlight lang="tcl">set soln [dinesmanSolve {1 2 3 4 5} {Baker Cooper Fletcher Miller Smith} {
{$Baker != 5}
{$Cooper != 1}
Line 4,223 ⟶ 4,707:
}]
puts "Solution found:"
foreach {where who} $soln {puts " Floor ${where}: $who"}</langsyntaxhighlight>
 
{{out}}
Line 4,238 ⟶ 4,722:
{{works with|Bash}}
 
<langsyntaxhighlight lang="bash">#!/bin/bash
 
# NAMES is a list of names. It can be changed as needed. It can be more than five names, or less.
Line 4,310 ⟶ 4,794:
fi
done
done</langsyntaxhighlight>
 
Sample output:
Line 4,317 ⟶ 4,801:
=={{header|UTFool}}==
 
<syntaxhighlight lang="utfool">
<lang UTFool>
···
http://rosettacode.org/wiki/Dinesman's_multiple-dwelling_problem
Line 4,365 ⟶ 4,849:
people.insert i, person
house.setLength house.length° - 1
</syntaxhighlight>
</lang>
'''Output''':
<pre>SCBFM</pre>
Line 4,372 ⟶ 4,856:
{{trans|Kotlin}}
{{libheader|Wren-seq}}
<langsyntaxhighlight ecmascriptlang="wren">import "./seq" for Lst
 
var permute // recursive
Line 4,419 ⟶ 4,903:
System.print()
}
}</langsyntaxhighlight>
 
{{out}}
Line 4,434 ⟶ 4,918:
=={{header|XPL0}}==
{{incomplete|XPL0|Examples should state what changes to the problem text are allowed.}}
<langsyntaxhighlight XPL0lang="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
Line 4,450 ⟶ 4,934:
Text(0, "Miller "); IntOut(0, M); CrLf(0);
Text(0, "Smith "); IntOut(0, S); CrLf(0);
]</langsyntaxhighlight>
 
Output:
Line 4,467 ⟶ 4,951:
 
This could be generalized even more by putting the variables and constraint functions in a class, then reflection could be used to automagically get the variables, variable names and constraint functions.
<langsyntaxhighlight lang="zkl">var Baker, Cooper, Fletcher, Miller, Smith; // value == floor
const bottom=1,top=5; // floors: 1..5
// All live on different floors, enforced by using permutations of floors
Line 4,486 ⟶ 4,970:
break;
}
}</langsyntaxhighlight>
{{out}}
<pre>
2,122

edits