Le jeudi 9 février 2023 à 12:47:02 UTC, Ahmed MELAHI a écrit :
> 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
Hi, again,
In the previous program, there is a result left on the data stack. it must be dropped.
The new version is here

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
;
Click here to read the complete article

Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 13:47:02 UTC+1:
> 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.

Merci de tes contributions! Of course M has to be 1 because it has to be a carry bit.
So you used a mathematical property of one of the constraints to manually reduce your search space.

BTW this shows an interesting common aspect between all the various Forth proposals:
In their manually coded program formulation they freely join/mix/meddle walking the search space with constraint properties.
Therefore many different solutions appear on the table depending on programmer's expertise or preference.

Declarative constraint programming languages don't have to do this (ideally). They go in distinctive not related steps:
1) declare the variable domains ( here: integers ranging from 0 to 9 )
2) span the search space in toto ( here: 8 variables SENDMORY )
3) declare the constraints ( here: M<>0 and SEND+MORE=MONEY and all variables unique)
\ BTW: M<>0 not because of the other constraint but because otherwise MONEY would be written as ONEY ! )
4) solve it.
( of course real CLP programmers also use their optimization toolbelts ... but that's a different story )

So this is a very generic and very versatile approach! One can add/delete/change constraints in one place without
having to rewrite the program. And the best: bug-free from start.

How would a Forth programmer come close to this?

( for fun: try to solve TO+GO=OUT )

torstai 9. helmikuuta 2023 klo 16.24.39 UTC+2 minf...@arcor.de kirjoitti:
> Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 13:47:02 UTC+1:
> > 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.
> Merci de tes contributions! Of course M has to be 1 because it has to be a carry bit.
> So you used a mathematical property of one of the constraints to manually reduce your search space.
>
> BTW this shows an interesting common aspect between all the various Forth proposals:
> In their manually coded program formulation they freely join/mix/meddle walking the search space with constraint properties.
> Therefore many different solutions appear on the table depending on programmer's expertise or preference.
>
> Declarative constraint programming languages don't have to do this (ideally). They go in distinctive not related steps:
> 1) declare the variable domains ( here: integers ranging from 0 to 9 )
> 2) span the search space in toto ( here: 8 variables SENDMORY )
> 3) declare the constraints ( here: M<>0 and SEND+MORE=MONEY and all variables unique)
> \ BTW: M<>0 not because of the other constraint but because otherwise MONEY would be written as ONEY ! )
> 4) solve it.
> ( of course real CLP programmers also use their optimization toolbelts ... but that's a different story )
>
> So this is a very generic and very versatile approach! One can add/delete/change constraints in one place without
> having to rewrite the program. And the best: bug-free from start.
>
> How would a Forth programmer come close to this?
>
> ( for fun: try to solve TO+GO=OUT )

I think, I have to try my bit based idea. I have used it succesfully for a Sudoku solver before and it worked nicely: https://pastebin.com/v5P0hCYA

Le jeudi 9 février 2023 à 14:24:39 UTC, minf...@arcor.de a écrit :
> Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 13:47:02 UTC+1:
> > 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.
> Merci de tes contributions! Of course M has to be 1 because it has to be a carry bit.
> So you used a mathematical property of one of the constraints to manually reduce your search space.
>
> BTW this shows an interesting common aspect between all the various Forth proposals:
> In their manually coded program formulation they freely join/mix/meddle walking the search space with constraint properties.
> Therefore many different solutions appear on the table depending on programmer's expertise or preference.
>
> Declarative constraint programming languages don't have to do this (ideally). They go in distinctive not related steps:
> 1) declare the variable domains ( here: integers ranging from 0 to 9 )
> 2) span the search space in toto ( here: 8 variables SENDMORY )
> 3) declare the constraints ( here: M<>0 and SEND+MORE=MONEY and all variables unique)
> \ BTW: M<>0 not because of the other constraint but because otherwise MONEY would be written as ONEY ! )
> 4) solve it.
> ( of course real CLP programmers also use their optimization toolbelts .... but that's a different story )
>
> So this is a very generic and very versatile approach! One can add/delete/change constraints in one place without
> having to rewrite the program. And the best: bug-free from start.
>
> How would a Forth programmer come close to this?
>
> ( for fun: try to solve TO+GO=OUT )
Hi again,
Prolog implemets CLP (Constrained Logic Programming), so one can solve this type of problems.
There is a prolog compiler written in forth, (see forth dimension magazine)..
One can create a DSL in forth to solve this type of problems.
Yes the solution given previously is specific to this case.
But the approach can be generalized.
Here is the adaptation of the previous program to the case to+go=out. Perhaps, this gives an idea to generalize this approach to solve this type of problems.

s" random.fs" included

: not 0= ;

0 value t
0 value o
0 value g
0 value u

: to_ t 10 * o + ;
: go_ g 10 * o + ;
: out_ o 10 * u + 10 * t + ;

: is_to+go=out_? to_ go_ + out_ - 0= ;

create flags_chosen_vals 10 allot
flags_chosen_vals 10 erase
create flags_chosen_togu 4 allot
flags_chosen_togu 4 erase

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

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

: chosen--> dup chosen ;

: chosen_vars_init flags_chosen_togu 4 erase ;
: chosen_vals_init flags_chosen_vals 10 erase ;

: to_t choose chosen--> to t 0 chosen_var_set ;
: to_o choose dup chosen_? if drop else chosen--> to o 1 chosen_var_set then ;
: to_g choose dup chosen_? if drop else chosen--> to g 2 chosen_var_set then ;
: to_u choose dup chosen_? if drop else chosen--> to u 3 chosen_var_set then ;
: gen_togu
chosen_vals_init
1 chosen \ mark digit 1 as already chosen
chosen_vars_init
1 chosen_var_set \ mark o as already chosen
1 to o \ and set to 1

begin 0 chosen_var_get not while to_t repeat
begin 2 chosen_var_get not while to_g repeat
begin 3 chosen_var_get not while to_u repeat
;

: .togu t . o . g . u . ;

: togu_as_number t 10 * o + 10 * g + 10 * u + ;

1000 value max_results_size
create results max_results_size cells allot
0 value result_counter

: to_results
togu_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_togoout
cr
." solving ..."
0 to result_counter
0 do
gen_togu
is_to+go=out_? if
( cr .togu)
to_results
\ unloop exit
then
loop
cr cr result_counter . ." solutions found"
;

: .to to_ 2 .r ;
: .go go_ 2 .r ;
: .out out_ 3 .r ;

: to_togu
1000 /mod to t
100 /mod to o
10 /mod to g
to u
;

: .to+go=out .to ." + " .go ." = " .out ;

: .results
." sol_num togu to + go = out"
result_counter 0 ?do
cr i 7 .r 3 spaces
i cells results + @ dup
. 3 spaces
to_togu .to+go=out
loop
;

: .unique_result
cr ." The unique solution is:" cr
cr
." to + go = out"
cr
result_counter 0 ?do
i cells results + @
to_togu
o 1 = if
.to+go=out
\ unloop exit
then
loop
;

: go go_togoout cr ( .results) ;

10000000 go

anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
> 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 think it's not just the Python interpreter, but the code itself is
doing a lot of tuple packing and packing, recursively generating the
permutations, passing them to the search routine through a coroutine
mechanism, etc. So there was a lot of memory allocation and freeing,
etc. I will try the same thing in Haskell when I get a chance, and also
try to figure out what is going wrong in my Forth version.

Jali Heinonen <jali.heinonen@gmail.com> writes:
> Can ALLDIFFERENT be eliminated by using bit presentation for numbers,

I did something like that in a permutation generator in Forth, but
something else is going wrong that I haven't yet debugged.

Le jeudi 9 février 2023 à 16:00:10 UTC, Ahmed MELAHI a écrit :
> Le jeudi 9 février 2023 à 14:24:39 UTC, minf...@arcor.de a écrit :
> > Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 13:47:02 UTC+1:
> > > 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.
> > Merci de tes contributions! Of course M has to be 1 because it has to be a carry bit.
> > So you used a mathematical property of one of the constraints to manually reduce your search space.
> >
> > BTW this shows an interesting common aspect between all the various Forth proposals:
> > In their manually coded program formulation they freely join/mix/meddle walking the search space with constraint properties.
> > Therefore many different solutions appear on the table depending on programmer's expertise or preference.
> >
> > Declarative constraint programming languages don't have to do this (ideally). They go in distinctive not related steps:
> > 1) declare the variable domains ( here: integers ranging from 0 to 9 )
> > 2) span the search space in toto ( here: 8 variables SENDMORY )
> > 3) declare the constraints ( here: M<>0 and SEND+MORE=MONEY and all variables unique)
> > \ BTW: M<>0 not because of the other constraint but because otherwise MONEY would be written as ONEY ! )
> > 4) solve it.
> > ( of course real CLP programmers also use their optimization toolbelts .... but that's a different story )
> >
> > So this is a very generic and very versatile approach! One can add/delete/change constraints in one place without
> > having to rewrite the program. And the best: bug-free from start.
> >
> > How would a Forth programmer come close to this?
> >
> > ( for fun: try to solve TO+GO=OUT )
> Hi again,
> Prolog implemets CLP (Constrained Logic Programming), so one can solve this type of problems.
> There is a prolog compiler written in forth, (see forth dimension magazine).
> One can create a DSL in forth to solve this type of problems.
> Yes the solution given previously is specific to this case.
> But the approach can be generalized.
> Here is the adaptation of the previous program to the case to+go=out. Perhaps, this gives an idea to generalize this approach to solve this type of problems.
> s" random.fs" included
>
> : not 0= ;
> 0 value t
> 0 value o
> 0 value g
> 0 value u
>
> : to_ t 10 * o + ;
> : go_ g 10 * o + ;
> : out_ o 10 * u + 10 * t + ;
>
> : is_to+go=out_? to_ go_ + out_ - 0= ;
> create flags_chosen_vals 10 allot
> flags_chosen_vals 10 erase
> create flags_chosen_togu 4 allot
> flags_chosen_togu 4 erase
> : choose 10 random ;
> : chosen flags_chosen_vals + 1 swap c! ;
> : chosen_? flags_chosen_vals + c@ ;
> : chosen_var_set flags_chosen_togu + 1 swap c! ;
> : chosen_var_get flags_chosen_togu + c@ ;
>
> : chosen--> dup chosen ;
>
> : chosen_vars_init flags_chosen_togu 4 erase ;
> : chosen_vals_init flags_chosen_vals 10 erase ;
>
> : to_t choose chosen--> to t 0 chosen_var_set ;
> : to_o choose dup chosen_? if drop else chosen--> to o 1 chosen_var_set then ;
> : to_g choose dup chosen_? if drop else chosen--> to g 2 chosen_var_set then ;
> : to_u choose dup chosen_? if drop else chosen--> to u 3 chosen_var_set then ;
>
> : gen_togu
> chosen_vals_init
> 1 chosen \ mark digit 1 as already chosen
> chosen_vars_init
> 1 chosen_var_set \ mark o as already chosen
> 1 to o \ and set to 1
>
> begin 0 chosen_var_get not while to_t repeat
> begin 2 chosen_var_get not while to_g repeat
> begin 3 chosen_var_get not while to_u repeat
> ;
>
> : .togu t . o . g . u . ;
>
> : togu_as_number t 10 * o + 10 * g + 10 * u + ;
> 1000 value max_results_size
> create results max_results_size cells allot
> 0 value result_counter
>
> : to_results
> togu_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_togoout
> cr
> ." solving ..."
> 0 to result_counter
> 0 do
> gen_togu
> is_to+go=out_? if
> ( cr .togu)
> to_results
> \ unloop exit
> then
> loop
> cr cr result_counter . ." solutions found"
> ;
> : .to to_ 2 .r ;
> : .go go_ 2 .r ;
> : .out out_ 3 .r ;
>
> : to_togu
> 1000 /mod to t
> 100 /mod to o
> 10 /mod to g
> to u
> ;
>
>
> : .to+go=out .to ." + " .go ." = " .out ;
>
> : .results
> ." sol_num togu to + go = out"
> result_counter 0 ?do
> cr i 7 .r 3 spaces
> i cells results + @ dup
> . 3 spaces
> to_togu .to+go=out
> loop
> ;
>
>
> : .unique_result
> cr ." The unique solution is:" cr
> cr
> ." to + go = out"
> cr
> result_counter 0 ?do
> i cells results + @
> to_togu
> o 1 = if
> .to+go=out
> \ unloop exit
> then
> loop
> ;
>
> : go go_togoout cr ( .results) ;
>
> 10000000 go
Hi,
This program takes about 2 ms to give the unique result.
s" random.fs" included

: not 0= ;

0 value t
0 value o
0 value g
0 value u

: to_ t 10 * o + ;
: go_ g 10 * o + ;
: out_ o 10 * u + 10 * t + ;

: is_to+go=out_? to_ go_ + out_ - 0= ;

create flags_chosen_vals 10 allot
flags_chosen_vals 10 erase
create flags_chosen_togu 4 allot
flags_chosen_togu 4 erase

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

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

: chosen--> dup chosen ;

: chosen_vars_init flags_chosen_togu 4 erase ;
: chosen_vals_init flags_chosen_vals 10 erase ;

: to_t choose chosen--> to t 0 chosen_var_set ;
: to_o choose dup chosen_? if drop else chosen--> to o 1 chosen_var_set then ;
: to_g choose dup chosen_? if drop else chosen--> to g 2 chosen_var_set then ;
: to_u choose dup chosen_? if drop else chosen--> to u 3 chosen_var_set then ;
: gen_togu
chosen_vals_init
1 chosen \ mark digit 1 as already chosen
chosen_vars_init
1 chosen_var_set \ mark o as already chosen
1 to o \ and set to 1

begin 0 chosen_var_get not while to_t repeat
begin 2 chosen_var_get not while to_g repeat
begin 3 chosen_var_get not while to_u repeat
;

: .togu t . o . g . u . ;

: togu_as_number t 10 * o + 10 * g + 10 * u + ;

1000 value max_results_size
create results max_results_size cells allot
0 value result_counter

: to_results
togu_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_togoout
cr
." solving ..."
0 to result_counter
0 do
gen_togu
is_to+go=out_? if
( cr .togu)
to_results
unloop exit
then
loop
cr cr result_counter . ." solutions found"
;

: .to to_ 2 .r ;
: .go go_ 2 .r ;
: .out out_ 3 .r ;

: to_togu
1000 /mod to t
100 /mod to o
10 /mod to g
to u
;

: .to+go=out .to ." + " .go ." = " .out ;

: .results
." sol_num togu to + go = out"
result_counter 0 ?do
cr i 7 .r 3 spaces
i cells results + @ dup
. 3 spaces
to_togu .to+go=out
loop
;

: .unique_result
cr ." The unique solution is:" cr
cr
." to + go = out"
cr
result_counter 0 ?do
i cells results + @
to_togu
o 1 = if
.to+go=out
unloop exit
then
loop
;

"minf...@arcor.de" <minforth@arcor.de> writes:
>Declarative constraint programming languages don't have to do this (ideally). They go in distinctive not related steps:
>1) declare the variable domains ( here: integers ranging from 0 to 9 )
>2) span the search space in toto ( here: 8 variables SENDMORY )
>3) declare the constraints ( here: M<>0 and SEND+MORE=MONEY and all variables unique)
>\ BTW: M<>0 not because of the other constraint but because otherwise MONEY would be written as ONEY ! )
>4) solve it.
>( of course real CLP programmers also use their optimization toolbelts ... but that's a different story )

Not sure what step 2 and step 4 means.

Classical generate-and-test (as in your program and in plain Prolog) does:

1) Generate all assignments to all variables
2) test if the assignment is a solution to the problem

