The Zebra Puzzle - Rosetta Code

[plus]

Thanks to tsh73 Math Puzzle justbasiccom.proboards.com/thread/905/math-puzzle-challenge
my interest in this sort of problem has been re-sparked.

I took another shot at the Zebra Puzzle at Rosetta Code and managed to find a way to solve in what I call a computer assisted coding method.
The hard thing was getting the thing started with 15,625 possible scenarios generated = 5^6
5 House positions 1,2,3,4,5
5 House colors, 5 House occupants nationality, 5 different drinks each preferred, 5 different Brands of Smokes and finally 5 different animals they have, including one having a Zebra!

I would like very much to translate my QB64 solution to JB as thanks for inspiring problems/challenges.
But my QB64 uses Dynamic arrays and to do something in JB on same lines I need to start with 2 giant string arrays possibly up to 100 Chars$ per string plus some extra room for other variables, will JB allow me all this space? I'd sure hate to go through the translation and find out JB wont allow all the room it takes.

I did this experiment to test:
' JB have room for 2 15,625 string arrays probably 100 chars max per string
Dim a1$(15625), a2$(15625), moreSpace$(100) ' ??
s100$ = space$(100)
for i = 1 to 15625
   a1$(i) = s100$
   a2$(i) = s100$
next
for i = 1 to 100
   moreSpace$(i) = str$(i) + s100$
next

for i = 90 to 100
   print moreSpace$(i) 'can JB show this? or will I have memory problem
next
print " OK done!"


This is indicating I will be allowed the space in JB. Is there something else I should be considering?

[plus]

OK for me the key part of getting started on this problem was generating all the possible scenarios.

I've had to totally revise the building of all possible scenarios using static Global arrays, actually this turned out kind of nice, easier to follow specific array names and variable max indexes when not generic.

So here are the 15,625 possible scenarios generated in JB before we start applying the rules for elimination.
' Zebra Puzzle - Rosetta Code
' ref  http://rosettacode.org/wiki/Zebra_puzzle
' b+ 2022-10-30 translate QB64 solution to JB
' from _Title "15625 Scenarios Elimination" 'b+ start 2021-09-05 2022-10-29
' QB64 dev notes
' restart 2022-10-27 add split
' 2022-10-29 make and use build sub for combining and ordering permutations
' generate ALL possible scenarios of house 1 number/order, 2 color, 3 nation, 4 drink, 5 smoke, 6 animal
' 2022-10-29 add old Wrd$() tool to find nth word in string.
' 2022-10-29 add Sub aCopy (a() As String, b() As String)
' 2022-10-29 add Sub AddEnd (a() As String, addon As String)
' 2022-10-29 3 phases of elimination and down to Sol'n in blink of the eye!

' JB dev notes, dump Wrd$ which mimics JB's Word$()
' Dump Split because JB doesn't do Dynamic arrays, that is going to be the challenge
' but Wrd$ may enough, slower but enough.
' Modify AddEnd and aCopy for static arrays. I hope JB has enough memory for 15,625 strings in
' one array and what? 100 in survivor array.
' Add global array indexes. Perform experiment two 15,625 string arrays???
' Make the word strings Global too as they will be used in build Sub
' Goal of Zebra build1.bas is to get the scenarios rebuilt in JB.
' OK mission accomplished! For me this was hardest part of getting started.
' And dang! if this is isn't simpler, of course it isn't nearly as generic either,
' it is totally geared for certain arrays with Global maxIndex variables.

Global IMaxScen, IMaxSurv  ' track upper bound of items in giant arrays
Global House$, Color$, Nation$, Drink$, Smoke$, Animal$
Dim Scen$(15625), Surv$(15625) 'scenarios and survivors after logic elimination round

Print
Print "      The Zebra Puzzle has 16 Clues:"
Print
Print "  1.  There are five houses."
Print "  2.  The English man lives in the red house."
Print "  3.  The Swede has a dog."
Print "  4.  The Dane drinks tea."
Print "  5.  The green house is immediately to the left of the white house."
Print "  6.  They drink coffee in the green house."
Print "  7.  The man who smokes Pall Mall has birds."
Print "  8.  In the yellow house they smoke Dunhill."
Print "  9.  In the middle house they drink milk."
Print " 10.  The Norwegian lives in the first house."
Print " 11.  The man who smokes Blend lives in the house next to the house with cats."
Print " 12.  In a house next to the house where they have a horse, they smoke Dunhill."
Print " 13.  The man who smokes Blue Master drinks beer."
Print " 14.  The German smokes Prince."
Print " 15.  The Norwegian lives next to the blue house."
Print " 16.  They drink water in a house next to the house where they smoke Blend"
Print
Print "      The Puzzle is, Who owns the zebra?"
Print

' from 1-16 there are 5 house in order from left to right that have:
House$ = "1 2 3 4 5" 'left to right
Color$ = "red green white yellow blue"
Nation$ = "English Swede Dane Norwegian German"
Drink$ = "tea coffee milk beer water"
Smoke$ = "Pall_Malls Dunhill Blend Blue_Master Prince"
Animal$ = "dog birds cats horse zebra?"

Print " 15,625 = (5 ^ 6) possible scenarios of :"
Print "               5 House Choices: "; House$
Print "         with 5 Colors Choices: "; Color$
Print "  with 5 Nationalities Choices: "; Nation$
Print "          with 5 Drink Choices: "; Drink$
Print "         with 5 Smokes Choices: "; Smoke$
Print " and finally 5 Animals Choices: "; Animal$
Print

' start Scen$() with the 5 animals
for i = 1 to 5
   Scen$(i) = word$(Animal$, i)
next
IMaxScen = 5
IMaxSurv = 0
For b = 2 To 6
   Select Case b
       Case 2: call Build Smoke$
       Case 3: call Build Drink$
       Case 4: call Build Nation$
       Case 5: call Build Color$
       Case 6: call Build House$
   End Select
   call CopySurv2Scen ' transfers surv to scen and clears surv array for next build
Next
call ShowScen  ' very good! so far

Sub Build B$ ' customized for JB particular arrays with global index
   For i = 1 To IMaxScen
       For j = 1 To 5
           IMaxSurv = IMaxSurv + 1
           Surv$(IMaxSurv) = word$(B$, j) + " " + Scen$(i)
       Next
   Next
End Sub

Sub CopySurv2Scen ' just move contents of Surv back to fresh Scen and erase Surv
   dim Scen$(IMaxSurv) ' erase and reset array
   For i = 1 To IMaxSurv
       Scen$(i) = Surv$(i)
   Next
   IMaxScen = IMaxSurv
   ' delete Surv and make ready for next build or elim
   ' dim Surv$(15625) 'erase contents not sure I really need to do this try without  first
   IMaxSurv = 0
End Sub

sub ShowScen     ' lets check build or Scen = Scenarios
   ' In QB64 it worked that the Houses were listed in alpha order
   ' that made it easy to see what has to go where eg House 1 has to be
   ' yellow, drinking water and smoking Dunhills, that made it easy to take
   ' those out everywhere else!

   sort Scen$(), 1, IMaxScen
   for i = 1 to IMaxScen
       print i, Scen$(i)
   next
end sub


I do love scrolling output screens, Ctrl+Home shows the intro of the problem before the big long list of all possible scenarios.

[plus]

OK Phase 1 of eliminations a successful translation! We go from a possible 15,625 scenarios down to 38!

' Zebra elininamtion phase 1.bas b+ 2022-10-30
' Zebra Puzzle - Rosetta Code
' ref  http://rosettacode.org/wiki/Zebra_puzzle
' b+ 2022-10-30 translate QB64 solution to JB
' from _Title "15625 Scenarios Elimination" 'b+ start 2021-09-05 2022-10-29
' QB64 dev notes
' restart 2022-10-27 add split
' 2022-10-29 make and use build sub for combining and ordering permutations
' generate ALL possible scenarios of house 1 number/order, 2 color, 3 nation, 4 drink, 5 smoke, 6 animal
' 2022-10-29 add old Wrd$() tool to find nth word in string.
' 2022-10-29 add Sub aCopy (a() As String, b() As String)
' 2022-10-29 add Sub AddEnd (a() As String, addon As String)
' 2022-10-29 3 phases of elimination and down to Sol'n in blink of the eye!

