Board Logo
« Alphametic puzzle SOLVER »

Welcome Guest. Please Login or Register.
Dec 12th, 2017, 10:05am


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 hotthread  Author  Topic: Alphametic puzzle SOLVER  (Read 287 times)
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3142
xx Alphametic puzzle SOLVER
« Thread started on: Jul 8th, 2017, 05:18am »

Alphametic puzzle SOLVER

Hello. If you never heard of word "Alphametic" before then read
Wiki::Verbal arithmetic.

Got it? It's puzzles of type "SEND + MORE = MONEY".
Rules are:
Each letter represents different digit
Leading digit of a multi-digit number must not be zero

Recently we had several threads concerning these
Basic coding, which turned to these puzzles from Reply#39 (page 3)
and Words = Numbers, Code Puzzles,
Words = Numbers, Code Puzzle #2
with more puzzles.

So. normally these puzzles were written for pen-and-paper - and you could do it if you love that kind of stuff - but with BASIC you could exchange time spent with pen and paper to time spent coding ;)

There are several (very similar actually) codes to solve

Code:
"ONE + ONE + ONE + ONE = TEN" 
 

puzzle in a first thread.

I'll add mine here just to show how easy it is

Code:
for o = 0 to 9
    for n = 0 to 9
        for e = 0 to 9
            one=o*100+n*10+e
            for t = 0 to 9
                SCAN  'so you can break it if it takes forever
                ten=t*100+e*10+n
                if ten = 4*one then print  ten; "= 4*";one
            next
        next
    next
next 
 

It cuts some corners - did not check (Rules) above, but I'm sure you can add them quite easily (or check first thread again).

Adding more digits just involve more loops, right?
Sure it will take longer... may be too long for 8 digits and more. May be using permutations can help - I didn't try, search around this/LB forum.

But.
The challenge is not to solve single puzzle, hard-coding loops and checks.
The task is - (Quoting Bplus):

Quote:
To create a Generic Puzzle Solver ie given any Word Puzzle Equation say:

PuzzleEq$ = "NOON + MOON + SOON = JUNE"

Plugging ONLY that line into my Generic Puzzle Solver, I get the solution back in under 24 hours ;-))

Is it even possible? ;)
Likely it is. I have something working for
"ONE + ONE + ONE + ONE = TEN" puzzle.
It's variation of brute-force method with nested loops above.
There sure another ways, and some of them probably better (and/ or faster).
Again, some corners are cut.
No check for (Rules) above.
More essential, loops are hard-coded. So it hopefully work for any puzzle with 4 different letters (It does work for "I + DID = TOO").
But not with any other number of letters.

Hey, but it was just an example.
So,
Gentlemen, Start Your Engines!



Code:
Code:
PuzzleEq$ = "ONE + ONE + ONE + ONE = TEN"
'PuzzleEq$ = "I + DID = TOO"
global nLetters 'never be more then 10. So probably are arrays. So we could skip DIM

print PuzzleEq$
print "------------------------------------------"

nLetters=0
ops$ = "+-*/="
happened$=""
for i = 1 to len(PuzzleEq$)
    c$=mid$(PuzzleEq$, i, 1)
    'print c$
    if instr(ops$+" ", c$) =0 then
        if instr(happened$, c$) =0 then
            nLetters= nLetters+1
            letter$(nLetters)= c$
            happened$=happened$+c$
        end if
    end if
next

for i = 1 to nLetters
    print  letter$(i)
next

if  nLetters<>4 then print "Sorry it works only for 4 different letters": end

part1$=word$(PuzzleEq$, 1, "=")
part2$=word$(PuzzleEq$, 2, "=")

print "--------------------"
for i1 = 0 to 9
    v(1)=i1
    for i2 = 0 to 9
        v(2)=i2
        for i3 = 0 to 9
            v(3)=i3
            for i4 = 0 to 9
                SCAN    'so we can break it
                v(4)=i4
                part1=evalSum(part1$)
                part2=evalWrd(part2$)
                'print part1$, part1
                'print part2$, part2
                if part1 = part2 then print  showSum$(part1$) ;" = ";part2
            next
        next
    next
next
print "--no more solutions--"
end

function evalWrd(wrd$)
    wrd$=trim$(wrd$)
    res=0
    for i = 1 to len(wrd$)
        c$=mid$(wrd$,i,1)
        'find that letter. Get corresponding value
        for j = 1 to nLetters
            if c$= letter$(j) then v = v(j): exit for
        next
        res=res*10+v
    next
    evalWrd = res
