Dinesman's multiple-dwelling problem: Difference between revisions

Added Forth version
(Added Forth version)
Line 208:
<pre>[Fletcher, Cooper, Miller, Smith, Baker]</pre>
 
=={{header|Forth}}==
This solution takes advantage of several of Forth's strengths. Forth is able to picture a number in any base from 2 to 36.
 
This program simply iterates through all numbers between 01234 and 43210 (base 5). To see whether this is a permutation worth testing, a binary mask is generated. If all 5 bits are set (31 decimal), this is a possible candidate. Then all ASCII digits of the generated number are converted back to numbers by subtracting the value of ASCII "0". Finally each of the conditions is tested.
 
Although this is not ANS Forth, one should have little trouble converting it.
{{works with|4tH|3.6.20}}
<lang forth> 0 enum baker \ enumeration of all tenants
enum cooper
enum fletcher
enum miller
constant smith
 
create names \ names of all the tenants
," Baker"
," Cooper"
," Fletcher"
," Miller"
," Smith" \ get name, type it
does> swap cells + @c count type ." lives in ";
 
5 constant #floor \ number of floors
#floor 1- constant top \ top floor
0 constant bottom \ we're counting the floors from 0
 
: num@ c@ [char] 0 - ; ( a -- n)
: floor chars over + num@ ; ( a n1 -- a n2)
\ is it a valid permutation?
: perm? ( n -- a f)
#floor base ! 0 swap s>d <# #floor 0 ?do # loop #>
over >r bounds do 1 i num@ lshift + loop
31 = r> swap decimal \ create binary mask and check
;
\ test a solution
: solution? ( a -- a f)
baker floor top <> \ baker on top floor?
if cooper floor bottom <> \ cooper on the bottom floor?
if fletcher floor dup bottom <> swap top <> and
if cooper floor swap miller floor rot >
if smith floor swap fletcher floor rot - abs 1 <>
if cooper floor swap fletcher floor rot - abs 1 <>
if true exit then \ we found a solution!
then
then
then
then
then false \ nice try, no cigar..
;
\ main routine
: dinesman ( --)
2932 194 do i perm? if solution? if leave else drop then else drop then loop
#floor 0 do i names i chars over + c@ 1+ emit cr loop drop
; \ show the solution
 
dinesman</lang>
Output:
<pre>
Baker lives in 3
Cooper lives in 2
Fletcher lives in 4
Miller lives in 5
Smith lives in 1
</pre>
=={{header|Haskell}}==
The List monad is perfect for this kind of problem. One can express the problem statements in a very natural and concise way:
374

edits