' Zebra build1.bas 2022-10-30
' JB dev notes, dump Wrd$ which mimics JB's Word$()
' Dump Split because JB doesn't do Dynamic arrays, that is going to be the challenge
' but Wrd$ may enough, slower but enough.
' Modify AddEnd and aCopy for static arrays. I hope JB has enough memory for 15,625 strings in
' one array and what? 100 in survivor array.
' Add global array indexes. Perform experiment two 15,625 string arrays???
' Make the word strings Global too as they will be used in build Sub
' Goal of Zebra build1.bas is to get the scenarios rebuilt in JB.
' PK mission accomplished! For me this was hardest part of getting started.
' And dang! if this is isn't simpler, of course it isn't nearly as generic either,
' it is totally geared for certain arrays with Global maxIndex variables.

' Zebra elininamtion phase 1.bas b+ 2022-10-30
' comment out display of 15,625 all possible scenarios and start 1st round of eliminations.
' If all goes right, we should go from the 15,625 possibles to 38, nice reduction to human terms.
' OK that step a success.

Global IMaxScen, IMaxSurv  ' track upper bound of items in giant arrays
Global House$, Color$, Nation$, Drink$, Smoke$, Animal$
Dim Scen$(15625), Surv$(15625) 'scenarios and survivors after logic elimination round

Print
Print "      The Zebra Puzzle has 16 Clues:"
Print
Print "  1.  There are five houses."
Print "  2.  The English man lives in the red house."
Print "  3.  The Swede has a dog."
Print "  4.  The Dane drinks tea."
Print "  5.  The green house is immediately to the left of the white house."
Print "  6.  They drink coffee in the green house."
Print "  7.  The man who smokes Pall Mall has birds."
Print "  8.  In the yellow house they smoke Dunhill."
Print "  9.  In the middle house they drink milk."
Print " 10.  The Norwegian lives in the first house."
Print " 11.  The man who smokes Blend lives in the house next to the house with cats."
Print " 12.  In a house next to the house where they have a horse, they smoke Dunhill."
Print " 13.  The man who smokes Blue Master drinks beer."
Print " 14.  The German smokes Prince."
Print " 15.  The Norwegian lives next to the blue house."
Print " 16.  They drink water in a house next to the house where they smoke Blend"
Print
Print "      The Puzzle is, Who owns the zebra?"
Print

' from 1-16 there are 5 house in order from left to right that have:
House$ = "1 2 3 4 5" 'left to right
Color$ = "red green white yellow blue"
Nation$ = "English Swede Dane Norwegian German"
Drink$ = "tea coffee milk beer water"
Smoke$ = "Pall_Malls Dunhill Blend Blue_Master Prince"
Animal$ = "dog birds cats horse zebra?"

Print " 15,625 = (5 ^ 6) possible scenarios of :"
Print "               5 House Choices: "; House$
Print "         with 5 Colors Choices: "; Color$
Print "  with 5 Nationalities Choices: "; Nation$
Print "          with 5 Drink Choices: "; Drink$
Print "         with 5 Smokes Choices: "; Smoke$
Print " and finally 5 Animals Choices: "; Animal$
Print

' start Scen$() with the 5 animals
For i = 1 To 5
   Scen$(i) = word$(Animal$, i)
next
IMaxScen = 5
IMaxSurv = 0
For b = 2 To 6
   Select Case b
       Case 2: call Build Smoke$
       Case 3: call Build Drink$
       Case 4: call Build Nation$
       Case 5: call Build Color$
       Case 6: call Build House$
   End Select
   call CopySurv2Scen ' transfers surv to scen and clears surv array for next build
Next
' call ShowScen  ' very good! so far don't need to show all this again === end of Zebra build1.bas
'
' OK that built as I want list: House Color Nation Drink Smoke Animal = 6 items in order
' note: at moment Scen$() is loaded with all scenarios and Surv$ is erased for refill
For i = 1 To IMaxScen ' elimination round
   OK = -1

   '2.  The English man lives in the red house.
   test1 = InStr(Scen$(i), "English") > 0: test2 = InStr(Scen$(i), "red") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '3.  The Swede has a dog.
   test1 = InStr(Scen$(i), "Swede") > 0: test2 = InStr(Scen$(i), "dog") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '4.  The Dane drinks tea.
   test1 = InStr(Scen$(i), "Dane") > 0: test2 = InStr(Scen$(i), "tea") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '5.  The green house is immediately to the left of the white house.
   ' green <> 1, 2 or 5  so 3 or 4  white 4 or 5  because blue is 2 and green and white are sequential

   testC$ = Word$(Scen$(i), 2): testH$ = Word$(Scen$(i), 1)

   If testC$ = "green" Then
       If testH$ = "3" Or testH$ = "4" Then
       Else
           OK = 0
       End If
   Else
       If testC$ = "white" Then
           If testH$ = "4" Or testH$ = "5" Then
           Else
               OK = 0
           End If
       End If
   End If
   ' house 4 can only be green or white or wont have sequence
   If testH$ = "4" Then
       If testC$ = "green" Or testC$ = "white" Then
       Else
           OK = 0
       End If
   End If

   '6.  They drink coffee in the green house.
   test1 = InStr(Scen$(i), "coffee") > 0: test2 = InStr(Scen$(i), "green") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '7.  The man who smokes Pall Mall has birds.
   test1 = InStr(Scen$(i), "Pall_Malls") > 0: test2 = InStr(Scen$(i), "birds") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '8.  In the yellow house they smoke Dunhill.
   test1 = InStr(Scen$(i), "yellow") > 0: test2 = InStr(Scen$(i), "Dunhill") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '9.  In the middle house they drink milk.
   test1 = InStr(Scen$(i), "3") > 0: test2 = InStr(Scen$(i), "milk") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '10.  The Norwegian lives in the first house.
   test1 = InStr(Scen$(i), "Norwegian") > 0: test2 = InStr(Scen$(i), "1") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '11.  The man who smokes Blend lives in the house next to the house with cats.
   test1 = InStr(Scen$(i), "Blend") > 0: test2 = InStr(Scen$(i), "cats") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then OK = 0
   End If

   '12.  In a house next to the house where they have a horse, they smoke Dunhill.
   test1 = InStr(Scen$(i), "horse") > 0: test2 = InStr(Scen$(i), "Dunhill") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then OK = 0
   End If

   '13.  The man who smokes Blue Master drinks beer.
   test1 = InStr(Scen$(i), "Blue_Master") > 0: test2 = InStr(Scen$(i), "beer") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '14.  The German smokes Prince.
   test1 = InStr(Scen$(i), "German") > 0: test2 = InStr(Scen$(i), "Prince") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '15.  The Norwegian lives next to the blue house.
   '     the Norwegian is in house 1 so blue house is house 2
   test1 = InStr(Scen$(i), "blue") > 0: test2 = InStr(Scen$(i), "2") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   ' 16. They drink water in a house next to the house where they smoke Blend
   test1 = InStr(Scen$(i), "water") > 0: test2 = InStr(Scen$(i), "Blend") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then OK = 0
   End If

   If OK Then
       IMaxSurv = IMaxSurv + 1
       Surv$(IMaxSurv) = Scen$(i)
   End If

Next
' OK what's left?
call CopySurv2Scen
call ShowScen

Sub Build B$ ' customized for JB particular arrays with global index
   For i = 1 To IMaxScen
       For j = 1 To 5
           IMaxSurv = IMaxSurv + 1
           Surv$(IMaxSurv) = word$(B$, j) + " " + Scen$(i)
       Next
   Next
End Sub

Sub CopySurv2Scen ' just move contents of Surv back to fresh Scen and erase Surv
   dim Scen$(IMaxSurv) ' erase and reset array
   For i = 1 To IMaxSurv
       Scen$(i) = Surv$(i)
   Next
   IMaxScen = IMaxSurv
   ' delete Surv and make ready for next build or elim
   ' dim Surv$(15625) 'erase contents not sure I really need to do this try without  first
   IMaxSurv = 0
End Sub

sub ShowScen     ' lets check build or Scen = Scenarios
   ' In QB64 it worked that the Houses were listed in alpha order
   ' that made it easy to see what has to go where eg House 1 has to be
   ' yellow, drinking water and smoking Dunhills, that made it easy to take
   ' those out everywhere else!

   sort Scen$(), 1, IMaxScen
   for i = 1 to IMaxScen
       print i, Scen$(i)
   next