end function

function evalSum(sum$)
    evalSum = 0
    i = 0
    while 1
        i=i+1
        addend$=word$(sum$,i,"+")
        if addend$="" then exit function
        evalSum = evalSum+evalWrd(addend$)
    wend
end function

function showSum$(sum$)
    showSum$ = ""
    i = 0
    while 1
        i=i+1
        addend$=word$(sum$,i,"+")
        if addend$="" then exit while
        showSum$ = showSum$;" + ";evalWrd(addend$)
    wend
    showSum$ = mid$(showSum$,3)
end function

 

User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1229
xx Re: Alphametic puzzle SOLVER
« Reply #1 on: Jul 8th, 2017, 07:47am »

Cool!

EDIT: (Oh, Rod does have the rules up.)

Another part of challenge might be to find clever phrases that take only a few letters to code.

Like Rod's "I + DID = TOO" 4 letters run quick!

APPEND:
Code:
' W=N Puzzles Generic Solution.txt for JB (B+=MGA) 2017-07-07

' Plug-in the word equation in the next line     *** use lower case letters ***
wEq$ = "one + one + one + one = ten"
wEq$ = "noon + moon + soon = june"

wEq$ = "this + is + not + with = which"
'start 2:51 PM solutions at 6:00 PM 81% Done before 6:45 PM code modified since
' nearly 4 hours for 8 letters is not satisfactory!

'Rod's new one today
wEq$ = "i + did = too"

timeStart = time$("seconds")
' identify the letters involved and whether they are first letters in a word
index = 1
while word$(wEq$, index) <> ""
    w$ = word$(wEq$, index)
    for i = 1 to len(w$)
        c$ = mid$(w$, i, 1)
        if not(instr("=+-*/^%=", c$)) then
            if i = 1 then
                if not(instr(firstLetters$, c$)) then firstLetters$ = firstLetters$;c$
            end if
            if not(instr(letters$, c$)) then letters$ = letters$;c$
        end if
    next
    index = index + 1
wend
nLetters = len(letters$)
nFirstLetters = len(firstLetters$)
nNumbers = 10 ^ nLetters - 1
zeros$ =""
for i = 1 to nLetters
    zeros$ = zeros$ + "0"
next

cls

for i = 0 to nNumbers
    scan
    if i mod 1000 = 0 then
        locate 1, 1
        print "Progress: "; i/nNumbers; nStr$
    end if
    'convert number to string
    nStr$ = right$(zeros$;str$(i), nLetters)

    repeatF = 0 'set repeat Flag if nStr$ has repeated digit
    for j = 1 to nLetters - 1
      if instr( mid$(nStr$, j + 1), mid$(nStr$, j, 1) ) then repeatF = 1 : exit for
    next

    if repeatF = 0 then 'continue processing if nStr$ does not repeat a digit

        'nStr$ is now code values for letters but if any firstLetters$ = 0 no good
        flzF = 0 'set first letter zero Flag if = 0 in nStr$
        for j = 1 to nFirstLetters
            position = instr(letters$, mid$(firstLetters$, j, 1))
            if mid$(nStr$, position, 1) = "0" then flzF = 1 : exit for
        next
        if flzF = 0 then 'translate the puzzle equation into digits to test
            'if debug2 then print nStr$ : input "OK "; temp

            'initialize for word equation test
            index = 1 : lastOperator$ = "" : leftSide = 0
            while word$(wEq$, index) <> ""

                w$ = word$(wEq$, index)

                if index mod 2 = 0 then 'look for operator
                    lastOperator$ = w$

                else 'build a number and then check last operator

                    b$ = ""
                    for k = 1 to len(w$)
                        letter$ = mid$(w$, k, 1)
                        lposition = instr(letters$, letter$)
                        digit$ = mid$(nStr$, lposition, 1)
                        b$ = b$;digit$
                    next
                    bVal = val(b$)

                    'now process the number built
                    select case lastOperator$

                        case "=" 'at last check our equation
                            rightSide = bVal
                            if rightSide = leftSide and rightSide <> 0 then 'solution
                                'lets print something nice
                                wSo$ = ""  'decode wEq$ with the digit soltion
                                for k = 1 to len(wEq$)
                                    c$ = mid$(wEq$, k, 1)
                                    if 96 < asc(c$) and asc(c$) < 123 then
                                        lposition = instr(letters$, c$)
                                        digit$ = mid$(nStr$, lposition, 1)
                                        wSo$ = wSo$;digit$ 
                                    else
                                        wSo$ = wSo$;c$
                                    end if
                                next

                                'show what we found
                                solutionCnt = solutionCnt + 1
                                locate 0, 1 + solutionCnt * 3
                                print " For the Puzzle: ";wEq$
                                print "     A Solution: ";wSo$

                            'else done with last word but no exit while needed
                            end if

                        'do the math
                        case "" : leftSide = bVal
                        case "+": leftSide = leftSide + bVal
                        case "-": leftSide = leftSide - bVal
                        case "*": leftSide = leftSide * bVal
                        case "/": leftSide = leftSide / bVal
                        case "^": leftSide = leftSide ^ bVal

                    end select

                end if 'type of word number of operator

                index = index + 1
            wend 'end testing the wEq$ with nStr$ 


        end if 'no first letter zero flag
    end if 'no repeats flag
