Jump to content

Dinesman's multiple-dwelling problem: Difference between revisions

m
syntax highlighting fixup automation
(→‎{{header|Picat}}: Moved into subsections, added {{out}})
m (syntax highlighting fixup automation)
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 207:
 
=={{header|AWK}}==
<syntaxhighlight lang="awk">
<lang AWK>
# syntax: GAWK -f DINESMANS_MULTIPLE-DWELLING_PROBLEM.AWK
BEGIN {
Line 247:
}
function abs(x) { if (x >= 0) { return x } else { return -x } }
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 261:
==={{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:
next Cooper
next Baker
end</langsyntaxhighlight>
{{out}}
<pre>
Line 297:
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:
NEXT Cooper
NEXT Baker
END</langsyntaxhighlight>
{{out}}
<pre>
Line 356:
 
==={{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:
Next Cooper
Next Baker
Sleep</langsyntaxhighlight>
{{out}}
<pre>
Line 408:
 
==={{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:
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:
Next
Print("Press ENTER to exit"): Input()
EndIf</langsyntaxhighlight>
<pre>Solution found;
Baker=3
Line 537:
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:
CloseConsole( )
 
End</langsyntaxhighlight>
 
<pre>Found arrangement:
Line 652:
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:
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|uBasic/4tH}}===
{{trans|BBC Basic}}
<syntaxhighlight lang="text">REM Floors are numbered 0 (ground) to 4 (top)
 
FOR B = 0 TO 4
Line 734:
REM "Fletcher does not live on a floor adjacent to Cooper's"
160 PUSH ABS(F-C)#1
RETURN</langsyntaxhighlight>
 
Output:
Line 750:
==={{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:
next Cooper
next Baker
end</langsyntaxhighlight>
{{out}}
<pre>
Line 785:
==={{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:
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:
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:
& 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:
if (!solve(0)) printf("Nobody lives anywhere\n");
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>Found arrangement:
Line 945:
=={{header|C++}}==
{{Works with|C++14}}
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <array>
#include <cmath>
Line 984:
 
return EXIT_SUCCESS;
}</langsyntaxhighlight>
 
=={{header|C sharp|C#}}==
Line 993:
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:
if (index == position) yield return newElement;
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,068:
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:
 
public static IEnumerable<T> ToSingleton<T>(this T item) { yield return item; }
}</langsyntaxhighlight>
{{out}}
<pre>Smith Cooper Baker Fletcher Miller
Line 1,112:
 
=={{header|Ceylon}}==
<langsyntaxhighlight lang="ceylon">shared void run() {
function notAdjacent(Integer a, Integer b) => (a - b).magnitude >= 2;
Line 1,135:
print(solutions.first else "No solution!");
}</langsyntaxhighlight>
{{out}}
<pre>baker lives on 3
Line 1,151:
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:
(println "solution(s) highest to lowest floor:")
(doseq [soln solns] (println " " soln)))
</syntaxhighlight>
</lang>
{{out}}
<pre>solution count: 1
Line 1,196:
=={{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:
(fail))
(format t "(~{~A~^ ~})~%" building))))
</syntaxhighlight>
</lang>
 
=={{header|Crystal}}==
Line 1,246:
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:
]
 
puts residents.permutations.find { |p| predicates.all? &.call p }</langsyntaxhighlight>
 
=={{header|D}}==
Line 1,277:
 
As for flexibility: the solve code works with an arbitrary number of people and predicates.
<langsyntaxhighlight lang="d">import std.stdio, std.math, std.algorithm, std.traits, permutations2;
 
void main() {
Line 1,293:
.filter!(solution => predicates.all!(pred => pred(solution)))
.writeln;
}</langsyntaxhighlight>
{{out}}
<pre>[[Fletcher, Cooper, Miller, Smith, Baker]]</pre>
 
===Simpler Version===
<langsyntaxhighlight lang="d">void main() {
import std.stdio, std.math, std.algorithm, permutations2;
 
Line 1,310:
abs(s.countUntil("Cooper") - s.countUntil("Fletcher")) != 1)
.writeln;
}</langsyntaxhighlight>
The output is the same.
 
Line 1,316:
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:
(make-hash)) ;; hash table : "name" -> floor
)
</syntaxhighlight>
</lang>
=== Problem data - constraints ===
<langsyntaxhighlight lang="scheme">
(define names '("baker" "cooper" "fletcher" "miller" "smith" ))
 
Line 1,368:
(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:
)
 
</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:
end
 
Dinesman.problem</langsyntaxhighlight>
 
{{out}}
Line 1,443:
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:
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:
 
=={{header|ERRE}}==
<langsyntaxhighlight ERRElang="erre">PROGRAM DINESMAN
 
BEGIN
Line 1,546:
END FOR ! Cooper
END FOR ! Baker
END PROGRAM</langsyntaxhighlight>
{{out}}
<pre>
Line 1,558:
=={{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:
&& 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:
=={{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:
 
: dinesman ( -- )
solutions [ >names . ] each ;</langsyntaxhighlight>
{{out}}
<pre>{
Line 1,623:
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:
; \ show the solution
 
dinesman</langsyntaxhighlight>
{{out}}
<pre>
Line 1,684:
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 1,805:
fmt.Println(t, f)
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,818:
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:
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:
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:
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:
procedure top() # return top
return *nameL
end</langsyntaxhighlight>
 
{{out}}
Line 1,970:
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:
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:
'''Code:'''
 
<langsyntaxhighlight lang="java">import java.util.*;
 
class DinesmanMultipleDwelling {
Line 2,080:
}
}
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,097:
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:
 
// --> [{"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:
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:
// --> [{"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:
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:
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:
| 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:
"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:
 
solutions = solve(Names, predicates)
foreach(x -> println(join(x, ", ")), solutions)</langsyntaxhighlight>
 
{{out}}
Line 2,300:
Tested with Kona.
 
<syntaxhighlight lang="k">
<lang k>
perm: {x@m@&n=(#?:)'m:!n#n:#x}
filter: {y[& x'y]}
Line 2,313:
p: reject[{adjacent[`Cooper; `Fletcher; x]}; p]
p: reject[{(x ? `Fletcher)_in (0 4)}; p]
</syntaxhighlight>
</lang>
Output:
<pre>
Line 2,320:
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">// version 1.1.3
 
typealias Predicate = (List<String>) -> Boolean
Line 2,369:
}
}
}</langsyntaxhighlight>
 
{{out}}
Line 2,383:
 
=={{header|Lua}}==
<langsyntaxhighlight lang="lua">local wrap, yield = coroutine.wrap, coroutine.yield
local function perm(n)
local r = {}
Line 2,445:
end
 
print(solve (conds, tenants))</langsyntaxhighlight>
{{Output}}
<pre> Baker lives on floor 3
Line 2,455:
=={{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:
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:
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:
constraint res[Cooper] < res[Miller];
output["\(n) resides on floor \(res[n])\n" | n in names]
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,511:
 
=={{header|Nim}}==
<langsyntaxhighlight Nimlang="nim">import algorithm
 
type
Line 2,532:
if not floors.nextPermutation():
echo "No solution found."
break</langsyntaxhighlight>
 
{{out}}
Line 2,547:
'''Setup'''
 
<langsyntaxhighlight lang="perl">use strict;
use warnings;
use feature <state say>;
Line 2,602:
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:
Thus, the problem statement from the task description translates to:
 
<langsyntaxhighlight lang="perl">parse_and_solve(<DATA>);
 
__DATA__
Line 2,634:
Miller higher than Cooper
Smith not adjacent to Fletcher
Fletcher not adjacent to Cooper</langsyntaxhighlight>
 
{{out}}
Line 2,646:
=={{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:
<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:
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:
<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===
<langsyntaxhighlight lang="picat">import util.
import cp.
 
Line 2,761:
solve(X),
 
println([baker=Baker, cooper=Cooper, fletcher=Fletcher, miller=Miller, smith=Smith]).</langsyntaxhighlight>
 
{{out}}
Line 2,767:
 
===Using permutations===
<syntaxhighlight lang="picat">%
<lang Picat>%
% floors: 1: bottom .. 5: top floor
%
Line 2,785:
println([baker=B, cooper=C, fletcher=F, miller=M, smith=S])
end.
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,792:
=={{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,818:
(or
((equal (@Tenant1 @Tenant2 . @) @Rest))
((equal (@Tenant2 @Tenant1 . @) @Rest)) ) )</langsyntaxhighlight>
{{out}}
<pre>: (? (dwelling @Result))
Line 2,826:
=={{header|PowerShell}}==
{{trans|BBC BASIC}}
<syntaxhighlight lang="powershell">
<lang PowerShell>
# Floors are numbered 1 (ground) to 5 (top)
 
Line 2,895:
}
}
</syntaxhighlight>
</lang>
The solution sorted by name:
<syntaxhighlight lang="powershell">
<lang PowerShell>
$multipleDwellings
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 2,911:
</pre>
The solution sorted by floor:
<syntaxhighlight lang="powershell">
<lang PowerShell>
$multipleDwellings | Sort-Object -Property Floor -Descending
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 2,930:
Works with SWI-Prolog and library(clpfd) written by '''Markus Triska'''.
 
<langsyntaxhighlight Prologlang="prolog">:- use_module(library(clpfd)).
 
:- dynamic top/1, bottom/1.
Line 3,012:
solve(L),
maplist(writeln, L).
</syntaxhighlight>
</lang>
 
{{out}}
Line 3,033:
===Plain Prolog version===
 
<langsyntaxhighlight Prologlang="prolog">select([A|As],S):- select(A,S,S1),select(As,S1).
select([],_).
 
Line 3,066:
-> 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,076:
 
===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,102:
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,114:
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,245:
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,271:
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,307:
adjacent to Cooper's. Where does everyone live</pre>
 
<langsyntaxhighlight lang="python">from amb import Amb
if __name__ == '__main__':
Line 3,364:
print 'No solution found.'
print
</syntaxhighlight>
</lang>
 
{{out}}
Line 3,385:
===Simple Solutions===
 
<langsyntaxhighlight lang="python">from itertools import permutations
 
class Names:
Line 3,402:
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,410:
{{Trans|Haskell}}
{{Works with|Python|3.7}}
<langsyntaxhighlight lang="python">'''Dinesman's multiple-dwelling problem'''
 
from itertools import permutations
Line 3,431:
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,438:
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,498:
# 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,504:
=={{header|R}}==
 
<syntaxhighlight lang="r">
<lang R>
names = unlist(strsplit("baker cooper fletcher miller smith", " "))
 
Line 3,521:
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,533:
user system elapsed
0 0 0
</syntaxhighlight>
</lang>
 
=={{header|Racket}}==
Line 3,539:
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,583:
(printf "Solution:\n")
(for ([x (sort residents > #:key car)]) (apply printf " ~a. ~a\n" x)))
</syntaxhighlight>
</lang>
 
{{out}}
Line 3,601:
{{trans|Perl}}
 
<syntaxhighlight lang="raku" perl6line>use MONKEY-SEE-NO-EVAL;
 
sub parse_and_solve ($text) {
Line 3,642:
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,653:
===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,663:
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,695:
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,735:
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,747:
 
=={{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,776:
next
next
</syntaxhighlight>
</lang>
Output:
<pre>
Line 3,789:
===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,815:
names.permutation.detect{|candidate| predicates.all?{|predicate| predicate.(candidate)}}
end</langsyntaxhighlight>
 
The program operates under these assumptions:
Line 3,824:
 
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,849:
adjacent to Cooper's. Where does everyone live?"
 
[demo1, demo2, problem1, problem2].each{|problem| puts solve( problem ) ;puts }</langsyntaxhighlight>
{{Output}}
<pre>
Line 3,878:
===Simple solution===
{{Trans|D}}
<langsyntaxhighlight lang="ruby">names = %i( Baker Cooper Fletcher Miller Smith )
 
predicates = [->(c){ :Baker != c.last },
Line 3,887:
->(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,898:
 
===Using grep===
<langsyntaxhighlight lang="ruby">
N = %w(Baker Cooper Fletcher Miller Smith)
b,c,f,m,s = N
Line 3,910:
(?=.*(#{f}..+#{c}|#{c}..+#{f}))/x).
first
</syntaxhighlight>
</lang>
<pre>
"Smith Cooper Baker Fletcher Miller"
Line 3,916:
 
=={{header|Scala}}==
<langsyntaxhighlight Scalalang="scala">import scala.math.abs
 
object Dinesman3 extends App {
Line 3,942:
}
}
}</langsyntaxhighlight>
{{out}}
Solutions: 1
Line 3,953:
===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,983:
}
}
}</langsyntaxhighlight>
{{out}}
Solutions: 1
Line 3,995:
===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 4,041:
}
}
}</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 4,079:
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,103:
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,132:
===Simple solution===
{{trans|Ruby}}
<langsyntaxhighlight lang="ruby">var names = %w(Baker Cooper Fletcher Miller Smith)
 
var predicates = [
Line 4,148:
break
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,160:
=={{header|Tailspin}}==
===Simple solution===
<langsyntaxhighlight lang="tailspin">
templates permutations
when <=1> do [1] !
Line 4,189:
-> $(last..first:-1)
-> '$...;$#10;' -> !OUT::write
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 4,200:
 
===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,225:
'No more solutions
' -> !OUT::write
</syntaxhighlight>
</lang>
 
{{out}}
Line 4,244:
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,274:
}
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,286:
}]
puts "Solution found:"
foreach {where who} $soln {puts " Floor ${where}: $who"}</langsyntaxhighlight>
 
{{out}}
Line 4,301:
{{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,373:
fi
done
done</langsyntaxhighlight>
 
Sample output:
Line 4,380:
=={{header|UTFool}}==
 
<syntaxhighlight lang="utfool">
<lang UTFool>
···
http://rosettacode.org/wiki/Dinesman's_multiple-dwelling_problem
Line 4,428:
people.insert i, person
house.setLength house.length° - 1
</syntaxhighlight>
</lang>
'''Output''':
<pre>SCBFM</pre>
Line 4,435:
{{trans|Kotlin}}
{{libheader|Wren-seq}}
<langsyntaxhighlight lang="ecmascript">import "/seq" for Lst
 
var permute // recursive
Line 4,482:
System.print()
}
}</langsyntaxhighlight>
 
{{out}}
Line 4,497:
=={{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,513:
Text(0, "Miller "); IntOut(0, M); CrLf(0);
Text(0, "Smith "); IntOut(0, S); CrLf(0);
]</langsyntaxhighlight>
 
Output:
Line 4,530:
 
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,549:
break;
}
}</langsyntaxhighlight>
{{out}}
<pre>
10,339

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.