end sub



From here you might be able solve with pencil and paper but show us the code! ;-))

While I am coding the next phase look at house 1, only one choice for color, smoke.. all but animal and only 2 choices there cats or zebra.
So any other House we see yellow, Dunhills, water we can eliminate from scenarios. That should allot in getting the scenarios down to even less!

PS I have 2 more posts and then comments would be most welcome!

[plus]

Phase 2 Elimination from 38 down to 11 possible scenarios left!
' Zebra elininamtion phase 2.bas b+ 2022-10-30
' Zebra Puzzle - Rosetta Code
' ref  http://rosettacode.org/wiki/Zebra_puzzle
' b+ 2022-10-30 translate QB64 solution to JB
' from _Title "15625 Scenarios Elimination" 'b+ start 2021-09-05 2022-10-29
' QB64 dev notes
' restart 2022-10-27 add split
' 2022-10-29 make and use build sub for combining and ordering permutations
' generate ALL possible scenarios of house 1 number/order, 2 color, 3 nation, 4 drink, 5 smoke, 6 animal
' 2022-10-29 add old Wrd$() tool to find nth word in string.
' 2022-10-29 add Sub aCopy (a() As String, b() As String)
' 2022-10-29 add Sub AddEnd (a() As String, addon As String)
' 2022-10-29 3 phases of elimination and down to Sol'n in blink of the eye!

' Zebra build1.bas 2022-10-30
' JB dev notes, dump Wrd$ which mimics JB's Word$()
' Dump Split because JB doesn't do Dynamic arrays, that is going to be the challenge
' but Wrd$ may enough, slower but enough.
' Modify AddEnd and aCopy for static arrays. I hope JB has enough memory for 15,625 strings in
' one array and what? 100 in survivor array.
' Add global array indexes. Perform experiment two 15,625 string arrays???
' Make the word strings Global too as they will be used in build Sub
' Goal of Zebra build1.bas is to get the scenarios rebuilt in JB.
' PK mission accomplished! For me this was hardest part of getting started.
' And dang! if this is isn't simpler, of course it isn't nearly as generic either,
' it is totally geared for certain arrays with Global maxIndex variables.

' Zebra elininamtion phase 1.bas b+ 2022-10-30
' comment out display of 15,625 all possible scenarios and start 1st round of eliminations.
' If all goes right, we should go from the 15,625 possibles to 38, nice reduction to human terms.
' OK that step a success.

' Zebra elininamtion phase 2.bas b+ 2022-10-30
' How much more do we eliminate noticing no choice for House 1:
' must be water, Dunhills and yellow there and no other house.
' Good down to 11 scenarios remaining!

Global IMaxScen, IMaxSurv  ' track upper bound of items in giant arrays
Global House$, Color$, Nation$, Drink$, Smoke$, Animal$
Dim Scen$(15625), Surv$(15625) 'scenarios and survivors after logic elimination round

Print
Print "      The Zebra Puzzle has 16 Clues:"
Print
Print "  1.  There are five houses."
Print "  2.  The English man lives in the red house."
Print "  3.  The Swede has a dog."
Print "  4.  The Dane drinks tea."
Print "  5.  The green house is immediately to the left of the white house."
Print "  6.  They drink coffee in the green house."
Print "  7.  The man who smokes Pall Mall has birds."
Print "  8.  In the yellow house they smoke Dunhill."
Print "  9.  In the middle house they drink milk."
Print " 10.  The Norwegian lives in the first house."
Print " 11.  The man who smokes Blend lives in the house next to the house with cats."
Print " 12.  In a house next to the house where they have a horse, they smoke Dunhill."
Print " 13.  The man who smokes Blue Master drinks beer."
Print " 14.  The German smokes Prince."
Print " 15.  The Norwegian lives next to the blue house."
Print " 16.  They drink water in a house next to the house where they smoke Blend"
Print
Print "      The Puzzle is, Who owns the zebra?"
Print

' from 1-16 there are 5 house in order from left to right that have:
House$ = "1 2 3 4 5" 'left to right
Color$ = "red green white yellow blue"
Nation$ = "English Swede Dane Norwegian German"
Drink$ = "tea coffee milk beer water"
Smoke$ = "Pall_Malls Dunhill Blend Blue_Master Prince"
Animal$ = "dog birds cats horse zebra?"

Print " 15,625 = (5 ^ 6) possible scenarios of :"
Print "               5 House Choices: "; House$
Print "         with 5 Colors Choices: "; Color$
Print "  with 5 Nationalities Choices: "; Nation$
Print "          with 5 Drink Choices: "; Drink$
Print "         with 5 Smokes Choices: "; Smoke$
Print " and finally 5 Animals Choices: "; Animal$
Print

' start Scen$() with the 5 animals
For i = 1 To 5
   Scen$(i) = word$(Animal$, i)
next
IMaxScen = 5
IMaxSurv = 0
For b = 2 To 6
   Select Case b
       Case 2: call Build Smoke$
       Case 3: call Build Drink$
       Case 4: call Build Nation$
       Case 5: call Build Color$
       Case 6: call Build House$
   End Select
   call CopySurv2Scen ' transfers surv to scen and clears surv array for next build
Next
' call ShowScen  ' very good! so far don't need to show all this again === end of Zebra build1.bas
'
' OK that built as I want list: House Color Nation Drink Smoke Animal = 6 items in order
' note: at moment Scen$() is loaded with all scenarios and Surv$ is erased for refill
For i = 1 To IMaxScen ' elimination round
   OK = -1

   '2.  The English man lives in the red house.
   test1 = InStr(Scen$(i), "English") > 0: test2 = InStr(Scen$(i), "red") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '3.  The Swede has a dog.
   test1 = InStr(Scen$(i), "Swede") > 0: test2 = InStr(Scen$(i), "dog") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '4.  The Dane drinks tea.
   test1 = InStr(Scen$(i), "Dane") > 0: test2 = InStr(Scen$(i), "tea") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '5.  The green house is immediately to the left of the white house.
   ' green <> 1, 2 or 5  so 3 or 4  white 4 or 5  because blue is 2 and green and white are sequential

   testC$ = Word$(Scen$(i), 2): testH$ = Word$(Scen$(i), 1)

   If testC$ = "green" Then
       If testH$ = "3" Or testH$ = "4" Then
       Else
           OK = 0
       End If
   Else
       If testC$ = "white" Then
           If testH$ = "4" Or testH$ = "5" Then
           Else
               OK = 0
           End If
       End If
   End If
   ' house 4 can only be green or white or wont have sequence
   If testH$ = "4" Then
       If testC$ = "green" Or testC$ = "white" Then
       Else
           OK = 0
       End If
   End If

   '6.  They drink coffee in the green house.
   test1 = InStr(Scen$(i), "coffee") > 0: test2 = InStr(Scen$(i), "green") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '7.  The man who smokes Pall Mall has birds.
   test1 = InStr(Scen$(i), "Pall_Malls") > 0: test2 = InStr(Scen$(i), "birds") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '8.  In the yellow house they smoke Dunhill.
   test1 = InStr(Scen$(i), "yellow") > 0: test2 = InStr(Scen$(i), "Dunhill") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '9.  In the middle house they drink milk.
   test1 = InStr(Scen$(i), "3") > 0: test2 = InStr(Scen$(i), "milk") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '10.  The Norwegian lives in the first house.
   test1 = InStr(Scen$(i), "Norwegian") > 0: test2 = InStr(Scen$(i), "1") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '11.  The man who smokes Blend lives in the house next to the house with cats.
   test1 = InStr(Scen$(i), "Blend") > 0: test2 = InStr(Scen$(i), "cats") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then OK = 0
   End If

   '12.  In a house next to the house where they have a horse, they smoke Dunhill.
   test1 = InStr(Scen$(i), "horse") > 0: test2 = InStr(Scen$(i), "Dunhill") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then OK = 0
   End If

   '13.  The man who smokes Blue Master drinks beer.
   test1 = InStr(Scen$(i), "Blue_Master") > 0: test2 = InStr(Scen$(i), "beer") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '14.  The German smokes Prince.
   test1 = InStr(Scen$(i), "German") > 0: test2 = InStr(Scen$(i), "Prince") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '15.  The Norwegian lives next to the blue house.
   '     the Norwegian is in house 1 so blue house is house 2
   test1 = InStr(Scen$(i), "blue") > 0: test2 = InStr(Scen$(i), "2") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   ' 16. They drink water in a house next to the house where they smoke Blend
   test1 = InStr(Scen$(i), "water") > 0: test2 = InStr(Scen$(i), "Blend") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then OK = 0
   End If

   If OK Then
       IMaxSurv = IMaxSurv + 1
       Surv$(IMaxSurv) = Scen$(i)
   End If

