+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: USSR puzzle digital (/showthread.php?tid=4512)
USSR puzzle digital - DANILIN - 02-26-2026
USSR puzzle digital
Personally I have naturally solved by 3 algorithms
Interest your witty decisions
Parallel topic
Danilin without the GoTo's
https://qb64phoenix.com/forum/showthread.php?tid=4515
RE: USSR puzzle digital - DANILIN - 02-27-2026
my variant can distort your variants
Code: (Select All)
Dim s As Long: t = Timer
For a = 0 To 9: For b = 0 To 9: For c = 0 To 9
For d = 0 To 9: For e = 0 To 9: For f = 0 To 9
For g = 0 To 9: For h = 0 To 9: For i = 0 To 9
If a * b - c <> 4 Then 5
If d + e + f <> 8 Then 5
If g / h + i <> 8 Then 5
If a / d + g <> 9 Then 5
If b + e + h <> 8 Then 5
If c + f - i <> 6 Then 5
Print a, b, c
Print d, e, f
Print g, h, i: Print: Print
5 s = s + 1: Next: Next: Next: Next: Next
Next: Next: Next: Next: Print s / 10 ^ 6; " mln", Timer - t
EndCode: (Select All)
[qbjs]https://qbjs.org/?mode=auto&src=https://qb64phoenix.com/forum/attachment.php?aid=5667[/qbjs]RE: USSR puzzle digital - bplus - 02-27-2026
OHHHHHHHHHHHHHHHH ! I thought the 9 digits had to be a unique permutation of digits 1 to 9. Well there aren't any of those BUT!
There are 65 sets that match e(2) with e(3) and with e(5) (Danilins = 8 equations) some get pretty close to single digit answers to all 6 equations.
There are 5 of the closest = 9 not 8 in e2, e3 and e5.
How I found these as alternate to Danilin's problem:
First I created a file of the permutations of digits 1 to 9:
Code: (Select All)
_Title "Recursive 9 Permutations of symbols to RA" 'mod B+ 2026-02-27
'ordered permutations.bas for SmallBASIC 0.12.6 [B+=MGA] 2016-07-21
'translated from JB v1.01 [B+=MGA] 2016-07-21
'recursive ordered permutations (non repeating)
'if 1st element < 2nd element < 3rd element... then list acsends
'if reverse case then list decsends
' 2026-02-27 this mod
Dim Shared ls, index
Dim Shared record As String * 9
s$ = "987654321"
ls = Len(s$)
index = 0
Dim Shared c$(ls) 'this holds each letter or digit or symbol
Open "9 permutations.RA" For Random As #1 Len = 9
perm s$ '<<<<<<<<<<<<< if s$ is ordered then the permutations will be so also!!!
Sub perm (r$)
'local lr, i, r1
If Len(r$) = 0 Then
index = index + 1
b$ = ""
For i = 1 To ls
b$ = b$ + c$(i)
Next
record = b$
Put #1, index, record
Else
lr = Len(r$)
For i = 1 To lr
c$(ls - lr + 1) = Mid$(r$, i, 1)
If i < Len(r$) And i > 1 Then
r1$ = Mid$(r$, 1, i - 1) + Mid$(r$, i + 1)
'ELSEIF i = 1 AND i = lr THEN
'r1$ = ""
ElseIf i = 1 Then
r1$ = Mid$(r$, i + 1)
Else
r1$ = Mid$(r$, 1, i - 1)
End If
perm r1$
Next
End If
End Sub
Then I checked all permutations with this code:
Code: (Select All)
_Title "Test Danlin's matrix with 9 permutations" 'b+ 2026-02-26
' 2026-02-27 rewrite for RA
Dim record As String * 9
Open "9 permutations.RA" For Random As #1 Len = 9
Dim c(1 To 9) As Integer, index As Long
While index < 362880
index = index + 1
Get #1, index, record
Print index; ":"; record
For i = 1 To 9
c(i) = Val(Mid$(record, i, 1))
Next
If c(1) * c(2) - c(3) = 4 Then
Print "Check First equation: "; record
'Sleep
If c(4) + c(5) + c(6) = 8 Then
Print "Check 2nd equation: "; record
'Sleep
If c(7) / c(8) + c(9) = 8 Then
Print "Check 3rd equation: "; record
Sleep
If c(1) / c(4) + c(7) = 9 Then
If c(2) + c(5) + c(8) = 8 Then
If c(3) + c(6) - c(9) = 6 Then
Print "!!!!!!!!!!!!!!!!!!!!Solution! "; c(1), c(2), c(3)
Print "!!!!!!!!!!!!!!!!!!!!Solution! "; c(4), c(5), c(6)
Print "!!!!!!!!!!!!!!!!!!!!Solution! "; c(7), c(8), c(9)
Sleep
End
End If
End If
End If
End If
End If
End If
Wend
Nope! Nothing stopped and met Danilins 4, 8, 8, 9, 8, 6 answers so there is NOT 9 unique digits that solve Danilin's equations.
So how close can we get?
First I tried to just match e2, e3, and e5 and there I found 65 solutions!
So what combinations get us closest to e2=e3=e5 = 8?
How about e2 = e3 = e5 = 9 !
Yes only 5 of those:
Code: (Select All)
index, record is 10546 968315427 e()'s match #1
9 * 6 - 8 = 46
3 + 1 + 5 = 9
4 / 2 + 7 = 9
9 / 3 + 4 = 7
6 + 1 + 2 = 9
8 + 5 - 7 = 6
index, record is 28070 935126847 e()'s match #2
9 * 3 - 5 = 22
1 + 2 + 6 = 9
8 / 4 + 7 = 9
9 / 1 + 8 = 17
3 + 2 + 4 = 9
5 + 6 - 7 = 4
index, record is 32390 926135847 e()'s match #3
9 * 2 - 6 = 12
1 + 3 + 5 = 9
8 / 4 + 7 = 9
9 / 1 + 8 = 17
2 + 3 + 4 = 9
6 + 5 - 7 = 4
index, record is 151910 629135847 e()'s match #4
6 * 2 - 9 = 3
1 + 3 + 5 = 9
8 / 4 + 7 = 9
6 / 1 + 8 = 14
2 + 3 + 4 = 9
9 + 5 - 7 = 7
index, record is 187190 539126847 e()'s match #5
5 * 3 - 9 = 6
1 + 2 + 6 = 9
8 / 4 + 7 = 9
5 / 1 + 8 = 13
3 + 2 + 4 = 9
9 + 6 - 7 = 8Found with this modified code:
Code: (Select All)
_Title "Alternate Danlin problem" 'b+ 2026-02-26
' 2026-02-27 mod for RA file
Dim record As String * 9
Dim c(1 To 9) As Integer
Dim eq(1 To 6) As Integer
Open "9 permutations.RA" For Random As #1 Len = 9
Open "Match e2 with e3 and e5 for unique 9 digitsets.dat" For Output As #2
index = 0
tryAgain:
index = index + 1
If index > 362880 Then Print: Print "Through Whole File All done!": End
Get #1, index, record
'Print index, record
For i = 1 To 9
c(i) = Val(Mid$(record, i, 1))
Next
If c(7) / c(8) = Int(c(7) / c(8)) Then
If c(1) / c(4) = Int(c(1) \ c(4)) Then
'Print "index, record is"; index, record
e(1) = c(1) * c(2) - c(3) '4
e(2) = c(4) + c(5) + c(6) '8 match e(2)
e(3) = c(7) / c(8) + c(9) '8 match with e(3)
e(4) = c(1) / c(4) + c(7) '9
e(5) = c(2) + c(5) + c(8) '8 match and with e(5)
e(6) = c(3) + c(6) - c(9) '6
If e(2) = 9 _AndAlso e(3) = 9 _AndAlso e(5) = 9 Then
'If e(2) = e(5) Then ' the middle one across = middle one down
' If 2 * e(1) = e(2) Then
' If e(4) = 1.1 / 8 * e(2) Then
' If e(6) = 3 / 4 * e(2) Then
count = count + 1
Print #2, "index, record is"; index, record, "e()'s match #"; _Trim$(Str$(count))
Print #2, c(1); " *"; c(2); " -"; c(3); " ="; c(1) * c(2) - c(3)
Print #2, c(4); " +"; c(5); " +"; c(6); " ="; c(4) + c(5) + c(6)
Print #2, c(7); " /"; c(8); " +"; c(9); " ="; c(7) / c(8) + c(9)
Print #2, c(1); " /"; c(4); " +"; c(7); " ="; c(1) / c(4) + c(7)
Print #2, c(2); " +"; c(5); " +"; c(8); " ="; c(2) + c(5) + c(8)
Print #2, c(3); " +"; c(6); " -"; c(9); " ="; c(3) + c(6) - c(9)
Print #2, ""
'Sleep
GoTo tryAgain:
'Else
' GoTo tryAgain:
'End If
'Else
' GoTo tryAgain:
'End If
' Else
' GoTo tryAgain:
' End If
' Else
' GoTo tryAgain:
' End If
Else
GoTo tryAgain:
End If
Else
GoTo tryAgain:
End If
Else
GoTo tryAgain:
End If
RE: USSR puzzle digital - bplus - 02-27-2026
Danilin's code fixed for QBJS
There is a bit of a wait, be patient it's coming!
I prefer like the middle solution only because it contains no 0's making it just one solution with digits 1 to 9.
RE: USSR puzzle digital - DANILIN - 02-27-2026
Numerals exactly all different are not required
and repetitions possible otherwise squares
were signed as in subject "rebus of letters"
though on greater number possible decision unique
or negative to use but I did not check
New program in source message for qbjs without goto
working slowly in 2 times
Here momentary algorithm with goto
Code: (Select All)
Dim s As Long: t = Timer
For a = 0 To 9: For b = 0 To 9: For c = 0 To 9
For d = 0 To 9: For e = 0 To 9: For f = 0 To 9
For g = 0 To 9: For h = 0 To 9: For i = 0 To 9
s = s + 1
If a * b - c <> 4 Then 7
If d + e + f <> 8 Then 4
If g / h + i <> 8 Then 1
If a / d + g <> 9 Then 3
If b + e + h <> 8 Then 2
If c + f - i <> 6 Then 1
Print a, b, c
Print d, e, f
Print g, h, i: Print: Print
1 Next i
2 Next h
3 Next g
4 Next f
5 Next e
6 Next d
7 Next c
8 Next b
9 Next a
Print s / 10 ^ 6; " mln", Timer - t
EndRE: USSR puzzle digital - SMcNeill - 02-27-2026
Why in the world would you guys even build this around the GOTO concept here? It's completely and utterly unneeded.
Try this and compare the run times, if you will:
Code: (Select All)
Screen _NewImage(1024, 720, 32)
Dim s As Long: t = Timer(0.001)
For a = 0 To 9: For b = 0 To 9: For c = 0 To 9
If a * b - c = 4 Then
For d = 0 To 9: For e = 0 To 9: For f = 0 To 9
If d + e + f = 8 Then
For g = 0 To 9: For h = 0 To 9: For i = 0 To 9
If g / h + i = 8 _AndAlso a / d + g = 9 _AndAlso b + e + h = 8 _AndAlso c + f - i = 6 Then
Print a, b, c
Print d, e, f
Print g, h, i: Print: Print
s = s + 1
End If
Next i, h, g
End If
Next f, e, d
End If
Next c, b, a
Print Using "###,### solutions, in #.#### seconds"; s, Timer(0.001) - t
Print
Print "Compared to:"
Print
For a = 0 To 9: For b = 0 To 9: For c = 0 To 9
For d = 0 To 9: For e = 0 To 9: For f = 0 To 9
For g = 0 To 9: For h = 0 To 9: For i = 0 To 9
If a * b - c <> 4 Then 5
If d + e + f <> 8 Then 5
If g / h + i <> 8 Then 5
If a / d + g <> 9 Then 5
If b + e + h <> 8 Then 5
If c + f - i <> 6 Then 5
Print a, b, c
Print d, e, f
Print g, h, i: Print: Print
5 s = s + 1: Next: Next: Next: Next: Next
Next: Next: Next: Next: Print s / 10 ^ 6; " mln", Timer - t
End
I don't need half a dozen seconds to solve this. I can solve it in 0.01 second, and without any use of GOTO or _CONTINUE! Just simple for loops and elimination logic which cuts down run time by a magnitude of 1000s.
It's simple. It's efficient. It's easy to understand and follow. What's not to love about it?
RE: USSR puzzle digital - SMcNeill - 02-27-2026
And here I took a few moments to apply the most basic of logic to this to eliminate multiple instances of recursion:
Code: (Select All)
Screen _NewImage(1024, 720, 32)
Dim s As Long: t = Timer(0.001)
For a = 1 To 9 ' a * b has to be > 4 + c, so neither can be negative values
For b = 1 To 9
If a * b >= 4 _AndAlso a * b <= 13 Then ' a*b -c = 4, so a * b has to be between 4 and 13 since c is from 0 to 9
For c = 0 To 9
If a * b - c = 4 Then
For d = 0 To 8: For e = 0 To 8 - d 'd + e + f = 8, so d can't be > 8. e can't be greater than 8 -d
If d + e <= 8 Then ' and if d + e are 8 or less, then f has to be the remainer of that formula to make 8
f = 8 - d - e
For g = 0 To 9: For h = 0 To 9: For i = 0 To 9
If g / h + i = 8 _AndAlso a / d + g = 9 _AndAlso b + e + h = 8 _AndAlso c + f - i = 6 Then
Print a, b, c
Print d, e, f
Print g, h, i: Print: Print
s = s + 1
End If
Next i, h, g
End If
Next e, d
End If
Next c
End If
Next b, a
Print Using "###,### solutions, in #.#### seconds"; s, Timer(0.001) - t
It now gives the same answers and runs in less than 0.005 seconds on my laptop. That's well over 1000x improvement over the original. Instead of trying to work out any more math logic like this, I'll just call this fast enough and go on with things.
Honestly though, this is getting a little too single-case specific to be all that useful for anything else except this one instance. The previous code is much more flexible as one can just basically substitute any formulas into it as they wish and get the answer in no time at all. I was just playing around with this to kind of showcase how one can often completely skip a ton of work and processing just by applying basic logic to their own thinking before they ever have the computer take over and do the crunching and whatnot for them.
I mean, let's look at two very simple changes here -- both A and B start with a value of 1, as we know A * B = 4 + C. This makes A and B both *have* to be non-zero, as C can't be negative, and if either is 0 then it's going to be 0 = 4 + a non-negative number, which is impossible.
So this one change elimited running A at 0, which then runs B,C,D,E,F,G,H,I each up to 10 times... which is up to 100000000 loops eliminated. B runs the same logic, but to a power of 10 less than A as it's in inner loop and runs C, D, E, F, G, H, I...
So 110,000,000 loops eliminated with the very barest of logic applied to the loop here.
F doesn't even need to be a loop as it's a set value dependent upon D and E. F = 8 - D - E, and it has to non-negative. So that's a whole inner loop gone with just basic logic applied here.
Folks are always looking for a way to make programs faster. Often, the best way to speed up the execution of a program is just like this -- apply a little logic and narrow the scope to easily adjusted bounds and reduce the runtime as much as possible.
RE: USSR puzzle digital - DANILIN - 02-27-2026
Exclude h=0 and d=0 ?
Possible negative numerals from -9 to 9
and 21 decisions
Code: (Select All)
Dim s As Long: t = Timer ' ussr_puzzle_minus.bas
Open "ussr_puzzle_minus.txt" For Output As #1
For a = -9 To 9: For b = -9 To 9: For c = -9 To 9
For d = -9 To 9: For e = -9 To 9: For f = -9 To 9
For g = -9 To 9: For h = -9 To 9: For i = -9 To 9
s = s + 1
If a * b - c <> 4 Then 7
If d + e + f <> 8 Then 4
If g / h + i <> 8 Then 1
If a / d + g <> 9 Then 3
If b + e + h <> 8 Then 2
If c + f - i <> 6 Then 1
x = x + 1: Print "#"; x
Print a, b, c
Print d, e, f
Print g, h, i: Print: Print
Print #1, "#"; x
Print #1, a, b, c
Print #1, d, e, f
Print #1, g, h, i: Print #1,
1 Next i
2 Next h
3 Next g
4 Next f
5 Next e
6 Next d
7 Next c
8 Next b
9 Next a
Print s / 10 ^ 6; " mln", Timer - t
EndConditions after first cycles
d>=1 & h>=1
0,0094 mln 2,7E-03 sec
Code: (Select All)
Dim s As Long: t = Timer(0.001) ' ussr_puzzle_subzero.bas
For a = 0 To 9: For b = 0 To 9: For c = 0 To 9
If a * b - c <> 4 Then 7
For d = 1 To 9: For e = 0 To 9: For f = 0 To 9
If d + e + f <> 8 Then 4
For g = 0 To 9: For h = 1 To 9: For i = 0 To 9
If g / h + i <> 8 Then 1
s = s + 1
If a / d + g <> 9 Then 3
If b + e + h <> 8 Then 2
If c + f - i <> 6 Then 1
Print a, b, c
Print d, e, f
Print g, h, i: Print
1 Next i
2 Next h
3 Next g
4 Next f
5 Next e
6 Next d
7 Next c
8 Next b
9 Next a
Print s / 10 ^ 6; " mln", Timer(0.001) - t
Endhttps://qb64forum.alephc.xyz/index.php?topic=2961
https://qb64forum.alephc.xyz/index.php?topic=2961.15
Nobel Prize will not receive itself
Nobelevskaya premiya sama sebya ne poluchit
Нобелевская премия сама себя не получит
Le prix Nobel ne se recevra pas
Nobelpreis wird sich nicht erhalten
Il Premio Nobel non ricevera se stesso
Russian Civilization as YouTube: RUtube https://rutube.ru/
RE: USSR puzzle digital - bplus - 02-28-2026
Ah-ha! Allowing for integer division instead of floating division I can:
Find a unique set of 9 digits that will produce = 8 in equations 2, 3 and 5
PLUS get the other equations all below 10 ie single digits!!!
There are 3 solutions like this (like in Danilin's problem) AND 1 is darn close to:
e(1) = 4
e(2) = 8
e(3) = 8
e(4) = 9
e(5) = 8
e(6) = 6
Code: (Select All)
index, record is 71038 829413657 e()'s match #1
8 * 2 - 9 = 7
4 + 1 + 3 = 8
6 \ 5 + 7 = 8
8 \ 4 + 6 = 8
2 + 1 + 5 = 8
9 + 3 - 7 = 5
index, record is 71158 829314657 e()'s match #2
8 * 2 - 9 = 7
3 + 1 + 4 = 8
6 \ 5 + 7 = 8
8 \ 3 + 6 = 8
2 + 1 + 5 = 8
9 + 4 - 7 = 6
index, record is 151676 629413857 e()'s match #3
6 * 2 - 9 = 3
4 + 1 + 3 = 8
8 \ 5 + 7 = 8
6 \ 4 + 8 = 9
2 + 1 + 5 = 8
9 + 3 - 7 = 5I have solved a harder problem than Danilin's
Code: (Select All)
_Title "Alternate Danlin problem 2" 'b+ 2026-02-28
' 2026-02-27 mod for RA file
Dim record As String * 9
Dim c(1 To 9) As Integer
Dim e(1 To 6) As Integer
Open "9 permutations.RA" For Random As #1 Len = 9
Open "Match e2 with e3 and e5 = 8 for unique 9 digitsets.dat" For Output As #2
Do Until index = 362880
index = index + 1
Get #1, index, record
For i = 1 To 9
c(i) = Val(Mid$(record, i, 1))
Next
e(1) = c(1) * c(2) - c(3) '4
e(2) = c(4) + c(5) + c(6) '8 match e(2)
e(3) = c(7) \ c(8) + c(9) '8 match with e(3)
e(4) = c(1) \ c(4) + c(7) '9
e(5) = c(2) + c(5) + c(8) '8 match and with e(5)
e(6) = c(3) + c(6) - c(9) '6
If e(2) = 8 _AndAlso e(3) = 8 _AndAlso e(5) = 8 Then
If e(1) < 10 _AndAlso e(4) < 10 _AndAlso e(6) < 10 Then
count = count + 1
Print #2, "index, record is"; index, record, "e()'s match #"; _Trim$(Str$(count))
Print #2, c(1); " *"; c(2); " -"; c(3); " ="; c(1) * c(2) - c(3)
Print #2, c(4); " +"; c(5); " +"; c(6); " ="; c(4) + c(5) + c(6)
Print #2, c(7); " \"; c(8); " +"; c(9); " ="; c(7) \ c(8) + c(9)
Print #2, c(1); " \"; c(4); " +"; c(7); " ="; c(1) \ c(4) + c(7)
Print #2, c(2); " +"; c(5); " +"; c(8); " ="; c(2) + c(5) + c(8)
Print #2, c(3); " +"; c(6); " -"; c(9); " ="; c(3) + c(6) - c(9)
Print #2, ""
End If
End If
Loop
Oh look no Goto's b+LOL