next
'signal done
timeEnd = time$("seconds")
solutionCnt = solutionCnt + 1
locate 0, 1 + solutionCnt * 3
print:print "Done in ";timeEnd - timeStart;" seconds or ";int((timeEnd - timeStart)/60);" mins."

 


output: Code:
Progress: 0.900090018999


 For the Puzzle: i + did = too
     A Solution: 9 + 191 = 200


Done in 4 seconds or 0 mins.


 


Don't see anyone attempting a power ^ puzzle, but I'm ready to solve it!

On to cutting the time down for 8 letters plus! ;)

2017-07-08 EDIT made to code, it is noted in the next post.
« Last Edit: Jul 8th, 2017, 11:32am by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1229
xx Re: Alphametic puzzle SOLVER
« Reply #2 on: Jul 8th, 2017, 10:15am »

JB ^ B + B = JEM

;D

APPEND: testing the above, I found a section of my code that needed repair:

Code:
                        case "" : leftSide = bVal
                        case "+": leftSide = leftSide + bVal
                        case "-": leftSide = leftSide - bVal
                        case "*": leftSide = leftSide * bVal
                        case "/": leftSide = leftSide / bVal
                        case "^": leftSide = leftSide ^ bVal

 


I forgot to capitalize the V in bVal after case "+". ( I had only tested the + and = operators until I made up the new Word equation and tested ^ operator. )
« Last Edit: Jul 8th, 2017, 11:31am by bplus » User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3629
xx Re: Alphametic puzzle SOLVER
« Reply #3 on: Jul 8th, 2017, 1:16pm »

Just want to say, that running till 10^n nicely solves problem of unknown amount of nested loops.

Have to see why your code so much faster
8|
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3629
xx Re: Alphametic puzzle SOLVER
« Reply #4 on: Jul 8th, 2017, 2:16pm »

Quote:
Have to see why your code so much faster

Because finding letter position with INSTR is faster then looping till equal.
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1229
xx Re: Alphametic puzzle SOLVER
« Reply #5 on: Jul 8th, 2017, 4:08pm »

Code:
Progress: 0.99900199899999999


 For the Puzzle: no + no + too = late
     A Solution: 74 + 74 + 944 = 1092


Done in 257 seconds or 4 mins.
 


faster?

Hi tsh73,

Didn't you say you had a generic solver about 2 days before my post? I have been eagerly waiting to see how you approached problem and was under impression your 8 letter solution ran faster than my 3 hours 54 min time.
User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3629
xx Re: Alphametic puzzle SOLVER
« Reply #6 on: Jul 9th, 2017, 02:12am »

Re: Quote:
faster

on my computer, your code solves
"NO + NO + TOO = LATE"
2x faster then code based on example in first post
(+ all checks and using single loop from 0 to 10^n-1)

Re: Quote:
Didn't you say you had a generic solver

well, I have, but not sure it qualify.

My program takes a puzzle string - and writes program to solve exactly that puzzle! With brute-force, needed amount of nested loops, and some of loops starting from 1.
Now if you run _that_ program it sure be faster then trying to interpret condition each time.
Here it is:
Code:
'puzzle solver
'tsh73 July 2017
'it generates program to solve given puzzle!
'then you run it and get answer
PuzzleEq$ = "ONE + ONE + ONE + ONE = TEN"   'fast, less then second
'PuzzleEq$ = "NO + NO + TOO = LATE"         'longer, half a minute
'PuzzleEq$ = "NOON + MOON + SOON = JUNE"    'longer still, 3 minutes
'PuzzleEq$ = "THIS + IS + NOT + WITH = WHICH"   'half an hour