Next
' OK what's left?
call CopySurv2Scen
Print
Print " Use the 16 statements to go from 15,625 scenarios to 38:"
call ShowScen
Print "================================================================================"

For i = 1 To IMaxScen
   OK = -1
   ' OK for house 1 we only have 1 choice for color, drink and smoke: yellow, water, dunhill
   ' if they are in any other house we can eliminate them
   testH$ = Word$(Scen$(i), 1)
   If testH$ <> "1" Then
       If InStr(Scen$(i), "yellow") > 0 Then OK = 0
       If InStr(Scen$(i), "water") > 0 Then OK = 0
       If InStr(Scen$(i), "Dunhill") > 0 Then OK = 0
   End If

   '12.  In a house next to the house where they have a horse, they smoke Dunhill.
   ' we know dunhill is house 1 so horse is house 2
   If testH$ <> "2" And Word$(Scen$(i), 6) = "horse" Then OK = 0
   If testH$ = "2" And Word$(Scen$(i), 6) <> "horse" Then OK = 0
   '' Also only red is coming up in house 3  no other choice it must go there!
   testC$ = Word$(Scen$(i), 2)

   ' When we clear Dunhills from other Houses 3 is left with only red,
   ' so green has to be House 3, no other options that makes green house 4
   ' and that makes white house 5 that should help clear some options!
   If testC$ = "red" Then
       If testH$ <> "3" Then OK = 0
   End If
   '' Also since house 3 aint going to be green then house 4 must be and so house 5 must be white!
   If testC$ = "green" Then
       If testH$ <> "4" Then OK = 0
   End If
   If testC$ = "white" Then
       If testH$ <> "5" Then OK = 0
   End If

   If OK Then ' add scenarios we could not eliminate to survivors
       IMaxSurv = IMaxSurv + 1
       Surv$(IMaxSurv) = Scen$(i)
   End If
Next

call CopySurv2Scen
Print
Print " Notice for House #1 only choice is: yellow, water and Dunhill, so no other house can use those."
Print " Also #12. In a house next to the house where they have a horse, they smoke Dunhill."
Print " We know Dunhill is in house 1 so horse has to be House 2"
Print " Also: For House 3, green is not a choice only red, so that settles green at 4 and white at 5."
Print " Imposing those requirements from observations 38 scenarios are reduced to 11!"
Print
call ShowScen
Print "================================================================================"
Print

Sub Build B$ ' customized for JB particular arrays with global index
   For i = 1 To IMaxScen
       For j = 1 To 5
           IMaxSurv = IMaxSurv + 1
           Surv$(IMaxSurv) = word$(B$, j) + " " + Scen$(i)
       Next
   Next
End Sub

Sub CopySurv2Scen ' just move contents of Surv back to fresh Scen and erase Surv
   dim Scen$(IMaxSurv) ' erase and reset array
   For i = 1 To IMaxSurv
       Scen$(i) = Surv$(i)
   Next
   IMaxScen = IMaxSurv
   ' delete Surv and make ready for next build or elim
   ' dim Surv$(15625) 'erase contents not sure I really need to do this try without  first
   IMaxSurv = 0
End Sub

sub ShowScen     ' lets check build or Scen = Scenarios
   ' In QB64 it worked that the Houses were listed in alpha order
   ' that made it easy to see what has to go where eg House 1 has to be
   ' yellow, drinking water and smoking Dunhills, that made it easy to take
   ' those out everywhere else!

   sort Scen$(), 1, IMaxScen
   for i = 1 to IMaxScen
       print i, Scen$(i)
   next
end sub

This solidifies the houses and their colors, we can next re-examine the neighbor / "next to" houses clauses again and make a final elimination.

[plus]

3's a Charm! The final elimination takes us to the one unique solution. Having houses in place we took another look at the neighbors statements and found only House #2 could have the Blends leaving House #1 with the cats and the German left with the zebra!
' Zebra elininamtion phase 3.bas b+ 2022-10-30
' Zebra Puzzle - Rosetta Code
' ref  http://rosettacode.org/wiki/Zebra_puzzle
' b+ 2022-10-30 translate QB64 solution to JB
' from _Title "15625 Scenarios Elimination" 'b+ start 2021-09-05 2022-10-29
' QB64 dev notes
' restart 2022-10-27 add split
' 2022-10-29 make and use build sub for combining and ordering permutations
' generate ALL possible scenarios of house 1 number/order, 2 color, 3 nation, 4 drink, 5 smoke, 6 animal
' 2022-10-29 add old Wrd$() tool to find nth word in string.
' 2022-10-29 add Sub aCopy (a() As String, b() As String)
' 2022-10-29 add Sub AddEnd (a() As String, addon As String)
' 2022-10-29 3 phases of elimination and down to Sol'n in blink of the eye!

' Zebra build1.bas 2022-10-30
' JB dev notes, dump Wrd$ which mimics JB's Word$()
' Dump Split because JB doesn't do Dynamic arrays, that is going to be the challenge
' but Wrd$ may enough, slower but enough.
' Modify AddEnd and aCopy for static arrays. I hope JB has enough memory for 15,625 strings in
' one array and what? 100 in survivor array.
' Add global array indexes. Perform experiment two 15,625 string arrays???
' Make the word strings Global too as they will be used in build Sub
' Goal of Zebra build1.bas is to get the scenarios rebuilt in JB.
' PK mission accomplished! For me this was hardest part of getting started.
' And dang! if this is isn't simpler, of course it isn't nearly as generic either,
' it is totally geared for certain arrays with Global maxIndex variables.

' Zebra elininamtion phase 1.bas b+ 2022-10-30
' comment out display of 15,625 all possible scenarios and start 1st round of eliminations.
' If all goes right, we should go from the 15,625 possibles to 38, nice reduction to human terms.
' OK that step a success.

' Zebra elininamtion phase 2.bas b+ 2022-10-30
' How much more do we eliminate noticing no choice for House 1:
' must be water, Dunhills and yellow there and no other house.
' Good down to 11 scenarios remaining!

' Zebra elininamtion phase 3.bas b+ 2022-10-30
' Withe the House positions and colors solidified, we can now re-examine those neighbor clauses
' #11 and #16 and make a final elimination to having only one complete set of scenarios left.
' The German has the zebra!

Global IMaxScen, IMaxSurv  ' track upper bound of items in giant arrays
Global House$, Color$, Nation$, Drink$, Smoke$, Animal$
Dim Scen$(15625), Surv$(15625) 'scenarios and survivors after logic elimination round

Print
Print "      The Zebra Puzzle has 16 Clues:"
Print
Print "  1.  There are five houses."
Print "  2.  The English man lives in the red house."
Print "  3.  The Swede has a dog."
Print "  4.  The Dane drinks tea."
Print "  5.  The green house is immediately to the left of the white house."
Print "  6.  They drink coffee in the green house."
Print "  7.  The man who smokes Pall Mall has birds."
Print "  8.  In the yellow house they smoke Dunhill."
Print "  9.  In the middle house they drink milk."
Print " 10.  The Norwegian lives in the first house."
Print " 11.  The man who smokes Blend lives in the house next to the house with cats."
Print " 12.  In a house next to the house where they have a horse, they smoke Dunhill."
Print " 13.  The man who smokes Blue Master drinks beer."
Print " 14.  The German smokes Prince."
Print " 15.  The Norwegian lives next to the blue house."
Print " 16.  They drink water in a house next to the house where they smoke Blend"
Print
Print "      The Puzzle is, Who owns the zebra?"
Print

' from 1-16 there are 5 house in order from left to right that have:
House$ = "1 2 3 4 5" 'left to right
Color$ = "red green white yellow blue"
Nation$ = "English Swede Dane Norwegian German"
Drink$ = "tea coffee milk beer water"
Smoke$ = "Pall_Malls Dunhill Blend Blue_Master Prince"
Animal$ = "dog birds cats horse zebra?"

