Today I doodled with constraint logic programming in Forth.

A classic beginner's example is the SEND+MORE=MONEY puzzlee,
where each letter stands for a digit in the range of 0 to 9
and which when concatenated represent a decimal number.
Constraint: all digits must be different.

I came up with the little program below using brute force.
It does its job, but ugly. Any ideas for improvement and acceleration?
Or syntax-wise? (Prolog does it so much more nicely).

\ ##### SENDMORE.FTH #####
: ALLDIFFERENT {: a b c d e f g h -- flag :}
false
a b = IF exit THEN
a c = IF exit THEN
a d = IF exit THEN
a e = IF exit THEN
a f = IF exit THEN
a g = IF exit THEN
a h = IF exit THEN
b c = IF exit THEN
b d = IF exit THEN
b e = IF exit THEN
b f = IF exit THEN
b g = IF exit THEN
b h = IF exit THEN
c d = IF exit THEN
c e = IF exit THEN
c f = IF exit THEN
c g = IF exit THEN
c h = IF exit THEN
d e = IF exit THEN
d f = IF exit THEN
d g = IF exit THEN
d h = IF exit THEN
e f = IF exit THEN
e g = IF exit THEN
e h = IF exit THEN
f g = IF exit THEN
f h = IF exit THEN
g h = IF exit THEN
drop true ;

: SENDMOREMONEY {: | s e n d m o r y s1 s2 s3 ct -- :}
0 to ct
1 9 DO i to s
1 9 DO i to m
1 9 DO i to e
1 9 DO i to d
0 9 DO i to n
0 9 DO i to o
0 9 DO i to r
0 9 DO i to y
s e n d m o r y alldifferent
IF
ct 1+ to ct
s 1000 * e 100 * + n 10 * + d + to s1
m 1000 * o 100 * + r 10 * + e + to s2
m 10000 * o 1000 * + n 100 * + e 10 * + y + to s3
s1 s2 + s3 =
IF
cr ." S=" s . ." E=" e . ." N=" n . ." D=" d .
cr ." M=" m . ." O=" o . ." R=" r . ." Y=" y .
cr ." " s1 . cr ." +" s2 . cr ." -----" cr ." " s3 .
THEN
THEN
-1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP
." loops:" ct . ;

SENDMOREMONEY

tiistai 7. helmikuuta 2023 klo 20.34.08 UTC+2 minf...@arcor.de kirjoitti:
> Today I doodled with constraint logic programming in Forth.
>
> A classic beginner's example is the SEND+MORE=MONEY puzzlee,
> where each letter stands for a digit in the range of 0 to 9
> and which when concatenated represent a decimal number.
> Constraint: all digits must be different.
>
> I came up with the little program below using brute force.
> It does its job, but ugly. Any ideas for improvement and acceleration?
> Or syntax-wise? (Prolog does it so much more nicely).
>
> \ ##### SENDMORE.FTH #####
> : ALLDIFFERENT {: a b c d e f g h -- flag :}
> false
> a b = IF exit THEN
> a c = IF exit THEN
> a d = IF exit THEN
> a e = IF exit THEN
> a f = IF exit THEN
> a g = IF exit THEN
> a h = IF exit THEN
> b c = IF exit THEN
> b d = IF exit THEN
> b e = IF exit THEN
> b f = IF exit THEN
> b g = IF exit THEN
> b h = IF exit THEN
> c d = IF exit THEN
> c e = IF exit THEN
> c f = IF exit THEN
> c g = IF exit THEN
> c h = IF exit THEN
> d e = IF exit THEN
> d f = IF exit THEN
> d g = IF exit THEN
> d h = IF exit THEN
> e f = IF exit THEN
> e g = IF exit THEN
> e h = IF exit THEN
> f g = IF exit THEN
> f h = IF exit THEN
> g h = IF exit THEN
> drop true ;
>
> : SENDMOREMONEY {: | s e n d m o r y s1 s2 s3 ct -- :}
> 0 to ct
> 1 9 DO i to s
> 1 9 DO i to m
> 1 9 DO i to e
> 1 9 DO i to d
> 0 9 DO i to n
> 0 9 DO i to o
> 0 9 DO i to r
> 0 9 DO i to y
> s e n d m o r y alldifferent
> IF
> ct 1+ to ct
> s 1000 * e 100 * + n 10 * + d + to s1
> m 1000 * o 100 * + r 10 * + e + to s2
> m 10000 * o 1000 * + n 100 * + e 10 * + y + to s3
> s1 s2 + s3 =
> IF
> cr ." S=" s . ." E=" e . ." N=" n . ." D=" d .
> cr ." M=" m . ." O=" o . ." R=" r . ." Y=" y .
> cr ." " s1 . cr ." +" s2 . cr ." -----" cr ." " s3 .
> THEN
> THEN
> -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP
> ." loops:" ct . ;
>
> SENDMOREMONEY

I have solved this one using 8th, mainly as a test for building permutations and letting the eval do the job:

----------------------------------

needs string/translate

private

: generate \ a n --
a:new ( 0 a:push ) 2 pick times -rot
over 4 pick w:exec
0
repeat
dup 2 pick n:< if
3 pick over a:_@ over n:< if
dup 2 n:mod !if
2 pick 0 2 pick a:<> drop
else
2 pick 4 pick 2 pick a:_@ 2 pick a:<> drop
then
2 pick 5 pick w:exec
3 pick over a:@ n:1+ 2 pick swap a:! drop
drop 0
else
3 pick over 0 a:! drop
n:1+
then
else
break
then
again 3drop drop ;

public
\ Note: callback word receives array reference
: a:permutations \ a w --
swap a:len #p:generate ;

\ Now, try solving alphametics...

"SEND MORE + MONEY =" constant alphametics
alphametics /[A-Z]/ r:/ ' s:cmp a:sort ' s:= a:uniq "" a:join constant unique-chars

: any-leading-zeros?
/\b[0]/ r:match nip ;

: app:main
"0123456789" null s:/
( 0 8 a:slice "" a:join
alphametics unique-chars rot s:translate dup any-leading-zeros? !if
dup eval if
. cr break
else
drop
then
else
drop
then ) a:permutations ;

----------------------------------
Running it gives:

root@DietPi:~# /opt/8th/bin/rpi64/8th permute.8th
9567 1085 + 10652 =
root@DietPi:~#