With constraint logic programming (CLP) these two steps are reversed:

2a) specify the domains of the variables
2b) specify the other constraints
1) Generate all assignments to all variables (labeling)

As soon as a variable is assigned, constraints on that variable
propagate to the other variables in the constraint. E.g., with the
alldifferent/1 constraint, if one variable receives a value, that
value is removed from all the other variables.

>So this is a very generic and very versatile approach! One can add/delete/change constraints in one place without
>having to rewrite the program. And the best: bug-free from start.

I wish.

>How would a Forth programmer come close to this?

Have a high level that works pretty much the same way, and implement
these high-level features in Forth. I heard that some group coming
from CLP then went on to provide this approach as a C++ library or
somesuch.

- 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:
>The lxf result demonstrates that locals can be implemented much more
>efficiently than in VFX or in SwiftForth.

One reason for the slowness of VFX and SwiftForth is that they produce
many more branch mispredictions (on Zen3):

lxf sf 4.0.0 RC52 vfx64 5.11 RC2
1_661_643_918 5_213_828_602 6_905_863_327 cycles:u
5_033_144_481 11_408_344_624 9_084_604_276 instructions:u
4_371_603 70_048_027 72_169_382 branch-misses

http://www.complang.tuwien.ac.at/forth/programs/sendmore.fth

