Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: DANILIN on August 28, 2020, 05:44:52 am

Title: Rebus of Letters
Post by: DANILIN on August 28, 2020, 05:44:52 am
Rebus of Letters

My program solves a rebus from letters of form:
UDAR + UDAR = DRAKA

Russian: Punch + Punch = Fight

I'm looking for other options possibly using an array

Code: QB64: [Select]
  1. ' daudar.bas
  2.  
  3. start = TIMER
  4.  
  5. FOR u = 1 TO 9
  6.     FOR d = 1 TO 9
  7.         FOR a = 0 TO 9
  8.             FOR r = 0 TO 9
  9.                 FOR k = 0 TO 9
  10.  
  11. IF u = d THEN 22
  12. IF u = a THEN 33
  13. IF u = r THEN 44
  14. IF u = k THEN 55
  15.  
  16. IF d = a THEN 33
  17. IF d = r THEN 44
  18. IF d = k THEN 55
  19.  
  20. IF a = r THEN 44
  21. IF a = k THEN 55
  22. IF r = k THEN 55
  23.  
  24. udar = 1000*u + 100*d + 10*a + r
  25. draka = d*10000 + r*1000 + a*100 + k*10 + a
  26.  
  27. IF udar + udar = draka THEN PRINT udar, draka
  28.  
  29.                 55 NEXT k
  30.            44 NEXT r
  31.        33 NEXT a
  32.    22 NEXT d
  33. 11 NEXT u
  34.  
  35. finish = TIMER
  36.  
  37. PRINT finish - start
  38.  

Next: combinatorics of letter combinations and formulas

Offer your rebuses
Title: Re: Rebus of Letters
Post by: DANILIN on August 28, 2020, 06:33:07 pm
Solve of rebus UDAR+UDAR=DRAKA through an array of 5 Letters

Letter comparisons via nested Loops

improvement possible: variable number of letters
then nested comparison loops will be universal

Code: QB64: [Select]
  1. ' Russian Rebus Letters from Digitals.bas
  2. NN = 5: DIM a(NN)
  3. FOR u = 1 TO 9: a(1) = u
  4.     FOR d = 1 TO 9: a(2) = d
  5.         FOR a = 0 TO 9: a(3) = a
  6.             FOR r = 0 TO 9: a(4) = r
  7.                 FOR k = 0 TO 9: a(5) = k
  8. FOR xx = 1 TO NN-1
  9.    FOR yy = xx + 1 TO NN
  10.       IF a(xx) = a(yy) THEN GOTO 55
  11. NEXT yy: NEXT xx
  12.              udar = 1000*u + 100*d + 10*a + r
  13.              draka = d*10000 + r*1000 + a*100 + k*10 + a
  14.                   IF udar + udar = draka THEN PRINT udar, draka
Title: Re: Rebus of Letters
Post by: bplus on August 29, 2020, 05:47:51 pm
@DANILIN Hardly as clever as yours and allot of tedious work but
ten + two = four  76 ways!

Code: QB64: [Select]
  1. ' rebus challenge by danilin ref:  https://www.qb64.org/forum/index.php?topic=2961.msg122153#msg122153
  2. _TITLE "Rebus Danilin Challenge" 'b+ 2020-08-29
  3.  
  4. 'try nine + five = seven  > nope
  5. 'try ten + two = four
  6. f = 1
  7. PRINT "Count:", "ten", "+ two", " = four"
  8. FOR t = 5 TO 9
  9.     FOR w = 0 TO 9
  10.         FOR o = 0 TO 9
  11.             FOR e = 0 TO 9
  12.                 FOR n = 0 TO 9
  13.                     FOR u = 0 TO 9
  14.                         FOR r = 0 TO 9
  15.  
  16.                             IF r <> u AND r <> n AND r <> e AND r <> o AND r <> w AND r <> t AND r <> f THEN
  17.                                 IF u <> n AND u <> e AND u <> o AND u <> w AND u <> t AND u <> f THEN
  18.                                     IF n <> e AND n <> o AND n <> w AND n <> t AND n <> f THEN
  19.                                         IF e <> o AND e <> w AND e <> t AND e <> f THEN
  20.                                             IF o <> w AND o <> t AND o <> f THEN
  21.                                                 IF w <> t AND w <> f THEN
  22.                                                     IF t <> f THEN
  23.                                                         ten = 100 * t + 10 * e + n
  24.                                                         two = 100 * t + 10 * w + o
  25.                                                         four = 1000 * f + 100 * o + 10 * u + r
  26.                                                         IF ten + two = four THEN
  27.                                                             count = count + 1
  28.                                                             PRINT count, ten, two, four
  29.                                                             IF count MOD 20 = 0 THEN
  30.                                                                 INPUT "Press enter to contiue... "; w$
  31.                                                                 CLS
  32.                                                                 PRINT "Count:", "ten", "+ two", " = four"
  33.                                                             END IF
  34.                                                         END IF
  35.                                                     END IF
  36.                                                 END IF
  37.                                             END IF
  38.                                         END IF
  39.                                     END IF
  40.                                 END IF
  41.                             END IF
  42.  
  43.                         NEXT
  44.                     NEXT
  45.                 NEXT
  46.             NEXT
  47.         NEXT
  48.     NEXT
  50. PRINT "ten + two = four "; count; " ways!"
  51.  
  52.  
Title: Re: Rebus of Letters
Post by: bplus on August 30, 2020, 11:11:38 pm
I got this one off the Internet. This stuff is called Cryptarithm or Alphametic Puzzles. Thanks to Danilin's 2nd program I have a much easier time making sure all the letters are different values.

Here is "send + more = money" written by a program I am writing and testing to solve these suckers.
Code: QB64: [Select]
  1. DIM a(8)
  2. FOR s = 0 TO 9: a(1) = s
  3.     FOR e = 0 TO 9: a(2) = e
  4.         FOR n = 0 TO 9: a(3) = n
  5.             FOR d = 0 TO 9: a(4) = d
  6.                 FOR m = 0 TO 9: a(5) = m
  7.                     FOR o = 0 TO 9: a(6) = o
  8.                         FOR r = 0 TO 9: a(7) = r
  9.                             FOR y = 0 TO 9: a(8) = y
  10.                                 FOR xx = 1 TO 7
  11.                                     FOR yy = xx + 1 TO 8
  12.                                         IF a(xx) = a(yy) THEN GOTO skip
  13.                                     NEXT
  14.                                 NEXT
  15.                                 send = 10 ^ 3 * s + 10 ^ 2 * e + 10 ^ 1 * n + 10 ^ 0 * d
  16.                                 more = 10 ^ 3 * m + 10 ^ 2 * o + 10 ^ 1 * r + 10 ^ 0 * e
  17.                                 money = 10 ^ 4 * m + 10 ^ 3 * o + 10 ^ 2 * n + 10 ^ 1 * e + 10 ^ 0 * y
  18.                                 IF send + more = money THEN
  19.                                     PRINT send, more, money
  20.                                 END IF
  21.                                 skip:
  22.                             NEXT
  23.                         NEXT
  24.                     NEXT
  25.                 NEXT
  26.             NEXT
  27.         NEXT
  28.     NEXT
  30.  