tiistai 7. helmikuuta 2023 klo 21.15.56 UTC+2 Jali Heinonen kirjoitti:
> tiistai 7. helmikuuta 2023 klo 20.34.08 UTC+2 minf...@arcor.de kirjoitti:
> > Today I doodled with constraint logic programming in Forth.
> >
> > A classic beginner's example is the SEND+MORE=MONEY puzzlee,
> > where each letter stands for a digit in the range of 0 to 9
> > and which when concatenated represent a decimal number.
> > Constraint: all digits must be different.
> >
> > I came up with the little program below using brute force.
> > It does its job, but ugly. Any ideas for improvement and acceleration?
> > Or syntax-wise? (Prolog does it so much more nicely).
> >
> > \ ##### SENDMORE.FTH #####
> > : ALLDIFFERENT {: a b c d e f g h -- flag :}
> > false
> > a b = IF exit THEN
> > a c = IF exit THEN
> > a d = IF exit THEN
> > a e = IF exit THEN
> > a f = IF exit THEN
> > a g = IF exit THEN
> > a h = IF exit THEN
> > b c = IF exit THEN
> > b d = IF exit THEN
> > b e = IF exit THEN
> > b f = IF exit THEN
> > b g = IF exit THEN
> > b h = IF exit THEN
> > c d = IF exit THEN
> > c e = IF exit THEN
> > c f = IF exit THEN
> > c g = IF exit THEN
> > c h = IF exit THEN
> > d e = IF exit THEN
> > d f = IF exit THEN
> > d g = IF exit THEN
> > d h = IF exit THEN
> > e f = IF exit THEN
> > e g = IF exit THEN
> > e h = IF exit THEN
> > f g = IF exit THEN
> > f h = IF exit THEN
> > g h = IF exit THEN
> > drop true ;
> >
> > : SENDMOREMONEY {: | s e n d m o r y s1 s2 s3 ct -- :}
> > 0 to ct
> > 1 9 DO i to s
> > 1 9 DO i to m
> > 1 9 DO i to e
> > 1 9 DO i to d
> > 0 9 DO i to n
> > 0 9 DO i to o
> > 0 9 DO i to r
> > 0 9 DO i to y
> > s e n d m o r y alldifferent
> > IF
> > ct 1+ to ct
> > s 1000 * e 100 * + n 10 * + d + to s1
> > m 1000 * o 100 * + r 10 * + e + to s2
> > m 10000 * o 1000 * + n 100 * + e 10 * + y + to s3
> > s1 s2 + s3 =
> > IF
> > cr ." S=" s . ." E=" e . ." N=" n . ." D=" d .
> > cr ." M=" m . ." O=" o . ." R=" r . ." Y=" y .
> > cr ." " s1 . cr ." +" s2 . cr ." -----" cr ." " s3 .
> > THEN
> > THEN
> > -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP
> > ." loops:" ct . ;
> >
> > SENDMOREMONEY
> I have solved this one using 8th, mainly as a test for building permutations and letting the eval do the job:
>
> ----------------------------------
>
> needs string/translate
>
> private
>
> : generate \ a n --
> a:new ( 0 a:push ) 2 pick times -rot
> over 4 pick w:exec
> 0
> repeat
> dup 2 pick n:< if
> 3 pick over a:_@ over n:< if
> dup 2 n:mod !if
> 2 pick 0 2 pick a:<> drop
> else
> 2 pick 4 pick 2 pick a:_@ 2 pick a:<> drop
> then
> 2 pick 5 pick w:exec
> 3 pick over a:@ n:1+ 2 pick swap a:! drop
> drop 0
> else
> 3 pick over 0 a:! drop
> n:1+
> then
> else
> break
> then
> again 3drop drop ;
>
> public
>
> \ Note: callback word receives array reference
> : a:permutations \ a w --
> swap a:len #p:generate ;
>
> \ Now, try solving alphametics...
>
> "SEND MORE + MONEY =" constant alphametics
> alphametics /[A-Z]/ r:/ ' s:cmp a:sort ' s:= a:uniq "" a:join constant unique-chars
>
> : any-leading-zeros?
> /\b[0]/ r:match nip ;
>
> : app:main
> "0123456789" null s:/
> ( 0 8 a:slice "" a:join
> alphametics unique-chars rot s:translate dup any-leading-zeros? !if
> dup eval if
> . cr break
> else
> drop
> then
> else
> drop
> then ) a:permutations ;
>
> ----------------------------------
> Running it gives:
>
> root@DietPi:~# /opt/8th/bin/rpi64/8th permute.8th
> 9567 1085 + 10652 =
> root@DietPi:~#
Sorry about losing indentations and making code hard to read....

Jali Heinonen schrieb am Dienstag, 7. Februar 2023 um 20:22:24 UTC+1:
> tiistai 7. helmikuuta 2023 klo 21.15.56 UTC+2 Jali Heinonen kirjoitti:
> > tiistai 7. helmikuuta 2023 klo 20.34.08 UTC+2 minf...@arcor.de kirjoitti:
> > > Today I doodled with constraint logic programming in Forth.
> > >
> > > A classic beginner's example is the SEND+MORE=MONEY puzzlee,
> > > where each letter stands for a digit in the range of 0 to 9
> > > and which when concatenated represent a decimal number.
> > > Constraint: all digits must be different.
> > >
> > > I came up with the little program below using brute force.
> > > It does its job, but ugly. Any ideas for improvement and acceleration?
> > > Or syntax-wise? (Prolog does it so much more nicely).
> > >
> > > \ ##### SENDMORE.FTH #####
> > > : ALLDIFFERENT {: a b c d e f g h -- flag :}
> > > false
> > > a b = IF exit THEN
> > > a c = IF exit THEN
> > > a d = IF exit THEN
> > > a e = IF exit THEN
> > > a f = IF exit THEN
> > > a g = IF exit THEN
> > > a h = IF exit THEN
> > > b c = IF exit THEN
> > > b d = IF exit THEN
> > > b e = IF exit THEN
> > > b f = IF exit THEN
> > > b g = IF exit THEN
> > > b h = IF exit THEN
> > > c d = IF exit THEN
> > > c e = IF exit THEN
> > > c f = IF exit THEN
> > > c g = IF exit THEN
> > > c h = IF exit THEN
> > > d e = IF exit THEN
> > > d f = IF exit THEN
> > > d g = IF exit THEN
> > > d h = IF exit THEN
> > > e f = IF exit THEN
> > > e g = IF exit THEN
> > > e h = IF exit THEN
> > > f g = IF exit THEN
> > > f h = IF exit THEN
> > > g h = IF exit THEN
> > > drop true ;
> > >
> > > : SENDMOREMONEY {: | s e n d m o r y s1 s2 s3 ct -- :}
> > > 0 to ct
> > > 1 9 DO i to s
> > > 1 9 DO i to m
> > > 1 9 DO i to e
> > > 1 9 DO i to d
> > > 0 9 DO i to n
> > > 0 9 DO i to o
> > > 0 9 DO i to r
> > > 0 9 DO i to y
> > > s e n d m o r y alldifferent
> > > IF
> > > ct 1+ to ct
> > > s 1000 * e 100 * + n 10 * + d + to s1
> > > m 1000 * o 100 * + r 10 * + e + to s2
> > > m 10000 * o 1000 * + n 100 * + e 10 * + y + to s3
> > > s1 s2 + s3 =
> > > IF
> > > cr ." S=" s . ." E=" e . ." N=" n . ." D=" d .
> > > cr ." M=" m . ." O=" o . ." R=" r . ." Y=" y .
> > > cr ." " s1 . cr ." +" s2 . cr ." -----" cr ." " s3 .
> > > THEN
> > > THEN
> > > -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP
> > > ." loops:" ct . ;
> > >
> > > SENDMOREMONEY
> > I have solved this one using 8th, mainly as a test for building permutations and letting the eval do the job:
> >
> > ----------------------------------
> >
> > needs string/translate
> >
> > private
> >
> > : generate \ a n --
> > a:new ( 0 a:push ) 2 pick times -rot
> > over 4 pick w:exec
> > 0
> > repeat
> > dup 2 pick n:< if
> > 3 pick over a:_@ over n:< if
> > dup 2 n:mod !if
> > 2 pick 0 2 pick a:<> drop
> > else
> > 2 pick 4 pick 2 pick a:_@ 2 pick a:<> drop
> > then
> > 2 pick 5 pick w:exec
> > 3 pick over a:@ n:1+ 2 pick swap a:! drop
> > drop 0
> > else
> > 3 pick over 0 a:! drop
> > n:1+
> > then
> > else
> > break
> > then
> > again 3drop drop ;
> >
> > public
> >
> > \ Note: callback word receives array reference
> > : a:permutations \ a w --
> > swap a:len #p:generate ;
> >
> > \ Now, try solving alphametics...
> >
> > "SEND MORE + MONEY =" constant alphametics
> > alphametics /[A-Z]/ r:/ ' s:cmp a:sort ' s:= a:uniq "" a:join constant unique-chars
> >
> > : any-leading-zeros?
> > /\b[0]/ r:match nip ;
> >
> > : app:main
> > "0123456789" null s:/
> > ( 0 8 a:slice "" a:join
> > alphametics unique-chars rot s:translate dup any-leading-zeros? !if
> > dup eval if
> > . cr break
> > else
> > drop
> > then
> > else
> > drop
> > then ) a:permutations ;
> >
> > ----------------------------------
> > Running it gives:
> >
> > root@DietPi:~# /opt/8th/bin/rpi64/8th permute.8th
> > 9567 1085 + 10652 =
> > root@DietPi:~#
> Sorry about losing indentations and making code hard to read....