dim letter$(10), value(10), from(10)
dim words$(10), wordEq$(10)
nLetters=0
ops$ = "+-*/="
happened$=""
for i = 1 to len(PuzzleEq$)
    c$=mid$(PuzzleEq$, i, 1)
    'print c$
    if instr(ops$+" ", c$) =0 then
        if instr(happened$, c$) =0 then
            nLetters= nLetters+1
            letter$(nLetters)= c$
            happened$=happened$+c$
        end if
    end if
next

'print "Number of letters ";nLetters
for i = 1 to nLetters
'    print  letter$(i)
next

nWords=0
happened$=" "
i=0
while 1
    i=i+1
    c$=word$(PuzzleEq$, i)
    if c$="" then exit while
    'print c$
    if instr(ops$, c$) =0 then
        if instr(happened$, " "+c$+" ") =0 then
            nWords= nWords+1
             words$(nWords)= c$
            happened$=happened$+c$+" "
        end if
    end if
wend

'print "Number of words "; nWords
for i = 1 to  nWords
    'print words$(i)
next

for i = 1 to nLetters
    for j = 1 to nWords
        if letter$(i) = left$(words$(j),1) then from(i)=1
    next
next

'print "Letter", "count from"
for i = 1 to nLetters
    'print  letter$(i), from(i)
next

for i = 1 to nLetters
    'print  tab(i*4-4); "for "; letter$(i);" = "; from(i);" to 9"
next
for i = nLetters to 1 step -1
    'print  tab(i*4-4); "next"
next

for j = 1 to nWords
    eq$=""
    for i = 1 to len(words$(j))
        c$=mid$(words$(j), i, 1)
        if  eq$ = "" then
            eq$ =c$
        else
            eq$="(";eq$;"*10+";c$;")"
        end if
    next
    wordEq$(j)=eq$
    'print words$(j), eq$
next

testEq$=" "
i = 0
while 1
    i=i+1
    c$=word$(PuzzleEq$, i)
    if c$="" then exit while
    'print i, c$
    if instr(ops$, c$) <>0 then
        testEq$=testEq$+c$+" "
    else
        'find word
        for j = 1 to nWords
            if c$ = words$(j) then exit for    'should be there. Check omitted
        next
        testEq$=testEq$+wordEq$(j)+" "
    end if
wend
'print "Test equation"
'print testEq$

qq$=chr$(34)
'print
'print "whole program"
print "'========================================================"
print "'Program for solving"
print "'";tab(4);qq$;PuzzleEq$;qq$
print "'puzzle"
print "'========================================================"
print "print ";qq$;"============================================";qq$
print "print ";qq$;PuzzleEq$;qq$
print "print ";qq$;"============================================";qq$
print "t0=time$(";qq$;"ms";qq$;")"
for i = 1 to nLetters
    print  tab(i*4-4); "for "; letter$(i);" = "; from(i);" to 9"
next
'if digits are different
print "IF ";
for i = 1 to nLetters
    for j = i+1 to nLetters
        print  tab(4);letter$(i);"<>";letter$(j);" and_"
    next
next
print tab(4);"1 THEN"
'if test equation holds
print  tab(4);"IF ";testEq$;" THEN"
'for i = 1 to nLetters
'    print "print "+qq$+letter$(i)+"="+qq$;";";letter$(i)
'next
for j = 1 to nWords
    print tab(4*2);"print "+qq$+ words$(j)+"="+qq$;";";wordEq$(j)
next

print tab(4*2);"print"
print  tab(4);"END IF"
print "END IF"
for i = nLetters to 1 step -1
    print  tab(i*4-4); "next"
next
print "print ";qq$;"-- no more solutions --";qq$
print "t1=time$(";qq$;"ms";qq$;")"
print "print ";qq$;"Time taken, ms ";qq$;";t1-t0"
 
« Last Edit: Jul 9th, 2017, 02:22am by tsh73 » User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3142
xx Re: Alphametic puzzle SOLVER
« Reply #7 on: Jul 9th, 2017, 10:29am »

Neat strategy, will be hard to beat.
User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1229
xx Re: Alphametic puzzle SOLVER
« Reply #8 on: Jul 9th, 2017, 10:43am »

"well I have, but not sure it qualify."

Hi tsh73,

I'd say, It qualifies! It gets the job done for any puzzle given it.

I also say, It is brilliant! smiley
What a time saver for getting the puzzle equation coded!

I knew you would have interesting approach when you mentioned the 8 letter puzzle time.