I still have to tell it that letters that start words can't be 0, so this program solves with m = 0 before getting around to m = 1 which has just one solution, the last listed.
Title: Re: Rebus of Letters
Post by: bplus on August 30, 2020, 11:51:03 pm
I added _TITLE, fixed the 1st letter problem, added a header to the Solution and the test program send more money gets written and runs perfect.

Code: QB64: [Select]
  1. _TITLE "send more money Solver.bas" ' written by Cryptarithm Program Writer.bas b+ 2020-08-30
  2. DIM a(8)
  3. FOR s = 1 TO 9: a(1) = s
  4.     FOR e = 0 TO 9: a(2) = e
  5.         FOR n = 0 TO 9: a(3) = n
  6.             FOR d = 0 TO 9: a(4) = d
  7.                 FOR m = 1 TO 9: a(5) = m
  8.                     FOR o = 0 TO 9: a(6) = o
  9.                         FOR r = 0 TO 9: a(7) = r
  10.                             FOR y = 0 TO 9: a(8) = y
  11.                                 FOR xx = 1 TO 7
  12.                                     FOR yy = xx + 1 TO 8
  13.                                         IF a(xx) = a(yy) THEN GOTO skip
  14.                                     NEXT
  15.                                 NEXT
  16.                                 send = 10 ^ 3 * s + 10 ^ 2 * e + 10 ^ 1 * n + 10 ^ 0 * d
  17.                                 more = 10 ^ 3 * m + 10 ^ 2 * o + 10 ^ 1 * r + 10 ^ 0 * e
  18.                                 money = 10 ^ 4 * m + 10 ^ 3 * o + 10 ^ 2 * n + 10 ^ 1 * e + 10 ^ 0 * y
  19.                                 IF send + more = money THEN
  20.                                     PRINT " send", " more", " money"
  21.                                     PRINT send, more, money
  22.                                 END IF
  23.                                 skip:
  24.                             NEXT
  25.                         NEXT
  26.                     NEXT
  27.                 NEXT
  28.             NEXT
  29.         NEXT
  30.     NEXT
  32.  

Next try input of the 3 words to write the program, so the program writer can write a program to solve for the 3 words.
Title: Re: Rebus of Letters
Post by: _vince on August 30, 2020, 11:52:24 pm
are you substituting digits for letters?
Title: Re: Rebus of Letters
Post by: bplus on August 30, 2020, 11:57:47 pm

Quote from: _vince on August 30, 2020, 11:52:24 pm
are you substituting digits for letters?

We are finding the digits for each letter to make the "equation" work. What digits make send + more = money
send + more = money
9567 + 1085 = 10652

m's, o's, e's all match up to same number
Title: Re: Rebus of Letters
Post by: bplus on August 31, 2020, 12:10:26 am
Yeah, no problem with inputting words :) me + me = bee
Code: QB64: [Select]
  1. _TITLE "me me bee Solver.bas" ' written by Cryptarithm Program Writer.bas b+ 2020-08-30
  2. DIM a(3)
  3. FOR m = 1 TO 9: a(1) = m
  4.     FOR e = 0 TO 9: a(2) = e
  5.         FOR b = 1 TO 9: a(3) = b
  6.             FOR xx = 1 TO 2
  7.                 FOR yy = xx + 1 TO 3
  8.                     IF a(xx) = a(yy) THEN GOTO skip
  9.                 NEXT
  10.             NEXT
  11.             me = 10 ^ 1 * m + 10 ^ 0 * e
  12.             me = 10 ^ 1 * m + 10 ^ 0 * e
  13.             bee = 10 ^ 2 * b + 10 ^ 1 * e + 10 ^ 0 * e
  14.             IF me + me = bee THEN
  15.                 PRINT " me", " me", " bee"
  16.                 PRINT me, me, bee
  17.             END IF
  18.             skip:
  19.         NEXT
  20.     NEXT
  22.  

 

Title: Re: Rebus of Letters
Post by: bplus on August 31, 2020, 12:20:14 am
This one is supposed to be a Rebus too:
time time lucky  (third time's a charm)
It has a ton of solutions.
Code: QB64: [Select]
  1. _TITLE "time time lucky Solver.bas" ' written by Cryptarithm Program Writer.bas b+ 2020-08-30
  2. DIM a(9)
  3. FOR t = 1 TO 9: a(1) = t
  4.     FOR i = 0 TO 9: a(2) = i
  5.         FOR m = 0 TO 9: a(3) = m
  6.             FOR e = 0 TO 9: a(4) = e
  7.                 FOR l = 1 TO 9: a(5) = l
  8.                     FOR u = 0 TO 9: a(6) = u
  9.                         FOR c = 0 TO 9: a(7) = c
  10.                             FOR k = 0 TO 9: a(8) = k
  11.                                 FOR y = 0 TO 9: a(9) = y
  12.                                     FOR xx = 1 TO 8
  13.                                         FOR yy = xx + 1 TO 9
  14.                                             IF a(xx) = a(yy) THEN GOTO skip
  15.                                         NEXT
  16.                                     NEXT
  17.                                     time = 10 ^ 3 * t + 10 ^ 2 * i + 10 ^ 1 * m + 10 ^ 0 * e
  18.                                     time = 10 ^ 3 * t + 10 ^ 2 * i + 10 ^ 1 * m + 10 ^ 0 * e
  19.                                     lucky = 10 ^ 4 * l + 10 ^ 3 * u + 10 ^ 2 * c + 10 ^ 1 * k + 10 ^ 0 * y
  20.                                     IF time + time = lucky THEN
  21.                                         PRINT " time", " time", " lucky"
  22.                                         PRINT time, time, lucky
  23.                                     END IF
  24.                                     skip:
  25.                                 NEXT
  26.                             NEXT
  27.                         NEXT
  28.                     NEXT
  29.                 NEXT
  30.             NEXT
  31.         NEXT
  32.     NEXT
  34.  
Title: Re: Rebus of Letters
Post by: bplus on August 31, 2020, 12:24:01 am
Here is a totally appropriate one, nice   ;-) runs fast one solution.
Code: QB64: [Select]
  1. _TITLE "USA USSR PEACE Solver.bas" ' written by Cryptarithm Program Writer.bas b+ 2020-08-30
  2. DIM a(7)
  3. FOR U = 1 TO 9: a(1) = U
  4.     FOR S = 0 TO 9: a(2) = S
  5.         FOR A = 0 TO 9: a(3) = A
  6.             FOR R = 0 TO 9: a(4) = R
  7.                 FOR P = 1 TO 9: a(5) = P
  8.                     FOR E = 0 TO 9: a(6) = E
  9.                         FOR C = 0 TO 9: a(7) = C
  10.                             FOR xx = 1 TO 6
  11.                                 FOR yy = xx + 1 TO 7
  12.                                     IF a(xx) = a(yy) THEN GOTO skip
  13.                                 NEXT
  14.                             NEXT
  15.                             USA = 10 ^ 2 * U + 10 ^ 1 * S + 10 ^ 0 * A
  16.                             USSR = 10 ^ 3 * U + 10 ^ 2 * S + 10 ^ 1 * S + 10 ^ 0 * R
  17.                             PEACE = 10 ^ 4 * P + 10 ^ 3 * E + 10 ^ 2 * A + 10 ^ 1 * C + 10 ^ 0 * E
  18.                             IF USA + USSR = PEACE THEN
  19.                                 PRINT " USA", " USSR", " PEACE"
  20.                                 PRINT USA, USSR, PEACE
  21.                             END IF
  22.                             skip:
  23.                         NEXT
  24.                     NEXT
  25.                 NEXT
  26.             NEXT
  27.         NEXT
  28.     NEXT
  30.  