Print " 15,625 = (5 ^ 6) possible scenarios of :"
Print "               5 House Choices: "; House$
Print "         with 5 Colors Choices: "; Color$
Print "  with 5 Nationalities Choices: "; Nation$
Print "          with 5 Drink Choices: "; Drink$
Print "         with 5 Smokes Choices: "; Smoke$
Print " and finally 5 Animals Choices: "; Animal$
Print

' start Scen$() with the 5 animals
For i = 1 To 5
   Scen$(i) = word$(Animal$, i)
next
IMaxScen = 5
IMaxSurv = 0
For b = 2 To 6
   Select Case b
       Case 2: call Build Smoke$
       Case 3: call Build Drink$
       Case 4: call Build Nation$
       Case 5: call Build Color$
       Case 6: call Build House$
   End Select
   call CopySurv2Scen ' transfers surv to scen and clears surv array for next build
Next
' call ShowScen  ' very good! so far don't need to show all this again === end of Zebra build1.bas
'
' OK that built as I want list: House Color Nation Drink Smoke Animal = 6 items in order
' note: at moment Scen$() is loaded with all scenarios and Surv$ is erased for refill
For i = 1 To IMaxScen ' elimination round
   OK = -1

   '2.  The English man lives in the red house.
   test1 = InStr(Scen$(i), "English") > 0: test2 = InStr(Scen$(i), "red") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '3.  The Swede has a dog.
   test1 = InStr(Scen$(i), "Swede") > 0: test2 = InStr(Scen$(i), "dog") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '4.  The Dane drinks tea.
   test1 = InStr(Scen$(i), "Dane") > 0: test2 = InStr(Scen$(i), "tea") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '5.  The green house is immediately to the left of the white house.
   ' green <> 1, 2 or 5  so 3 or 4  white 4 or 5  because blue is 2 and green and white are sequential

   testC$ = Word$(Scen$(i), 2): testH$ = Word$(Scen$(i), 1)

   If testC$ = "green" Then
       If testH$ = "3" Or testH$ = "4" Then
       Else
           OK = 0
       End If
   Else
       If testC$ = "white" Then
           If testH$ = "4" Or testH$ = "5" Then
           Else
               OK = 0
           End If
       End If
   End If
   ' house 4 can only be green or white or wont have sequence
   If testH$ = "4" Then
       If testC$ = "green" Or testC$ = "white" Then
       Else
           OK = 0
       End If
   End If

   '6.  They drink coffee in the green house.
   test1 = InStr(Scen$(i), "coffee") > 0: test2 = InStr(Scen$(i), "green") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '7.  The man who smokes Pall Mall has birds.
   test1 = InStr(Scen$(i), "Pall_Malls") > 0: test2 = InStr(Scen$(i), "birds") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '8.  In the yellow house they smoke Dunhill.
   test1 = InStr(Scen$(i), "yellow") > 0: test2 = InStr(Scen$(i), "Dunhill") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '9.  In the middle house they drink milk.
   test1 = InStr(Scen$(i), "3") > 0: test2 = InStr(Scen$(i), "milk") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '10.  The Norwegian lives in the first house.
   test1 = InStr(Scen$(i), "Norwegian") > 0: test2 = InStr(Scen$(i), "1") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '11.  The man who smokes Blend lives in the house next to the house with cats.
   test1 = InStr(Scen$(i), "Blend") > 0: test2 = InStr(Scen$(i), "cats") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then OK = 0
   End If

   '12.  In a house next to the house where they have a horse, they smoke Dunhill.
   test1 = InStr(Scen$(i), "horse") > 0: test2 = InStr(Scen$(i), "Dunhill") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then OK = 0
   End If

   '13.  The man who smokes Blue Master drinks beer.
   test1 = InStr(Scen$(i), "Blue_Master") > 0: test2 = InStr(Scen$(i), "beer") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '14.  The German smokes Prince.
   test1 = InStr(Scen$(i), "German") > 0: test2 = InStr(Scen$(i), "Prince") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   '15.  The Norwegian lives next to the blue house.
   '     the Norwegian is in house 1 so blue house is house 2
   test1 = InStr(Scen$(i), "blue") > 0: test2 = InStr(Scen$(i), "2") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           OK = 0
       End If
   End If

   ' 16. They drink water in a house next to the house where they smoke Blend
   test1 = InStr(Scen$(i), "water") > 0: test2 = InStr(Scen$(i), "Blend") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then OK = 0
   End If

   If OK Then
       IMaxSurv = IMaxSurv + 1
       Surv$(IMaxSurv) = Scen$(i)
   End If

Next
' OK what's left?
call CopySurv2Scen
Print
Print " Use the 16 statements to go from 15,625 scenarios to 38:"
call ShowScen
Print "================================================================================"

For i = 1 To IMaxScen
   OK = -1
   ' OK for house 1 we only have 1 choice for color, drink and smoke: yellow, water, dunhill
   ' if they are in any other house we can eliminate them
   testH$ = Word$(Scen$(i), 1)
   If testH$ <> "1" Then
       If InStr(Scen$(i), "yellow") > 0 Then OK = 0
       If InStr(Scen$(i), "water") > 0 Then OK = 0
       If InStr(Scen$(i), "Dunhill") > 0 Then OK = 0
   End If

   '12.  In a house next to the house where they have a horse, they smoke Dunhill.
   ' we know dunhill is house 1 so horse is house 2
   If testH$ <> "2" And Word$(Scen$(i), 6) = "horse" Then OK = 0
   If testH$ = "2" And Word$(Scen$(i), 6) <> "horse" Then OK = 0
   '' Also only red is coming up in house 3  no other choice it must go there!
   testC$ = Word$(Scen$(i), 2)

   ' When we clear Dunhills from other Houses 3 is left with only red,
   ' so green has to be House 3, no other options that makes green house 4
   ' and that makes white house 5 that should help clear some options!
   If testC$ = "red" Then
       If testH$ <> "3" Then OK = 0
   End If
   '' Also since house 3 aint going to be green then house 4 must be and so house 5 must be white!
   If testC$ = "green" Then
       If testH$ <> "4" Then OK = 0
   End If
   If testC$ = "white" Then
       If testH$ <> "5" Then OK = 0
   End If

   If OK Then ' add scenarios we could not eliminate to survivors
       IMaxSurv = IMaxSurv + 1
       Surv$(IMaxSurv) = Scen$(i)
   End If
Next
call CopySurv2Scen
Print
Print " Notice for House #1 only choice is: yellow, water and Dunhill,"
Print " so no other house can use those."
Print " Also #12. In a house next to the house where they have a horse, they smoke"
Print " Dunhill. We know Dunhill is in house 1 so horse has to be House 2"
Print " Also: For House 3, green is not a choice only red, so that settles green at"
print " 4 and white at 5."
Print " Imposing those requirements from observations 38 scenarios are reduced to 11!"
Print
call ShowScen
Print "================================================================================"

For i = 1 To IMaxScen
   OK = -1
   ' last of conditions
   '11.  The man who smokes Blend lives in the house next to the house with cats.
   '16.  They drink water in a house next to the house where they smoke Blend
   ' House 2 has only one option and that is with Blends and house 1 must have cats
   ' because house 3 doesnt
   testH$ = Word$(Scen$(i), 1)
   testS$ = Word$(Scen$(i), 5)
   testA$ = Word$(Scen$(i), 6)
   testN$ = Word$(Scen$(i), 3)
   If testS$ = "Blend" And testH$ <> "2" Then OK = 0
   If testS$ <> "Blend" And testH$ = "2" Then OK = 0
   If testA$ = "cats" And testH$ <> "1" Then OK = 0
   If testA$ <> "cats" And testH$ = "1" Then OK = 0
   ' also House 2 has to be the Dane
   If testH$ <> "2" And testN$ = "Dane" Then OK = 0
   If OK Then
       IMaxSurv = IMaxSurv + 1
       Surv$(IMaxSurv) = Scen$(i)
   End If
