Dinesman's multiple-dwelling problem: Difference between revisions
Dinesman's multiple-dwelling problem (view source)
Revision as of 23:44, 26 August 2022
, 1 year agosyntax highlighting fixup automation
(→{{header|Picat}}: Moved into subsections, added {{out}}) |
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
||
Line 28:
{{trans|Nim}}
<
BAKER = 0
COOPER = 1
Line 51:
I !floors.next_permutation()
print(‘No solution found.’)
L.break</
{{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.
<
procedure Dinesman is
subtype Floor is Positive range 1 .. 5;
Line 111:
end loop;
Solve (thefloors'Access, Floors'Length);
end Dinesman;</
{{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.
<
# SETUP #
Line 193:
FI
OD
OD</
{{out}}
<pre>
Line 207:
=={{header|AWK}}==
<syntaxhighlight 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>
{{out}}
<pre>
Line 261:
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<
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</
{{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.
<
REM "Baker, Cooper, Fletcher, Miller, and Smith live on different floors":
Line 344:
NEXT Cooper
NEXT Baker
END</
{{out}}
<pre>
Line 356:
==={{header|FreeBASIC}}===
<
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</
{{out}}
<pre>
Line 408:
==={{header|IS-BASIC}}===
<
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</
==={{header|PureBasic}}===
{{incomplete|PureBasic|Examples should state what changes to the problem text are allowed.}}
<
Enumeration #Null
Line 529:
Next
Print("Press ENTER to exit"): Input()
EndIf</
<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">
EnableExplicit
Line 638:
CloseConsole( )
End</
<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.
<
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</
<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</
Output:
Line 750:
==={{header|Yabasic}}===
{{trans|FreeBASIC}}
<
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</
{{out}}
<pre>
Line 785:
==={{header|ZX Spectrum Basic}}===
{{trans|BBC_BASIC}}
<
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</
=={{header|Bracmat}}==
Line 820:
If there are no reserved characters in a name, double quotes are optional.
<
& ( 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. }
);</
<pre>Inhabitants, from bottom to top: Smith Cooper Baker Fletcher Miller</pre>
=={{header|C}}==
<
#include <stdlib.h>
Line 929:
if (!solve(0)) printf("Nobody lives anywhere\n");
return 0;
}</
{{out}}
<pre>Found arrangement:
Line 945:
=={{header|C++}}==
{{Works with|C++14}}
<
#include <array>
#include <cmath>
Line 984:
return EXIT_SUCCESS;
}</
=={{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.
<
{
public static void Main()
Line 1,060:
if (index == position) yield return newElement;
}
}</
{{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}}
<
using System.Collections.Generic;
using static System.Linq.Enumerable;
Line 1,106:
public static IEnumerable<T> ToSingleton<T>(this T item) { yield return item; }
}</
{{out}}
<pre>Smith Cooper Baker Fletcher Miller
Line 1,112:
=={{header|Ceylon}}==
<
function notAdjacent(Integer a, Integer b) => (a - b).magnitude >= 2;
Line 1,135:
print(solutions.first else "No solution!");
}</
{{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.
<
(: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>
{{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.
<
(defpackage :dinesman
(:use :cl
Line 1,240:
(fail))
(format t "(~{~A~^ ~})~%" building))))
</syntaxhighlight>
=={{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.
<
def index!(element)
index(element).not_nil!
Line 1,263:
]
puts residents.permutations.find { |p| predicates.all? &.call p }</
=={{header|D}}==
Line 1,277:
As for flexibility: the solve code works with an arbitrary number of people and predicates.
<
void main() {
Line 1,293:
.filter!(solution => predicates.all!(pred => pred(solution)))
.writeln;
}</
{{out}}
<pre>[[Fletcher, Cooper, Miller, Smith, Baker]]</pre>
===Simpler Version===
<
import std.stdio, std.math, std.algorithm, permutations2;
Line 1,310:
abs(s.countUntil("Cooper") - s.countUntil("Fletcher")) != 1)
.writeln;
}</
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===
<
(require 'hash)
(require' amb)
Line 1,344:
(make-hash)) ;; hash table : "name" -> floor
)
</syntaxhighlight>
=== Problem data - constraints ===
<
(define names '("baker" "cooper" "fletcher" "miller" "smith" ))
Line 1,368:
(amb-require (not (touch "fletcher" "cooper")))
)
</syntaxhighlight>
{{out}}
<
(task names)
→ ((baker . 2) (cooper . 1) (fletcher . 3) (miller . 4) (smith . 0))
</syntaxhighlight>
=== Changing data - constraints ===
<
;; add a name/floor
(define names '("baker" "cooper" "fletcher" "miller" "smith" "antoinette"))
Line 1,390:
)
</syntaxhighlight>
{{out}}
<
(task names)
→ ((baker . 0) (cooper . 1) (fletcher . 3) (miller . 4) (smith . 5) (antoinette . 2))
</syntaxhighlight>
=={{header|Elixir}}==
{{trans|Ruby}}
'''Simple solution:'''
<
def problem do
names = ~w( Baker Cooper Fletcher Miller Smith )a
Line 1,426:
end
Dinesman.problem</
{{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">
-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>
{{out}}
<pre>
Line 1,499:
=={{header|ERRE}}==
<
BEGIN
Line 1,546:
END FOR ! Cooper
END FOR ! Baker
END PROGRAM</
{{out}}
<pre>
Line 1,558:
=={{header|F_Sharp|F#}}==
This task uses [[Permutations_by_swapping#F.23]]
<
// 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>
{{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?``
<
combinators.short-circuit
math math.combinatorics math.ranges
Line 1,604:
: dinesman ( -- )
solutions [ >names . ] each ;</
{{out}}
<pre>{
Line 1,623:
Although this is not ANS Forth, one should have little trouble converting it.
{{works with|4tH|3.6.20}}
<
enum cooper
enum fletcher
Line 1,673:
; \ show the solution
dinesman</
{{out}}
<pre>
Line 1,684:
=={{header|Go}}==
<
import "fmt"
Line 1,805:
fmt.Println(t, f)
}
}</
{{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+}}
<
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)]</
Or as a list comprehension (syntactic sugar for a list monad):
<
main :: IO ()
Line 1,876:
abs (s - f) > 1,
abs (c - f) > 1
]</
{{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).
<
global nameL, nameT, rules
Line 1,955:
procedure top() # return top
return *nameL
end</
{{out}}
Line 1,970:
We can represent these possibilities as permutations of the residents' initials, arranged in order from lowest floor to top floor:
<
Additionally, we are given a variety of constraints which eliminate some possibilities:
<
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</
The answer is thus:
<
SCBFM</
(bottom floor) Smith, Cooper, Baker, Fletcher, Miller (top floor)
Line 1,994:
'''Code:'''
<
class DinesmanMultipleDwelling {
Line 2,080:
}
}
</syntaxhighlight>
{{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.
<
'use strict';
Line 2,150:
// --> [{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}]
})();</
{{Out}}
<
====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.
<
'use strict';
Line 2,219:
// --> [{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}]
})();
</syntaxhighlight>
<
=={{header|jq}}==
Line 2,230:
The solution presented here does not blindly generate all permutations. It can be characterized as a constraint-oriented approach.
<
# 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);</
'''Solution''':
<
| 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.</
'''Out''':
<syntaxhighlight lang="sh">
$ jq -n -f Dinesman.jq
[
Line 2,265:
"Fletcher",
"Miller"
]</
=={{header|Julia}}==
{{works with|Julia|0.6}}
<
function solve(n::Vector{<:AbstractString}, pred::Vector{<:Function})
Line 2,292:
solutions = solve(Names, predicates)
foreach(x -> println(join(x, ", ")), solutions)</
{{out}}
Line 2,300:
Tested with Kona.
<syntaxhighlight 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>
Output:
<pre>
Line 2,320:
=={{header|Kotlin}}==
<
typealias Predicate = (List<String>) -> Boolean
Line 2,369:
}
}
}</
{{out}}
Line 2,383:
=={{header|Lua}}==
<
local function perm(n)
local r = {}
Line 2,445:
end
print(solve (conds, tenants))</
{{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">
{Baker, Cooper, Fletcher, Miller, Smith};
(Unequal @@ %) && (And @@ (0 < # < 6 & /@ %)) &&
Line 2,465:
Abs[Cooper - Fletcher] > 1 //
Reduce[#, %, Integers] &
</syntaxhighlight>
{{out}}
<
===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">
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>
{{out}}
<
=={{header|MiniZinc}}==
<syntaxhighlight 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>
{{out}}
<pre>
Line 2,511:
=={{header|Nim}}==
<
type
Line 2,532:
if not floors.nextPermutation():
echo "No solution found."
break</
{{out}}
Line 2,547:
'''Setup'''
<
use warnings;
use feature <state say>;
Line 2,602:
if ('.join(' && ', @expressions).');
} @f;';
}</
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:
<
__DATA__
Line 2,634:
Miller higher than Cooper
Smith not adjacent to Fletcher
Fletcher not adjacent to Cooper</
{{out}}
Line 2,646:
=={{header|Phix}}==
Simple static/hard-coded solution (brute force search)
<!--<
<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>
<!--</
{{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.
<!--<
<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>
<!--</
Same output
=={{header|Picat}}==
===Constraint modelling===
<
import cp.
Line 2,761:
solve(X),
println([baker=Baker, cooper=Cooper, fletcher=Fletcher, miller=Miller, smith=Smith]).</
{{out}}
Line 2,767:
===Using permutations===
<syntaxhighlight lang="picat">%
% floors: 1: bottom .. 5: top floor
%
Line 2,785:
println([baker=B, cooper=C, fletcher=F, miller=M, smith=S])
end.
</syntaxhighlight>
{{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.
<
(be dwelling (@Tenants)
(permute (Baker Cooper Fletcher Miller Smith) @Tenants)
Line 2,818:
(or
((equal (@Tenant1 @Tenant2 . @) @Rest))
((equal (@Tenant2 @Tenant1 . @) @Rest)) ) )</
{{out}}
<pre>: (? (dwelling @Result))
Line 2,826:
=={{header|PowerShell}}==
{{trans|BBC BASIC}}
<syntaxhighlight lang="powershell">
# Floors are numbered 1 (ground) to 5 (top)
Line 2,895:
}
}
</syntaxhighlight>
The solution sorted by name:
<syntaxhighlight lang="powershell">
$multipleDwellings
</syntaxhighlight>
{{Out}}
<pre>
Line 2,911:
</pre>
The solution sorted by floor:
<syntaxhighlight lang="powershell">
$multipleDwellings | Sort-Object -Property Floor -Descending
</syntaxhighlight>
{{Out}}
<pre>
Line 2,930:
Works with SWI-Prolog and library(clpfd) written by '''Markus Triska'''.
<
:- dynamic top/1, bottom/1.
Line 3,012:
solve(L),
maplist(writeln, L).
</syntaxhighlight>
{{out}}
Line 3,033:
===Plain Prolog version===
<
select([],_).
Line 3,066:
-> maplist( writeln, L), nl, write('No more solutions.')
; write('No solutions.').
</syntaxhighlight>
Ease of change (flexibility) is arguably evident in the code. [http://ideone.com/8n9IQ The output]:
Line 3,076:
===Testing as soon as possible===
<
%% 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>
[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.
<
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)</
;Problem statement
This is not much more than calling a function on the text of the problem!
<
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?""")</
;Output
Line 3,307:
adjacent to Cooper's. Where does everyone live</pre>
<
if __name__ == '__main__':
Line 3,364:
print 'No solution found.'
print
</syntaxhighlight>
{{out}}
Line 3,385:
===Simple Solutions===
<
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])))</
{{out}}
<pre>Smith Cooper Baker Fletcher Miller</pre>
Line 3,410:
{{Trans|Haskell}}
{{Works with|Python|3.7}}
<
from itertools import permutations
Line 3,431:
1 < abs(c - f)
])
])</
{{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):
<
from itertools import chain, permutations
Line 3,498:
# MAIN ---
if __name__ == '__main__':
main()</
{{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">
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>
Testing:
<syntaxhighlight 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>
=={{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.
<
#lang racket
Line 3,583:
(printf "Solution:\n")
(for ([x (sort residents > #:key car)]) (apply printf " ~a. ~a\n" x)))
</syntaxhighlight>
{{out}}
Line 3,601:
{{trans|Perl}}
<syntaxhighlight lang="raku"
sub parse_and_solve ($text) {
Line 3,642:
Smith not adjacent to Fletcher
Fletcher not adjacent to Cooper
END</
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"
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
;
}</
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 '''==''' could be simplified to '''=''' for readability.
<
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.*/</
{{out|output|text= when using the internal default values and definitions:}}
<pre>
Line 3,747:
=={{header|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>
Output:
<pre>
Line 3,789:
===By parsing the problem===
Inspired by the Python version.
<
lines = problem.split(".")
names = lines.first.scan( /[A-Z]\w*/ )
Line 3,815:
names.permutation.detect{|candidate| predicates.all?{|predicate| predicate.(candidate)}}
end</
The program operates under these assumptions:
Line 3,824:
Program invocation:
<
#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 }</
{{Output}}
<pre>
Line 3,878:
===Simple solution===
{{Trans|D}}
<
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)}}</
{{Output}}
<pre>
Line 3,898:
===Using grep===
<
N = %w(Baker Cooper Fletcher Miller Smith)
b,c,f,m,s = N
Line 3,910:
(?=.*(#{f}..+#{c}|#{c}..+#{f}))/x).
first
</syntaxhighlight>
<pre>
"Smith Cooper Baker Fletcher Miller"
Line 3,916:
=={{header|Scala}}==
<
object Dinesman3 extends App {
Line 3,942:
}
}
}</
{{out}}
Solutions: 1
Line 3,953:
===Extended task===
We can extend this problem by adding a tenant resp. adding conditions:
<
object Dinesman3 extends App {
Line 3,983:
}
}
}</
{{out}}
Solutions: 1
Line 3,995:
===Enhanced Solution ===
Combine the rules with the person names and separated the original task with an extension.
<
object Dinesman2 extends App {
Line 4,041:
}
}
}</
=={{header|Sidef}}==
===By parsing the problem===
{{trans|Ruby}}
<
var lines = problem.split('.')
var names = lines.first.scan(/\b[A-Z]\w*/)
Line 4,079:
predicates.all { |predicate| predicate(candidate) } && return candidate
}
}</
Function invocation:
<
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 '' }</
{{out}}
<pre>
Line 4,132:
===Simple solution===
{{trans|Ruby}}
<
var predicates = [
Line 4,148:
break
}
}</
{{out}}
<pre>
Line 4,160:
=={{header|Tailspin}}==
===Simple solution===
<
templates permutations
when <=1> do [1] !
Line 4,189:
-> $(last..first:-1)
-> '$...;$#10;' -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
Line 4,200:
===Re-using the solver we created for the Zebra puzzle===
<
// 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>
{{out}}
Line 4,244:
that produce a value that is/can be interpreted as a boolean.
{{tcllib|struct::list}}
<
package require struct::list
Line 4,274:
}
return $result
}</
Solve the particular problem:
<
{$Baker != 5}
{$Cooper != 1}
Line 4,286:
}]
puts "Solution found:"
foreach {where who} $soln {puts " Floor ${where}: $who"}</
{{out}}
Line 4,301:
{{works with|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</
Sample output:
Line 4,380:
=={{header|UTFool}}==
<syntaxhighlight lang="utfool">
···
http://rosettacode.org/wiki/Dinesman's_multiple-dwelling_problem
Line 4,428:
people.insert i, person
house.setLength house.length° - 1
</syntaxhighlight>
'''Output''':
<pre>SCBFM</pre>
Line 4,435:
{{trans|Kotlin}}
{{libheader|Wren-seq}}
<
var permute // recursive
Line 4,482:
System.print()
}
}</
{{out}}
Line 4,497:
=={{header|XPL0}}==
{{incomplete|XPL0|Examples should state what changes to the problem text are allowed.}}
<
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);
]</
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.
<
const bottom=1,top=5; // floors: 1..5
// All live on different floors, enforced by using permutations of floors
Line 4,549:
break;
}
}</
{{out}}
<pre>
|