A misprediction typically costs 20 cycles, so the 66M-68M additional
mispredictions cost 1.3G-1.4G cycles which does not explain all of the
slowdown, but a good part of it.

These mispredictions are caused by the technique of pushing an
additional return address that returns to other code than that where
the last call came from. The hardware return stack for branch
prediction was introduced at least 25 years ago, it's time that Forth
systems accept that reality and let go of this technique.

- 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 Donnerstag, 9. Februar 2023 um 18:06:38 UTC+1:
> "minf...@arcor.de" <minf...@arcor.de> writes:
> >Declarative constraint programming languages don't have to do this (ideally). They go in distinctive not related steps:
> >1) declare the variable domains ( here: integers ranging from 0 to 9 )
> >2) span the search space in toto ( here: 8 variables SENDMORY )
> >3) declare the constraints ( here: M<>0 and SEND+MORE=MONEY and all variables unique)
> >\ BTW: M<>0 not because of the other constraint but because otherwise MONEY would be written as ONEY ! )
> >4) solve it.
> >( of course real CLP programmers also use their optimization toolbelts ... but that's a different story )
> Not sure what step 2 and step 4 means.
>
> Classical generate-and-test (as in your program and in plain Prolog) does:
>
> 1) Generate all assignments to all variables
> 2) test if the assignment is a solution to the problem
>
> With constraint logic programming (CLP) these two steps are reversed:
>
> 2a) specify the domains of the variables
> 2b) specify the other constraints
> 1) Generate all assignments to all variables (labeling)
>
> As soon as a variable is assigned, constraints on that variable
> propagate to the other variables in the constraint. E.g., with the
> alldifferent/1 constraint, if one variable receives a value, that
> value is removed from all the other variables.