Next
call CopySurv2Scen 'put servivors back into scenario's
Print
Print " Now we can take another look at these House positioning requirements:"
Print " 11.  The man who smokes Blend lives in the house next to the house with cats."
Print " 16.  They drink water in a house next to the house where they smoke Blend"
Print " House 2 has only one option and that is with Blends and house 1 must have cats"
print " because house 3 doesn't."
Print
call ShowScen
Print
Print " And with the last cut from Blends connection to House 2,"
print " we arrive at the only possible solution!"
Print " The German could not have the Blends nor cats, Blend is at House 2 and cats"
Print " at House 1. He's got the Zebra!"
Print
Print "                                                                           b+"

Sub Build B$ ' customized for JB particular arrays with global index
   For i = 1 To IMaxScen
       For j = 1 To 5
           IMaxSurv = IMaxSurv + 1
           Surv$(IMaxSurv) = word$(B$, j) + " " + Scen$(i)
       Next
   Next
End Sub

Sub CopySurv2Scen ' just move contents of Surv back to fresh Scen and erase Surv
   dim Scen$(IMaxSurv) ' erase and reset array
   For i = 1 To IMaxSurv
       Scen$(i) = Surv$(i)
   Next
   IMaxScen = IMaxSurv
   ' delete Surv and make ready for next build or elim
   ' dim Surv$(15625) 'erase contents not sure I really need to do this try without  first
   IMaxSurv = 0
End Sub

sub ShowScen     ' lets check build or Scen = Scenarios
   ' In QB64 it worked that the Houses were listed in alpha order
   ' that made it easy to see what has to go where eg House 1 has to be
   ' yellow, drinking water and smoking Dunhills, that made it easy to take
   ' those out everywhere else!

   sort Scen$(), 1, IMaxScen
   for i = 1 to IMaxScen
       print i, Scen$(i)
   next
end sub


This problem sat on my ToDo list for over a year, it is a milestone for me to get it finished or nearly. Maybe we could do this all in one sweep, searching in code Houses with no options left for various items... The thing fell into place for me yesterday after I figured out how to build all the possible scenarios.

I am pleasantly surprised how fast this runs in JB, not bad for not compiled code.

[tsh73]

It was really nice to read (code too).
Computer detective story!
Great job.

[plus]

Thanks, yes Sherlock was on the case using deductive logic the foundation of Math and Computer Science.

There is still a step that could be attempted, make the observations I was making with my eyes in code, seeing which options are forced upon certain houses and coding the eliminations automatically.

[marshawn]

gotta be JB

[plus]

There were a couple problems like Zebra Puzzle linked at Rosetta Code so I took a shot at them.

Here is Dinesman Multi-Dwelling. It is pretty straightforward, test all possible floors for each occupant, see what sticks. Only one answer, ref link and conditions listed as comments in code. This took 0 changes for it to work in JB:
' Dinesman Muti-Dwelling - Rosetta Code b+ 2022-10-31 translated from QB64
'_Title "Dinemans Multi_Dwelling - Rosetta Code" ' b+ found 2022-10-30  too easy
' ref: https://rosettacode.org/wiki/Dinesman%27s_multiple-dwelling_problem

'Baker does not live on the top floor.
'Cooper does not live on the bottom floor.
'Fletcher does not live on either the top or the bottom floor.
'Miller lives on a higher 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

' nim soln same as Ada:
'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

' b <> 5     ' 1 to 4
' c <> 1      ' 2 to 5
' f <> 1 and f <> 5   ' 2 to 4
' m > c      then c <> 5   m <> 1
' s <> f + 1 and s <> f - 1
' f <> c + 1 and f <> c - 1

'everyone seems to go from 1 to 5        is there another solution going from 5 to 1?  no because the other codes dont quit when one is found
For b = 4 To 1 Step -1
   For c = 4 To 2 Step -1
       If c <> b Then
           For f = 4 To 2 Step -1
               If (f <> c) And (f <> b) Then
                   For m = 5 To 2 Step -1
                       If (m <> f) And ((m <> c) And (m <> b)) Then
                           For s = 5 To 1 Step -1
                               If ((s <> m) And (s <> f)) And ((s <> c) And (s <> b)) Then
                                   If (f <> c + 1) And (f <> c - 1) Then
                                       If s <> f + 1 And s <> f - 1 Then
                                           If m > c Then
                                               Print "Baker ="; b
                                               Print "Cooper ="; c
                                               Print "Fletcher ="; f
                                               Print "Miller ="; m
                                               Print "Smith ="; s
                                           End If
                                       End If
                                   End If
                               End If
                           Next
                       End If
                   Next
               End If
           Next
       End If
   Next
Next
Print "              End of Run"



Smith is the poor soul stuck with First Floor.

[plus]

And this is Twelve Statements problem from Rosetta Code. Much more problematic for Statement 4 and 8 I had to add an Else clause and make the statement True in order to match the solutions shown at Rosetta Code. After that in the JB translation I went for the extra credit and showed the near misses.

See reference link in code comments:
' Twelve Statements - Rosetta Code b+ trans from QB64 2022-10-31
'ref:     https://rosettacode.org/wiki/Twelve_statements

'     12 Statements
' 1.  This is a numbered list of twelve statements.
' 2.  Exactly 3 of the last 6 statements are true.
' 3.  Exactly 2 of the even-numbered statements are true.
' 4.  If statement 5 is true, then statements 6 and 7 are both true.
' 5.  The 3 preceding statements are all false.
' 6.  Exactly 4 of the odd-numbered statements are true.
' 7.  Either statement 2 or 3 is true, but not both.
' 8.  If statement 7 is true, then 5 and 6 are both true.
' 9.  Exactly 3 of the first 6 statements are true.
'10.  The next two statements are both true.
'11.  Exactly 1 of statements 7, 8 and 9 are true.
'12.  Exactly 4 of the preceding statements are true.

' Solution at Rosetta Code is with statements 1 3 4 6 7 11 true.

' go through all combinations of TF and see which one is consistent with statements
For n = 0 To 4095 ' 2 ^ 12 = 4096 permutations of TF for 12 digits positions
   scan
   dim st(12), TF(12) 'reset and get a TF scenario and compare to 12 statements
   For i = 0 To 11
       if n and 2^i then TF(i+1) = 1
   Next
   'print n,
   'for i = 1 to 12: print TF(i); :next: print

   ' 1.  This is a numbered list of twelve statements.
   st(1) = 1

   ' 2.  Exactly 3 of the last 6 statements are true.
   If ((TF(7) + TF(8) + TF(9) + TF(10) + TF(11) + TF(12)) = 3) Then st(2) = 1

   ' 3.  Exactly 2 of the even-numbered statements are true.
   If ((TF(2) + TF(4) + TF(6) + TF(8) + TF(10) + TF(12)) = 2) Then st(3) = 1

   ' 4.  If statement 5 is true, then statements 6 and 7 are both true.
   If TF(5) Then
       If ((TF(6) + TF(7)) = 2) Then st(4) = 1
   Else ' we need next to say true??
       st(4) = 1 ' ?  not working the other way every other TF will be 0 anyway
   End If

   ' 5.  The 3 preceding statements are all false.
   If ((TF(4) + TF(3) + TF(2)) = 0) Then st(5) = 1

   ' 6.  Exactly 4 of the odd-numbered statements are true.
   If ((TF(1) + TF(3) + TF(5) + TF(7) + TF(9) + TF(11)) = 4) Then st(6) = 1

   ' 7.  Either statement 2 or 3 is true, but not both.
   If ((TF(2) + TF(3)) = 1) Then st(7) = 1

   ' 8.  If statement 7 is true, then 5 and 6 are both true.
   If TF(7) Then
       If ((TF(5) + TF(6)) = 2) Then st(8) = 1
   Else '
       st(8) = 1 ' ??? this is like 4  which fixed things when I added else like here
   End If

   ' 9.  Exactly 3 of the first 6 statements are true.
   If ((TF(1) + TF(2) + TF(3) + TF(4) + TF(5) + TF(6)) = 3) Then st(9) = 1

   '10.  The next two statements are both true.
   If ((TF(11) + TF(12)) = 2) Then st(10) = 1

   '11.  Exactly 1 of statements 7, 8 and 9 are true.
   If ((TF(7) + TF(8) + TF(9)) = 1) Then st(11) = 1

   '12.  Exactly 4 of the preceding statements are true.
   If ((TF(1) + TF(2) + TF(3) + TF(4) + TF(5) + TF(6) + TF(7) + TF(8) + TF(9) + TF(10) + TF(11)) = 4) Then st(12) = 1

   wrong = 0 : s$ = ""
   For i = 1 To 12
       If st(i) <> TF(i) Then wrong = wrong + 1 : saveI = i
       If TF(i) then s$ = s$;i;" " else s$ = s$;"_ "
   Next
   if wrong = 1 then print "Near miss, true at: ";s$;" missed at ";saveI
   if wrong = 0 then print " Solution! true at: ";s$;" <<<<<<<<<<<<<"
