Dinesman's multiple-dwelling problem: Difference between revisions

''Where does everyone live?''<br>

<br><br>

 

=={{header|Ada}}==

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;

end loop;

Solve (thefloors'Access, Floors'Length);

{{out}}

<pre>BAKER on floor 3

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 #

FI

OD

{{out}}

<pre>

0 Smith

</pre>

 

=={{header|AutoHotkey}}==

 

=={{header|AWK}}==

# syntax: GAWK -f DINESMANS_MULTIPLE-DWELLING_PROBLEM.AWK

BEGIN {

}

function abs(x) { if (x >= 0) { return x } else { return -x } }

{{out}}

<pre>

</pre>

 

{{works with|BBC BASIC for Windows}}

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

NEXT Cooper

NEXT Baker

{{out}}

<pre>

Smith lives on floor 0

</pre>

 

=={{header|Bracmat}}==

If there are no reserved characters in a name, double quotes are optional.

 

& ( constraints

=

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

 

if (!solve(0)) printf("Nobody lives anywhere\n");

return 0;

{{out}}

<pre>Found arrangement:

=={{header|C++}}==

{{Works with|C++14}}

#include <array>

#include <cmath>

 

return EXIT_SUCCESS;

 

===Constraints as functions solution===

Usage of the DinesmanSolver is very simple. Just feed it a bunch of constraints in the form of functions. (It could also be one function with a bunch of 'and' clauses)<br/>

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

if (index == position) yield return newElement;

}

{{out}}

<pre>

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;

 

public static IEnumerable<T> ToSingleton<T>(this T item) { yield return item; }

{{out}}

<pre>Smith Cooper Baker Fletcher Miller

 

=={{header|Ceylon}}==

function notAdjacent(Integer a, Integer b) => (a - b).magnitude >= 2;

print(solutions.first else "No solution!");

{{out}}

<pre>baker lives on 3

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

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

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

{{out}}

<pre>solution count: 1

=={{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

(fail))

(format t "(~{~A~^ ~})~%" building))))

 

=={{header|Crystal}}==

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!

]

 

 

=={{header|D}}==

 

This code uses the second lazy permutations function of '''[[Permutations#Lazy_version]]'''.

 

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

 

