Dinesman's multiple-dwelling problem: Difference between revisions

Content added Content deleted
(Dinesman's multiple-dwelling problem en FreeBASIC)
(Dinesman's multiple-dwelling problem en BASIC256 y Yabasic. Agrupados los dialectos BASIC)
Line 220: Line 220:
</pre>
</pre>



=={{header|BBC BASIC}}==
=={{header|BASIC}}==
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<lang 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)."
print "- Cooper no vive en el piso inferior (bajo)."
print "- Fletcher no vive ni en el ático ni en el bajo."
print "- Miller vive en un apartamento más alto que Cooper."
print "- Smith no vive en un apartamento adyacente al de Fletcher."
print "- Fletcher no vive en un apartamento adyacente al de Cooper." & chr(10)

for Baker = 0 to 3
for Cooper = 1 to 4
for Fletcher = 1 to 3
for Miller = 0 to 4
for Smith = 0 to 4
if Baker<>Cooper and Baker<>Fletcher and Baker<>Miller and Baker<>Smith and Cooper<>Fletcher and Cooper<>Miller and Cooper<>Smith and Fletcher<>Miller and Fletcher<>Smith and Miller<>Smith and Miller>Cooper and abs(Smith-Fletcher)<>1 and abs(Fletcher-Cooper)<>1 then
print "Baker vive en el piso "; Baker
print "Cooper vive en el piso "; Cooper
print "Fletcher vive en el piso "; Fletcher
print "Miller vive en el piso "; Miller
print "Smith vive en el piso "; Smith
end if
next Smith
next Miller
next Fletcher
next Cooper
next Baker
end</lang>
{{out}}
<pre>
Igual que la entrada de FreeBASIC.
</pre>

==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
{{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.
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.
Line 280: Line 316:
Smith lives on floor 0
Smith lives on floor 0
</pre>
</pre>


==={{header|FreeBASIC}}===
<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)."
Print "- Cooper no vive en el piso inferior (bajo)."
Print "- Fletcher no vive ni en el atico ni en el bajo."
Print "- Miller vive en un apartamento más alto que Cooper."
Print "- Smith no vive en un apartamento adyacente al de Fletcher."
Print "- Fletcher no vive en un apartamento adyacente al de Cooper." & Chr(10)

Dim As Ubyte Baker, Cooper, Fletcher, Miller, Smith

For Baker = 0 To 3
For Cooper = 1 To 4
For Fletcher = 1 To 3
For Miller = 0 To 4
For Smith = 0 To 4
If Baker<>Cooper And Baker<>Fletcher And Baker<>Miller _
And Baker<>Smith And Cooper<>Fletcher And Cooper<>Miller _
And Cooper<>Smith And Fletcher<>Miller And Fletcher<>Smith _
And Miller<>Smith And Miller>Cooper And Abs(Smith-Fletcher)<>1 _
And Abs(Fletcher-Cooper)<>1 Then
Print "Baker vive en el piso "; Baker
Print "Cooper vive en el piso "; Cooper
Print "Fletcher vive en el piso "; Fletcher
Print "Miller vive en el piso "; Miller
Print "Smith vive en el piso "; Smith
End If
Next Smith
Next Miller
Next Fletcher
Next Cooper
Next Baker
Sleep</lang>
{{out}}
<pre>
Los apartamentos estan numerados del 0 (bajo) al 4 (atico).
Baker, Cooper, Fletcher, Miller y Smith viven en apartamentos diferentes.
- Baker no vive en el ultimo apartamento (atico).
- Cooper no vive en el piso inferior (bajo).
- Fletcher no vive ni en el atico ni en el bajo.
- Miller vive en un apartamento mßs alto que Cooper.
- Smith no vive en un apartamento adyacente al de Fletcher.
- Fletcher no vive en un apartamento adyacente al de Cooper.

Baker vive en el piso 2
Cooper vive en el piso 1
Fletcher vive en el piso 3
Miller vive en el piso 4
Smith vive en el piso 0
</pre>

==={{header|IS-BASIC}}===
<lang IS-BASIC>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."
130 PRINT "- Fletcher does not live on either the top or the bottom floor.":PRINT "- Miller lives on a higher floor than does Cooper."
140 PRINT "- Smith does not live on a floor adjacent to Fletcher's.":PRINT "- Fletcher does not live on a floor adjacent to Cooper's.":PRINT :LET S$=" lives on floor"
150 FOR B=0 TO 3
150 FOR C=1 TO 4
170 FOR F=1 TO 3
180 FOR M=0 TO 4
190 FOR S=0 TO 4
200 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 M>C AND ABS(S-F)<>1 AND ABS(F-C)<>1 THEN
210 PRINT "Baker",S$;B:PRINT "Cooper",S$;C:PRINT "Fletcher";S$;F:PRINT "Miller",S$;M:PRINT "Smith",S$;S
220 END
230 END IF
240 NEXT
250 NEXT
260 NEXT
270 NEXT
280 NEXT</lang>

==={{header|PureBasic}}===
{{incomplete|PureBasic|Examples should state what changes to the problem text are allowed.}}
<lang PureBasic>Prototype cond(Array t(1))

Enumeration #Null
#Baker
#Cooper
#Fletcher
#Miller
#Smith
EndEnumeration

Procedure checkTenands(Array tenants(1), Array Condions.cond(1))
Protected i, j
Protected.cond *f
j=ArraySize(Condions())
For i=0 To j
*f=Condions(i) ; load the function pointer to the current condition
If *f(tenants()) = #False
ProcedureReturn #False
EndIf
Next
ProcedureReturn #True
EndProcedure

Procedure C1(Array t(1))
If Int(Abs(t(#Fletcher)-t(#Cooper)))<>1
ProcedureReturn #True
EndIf
EndProcedure

Procedure C2(Array t(1))
If t(#Baker)<>5
ProcedureReturn #True
EndIf
EndProcedure

Procedure C3(Array t(1))
If t(#Cooper)<>1
ProcedureReturn #True
EndIf
EndProcedure

Procedure C4(Array t(1))
If t(#Miller) >= t(#Cooper)
ProcedureReturn #True
EndIf
EndProcedure

Procedure C5(Array t(1))
If t(#Fletcher)<>1 And t(#Fletcher)<>5
ProcedureReturn #True
EndIf
EndProcedure

Procedure C6(Array t(1))
If Int(Abs(t(#Smith)-t(#Fletcher)))<>1
ProcedureReturn #True
EndIf
EndProcedure


If OpenConsole()
Dim People(4)
Dim Conditions(5)
Define a, b, c, d, e, i
;
;- Load all conditions
Conditions(i)=@C1(): i+1
Conditions(i)=@C2(): i+1
Conditions(i)=@C3(): i+1
Conditions(i)=@C4(): i+1
Conditions(i)=@C5(): i+1
Conditions(i)=@C6()
;
; generate and the all legal combinations
For a=1 To 5
For b=1 To 5
If a=b: Continue: EndIf
For c=1 To 5
If a=c Or b=c: Continue: EndIf
For d=1 To 5
If d=a Or d=b Or d=c : Continue: EndIf
For e=1 To 5
If e=a Or e=b Or e=c Or e=d: Continue: EndIf
People(#Baker)=a
People(#Cooper)=b
People(#Fletcher)=c
People(#Miller)=d
People(#Smith)=e
If checkTenands(People(), Conditions())
PrintN("Solution found;")
PrintN("Baker="+Str(a)+#CRLF$+"Cooper="+Str(b)+#CRLF$+"Fletcher="+Str(c))
PrintN("Miller="+Str(d)+#CRLF$+"Smith="+Str(e)+#CRLF$)
EndIf
Next
Next
Next
Next
Next
Print("Press ENTER to exit"): Input()
EndIf</lang>
<pre>Solution found;
Baker=3
Cooper=2
Fletcher=4
Miller=5
Smith=1</pre>
===Port of [http://rosettacode.org/wiki/Dinesman%27s_multiple-dwelling_problem#C C code solution]===
<lang PureBasic>
EnableExplicit

Global verbose = #False

Macro COND ( a, b )
Procedure a ( Array s ( 1 ) )
ProcedureReturn Bool( b )
EndProcedure
EndMacro

Prototype condition ( Array s ( 1 ) )

#N_FLOORS = 5
#TOP = #N_FLOORS - 1

Global Dim solutions ( #N_FLOORS - 1 )
Global Dim occupied ( #N_FLOORS - 1 )

Enumeration tenants
#baker
#cooper
#fletcher
#miller
#smith
#phantom_of_the_opera
EndEnumeration

Global Dim names.s ( 4 )
names( 0 ) = "baker"
names( 1 ) = "cooper"
names( 2 ) = "fletcher"
names( 3 ) = "miller"
names( 4 ) = "smith"

COND( c0, s( #baker ) <> #TOP )
COND( c1, s( #cooper ) <> 0 )
COND( c2, s( #fletcher ) <> 0 And s( #fletcher ) <> #TOP )
COND( c3, s( #miller ) > s( #cooper ) )
COND( c4, Abs( s( #smith ) - s( #fletcher ) ) <> 1 )
COND( c5, Abs( s( #cooper ) - s( #fletcher ) ) <> 1 )

#N_CONDITIONS = 6

Global Dim conds ( #N_CONDITIONS - 1 )
conds( 0 ) = @c0()
conds( 1 ) = @c1()
conds( 2 ) = @c2()
conds( 3 ) = @c3()
conds( 4 ) = @c4()
conds( 5 ) = @c5()

Procedure solve ( person.i )
Protected i.i, j.i
If person = #phantom_of_the_opera
For i = 0 To #N_CONDITIONS - 1
Protected proc.condition = conds( i )
If proc( solutions( ) )
Continue
EndIf
If verbose
For j = 0 To #N_FLOORS - 1
PrintN( Str( solutions( j ) ) + " " + names( j ) )
Next
PrintN( "cond" + Str( i ) + " bad\n" )
EndIf
ProcedureReturn 0
Next
PrintN( "Found arrangement:" )
For i = 0 To #N_FLOORS - 1
PrintN( Str( solutions( i ) ) + " " + names( i ) )
Next
ProcedureReturn 1
EndIf
For i = 0 To #N_FLOORS - 1
If occupied( i )
Continue
EndIf
solutions( person ) = i
occupied( i ) = #True
If solve( person + 1 )
ProcedureReturn #True
EndIf
occupied( i ) = #False
Next
ProcedureReturn #False
EndProcedure



OpenConsole( )

verbose = #False

If Not solve( 0 )
PrintN( "Nobody lives anywhere" )
EndIf

Input( )
CloseConsole( )

End</lang>

<pre>Found arrangement:
2 baker
1 cooper
3 fletcher
4 miller
0 smith</pre>

==={{header|Run BASIC}}===
This program simply iterates by looking at each room available for each person.
It then looks to see if it meets the requirements for each person by looking at the results of the iteration.
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.

<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
for miller = 1 to 5 ' can be in any room
for smith = 1 to 5 ' can be in any room
if baler <> cooper and fletcher <> miller and miller > cooper and abs(smith - fletcher) > 1 and abs(fletcher - cooper) > 1 then
if baler + cooper + fletcher + miller + smith = 15 then ' that is 1 + 2 + 3 + 4 + 5
rooms$ = baler;cooper;fletcher;miller;smith
print "baler: ";baler;" copper: ";cooper;" fletcher: ";fletcher;" miller: ";miller;" smith: ";smith
end
end if
end if
next smith
next miller
next fletcher
next cooper
next baler
print "Can't assign rooms" ' print this if it can not find a solution</lang>
<pre>baler: 3 copper: 2 fletcher: 4 miller: 5 smith: 1</pre>

==={{header|uBasic/4tH}}===
{{trans|BBC Basic}}
<lang>REM Floors are numbered 0 (ground) to 4 (top)

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
GOSUB 100 : IF POP() THEN
GOSUB 110 : IF POP() THEN
GOSUB 120 : IF POP() THEN
GOSUB 130 : IF POP() THEN
GOSUB 140 : IF POP() THEN
GOSUB 150 : IF POP() THEN
GOSUB 160 : IF POP() THEN
PRINT "Baker lives on floor " ; B + 1
PRINT "Cooper lives on floor " ; C + 1
PRINT "Fletcher lives on floor " ; F + 1
PRINT "Miller lives on floor " ; M + 1
PRINT "Smith lives on floor " ; S + 1
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT S
NEXT M
NEXT F
NEXT C
NEXT B

END

REM "Baker, Cooper, Fletcher, Miller, and Smith live on different floors"
100 PUSH (B#C)*(B#F)*(B#M)*(B#S)*(C#F)*(C#M)*(C#S)*(F#M)*(F#S)*(M#S)
RETURN

REM "Baker does not live on the top floor"
110 PUSH B#4
RETURN

REM "Cooper does not live on the bottom floor"
120 PUSH C#0
RETURN

REM "Fletcher does not live on either the top or the bottom floor"
130 PUSH (F#0)*(F#4)
RETURN

REM "Miller lives on a higher floor than does Cooper"
140 PUSH M>C
RETURN

REM "Smith does not live on a floor adjacent to Fletcher's"
150 PUSH ABS(S-F)#1
RETURN

REM "Fletcher does not live on a floor adjacent to Cooper's"
160 PUSH ABS(F-C)#1
RETURN</lang>

Output:
<pre>
Baker lives on floor 3
Cooper lives on floor 2
Fletcher lives on floor 4
Miller lives on floor 5
Smith lives on floor 1

0 OK, 0:1442
</pre>


==={{header|Yabasic}}===
{{trans|FreeBASIC}}
<lang 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)."
print "- Cooper no vive en el piso inferior (bajo)."
print "- Fletcher no vive ni en el atico ni en el bajo."
print "- Miller vive en un apartamento más alto que Cooper."
print "- Smith no vive en un apartamento adyacente al de Fletcher."
print "- Fletcher no vive en un apartamento adyacente al de Cooper."
print

for Baker = 0 to 3
for Cooper = 1 to 4
for Fletcher = 1 to 3
for Miller = 0 to 4
for Smith = 0 to 4
if Baker<>Cooper and Baker<>Fletcher and Baker<>Miller and Baker<>Smith and Cooper<>Fletcher and Cooper<>Miller and Cooper<>Smith and Fletcher<>Miller and Fletcher<>Smith and Miller<>Smith and Miller>Cooper and abs(Smith-Fletcher)<>1 and abs(Fletcher-Cooper)<>1 then
print "Baker vive en el piso ", Baker
print "Cooper vive en el piso ", Cooper
print "Fletcher vive en el piso ", Fletcher
print "Miller vive en el piso ", Miller
print "Smith vive en el piso ", Smith
end if
next Smith
next Miller
next Fletcher
next Cooper
next Baker
end</lang>
{{out}}
<pre>
Igual que la entrada de FreeBASIC.
</pre>

==={{header|ZX Spectrum Basic}}===
{{trans|BBC_BASIC}}
<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"
40 REM "Cooper does not live on the bottom floor"
50 REM "Fletcher does not live on either the top or the bottom floor"
60 REM "Miller lives on a higher floor than does Cooper"
70 REM "Smith does not live on a floor adjacent to Fletcher's"
80 REM "Fletcher does not live on a floor adjacent to Cooper's"
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</lang>


=={{header|Bracmat}}==
=={{header|Bracmat}}==
Line 1,166: Line 1,645:
Smith lives in 1
Smith lives in 1
</pre>
</pre>


=={{header|FreeBASIC}}==
<lang freebasic>Dim As Ubyte Baker, Cooper, Fletcher, Miller, Smith

For Baker = 0 To 3
For Cooper = 1 To 4
For Fletcher = 1 To 3
For Miller = 0 To 4
For Smith = 0 To 4
If Baker<>Cooper And Baker<>Fletcher And Baker<>Miller _
And Baker<>Smith And Cooper<>Fletcher And Cooper<>Miller _
And Cooper<>Smith And Fletcher<>Miller And Fletcher<>Smith _
And Miller<>Smith And Miller>Cooper And Abs(Smith-Fletcher)<>1 _
And Abs(Fletcher-Cooper)<>1 Then
Print "Baker vive en el piso "; Baker
Print "Cooper vive en el piso "; Cooper
Print "Fletcher vive en el piso "; Fletcher
Print "Miller vive en el piso "; Miller
Print "Smith vive en el piso "; Smith
End If
Next Smith
Next Miller
Next Fletcher
Next Cooper
Next Baker
Sleep</lang>



=={{header|Go}}==
=={{header|Go}}==
Line 1,474: Line 1,925:
Miller lives in 5
Miller lives in 5
Smith lives in 1</pre>
Smith lives in 1</pre>

=={{header|IS-BASIC}}==
<lang IS-BASIC>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."
130 PRINT "- Fletcher does not live on either the top or the bottom floor.":PRINT "- Miller lives on a higher floor than does Cooper."
140 PRINT "- Smith does not live on a floor adjacent to Fletcher's.":PRINT "- Fletcher does not live on a floor adjacent to Cooper's.":PRINT :LET S$=" lives on floor"
150 FOR B=0 TO 3
150 FOR C=1 TO 4
170 FOR F=1 TO 3
180 FOR M=0 TO 4
190 FOR S=0 TO 4
200 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 M>C AND ABS(S-F)<>1 AND ABS(F-C)<>1 THEN
210 PRINT "Baker",S$;B:PRINT "Cooper",S$;C:PRINT "Fletcher";S$;F:PRINT "Miller",S$;M:PRINT "Smith",S$;S
220 END
230 END IF
240 NEXT
250 NEXT
260 NEXT
270 NEXT
280 NEXT</lang>


=={{header|J}}==
=={{header|J}}==
Line 2,534: Line 2,964:


[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.
[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|PureBasic}}==
{{incomplete|PureBasic|Examples should state what changes to the problem text are allowed.}}
<lang PureBasic>Prototype cond(Array t(1))

Enumeration #Null
#Baker
#Cooper
#Fletcher
#Miller
#Smith
EndEnumeration

Procedure checkTenands(Array tenants(1), Array Condions.cond(1))
Protected i, j
Protected.cond *f
j=ArraySize(Condions())
For i=0 To j
*f=Condions(i) ; load the function pointer to the current condition
If *f(tenants()) = #False
ProcedureReturn #False
EndIf
Next
ProcedureReturn #True
EndProcedure

Procedure C1(Array t(1))
If Int(Abs(t(#Fletcher)-t(#Cooper)))<>1
ProcedureReturn #True
EndIf
EndProcedure

Procedure C2(Array t(1))
If t(#Baker)<>5
ProcedureReturn #True
EndIf
EndProcedure

Procedure C3(Array t(1))
If t(#Cooper)<>1
ProcedureReturn #True
EndIf
EndProcedure

Procedure C4(Array t(1))
If t(#Miller) >= t(#Cooper)
ProcedureReturn #True
EndIf
EndProcedure

Procedure C5(Array t(1))
If t(#Fletcher)<>1 And t(#Fletcher)<>5
ProcedureReturn #True
EndIf
EndProcedure

Procedure C6(Array t(1))
If Int(Abs(t(#Smith)-t(#Fletcher)))<>1
ProcedureReturn #True
EndIf
EndProcedure


If OpenConsole()
Dim People(4)
Dim Conditions(5)
Define a, b, c, d, e, i
;
;- Load all conditions
Conditions(i)=@C1(): i+1
Conditions(i)=@C2(): i+1
Conditions(i)=@C3(): i+1
Conditions(i)=@C4(): i+1
Conditions(i)=@C5(): i+1
Conditions(i)=@C6()
;
; generate and the all legal combinations
For a=1 To 5
For b=1 To 5
If a=b: Continue: EndIf
For c=1 To 5
If a=c Or b=c: Continue: EndIf
For d=1 To 5
If d=a Or d=b Or d=c : Continue: EndIf
For e=1 To 5
If e=a Or e=b Or e=c Or e=d: Continue: EndIf
People(#Baker)=a
People(#Cooper)=b
People(#Fletcher)=c
People(#Miller)=d
People(#Smith)=e
If checkTenands(People(), Conditions())
PrintN("Solution found;")
PrintN("Baker="+Str(a)+#CRLF$+"Cooper="+Str(b)+#CRLF$+"Fletcher="+Str(c))
PrintN("Miller="+Str(d)+#CRLF$+"Smith="+Str(e)+#CRLF$)
EndIf
Next
Next
Next
Next
Next
Print("Press ENTER to exit"): Input()
EndIf</lang>
<pre>Solution found;
Baker=3
Cooper=2
Fletcher=4
Miller=5
Smith=1</pre>
===Port of [http://rosettacode.org/wiki/Dinesman%27s_multiple-dwelling_problem#C C code solution]===
<lang PureBasic>
EnableExplicit

Global verbose = #False

Macro COND ( a, b )
Procedure a ( Array s ( 1 ) )
ProcedureReturn Bool( b )
EndProcedure
EndMacro

Prototype condition ( Array s ( 1 ) )

#N_FLOORS = 5
#TOP = #N_FLOORS - 1

Global Dim solutions ( #N_FLOORS - 1 )
Global Dim occupied ( #N_FLOORS - 1 )

Enumeration tenants
#baker
#cooper
#fletcher
#miller
#smith
#phantom_of_the_opera
EndEnumeration

Global Dim names.s ( 4 )
names( 0 ) = "baker"
names( 1 ) = "cooper"
names( 2 ) = "fletcher"
names( 3 ) = "miller"
names( 4 ) = "smith"

COND( c0, s( #baker ) <> #TOP )
COND( c1, s( #cooper ) <> 0 )
COND( c2, s( #fletcher ) <> 0 And s( #fletcher ) <> #TOP )
COND( c3, s( #miller ) > s( #cooper ) )
COND( c4, Abs( s( #smith ) - s( #fletcher ) ) <> 1 )
COND( c5, Abs( s( #cooper ) - s( #fletcher ) ) <> 1 )

#N_CONDITIONS = 6

Global Dim conds ( #N_CONDITIONS - 1 )
conds( 0 ) = @c0()
conds( 1 ) = @c1()
conds( 2 ) = @c2()
conds( 3 ) = @c3()
conds( 4 ) = @c4()
conds( 5 ) = @c5()

Procedure solve ( person.i )
Protected i.i, j.i
If person = #phantom_of_the_opera
For i = 0 To #N_CONDITIONS - 1
Protected proc.condition = conds( i )
If proc( solutions( ) )
Continue
EndIf
If verbose
For j = 0 To #N_FLOORS - 1
PrintN( Str( solutions( j ) ) + " " + names( j ) )
Next
PrintN( "cond" + Str( i ) + " bad\n" )
EndIf
ProcedureReturn 0
Next
PrintN( "Found arrangement:" )
For i = 0 To #N_FLOORS - 1
PrintN( Str( solutions( i ) ) + " " + names( i ) )
Next
ProcedureReturn 1
EndIf
For i = 0 To #N_FLOORS - 1
If occupied( i )
Continue
EndIf
solutions( person ) = i
occupied( i ) = #True
If solve( person + 1 )
ProcedureReturn #True
EndIf
occupied( i ) = #False
Next
ProcedureReturn #False
EndProcedure



OpenConsole( )

verbose = #False

If Not solve( 0 )
PrintN( "Nobody lives anywhere" )
EndIf

Input( )
CloseConsole( )

End</lang>

<pre>Found arrangement:
2 baker
1 cooper
3 fletcher
4 miller
0 smith</pre>


=={{header|Python}}==
=={{header|Python}}==
Line 3,562: Line 3,773:
"Smith Cooper Baker Fletcher Miller"
"Smith Cooper Baker Fletcher Miller"
</pre>
</pre>

=={{header|Run BASIC}}==
This program simply iterates by looking at each room available for each person.
It then looks to see if it meets the requirements for each person by looking at the results of the iteration.
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.

<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
for miller = 1 to 5 ' can be in any room
for smith = 1 to 5 ' can be in any room
if baler <> cooper and fletcher <> miller and miller > cooper and abs(smith - fletcher) > 1 and abs(fletcher - cooper) > 1 then
if baler + cooper + fletcher + miller + smith = 15 then ' that is 1 + 2 + 3 + 4 + 5
rooms$ = baler;cooper;fletcher;miller;smith
print "baler: ";baler;" copper: ";cooper;" fletcher: ";fletcher;" miller: ";miller;" smith: ";smith
end
end if
end if
next smith
next miller
next fletcher
next cooper
next baler
print "Can't assign rooms" ' print this if it can not find a solution</lang>
<pre>baler: 3 copper: 2 fletcher: 4 miller: 5 smith: 1</pre>


=={{header|Scala}}==
=={{header|Scala}}==
Line 3,888: Line 4,074:
Floor 4: Fletcher
Floor 4: Fletcher
Floor 5: Miller
Floor 5: Miller
</pre>

=={{header|uBasic/4tH}}==
{{trans|BBC Basic}}
<lang>REM Floors are numbered 0 (ground) to 4 (top)

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
GOSUB 100 : IF POP() THEN
GOSUB 110 : IF POP() THEN
GOSUB 120 : IF POP() THEN
GOSUB 130 : IF POP() THEN
GOSUB 140 : IF POP() THEN
GOSUB 150 : IF POP() THEN
GOSUB 160 : IF POP() THEN
PRINT "Baker lives on floor " ; B + 1
PRINT "Cooper lives on floor " ; C + 1
PRINT "Fletcher lives on floor " ; F + 1
PRINT "Miller lives on floor " ; M + 1
PRINT "Smith lives on floor " ; S + 1
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT S
NEXT M
NEXT F
NEXT C
NEXT B

END

REM "Baker, Cooper, Fletcher, Miller, and Smith live on different floors"
100 PUSH (B#C)*(B#F)*(B#M)*(B#S)*(C#F)*(C#M)*(C#S)*(F#M)*(F#S)*(M#S)
RETURN

REM "Baker does not live on the top floor"
110 PUSH B#4
RETURN

REM "Cooper does not live on the bottom floor"
120 PUSH C#0
RETURN

REM "Fletcher does not live on either the top or the bottom floor"
130 PUSH (F#0)*(F#4)
RETURN

REM "Miller lives on a higher floor than does Cooper"
140 PUSH M>C
RETURN

REM "Smith does not live on a floor adjacent to Fletcher's"
150 PUSH ABS(S-F)#1
RETURN

REM "Fletcher does not live on a floor adjacent to Cooper's"
160 PUSH ABS(F-C)#1
RETURN</lang>

Output:
<pre>
Baker lives on floor 3
Cooper lives on floor 2
Fletcher lives on floor 4
Miller lives on floor 5
Smith lives on floor 1

0 OK, 0:1442
</pre>
</pre>


Line 4,221: Line 4,332:
L(L("Baker",3),L("Cooper",2),L("Fletcher",4),L("Miller",5),L("Smith",1))
L(L("Baker",3),L("Cooper",2),L("Fletcher",4),L("Miller",5),L("Smith",1))
</pre>
</pre>

=={{header|ZX Spectrum Basic}}==
{{trans|BBC_BASIC}}
<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"
40 REM "Cooper does not live on the bottom floor"
50 REM "Fletcher does not live on either the top or the bottom floor"
60 REM "Miller lives on a higher floor than does Cooper"
70 REM "Smith does not live on a floor adjacent to Fletcher's"
80 REM "Fletcher does not live on a floor adjacent to Cooper's"
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</lang>
Retrieved from "https://rosettacode.org/wiki/Dinesman%27s_multiple-dwelling_problem"