+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: bplus (https://qb64phoenix.com/forum/forumdisplay.php?fid=36)
+---- Thread: Rosetta Code Challenges (/showthread.php?tid=212)
Pages:
1
2
Rosetta Code Challenges - bplus - 04-26-2022
The posts in this thread are from Rosetta Code Challenges.
You are free to post improvements.
Better IMHO is less LOC (Lines Of Code) but try to hold off on using so many colons on a line: none is perfect, one or 2 reasonable, 10 ridiculous! = too much)
_____________________________________________________________________________________________
Ken was asking about this today.
Bulls and cows: http://rosettacode.org/wiki/Bulls_and_cows
Code: (Select All)
_Title "Bulls and Cows" ' found at Rosetta for Qbasic, copy 2019-01-31
'challenge is to develope AI player for this game
DefInt A-Z
Dim secret As String
Dim guess As String
Dim c As String
Dim bulls, cows, guesses, i
Randomize Timer
Do While Len(secret) < 4
c = Chr$(Int(Rnd * 10) + 48)
If InStr(secret, c) = 0 Then secret = secret + c
Loop
guesses = 0
Do
Input "Guess a 4-digit number with no duplicate digits: "; guess
guess = LTrim$(RTrim$(guess))
If Len(guess) = 0 Then Exit Do
If Len(guess) <> 4 Or Val(guess) = 0 Then
Print "** You should enter 4 numeric digits!"
GoTo looper
End If
bulls = 0: cows = 0: guesses = guesses + 1
For i = 1 To 4
c = Mid$(secret, i, 1)
If Mid$(guess, i, 1) = c Then
bulls = bulls + 1
ElseIf InStr(guess, c) Then
cows = cows + 1
End If
Next i
Print bulls; " bulls, "; cows; " cows"
If guess = secret Then
Print "You won after "; guesses; " guesses!"
Exit Do
End If
looper:
Loop![[Image: Bulls-and-cows.png]](https://i.ibb.co/JpG8LB9/Bulls-and-cows.png)
RE: Rosetta Code Challenges - SierraKen - 04-27-2022
LOL Thanks B+ but it's not the game I was thinking about. The one I was thinking about had little graphics of animals in the pen moving around, I should have explained it better. But this little game is pretty neat. I like random number games. Reminds me of one of my very first games I made in BASIC programming class at High School.
RE: Rosetta Code Challenges - bplus - 04-27-2022
Yeah, I posted it to show it was not the game you were talking about, no animals or sounds just a logic brain puzzle.
RE: Rosetta Code Challenges - bplus - 10-30-2022
The Zebra Puzzle
I've been sitting on this problem for over a year, finally got the approach worked out and solved the thing tod... yesterday.
Looks pretty good in Console Window that scrolling is great feature! This is a little like telling a story.
Looks pretty good in Console Window that scrolling is great feature! This is a little like telling a story.
Code: (Select All)
Option _Explicit
_Title "15625 Scenarios Elimination" 'b+ start 2021-09-05 2022-10-29
' 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!
$Console:Only
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
Dim order$, color$, nation$, drink$, smoke$, animal$, testC$, testH$, testS$, testA$, testN$
Dim As Long b, i, OK, test1, test2
' from 1-16 there are 5 house in order from left to right that have:
order$ = "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?"
' arrays to hold little lists of 5
ReDim o$(1 To 1), c$(1 To 1), n$(1 To 1), d$(1 To 1), s$(1 To 1), a$(1 To 1)
Split order$, " ", o$()
Split color$, " ", c$()
Split nation$, " ", n$()
Split drink$, " ", d$()
Split smoke$, " ", s$()
Split animal$, " ", a$()
Print " 15,625 = (5 ^ 6) possible scenarios of :"
Print " 5 House Choices: "; order$
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
ReDim scen$(1 To 1) ' container for all the permutations
ReDim temp$(1 To 1) ' 2nd container for sifting out eliminated scenarios
For b = 1 To 5
Select Case b
Case 1: build s$(), a$(), temp$()
Case 2: build d$(), scen$(), temp$()
Case 3: build n$(), scen$(), temp$()
Case 4: build c$(), scen$(), temp$()
Case 5: build o$(), scen$(), temp$()
End Select
aCopy temp$(), scen$() ' copy temp to scen$() array
Next
' OK that built as I want list: order color nation drink smoke animal = 6 items in order
' note: at moment temp$ and scen$ arrays are the same
ReDim surv$(0) ' store all scenarios we couldn't eliminate, surv$ for survivors!
For i = 1 To UBound(temp$) ' 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
'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
'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
'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$ = Wrd$(scen$(i), 2): testH$ = Wrd$(scen$(i), 1)
If testC$ = "green" Then
If testH$ = "3" Or testH$ = "4" Then Else OK = 0
ElseIf testC$ = "white" Then
If testH$ = "4" Or testH$ = "5" Then Else OK = 0
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
'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
'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
'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
'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
'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
'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
'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
'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
' 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 AddEnd surv$(), scen$(i) ' not eliminated save in survivors
Next
ReDim scen$(0) ' copy surv$() into scen$() for next round
aCopy surv$(), scen$() 'put servivors back into scenario's
Print
Print " Use the 16 statements to go from 15,625 scenarios to 38:"
For i = 1 To UBound(scen$) ' check copy OK
Print i, scen$(i)
Next
Print String$(80, "=")
ReDim surv$(0) ' to reload
For i = 1 To UBound(scen$)
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$ = Wrd$(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 Wrd$(scen$(i), 6) = "horse" Then OK = 0
If testH$ = "2" And Wrd$(scen$(i), 6) <> "horse" Then OK = 0
'' Also only red is coming up in house 3 no other choice it must go there!
testC$ = Wrd$(scen$(i), 2)
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
AddEnd surv$(), scen$(i)
End If
Next
ReDim scen$(0)
aCopy surv$(), scen$() 'put servivors back into scenario's
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
For i = 1 To UBound(scen$) ' check copy OK
Print i, scen$(i)
Next
Print String$(80, "=")
Print
ReDim surv$(0) ' to reload
For i = 1 To UBound(scen$)
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$ = Wrd$(scen$(i), 1)
testS$ = Wrd$(scen$(i), 5)
testA$ = Wrd$(scen$(i), 6)
testN$ = Wrd$(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
AddEnd surv$(), scen$(i)
End If
Next
ReDim scen$(0)
aCopy surv$(), scen$() 'put servivors back into scenario's
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 because house 3 doesn't."
Print
For i = 1 To UBound(scen$) ' check copy OK
Print i, scen$(i)
Next
Print
Print " And with the last cut from Blends connection to House 2, we arrive at the only possible solution!"
Print " The German could not have the Blends nor cats, Blend is at House 2 and cats at House 1. He's got the Zebra!"
Print: Print " b+"
Sleep
' sort of a brute force way to build list of all possible scenario's
Sub build (list1$(), list2$(), outList$()) 'all lists base 1
Dim As Long ub1, ub2, i, j, outI
ub1 = UBound(list1$): ub2 = UBound(list2$)
ReDim outList$(1 To ub1 * ub2)
For i = 1 To ub1
For j = 1 To ub2
outI = outI + 1
outList$(outI) = list1$(i) + " " + list2$(j)
Next
Next
End Sub
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
dpos = InStr(curpos, SplitMeString, delim)
Do Until dpos = 0
loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
arrpos = arrpos + 1
If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
curpos = dpos + LD
dpos = InStr(curpos, SplitMeString, delim)
Loop
loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub
' This duplicates JB word(string, wordNumber) base 1, space as default delimiter
' by returning the Nth word of source string s
' this function assumes s has been through wPrep
Function Wrd$ (ss$, wNumber)
Dim s$, w$
Dim As Long c, i
's$ = wPrep(ss$)
s$ = ss$ 'don't change ss$
If Len(s$) = 0 Then Wrd$ = "": Exit Function
w$ = "": c = 1
For i = 1 To Len(s$)
If Mid$(s$, i, 1) = " " Then
If c = wNumber Then Wrd$ = w$: Exit Function
w$ = "": c = c + 1
Else
w$ = w$ + Mid$(s$, i, 1)
End If
Next
If c <> wNumber Then Wrd$ = " " Else Wrd$ = w$
End Function
Sub AddEnd (a() As String, addon As String)
Dim lba As Long, uba As Long
lba = LBound(a): uba = UBound(a)
ReDim _Preserve a(lba To uba + 1) As String
a(uba + 1) = addon
End Sub
Sub aCopy (a() As String, b() As String)
Dim lba As Long, uba As Long, i As Long
lba = LBound(a): uba = UBound(a)
ReDim b(lba To uba) As String
For i = lba To uba
b(i) = a(i)
Next
End SubRE: Rosetta Code Challenges - bplus - 10-31-2022
This was given at Rosetta Code as a problem similar to Zebra Puzzle but it's a pretty straight forward check all possible see what sticks.
Dinesman Multi-Dwelling
Code: (Select All)
_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"Only one solution sticks, Smith gets the dreaded first floor.
The other related problem, 12 Statements, is giving me more trouble but it was past my bedtime. Maybe today I can figure it out.
https://rosettacode.org/wiki/Twelve_statements
RE: Rosetta Code Challenges - SpriggsySpriggs - 10-31-2022
I used to peruse those challenges to see what I could do. Fellippe tried getting everyone on board with that a while back. Just so many things on that site.
RE: Rosetta Code Challenges - bplus - 10-31-2022
(10-31-2022, 07:24 PM)Spriggsy Wrote: I used to peruse those challenges to see what I could do. Fellippe tried getting everyone on board with that a while back. Just so many things on that site.
Yes, I can't seem to get enough challenges that make me think but are doable. Here is great place to copy the masters!
Twelve Statements (Boolean Logic + Binary Scenarios Puzzle)
I did figure out Twelve Statements but I had to add Else clauses in Statement 4 and 8 handlers that make the statement True if the first condition is not. (Plus Statement 12 was missing a TF(7) in the total.)
Statement 4: If statement 5 is true, then statements 6 and 7 are both true.
So where are we if 5 is NOT true?
Well I guess if I want to match Rosetta single unique solution I have to say:
ELSE statement(4) = 1
the same happens in
Statement 8: If statement 7 is true, then 5 and 6 are both true.
So where are we if 7 is NOT true?
Well I guess if I want to match Rosetta single unique solution I have to say:
ELSE statement(8) = 1
BTW allot of these statements have symmetric complements:
The first 6, the last 6
The evens, the odds
Statement 4 and statement 8
Here using 1 not -1, so be careful with IF's ANDs...
2 ^ 12 is the number of permutations of True and False (1 and 0) so convert all numbers 0 to 2^12 - 1 to Binary and you run all the possible ways T and F, 1 and 0, can be arranged in 12 digits slots. So run the numbers and see which one(s) produce a consistent match with the 12 statements. As usual with Rosetta Code problems the problem is setup to produce one or unique set of solutions.
Code: (Select All)
Option _Explicit
_Title "12 Statements - Rosetta Code" ' b+ found 2022-10-30
'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.
'VVVVVVVV mass comment method
'$If Then
ReDim As Long n, TF(1 To 12), wrong, i
For n = 0 To 4095
Dec2BinArr12 n, TF() ' get a TF scenario and compare to 12 statements
ReDim st(1 To 12) As Long
' 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
For i = 1 To 12
If st(i) <> TF(i) Then wrong = wrong + 1
Next
If wrong = 0 Then
For i = 1 To 12
Print i; TF(i); st(i)
Next
Print "This matches the Binary of"; n
Print
Print "zzz... press any to continue"
Sleep
Cls
End If
Next
Print "End of Run."
'$End If
'' test sub Dec2BinArr12
'VVVVVVVV mass comment method
$If Then
ReDim out12(0) As Long, k As Long, j As Long
'For k = 4095 - 20 To 4095 ' << check tail end
For k = 0 To 20 ' << check from end
Dec2BinArr12 k, out12()
Print k,
For j = 1 To 12
Print out12(j);
Next
Print
Next
$End If
Sub Dec2BinArr12 (dec As Long, out12() As Long)
ReDim out12(1 To 12) As Long, j As Long
For j = 0 To 11
If (dec And 2 ^ j) > 0 Then out12(j + 1) = 1
Next
End SubBTW the solution is number 1133 converted to Binary.
PS This is first time I used $IF for mass commenting out code, very handy. Thanks @Pete
RE: Rosetta Code Challenges - MasterGy - 10-31-2022
Hi ! Bplus! You brought me a great puzzle for the evening!
I thought a lot about how it could be. I can't check back. Among the solutions is 1, which might be correct. I'm not sure.
Code: (Select All)
'1 3 4 6 7 11
Dim Shared ans(20)
For t = 0 To 4095: ' Locate 1, 1: Print t
For t2 = 1 To 12
ans(t2) = Sgn(t And 2 ^ (t2 - 1))
Next t2
add = 0: count = 0
For t2 = 1 To 12
add = add + Abs(ans(t2) = quest(t2))
count = count + 1
Next t2
If add + 1 = count Then
Print "find: ";:
For t3 = 1 To 12 Step 1
If ans(t3) Then Print t3;
Next t3
Print
End If
Next t
Function quest (which)
Select Case which
Case 1: ans = 1
Case 2: add = 0: For t = 7 To 12: add = add + ans(t): Next t: ans = add = 3
Case 3: add = 0: For t = 2 To 12 Step 2: add = add + ans(t): Next t: ans = add = 2
Case 4: ans = ans(5) And ans(6) And ans(7)
Case 5: ans = ans(2) = 0 And ans(3) = 0 And ans(4)
Case 6: add = 0: For t = 1 To 11 Step 2: add = add + ans(t): Next t: ans = add = 4
Case 7: ans = (ans(2) Or ans(3)) * ((ans(2) And ans(3)) = 0)
Case 8: ans = ans(5) And ans(6) And ans(7)
Case 9: add = 0: For t = 1 To 6: add = add + ans(t): Next t: ans = add = 3
Case 10: ans = ans(11) And ans(12)
Case 11: add = 0: For t = 7 To 9: add = add + ans(t): Next t: ans = add = 1
Case 12: add = 0: For t = 1 To 11: add = add + ans(t): Next t: ans = add = 4
End Select
quest = Abs(Sgn(ans))
End FunctionRE: Rosetta Code Challenges - bplus - 10-31-2022
Hi MasterGy,
Nice to see your approach to this, I will study later but looks like you need to narrow solutions down a bit more.
Probably have to change at least statement 4 and 8 handlers.
The good news, the solution is in that group!
I will also try your way for 4 and 8 and see what happens in my code. Thanks!
RE: Rosetta Code Challenges - bplus - 11-01-2022
When I translated Twelve Statements to JB, I added near misses for extra RC credit. I also trimmed the fat and got it down to 35 LOC:
Code: (Select All)
_Title "12 Statements #2 Missing by 1" ' b+ 2022-10-31
Dim As Long i, saveI
For n = 0 To 4095 ' 2 ^ 12 = 4096 permutations of TF for 12 digits positions
ReDim As Long 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
st(1) = 1
If ((TF(7) + TF(8) + TF(9) + TF(10) + TF(11) + TF(12)) = 3) Then st(2) = 1
If ((TF(2) + TF(4) + TF(6) + TF(8) + TF(10) + TF(12)) = 2) Then st(3) = 1
If TF(5) Then
If ((TF(6) + TF(7)) = 2) Then st(4) = 1
Else ' say true??
st(4) = 1 ' to match solution at RC
End If
If ((TF(4) + TF(3) + TF(2)) = 0) Then st(5) = 1
If ((TF(1) + TF(3) + TF(5) + TF(7) + TF(9) + TF(11)) = 4) Then st(6) = 1
If ((TF(2) + TF(3)) = 1) Then st(7) = 1
If TF(7) Then
If ((TF(5) + TF(6)) = 2) Then st(8) = 1
Else ' say true?
st(8) = 1 ' ??? this is like 4 which fixed things when I added 1 = true here
End If
If ((TF(1) + TF(2) + TF(3) + TF(4) + TF(5) + TF(6)) = 3) Then st(9) = 1
If ((TF(11) + TF(12)) = 2) Then st(10) = 1
If ((TF(7) + TF(8) + TF(9)) = 1) Then st(11) = 1
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$ + _Trim$(Str$(i)) + " " Else s$ = s$ + "_ "
Next
If wrong = 1 Then Print "Near miss, true at: "; s$; " missed at "; _Trim$(Str$(saveI))
If wrong = 0 Then Print " Solution! true at: "; s$; " <<<<<<<<<<<<<"
Next