void main() {

enum Names { Baker, Cooper, Fletcher, Miller, Smith }

 

immutable(bool function(in Names[]) pure nothrow)[] predicates = [

.writeln;

{{out}}

 

===Simpler Version===

 

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

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

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

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

The output is the same.

 

=={{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===

(require 'hash)

(require' amb)

(make-hash)) ;; hash table : "name" -> floor

)

=== Problem data - constraints ===

(define names '("baker" "cooper" "fletcher" "miller" "smith" ))

 

(amb-require (not (touch "fletcher" "cooper")))

)

{{out}}

(task names)

→ ((baker . 2) (cooper . 1) (fletcher . 3) (miller . 4) (smith . 0))

=== Changing data - constraints ===

;; add a name/floor

(define names '("baker" "cooper" "fletcher" "miller" "smith" "antoinette"))

)

 

{{out}}

(task names)

→ ((baker . 0) (cooper . 1) (fletcher . 3) (miller . 4) (smith . 5) (antoinette . 2))

 

=={{header|Elixir}}==

{{trans|Ruby}}

'''Simple solution:'''

def problem do

names = ~w( Baker Cooper Fletcher Miller Smith )a

end

 

 

{{out}}

The design of the rules can be argued.

Perhaps {cooper, does_not_live_on, 0}, etc, would be better for people unfamiliar with lisp.

-module( dinesman_multiple_dwelling ).

 

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.

{{out}}

<pre>

 

=={{header|ERRE}}==

 

BEGIN

END FOR ! Cooper

END FOR ! Baker

{{out}}

<pre>

</pre>

 

=={{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

 

: dinesman ( -- )

{{out}}

<pre>{

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

{{works with|4tH|3.6.20}}

enum cooper

enum fletcher

; \ show the solution

 

{{out}}

<pre>

 

=={{header|Go}}==

 

import "fmt"

fmt.Println(t, f)

}

{{out}}

<pre>

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)

 

main = do

print $ head dinesman -- print first solution: (3,2,4,5,1)

 

 

main :: IO ()

main =

print

{{out}}

<pre>[("Baker lives on 3","Cooper lives on 2","Fletcher lives on 4","Miller lives on 5","Smith lives on 1")]</pre>

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

 

procedure top() # return top

return *nameL

 

{{out}}

Miller lives in 5

Smith lives in 1</pre>

 

=={{header|J}}==

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

possible=: (#~ 0 = +/@E."1~&'FS') possible NB. Fletcher not immediately below Smith

possible=: (#~ 0 = +/@E."1~&'CF') possible NB. Cooper not immediately below Fletcher

 

The answer is thus:

 

 

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

'''Code:'''

 

 

class DinesmanMultipleDwelling {

}

}

 

{{out}}

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

 

 

// --> [{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}]

 

{{Out}}

 

====Less flexibility====

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

 

// --> [{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}]

})();

 

 

=={{header|jq}}==

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.

def bottom: 0;

def higher(j): . > j;

'''Solution''':

| resides("Baker"; . != top) # Baker does not live on the top floor

| resides("Cooper"; . != bottom) # Cooper does not live on the bottom floor

| index("Fletcher") as $Fletcher

| resides("Smith"; adjacent($Fletcher) | not) # Smith does not live on a floor adjacent to Fletcher's.

'''Out''':

$ jq -n -f Dinesman.jq

[

"Fletcher",

"Miller"

 

=={{header|Julia}}==

{{works with|Julia|0.6}}

 

 

function solve(n::Vector{<:AbstractString}, pred::Vector{<:Function})

 

solutions = solve(Names, predicates)

 

{{out}}

Tested with Kona.

 

perm: {x@m@&n=(#?:)'m:!n#n:#x}

filter: {y[& x'y]}

p: reject[{adjacent[`Cooper; `Fletcher; x]}; p]

p: reject[{(x ? `Fletcher)_in (0 4)}; p]

Output:

<pre>

 

=={{header|Kotlin}}==

 

typealias Predicate = (List<String>) -> Boolean

}

}

 

{{out}}

 

=={{header|Lua}}==

local function perm(n)

local r = {}

end

 

{{Output}}

<pre> Baker lives on floor 3

Miller lives on floor 5

Smith lives on floor 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.

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

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

Abs[Cooper - Fletcher] > 1 //

Reduce[#, %, Integers] &

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

 

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

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

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

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

 

{{out}}

 

=={{header|Perl}}==

'''Setup'''

 

use warnings;

use List::Util 1.33 qw(pairmap);

use Algorithm::Permute qw(permute);

my $pred = $predicates{$+{pred}};

}

my @f = 1..$i;

permute {

say join(", ", pairmap { "$f[$b] $a" } %ids)

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.

Thus, the problem statement from the task description translates to:

 

 

__DATA__

Miller higher than Cooper

Smith not adjacent to Fletcher

 

{{out}}

=={{header|Phix}}==

Simple static/hard-coded solution (brute force search)

{{out}}

<pre>

Something more flexible. The nested rules worked just as well, and

of course the code will cope with various content in names/rules.

 

 

 

 

=={{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)

(or

((equal (@Tenant1 @Tenant2 . @) @Rest))

{{out}}

<pre>: (? (dwelling @Result))

=={{header|PowerShell}}==

{{trans|BBC BASIC}}

# Floors are numbered 1 (ground) to 5 (top)

 

}

}

The solution sorted by name:

$multipleDwellings

{{Out}}

<pre>

</pre>

The solution sorted by floor:

$multipleDwellings | Sort-Object -Property Floor -Descending

{{Out}}

<pre>

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

 

 

:- dynamic top/1, bottom/1.

solve(L),

maplist(writeln, L).

 

{{out}}

===Plain Prolog version===

 

select([],_).

 

-> maplist( writeln, L), nl, write('No more solutions.')

; write('No solutions.').

 

Ease of change (flexibility) is arguably evident in the code. [http://ideone.com/8n9IQ The output]:

 

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

X = ['Baker'(Baker), 'Cooper'(Cooper), 'Fletcher'(Fletcher),

'Miller'(Miller), 'Smith'(Smith)].

 

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

 

=={{header|Python}}==

Parsing is done with the aid of the multi-line regular expression at the head of the program.

 

from itertools import product

 

groupname, txt = [(k,v) for k,v in x.groupdict().items() if v][0]

#print ("%r, %r" % (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

floor than does Cooper. Smith does not live on a floor

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

 

;Output

adjacent to Cooper's. Where does everyone live</pre>

 

if __name__ == '__main__':

print 'No solution found.'

print

 

{{out}}

===Simple Solutions===

 

 

class Names:

for sol in permutations(Names.seq):

if all(p(sol) for p in predicates):

{{out}}

<pre>Smith Cooper Baker Fletcher Miller</pre>

{{Trans|Haskell}}

{{Works with|Python|3.7}}

 

from itertools import permutations

1 < abs(c - f)

])

{{Out}}

<pre>[('Baker on 3', 'Cooper on 2', 'Fletcher on 4', 'Miller on 5', 'Smith on 1')]</pre>

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

# MAIN ---

if __name__ == '__main__':

{{Out}}

<pre>Baker in 3, Cooper in 2, Fletcher in 4, Miller in 5, Smith in 1.</pre>

=={{header|R}}==

 

names = unlist(strsplit("baker cooper fletcher miller smith", " "))

 

if (0 == length(seq)) func(built)

else for (x in seq) do.perms( seq[!seq==x], func, c(x, built)) }

 

Testing:

 

> do.perms(names, test)

From bottom to top: --> smith cooper baker fletcher miller

user system elapsed

0 0 0

 

=={{header|Racket}}==

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

 

(printf "Solution:\n")

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

 

{{out}}

{{trans|Perl}}

 

 

sub parse_and_solve ($text) {

Smith not adjacent to Fletcher

Fletcher not adjacent to Cooper

 

Supports the same grammar for the problem statement, as the Perl solution.

===Simple solution===

{{Works with|rakudo|2015-11-15}}

for (flat (1..5).permutations) -> $b, $c, $f, $m, $s {

say "Baker=$b Cooper=$c Fletcher=$f Miller=$m Smith=$s"

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.

The "rules" that contain &nbsp; '''==''' &nbsp; could be simplified to &nbsp; '''=''' &nbsp; for readability.

 

names= 'Baker Cooper Fletcher Miller Smith' /*names of multiple─dwelling tenants. */

#tenants= words(names) /*the number of tenants in the building*/

 

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

/*──────────────────────────────────────────────────────────────────────────────────────*/

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

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

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

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

say right(tenant, 35) 'lives on the' @.p || th(@.p) "floor."

end /*p*/ /* [↑] "||" is REXX's concatenation. */

{{out|output|text=&nbsp; when using the internal default values and definitions:}}

<pre>

 

=={{header|Ring}}==

floor1 = "return baker!=cooper and baker!=fletcher and baker!=miller and

baker!=smith and cooper!=fletcher and cooper!=miller and

next

next

Output:

<pre>

===By parsing the problem===

Inspired by the Python version.

lines = problem.split(".")

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

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

 

The program operates under these assumptions:

 

Program invocation:

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

 

adjacent to Cooper's. Where does everyone live?"

 

{{Output}}

<pre>

===Simple solution===

{{Trans|D}}

 

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

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

 

{{Output}}

<pre>

 

===Using grep===

N = %w(Baker Cooper Fletcher Miller Smith)

b,c,f,m,s = N

(?=.*(#{f}..+#{c}|#{c}..+#{f}))/x).

first

<pre>

"Smith Cooper Baker Fletcher Miller"

</pre>

 

 

 

=={{header|Scala}}==

 

object Dinesman3 extends App {

}

}

{{out}}

Solutions: 1

===Extended task===

We can extend this problem by adding a tenant resp. adding conditions:

 

object Dinesman3 extends App {

}

}

{{out}}

Solutions: 1

===Enhanced Solution ===

Combine the rules with the person names and separated the original task with an extension.

 

object Dinesman2 extends App {

}

}

 

=={{header|Sidef}}==

===By parsing the problem===

{{trans|Ruby}}

var lines = problem.split('.')

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

 

# Build an array of lambda's

var keywords = line.scan(re_keywords)

var (name1, name2) = line.scan(re_names)...

predicates.all { |predicate| predicate(candidate) } && return candidate

}

 

Function invocation:

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

 

adjacent to Cooper's. Where does everyone live?"

 

{{out}}

<pre>

===Simple solution===

{{trans|Ruby}}

 

var predicates = [

break

}

{{out}}

<pre>

Fletcher

Miller

</pre>

 

that produce a value that is/can be interpreted as a boolean.

{{tcllib|struct::list}}

package require struct::list

 

}

return $result

 

Solve the particular problem:

{$Baker != 5}

{$Cooper != 1}

}]

puts "Solution found:"

 

{{out}}

Floor 4: Fletcher

Floor 5: Miller

</pre>

 

{{works with|Bash}}

 

 

# NAMES is a list of names. It can be changed as needed. It can be more than five names, or less.

fi

done

 

Sample output:

=={{header|UTFool}}==

 

···

http://rosettacode.org/wiki/Dinesman's_multiple-dwelling_problem

people.insert i, person

house.setLength house.length° - 1

'''Output''':

<pre>SCBFM</pre>

{{trans|Kotlin}}

{{libheader|Wren-seq}}

 

var permute // recursive

var perms = []

var toInsert = input[0]

for (perm in permute.call(input.skip(1).toList)) {

for (i in 0..perm.count) {

System.print()

}

 

{{out}}

=={{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

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

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

 

Output:

 

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

break;

}

{{out}}

<pre>

L(L("Baker",3),L("Cooper",2),L("Fletcher",4),L("Miller",5),L("Smith",1))

</pre>