Charlie Veniot 1st November 2022 at 6:48pm
' https://rosettacode.org/wiki/Zebra_puzzle
' BASIC Anywhere Machine version by Charlie Veniot
' Using a blend of TiddlyWiki (as meta-programming/scripting language) and BASIC
' screen _newimage(720, 280, 0)
' 🟠 General Description of Process (Program runtime is a about 5 minutes and 15 seconds).
' Use TiddlyWiki widgets to generate all possible combinations of house number, nationality, house color, smoke brand, drink type, and pet type
' immediately eliminating individual attribute combinations for any one house that are not possible.
'
' With what is left, generate BASIC DATA statements, in groups of possible combinations for each house number.
' Get a count of possible combinations for each house number.
'
' Now, loop through all of the possible combinations of house 1,2,3,4,5 attributes.
' (so for each possible combination of attributes for house 1, combine with each combination of house 2 attributes, combine with each combination of house 3 attributes,
' etc. etc.)
' For each possible combination of houses 1-5, keep only those combinations that pass the checks involving relationships between the houses.
' 🟠 Function to count number of DATA statements (a combination of attributes per DATA statement for 1 house) per house number
FUNCTION HouseDataCount%()
thisCount = 0
DO
READ HouseNum$, Nationality$, HouseColor$, SmokeBrand$, DrinkType$, PetType$
IF HouseNum$ <> "0" THEN thisCount = thisCount + 1
LOOP UNTIL HouseNum$ = "0"
HouseDataCount% = thisCount
END FUNCTION
' 🟠 Functions to compare attributes across 2-5 houses in a potential grouping of attributes for houses 1 - 5
FUNCTION AreDistinct%(a$,b$,c$,d$,e$)
returnDistinct = TRUE
IF a$ = b$ OR a$ = c$ or a$ = d$ OR a$ = e$ THEN returnDistinct = FALSE
IF b$ = c$ OR b$ = d$ OR b$ = e$ THEN returnDistinct = FALSE
IF c$ = d$ OR c$ = e$ THEN returnDistinct = FALSE
IF d$ = e$ THEN returnDistinct = FALSE
AreDistinct% = returnDistinct
END FUNCTION
FUNCTION GreenToLeftOfWhite%(a$,b$,c$,d$,e$)
returnValue = TRUE
IF a$ = "Green" AND b$ <> "White" THEN returnValue = FALSE
IF b$ = "Green" AND c$ <> "White" THEN returnValue = FALSE
IF c$ = "Green" AND d$ <> "White" THEN returnValue = FALSE
IF d$ = "Green" AND e$ <> "White" THEN returnValue = FALSE
GreenToLeftOfWhite% = returnValue
END FUNCTION
FUNCTION BlendNextToCats%(Sb1$,Sb2$,Sb3$,Sb4$,Sb5$,Pt1$,Pt2$,Pt3$,Pt4$,Pt5$)
returnValue = TRUE
IF Sb1$ = "Blend" AND Pt2$ <> "Cats" THEN returnValue = FALSE : GOTO DoneBNTC
IF Pt1$ = "Cats" AND Sb2$ <> "Blend" THEN returnValue = FALSE : GOTO DoneBNTC
IF Sb2$ = "Blend" AND Pt1$ <> "Cats" AND Pt3$ <> "Cats" THEN returnValue = FALSE : GOTO DoneBNTC
IF Pt2$ = "Cats" AND Sb1$ <> "Blend" AND Sb3$ <> "Blend" THEN returnValue = FALSE : GOTO DoneBNTC
IF Sb3$ = "Blend" AND Pt2$ <> "Cats" AND Pt4$ <> "Cats" THEN returnValue = FALSE : GOTO DoneBNTC
IF Pt3$ = "Cats" AND Sb2$ <> "Blend" AND Sb4$ <> "Blend" THEN returnValue = FALSE : GOTO DoneBNTC
IF Sb4$ = "Blend" AND Pt3$ <> "Cats" AND Pt5$ <> "Cats" THEN returnValue = FALSE : GOTO DoneBNTC
IF Pt4$ = "Cats" AND Sb3$ <> "Blend" AND Sb5$ <> "Blend" THEN returnValue = FALSE : GOTO DoneBNTC
DoneBNTC:
BlendNextToCats% = returnValue
END FUNCTION
FUNCTION DunhillNextToHorse%(Sb1$,Sb2$,Sb3$,Sb4$,Sb5$,Pt1$,Pt2$,Pt3$,Pt4$,Pt5$)
returnValue = TRUE
IF Sb1$ = "Dunhill" AND Pt2$ <> "Horse" THEN returnValue = FALSE : GOTO DoneDNTH
IF Pt1$ = "Horse" AND Sb2$ <> "Dunhill" THEN returnValue = FALSE : GOTO DoneDNTH
IF Sb2$ = "Dunhill" AND Pt1$ <> "Horse" AND Pt3$ <> "Horse" THEN returnValue = FALSE : GOTO DoneDNTH
IF Pt2$ = "Horse" AND Sb1$ <> "Dunhill" AND Sb3$ <> "Dunhill" THEN returnValue = FALSE : GOTO DoneDNTH
IF Sb3$ = "Dunhill" AND Pt2$ <> "Horse" AND Pt4$ <> "Horse" THEN returnValue = FALSE : GOTO DoneDNTH
IF Pt3$ = "Horse" AND Sb2$ <> "Dunhill" AND Sb4$ <> "Dunhill" THEN returnValue = FALSE : GOTO DoneDNTH
IF Sb4$ = "Dunhill" AND Pt3$ <> "Horse" AND Pt5$ <> "Horse" THEN returnValue = FALSE : GOTO DoneDNTH
IF Pt4$ = "Horse" AND Sb3$ <> "Dunhill" AND Sb5$ <> "Dunhill" THEN returnValue = FALSE : GOTO DoneDNTH
DoneDNTH:
DunhillNextToHorse% = returnValue
END FUNCTION
' 🟠 The list of available values for each attribute, used at the start of the main program and creation of DATA statements further below
<$let house_num_list="1,2,3,4,5"
nationality_list="English,Swede,Dane,Norwegian,German"
house_color_list="Red,Green,White,Yellow,hBlue"
smoke_brand_list="Pall Mall,Dunhill,Blend,Blue Master,Prince"
drink_type_list="Tea,Coffee,Milk,Beer,Water"
pet_type_list="Dog,Birds,Cats,Horse,Zebra">
' 🟠 Main BASIC Program
<$list variable="house_num" filter="[<house_num_list>split[,]]">
RESTORE HOUSE<<house_num>><br>
House<<house_num>>DataCount = HouseDataCount%()<br>
</$list>
COLOR 14 : PRINT "PROGRAM START TIME: " + TIME$
_delay 0.00125
FOR I1 = 1 TO House1DataCount
RESTORE HOUSE1
FOR R = 1 TO I1
READ HouseNum1$, HouseColor1$, Nationality1$, SmokeBrand1$, DrinkType1$, PetType1$
NEXT R
FOR I2 = 1 TO House2DataCount
RESTORE HOUSE2
FOR R = 1 TO I2
READ HouseNum2$, HouseColor2$, Nationality2$, SmokeBrand2$, DrinkType2$, PetType2$
NEXT R
FOR I3 = 1 TO House3DataCount
RESTORE HOUSE3
FOR R = 1 TO I3
READ HouseNum3$, HouseColor3$, Nationality3$, SmokeBrand3$, DrinkType3$, PetType3$
NEXT R
FOR I4 = 1 TO House4DataCount
RESTORE HOUSE4
FOR R = 1 TO I4
READ HouseNum4$, HouseColor4$, Nationality4$, SmokeBrand4$, DrinkType4$, PetType4$
NEXT R
FOR I5 = 1 TO House5DataCount
RESTORE HOUSE5
FOR R = 1 TO I5
READ HouseNum5$, HouseColor5$, Nationality5$, SmokeBrand5$, DrinkType5$, PetType5$
NEXT R
IF AreDistinct%(Nationality1$,Nationality2$,Nationality3$,Nationality4$,Nationality5$) AND AreDistinct%(HouseColor1$,HouseColor2$,HouseColor3$,HouseColor4$,HouseColor5$) AND AreDistinct%(SmokeBrand1$,SmokeBrand2$,SmokeBrand3$,SmokeBrand4$,SmokeBrand5$) AND AreDistinct%(DrinkType1$,DrinkType2$,DrinkType3$,DrinkType4$,DrinkType5$) AND AreDistinct%(PetType1$,PetType2$,PetType3$,PetType4$,PetType5$) AND GreenToLeftOfWhite%(HouseColor1$,HouseColor2$,HouseColor3$,HouseColor4$,HouseColor5$) AND BlendNextToCats%(SmokeBrand1$,SmokeBrand2$,SmokeBrand3$,SmokeBrand4$,SmokeBrand5$,PetType1$,PetType2$,PetType3$,PetType4$,PetType5$) AND DunhillNextToHorse%(SmokeBrand1$,SmokeBrand2$,SmokeBrand3$,SmokeBrand4$,SmokeBrand5$,PetType1$,PetType2$,PetType3$,PetType4$,PetType5$) THEN
PRINT
COLOR 15
PRINT HouseNum1$, Nationality1$, HouseColor1$, SmokeBrand1$, DrinkType1$, PetType1$
PRINT HouseNum2$, Nationality2$, HouseColor2$, SmokeBrand2$, DrinkType2$, PetType2$
PRINT HouseNum3$, Nationality3$, HouseColor3$, SmokeBrand3$, DrinkType3$, PetType3$
PRINT HouseNum4$, Nationality4$, HouseColor4$, SmokeBrand4$, DrinkType4$, PetType4$
PRINT HouseNum5$, Nationality5$, HouseColor5$, SmokeBrand5$, DrinkType5$, PetType5$
' PRINT "press a key to continue"
' pause_end_key$ = input$(1)
END IF
_delay 0.00125
NEXT I5
NEXT I4
COLOR INT(RND*15) + 1 : PRINT ".";
NEXT I3
NEXT I2
NEXT I1
COLOR 14 : PRINT: PRINT "PROGRAM END TIME: " + TIME$
END
' 🟠 Generation of DATA statements with valid combinations of attributes per house BEFORE comparing attributes between houses
<house-num 🟠/><$list variable="house_num" filter="[<house_num_list>split[,]]">
HOUSE<<house_num>>:<br>
<nationality 🟠/><$list variable="nationality" filter="[<nationality_list>split[,]]">
<$list variable="Norwegian1" filter="[<nationality>addsuffix<house_num>match[Norwegian1]] [<nationality>addsuffix<house_num>!regexp[Norwegian]!regexp[1]] +[join[]]">
<house-color 🟠/><$list variable="house_color" filter="[<house_color_list>split[,]]">
<$list variable="EnglishRed" filter="[<nationality>addsuffix<house_color>match[EnglishRed]] [<nationality>addsuffix<house_color>!regexp[English]!regexp[Red]] +[join[]]">
<$list variable="hBlue2" filter="[<house_color>addsuffix<house_num>match[hBlue2]] [<house_color>addsuffix<house_num>!regexp[hBlue]!regexp[2]] +[join[]]">
<$list variable="GreenNot5" filter="[<house_color>addsuffix<house_num>!match[Green5]]">
<$list variable="WhiteNot1" filter="[<house_color>addsuffix<house_num>!match[White1]]">
<smoke-brand 🟠/><$list variable="smoke_brand" filter="[<smoke_brand_list>split[,]]">
<$list variable="DunhillYellow" filter="[<smoke_brand>addsuffix<house_color>match[DunhillYellow]] [<smoke_brand>addsuffix<house_color>!regexp[Dunhill]!regexp[Yellow]] +[join[]]">
<$list variable="GermanPrince" filter="[<nationality>addsuffix<smoke_brand>match[GermanPrince]] [<nationality>addsuffix<smoke_brand>!regexp[German]!regexp[Prince]] +[join[]]">
<drink-type 🟠/><$list variable="drink_type" filter="[<drink_type_list>split[,]]">
<$list variable="DaneTea" filter="[<nationality>addsuffix<drink_type>match[DaneTea]] [<nationality>addsuffix<drink_type>!regexp[Dane]!regexp[Tea]] +[join[]]">
<$list variable="GreenCoffee" filter="[<house_color>addsuffix<drink_type>match[GreenCoffee]] [<house_color>addsuffix<drink_type>!regexp[Green]!regexp[Coffee]] +[join[]]">
<$list variable="Blue MasterBeer" filter="[<smoke_brand>addsuffix<drink_type>match[Blue MasterBeer]] [<smoke_brand>addsuffix<drink_type>!regexp[Blue Master]!regexp[Beer]] +[join[]]">
<$list variable="Milk3" filter="[<drink_type>addsuffix<house_num>match[Milk3]] [<drink_type>addsuffix<house_num>!regexp[Milk]!regexp[3]] +[join[]]">
<$list variable="WaterNotBlend" filter="[<drink_type>addsuffix<smoke_brand>!match[WaterBlend]]">
<pet-type 🟠/><$list variable="pet_type" filter="[<pet_type_list>split[,]]">
<$list variable="SwedeDog" filter="[<nationality>addsuffix<pet_type>match[SwedeDog]] [<nationality>addsuffix<pet_type>!regexp[Swede]!regexp[Dog]] +[join[]]">
<$list variable="PallMallBirds" filter="[<smoke_brand>addsuffix<pet_type>match[Pall MallBirds]] [<smoke_brand>addsuffix<pet_type>!regexp[Pall Mall]!regexp[Birds]] +[join[]]">
<$list variable="BlendNotCats" filter="[<smoke_brand>addsuffix<pet_type>!match[BlendCats]]">
<$list variable="DunhillNotHorse" filter="[<smoke_brand>addsuffix<pet_type>!match[DunhillHorse]]">
DATA "<<house_num>>","<<house_color>>","<<nationality>>","<<smoke_brand>>","<<drink_type>>","<<pet_type>>"<br>
</$list></$list></$list></$list></$list><pet-type 🟠/>
</$list></$list></$list></$list></$list></$list><drink-type 🟠/>
</$list></$list></$list><smoke-brand 🟠/>
</$list></$list></$list></$list></$list><house-color 🟠/>
</$list></$list><nationality 🟠/>
DATA "0","","","","",""<br>
</$list><house-num 🟠/>
</$let>