Next up, do one that can add more than 2 words.
Title: Re: Rebus of Letters
Post by: bplus on August 31, 2020, 03:19:37 am
Here is latest from updated program writer, adding 4 words letters to equal the fith words letters!
Code: QB64: [Select]
  1. _TITLE "one nine twenty fifty eighty Solver.bas" ' written by Cryptarithm Program Writer +.bas b+ 2020-08-31
  2. DIM a(10)
  3. FOR e = 1 TO 9: a(1) = e
  4.     FOR i = 0 TO 9: a(2) = i
  5.         FOR g = 0 TO 9: a(3) = g
  6.             FOR h = 0 TO 9: a(4) = h
  7.                 FOR t = 1 TO 9: a(5) = t
  8.                     FOR y = 0 TO 9: a(6) = y
  9.                         FOR f = 1 TO 9: a(7) = f
  10.                             FOR w = 0 TO 9: a(8) = w
  11.                                 FOR n = 1 TO 9: a(9) = n
  12.                                     FOR o = 1 TO 9: a(10) = o
  13.                                         FOR xx = 1 TO 9
  14.                                             FOR yy = xx + 1 TO 10
  15.                                                 IF a(xx) = a(yy) THEN GOTO skip
  16.                                             NEXT
  17.                                         NEXT
  18.                                         one = 10 ^ 2 * o + 10 ^ 1 * n + 10 ^ 0 * e
  19.                                         nine = 10 ^ 3 * n + 10 ^ 2 * i + 10 ^ 1 * n + 10 ^ 0 * e
  20.                                         twenty = 10 ^ 5 * t + 10 ^ 4 * w + 10 ^ 3 * e + 10 ^ 2 * n + 10 ^ 1 * t + 10 ^ 0 * y
  21.                                         fifty = 10 ^ 4 * f + 10 ^ 3 * i + 10 ^ 2 * f + 10 ^ 1 * t + 10 ^ 0 * y
  22.                                         eighty = 10 ^ 5 * e + 10 ^ 4 * i + 10 ^ 3 * g + 10 ^ 2 * h + 10 ^ 1 * t + 10 ^ 0 * y
  23.                                         IF one + nine + twenty + fifty = eighty THEN
  24.                                             PRINT " one", "+nine", "+twenty", "+fifty", "=eighty"
  25.                                             PRINT one, nine, twenty, fifty, eighty
  26.                                             PRINT: PRINT "  Press any to end..."
  27.                                             SLEEP
  28.                                             END
  29.                                         END IF
  30.                                         skip:
  31.                                     NEXT
  32.                                 NEXT
  33.                             NEXT
  34.                         NEXT
  35.                     NEXT
  36.                 NEXT
  37.             NEXT
  38.         NEXT
  39.     NEXT
  41. PRINT " Run is done, goodbye!"
  42.  

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Rebus of Letters
Post by: bplus on August 31, 2020, 02:54:28 pm
Hey @DANILIN

I guess you like my progress, are you ready for different math operations? How about yourself? Have you formalized an approach to doing these things?
Title: Re: Rebus of Letters
Post by: bplus on August 31, 2020, 04:26:41 pm
I knew this stuff looked familiar, we did this one at JB years ago!
Code: QB64: [Select]
  1. _TITLE "noon moon soon june Solver.bas" ' written by Cryptarithm Program Writer +.bas b+ 2020-08-31
  2. DIM a(7)
  3. FOR j = 1 TO 9: a(1) = j
  4.     FOR u = 0 TO 9: a(2) = u
  5.         FOR n = 1 TO 9: a(3) = n
  6.             FOR e = 0 TO 9: a(4) = e
  7.                 FOR s = 1 TO 9: a(5) = s
  8.                     FOR o = 0 TO 9: a(6) = o
  9.                         FOR m = 1 TO 9: a(7) = m
  10.                             FOR xx = 1 TO 6
  11.                                 FOR yy = xx + 1 TO 7
  12.                                     IF a(xx) = a(yy) THEN GOTO skip
  13.                                 NEXT
  14.                             NEXT
  15.                             noon = 10 ^ 3 * n + 10 ^ 2 * o + 10 ^ 1 * o + 10 ^ 0 * n
  16.                             moon = 10 ^ 3 * m + 10 ^ 2 * o + 10 ^ 1 * o + 10 ^ 0 * n
  17.                             soon = 10 ^ 3 * s + 10 ^ 2 * o + 10 ^ 1 * o + 10 ^ 0 * n
  18.                             june = 10 ^ 3 * j + 10 ^ 2 * u + 10 ^ 1 * n + 10 ^ 0 * e
  19.                             IF noon + moon + soon = june THEN
  20.                                 PRINT " noon", "+moon", "+soon", "=june"
  21.                                 PRINT noon, moon, soon, june
  22.                                 PRINT: PRINT "  Press any to end..."
  23.                                 SLEEP
  24.                                 END
  25.                             END IF
  26.                             skip:
  27.                         NEXT
  28.                     NEXT
  29.                 NEXT
  30.             NEXT
  31.         NEXT
  32.     NEXT
  34. PRINT " Run is done, goodbye!"
  35.  

