Dinesman's multiple-dwelling problem: Difference between revisions

</pre>

=={{header|Tcl}}==

{{tcllib|struct::list}}

<lang tcl>package require Tcl 8.5

package require struct::list

proc dinesmanSolve {floors people constraints} {

# Search for a possible assignment that satisfies the constraints

struct::list foreachperm p $floors {

lassign $p {*}$people

set found 1

foreach c $constraints {

if {![expr $c]} {

set found 0

break

}

}

if {$found} break

}

# Found something, or exhausted possibilities

if {!$found} {

error "no solution possible"

}

# Generate in "nice" order

foreach f $floors {

foreach person $people {

if {[set $person] == $f} {

lappend result $f $person

break

}

}

}

return $result

}</lang>

Solve the particular problem:

<lang tcl>set soln [dinesmanSolve {1 2 3 4 5} {Baker Cooper Fletcher Miller Smith} {

{$Baker != 5}

{$Cooper != 1}

{$Fletcher != 1 && $Fletcher != 5}

{$Miller > $Cooper}

{abs($Smith-$Fletcher) != 1}

{abs($Fletcher-$Cooper) != 1}

}]

puts "Solution found:"

foreach {where who} $soln {puts " Floor ${where}: $who"}</lang>

Output:

<pre>

Solution found:

Floor 1: Smith

Floor 2: Cooper

Floor 3: Baker

Floor 4: Fletcher

Floor 5: Miller