Thank you! Permutations could narrow the search space significantly indeed.
I have to think about how to implement them in standard Forth in order to replace
those eight nested DO..LOOPs with one single permutation loop.

On Tuesday, February 7, 2023 at 7:34:08 PM UTC+1, minf...@arcor.de wrote:
> Today I doodled with constraint logic programming in Forth.
[..]
> SENDMOREMONEY

It is unclear what you want to do?

Is it:
1. Given 8 numbers randomly drawn from the set { 0 .. 9 }, find all concatenations that do not start
with '0', and where all 8 numbers are different?

2. Is it to test if a particular set of 8 single-digit decimal numbers form one of the valid combinations?

Assuming it is 2, then:

Fill an array a with 0, 1, ... 9
Inspect the 8 numbers sequentially with index i
if the first number is '0', stop with result FALSE.
if a[i] = -1, stop with result FALSE ( we saw this number before )
store -1 in a[i] ( seen this number )
Stop with result TRUE.

This will also work
-marcel

On Tuesday, February 7, 2023 at 7:34:08 PM UTC+1, minf...@arcor.de wrote:
> Today I doodled with constraint logic programming in Forth.
[..]
> SENDMOREMONEY

It is unclear what you want to do?

Is it:
1. Given 8 numbers randomly drawn from the set { 0 .. 9 }, find all concatenations that do not start
with '0', and where all 8 numbers are different?

2. Is it to test if a particular set of 8 single-digit decimal numbers form one of the valid
combinations?

Assuming it is 2, then:

Fill an array a with 0, 1, ... 9
Inspect the 8 numbers sequentially with index i
if the first number is '0', stop with result FALSE.
if a[i] = -1, stop with result FALSE ( we saw this number before )
store -1 in a[i] ( seen this number )
Stop with result TRUE.

-marcel

On 07/02/2023 20:00, minf...@arcor.de wrote:
> Jali Heinonen schrieb am Dienstag, 7. Februar 2023 um 20:22:24 UTC+1:
>
> Thank you! Permutations could narrow the search space significantly indeed.
> I have to think about how to implement them in standard Forth in order to replace
> those eight nested DO..LOOPs with one single permutation loop.

There's Heaps algorithm and an implementation of it at
https://groups.google.com/g/comp.lang.forth/c/xZO_hScBJiI/m/BapQC8g0DQAJ

--
Gerry

"minf...@arcor.de" <minforth@arcor.de> writes:
>I came up with the little program below using brute force.
>It does its job, but ugly. Any ideas for improvement and acceleration?
>Or syntax-wise? (Prolog does it so much more nicely).

For performance:

Have a map of already-occupied digits, and only scan through those
that are still free; that eliminates ALLDIFFERENT.

You could start with the last digits, and compute the digits of MONEY
from the others rather than scanning it.

I wonder if BacForth (from Michael Gassanenko, supports backtracking)
would be of advantage here, but I suspect not.

Writing about it, I get inspired to try it myself:

create occupationmap 10 allot
\ each entry is 0 if free, non-0 if occupied

: occupation! ( f u -- )
occupationmap + c! ;