We are trying to do things the Forth way and can't use labeling.
Still it can be done without labeling, look here
https://www.swi-prolog.org/pldoc/man?section=clpfd-search

Paul Rubin <no.email@nospam.invalid> writes:
> I will try the same thing in Haskell when I get a chance, and also
> try to figure out what is going wrong in my Forth version.

Here is the Haskell version. CPU time with ghc 8.8.4 -O3 is 0.472s sec
so about 6x the speed of Python3 3.9 on my laptop. In both cases there
are obvious optimizations possible at the expense of complicating the
code slightly, such as generating only half the permutations instead
of throwing away the ones with x0>=x1. GHC 8.8.4 is now somewhat
outdated and newer versions might generate the better code.

Note the type annotation (Int,Int,Int) which tells the compiler that
the values are (64 bit) machine integers. Without the annotation it
would use Integer which is bignums. In that case, cpu time is 1.085s,
so still 3x the speed of Python.

================================================================

import Data.List (permutations)

main = print $ [(send,more,money) :: (Int,Int,Int)
| [x0,x1,s,e,n,d,m,o,r,y] <- permutations [0..9]
, x0 < x1 && m > 0
, let { send=1000*s+100*e+10*n+d;
more=1000*m+100*o+10*r+e;
money=10000*m+1000*o+100*n+10*e+y
}
, send+more == money
]