I am wondering (only a little) why not write a file directly?
User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1229
xx Re: Alphametic puzzle SOLVER
« Reply #9 on: Jul 10th, 2017, 09:06am »

Hi,

I tried something with tsh73 code:
Code:

'' still gathering parts and pieces of program to write
'' convert words of eq with plug in letters to build wordEq$() array
'for j = 1 to nWords
'    eq$=""
'    for i = 1 to len(words$(j))
'        c$=mid$(words$(j), i, 1)
'        if  eq$ = "" then
'            eq$ =c$
'        else
'                                      '' extremely clever line here!!!
'            eq$="(";eq$;"*10+";c$;")"  '' take letter and mult by 10's column
'                                       '' but wouldn't VAL(letter;letter;.. ) work better?
'        end if
'    next
'    wordEq$(j)=eq$
'    'print words$(j), eq$
'next

'' alternate build, yep! works
for j = 1 to nWords
    eq$="val("
    for i = 1 to len(words$(j))
        c$=mid$(words$(j), i, 1)
        if i = len(words$(j)) then eq$ = eq$;c$ else eq$ = eq$;c$;";"
    next
    eq$ = eq$;")"
    wordEq$(j)=eq$
    'print words$(j), eq$
next

 


(All comments and double comments are mine except one, I think.)

6 of 1, half dozen of another?

tsh73 code method extremely clever!

mine, too simple?

I wonder which is faster?
« Last Edit: Jul 10th, 2017, 09:08am by bplus » User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3629
xx Re: Alphametic puzzle SOLVER
« Reply #10 on: Jul 11th, 2017, 2:25pm »

Run generated code for
Code:
NO + NO + TOO = LATE 

puzzle. With numeric condition
Code:
   IF  (N*10+O) + (N*10+O) + ((T*10+O)*10+O) = (((L*10+A)*10+T)*10+E)  THEN
 

it reported
Code:
Time taken, ms 23984 

With string condition
Code:
   IF  val(N;O) + val(N;O) + val(T;O;O) = val(L;A;T;E) THEN 

it reported
Code:
Time taken, ms 32610 

So at least on my machine, numeric way is faster.
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1229
xx Re: Alphametic puzzle SOLVER
« Reply #11 on: Jul 11th, 2017, 3:04pm »

Yes, confirmed on my system with
NOON + MOON + SOON = JUNE

tsh73 clever number build: 209 seconds.

bplus val(string concatenation): 241 seconds

(Rounded to seconds)

Oh I just thought of another alternate build to try!
Stay tuned... wink
User IP Logged

B+
tsh73
JB-Supporter


member is offline

Avatar




PM

Gender: Male
Posts: 3629
xx Re: Alphametic puzzle SOLVER
« Reply #12 on: Jul 11th, 2017, 4:07pm »

Ok I have something more
If 7 letter puzzle takes 3 minutes, 8 letters take half an hour, then 10 letters should probably take whole day?

There is a way to solve 10 letters puzzle - faster
If we have 10 letters then different numbers make permutation digits from 0 to 9
By defunition of permutation - each digit happens only once!
No need to check if digits repeat
Smaller amount of total iterations - number of permutations is 10! (factorial) - is 3 628 800, that is 2 755 times smaller then 10^10 (for 10 nested loops)
Code here
LB::[RC] Permutations
variant 2 enumerates all permutations in 8 minutes on my machine.
Tweaking generator program to write condition via array a()
(and adding "this letter could not be 0" condition by hand)
gives us this program that solves 10-letters puzzle in 12 minutes on my machine.
Code:
'Permutations
'translation from: PowerBASIC

'========================================================
'Program for solving
'  "HAVE + A + GREAT = SUMMER"
'puzzle
'========================================================
print "============================================"
print "HAVE + A + GREAT = SUMMER"
print "============================================"

n=10    'all permutations in 8 minutes
dim a(n+1)  '+1 needed due to bug in LB that checks loop condition
    '   until (i=0) or (a(i)<a(i+1))
    'before executing i=i-1 in loop body.
'init permutation
for i=1 to n: a(i)=i-1: next
t0=time$("ms")
do
  'printing out pernutation (check)
  'for i=1 to n: print a(i);: next: print