Next
Print "End of Run."



Output:
Near miss, true at: 1 _ _ 4 _ _ _ _ _ _ _ _  missed at 8
Near miss, true at: 1 _ _ _ 5 _ _ _ _ _ _ _  missed at 8
Near miss, true at: 1 _ _ _ 5 _ _ 8 _ _ _ _  missed at 11
Near miss, true at: 1 _ 3 4 _ 6 7 _ 9 _ _ _  missed at 9
Near miss, true at: 1 _ 3 4 _ _ _ 8 9 _ _ _  missed at 7
Near miss, true at: 1 _ _ 4 _ 6 _ 8 9 _ _ _  missed at 6
Near miss, true at: 1 2 _ 4 _ _ 7 8 9 _ _ _  missed at 8
Near miss, true at: 1 2 _ 4 _ _ 7 _ 9 10 _ _  missed at 10
Solution! true at: 1 _ 3 4 _ 6 7 _ _ _ 11 _  <<<<<<<<<<<<<
Near miss, true at: _ _ _ _ 5 _ _ 8 _ _ 11 _  missed at 1
Near miss, true at: 1 _ _ _ 5 _ _ 8 _ _ 11 _  missed at 12
Near miss, true at: 1 _ _ _ 5 6 _ _ 9 _ 11 _  missed at 8
Near miss, true at: 1 2 _ 4 _ _ 7 _ 9 _ _ 12  missed at 12
Near miss, true at: _ _ _ 4 _ _ _ 8 _ 10 11 12  missed at 1
Near miss, true at: 1 _ _ 4 _ _ _ 8 _ 10 11 12  missed at 12
Near miss, true at: _ _ _ _ 5 _ _ 8 _ 10 11 12  missed at 1
Near miss, true at: 1 _ _ _ 5 _ _ 8 _ 10 11 12  missed at 12
End of Run.



[plus]

I rewrote Zebra Puzzle to blindly continue calling the Elimination Sub until no more changes could be made. This takes the place of me looking at the results of an elimination round and coding the next round by observing unique solutions that develop. Also I rebuilt the Build sub so that the scen$() didn't need sorting after the build. Actually it's nice way to generate all possible permutations for various sets of items.

So this code is a little smarter:
' Zebra 2 Sweep.bas trans to JB 2022-11-04 b+

' ref  http://rosettacode.org/wiki/Zebra_puzzle
' restart 2022-10-27 add split
' 2022-10-29 make and use build sub for combining and ordering permutations
' generate ALL possible scenarios of house 1 number/order, 2 color, 3 nation, 4 drink, 5 smoke, 6 animal
' 2022-10-29 add old Wrd$() tool to find nth word in string.
' 2022-10-29 add Sub aCopy (a() As String, b() As String)
' 2022-10-29 add Sub AddEnd (a() As String, addon As String)
' 2022-10-29 3 phases of elimination and down to Sol'n in blink of the eye!

' 2022-11-02 Zebra Puzzle 2 Sweep is an attempt to code the observations I made between 3 eliminations rounds
' After first elimination from 15625 to 38 I observed House 1 had to be yellow, water Dunhills
' Add a Shared Solution Array and a sub that reads through survivor scenarios and looks for only 1 option for a house
' eg house 1 is only yellow so put yellow under color for house 1 and remove all other houses with yellow as option

' 2022-11-03 Since I am rebuilding this I want to do the build over too, more like I did in JB translation.
' 2022-11-04 OK it runs through supposedly without assistance by programmer.

Print
Print "      The Zebra Puzzle has 16 Clues:"
Print
Print "  1.  There are five houses."
Print "  2.  The English man lives in the red house."
Print "  3.  The Swede has a dog."
Print "  4.  The Dane drinks tea."
Print "  5.  The green house is immediately to the left of the white house."
Print "  6.  They drink coffee in the green house."
Print "  7.  The man who smokes Pall Mall has birds."
Print "  8.  In the yellow house they smoke Dunhill."
Print "  9.  In the middle house they drink milk."
Print " 10.  The Norwegian lives in the first house."
Print " 11.  The man who smokes Blend lives in the house next to the house with cats."
Print " 12.  In a house next to the house where they have a horse, they smoke Dunhill."
Print " 13.  The man who smokes Blue Master drinks beer."
Print " 14.  The German smokes Prince."
Print " 15.  The Norwegian lives next to the blue house."
Print " 16.  They drink water in a house next to the house where they smoke Blend"
Print
Print "      The Puzzle is, Who owns the zebra?"
Print

Global IMaxScen, IMaxSurv
Global Flag$, order$, color$, nation$, drink$, smoke$, animal$
Dim Soln$(6, 5) ' quality columns and house number rows

' from 1-16 there are 5 house in order from left to right that have:
house$ = "1 2 3 4 5" 'left to right
color$ = "red green white yellow blue"
nation$ = "English Swede Dane Norwegian German"
drink$ = "tea coffee milk beer water"
smoke$ = "Pall_Malls Dunhill Blend Blue_Master Prince"
animal$ = "dog birds cats horse zebra?"

Print " 15,625 = (5 ^ 6) possible scenarios of :"
Print "               5 House Choices: "; house$
Print "         with 5 Colors Choices: "; color$
Print "  with 5 Nationalities Choices: "; nation$
Print "          with 5 Drink Choices: "; drink$
Print "         with 5 Smokes Choices: "; smoke$
Print " and finally 5 Animals Choices: "; animal$
Print
dim scen$(15625), surv$(15625) ' container for all the permutations   make this shared so sub can use without parameter

' start Scen$() with the 5 animals
for i = 1 to 5
   scen$(i) = word$(animal$, i)
next
IMaxScen = 5
IMaxSurv = 0
For b = 2 To 6
   Select Case b
       Case 2: call Build smoke$
       Case 3: call Build drink$
       Case 4: call Build nation$
       Case 5: call Build color$
       Case 6: call Build house$
   End Select
Next
'call showScen  ' very good! so far

For i = 1 To 15625 ' elimination round

   '2.  The English man lives in the red house.
   test1 = InStr(scen$(i), "English") > 0: test2 = InStr(scen$(i), "red") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '3.  The Swede has a dog.
   test1 = InStr(scen$(i), "Swede") > 0: test2 = InStr(scen$(i), "dog") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '4.  The Dane drinks tea.
   test1 = InStr(scen$(i), "Dane") > 0: test2 = InStr(scen$(i), "tea") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '5.  The green house is immediately to the left of the white house.
   ' green <> 1, 2 or 5  so 3 or 4  white 4 or 5  because blue is 2 and green and white are sequential
   testC$ = Word$(scen$(i), 2): testH$ = Word$(scen$(i), 1)
   If testC$ = "green" Then
       If testH$ = "3" Or testH$ = "4" Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   Else
       If testC$ = "white" Then
           If testH$ = "4" Or testH$ = "5" Then
           Else
               scen$(i) = scen$(i) + " X"
           end if
       end if
   End If
   ' house 4 can only be green or white or wont have sequence
   If testH$ = "4" Then
       If testC$ = "green" Or testC$ = "white" Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '6.  They drink coffee in the green house.
   test1 = InStr(scen$(i), "coffee") > 0: test2 = InStr(scen$(i), "green") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '7.  The man who smokes Pall Mall has birds.
   test1 = InStr(scen$(i), "Pall_Malls") > 0: test2 = InStr(scen$(i), "birds") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '8.  In the yellow house they smoke Dunhill.
   test1 = InStr(scen$(i), "yellow") > 0: test2 = InStr(scen$(i), "Dunhill") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '9.  In the middle house they drink milk.
   test1 = InStr(scen$(i), "3") > 0: test2 = InStr(scen$(i), "milk") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '10.  The Norwegian lives in the first house.
   test1 = InStr(scen$(i), "Norwegian") > 0: test2 = InStr(scen$(i), "1") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '11.  The man who smokes Blend lives in the house next to the house with cats.
   test1 = InStr(scen$(i), "Blend") > 0: test2 = InStr(scen$(i), "cats") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then scen$(i) = scen$(i) + " X"
   End If

   '12.  In a house next to the house where they have a horse, they smoke Dunhill.
   test1 = InStr(scen$(i), "horse") > 0: test2 = InStr(scen$(i), "Dunhill") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then scen$(i) = scen$(i) + " X"
   End If

   '13.  The man who smokes Blue Master drinks beer.
   test1 = InStr(scen$(i), "Blue_Master") > 0: test2 = InStr(scen$(i), "beer") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '14.  The German smokes Prince.
   test1 = InStr(scen$(i), "German") > 0: test2 = InStr(scen$(i), "Prince") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   '15.  The Norwegian lives next to the blue house.
   '     the Norwegian is in house 1 so blue house is house 2
   test1 = InStr(scen$(i), "blue") > 0: test2 = InStr(scen$(i), "2") > 0
   If test1 Or test2 Then ' if have one must have both or dump
       If test1 And test2 Then
       Else
           scen$(i) = scen$(i) + " X"
       end if
   End If

   ' 16. They drink water in a house next to the house where they smoke Blend
   test1 = InStr(scen$(i), "water") > 0: test2 = InStr(scen$(i), "Blend") > 0
   If test1 Or test2 Then ' not in same house
       If test1 And test2 Then scen$(i) = scen$(i) + " X"
   End If