Paul Rubin schrieb am Donnerstag, 9. Februar 2023 um 20:34:11 UTC+1:
> Paul Rubin <no.e...@nospam.invalid> writes:
> > I will try the same thing in Haskell when I get a chance, and also
> > try to figure out what is going wrong in my Forth version.
> Here is the Haskell version. CPU time with ghc 8.8.4 -O3 is 0.472s sec
> so about 6x the speed of Python3 3.9 on my laptop. In both cases there
> are obvious optimizations possible at the expense of complicating the
> code slightly, such as generating only half the permutations instead
> of throwing away the ones with x0>=x1. GHC 8.8.4 is now somewhat
> outdated and newer versions might generate the better code.
>
> Note the type annotation (Int,Int,Int) which tells the compiler that
> the values are (64 bit) machine integers. Without the annotation it
> would use Integer which is bignums. In that case, cpu time is 1.085s,
> so still 3x the speed of Python.
>
> ================================================================
>
> import Data.List (permutations)
>
> main = print $ [(send,more,money) :: (Int,Int,Int)
> | [x0,x1,s,e,n,d,m,o,r,y] <- permutations [0..9]
> , x0 < x1 && m > 0
> , let { send=1000*s+100*e+10*n+d;
> more=1000*m+100*o+10*r+e;
> money=10000*m+1000*o+100*n+10*e+y
> }
> , send+more == money
> ]

This over my head. X0 and X1 declared but never used?
Wild guess: these are control variable to create a smaller triangulated
(triangulized?) search space

"minf...@arcor.de" <minforth@arcor.de> writes:
> This over my head. X0 and X1 declared but never used?
> Wild guess: these are control variable to create a smaller triangulated
> (triangulized?) search space

There are 10 digits that get permuted, but you only care about 8 of
them. x0 and x1 are the other two. Imagine that they happen to be 3
and 5, and SENDMORY are a permutation of the other 8 digits. Then you
will see another 10-digit permutation where x0,x1 are 5,3 instead of
3,5, i.e. the solution will appear twice. To filter out that duplicate,
you only count the cases where x0<x1. With x0 and x1 switched you will
have x1<x0 and otherwise the same solution.

Le jeudi 9 février 2023 à 13:17:53 UTC, Ahmed MELAHI a écrit :
> Le jeudi 9 février 2023 à 12:47:02 UTC, Ahmed MELAHI a écrit :
> > 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
> Hi, again,
> In the previous program, there is a result left on the data stack. it must be dropped.
> The new version is here
> 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 + @
> to_sendmory
> m 1 = if
> .send+more=money
>
> unloop
> exit
> then
> loop
> ;
>
> : go go_sendmoremoney cr .unique_result ;
>
> 10000000 go
> \ -------N.B.---------
> utime 10000000 go utime d- dnegate d>f 1e-6 f* f. \ less than 1 second
Hi,
Previous program modified.

Paul Rubin <no.email@nospam.invalid> writes:
> Here is the Haskell version. CPU time with ghc 8.8.4 -O3 is 0.472s sec
> so about 6x the speed of Python3 3.9 on my laptop.

Here is C++ version, same algorithm, gcc 10.2.1 with -O3, runtime 0.037
sec on same laptop. Look ma, no garbage collection.

================================================================

#include <algorithm>
#include <iostream>
#include <array>

int main() {
std::array<int,10> digits {0,1,2,3,4,5,6,7,8,9};
enum { x0, x1, s, e, n, d, m, o, r, y } ;

do {
if (digits[x0] > digits[x1] || digits[m] == 0)
continue;
int send = 1000*digits[s]+100*digits[e]+10*digits[n]+digits[d];
int more = 1000*digits[m]+100*digits[o]+10*digits[r]+digits[e];
int money = 10000*digits[m]+1000*digits[o]
+ 100*digits[n]+10*digits[e]+digits[y];
if (send + more == money)
std::cout << send << " " << more << " " << money << '\n';
} while(std::next_permutation(digits.begin(), digits.end()));
}