: occupy< ( u -- u )
]] dup >r occupationmap + c@ 0= if true r@ occupation! r@ [[ ; immediate

: >occupy ( -- )
]] false r@ occupation! then rdrop [[ ; immediate

: try< ( run-time: -- u )
]] 10 0 do i occupy< [[ ; immediate

: >try ( run-time: -- )
]] >occupy loop [[ ; immediate

: .solution {: s e n d m o r y -- :}
s 0 .r e 0 .r n 0 .r d 0 .r ." +"
m 0 .r o 0 .r r 0 .r e 0 .r ." ="
m 0 .r o 0 .r n 0 .r e 0 .r y 0 .r ;

: smm ( -- )
\ SEND+MORE=MONEY
occupationmap 10 erase
1 occupy< {: m :}
try< {: d :}
try< {: e :}
d e + 10 /modf {: carry0 :} occupy< {: y :}
try< {: n :}
e carry0 - n - 10 /modf negate {: carry1 :} occupy< {: r :}
n carry1 - e - 10 /modf negate {: carry2 :} occupy< {: o :}
o carry2 - m - 10 /modf negate m = if occupy< {: s :}
cr s e n d m o r y .solution
>occupy else drop then
>occupy
>occupy
>try
>occupy
>try
>try
>occupy ;

This assumes that MONEY has no leading 0. Another option is to start
with M, derive S from that, which reduces the search space for the
rest; I did this for M, but not for S. I guess that with enough
smarts you need very few guesses, because this is a puzzle from the
times before computers.

Performance (with gforth-fast on a 4GHz Skylake):

minforth Ertl
6_428_853_392 39_964 cycles:u
19_625_679_081 114_372 instructions:u

Actually the Ertl solution was so fast that I ran it 1M times (and
divided the result by 1M) to make the Gforth startup overhead
insignificant.

One could probably make it even faster by keeping the occupation map
as a bitmap on the stack.

You can download the programs from

http://www.complang.tuwien.ac.at/forth/programs/sendmore.fth
http://www.complang.tuwien.ac.at/forth/programs/sendmore-ae.4th

- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: https://forth-standard.org/
EuroForth 2022: https://euro.theforth.net

anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>Writing about it, I get inspired to try it myself:

And here's the code with execution conts in parentheses, produced with

gforth coverage.fs ~/forth/sendmore-ae.4th -e "smm cr bw-cover .coverage bye"

\ SEND+MORE=MONEY program by M. Anton Ertl 2023

create occupationmap 10 allot
\ each entry is 0 if free, non-0 if occupied

: occupation! ( 1252) ( f u -- )
( 1252) occupationmap + c! ;

: occupy< ( 8) ( u -- u )
( 8) ]] dup >r occupationmap + c@ 0= if true r@ occupation! r@ [[ ; immediate

: >occupy ( 8) ( -- )
( 8) ]] false r@ occupation! then rdrop [[ ; immediate

: try< ( 3) ( run-time: -- u )
( 3) ]] 10 0 do i occupy< [[ ; immediate

: >try ( 3) ( run-time: -- )
( 3) ]] >occupy loop [[ ; immediate

: .solution ( 1) {: s e n d m o r y -- :}
( 1) s 0 .r e 0 .r n 0 .r d 0 .r ." +"
( 1) m 0 .r o 0 .r r 0 .r e 0 .r ." ="
( 1) m 0 .r o 0 .r n 0 .r e 0 .r y 0 .r ;

: smm ( 1) ( -- )
( 1) \ SEND+MORE=MONEY
( 1) occupationmap 10 erase
( 1) 1 occupy< ( 1) {: m :}
( 1) try< ( 10) ( 9) {: d :}
( 9) try< ( 90) ( 72) {: e :}
( 72) d e + 10 /modf {: carry0 :} occupy< ( 48) {: y :}
( 48) try< ( 480) ( 288) {: n :}
( 288) e carry0 - n - 10 /modf negate {: carry1 :} occupy< ( 140) {: r :}
( 140) n carry1 - e - 10 /modf negate {: carry2 :} occupy< ( 67) {: o :}
( 67) o carry2 - m - 10 /modf negate m = if ( 15) occupy< ( 1) {: s :}
( 1) cr s e n d m o r y .solution
( 1) >occupy ( 15) else ( 52) drop then ( 67)
( 67) >occupy ( 140)
( 140) >occupy ( 288)
( 288) >try ( 480) ( 48)
( 48) >occupy ( 72)
( 72) >try ( 90) ( 9)
( 9) >try ( 10) ( 1)
( 1) >occupy ( 1) ;

Note that the two numbers after TRY< come from the DO and the IF
compiled by the TRY<: the first number is the number of loop
iterations, the second number time times the non-occupation test has
succeeded. E.g., the first TRY< is performed once "( 1)" at the start
of the line, it then performs 10 occupation checks, 9 of which
succeed.

- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: https://forth-standard.org/
EuroForth 2022: https://euro.theforth.net

Marcel Hendrix schrieb am Mittwoch, 8. Februar 2023 um 10:23:15 UTC+1:
> On Tuesday, February 7, 2023 at 7:34:08 PM UTC+1, minf...@arcor.de wrote:
> > Today I doodled with constraint logic programming in Forth.
> [..]
> > SENDMOREMONEY
>
> It is unclear what you want to do?
>

It is a very old mathematical puzzle, looking simple but surprisingly difficult
to solve by hand. Unique solution:
SEND + MORE = 9567 + 1085 = 10652 = MONEY

The manual way to go is to reduce the search space by applying algebraic
properties of addition operations like
M <> 0
S+M >= 9
etc

For computation the absolute benchmark would be CLP programming languages
like SICSTUS Prolog:
sum(S, E, N, D, M, O, R, Y) +:
1000*S + 100*E + 10*N + D
+ 1000*M + 100*O + 10*R + E
#= 10000*M + 1000*O + 100*N + 10*E + Y.

This is the complete program to solve the puzzle!
The magic happens within the #= operator.

Forth as an imperative language does not have an automatic backtracking solver
built in like Prolog, therefore in Forth one has to implement walking a search space
through manual looping or using generators.

On Wednesday, February 8, 2023 at 1:51:05 PM UTC+1, minf...@arcor.de wrote:
> Marcel Hendrix schrieb am Mittwoch, 8. Februar 2023 um 10:23:15 UTC+1:
> > On Tuesday, February 7, 2023 at 7:34:08 PM UTC+1, minf...@arcor.de wrote:
[..]
> SEND + MORE = 9567 + 1085 = 10652 = MONEY

Oh. All 3 numbers have a '5' and that is not a problem... I will have to look
elsewhere to get an exact description.

-marcel

"minf...@arcor.de" <minforth@arcor.de> writes:
>For computation the absolute benchmark would be CLP programming languages
>like SICSTUS Prolog:
>sum(S, E, N, D, M, O, R, Y) +:
> 1000*S + 100*E + 10*N + D
> + 1000*M + 100*O + 10*R + E
> #= 10000*M + 1000*O + 100*N + 10*E + Y.
>
>This is the complete program to solve the puzzle!
>The magic happens within the #= operator.

Not even alldifferent([S,E,N,D,M,O,R,Y])? No way to influence the
labeling? Too much magic.

For comparsion, I did not do SEND+MORE=MONEY for my master's thesis
<https://www.complang.tuwien.ac.at/Diplomarbeiten/ertl90.ps.gz>, but I
did some others. E.g., the Forward-checking variant of the
N-Queens-Problem looked as follows:

queens(N,L):-
length(L,N),
L in 1..N,
alldifferent(L),
safe(L),
labeling(L).

length([],0).
length([X|Y],N):- N>0, plus(N1,1,N), length(Y,N1).

safe([]).
safe([X|Xs]):-
noattack(X,Xs),
safe(Xs).

noattack(X,L):- noattack(X,L,1).

noattack(X,[],Nb).
noattack(X,[Y|Ys],Nb):-
notsum(X,Nb,Y),
notsum(Y,Nb,X),
Nb1 is Nb+1,
noattack(X,Ys,Nb1).

notsum(X,Y,Z):- notplus(X,Y,Z).

labeling([]).
labeling([X|Y]):- indomain(X), labeling(Y).

And this allowed to, e.g., refine the labeling for a more efficient
order of variables and values used in labeling (shown in Abbildung 6.6
and 6.7).

- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: https://forth-standard.org/
EuroForth 2022: https://euro.theforth.net

Anton Ertl schrieb am Mittwoch, 8. Februar 2023 um 18:48:49 UTC+1:
> "minf...@arcor.de" <minf...@arcor.de> writes:
> >For computation the absolute benchmark would be CLP programming languages
> >like SICSTUS Prolog:
> >sum(S, E, N, D, M, O, R, Y) +:
> > 1000*S + 100*E + 10*N + D
> > + 1000*M + 100*O + 10*R + E
> > #= 10000*M + 1000*O + 100*N + 10*E + Y.
> >
> >This is the complete program to solve the puzzle!
> >The magic happens within the #= operator.
> Not even alldifferent([S,E,N,D,M,O,R,Y])? No way to influence the
> labeling? Too much magic.

This justified remark comes from my too abbreviated example. If you want to see
the car and not just the motor, here it is:

:- use_module(library(clpfd)).

mm([S,E,N,D,M,O,R,Y], Type) :-
domain([S,E,N,D,M,O,R,Y], 0, 9), % step 1
S#>0, M#>0,
all_different([S,E,N,D,M,O,R,Y]), % step 2
sum(S,E,N,D,M,O,R,Y),
labeling(Type, [S,E,N,D,M,O,R,Y]). % step 3

sum(S, E, N, D, M, O, R, Y) :-
1000*S + 100*E + 10*N + D
+ 1000*M + 100*O + 10*R + E
#= 10000*M + 1000*O + 100*N + 10*E + Y.

| ?- mm([S,E,N,D,M,O,R,Y], []).
D = 7,
E = 5,
M = 1,
N = 6,
O = 0,
R = 8,
S = 9,
Y = 2

minf...@arcor.de schrieb am Mittwoch, 8. Februar 2023 um 19:10:51 UTC+1:
> Anton Ertl schrieb am Mittwoch, 8. Februar 2023 um 18:48:49 UTC+1:
> > "minf...@arcor.de" <minf...@arcor.de> writes:
> > >For computation the absolute benchmark would be CLP programming languages
> > >like SICSTUS Prolog:
> > >sum(S, E, N, D, M, O, R, Y) +:
> > > 1000*S + 100*E + 10*N + D
> > > + 1000*M + 100*O + 10*R + E
> > > #= 10000*M + 1000*O + 100*N + 10*E + Y.
> > >
> > >This is the complete program to solve the puzzle!
> > >The magic happens within the #= operator.
> > Not even alldifferent([S,E,N,D,M,O,R,Y])? No way to influence the
> > labeling? Too much magic.
> This justified remark comes from my too abbreviated example. If you want to see
> the car and not just the motor, here it is:
>
> :- use_module(library(clpfd)).
>
> mm([S,E,N,D,M,O,R,Y], Type) :-
> domain([S,E,N,D,M,O,R,Y], 0, 9), % step 1
> S#>0, M#>0,
> all_different([S,E,N,D,M,O,R,Y]), % step 2
> sum(S,E,N,D,M,O,R,Y),
> labeling(Type, [S,E,N,D,M,O,R,Y]). % step 3
>
> sum(S, E, N, D, M, O, R, Y) :-
> 1000*S + 100*E + 10*N + D
> + 1000*M + 100*O + 10*R + E
> #= 10000*M + 1000*O + 100*N + 10*E + Y.
> | ?- mm([S,E,N,D,M,O,R,Y], []).
> D = 7,
> E = 5,
> M = 1,
> N = 6,
> O = 0,
> R = 8,
> S = 9,
> Y = 2

P. S. FWIW my old playhorse had been BProlog, not as versatile as alpha male
Sicstus, but still a joy to use. BProlog example (now the car) in some few lines:

sendmore(Digits) :-
Digits = [S,E,N,D,M,O,R,Y], % Create variables
Digits :: [0..9], % Associate domains to variables
S #\= 0, % Add. constraints
M #\= 0,
alldifferent(Digits), % all digits must be uniqe
1000*S + 100*E + 10*N + D % Main constraints
+ 1000*M + 100*O + 10*R + E
#= 10000*M + 1000*O + 100*N + 10*E + Y,
labeling(Digits). % Solve it

P. P. S. I like your Queens problem solver! I'll have to study it deeper. Unfortunately
right now the weather here is just too fine for indoor studies. ;-)

"minf...@arcor.de" <minforth@arcor.de> writes:
> A classic beginner's example is the SEND+MORE=MONEY puzzlee,

I spent about an hour messing with the below algorithm in Forth, but got
somewhat bogged down generating the permutations recursively because I
had a DO loop that might have been putting loop indices on the return
stack and interfering with the recursion. I put it aside and did it in
Python (below). I may get back to the Forth version, but meanwhile,
this was much easier:

from itertools import permutations
from functools import reduce

def main():
def digits(*ds): return reduce(lambda a,b: 10*a+b, ds, 0)

for x1,x2,s,e,n,d,m,o,r,y in permutations(range(10)):
if x1 <= x2 or m == 0: continue
send = digits(s,e,n,d)
more = digits(m,o,r,e)
money = digits(m,o,n,e,y)
if send+more==money: print(send,more,money)
main()

Output:

$ time python3 smm.py
9567 1085 10652

real 0m3.966s
user 0m3.960s
sys 0m0.001s

Le mardi 7 février 2023 à 18:34:08 UTC, minf...@arcor.de a écrit :
> Today I doodled with constraint logic programming in Forth.
>
> A classic beginner's example is the SEND+MORE=MONEY puzzlee,
> where each letter stands for a digit in the range of 0 to 9
> and which when concatenated represent a decimal number.
> Constraint: all digits must be different.
>
> I came up with the little program below using brute force.
> It does its job, but ugly. Any ideas for improvement and acceleration?
> Or syntax-wise? (Prolog does it so much more nicely).
>
> \ ##### SENDMORE.FTH #####
> : ALLDIFFERENT {: a b c d e f g h -- flag :}
> false
> a b = IF exit THEN
> a c = IF exit THEN
> a d = IF exit THEN
> a e = IF exit THEN
> a f = IF exit THEN
> a g = IF exit THEN
> a h = IF exit THEN
> b c = IF exit THEN
> b d = IF exit THEN
> b e = IF exit THEN
> b f = IF exit THEN
> b g = IF exit THEN
> b h = IF exit THEN
> c d = IF exit THEN
> c e = IF exit THEN
> c f = IF exit THEN
> c g = IF exit THEN
> c h = IF exit THEN
> d e = IF exit THEN
> d f = IF exit THEN
> d g = IF exit THEN
> d h = IF exit THEN
> e f = IF exit THEN
> e g = IF exit THEN
> e h = IF exit THEN
> f g = IF exit THEN
> f h = IF exit THEN
> g h = IF exit THEN
> drop true ;
>
> : SENDMOREMONEY {: | s e n d m o r y s1 s2 s3 ct -- :}
> 0 to ct
> 1 9 DO i to s
> 1 9 DO i to m
> 1 9 DO i to e
> 1 9 DO i to d
> 0 9 DO i to n
> 0 9 DO i to o
> 0 9 DO i to r
> 0 9 DO i to y
> s e n d m o r y alldifferent
> IF
> ct 1+ to ct
> s 1000 * e 100 * + n 10 * + d + to s1
> m 1000 * o 100 * + r 10 * + e + to s2
> m 10000 * o 1000 * + n 100 * + e 10 * + y + to s3
> s1 s2 + s3 =
> IF
> cr ." S=" s . ." E=" e . ." N=" n . ." D=" d .
> cr ." M=" m . ." O=" o . ." R=" r . ." Y=" y .
> cr ." " s1 . cr ." +" s2 . cr ." -----" cr ." " s3 .
> THEN
> THEN
> -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP
> ." loops:" ct . ;
>
> SENDMOREMONEY
Hi everybody,
Here is a program that gives all possible solutions (there are 25), written in gforth.

s" random.fs" included

: not 0= ;

0 value s
0 value e
0 value n
0 value d
0 value m
0 value o
0 value r
0 value y

: send s 10 * e + 10 * n + 10 * d + ;
: more m 10 * o + 10 * r + 10 * e + ;
: money m 10 * o + 10 * n + 10 * e + 10 * y + ;

: is_send+more=money_? send more + money - 0= ;

create flags_chosen_vals 10 allot
flags_chosen_vals 10 erase
create flags_chosen_sendmory 8 allot
flags_chosen_sendmory 8 erase

: choose 10 random ;
: chosen flags_chosen_vals + 1 swap c! ;
: chosen_? flags_chosen_vals + c@ ;

: chosen_var_set flags_chosen_sendmory + 1 swap c! ;
: chosen_var_get flags_chosen_sendmory + c@ ;

: chosen--> dup chosen ;

: chosen_vars_init flags_chosen_sendmory 8 erase ;
: chosen_vals_init flags_chosen_vals 10 erase ;

: to_s choose chosen--> to s 0 chosen_var_set ;
: to_e choose dup chosen_? if drop else chosen--> to e 1 chosen_var_set then ;
: to_n choose dup chosen_? if drop else chosen--> to n 2 chosen_var_set then ;
: to_d choose dup chosen_? if drop else chosen--> to d 3 chosen_var_set then ;
: to_m choose dup chosen_? if drop else chosen--> to m 4 chosen_var_set then ;
: to_o choose dup chosen_? if drop else chosen--> to o 5 chosen_var_set then ;
: to_r choose dup chosen_? if drop else chosen--> to r 6 chosen_var_set then ;
: to_y choose dup chosen_? if drop else chosen--> to y 7 chosen_var_set then ;
: gen_sendmory
chosen_vals_init
chosen_vars_init
to_s
begin 1 chosen_var_get not while to_e repeat
begin 2 chosen_var_get not while to_n repeat
begin 3 chosen_var_get not while to_d repeat
begin 4 chosen_var_get not while to_m repeat
begin 5 chosen_var_get not while to_o repeat
begin 6 chosen_var_get not while to_r repeat
begin 7 chosen_var_get not while to_y repeat
;

: .sendmory s . e . n . d . m . o . r . y . ;

: sendmory_as_number s 10 * e + 10 * n + 10 * d + 10 * m + 10 * o + 10 * r + 10 * y + ;

1000 value max_results_size
create results max_results_size cells allot
0 value result_counter

: to_results
sendmory_as_number
result_counter 0 ?do
dup i cells results + @ = if
drop unloop exit
then
loop
result_counter cells results + !
result_counter 1+ to result_counter
result_counter cr . ." solutions found"
;

: go_sendmoremoney
0 to result_counter
0 do
gen_sendmory
is_send+more=money_? if
( cr .sendmory)
to_results
( unloop exit)
then
loop
cr cr result_counter . ." solutions found"
;

: .send send 4 .r ;
: .more more 4 .r ;
: .money money 5 .r ;

: to_sendmory
10000000 /mod to s
1000000 /mod to e
100000 /mod to n
10000 /mod to d
1000 /mod to m
100 /mod to o
10 /mod to r
to y
;

: .send+more=money .send ." + " .more ." = " .money ;

: .results
." sol_num sendmory send + more = money"
result_counter 0 ?do
cr i 7 .r 3 spaces
i cells results + @ dup
. 3 spaces
to_sendmory .send+more=money
loop
;
: go go_sendmoremoney cr .results ;

10000000 go

Bye

Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 09:00:14 UTC+1:
> > SENDMOREMONEY
> Hi everybody,
> Here is a program that gives all possible solutions (there are 25), written in gforth.

Thanks! 25 solutions appear when M is allowed to be zero.
Even more solutions appear when the all-digits-different constraint is taken out.

I am fascinated by those many completely different approaches in this thread.

Marcel Hendrix schrieb am Mittwoch, 8. Februar 2023 um 14:21:38 UTC+1:
> On Wednesday, February 8, 2023 at 1:51:05 PM UTC+1, minf...@arcor.de wrote:
> > Marcel Hendrix schrieb am Mittwoch, 8. Februar 2023 um 10:23:15 UTC+1:
> > > On Tuesday, February 7, 2023 at 7:34:08 PM UTC+1, minf...@arcor.de wrote:
> [..]
> > SEND + MORE = 9567 + 1085 = 10652 = MONEY
> Oh. All 3 numbers have a '5' and that is not a problem... I will have to look
> elsewhere to get an exact description.
>
Here you go:
https://en.wikipedia.org/wiki/Verbal_arithmetic

Paul Rubin <no.email@nospam.invalid> writes:
>$ time python3 smm.py
>9567 1085 10652
>
>real 0m3.966s
>user 0m3.960s
>sys 0m0.001s

I tried it on my 4GHz Skylake, where it is a little faster (2.54s user
time), but still slower than minforth's version. Cycles and
instructions:

Rubin minforth Ertl
9_969_117_645 6_428_853_392 39_964 cycles:u
31_937_879_569 19_625_679_081 114_372 instructions:u

You only generate 10!=3_628_800 permutations, while minforth generates
100_000_000 variants that he checks for the alldifferent property only
afterwards, but apparently the constant factor of Python3 is so much
worse than that of gforth-fast that minforth's version prevails.

I have now also tried minforth's version on several Forth systems for
performance comparison:

gforth-fast lxf SwiftForth 3.11 VFX 4.72
6_428_853_392 2_025_393_969 9_556_676_271 5_941_247_227 cycles:u
19_625_679_081 5_033_144_283 13_662_547_049 9_003_308_671 instructions:u

Let's see if SwiftForth and VFX are better in newer versions (on a Zen3):

gforth-fast lxf sf 4.0.0-RC52 VFX 64 5.11
5_996_105_179 1_661_344_432 5_205_443_081 6_991_357_051 cycles:u
19_625_279_724 5_033_144_483 11_408_344_112 9_084_604_055 instructions:u

My guess is that the locals in ALLDIFFERENT play a large role in the
performance. Even with the mediocre locals implementation of
SwiftForth and VFX, it's surprising that gforth-fast is so close to
VFX and SwiftForth, even beating the old SwiftForth and the new VFX;
after all, Gforth's locals implementation is not that great, either.
lxf demonstrates that locals can be implemented much faster.

- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: https://forth-standard.org/
EuroForth 2022: https://euro.theforth.net

torstai 9. helmikuuta 2023 klo 10.32.34 UTC+2 Anton Ertl kirjoitti:
> Paul Rubin <no.e...@nospam.invalid> writes:
> >$ time python3 smm.py
> >9567 1085 10652
> >
> >real 0m3.966s
> >user 0m3.960s
> >sys 0m0.001s
> I tried it on my 4GHz Skylake, where it is a little faster (2.54s user
> time), but still slower than minforth's version. Cycles and
> instructions:
>
> Rubin minforth Ertl
> 9_969_117_645 6_428_853_392 39_964 cycles:u
> 31_937_879_569 19_625_679_081 114_372 instructions:u
>
> You only generate 10!=3_628_800 permutations, while minforth generates
> 100_000_000 variants that he checks for the alldifferent property only
> afterwards, but apparently the constant factor of Python3 is so much
> worse than that of gforth-fast that minforth's version prevails.
>
> I have now also tried minforth's version on several Forth systems for
> performance comparison:
>
> gforth-fast lxf SwiftForth 3.11 VFX 4.72
> 6_428_853_392 2_025_393_969 9_556_676_271 5_941_247_227 cycles:u
> 19_625_679_081 5_033_144_283 13_662_547_049 9_003_308_671 instructions:u
>
> Let's see if SwiftForth and VFX are better in newer versions (on a Zen3):
>
> gforth-fast lxf sf 4.0.0-RC52 VFX 64 5.11
> 5_996_105_179 1_661_344_432 5_205_443_081 6_991_357_051 cycles:u
> 19_625_279_724 5_033_144_483 11_408_344_112 9_084_604_055 instructions:u
>
> My guess is that the locals in ALLDIFFERENT play a large role in the
> performance. Even with the mediocre locals implementation of
> SwiftForth and VFX, it's surprising that gforth-fast is so close to
> VFX and SwiftForth, even beating the old SwiftForth and the new VFX;
> after all, Gforth's locals implementation is not that great, either.
> lxf demonstrates that locals can be implemented much faster.
> - anton
> --
> M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
> comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
> New standard: https://forth-standard.org/
> EuroForth 2022: https://euro.theforth.net

Can ALLDIFFERENT be eliminated by using bit presentation for numbers, where bit position directly maps to number? Now, jus bitwise OR all the numbers, bitwise NOT and use bit twiddling trick to get the trailing zero bits to get the first possible different number candidate?

Anton Ertl schrieb am Donnerstag, 9. Februar 2023 um 09:32:34 UTC+1:
> My guess is that the locals in ALLDIFFERENT play a large role in the
> performance.

Put the 8 digits in global values and at least they have not to be copied so
many times around. IMO here we see a price ( implementation differences
put aside ) to be paid for Forth locals that have to be moved away from
the data stack.

Jali Heinonen <jali.heinonen@gmail.com> writes:
>Can ALLDIFFERENT be eliminated by using bit presentation for numbers, where=
> bit position directly maps to number? Now, jus bitwise OR all the numbers,=
> bitwise NOT and use bit twiddling trick to get the trailing zero bits to g=
>et the first possible different number candidate?

Certainly. Or you can use the in-memory occupation map that I used.
I just took that part from my program and adapted minforth's program
to use it, resulting in

http://www.complang.tuwien.ac.at/forth/programs/sendmore-hybrid.4th

Performance on Zen3 (with gforth-fast):

minforth hybrid
6_065_825_773 306_696_520 cycles:u
19_625_595_531 689_828_810 instructions:u

This approach certainly reduces the execution time; by far not as much
as testing each digit as soon as possible (or directly generating it),
like sendmore-ae.4th, but then sendmore-ae.4th needed more effort when
writing, and I had to fix two bugs, whereas sendmore-hybrid.4th worked
first time I tried it.

And here's the program with execution counts:

\ SEND+MORE=MONEY program by M. Anton Ertl 2023

create occupationmap 10 allot
\ each entry is 0 if free, non-0 if occupied

: occupation! ( 4170422) ( f u -- )
( 4170422) occupationmap + c! ;

: occupy< ( 8) ( u -- u )
( 8) ]] dup >r occupationmap + c@ 0= if true r@ occupation! r@ [[ ; immediate

: >occupy ( 8) ( -- )
( 8) ]] false r@ occupation! then rdrop [[ ; immediate

: try< ( 8) ( run-time: -- u )
( 8) ]] 10 0 do i occupy< [[ ; immediate

: >try ( 8) ( run-time: -- )
( 8) ]] >occupy loop [[ ; immediate

: .solution ( 1) {: s e n d m o r y -- :}
( 1) s 0 .r e 0 .r n 0 .r d 0 .r ." +"
( 1) m 0 .r o 0 .r r 0 .r e 0 .r ." ="
( 1) m 0 .r o 0 .r n 0 .r e 0 .r y 0 .r ;

: smm ( 1) ( -- )
( 1) \ SEND+MORE=MONEY
( 1) occupationmap 10 erase
( 1) try< ( 10) ( 10) {: s :} s 0 > if ( 9)
( 9) try< ( 90) ( 81) {: m :} m 0 > if ( 72)
( 72) try< ( 720) ( 576) {: e :}
( 576) try< ( 5760) ( 4032) {: d :}
( 4032) try< ( 40320) ( 24192) {: n :}
( 24192) try< ( 241920) ( 120960) {: o :}
( 120960) try< ( 1209600) ( 483840) {: r :}
( 483840) try< ( 4838400) ( 1451520) {: y :}
( 1451520) s 1000 * e 100 * + n 10 * + d + {: send :}
( 1451520) m 1000 * o 100 * + r 10 * + e + {: more :}
( 1451520) m 10000 * o 1000 * + n 100 * + e 10 * + y + {: money :}
( 1451520) send more + money = if ( 1)
( 1) cr s e n d m o r y .solution
( 1) then ( 1451520)
( 1451520) >try ( 4838400) ( 483840)
( 483840) >try ( 1209600) ( 120960)
( 120960) >try ( 241920) ( 24192)
( 24192) >try ( 40320) ( 4032)
( 4032) >try ( 5760) ( 576)
( 576) >try ( 720) ( 72)
( 72) then ( 81) >try ( 90) ( 9)
( 9) then ( 10) >try ( 10) ( 1) ;

- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: https://forth-standard.org/
EuroForth 2022: https://euro.theforth.net

"minf...@arcor.de" <minforth@arcor.de> writes:
>Anton Ertl schrieb am Donnerstag, 9. Februar 2023 um 09:32:34 UTC+1:
>> My guess is that the locals in ALLDIFFERENT play a large role in the
>> performance.
>
>Put the 8 digits in global values and at least they have not to be copied so
>many times around. IMO here we see a price ( implementation differences
>put aside ) to be paid for Forth locals that have to be moved away from
>the data stack.

The lxf result demonstrates that locals can be implemented much more
efficiently than in VFX or in SwiftForth. Maybe global variables work
faster on these systems (probably even lxf), but are not a good
solution for larger or reentrant programs.

Plus, in a really good native-code Forth system (beyond what current
Forth systems do), locals will also be more efficient, because they
can be kept in registers, while global variables have to be stored
into memory.

- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: https://forth-standard.org/
EuroForth 2022: https://euro.theforth.net

Another solution ...

marker puzzle1

0 value s
0 value e
0 value n
0 value d
0 value m
0 value o
0 value r
0 value y

: send ( -- n ) d n e s 10 * + 10 * + 10 * + ;
: more ( -- n ) e r o m 10 * + 10 * + 10 * + ;
: money ( -- n ) y e n o m 10 * + 10 * + 10 * + 10 * + ;
: test ( -- f )
send more + money = ;

: all-unique { a u -- f }
begin u 1 > while
a 1+ u 1- a 1 search if 2drop false exit else 2drop then
a 1+ to a u 1- to u
repeat
true ;

: disp ( -- )
cr ." s e n d " s . e . n . d .
cr ." m o r e " m . o . r . e .
cr ." m o n e y " m . o . n . e . y .
cr ;

: dig ( a1 -- a2 n ) dup 1+ swap c@ 48 - ;

: start ( -- )
cr ." Solving... " cr
99999999 1 do
i s>d <# # # # # # # # # #> drop
dig to s
dig to e
dig to n
dig to d
dig to o
dig to r
dig to y
dig to m
drop
i s>d <# # # # # # # # # #> all-unique if
m 0<> if
test if
cr ." success" cr disp
then
then
then
loop ;

bye

Le jeudi 9 février 2023 à 08:13:20 UTC, minf...@arcor.de a écrit :
> Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 09:00:14 UTC+1:
> > > SENDMOREMONEY
> > Hi everybody,
> > Here is a program that gives all possible solutions (there are 25), written in gforth.
> Thanks! 25 solutions appear when M is allowed to be zero.
> Even more solutions appear when the all-digits-different constraint is taken out.
>
> I am fascinated by those many completely different approaches in this thread.
Hi,
For the case of m<>0 (so m must be 1), the same program gives the also the unique result, by selecting the solution with m=1.
To get the unique result directly,one can set 1 to m, and search for the others.
Here is the program (the same as the previous, with some changes)

s" random.fs" included

: not 0= ;

0 value s
0 value e
0 value n
0 value d
0 value m
0 value o
0 value r
0 value y

: send s 10 * e + 10 * n + 10 * d + ;
: more m 10 * o + 10 * r + 10 * e + ;
: money m 10 * o + 10 * n + 10 * e + 10 * y + ;

: is_send+more=money_? send more + money - 0= ;

create flags_chosen_vals 10 allot
flags_chosen_vals 10 erase
create flags_chosen_sendmory 8 allot
flags_chosen_sendmory 8 erase

: choose 10 random ;
: chosen flags_chosen_vals + 1 swap c! ;
: chosen_? flags_chosen_vals + c@ ;

: chosen_var_set flags_chosen_sendmory + 1 swap c! ;
: chosen_var_get flags_chosen_sendmory + c@ ;

: chosen--> dup chosen ;

: chosen_vars_init flags_chosen_sendmory 8 erase ;
: chosen_vals_init flags_chosen_vals 10 erase ;

: to_s choose chosen--> to s 0 chosen_var_set ;
: to_e choose dup chosen_? if drop else chosen--> to e 1 chosen_var_set then ;
: to_n choose dup chosen_? if drop else chosen--> to n 2 chosen_var_set then ;
: to_d choose dup chosen_? if drop else chosen--> to d 3 chosen_var_set then ;
: to_m choose dup chosen_? if drop else chosen--> to m 4 chosen_var_set then ;
: to_o choose dup chosen_? if drop else chosen--> to o 5 chosen_var_set then ;
: to_r choose dup chosen_? if drop else chosen--> to r 6 chosen_var_set then ;
: to_y choose dup chosen_? if drop else chosen--> to y 7 chosen_var_set then ;
: gen_sendmory
chosen_vals_init
1 chosen \ mark digit 1 as already chosen
chosen_vars_init
4 chosen_var_set \ mark m as already chosen
1 to m \ and set to 1

to_s
begin 1 chosen_var_get not while to_e repeat
begin 2 chosen_var_get not while to_n repeat
begin 3 chosen_var_get not while to_d repeat
\ begin 4 chosen_var_get not while to_m repeat
begin 5 chosen_var_get not while to_o repeat
begin 6 chosen_var_get not while to_r repeat
begin 7 chosen_var_get not while to_y repeat
;

: .sendmory s . e . n . d . m . o . r . y . ;

: sendmory_as_number s 10 * e + 10 * n + 10 * d + 10 * m + 10 * o + 10 * r + 10 * y + ;

1000 value max_results_size
create results max_results_size cells allot
0 value result_counter

: to_results
sendmory_as_number
result_counter 0 ?do
dup i cells results + @ = if
drop unloop exit
then
loop
result_counter cells results + !
result_counter 1+ to result_counter
result_counter cr . ." solutions found"
;

: go_sendmoremoney
cr
." solving ..."
0 to result_counter
0 do
gen_sendmory
is_send+more=money_? if
( cr .sendmory)
to_results
unloop exit
then
loop
cr cr result_counter . ." solutions found"
;

: .send send 4 .r ;
: .more more 4 .r ;
: .money money 5 .r ;

: to_sendmory
10000000 /mod to s
1000000 /mod to e
100000 /mod to n
10000 /mod to d
1000 /mod to m
100 /mod to o
10 /mod to r
to y
;

: .send+more=money .send ." + " .more ." = " .money ;

: .results
." sol_num sendmory send + more = money"
result_counter 0 ?do
cr i 7 .r 3 spaces
i cells results + @ dup
. 3 spaces
to_sendmory .send+more=money
loop
;

: .unique_result
cr ." The unique solution is:" cr
cr
." send + more = money"
cr
result_counter 0 ?do
i cells results + @ dup
to_sendmory
m 1 = if
.send+more=money
unloop
exit
then
loop
;

: go go_sendmoremoney cr .unique_result ;

10000000 go

bye