Next
Print " First Elimination:"
call showScen ' OK  still works with 38 surv after first elim
Print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
Print
Print " Continue calling the blind Elimination Sub until no more changes:"
Do
   Flag$ = ""
   call EvalElimRun
   If Flag$ <> "" Then Print Flag$
   If Flag$ <> "" Then call showScen
Loop Until Flag$ = ""

Print: Print "============================================================================="
Print
print " Solution:"
call showSolution

Function House (val$)
   For row = 1 To 5
       For col = 1 To 6
           If Soln$(col, row) = val$ Then House = row: Exit Function
       Next
   Next
End Function

Sub showSolution
   Print pad$("House"); pad$("Color"); pad$("Nation"); pad$("Drink"); pad$("Smoke"); pad$("Pet")
   Print
   For row = 1 To 5
       For col = 1 To 6
           Print pad$(Soln$(col, row));
       Next
       Print
   Next
End Sub

Function pad$ (s$)
   pad$ = Left$(s$ + "            ", 13)
End Function

Sub EvalElimRun ' here I coded what I coded manually before supposedly without knowing what is going to sieve through
   For h = 1 To 5
       H$ = Str$(h)
       s = (h - 1) * 3125 + 1
       ' find first house still in the running
       While Word$(scen$(s), 7) = "X" And s < h * 3125
           s = s + 1
       Wend ' still active

       Dim first$(6) ' get it's values
       For item = 1 To 6
           first$(item) = Word$(scen$(s), item) ' get first values for house
       Next
       ' if all values match first we have exclusive
       Dim NoMatch(6)
       s = s + 1
       While s <= h * 3125 ' run through section with house # h check if items match the very first active found
           If Word$(scen$(s), 7) <> "X" Then ' scen s still in running
               For item = 1 To 6
                   If NoMatch(item) = 0 Then ' so far all these are matching
                       If first$(item) <> Word$(scen$(s), item) Then NoMatch(item) = 1 ' dang
                   End If
               Next
           End If
           s = s + 1
       Wend

       ' process matches
       For item = 1 To 6
           If NoMatch(item) = 0 Then ' found something unique for house!
               If Soln$(item, h) = "" Then ' did we already know?
                   Soln$(item, h) = first$(item)
                   ' now throw out every other scen$ with that item in another house
                   For s = 1 To 15625
                       If Word$(scen$(s), 7) <> "X" Then ' scen s still in running
                           If Word$(scen$(s), 1) <> H$ Then
                               If Word$(scen$(s), item) = first$(item) Then scen$(s) = scen$(s) + " X": Flag$ = "Change" ' signal a change
                           End If
                       End If
                   Next
               End If
           End If
       Next
   Next

   ' more 16.  They drink water in a house next to the house where they smoke Blend"
   If House("water") Then ' water is a solution so house # is determined and Blend is a neighbor
       For s = 1 To 15625
           If Word$(scen$(s), 7) <> "X" Then
               If Word$(scen$(s), 5) = "Blend" Then
                   If Abs(House("water") - Val(Word$(scen$(s), 1))) <> 1 Then scen$(s) = scen$(s) + " X": Flag$ = "Change"
               End If
           End If
       Next
   End If
   If House("Blend") Then '  Blend is a solution so house # is determined  next door water
       For s = 1 To 15625
           If Word$(scen$(s), 7) <> "X" Then
               If Word$(scen$(s), 4) = "water" Then
                   If Abs(House("Blend") - Val(Word$(scen$(s), 1))) <> 1 Then scen$(s) = scen$(s) + " X": Flag$ = "Change"
               End If
           End If
       Next
   End If

   ' more 12.  In a house next to the house where they have a horse, they smoke Dunhill.
   If House("Dunhill") Then ' Dunhill is a solution so house # is determined  next door horse
       For s = 1 To 15625
           If Word$(scen$(s), 7) <> "X" Then
               If Word$(scen$(s), 6) = "horse" Then
                   If Abs(House("Dunhill") - Val(Word$(scen$(s), 1))) <> 1 Then scen$(s) = scen$(s) + " X": Flag$ = "Change"
               End If
           End If
       Next
   End If
   If House("horse") Then ' horse is a solution so next door is Dunhill
       For s = 1 To 15625
           If Word$(scen$(s), 7) <> "X" Then
               If Word$(scen$(s), 5) = "Dunhill" Then
                   If Abs(House("horse") - Val(Word$(scen$(s), 1))) <> 1 Then scen$(s) = scen$(s) + " X": Flag$ = "Change"
               End If
           End If
       Next
   End If

   ' more 11.  The man who smokes Blend lives in the house next to the house with cats.
   If House("Blend") Then ' Blend is a sloution so next door cats
       For s = 1 To 15625
           If Word$(scen$(s), 7) <> "X" Then
               If Word$(scen$(s), 6) = "cats" Then
                   If Abs(House("Blend") - Val(Word$(scen$(s), 1))) <> 1 Then scen$(s) = scen$(s) + " X": Flag$ = "Change"
               End If
           End If
       Next
   End If
   If House("cats") Then ' cats is a solution so next door Blend
       For s = 1 To 15625
           If Word$(scen$(s), 7) <> "X" Then
               If Word$(scen$(s), 5) = "Blend" Then
                   If Abs(House("cats") - Val(Word$(scen$(s), 1))) <> 1 Then scen$(s) = scen$(s) + " X": Flag$ = "Change"
               End If
           End If
       Next
   End If

End Sub

Sub Build B$ ' customized for JB particular arrays with global index
   For i = 1 To 5
       For j = 1 To IMaxScen
           IMaxSurv = IMaxSurv + 1
           surv$(IMaxSurv) = word$(B$, i) + " " + scen$(j)
       Next
   Next
   dim scen$(IMaxSurv) ' erase and reset array
   For i = 1 To IMaxSurv
       scen$(i) = surv$(i)
   Next
   IMaxScen = IMaxSurv
   ' delete Surv and make ready for next build or elim
   ' dim Surv$(15625) 'erase contents not sure I really need to do this try without  first
   IMaxSurv = 0
End Sub

Sub showScen ' the scenarios not eliminated
   For i = 1 To 15625
       scan
       If Word$(scen$(i), 7) <> "X" Then c = c + 1: Print c, scen$(i)
   Next
End Sub

Function wCnt (s$)
   If Len(s$) = 0 Then wCnt = 0: Exit Function
   c = 1: p = 1: ip = InStr(s$, " ", p)
   While ip
       c = c + 1: p = ip + 1: ip = InStr(s$, " ", p)
   Wend
   wCnt = c
End Function


It's also a little longer in Lines Of Code (LOC) and takes more time because I don't throw out the eliminated scenarios. I just add " X" to the end of the scenario that has just been eliminated and skip over those when examining the survivors. That way I don't have to track which index numbers house #1 starts and ends.