Found some lovely Multiplication Puzzles :) 1 OK Division and 2 Subtraction puzzles.
Title: Re: Rebus of Letters
Post by: bplus on August 31, 2020, 10:29:43 pm
Yes subtraction working:
Code: QB64: [Select]
  1. _TITLE "research sources careless Solver.bas" ' written by Cryptarithm Program Writer ASMD.bas b+ 2020-08-31
  3. DIM a(9)
  4. FOR c = 1 TO 9: a(1) = c
  5.     FOR a = 0 TO 9: a(2) = a
  6.         FOR r = 1 TO 9: a(3) = r
  7.             FOR e = 0 TO 9: a(4) = e
  8.                 FOR l = 0 TO 9: a(5) = l
  9.                     FOR s = 1 TO 9: a(6) = s
  10.                         FOR o = 0 TO 9: a(7) = o
  11.                             FOR u = 0 TO 9: a(8) = u
  12.                                 FOR h = 0 TO 9: a(9) = h
  13.                                     FOR xx = 1 TO 8
  14.                                         FOR yy = xx + 1 TO 9
  15.                                             IF a(xx) = a(yy) THEN GOTO skip
  16.                                         NEXT
  17.                                     NEXT
  18.                                     research = 10 ^ 7 * r + 10 ^ 6 * e + 10 ^ 5 * s + 10 ^ 4 * e + 10 ^ 3 * a + 10 ^ 2 * r + 10 ^ 1 * c + 10 ^ 0 * h
  19.                                     sources = 10 ^ 6 * s + 10 ^ 5 * o + 10 ^ 4 * u + 10 ^ 3 * r + 10 ^ 2 * c + 10 ^ 1 * e + 10 ^ 0 * s
  20.                                     careless = 10 ^ 7 * c + 10 ^ 6 * a + 10 ^ 5 * r + 10 ^ 4 * e + 10 ^ 3 * l + 10 ^ 2 * e + 10 ^ 1 * s + 10 ^ 0 * s
  21.                                     IF research - sources = careless THEN
  22.                                         PRINT " research", "-sources", "=careless"
  23.                                         PRINT research, sources, careless
  24.                                         PRINT: PRINT "  Press any to end..."
  25.                                         SLEEP
  26.                                         END
  27.                                     END IF
  28.                                     skip:
  29.                                 NEXT
  30.                             NEXT
  31.                         NEXT
  32.                     NEXT
  33.                 NEXT
  34.             NEXT
  35.         NEXT
  36.     NEXT
  38. PRINT " Run is done, goodbye!"

I think this is the one where I had to add:
Code: QB64: [Select]
line to the programs because the e notation popped up in the answer.


Multiplication for the little there was to try:
Code: QB64: [Select]
  1. _TITLE "hip hip hurray Solver.bas" ' written by Cryptarithm Program Writer ASMD.bas b+ 2020-08-31
  3. DIM a(7)
  4. FOR h = 1 TO 9: a(1) = h
  5.     FOR u = 0 TO 9: a(2) = u
  6.         FOR r = 0 TO 9: a(3) = r
  7.             FOR a = 0 TO 9: a(4) = a
  8.                 FOR y = 0 TO 9: a(5) = y
  9.                     FOR i = 0 TO 9: a(6) = i
  10.                         FOR p = 0 TO 9: a(7) = p
  11.                             FOR xx = 1 TO 6
  12.                                 FOR yy = xx + 1 TO 7
  13.                                     IF a(xx) = a(yy) THEN GOTO skip
  14.                                 NEXT
  15.                             NEXT
  16.                             hip = 10 ^ 2 * h + 10 ^ 1 * i + 10 ^ 0 * p
  17.                             hip = 10 ^ 2 * h + 10 ^ 1 * i + 10 ^ 0 * p
  18.                             hurray = 10 ^ 5 * h + 10 ^ 4 * u + 10 ^ 3 * r + 10 ^ 2 * r + 10 ^ 1 * a + 10 ^ 0 * y
  19.                             IF hip * hip = hurray THEN
  20.                                 PRINT " hip", "*hip", "=hurray"
  21.                                 PRINT hip, hip, hurray
  22.                                 PRINT: PRINT "  Press any to end..."
  23.                                 SLEEP
  24.                                 END
  25.                             END IF
  26.                             skip:
  27.                         NEXT
  28.                     NEXT
  29.                 NEXT
  30.             NEXT
  31.         NEXT
  32.     NEXT
  34. PRINT " Run is done, goodbye!"
  35.  
And some division:
Code: QB64: [Select]
  1. _TITLE "riding red hood Solver.bas" ' written by Cryptarithm Program Writer ASMD.bas b+ 2020-08-31
  3. DIM a(8)
  4. FOR h = 1 TO 9: a(1) = h
  5.     FOR o = 0 TO 9: a(2) = o
  6.         FOR d = 0 TO 9: a(3) = d
  7.             FOR r = 1 TO 9: a(4) = r
  8.                 FOR e = 0 TO 9: a(5) = e
  9.                     FOR i = 0 TO 9: a(6) = i
  10.                         FOR n = 0 TO 9: a(7) = n
  11.                             FOR g = 0 TO 9: a(8) = g
  12.                                 FOR xx = 1 TO 7
  13.                                     FOR yy = xx + 1 TO 8
  14.                                         IF a(xx) = a(yy) THEN GOTO skip
  15.                                     NEXT
  16.                                 NEXT
  17.                                 riding = 10 ^ 5 * r + 10 ^ 4 * i + 10 ^ 3 * d + 10 ^ 2 * i + 10 ^ 1 * n + 10 ^ 0 * g
  18.                                 red = 10 ^ 2 * r + 10 ^ 1 * e + 10 ^ 0 * d
  19.                                 hood = 10 ^ 3 * h + 10 ^ 2 * o + 10 ^ 1 * o + 10 ^ 0 * d
  20.                                 IF riding \ red = hood THEN
  21.                                     PRINT " riding", "\red", "=hood"
  22.                                     PRINT riding, red, hood
  23.                                     PRINT: PRINT "  Press any to end..."
  24.                                     SLEEP
  25.                                     END
  26.                                 END IF
  27.                                 skip:
  28.                             NEXT
  29.                         NEXT
  30.                     NEXT
  31.                 NEXT
  32.             NEXT
  33.         NEXT
  34.     NEXT
  36. PRINT " Run is done, goodbye!"
  37.  

Alas the really cool division: ANTARTICA \ AMERICA = ASIA failed to find a solution.
Title: Re: Rebus of Letters
Post by: DANILIN on September 01, 2020, 09:37:54 am
improvement possible: variable number of letters
then nested comparison loops will be universal

Code: QB64: [Select]
  1. NN=5
  2. dim a(NN)
  3. ...
  4. FOR xx = 1 TO NN-1
  5.    FOR yy = xx + 1 TO NN
  6.       IF a(xx) = a(yy) THEN GOTO skip
Title: Re: Rebus of Letters
Post by: bplus on September 01, 2020, 09:48:20 am
Quote
improvement possible: variable number of letters
then nested comparison loops will be universal

Yeah my program writer uses the actual number of letters and the actual letters when it writes the Solver Program to run. Along with the Operation to use: add, subtract, multiple, divide and inputs number of words if it's to be addition.

Bout time I cleaned up the Program Writer and presented it.
Title: Re: Rebus of Letters
Post by: bplus on September 02, 2020, 02:53:10 am
I found a much easier way to input and process the Cryptarithm Puzzles. We had done these puzzles years ago at JB forum. With JB what you print onto the output screen can be copy and pasted through clipboard so there and then we were outputting programs on screen then copy / pasting as New bas code to run. But hardly any difference between printing to screen and printing to file.

Anyway, I rewrote the Input part of the puzzle and all the ramifications it involved and then rewrote and reran all the solvers. All the .bas files now start with word Solve (the equation).bas as the filename. The ones that have all 10 digits run about 20 minutes and on my CPU I can easily run 3 at a time.

So here is Writer #2:
Code: QB64: [Select]
  1. _TITLE "Cryptarithm Program Writer #2 ASMD" 'b+ 2020-09-01
  2. ' for rebus challenge by danilin ref:  https://www.qb64.org/forum/index.php?topic=2961.msg122153#msg122153
  3. ' Takes input for words to add and solve and writes a program to do that.
  4.  
  5. ' 2020-08-31 Let's "add" more than 2 words -  Cryptarithm Program Writer +.bas
  6. ' write 1 solution because we don't want to run through all 10 digits of 10 letter permutations
  7. ' We probably want the letter of the last word to go first (be the last to change). Done that was easy!
  8. ' No not done we need to make the last word first!
  9.  
  10. ' 2020-08-31 PM Let's do more than just add  -  Cryptarithm Program Writer ASMD.bas
  11. ' Had to add  "_DEFINE A-Z AS _INTEGER64" to programs being written, as one test returned answer
  12. ' with e notation.
  13.  
  14. ' 2020-09-01 Got a huge hint from tsh73 from years ago at JB Forum how to make the input to the
  15. ' Program Writer a one line, simply enter the whole equation. We will use spaces to separate
  16. ' the words from the operators or = sign. Simply smart!
  17.  
  19. SCREEN _NEWIMAGE(1200, 400, 32) 'need a wider screen taller screen for lot's of solutions
  20. _DELAY .25
  22. restart:
  23. PRINT "             For our word equation use the following operator symbols:"
  24. PRINT "  + add, - subtract, * multiply, \ integer divide and = sign with final word"
  25. PRINT "       Make sure there is a space between each word and operator or = sign."
  26. PRINT "                        Example > hip * hip = hurray"
  27. PRINT "                   No more than 10 different letters total."
  29. LINE INPUT " > "; eq$
  30.  
  31. ' debug with this old one from JB
  32. 'eq$ = "noon + moon + soon = june"
  33.  
  34. REDIM word(0) AS STRING
  35. Split eq$, " ", word()
  36. nWords = UBOUND(word)
  37. list$ = "": start$ = ""
  38. ' collect and count letters
  39. FOR w = nWords TO 0 STEP -2 'make sure first letter of = word is at top of list 10 permutations take while
  40.     FOR i = 1 TO LEN(word(w))
  41.         L$ = MID$(word(w), i, 1)
  42.         IF i = 1 THEN start$ = L$ + start$: wordCnt = wordCnt + 1 ' make sure the first letter of the last word is listed first, never used wordCnt
  43.         addit = -1
  44.         FOR j = 1 TO LEN(list$)
  45.             IF L$ = MID$(list$, j, 1) THEN addit = 0
  46.         NEXT
  47.         IF addit THEN list$ = list$ + L$
  48.     NEXT
  50. PRINT "Letter list, length, start$, eq$: "; list$, LEN(list$), start$, eq$
  51. LL = LEN(list$)
  52. INPUT " Enter anything to quit, just enter to continue..."; quit$
  53. IF LEN(quit$) THEN END
  54.  
  55. 'OK here we start writing the file
  56. p = INSTR(eq$, "\") 'cant open file with "\" in title
  58.     eqq$ = MID$(eq$, 1, p - 1) + "idvd" + MID$(eq$, p + 1)
  60.     eqq$ = eq$
  62. p = INSTR(eqq$, "*") 'cant open file with "*" in title
  64.     eqq$ = MID$(eqq$, 1, p - 1) + "mult" + MID$(eqq$, p + 1)
  66.  
  67. OPEN "Solve (" + eqq$ + ").bas" FOR OUTPUT AS #1
  68. S1$ = " ' written by Cryptarithm Program Writer #2 ASMD.bas b+ 2020-09-01"
  69. PRINT #1, "_TITLE " + CHR$(34) + "Solve (" + eq$ + ").bas" + CHR$(34) + S1$
  70. PRINT #1, "SCREEN _NEWIMAGE(1200, 720, 32) 'need a wider screen taller screen for lot's of solutions"
  71. PRINT #1, "_DELAY .25"
  72. PRINT #1, "_SCREENMOVE _MIDDLE"
  73. PRINT #1, "_DEFINE A-Z AS _INTEGER64"
  74. PRINT #1, "DIM a(" + _TRIM$(STR$(LL)) + ")"
  75.  
  76. S$ = "" ' Header for solution columns, aint we full of hope!
  77. FOR i = 0 TO nWords STEP 2 ' setup a header actually should do this at start reguardless of solutions or not
  78.     IF i = 0 THEN
  79.         S$ = S$ + CHR$(34) + " " + word(i) + CHR$(34)
  80.     ELSE
  81.         S$ = S$ + CHR$(34) + word(i - 1) + word(i) + CHR$(34)
  82.     END IF
  83.     IF i <> nWords THEN S$ = S$ + ", "
  85. Header$ = S$ ' if there are allot of multiple solutions the we could pause, then cls and fill another with header
  86. PRINT #1, "PRINT " + S$
  87.  
  88. FOR i = 1 TO LEN(list$)
  89.     IF INSTR(start$, MID$(list$, i, 1)) THEN
  90.         PRINT #1, "FOR " + MID$(list$, i, 1) + " = 1 to 9: a(" + _TRIM$(STR$(i)) + ") = " + MID$(list$, i, 1)
  91.     ELSE
  92.         PRINT #1, "FOR " + MID$(list$, i, 1) + " = 0 to 9: a(" + _TRIM$(STR$(i)) + ") = " + MID$(list$, i, 1)
  93.     END IF
  95.  
  96. PRINT #1, "FOR xx = 1 TO " + _TRIM$(STR$(LL - 1))
  97. PRINT #1, "FOR yy = xx + 1 TO " + _TRIM$(STR$(LL))
  98. PRINT #1, "IF a(xx) = a(yy) THEN GOTO skip"
  99. PRINT #1, "NEXT"
  100. PRINT #1, "NEXT"
  101.  
  102. 'ten = 100 * t + 10 * e + n
  103. FOR w = 0 TO nWords STEP 2
  104.     S$ = word(w) + " = "
  105.     LW = LEN(word(w))
  106.     FOR i = 1 TO LW
  107.         S$ = S$ + "10 ^ " + _TRIM$(STR$(LW - i)) + " * " + MID$(word(w), i, 1)
  108.         IF i <> LW THEN S$ = S$ + " + "
  109.     NEXT
  110.     PRINT #1, S$
  112.  
  113. 'IF ten + two = four THEN
  114. PRINT #1, "IF " + eq$ + " THEN" '  here we have a solution
  115.  
  116. 'PRINT count, ten, two, four
  117. S$ = ""
  118. FOR i = 0 TO nWords STEP 2
  119.     S$ = S$ + word(i)
  120.     IF i <> nWords THEN S$ = S$ + ", "
  122. PRINT #1, "PRINT " + S$
  123. 'PRINT #1, "PRINT: PRINT " + CHR$(34) + "  Press any to end..." + CHR$(34)
  124. 'PRINT #1, "SLEEP"
  125. 'PRINT #1, "END"
  126. PRINT #1, "END IF"
  127.  
  128. PRINT #1, "skip:"
  129. FOR i = 1 TO LL
  130.     PRINT #1, "NEXT"
  132. PRINT #1, "PRINT " + CHR$(34) + " Run is done, goodbye!" + CHR$(34)
  134. PRINT "File Ready"
  135. GOTO restart
  136.  
  137. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
  138.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
  139.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
  140.     dpos = INSTR(curpos, SplitMeString, delim)
  141.     DO UNTIL dpos = 0
  142.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
  143.         arrpos = arrpos + 1
  144.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
  145.         curpos = dpos + LD
  146.         dpos = INSTR(curpos, SplitMeString, delim)
  147.     LOOP
  148.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
  149.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
  151.  
  152.  

and here is the load of Solvers I've written with it tonight, a couple of subtraction, division and multiplication but mostly addition of two or more words:
Title: Re: Rebus of Letters
Post by: DANILIN on September 03, 2020, 02:04:37 am
Brilliant work synthesizing programs from a program

I remembered doing the same thing in Excel for an idea
Quadrat Economy Danilins
where regular changes in the code are made in Excel

 


And without Excel and without synthesis it takes into account 10 letters
there are probably "IF" before cycles

Original code:
Code: QB64: [Select]
  1. ' Russian Rebus of Letters from Digitals.bas
  2. NN = 5: DIM a(NN)
  3. FOR u = 1 TO 9: a(1) = u
  4.     FOR d = 1 TO 9: a(2) = d
  5.         FOR a = 0 TO 9: a(3) = a
  6.             FOR r = 0 TO 9: a(4) = r
  7.                 FOR k = 0 TO 9: a(5) = k
  8. FOR xx = 1 TO NN-1
  9.    FOR yy = xx + 1 TO NN
  10.       IF a(xx) = a(yy) THEN GOTO 55
  11. NEXT yy: NEXT xx
  12.              udar = 1000*u + 100*d + 10*a + r
  13.              draka = d*10000 + r*1000 + a*100 + k*10 + a
  14.                   IF udar + udar = draka THEN PRINT udar, draka
Title: Re: Rebus of Letters
Post by: bplus on September 05, 2020, 01:31:30 pm
Yes, your example for handling IF's was very helpful. I was prepared to systematically run through the combinations.
Title: Re: Rebus of Letters
Post by: TempodiBasic on September 06, 2020, 08:17:32 pm
Hi Bplus and DANILIN

so I can see that you like the crytography and the use of brute force of  PC machine to solve it.

Do you think that it is possible to apply this method for solve the Lettera del Diavolo di Agrigento (Letter of devil that stays in Agrigento)?
here a link to the issuehttps://sites.google.com/site/beatacorbera/lettera-del-diavolo (https://sites.google.com/site/beatacorbera/lettera-del-diavolo) and the letter https://sites.google.com/site/beatacorbera/_/rsrc/1317142844724/lettera-del-diavolo/LETTERA%20DEL%20DIAVOLO.jpg?height=1553&width=1118 (https://sites.google.com/site/beatacorbera/_/rsrc/1317142844724/lettera-del-diavolo/LETTERA%20DEL%20DIAVOLO.jpg?height=1553&width=1118)

Thanks to read
Title: Re: Rebus of Letters
Post by: DANILIN on September 07, 2020, 08:40:26 am
Theoretically without a key except for letter differences
this algorithm compares letters with each other
requires up to 26*25/2=325 comparisons each turn
and it will give out words from different letters

And one day this text will add up to a readable one

Code: QB64: [Select]
  1. NN = 26: DIM a(NN)
  2. FOR a = 1 TO 26: a(1) = a
  3.     FOR b = 1 TO 26: a(2) = b
  4.         ...
  5.             FOR y = 1 TO 26: a(25) = y
  6.                 FOR z = 1 TO 26: a(26) = z
  7. FOR xx = 1 TO NN-1: FOR yy = xx+1 TO NN
  8.       IF a(xx) = a(yy) THEN GOTO 55
  9. NEXT yy: NEXT xx

Then output prepared letter combination
main thing is that order is observed

I'll check it out for myself:

Code: QB64: [Select]
  1. NN = 5: DIM a(NN): s = 0 ' danilin.bas
  2. FOR d = 0 TO 26: a(1) = d
  3.     FOR a = 0 TO 26: a(2) = a
  4.         FOR n = 0 TO 26: a(3) = n
  5.             FOR i = 0 TO 26: a(4) = i
  6.                 FOR l = 0 TO 26: a(5) = l
  7.     FOR xx = 1 TO NN - 1: FOR yy = xx+1 TO NN
  8.           IF a(xx) = a(yy) THEN GOTO 55
  9.     NEXT yy: NEXT xx
  10. s = s+1
  11. Word$ = CHR$(65+a(1)) + CHR$(65+a(2)) + CHR$(65+a(3)) + CHR$(65+a(4)) + CHR$(65+a(5)) + CHR$(65+a(4)) + CHR$(65+a(3))
  12. PRINT s; Word$;
  13. IF Word$ = "DANILIN" THEN END
  14.  

DANILIN # 1'082'619 by 5 seconds
Title: Re: Rebus of Letters
Post by: bplus on September 07, 2020, 12:47:01 pm
Hey @TempodiBasic

I don't consider these Solvers = cryptography, they are letter/word equations/puzzles to be solved besides, some of them have more than one solution.

Any cryptography of worth would not repeat the same value for same letter, too easy!
Title: Re: Rebus of Letters
Post by: TempodiBasic on September 07, 2020, 05:50:29 pm
@bplus
before to run you must be able to walk, and before to walk you must be able to stand on your feet...

Yes the scrolling frame is the second pattern used into cryptography after the substitution one to one from a symbol to another of another kind. The third step, generally, is the substitution one symbol to many symbol following a math scheme.
Here I post an example of the easyest cryptography  taken from this link https://www.google.com/url?sa=i&url=https%3A%2F%2Fpdfslide.net%2Fdocuments%2Fsettimana-enigmistica-3270-con-soluzioni.html&psig=AOvVaw1YIuX2pFgB3ItXqzNONtDT&ust=1599600916868000&source=images&cd=vfe&ved=0CA4QtaYDahcKEwjQ0JL3_9frAhUAAAAAHQAAAAAQCw (https://www.google.com/url?sa=i&url=https%3A%2F%2Fpdfslide.net%2Fdocuments%2Fsettimana-enigmistica-3270-con-soluzioni.html&psig=AOvVaw1YIuX2pFgB3ItXqzNONtDT&ust=1599600916868000&source=images&cd=vfe&ved=0CA4QtaYDahcKEwjQ0JL3_9frAhUAAAAAHQAAAAAQCw)

Quote
L'ANEDDOTO CIFRATO
123456-78-9
8 IO 9 3 Il 2 - IO 8 12
13 2 Il Brando 8 14 6 14 8
13 - 8 9 3 15 16 7 3 Il
6 7 3 - 8 Il 7 8 12 17
6 Il 6 - 8 - 18 2 Il 18
2 invece 7 3 - 12 6 4 8 12
17 3 - 8 - 17 4 16 2 13
8 . - 13 8 - 17 2 12 6 13
13 8 - IO 8 19 19 3 2 12
6 - 7 6 4 3 17 6 - 3 Il
20 3 Il 6 - 7 3 accompagnar­
velo I 6 12 17 2 Il 8 13 IO
6 Il 15 6 • - 15 6 Il 6 Il
7 2 13 2 - 8 13 - 19 16
3 Il 18 8 19 13 3 2 .
Sostituite una lettera ad ogni numero.
Good Luck to translate into italian language. (using a foreign language to write the message: this can be another way to make more difficult the cryptography because everyone is used to think and talk in own native language and not in other languages.)

Title: Re: Rebus of Letters
Post by: DANILIN on September 08, 2020, 06:58:53 am
Program lists combinations of 7 letters
before word ZYXWVUT
reporting results every 15 seconds
practically changing 2nd letter
and it takes about 3 hours for all iterations
Code: QB64: [Select]
  1. start = TIMER: NN = 7: t = 0: DIM a(NN): DIM s AS DOUBLE: s = 0:' zyxwvut.bas
  2. FOR a = 0 TO 25: a(1) = a
  3.     FOR b = 0 TO 25: a(2) = b
  4.         FOR c = 0 TO 25: a(3) = c
  5.             FOR d = 0 TO 25: a(4) = d
  6.                 FOR e = 0 TO 25: a(5) = e
  7.                     FOR f = 0 TO 25: a(6) = f
  8.                         FOR g = 0 TO 25: a(7) = g
  9.     FOR xx = 1 TO NN - 1: FOR yy = xx + 1 TO NN: IF a(xx) = a(yy) THEN GOTO 55
  10.     NEXT yy: NEXT xx
  11. s = s + 1: finish = TIMER: q = INT(finish - start)
  12. Word$ = CHR$(65+a(1)) + CHR$(65+a(2)) + CHR$(65+a(3)) + CHR$(65+a(4)) + CHR$(65+a(5)) + CHR$(65+a(6)) + CHR$(65+a(7))
  13. IF q-t = 15 THEN PRINT q; "s. "; INT(s /10^6); "mln. "; Word$; ,: t = q
  14. IF Word$ = "ZYXWVUT" THEN PRINT s; Word$; ,: finish = TIMER: PRINT finish - start: END
  15.    55 NEXT: NEXT: NEXT: NEXT: NEXT: NEXT: NEXT
  16. finish = TIMER: PRINT finish - start: END

+ 9\9\20

Code: QB64: [Select]
  1. start = TIMER: NN = 7: t = 0: DIM a(NN): DIM s AS DOUBLE: s = 0 ' zyxwvut.bas
  2. FOR a = 25 TO 25: a(1) = a
  3.     FOR b = 24 TO 25: a(2) = b
  4.         FOR c = 0 TO 25: a(3) = c
  5.             FOR d = 0 TO 25: a(4) = d
  6.                 FOR e = 0 TO 25: a(5) = e
  7.                     FOR f = 0 TO 25: a(6) = f
  8.                         FOR g = 0 TO 25: a(7) = g
  9. FOR xx = 1 TO NN - 1: FOR yy = xx + 1 TO NN: IF a(xx) = a(yy) THEN 55
  10.          NEXT yy: NEXT xx: s = s + 1
  11. Word$ = CHR$(65+a(1)) + CHR$(65+a(2)) + CHR$(65+a(3)) + CHR$(65+a(4)) + CHR$(65+a(5)) + CHR$(65+a(6)) + CHR$(65+a(7))
  12. IF Word$ = "ZYXWVUT" THEN 77
  13.   55 NEXT: NEXT: NEXT: NEXT
  14.       PRINT INT(s/10^6); "mln. "; Word$; ,
  16. 77 PRINT s; Word$; ,: finish = TIMER: PRINT finish - start: END

 


Below: all combination of 7 digital is factorial 7! = 1*2*3*4*5*6*7 = 5040
Title: Re: Rebus of Letters
Post by: bplus on September 08, 2020, 12:16:44 pm
Quote from: DANILIN on September 08, 2020, 06:58:53 am
Program lists combinations of 7 letters
before word ZYXWVUT
reporting results every 15 seconds
practically changing 2nd letter
and it takes about 3 hours for all iterations
Code: QB64: [Select]
  1. start = TIMER: NN = 7: t = 0: DIM a(NN): DIM s AS DOUBLE: s = 0:' zyxwvut.bas
  2. FOR a = 0 TO 25: a(1) = a
  3.     FOR b = 0 TO 25: a(2) = b
  4.         FOR c = 0 TO 25: a(3) = c
  5.             FOR d = 0 TO 25: a(4) = d
  6.                 FOR e = 0 TO 25: a(5) = e
  7.                     FOR f = 0 TO 25: a(6) = f
  8.                         FOR g = 0 TO 25: a(7) = g
  9.     FOR xx = 1 TO NN - 1: FOR yy = xx + 1 TO NN: IF a(xx) = a(yy) THEN GOTO 55
  10.     NEXT yy: NEXT xx
  11. s = s + 1: finish = TIMER: q = INT(finish - start)
  12. Word$ = CHR$(65+a(1)) + CHR$(65+a(2)) + CHR$(65+a(3)) + CHR$(65+a(4)) + CHR$(65+a(5)) + CHR$(65+a(6)) + CHR$(65+a(7))
  13. IF q-t = 15 THEN PRINT q; "s. "; INT(s /10^6); "mln. "; Word$; ,: t = q
  14. IF Word$ = "ZYXWVUT" THEN PRINT s; Word$; ,: finish = TIMER: PRINT finish - start: END
  15.    55 NEXT: NEXT: NEXT: NEXT: NEXT: NEXT: NEXT
  16. finish = TIMER: PRINT finish - start: END


@DANILIN  sorry this does not make sense to me maybe I miss something or something lost in translation but
there is 1 combination of 7 letters using all 7 letters
and there are 2^7 sets of combination subsets of a 7 element set including the combination of no letters.

There are 7! Permutations of 7 letters that is only 5040 which should take less than a minute to generate even on slow computer.

Lets see if I can dig up the code that will list perms of abcdefg

Ah here we go! 5040 permutations. This thing can do whole words too!
Code: QB64: [Select]
  1. _TITLE "Permutations with value translator" 'B+ add value translator 2019-03-31
  2. 'from "Permutations wo recursion"  translate from SmallBasic to QB64 2019-03-31
  3. 'from "Permutations" translation from: PowerBASIC, tsh copy from Liberty link 2017-02-04
  4.  
  5. SCREEN _NEWIMAGE(800, 600, 32)
  6. _SCREENMOVE 300, 40
  7.  
  8. REDIM results$(0)
  9. loadPermsValues results$()
  10. 'display result$
  11. FOR i = 0 TO UBOUND(results$)
  12.     PRINT i + 1, results$(i)
  13.     IF i MOD 30 = 29 THEN
  14.         PRINT "press any to continue..."
  15.         SLEEP
  16.         CLS
  17.     END IF
  19.  
  20. ValuesData:
  21. DATA "a","b","c","d","e","f","g","END"
  22.  
  23. 'this reads data from ValuesData line and translates Permutations to those values
  24. SUB loadPermsValues (r() AS STRING)
  25.     'load values array one way or another? read data
  26.     REDIM values(0) AS STRING
  27.     RESTORE ValuesData
  28.     DO
  29.         READ r$
  30.         IF r$ = "END" THEN
  31.             done = 1
  32.         ELSE
  33.             n = n + 1
  34.             REDIM _PRESERVE values(n) AS STRING
  35.             values(n) = r$
  36.         END IF
  37.     LOOP UNTIL done
  38.     n = UBOUND(values)
  39.     DIM a(0 TO n + 1) '+1 needed due to bug in LB that checks loop condition: until (i=0) or (a(i)<a(i+1))
  40.     FOR i = 0 TO n: a(i) = i: NEXT 'load a() with minimum values
  41.     DO
  42.         b$ = ""
  43.         FOR i = 1 TO n
  44.             b$ = b$ + values(a(i)) + " "
  45.         NEXT
  46.         REDIM _PRESERVE r(e)
  47.         r(e) = b$
  48.         e = e + 1
  49.  
  50.         i = n
  51.         DO
  52.             i = i - 1
  53.         LOOP UNTIL (i = 0) OR (a(i) < a(i + 1))
  54.         j = i + 1
  55.         k = n
  56.         WHILE j < k
  57.             SWAP a(j), a(k)
  58.             j = j + 1
  59.             k = k - 1
  60.         WEND
  61.         IF i > 0 THEN
  62.             j = i + 1
  63.             WHILE a(j) < a(i)
  64.                 j = j + 1
  65.             WEND
  66.             SWAP a(i), a(j)
  67.         END IF
  68.     LOOP UNTIL i = 0
  69.     EXIT SUB
  71.  
  72.  
Title: Re: Rebus of Letters
Post by: bplus on September 08, 2020, 12:28:37 pm
And for combinations here is how Steve handled the listing of Combinations of 60 numbers taken 6 at a time:

Code: QB64: [Select]
  1. ' print ordered list of combo rCn, r = 6 n = 60 Steve McNeill 2019-03-28
  2.  
  3. PRINT "Calculating..."
  4. OPEN "6 Combos from 60 Numbers.txt" FOR OUTPUT AS #1
  5. FOR num1 = 1 TO 55
  6.     LOCATE 2, 1: PRINT num1,
  7.     FOR num2 = num1 + 1 TO 56
  8.         LOCATE 3, 1: PRINT num2,
  9.         FOR num3 = num2 + 1 TO 57
  10.             LOCATE 4, 1: PRINT num3,
  11.             FOR num4 = num3 + 1 TO 58
  12.                 LOCATE 5, 1: PRINT num4,
  13.                 FOR num5 = num4 + 1 TO 59
  14.                     LOCATE 6, 1: PRINT num5,
  15.                     FOR num6 = num5 + 1 TO 60
  16.                         LOCATE 7, 1: PRINT num6
  17.                         s$ = LTRIM$(STR$(num1)) + ","
  18.                         IF num1 < 10 THEN s$ = "0" + s$
  19.                         IF num2 < 10 THEN s$ = s$ + "0"
  20.                         s$ = s$ + LTRIM$(STR$(num2)) + ","
  21.                         IF num3 < 10 THEN s$ = s$ + "0"
  22.                         s$ = s$ + LTRIM$(STR$(num3)) + ","
  23.                         IF num4 < 10 THEN s$ = s$ + "0"
  24.                         s$ = s$ + LTRIM$(STR$(num4)) + ","
  25.                         IF num5 < 10 THEN s$ = s$ + "0"
  26.                         s$ = s$ + LTRIM$(STR$(num5)) + ","
  27.                         IF num6 < 10 THEN s$ = s$ + "0"
  28.                         s$ = s$ + LTRIM$(STR$(num6))
  29.                         PRINT #1, s$
  30.                     NEXT
  31.                 NEXT
  32.             NEXT
  33.         NEXT
  34.     NEXT
  36.  
  37.  

Now I will make a program to generate all the combinations of an n element set because I've been meaning to do that :)
Title: Re: Rebus of Letters
Post by: bplus on September 08, 2020, 02:12:35 pm
Sometimes I impress myself:
Ordered Combinations Generator (using letters to represent elements in a set)
https://www.qb64.org/forum/index.php?topic=2999.msg122579#msg122579
Text Only | Text with Attachments