Le jeudi 9 février 2023 à 14:24:39 UTC, minf...@arcor.de a écrit :
> Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 13:47:02 UTC+1:
> > 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.
> Merci de tes contributions! Of course M has to be 1 because it has to be a carry bit.
> So you used a mathematical property of one of the constraints to manually reduce your search space.
>
> BTW this shows an interesting common aspect between all the various Forth proposals:
> In their manually coded program formulation they freely join/mix/meddle walking the search space with constraint properties.
> Therefore many different solutions appear on the table depending on programmer's expertise or preference.
>
> Declarative constraint programming languages don't have to do this (ideally). They go in distinctive not related steps:
> 1) declare the variable domains ( here: integers ranging from 0 to 9 )
> 2) span the search space in toto ( here: 8 variables SENDMORY )
> 3) declare the constraints ( here: M<>0 and SEND+MORE=MONEY and all variables unique)
> \ BTW: M<>0 not because of the other constraint but because otherwise MONEY would be written as ONEY ! )
> 4) solve it.
> ( of course real CLP programmers also use their optimization toolbelts .... but that's a different story )
>
> So this is a very generic and very versatile approach! One can add/delete/change constraints in one place without
> having to rewrite the program. And the best: bug-free from start.
>
> How would a Forth programmer come close to this?
>
> ( for fun: try to solve TO+GO=OUT )
Hi,
Here, 3 programs are presented:
-1- send+more=money: without using permutations, use all_diff defined here in the program, also note the definition of (sendmoremoney), it has the form of declarative constrained logic, using the words defined at the begining of the program. this program take a while to find the solution (due to absence of permutations).
-2- send+more=money: with use of permutations, also note the form of the word (sendmoremoney), it uses declarative constained logic using the words defined in the begining of the program. this program find the solution rapidly.
-3- to+go=out: as the first program, here there are just 4 unknowns. it find the solution rapidly.

N.B. the words defined at the begining can be moved to another program (module) and included in the application program.

First program:

s" random.fs" included

: :- 1 ;
: , and dup 0= if exit then ;
: min_max 1 -rot over - 1+ random + ;

100 value diff_flags_max_size
create all_diff_flags diff_flags_max_size allot

0 value nvars

: all_diff_flags_init all_diff_flags diff_flags_max_size erase ;

: all_diff
all_diff_flags_init
nvars 0 do
all_diff_flags + dup c@ if
nvars i - 0 do
drop
loop
0 unloop exit
else
1 swap c!
then
loop
1
;

: -: and if 1 cr ." solution found" else 0 then ;

\ here begins the application to send+more=money
8 to nvars

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

: (sendmoremoney)
:- 0 9 min_max to s , 0 9 min_max to e , 0 9 min_max to n , 0 9 min_max to d ,
0 9 min_max to m , 0 9 min_max to o , 0 9 min_max to r , 0 9 min_max to y ,
s e n d m o r y all_diff ,
m 0> ,
s 10 * e + 10 * n + 10 * d +
m 10 * o + 10 * r + 10 * e + +
m 10 * o + 10 * n + 10 * e + 10 * y + = -:
;

: sendmoremoney
cr ." Solving ..." cr

0 do
(sendmoremoney)
if 1 unloop exit else then
loop
0
;

: .solution
if
cr
." the solution is: "
cr
s 10 * e + 10 * n + 10 * d + 4 .r ." + "
m 10 * o + 10 * r + 10 * e + 4 .r ." = "
m 10 * o + 10 * n + 10 * e + 10 * y + 5 .r
else
cr
." no solution found"
then
cr
;

: go sendmoremoney .solution ;

\ 100000000 go

utime 100000000 go utime d- dnegate d>f 1e-6 f* cr ." Done in: " f. ." seconds."

Second program:
s" random.fs" included

: :- 1 ;
: , and dup 0= if exit then ;
: min_max 1 -rot over - 1+ random + ;

100 value diff_flags_max_size
create all_diff_flags diff_flags_max_size allot

0 value nvars

: all_diff_flags_init all_diff_flags diff_flags_max_size erase ;

: all_diff
all_diff_flags_init
nvars 0 do
all_diff_flags + dup c@ if
nvars i - 0 do
drop
loop
0 unloop exit
else
1 swap c!
then
loop
1
;

: -: and if 1 cr ." solution found" else 0 then ;

\ here begins the application to send+more=money

8 to nvars

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

\ s e n d m o r y : the 8 first positions
create vals 0 c, 1 c, 2 c, 3 c, 4 c, 5 c, 6 c, 7 c, 8 c, 9 c,

0 value a
0 value b

: gen_new_permutation
\ by exchanging values in vals at a and b positions,
\ a and b are randomly chosen in 0, ..., 9.
10 random to a
10 random to b
vals a + c@
vals b + c@
vals a + c!
vals b + c!
;

: gen_sendmory
1
gen_new_permutation
7 for vals i + c@ next
to s to e to n to d to m to o to r to y
;

: (sendmoremoney)
:- gen_sendmory ,
m 0> ,
s 10 * e + 10 * n + 10 * d +
m 10 * o + 10 * r + 10 * e + +
m 10 * o + 10 * n + 10 * e + 10 * y + = -:
;

: sendmoremoney
cr ." Solving ..." cr

0 do
(sendmoremoney)
if 1 unloop exit else then
loop
0
;

: .solution
if
cr
." the solution is: "
cr
s 10 * e + 10 * n + 10 * d + 4 .r ." + "
m 10 * o + 10 * r + 10 * e + 4 .r ." = "
m 10 * o + 10 * n + 10 * e + 10 * y + 5 .r
else
cr
." no solution found"
then
cr
;

: go sendmoremoney .solution ;

\ 10000000 go

utime 10000000 go utime d- dnegate d>f 1e-6 f* cr ." Done in: " f. ." seconds."

Third program:
s" random.fs" included

: :- 1 ;
: , and dup 0= if exit then ;
: min_max 1 -rot over - 1+ random + ;

100 value diff_flags_max_size
create all_diff_flags diff_flags_max_size allot

0 value nvars

: all_diff_flags_init all_diff_flags diff_flags_max_size erase ;

: all_diff
all_diff_flags_init
nvars 0 do
all_diff_flags + dup c@ if
nvars i - 0 do
drop
loop
0 unloop exit
else
1 swap c!
then
loop
1
;

: -: and if 1 cr ." solution found" else 0 then ;

\ here begins the application to to+go=out

4 to nvars

0 value t
0 value o
0 value g
0 value u

: (togoout)
:- 0 9 min_max to t , 0 9 min_max to o , 0 9 min_max to g , 0 9 min_max to u ,
t o g u all_diff ,
o 0> ,
t 10 * o +
g 10 * o + +
o 10 * u + 10 * t + = -:
;

: togoout
cr ." Solving ..." cr

0 do
(togoout)
if 1 unloop exit else then
loop
0
;

: .solution
if
cr
." the solution is: "
cr
t 10 * o + 2 .r ." + "
g 10 * o + 2 .r ." = "
o 10 * u + 10 * t + 3 .r
else
cr
." no solution found"
then
cr
;

: go togoout .solution ;

\ 100000000 go

utime 100000000 go utime d- dnegate d>f 1e-6 f* cr ." Done in: " f. ." seconds."

"minf...@arcor.de" <minforth@arcor.de> writes:
>We are trying to do things the Forth way and can't use labeling.

What in the Forth way would preclude us from using labeling?

>Still it can be done without labeling, look here
>https://www.swi-prolog.org/pldoc/man?section=clpfd-search

This page shows that SWI Prolog outputs the remaining constraints when
you give it only the original constraints (which is certainly much
better than the state of the art when I did my master's thesis). The
constraint solver can reduce the possible values of the variables even
so, basically:

S=9 E in 4..7 N in 5..8 D in 2..8
M=1 O=0 R in 2..8
Y in 2..8
91*E+D+10*R = 90*N+Y

It then needs some labeling to resolve the rest, even though there is
only one solution (so a sufficiently sophisticated solver could
produce a ground solution from the constraints alone without labeling;
with multiple solutions labeling or some other kind of guessing (e.g.,
splitting variable ranges) is strictly necessary). Still, the range
reduction of the existing SWI Prolog solver is quite impressive.

- 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

Paul Rubin <no.email@nospam.invalid> writes:
>Paul Rubin <no.email@nospam.invalid> writes:
>> I will try the same thing in Haskell when I get a chance, and also
>> try to figure out what is going wrong in my Forth version.
>
>Here is the Haskell version. CPU time with ghc 8.8.4 -O3 is 0.472s sec
>so about 6x the speed of Python3 3.9 on my laptop. In both cases there
>are obvious optimizations possible at the expense of complicating the
>code slightly, such as generating only half the permutations instead
>of throwing away the ones with x0>=x1.

The question is if you can use Haskell's lazy evaluation to advantage
here, resulting in a similar effect (although conceptually inverted)
as the interleaving of labeling and constraint evaluation that happens
in constraint logic programming. I don't expect a sophisticated
solver for the big arithmetic constraint, but the x0<x1 and m>0
constraints might be able to reduce the time needed to produce the
permutations.

However, given that your C++ solution is a lot faster and cannot
benefit from lazy evaluation, I expect that the potential lazy
evaluation advantage does not happen in this Haskell program.

- 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

In article <2023Feb9.115420@mips.complang.tuwien.ac.at>,
Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
<SNIP>
>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.

I hope to demonstrate that VARIABLE can be optimised away as easily
as locals.
Also there is a false dichotomy (cause by the LOCAL mindset)
between local and global variables.
In a proper Pascal implementation of qsort there is an intermediate
storage where e.g. the pointers to procedures are stored.
They are global to qsort proper, and local to the main program.
It is almost impossible to break out of the mindset of
language like c and Forth that cannot have local functions that
have their own variables. (So I don't blame you ;-) )

>
>- anton

Groetjes Albert
--
Don't praise the day before the evening. One swallow doesn't make spring.
You must not say "hey" before you have crossed the bridge. Don't sell the
hide of the bear until you shot it. Better one bird in the hand than ten in
the air. First gain is a cat spinning. - the Wise from Antrim -

none albert schrieb am Freitag, 10. Februar 2023 um 12:44:37 UTC+1:
> In article <2023Feb...@mips.complang.tuwien.ac.at>,
> Anton Ertl <an...@mips.complang.tuwien.ac.at> wrote:
> <SNIP>
> >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.
> I hope to demonstrate that VARIABLE can be optimised away as easily
> as locals.
> Also there is a false dichotomy (cause by the LOCAL mindset)
> between local and global variables.
> In a proper Pascal implementation of qsort there is an intermediate
> storage where e.g. the pointers to procedures are stored.
> They are global to qsort proper, and local to the main program.
> It is almost impossible to break out of the mindset of
> language like c and Forth that cannot have local functions that
> have their own variables. (So I don't blame you ;-) )

Pascal also allows nested functions and afaik even closures. Both are not available
in C until today (without extreme clumsy trick programming). Were it not for its
verbose syntax, it could kick C around more often than not.

anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
> I don't expect a sophisticated solver for the big arithmetic
> constraint, but the x0<x1 and m>0 constraints might be able to reduce
> the time needed to produce the permutations.

Certainly that would have been straightforward if the permutations were
being generated in a known order, say lexicographic. I didn't bother
checking the docs and just assumed they were in random order so I had to
filter all of them. The Haskell version was a straightforward port of
the Python version, whose itertools.permutations generator also doesn't
generate a documented order. Both versions use lazy evaluation in the
sense that the permutation generation is interleaved with the checking,
rather than building up a list of 10! permutations in memory before
filtering.

The C++ std::next_permutation function on the other hand is documented
to generate permutations in lexicographic order. It works by taking an
existing permutation and "incrementing" it. I didn't check the
implementation code but after a few minutes I was able to figure out how
it could work. I hadn't previously thought of that approach, which is
quite clever. My Forth version used recursion to generate permutations
on the stack. I think I will refactor it to use the C++ approach.

With the permutations generated in lexicographic order, it's just a
matter of putting m=1 in the leftmost cell and starting from there to
eliminate half the permutations.

There are some SMT solver solutions at page 276 of this nice book on
using solvers (15MB pdf, page 279 of the pdf):

https://yurichev.com/writings/SAT_SMT_by_example.pdf

It links to this, which might also be interesting (I haven't checked):

https://tamura70.gitlab.io/web-puzzle/cryptarithm/

Unfortunately it doesn't give solution timings.

Another solution using the same method by Wirth in nqueen problem (backtracking was called)

VOCABULARY smm ALSO smm DEFINITIONS

\ S E N D
\ + M O R E
\ ---------
\ M O N E Y

: 1array CREATE /ALLOT DOES> + ;

8 1array letter
: S ( -- a ) 0 letter ;
: E ( -- a ) 1 letter ;
: N ( -- a ) 2 letter ;
: D ( -- a ) 3 letter ;
: M ( -- a ) 4 letter ;
: O ( -- a ) 5 letter ;
: R ( -- a ) 6 letter ;
: Y ( -- a ) 7 letter ;

: d+e D C@ E C@ + ;
: d+e=y d+e 10 MOD Y C@ = ;
: c1 d+e 10 / ;
: n+r N C@ R C@ + ; : c2 n+r 10 / ;
: c1+n+r=e c1 n+r + 10 MOD E C@ = ;
: e+o E C@ O C@ + ; : c3 e+o 10 / ;
: c2+e+o=n c2 e+o + 10 MOD N C@ = ;
: s+m S C@ M C@ + ; : c4 s+m 10 / ;
: c3+s+m=o c3 s+m + 10 MOD O C@ = ;
: m<>0 M C@ c4 = M C@ 0<> AND ;
: solution d+e=y c1+n+r=e AND c2+e+o=n AND c3+s+m=o AND m<>0 AND ;

10 1array digits

: unused ( d - t/f ) digits C@ 0= ; \ safe or unused
: mark ( l d -- ) 1 OVER digits C! SWAP letter C! ;
: unmark ( l d -- ) 0 SWAP digits C! 0 SWAP letter C! ;

VARIABLE tries#

: .digits ( -- ) 7 0 DO I letter C@ . LOOP ;
: .solution1 CR ." After tries: " tries# @ . ." Solution is: " .digits ;
: .send ( -- ) S C@ . E C@ . N C@ . D C@ . ;
: .more ( -- ) M C@ . O C@ . R C@ . E C@ . ;
: .money ( -- ) M C@ . O C@ . N C@ . E C@ . Y C@ . ;
: .solution2 ( -- ) CR CR SPACE SPACE .send CR SPACE SPACE .more CR ." + _ _ _ _" CR .money ;
: check ( -- ) solution IF .solution2 THEN ;

: try ( l -- )
10 0 DO \ Digits \ I digit
tries# ++ \ CR tries# ? .digits
I unused IF
DUP I mark
DUP 7 < IF DUP 1+ RECURSE ELSE check THEN
DUP I unmark
THEN
LOOP DROP ;

: go 0 tries# ! 0 try ; go tries# ?

..S KEY BYE

It is not optimized and gets the solution.

On Friday, February 10, 2023 at 9:22:12 PM UTC+1, Ala'a wrote:
> Another solution using the same method by Wirth in nqueen problem (backtracking was called)
[..]
> It is not optimized and gets the solution.

Not bad, only 1 unfamiliar word ( /allot ), and runs in 14.84 ms ( iForth64 ).

FORTH> go

9 5 6 7
1 0 8 5
+ _ _ _ _
1 0 6 5 2 14.83 milliseconds elapsed, tries# = 7921010 ok

-marcel

On Saturday, February 11, 2023 at 3:25:52 AM UTC+4, Marcel Hendrix wrote:
> On Friday, February 10, 2023 at 9:22:12 PM UTC+1, Ala'a wrote:
> > Another solution using the same method by Wirth in nqueen problem (backtracking was called)
> [..]
> > It is not optimized and gets the solution.
> Not bad, only 1 unfamiliar word ( /allot ), and runs in 14.84 ms ( iForth64 ).
>
> FORTH> go
>
> 9 5 6 7
> 1 0 8 5
> + _ _ _ _
> 1 0 6 5 2 14.83 milliseconds elapsed, tries# = 7921010 ok
>
> -marcel

/Allot is combination of ALLOT and 0 FILL

On Saturday, February 11, 2023 at 8:21:06 AM UTC+1, Ala'a wrote:
> On Saturday, February 11, 2023 at 3:25:52 AM UTC+4, Marcel Hendrix wrote:
> > On Friday, February 10, 2023 at 9:22:12 PM UTC+1, Ala'a wrote:
> > > Another solution using the same method by Wirth in nqueen problem (backtracking was called)
[..]
> /Allot is combination of ALLOT and 0 FILL

I found out when trying to run the program more than once.

-marcel