Ребус Букв: Rebus of Letters
Программа решает ребусы вида UDAR + UDAR = DRAKA
' Russian Rebus of Letters from Digitals.bas
NN = 5: DIM a(NN)
FOR u = 1 TO 9: a(1) = u
FOR d = 1 TO 9: a(2) = d
FOR a = 0 TO 9: a(3) = a
FOR r = 0 TO 9: a(4) = r
FOR k = 0 TO 9: a(5) = k
FOR xx = 1 TO NN-1
FOR yy = xx + 1 TO NN
IF a(xx) = a(yy) THEN GOTO 55
NEXT yy: NEXT xx
udar = 1000*u + 100*d + 10*a + r
draka = d*10000 + r*1000 + a*100 + k*10 + a
IF udar + udar = draka THEN PRINT udar, draka
55 NEXT: NEXT: NEXT: NEXT: NEXT
END
Программа синтезирует программы решающие ребусы USA + USSR = PEACE
Rebus of Letters
qb64forum.alephc.xyz/index.php?topic=2961
_TITLE "Cryptarithm Program Writer #2 ASMD" 'b+ 2020-09-01
' for rebus challenge by danilin ref: https://qb64forum.alephc.xyz/index.php?topic=2961.msg122153#msg122153
' Takes input for words to add and solve and writes a program to do that.
' 2020-08-31 Let's "add" more than 2 words - Cryptarithm Program Writer +.bas
' write 1 solution because we don't want to run through all 10 digits of 10 letter permutations
' We probably want the letter of the last word to go first (be the last to change). Done that was easy!
' No not done we need to make the last word first!
' 2020-08-31 PM Let's do more than just add - Cryptarithm Program Writer ASMD.bas
' Had to add "_DEFINE A-Z AS _INTEGER64" to programs being written, as one test returned answer
' with e notation.
' 2020-09-01 Got a huge hint from tsh73 from years ago at JB Forum how to make the input to the
' Program Writer a one line, simply enter the whole equation. We will use spaces to separate
' the words from the operators or = sign. Simply smart!
_DEFINE A-Z AS _INTEGER64
SCREEN _NEWIMAGE(1200, 400, 32) 'need a wider screen taller screen for lot's of solutions
_DELAY .25
_SCREENMOVE _MIDDLE
restart:
PRINT " For our word equation use the following operator symbols:"
PRINT " + add, - subtract, * multiply, \ integer divide and = sign with final word"
PRINT " Make sure there is a space between each word and operator or = sign."
PRINT " Example > hip * hip = hurray"
PRINT " No more than 10 different letters total."
PRINT
LINE INPUT " > "; eq$
' debug with this old one from JB
'eq$ = "noon + moon + soon = june"
REDIM word(0) AS STRING
Split eq$, " ", word()
nWords = UBOUND(word)
list$ = "": start$ = ""
' collect and count letters
FOR w = nWords TO 0 STEP -2 'make sure first letter of = word is at top of list 10 permutations take while
FOR i = 1 TO LEN(word(w))
L$ = MID$(word(w), i, 1)
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
addit = -1
FOR j = 1 TO LEN(list$)
IF L$ = MID$(list$, j, 1) THEN addit = 0
NEXT
IF addit THEN list$ = list$ + L$
NEXT
NEXT
PRINT "Letter list, length, start$, eq$: "; list$, LEN(list$), start$, eq$
LL = LEN(list$)
INPUT " Enter anything to quit, just enter to continue..."; quit$
IF LEN(quit$) THEN END
'OK here we start writing the file
p = INSTR(eq$, "\") 'cant open file with "\" in title
IF p THEN
eqq$ = MID$(eq$, 1, p - 1) + "idvd" + MID$(eq$, p + 1)
ELSE
eqq$ = eq$
END IF
p = INSTR(eqq$, "*") 'cant open file with "*" in title
IF p THEN
eqq$ = MID$(eqq$, 1, p - 1) + "mult" + MID$(eqq$, p + 1)
END IF
OPEN "Solve (" + eqq$ + ").bas" FOR OUTPUT AS #1
S1$ = " ' written by Cryptarithm Program Writer #2 ASMD.bas b+ 2020-09-01"
PRINT #1, "_TITLE " + CHR$(34) + "Solve (" + eq$ + ").bas" + CHR$(34) + S1$
PRINT #1, "SCREEN _NEWIMAGE(1200, 720, 32) 'need a wider screen taller screen for lot's of solutions"
PRINT #1, "_DELAY .25"
PRINT #1, "_SCREENMOVE _MIDDLE"
PRINT #1, "_DEFINE A-Z AS _INTEGER64"
PRINT #1, "DIM a(" + _TRIM$(STR$(LL)) + ")"
S$ = "" ' Header for solution columns, aint we full of hope!
FOR i = 0 TO nWords STEP 2 ' setup a header actually should do this at start reguardless of solutions or not
IF i = 0 THEN
S$ = S$ + CHR$(34) + " " + word(i) + CHR$(34)
ELSE
S$ = S$ + CHR$(34) + word(i - 1) + word(i) + CHR$(34)
END IF
IF i <> nWords THEN S$ = S$ + ", "
NEXT
Header$ = S$ ' if there are allot of multiple solutions the we could pause, then cls and fill another with header
PRINT #1, "PRINT " + S$
FOR i = 1 TO LEN(list$)
IF INSTR(start$, MID$(list$, i, 1)) THEN
PRINT #1, "FOR " + MID$(list$, i, 1) + " = 1 to 9: a(" + _TRIM$(STR$(i)) + ") = " + MID$(list$, i, 1)
ELSE
PRINT #1, "FOR " + MID$(list$, i, 1) + " = 0 to 9: a(" + _TRIM$(STR$(i)) + ") = " + MID$(list$, i, 1)
END IF
NEXT
PRINT #1, "FOR xx = 1 TO " + _TRIM$(STR$(LL - 1))
PRINT #1, "FOR yy = xx + 1 TO " + _TRIM$(STR$(LL))
PRINT #1, "IF a(xx) = a(yy) THEN GOTO skip"
PRINT #1, "NEXT"
PRINT #1, "NEXT"
'ten = 100 * t + 10 * e + n
FOR w = 0 TO nWords STEP 2
S$ = word(w) + " = "
LW = LEN(word(w))
FOR i = 1 TO LW
S$ = S$ + "10 ^ " + _TRIM$(STR$(LW - i)) + " * " + MID$(word(w), i, 1)
IF i <> LW THEN S$ = S$ + " + "
NEXT
PRINT #1, S$
NEXT
'IF ten + two = four THEN
PRINT #1, "IF " + eq$ + " THEN" ' here we have a solution
'PRINT count, ten, two, four
S$ = ""
FOR i = 0 TO nWords STEP 2
S$ = S$ + word(i)
IF i <> nWords THEN S$ = S$ + ", "
NEXT
PRINT #1, "PRINT " + S$
'PRINT #1, "PRINT: PRINT " + CHR$(34) + " Press any to end..." + CHR$(34)
'PRINT #1, "SLEEP"
'PRINT #1, "END"
PRINT #1, "END IF"
PRINT #1, "skip:"
FOR i = 1 TO LL
PRINT #1, "NEXT"
NEXT
PRINT #1, "PRINT " + CHR$(34) + " Run is done, goodbye!" + CHR$(34)
CLOSE #1
PRINT "File Ready"
GOTO restart
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
qb64forum.alephc.xyz/index.php?topic=2961.msg122153#msg122153
Криптарифма Cryptarithm альфаметик alphametic
на языках qbasic python c# c++ JavaScript
Ребус где буквы заменяют цифры
решается на нескольких языках программирования
и есть программа составляющая программы
на языке высочайшего уровня бэйсик qbasic qb64
решающая дюжину цифро буквенных ребусов крипторифм
вида Ветка +Ветка =Дерево ][ 74235 +74235 =148470
+VETKA ][ +74235
+VETKA ][ +74235
DEREVO ][ 148470
или за 5 минут переделывается на букв меньше
например УДАР + УДАР = ДРАКА 8126 + 8126 = 16252
и формула и знаки могут быть любые
Особенность: буквы крайние 0 быть не могут
что ускоряет алгоритм от +25% до +50%
Порядок букв в циклах на формулы не влияет
и возможны несколько решений или без решения
Криптарифма Rebus of Letters Cryptarithm
Ветка + Ветка = Дерево
VETKA + VETKA = DEREVO
Rebus qb64 qbasic
NN=8: Dim a(NN) ' DANILIN Rebus.bas of Letters
For V=1 To 9: a(1)=V: Print V;
For E=0 To 9: a(2)=E ' jdoodle.com/a/6cSw
For T=0 To 9: a(3)=T ' ВЕТКА+ВЕТКА=ДЕРЕВО
For K=0 To 9: a(4)=K
For A=1 To 9: a(5)=A
For R=0 To 9: a(6)=R
For O=0 To 9: a(7)=O
For D=1 To 9: a(8)=D
For ii=1 To NN - 1
For jj=ii + 1 To NN
If a(ii)=a(jj) Then GoTo 55
Next: Next
VETKA = 10000*V + 1000*E + 100*T + 10*K + A
DEREVO=D*100000 + E*10000 + R*1000 + E*100 + V*10 + O
If VETKA + VETKA=DEREVO Then Print: Print VETKA, DEREVO
55 Next: Next: Next: Next: Next: Next: Next: Next
End
Rebus Python
nn=8; x=[1]; ff = 0 # rebusp.py DANILIN
for i in range (0,nn+1):
x[i]=x.append(i)
for v in range (7,10):
x[1]=v; print(v, end='')
for e in range (4,10):
x[2]=e; print(e, end='')
for t in range (0,10):
x[3]=t; print(t, end=' ')
for k in range (0,10):
x[4]=k
for a in range (1,10):
x[5]=a
for r in range (0,10):
x[6]=r
for o in range (0,10):
x[7]=o
for d in range (1,10):
x[8]=d
for ii in range (1,nn-1):
for jj in range (ii+1,nn):
if x[ii] == x[jj]:
ff = 1
if ff == 0:
vetka = 10000*v +1000*e +100*t +10*k+a
derevo = d*100000+e*10000+r*1000+e*100+v*10+o
if vetka + vetka == derevo:
print(" ", vetka, derevo)
ff=0
Rebus JavaScript js htm
<!DOCTYPE html> <html> <head> <meta charset="utf-8">
<title>Rebus of Letters JS</title> </head> <body>
http://jdoodle.com/h/2YH <script> var v,e,t,k,a,r,o,d;
var nn=8, x=[nn+1], ff = 0; var ii,jj, vetka, derevo
for (v=1; v<=9; v++)
{ x[1]=v; document.write(v);
for (e=0; e<=9; e++)
{ x[2]=e; for (t=0; t<=9; t++)
{ x[3]=t; for (k=0; k<=9; k++)
{ x[4]=k; for (a=1; a<=9; a++)
{ x[5]=a; for (r=0; r<=9; r++)
{ x[6]=r; for (o=0; o<=9; o++)
{ x[7]=o; for (d=1; d<=9; d++)
{ x[8]=d;
for (ii = 1; ii <= nn-1; ii++)
for (jj = ii+1; jj <= nn; jj++)
if (x[ii] == x[jj]) { ff = 1; }
if (ff==0)
{ vetka = 10000*v +1000*e +100*t +10*k+a;
derevo = d*100000+e*10000+r*1000+e*100+v*10+o;
if (vetka + vetka == derevo)
{ document.write(" "+ vetka +" "+ derevo +" ");}
}
ff=0 }} }} }} }}
</script> </body> </html>
Rebus c++
#include <iostream> // rebusc.cpp DANILIN
using namespace std; int main()
{ setlocale (LC_ALL, "RUS"); srand(time(NULL));
int v,e,t,k,a,r,o,d,ii,jj; int nn=8;
int x[nn+1]; int vetka, derevo;
for (v=1; v<=9; v++)
{ x[1]=v; cout << v; // jdoodle.com/a/6cSs
for (e=0; e<=9; e++)
{ x[2]=e; for (t=0; t<=9; t++)
{ x[3]=t; for (k=0; k<=9; k++)
{ x[4]=k; for (a=0; a<=9; a++)
{ x[5]=a; for (r=0; r<=9; r++)
{ x[6]=r; for (o=0; o<=9; o++)
{ x[7]=o; for (d=1; d<=9; d++)
{ x[8]=d; // rextester.com/BLAZ43522
for (ii = 1; ii <= nn-1; ii++)
for (jj = ii+1; jj <= nn; jj++)
if (x[ii] == x[jj]) { goto dav; }
vetka = 10000*v +1000*e +100*t +10*k+a;
derevo = d*100000+e*10000+r*1000+e*100+v*10+o;
if (vetka + vetka == derevo)
cout <<"\n"<< vetka <<" "<< derevo <<"\n";
dav:; }} }} }} }}
system("pause");
}
Rebus C#
using System; using System.IO; // rebusx.cs DANILIN
namespace rebusx { class rebusx
{ static void Main(string[] args)
{ int v,e,t,k,a,r,o,d,ii,jj; int nn=8;
int[] x = new int[nn+1]; int vetka, derevo;
for (v=1; v<=9; v++)
{ x[1]=v; Console.Write(v);
for (e=0; e<=9; e++)
{ x[2]=e; for (t=0; t<=9; t++)
{ x[3]=t; for (k=0; k<=9; k++)
{ x[4]=k; for (a=0; a<=9; a++)
{ x[5]=a; for (r=0; r<=9; r++)
{ x[6]=r; for (o=0; o<=9; o++)
{ x[7]=o; for (d=1; d<=9; d++)
{ x[8]=d; // rextester.com/DDEQA74512
for (ii = 1; ii <= nn-1; ii++)
for (jj = ii+1; jj <= nn; jj++)
if (x[ii] == x[jj]) { goto dav; }
vetka = 10000*v +1000*e +100*t +10*k+a;
derevo = d*100000+e*10000+r*1000+e*100+v*10+o;
if (vetka + vetka == derevo) // jdoodle.com/a/6cSu
Console.WriteLine("\n {0} {1} ", vetka, derevo);
dav:; }} }} }} }}
Console.ReadKey();
}}}
rebus.bat
csc.exe /nologo rebusx.cs
pause
rebusx.exe
Онлайн компиляторы
jdoodle.com
onlinegdb.com
rextester.com
ide.geeksforgeeks.org
wandbox.org
ideone.com
techiedelight.com/compiler
cpp C++ jdoodle.com/a/6cSs rextester.com/BLAZ43522
py Python jdoodle.com/a/6dn5 rextester.com/GAV77378
cs C# jdoodle.com/a/6cSu rextester.com/DDEQA74512
js JavaScript jdoodle.com/h/2YH
qbasic qb64 jdoodle.com/a/6cSw
Cryptarithm alphametic
Puzzle where letters replace numbers
is solved in several programming languages
and there is a program that is a component of program
in language of highest level basic qbasic qb64
solving a dozen alphanumeric puzzles cryptorithm
or in 5 minutes it is redone by letters less
and formula and signs can be any
Feature: letters extreme 0 can not
be that accelerates algorithm from +25% to +50%
order of letters in cycles does not affect formulas
and several solutions are possible or without a solution
Архив Crypta Rithm Rebus 50 kB QB64 qbasic 50 кБ
kenokeno.ucoz.ru/rar/CryptaRithmRebus.rar
Файлы Files
kenokeno.ucoz.ru/doc/REBUS.docx
kenokeno.ucoz.ru/doc/REBUS.pdf
| 