'puzzle code
'check if first letter is not 0
if a(1)<>0 and a(2)<>0 and a(5)<>0 and a(8)<>0 then
'check word
   IF  (((a(1)*10+a(2))*10+a(3))*10+a(4)) + a(2) + ((((a(5)*10+a(6))*10+a(4))*10+a(2))*10+a(7)) = (((((a(8)*10+a(9))*10+a(10))*10+a(10))*10+a(4))*10+a(6))  THEN
       print "HAVE=";(((a(1)*10+a(2))*10+a(3))*10+a(4))
       print "A=";a(2)
       print "GREAT=";((((a(5)*10+a(6))*10+a(4))*10+a(2))*10+a(7))
       print "SUMMER=";(((((a(8)*10+a(9))*10+a(10))*10+a(10))*10+a(4))*10+a(6))
       print
   END IF
end if
'-----------
  i=n
  do
    i=i-1
  loop until (i=0) or (a(i)<a(i+1))
  j=i+1
  k=n
  while j<k
    'swap a(j),a(k)
    tmp=a(j): a(j)=a(k): a(k)=tmp
    j=j+1
    k=k-1
  wend
  if i>0 then
    j=i+1
    while a(j)<a(i)
      j=j+1
    wend
    'swap a(i),a(j)
    tmp=a(j): a(j)=a(i): a(i)=tmp
  end if
loop until i=0
t1=time$("ms")
print "Time taken ";t1-t0
 


I don't know it permutation thing could be adapted to generate 8-letter sequences from 0..9 without repeats.
But I could put condition for 8-leter puzzle ("THIS + IS + NOT + WITH = WHICH") into this permutation code (for 10 letters), so two letters just went unused.
And it still be faster (12-15 minutes) then nested loops (half an hour).

EDIT but it will print same solution several times (for permutations differing in unused extra digits only).

PS Last thing. I took all the puzzles from this page
User IP Logged

Q: "And if I took your codes and compile them, and sell them for a profit"?
A: Go ahead. I had my share of good then I coded it for fun, if you can make better use of it - please do.
(enjoying JB 1.01 on WinXP, netbook and desktop)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1229
xx Re: Alphametic puzzle SOLVER
« Reply #13 on: Jul 11th, 2017, 6:47pm »

Hi Tsh73,

What a great link! and what a great solution to 10 letters!

I myself have found the source of the time drain working another alternate build to your general solver.

It produced this code program for the NOON + MOON + SOON = JUNE. I thought I'd show the program it wrote with my alternate build as it would be easier to understand the change I made in code to the program writer.
Code:
'========================================================
'Program for solving
'  "NOON + MOON + SOON = JUNE"
'puzzle
'========================================================
print "============================================"
print "NOON + MOON + SOON = JUNE"
print "============================================"
t0=time$("ms")
for N = 1 to 9
   for O = 0 to 9
       for M = 1 to 9
           for S = 1 to 9
               for J = 1 to 9
                   for U = 0 to 9
                       for E = 0 to 9
test$ = N;O;M;S;J;U;E : rFlag = 0
for ii = 1 to 7 - 1
    if instr(mid$(test$, ii + 1), mid$(test$, ii, 1)) then rFlag = 1
next
if rFlag = 0 then
   IF  (((N*10+O)*10+O)*10+N) + (((M*10+O)*10+O)*10+N) + (((S*10+O)*10+O)*10+N) = (((J*10+U)*10+N)*10+E)  THEN
       print "NOON=";(((N*10+O)*10+O)*10+N)
       print "MOON=";(((M*10+O)*10+O)*10+N)
       print "SOON=";(((S*10+O)*10+O)*10+N)
       print "JUNE=";(((J*10+U)*10+N)*10+E)
       print
   END IF
END IF
                       next
                   next
               next
           next
       next
   next
next
print "-- no more solutions --"
t1=time$("ms")
print "Time taken, ms ";t1-t0


 


This code took 1473047 ms to run! That is 24.55 minutes compared to 3.47 minutes from original tsh73 general solver.

So it's checking for repeats specially the way I was doing it that was taking all the extra time!

Oh dang! I didn't exit for >:(

APPEND: OK, exit for, did cut time by more than half
11.91 minutes instead of 24.55 minutes yahoo!

Still pretty far from 3.47 minutes!

So from different approaches, we learn the time drain is coming from checking for repeats.
« Last Edit: Jul 11th, 2017, 7:12pm by bplus » User IP Logged

B+
zzz000abc
Full Member
ImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 265
xx Re: Alphametic puzzle SOLVER
« Reply #14 on: Oct 7th, 2017, 11:44am »

Hi,
I think generalized solution for this involves solving a problem on pattern recognition.But not sure whether is it addressed or not in JB/LB forum.
User IP Logged

Pages: 1 2  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls