SEND+MORE=MONEY

[minf...@arcor.de]

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

[Jali Heinonen]

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:~#

[Jali Heinonen]

Sorry about losing indentations and making code hard to read....

[minf...@arcor.de]

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.

[Marcel Hendrix]

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

[Gerry Jackson]

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

--
Gerry

[Anton Ertl]

"minf...@arcor.de" <minf...@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 Ertl]

an...@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.

[minf...@arcor.de]

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.

[Marcel Hendrix]

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

[Anton Ertl]

"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.

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).

[minf...@arcor.de]

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]

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. ;-)

[Paul Rubin]

"minf...@arcor.de" <minf...@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

[Ahmed MELAHI]

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

[minf...@arcor.de]

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.

[minf...@arcor.de]

Here you go:
https://en.wikipedia.org/wiki/Verbal_arithmetic

[Anton Ertl]

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.

[Jali Heinonen]

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?

[minf...@arcor.de]

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.

[Anton Ertl]

Jali Heinonen <jali.h...@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 Ertl]

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.

[NN]

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

[Ahmed MELAHI]

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)

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

[Ahmed MELAHI]

Hi, again,
In the previous program, there is a result left on the data stack. it must be dropped.
The new version is here

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

[minf...@arcor.de]

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 )

[Jali Heinonen]

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

[Ahmed MELAHI]

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

[Paul Rubin]

an...@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.

[Paul Rubin]

Jali Heinonen <jali.h...@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.

[Ahmed MELAHI]

Hi,
This program takes about 2 ms to give the unique result.

: go go_togoout cr .results ;

10000000 go

\ ---- timing
utime 10000000 go utime d- dnegate d>f 1e-6 f* cr f.

[Anton Ertl]

"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.

>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 Ertl]

an...@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.

[minf...@arcor.de]

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]

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
]

[minf...@arcor.de]

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

[Paul Rubin]

"minf...@arcor.de" <minf...@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.

[Ahmed MELAHI]

Hi,
Previous program modified.

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= ;

\ 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
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
;

: go_sendmoremoney
\ stochastic search in solution space
cr
." solving ..."
0 do
gen_sendmory
is_send+more=money_?
m 0<> and if
1 \ solution found
unloop exit
then
loop
0 \ no solution found

;

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

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

: .result

if

cr
." send + more = money"
cr

.send+more=money
cr
else
cr
." No solution found!"
cr
then
;

: go go_sendmoremoney cr .result ;

\ 10000000 go

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

[Paul Rubin]

Paul Rubin <no.e...@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()));
}

[Ahmed MELAHI]

Le jeudi 9 février 2023 à 14:24:39 UTC, minf...@arcor.de a écrit :

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."

[Anton Ertl]

"minf...@arcor.de" <minf...@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 Ertl]

Paul Rubin <no.e...@nospam.invalid> writes:
>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.

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.

[none albert]

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 ;-) )

>
>- 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 -

[minf...@arcor.de]

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.

[Paul Rubin]

an...@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.

[Ala'a]

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.

[Marcel Hendrix]

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

[Ala'a]

/Allot is combination of ALLOT and 0 FILL

[Marcel Hendrix]

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

[Ala'a]

I had updated the code and included /allot, changed ++ into +!, made 'M' at index 0, changed 7 into 8 before the recurse, and added early terminate after finding the solution:

VOCABULARY smem ALSO smem DEFINITIONS

: /ALLOT HERE SWAP DUP ALLOT 0 FILL ;

: 1array CREATE /ALLOT DOES> + ;

8 1array letter

: M ( -- a ) 0 letter ; : S ( -- a ) 1 letter ; : E ( -- a ) 2 letter ;
: N ( -- a ) 3 letter ; : D ( -- a ) 4 letter ; : O ( -- a ) 5 letter ;

: R ( -- a ) 6 letter ; : Y ( -- a ) 7 letter ;

: send s C@ 1000 * e C@ 100 * + n C@ 10 * + d C@ + ;
: more m C@ 1000 * o C@ 100 * + r C@ 10 * + e C@ + ;
: money m C@ 10000 * o C@ 1000 * + n C@ 100 * + e C@ 10 * + y C@ + ;
: sol? send more + money = M C@ 0<> AND ; \ M <> 0 -> 1 unique solution

10 1array digit

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

VARIABLE tries#

: .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@ . ;

: .tries CR ." After " tries# @ . ." tries, Solution is: " ;
: .equ SPACE SPACE .send CR SPACE SPACE .more CR ." + _ _ _ _" CR .money ;
: .solution ( -- ) CR .tries CR .equ ;
: check ( -- ) sol? IF .solution TRUE ELSE FALSE THEN ;

VARIABLE terminate terminate off

: try ( l -- )
10 0 DO \ Digits \ I digit

1 tries# +! \ CR tries# ? .digits

I unused IF
DUP I mark

DUP 8 < IF DUP 1+ RECURSE ELSE check terminate ! THEN
DUP I unmark
THEN
terminate @ IF DROP UNLOOP EXIT THEN

LOOP DROP ;

: go 0 tries# ! 0 try ;

\ counter go timer BYE
\ timer-reset go .elapsed BYE

go .S KEY BYE

Hope it help

[Anton Ertl]

albert@cherry.(none) (albert) writes:
>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.

Some people hope to build a perpetuum mobile.

For the others, consider:

variable s
variable e
...

: smm ( -- )
\ print all solutions to the SEND+MORE=MONEY puzzle
... \ store to and load from the global variables defined above
;

smm

s ?
e ?
...

SMM has to store at least the final values of the global variables in
memory, so that the user can access them after a call to SMM. You
cannot optimise that away, and even what you can optimise away is not
easy.

>Also there is a false dichotomy (cause by the LOCAL mindset)
>between local and global variables.

And the relevance for the present discussion is?

>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 ;-) )

Maybe you should read

@InProceedings{ertl&paysan18,
author = {M. Anton Ertl and Bernd Paysan},
title = {Closures --- the {Forth} way},
crossref = {euroforth18},
pages = {17--30},
url = {http://www.complang.tuwien.ac.at/papers/ertl%26paysan.pdf},
url2 = {http://www.euroforth.org/ef18/papers/ertl.pdf},
slides-url = {http://www.euroforth.org/ef18/papers/ertl-slides.pdf},
video = {https://wiki.forth-ev.de/doku.php/events:ef2018:closures},
OPTnote = {refereed},
abstract = {In Forth 200x, a quotation cannot access a local
defined outside it, and therefore cannot be
parameterized in the definition that produces its
execution token. We present Forth closures; they
lift this restriction with minimal implementation
complexity. They are based on passing parameters on
the stack when producing the execution token. The
programmer has to explicitly manage the memory of
the closure. We show a number of usage examples.
We also present the current implementation, which
takes 109~source lines of code (including some extra
features). The programmer can mechanically convert
lexical scoping (accessing a local defined outside)
into code using our closures, by applying assignment
conversion and flat-closure conversion. The result
can do everything one expects from closures,
including passing Knuth's man-or-boy test and living
beyond the end of their enclosing definitions.}
}

@Proceedings{euroforth18,
title = {34th EuroForth Conference},
booktitle = {34th EuroForth Conference},
year = {2018},
key = {EuroForth'18},
url = {http://www.euroforth.org/ef18/papers/proceedings.pdf}
}

One interesting aspect of the work on that paper was that I had
trouble finding simple examples that demonstrate the value of closures
(especially of the (locals-) stack-allocating closures, i.e., what
Pascal is limited to) and that cannot be rewritten without closures in
Forth with relatively little code.

I knew that Niklaus Wirth has this feature is Pascal, Modula-2 and
Oberon, but he is also a minimalist and eliminated features from
Oberon that can be replaced by using other features, such as the FOR
loop. Since he had included access to locals of outer functions in
Oberon, I assumed he had a good motivating use for that feature, so I
asked him about that. Unfortunately, I did not get the answer I was
interested in: He actually had eliminated this feature in a later
revision of Oberon, so he actually had no good reason for it, either.

Concerning the closures of Gforth: You can program without them, so
they are just a convenience, not a necessity. Nevertheless, Bernd
Paysan uses them frequently. I don't use them often. What I use more
often is the feature of postponing the value of a local, which is a
separate feature from Gforth closures, but was implemented when we
implemented closures, because the idea is to use a local where it
normally cannot be used, just like the original idea behind
implementing closures (which then morphed into Gforth closures):

Instead of

: foo {: bar baz :}
... ]] ... [[ bar ]] literal ... [[ baz ]] literal ... [[ ... ;

you just write

: foo {: bar baz :}
... ]] ... bar ... baz ... [[ ... ;

[Marcel Hendrix]

On Saturday, February 11, 2023 at 9:02:55 AM UTC+1, Ala'a wrote:
> On Saturday, February 11, 2023 at 11:49:42 AM UTC+4, Marcel Hendrix wrote:
> > 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)
> > [..]

That improves the timing from 14.83 to 8.93 milliseconds.
The #tries decreases from 7921010 to 5092470.

-marcel

[dxforth]

SwiftForth has it under that name while VFX calls it ALLOT&ERASE.
Some swear by zeroing variables/buffers etc at compile-time; I
tend to swear at it for the reason you gave.

[Marcel Hendrix]

On Saturday, February 11, 2023 at 11:09:13 AM UTC+1, Marcel Hendrix wrote:
[..]
> That improves the timing from 14.83 to 8.93 milliseconds.
> The #tries decreases from 7921010 to 5092470.

I was quite happy to find this numerical shortcut:
\ : sol? send more + money = M C@ 0<> AND ; \ M <> 0 -> 1 unique solution
: sol? m C@ 0= IF FALSE EXIT ENDIF
( m == 1 ) #10000
o C@ s C@ - ( m C@ ) 1 - #1000 * +
n C@ e C@ - o C@ - #100 * +
e C@ n C@ - r C@ - #10 * +
y C@ d C@ - e C@ - + 0= ;

Unfortunately, the run-time decreases by almost nothing, from 8.93ms to 8.78ms.
The runtime is dominated by the overhead of a recursive call. It could have been
the overhead of the 11 byte fetches, but that proved to be only 13ms.
With a by now very ugly sol?, the best time is 8.65 ms / go.

-marcel

[Ala'a]

This problem can be solved analytically. and using that the first observation is that M can only be 1 through C3 (as M<>0). Thus eliminated as constant. The second (which may be called cheating) is variables (of the letters) ordering (in CSP parlance) using the solution values and changing the indexes of the letters based on their value based on that, help in pruning the search space:

VOCABULARY s11 ALSO s11 DEFINITIONS \ pun intended

: /ALLOT HERE SWAP DUP ALLOT 0 FILL ;
: 1array CREATE /ALLOT DOES> + ;

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

: send s C@ 1000 * e C@ 100 * + n C@ 10 * + d C@ + ;

: more 1000 o C@ 100 * + r C@ 10 * + e C@ + ;
: money 10000 o C@ 1000 * + n C@ 100 * + e C@ 10 * + y C@ + ;
: sol? send more + money = ;

10 1array digit

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

VARIABLE tries#

: .send ( -- ) S C@ . E C@ . N C@ . D C@ . ;

: .more ( -- ) 1 . O C@ . R C@ . E C@ . ;
: .money ( -- ) 1 . O C@ . N C@ . E C@ . Y C@ . ;

: .tries CR ." After " tries# @ . ." tries, Solution is: " ;
: .equ SPACE SPACE .send CR SPACE SPACE .more CR ." + _ _ _ _" CR .money ;
: .solution ( -- ) CR .tries CR .equ ;
: check ( -- ) sol? IF .solution TRUE ELSE FALSE THEN ;

VARIABLE terminate terminate off

: try ( l -- )
10 0 DO \ Digits \ I digit
1 tries# +! \ CR tries# ? .digits
I unused IF
DUP I mark

DUP letters# < IF DUP 1+ RECURSE ELSE check terminate ! THEN

DUP I unmark
THEN
terminate @ IF DROP UNLOOP EXIT THEN
LOOP DROP ;

: go 0 tries# ! 0 try ;

go
\ ucounter go utimer KEY BYE \ increased preci. from ms to us
\ timer-reset go .elapsed KEY BYE

.S KEY BYE

\\ Tries#
\ previous: 5092470
\ eliminate M: 1535004
\ vars reorder: 304594

Regards,

[minf...@arcor.de]

Ala'a schrieb am Samstag, 11. Februar 2023 um 20:25:36 UTC+1:
> On Saturday, February 11, 2023 at 6:52:50 PM UTC+4, Marcel Hendrix wrote:
> > On Saturday, February 11, 2023 at 11:09:13 AM UTC+1, Marcel Hendrix wrote:
> > [..]
> > > That improves the timing from 14.83 to 8.93 milliseconds.
> > > The #tries decreases from 7921010 to 5092470.
> > I was quite happy to find this numerical shortcut:
> > \ : sol? send more + money = M C@ 0<> AND ; \ M <> 0 -> 1 unique solution
> > : sol? m C@ 0= IF FALSE EXIT ENDIF
> > ( m == 1 ) #10000
> > o C@ s C@ - ( m C@ ) 1 - #1000 * +
> > n C@ e C@ - o C@ - #100 * +
> > e C@ n C@ - r C@ - #10 * +
> > y C@ d C@ - e C@ - + 0= ;
> >
> > Unfortunately, the run-time decreases by almost nothing, from 8.93ms to 8.78ms.
> > The runtime is dominated by the overhead of a recursive call. It could have been
> > the overhead of the 11 byte fetches, but that proved to be only 13ms.
> > With a by now very ugly sol?, the best time is 8.65 ms / go.
> >
> > -marcel
> This problem can be solved analytically. and using that the first observation is that M can only be 1 through C3 (as M<>0). Thus eliminated as constant. The second (which may be called cheating) is variables (of the letters) ordering (in CSP parlance) using the solution values and changing the indexes of the letters based on their value based on that, help in pruning the search space:

Order of variables AND order of constraint evaluation do matter.
Taking profit from this property or even applying constraint propagation
is not cheating but search optimization. ;-)

https://www.ibm.com/docs/en/icos/20.1.0?topic=optimizer-constraint-propagation

[Ahmed MELAHI]

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, a program that takes some considerations on m, s and o. m=1, s=9 and o =0.
Also, it uses permutations, for e n d r y
It is based on non informed search algorithm (non informed stochastic search algorithm).
For the timing, it is very fast, but not deterministic, (timing ranges from 20 ms down to about 0.1 ms, but almost under 7ms).
To see this fact, run the program several times and verify the timing.
There are examples of running the program after the program listing.
This program is written and tested with gforth.


\ ---- Program listing begins here
: rand_7 utime drop 7 mod ;

: :- 1 ;
: , and dup 0= if rdrop exit then ;
: -: and if 1 ( cr ." solution found") else 0 then ;

\ here begins the application to send+more=money

0 value solution_found_?

\ sendmory

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

\ m s o
: (sendmoremoney)_pre
1 to m \
\ s + m = o + 10m
\ s + 1 = o + 10*1
\ s = o + 9
\ o>=0 ===> o + 9 >= 9 ie s>=9
\ s>=9 and s<=9 ===> unique solution s=9
\ therefore o=0
9 to s
0 to o
;

(sendmoremoney)_pre


\ e n d r y : the 6 first positions
create vals 2 c, 3 c, 4 c, 5 c, 6 c, 7 c, 8 c,

\ for permutations

0 value a
0 value b

\ for carries
0 value c1
0 value c2

: gen_new_permutation
\ by exchanging values in vals at a and b positions,

\ a and b are randomly chosen in 0, 1, 2, ..., 6.
3 0 do
rand_7 to a
rand_7 to b

vals a + c@
vals b + c@
vals a + c!
vals b + c!

loop
;

: gen_endry
gen_new_permutation
4 for vals i + c@ next
to e to n to d to r to y
;


\ send
\ more
\ money


: (sendmoremoney)
:-
gen_endry

d e + 10 /mod to c1 y = ,
c1 n + r + 10 /mod to c2 e = ,
c2 e + n =

-:
;


: go

cr ." Solving ..." cr
0 do
(sendmoremoney)

if 1 to solution_found_? unloop exit else then
loop
0 to solution_found_?
;



: .solution
cr
if

." 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

." no solution found."
then
;


utime 100000 go utime d- dnegate d>f 1e-6 f* cr ." Done in: " f. ." seconds." solution_found_? .solution

\ ----Program listing ends here

Examples of running the program:

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.004138 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.005762 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.008374 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.003357 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.000403 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.005634 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.011867 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.019845 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.007549 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.000411 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.000585 seconds.
the solution is:
9567 + 1085 = 10652

>gforth sendmoremoney_3.fs -e "bye"
Solving ...
Done in: 0.005141 seconds.
the solution is:
9567 + 1085 = 10652

[minf...@arcor.de]

Ahmed MELAHI schrieb am Samstag, 11. Februar 2023 um 23:41:19 UTC+1:

> Hi,
> Here, a program that takes some considerations on m, s and o. m=1, s=9 and o =0.
> Also, it uses permutations, for e n d r y
> It is based on non informed search algorithm (non informed stochastic search algorithm).
> For the timing, it is very fast, but not deterministic, (timing ranges from 20 ms down to about 0.1 ms, but almost under 7ms).
> To see this fact, run the program several times and verify the timing.

Each time you were restarting gforth, reloading the program from drive (cache)
someplace into memory, and run your solver only once. This might explain the obeserved
timing jitter.

What are the measurings when you load the program only once and run the solver 1000 times?

[Ahmed MELAHI]

Hi,
When running inside gforth, 1000 times, the mean timing is:
\ running the program 1000 times and taking the mean value
: timing_1000 utime 1000 0 do 100000 ( max number of tries) go loop utime d- dnegate d>f 1e-6 f* 1000e f/ f. ;
timing_1000 0.003234738 ok
timing_1000 0.003410783 ok
timing_1000 0.003526989 ok
timing_1000 0.003412328 ok
timing_1000 0.003339925 ok
So, approximately 3.4 ms


When invoking the program in command line:
gforth sendmoremoney_3.fs -e "bye"

0.003325417
0.003510594
0.003462138
0.003506971
0.003470388
So, approximately 3.4 ms

[Ahmed MELAHI]

Le dimanche 12 février 2023 à 09:03:54 UTC, minf...@arcor.de a écrit :

Hi, again,
Another version of the program, the internal algorithm is modified.

running the timing for 1000 times gives:
Inside gforth
>gforth
Gforth 0.7.9_20170112, Copyright (C) 1995-2016 Free Software Foundation, Inc.
Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
Type `help' for basic help

Here, including the program inside Gforth

include sendmoremoney_4.fs

Mean timing: 0.001022783

Mean timing: 0.001021481

Mean timing: 0.000997707

Mean timing: 0.001114846


Here, executing timing_1000 inside gforth:
Mean timing: 0.001177877 ok
timing_1000
Mean timing: 0.001000998 ok
timing_1000
Mean timing: 0.000886701 ok
timing_1000
Mean timing: 0.000978621 ok
timing_1000
Mean timing: 0.001051597 ok
timing_1000
Mean timing: 0.000961631 ok

When invoked in command line:
>gforth sendmoremoney_4.fs -e "bye"

sendmoremoney_4.fs:9:3: redefined ,
sendmoremoney_4.fs:19:9: redefined n
sendmoremoney_4.fs:48:9: redefined b
sendmoremoney_4.fs:90:9: redefined j with J

Mean timing: 0.000995724

Mean timing: 0.00093175

Mean timing: 0.000977553

Mean timing: 0.000926892

Mean timing: 0.000969498

The program is here

\ ----Program listing begins here

: rand_7 utime drop 7 mod ;

: rand_4 utime drop 4 mod 3 + ;
defer rand
' rand_7 is rand

\ y d e r n : the 6 first positions

create vals 2 c, 3 c, 4 c, 5 c, 6 c, 7 c, 8 c,

\ for permutations
0 value a
0 value b

\ for carries
0 value c1
0 value c2

: gen_new_permutation
\ by exchanging values in vals at a and b positions,
\ a and b are randomly chosen in 0, 1, 2, ..., 6.
3 0 do

rand to a
rand to b

vals a + c@
vals b + c@
vals a + c!
vals b + c!
loop
;

: gen_ydern_7

gen_new_permutation
4 for vals i + c@ next

to y to d to e to r to n
;

: gen_ydern_4
gen_new_permutation
1 for vals 3 + i + c@ next
to r to n
;
defer gen_ydern
' gen_ydern_7 is gen_ydern


\ send
\ more
\ money

: use_4 ['] gen_ydern_4 is gen_ydern ['] rand_4 is rand ;
: use_7 ['] gen_ydern_7 is gen_ydern ['] rand_7 is rand ;

0 value J
: (sendmoremoney)
:-
gen_ydern

d e + 10 /mod to c1 y = dup if use_4 then ,
J 1+ to J
c1 n + r + 10 /mod to c2 e = J 5 = if 0 to J use_7 then ,

c2 e + n =
-:
;

: sendmoremoney
\ cr ." Solving ..." cr

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



: .solution
cr
if
." 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
." no solution found."
then
;

: go utime 10000 sendmoremoney utime d- dnegate d>f 1e-6 f* cr ." Done in: " f. ." seconds." solution_found_? .solution ;

\ running the program 1000 times and taking the mean value

: timing_1000 utime 1000 0 do 10000 ( max number of tries) sendmoremoney ( solution_found_? .solution) loop utime d- dnegate d>f 1e-6 f* 1000e f/ cr ." Mean timing: " f. ;
cr timing_1000
cr timing_1000
cr timing_1000
cr timing_1000
cr timing_1000

\ ------------- Program listing ends here

[Marcel Hendrix]

On Saturday, February 11, 2023 at 11:41:19 PM UTC+1, Ahmed MELAHI wrote:
> 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:

[..]

> Examples of running the program:

[..]

> >gforth sendmoremoney_3.fs -e "bye"
> Solving ...
> Done in: 0.000403 seconds.
> the solution is:
> 9567 + 1085 = 10652

[..]

> >gforth sendmoremoney_3.fs -e "bye"
> Solving ...
> Done in: 0.019845 seconds.
> the solution is:
> 9567 + 1085 = 10652

[..]

> >gforth sendmoremoney_3.fs -e "bye"
> Solving ...
> Done in: 0.000411 seconds.
> the solution is:
> 9567 + 1085 = 10652
>

That's a *very* large variation!

FORTH> go many
Solving ... 39 microseconds elapsed, the solution is: 9567 + 1085 = 10652
Solving ... 40 microseconds elapsed, the solution is: 9567 + 1085 = 10652
Solving ... 40 microseconds elapsed, the solution is: 9567 + 1085 = 10652
Solving ... 40 microseconds elapsed, the solution is: 9567 + 1085 = 10652
Solving ... 40 microseconds elapsed, the solution is: 9567 + 1085 = 10652
Solving ... 43 microseconds elapsed, the solution is: 9567 + 1085 = 10652
...

Maybe the mysterious "RDROP" in (senmoremany) has something to do with it?
I modified it to:

: (sendmoremoney) ( -- bool )
gen_endry
d e + #10 /MOD TO c1 y <> IF FALSE EXIT ENDIF
c1 n + r + #10 /MOD TO c2 e <> IF FALSE EXIT ENDIF
c2 e + n = ;

-marcel

[Marcel Hendrix]

On Sunday, February 12, 2023 at 1:31:58 PM UTC+1, Marcel Hendrix wrote:
> On Saturday, February 11, 2023 at 11:41:19 PM UTC+1, Ahmed MELAHI wrote:
> > 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:

Still faster: why do gen_new_permutation 3 times?
: gen_new_permutation ( -- )
rand_7 TO a rand_7 TO b
vals a + C@
vals b + C@
vals a + C!
vals b + C! ;

FORTH> GO MANY
Solving ... 15 microseconds elapsed, the solution is: 9567 + 1085 = 10652
Solving ... 15 microseconds elapsed, the solution is: 9567 + 1085 = 10652
Solving ... 16 microseconds elapsed, the solution is: 9567 + 1085 = 10652
...
Solving ... 14 microseconds elapsed, the solution is: 9567 + 1085 = 10652
Solving ... 14 microseconds elapsed, the solution is: 9567 + 1085 = 10652
Solving ... 15 microseconds elapsed, the solution is: 9567 + 1085 = 10652 ok

-marcel

[Marcel Hendrix]

On Sunday, February 12, 2023 at 1:51:37 PM UTC+1, Marcel Hendrix wrote:
> On Sunday, February 12, 2023 at 1:31:58 PM UTC+1, Marcel Hendrix wrote:
> > On Saturday, February 11, 2023 at 11:41:19 PM UTC+1, Ahmed MELAHI wrote:
> > > 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:

All this basically boils down to:

Given a problem with N variables, where the range of each is known.
It is also known when a random set of values form a correct solution.
The more tests for correctness, the better.

Randomly test variable combinations and stop when a valid solution
is found.

There must be more to it ...
1. Can it be proven that this is faster than testing all possible combinations.
2. Does the algorithm stop in finite time.

This is parallellizable and scales linearly with the number of CPUs?!

Sorry if this has already been answered in the thread (in easily digestable morsels).

-marcel

[Marcel Hendrix]

On Wednesday, February 8, 2023 at 11:09:04 AM UTC+1, Anton Ertl wrote:
> "minf...@arcor.de" <minf...@arcor.de> writes:
> 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

So it took 1.607 seconds on minforth and 9.991us on Ertl?
(what do "cycles:u" and "instructions:u" mean exactly?)

-marcel

[Ahmed MELAHI]

Yes, I noticed that.
I think it is due the non informed stochastic search algorithm, it does not consider the previous results in order to enhance and speed up the search.
Perhaps, one can use informed search algorithms (particle swarm optimization, genetic algorithms, ... in general meta-heuristic or nature inspired optimization algorithms).
This problem is a combinatorics problem, one can use Ant Colonies Algorithms, they are suited for this kind of problems.

>
> FORTH> go many
> Solving ... 39 microseconds elapsed, the solution is: 9567 + 1085 = 10652
> Solving ... 40 microseconds elapsed, the solution is: 9567 + 1085 = 10652
> Solving ... 40 microseconds elapsed, the solution is: 9567 + 1085 = 10652
> Solving ... 40 microseconds elapsed, the solution is: 9567 + 1085 = 10652
> Solving ... 40 microseconds elapsed, the solution is: 9567 + 1085 = 10652
> Solving ... 43 microseconds elapsed, the solution is: 9567 + 1085 = 10652
> ...

Thanks for testing the program.

>
> Maybe the mysterious "RDROP" in (senmoremany) has something to do with it?
> I modified it to:
>
> : (sendmoremoney) ( -- bool )
> gen_endry
> d e + #10 /MOD TO c1 y <> IF FALSE EXIT ENDIF
> c1 n + r + #10 /MOD TO c2 e <> IF FALSE EXIT ENDIF
> c2 e + n = ;
>

In fact, I don' t want to change that, I wanted a form of Constrained Logic Programming (like in Prolog, but limited).
The algorithm will repeat from the begining with a new combination off SENDMORY when a logical constraint fails. This is done by the comma (here I changed , to do another job than compiling a literal in Here place in the dictionnary).

As another problem, Solving systems of nonlinear equations with several unknowns. Here a program, it is not fast but shows the approach applied.
These programs can be parallelized. I haven't done that.

\ here begins the listing of the program

\ solving system of equations:
\ "x^-2 - 3y + sin(z) + 25.96 = 0"
\ "3x + 2y^-3 + cos(z) - 15.0027 = 0"
\ "x^0.5 + y^2 + 2z - 86.377 = 0"

\ for x real in interval [0, 10] and y real in interval [5 , 15] and z real in interval [0, 10]
\ the exact solution x=5, y=9, z= pi/2=1.57..


s" random.fs" included

10000000000 value max_tries

: :- 1 ;
: , and dup 0= if rdrop exit then ;
: -: and if 1 ( cr ." solution found") else 0 then ;

100000000000000000000 value f_random_interval_size
: frandom f_random_interval_size dup s>f 1/f random s>f f* f* ; \
: f_min_max fover f- frandom f+ ;

0 value nvars


\ here begins the application

3 to nvars

0e fvalue x
0e fvalue y
0e fvalue z


0e fvalue x_lb
10e fvalue x_ub

5e fvalue y_lb
15e fvalue y_ub

0e fvalue z_lb
10e fvalue z_ub


1e-1 fvalue tolerance
0e fvalue d

: f1() x -2e f** 3e y f* f- z fsin f+ 25.96e f+ ;
: f2() 3e x f* 2e y -3e f** f* f+ z fcos f+ 15.0027e f- ;
: f3() x 0.5e f** y 2e f** f+ 2e z f* f+ 86.377e f- ;

: J() f1() fabs f2() fabs fmax f3() fabs fmax ;

: (solve)
:-
x_lb x_ub f_min_max to x
y_lb y_ub f_min_max to y
z_lb z_ub f_min_max to z

J() 0e tolerance f~ ,
cr
cr ." x = " x f.
cr ." y = " y f.
cr ." z = " z f.
cr ." J = " J() f.
cr ." tol = " tolerance f.
tolerance 10e f* to d
x d f- to x_lb x d f+ to x_ub
y d f- to y_lb y d f+ to y_ub
z d f- to z_lb z d f+ to z_ub
tolerance 10e f/ to tolerance

tolerance 1e-5 f<
-:
;


: solve

cr ." Solving ..." cr

0 do

(solve)
if 1 unloop exit else then
loop
0
;


: .solution
if
cr

." the solution is: "
cr

x f. 3 spaces y f. 3 spaces z f.
cr
." and f1(" x f. ." , " y f. ." , " z f. ." ) = " f1() f.
cr
." and f2(" x f. ." , " y f. ." , " z f. ." ) = " f2() f.
cr
." and f3(" x f. ." , " y f. ." , " z f. ." ) = " f3() f.
cr

else
cr
." no solution found"
then
cr
;

: go max_tries solve .solution ;

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


\ here the listing ends

An example of execution, invoked from the command line.
>gforth example_17___.fs -e "bye"

example_17___.fs:15:3: redefined ,
Solving ...


x = 5.22328085000251
y = 8.92117924078448
z = 2.21615179013329
J = 0.0718075600349124
tol = 0.1

x = 5.00370337297728
y = 8.99778115706805
z = 1.58740980572947
J = 0.00645933992813141
tol = 0.01

x = 5.00024926378217
y = 8.99989580954397
z = 1.57148403461704
J = 0.000308346974765783
tol = 0.001

x = 4.99992918754341
y = 8.99998001504991
z = 1.5706404342282
J = 0.0000610757223924452
tol = 0.0001

x = 4.99986667439217
y = 9.00000363175878
z = 1.57044565251771
J = 0.00000882346749975227
tol = 0.00001

the solution is:
4.99986667439217 9.00000363175878 1.57044565251771
and f1(4.99986667439217 , 9.00000363175878 , 1.57044565251771 ) = -0.00000882346749975227
and f2(4.99986667439217 , 9.00000363175878 , 1.57044565251771 ) = -0.00000582164974893828
and f3(4.99986667439217 , 9.00000363175878 , 1.57044565251771 ) = -0.00000515850457816214

Done in: 182.639417 seconds.



> -marcel

[Anton Ertl]

Marcel Hendrix <m...@iae.nl> writes:
>On Wednesday, February 8, 2023 at 11:09:04 AM UTC+1, Anton Ertl wrote:
>> "minf...@arcor.de" <minf...@arcor.de> writes:
>> 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
>
>So it took 1.607 seconds on minforth and 9.991us on Ertl?

Yes.

>(what do "cycles:u" and "instructions:u" mean exactly?)

":u" means in user mode. The system-mode stuff is small here. I
usually measure user-mode stuff because that is what I normally
influence. However, if there are significant differences in memory
consumption, the system-mode (":k") time also differs significantly
(due to allocating the memory in system mode).

[minf...@arcor.de]

This took long. "In practice" or "usually" such numerical Monte Carlo methods are stopped after a certain time.
The results are used as start values for a following Newtor-Raphson iteration.

[Anton Ertl]

Marcel Hendrix <m...@iae.nl> writes:
>All this basically boils down to:
>
>Given a problem with N variables, where the range of each is known.

>It is also known when a random set of values form a correct solution.=20

>The more tests for correctness, the better.

What you call tests are called constraints in the literature. See
<https://en.wikipedia.org/wiki/Constraint_satisfaction_problem>

>Randomly test variable combinations and stop when a valid solution
>is found.

The more common approach is to walk the search space in a systematic
way, especially if you want to find all solutions, or are searching
for an optimal solution. There are general and problem-specific
heuristics for the search.

>There must be more to it ...=20
>1. Can it be proven that this is faster than testing all possible combinati=
>ons.=20

A random search that does not exclude the previously searched space
will likely take more time than a search that visits every part of the
search space at most once.

>2. Does the algorithm stop in finite time.

That probably depends on the definition of finite time you use. For
every time span you give, there is a probability p>0 that such a
random search does not stop. OTOH, the probability that this
algorithm never stops is 0 (at least with a true random number
generator).

>This is parallellizable and scales linearly with the number of CPUs?!

Random search that ignores other attempts is perfectly parallelizable.

[Ahmed MELAHI]

Yes, that is exact. Here, we can add that.
After max tries reached, the program ends displaying "No solution found."

> The results are used as start values for a following Newtor-Raphson iteration.

Newton-Raphson method is applyied when derivatives can be obtained exactly or approximately.
and the risc of local minima, when doing optimization
Here, the system of equations is modified to an optimization problem (minimize J(x,y,z) = max(|f1(x,y,z)|, |f2(x,y,z)|,|f3(x,y,z)|).
This approach is for global optimization.
This program can be easily adapted to do PSO, GA, ACO, ...

If we know approximatly where the exact solution is, we can narrow the search by better choosing the bounds x_lb, x_ub, y_lb, y_ub, z_lb, z_ub from the begining.
when doing that, here is an example of execution of the program: begin with a guess such that 4<x0<6, 8<y<10 and 1<z<2

>gforth example_17___.fs

example_17___.fs:15:3: redefined ,
Solving ...

x = 5.13340715565075
y = 8.96324338810272
z = 1.90589619163218
J = 0.0714353597311668
tol = 0.1

x = 5.0106695818288
y = 8.99665735028719
z = 1.60276546379233
J = 0.00934681137117011
tol = 0.01

x = 5.00005030825161
y = 8.99999139570694
z = 1.57072125014805
J = 0.00036684983365376
tol = 0.001

x = 4.9999655699891
y = 8.99997686550441
z = 1.57071415902657
J = 0.000072176369840804
tol = 0.0001

x = 4.99987183911066
y = 9.00000197566145
z = 1.57046031227259
J = 0.00000498573381513268

tol = 0.00001
the solution is:

4.99987183911066 9.00000197566145 1.57046031227259
and f1(4.99987183911066 , 9.00000197566145 , 1.57046031227259 ) = -0.00000393278417121223
and f2(4.99987183911066 , 9.00000197566145 , 1.57046031227259 ) = -0.00000498573381513268
and f3(4.99987183911066 , 9.00000197566145 , 1.57046031227259 ) = -0.00000449387462708728


Done in: 61.759371 seconds

another execution: tolerance <0.001,

>gforth example_17___.fs

example_17___.fs:15:3: redefined ,
Solving ...

x = 5.01952077651797
y = 8.99102558931017
z = 1.66198604322517
J = 0.0324493494156268
tol = 0.1

x = 5.2117127444467
y = 8.91966518354894
z = 2.26680933844081
J = 0.00590664353095427
tol = 0.01

x = 5.21753194764435
y = 8.91782527807446
z = 2.28290184633388
J = 0.000713201761579185
tol = 0.001
the solution is:
5.21753194764435 8.91782527807446 2.28290184633388
and f1(5.21753194764435 , 8.91782527807446 , 2.28290184633388 ) = 0.00024604367860448
and f2(5.21753194764435 , 8.91782527807446 , 2.28290184633388 ) = -0.000713201761579185
and f3(5.21753194764435 , 8.91782527807446 , 2.28290184633388 ) = 0.000603132247888993


Done in: 14.389063 seconds.


In general, one can speed up the execution by modifying some parameters.
When using informed search (stochastic, PSO, ...) the random choose of x, y and z can be lowered slightly. (I have done this in matlab, julia, python, and gforth with other programs that implement PSO for upto 4 unkowns, can be done for >4 unkowns) ).

[Marcel Hendrix]

On Sunday, February 12, 2023 at 5:05:21 PM UTC+1, Anton Ertl wrote:
> Marcel Hendrix <m...@iae.nl> writes:
[..]

> >This is parallellizable and scales linearly with the number of CPUs?!
> Random search that ignores other attempts is perfectly parallelizable.

I guess it wouldn't help for the problem at hand because the variation
in run-time is almost negligible.

In a general case, one might need a way to generate batched (size N)
random numbers that don't repeat in the same batch (Sobel sequences)?

-marcel

[Marcel Hendrix]

On Sunday, February 12, 2023 at 5:38:04 PM UTC+1, Ahmed MELAHI wrote:
> Le dimanche 12 février 2023 à 15:50:04 UTC, minf...@arcor.de a écrit :
> > Ahmed MELAHI schrieb am Sonntag, 12. Februar 2023 um 16:06:44 UTC+1:
> > > As another problem, Solving systems of nonlinear equations with several unknowns.
> > > Here a program, it is not fast but shows the approach applied.

Won't Amoeba work here? With linear bounds it is by definition possible
to construct a convex hull.

-marcel

[minf...@arcor.de]

Ahmed MELAHI schrieb am Sonntag, 12. Februar 2023 um 17:38:04 UTC+1:
> > This took long. "In practice" or "usually" such numerical Monte Carlo methods are stopped after a certain time.
> Yes, that is exact. Here, we can add that.
> After max tries reached, the program ends displaying "No solution found."
> > The results are used as start values for a following Newtor-Raphson iteration.
> Newton-Raphson method is applyied when derivatives can be obtained exactly or approximately.
> and the risc of local minima, when doing optimization
> Here, the system of equations is modified to an optimization problem (minimize J(x,y,z) = max(|f1(x,y,z)|, |f2(x,y,z)|,|f3(x,y,z)|).
> This approach is for global optimization.

The big difference to other optimization problems is that here the functions are
known and therefore gradients can be calculated directly.

Of course there still is a low probability that the last best global Monte Carlo estimation
is not local enough around the unknown target and sidetracks to an inferior solution.

[Ahmed MELAHI]

Agreed,

[Paul Rubin]

an...@mips.complang.tuwien.ac.at (Anton Ertl) writes:
> 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.

OK, here is my insane Forth version. Runtime with gforth-fast 0.7 about
1.4 seconds on same laptop as before. Same brute force algorithm. Uses
the following highly recommended (lol) Forth techniques:

- ROLL and FPICK with variable depths up to 10 deep
- 13 local variables in one word
- stores temporary small integer values on floating point stack
(this works with IEEE floating point, YMMV otherwise)
- A couple more that I have forgotten.

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

: 10f@>s ( copy 10 integers from fp stack to data stack :O )
10 0 do 9 i - fpick f>s loop ;

: checkresult ( -- )
10f@>s { x0 x1 s e n d m o r y }
m 0> x0 x1 > and IF
s 1000 * e 100 * + n 10 * + d + { send }
m 1000 * o 100 * + r 10 * + e + { more }
m 10000 * o 1000 * + n 100 * + e 10 * + y + { money }
send more + money = IF
send . more . money . cr
THEN
THEN ;

: rec ( n1 n2 ... )
depth 0= IF
checkresult
ELSE
depth { d }
d 0 DO
s>f RECURSE f>s d 1- ROLL
LOOP
THEN ;

0 1 2 3 4 5 6 7 8 9 rec bye

[minf...@arcor.de]

Kool!

Not as small but here's another permuter:

CREATE LET 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 0 ,

: EXCHANGE ( i j -- )
cells let + swap cells let +
dup @ >r swap dup @ rot ! r> swap ! ;

: LT@ ( n -- ) cells let + @ ;

: M 0 lt@ ; : O 1 lt@ ; : R 2 lt@ ; : Y 3 lt@ ;
: S 4 lt@ ; : E 5 lt@ ; : N 6 lt@ ; : D 7 lt@ ;

: S1 S 10 * E + 10 * N + 10 * D + ;
: S2 M 10 * O + 10 * R + 10 * E + ;
: S3 M 10 * O + 10 * N + 10 * E + 10 * Y + ;

: CONSTR ( -- flag )
false
M 1 <> IF EXIT THEN
s1 s2 + s3 <> IF EXIT THEN
drop true ;

: USE-PERM ( -- )
constr IF
cr ." SEND+MORE=MONEY -> " s1 . s2 . s3 .
ABORT THEN ;

\ Heap's algorithm, thanks to Gerry Jackson
: PERMUTE ( n -- ) \ n assumed > 0
1- ?dup 0= IF use-perm EXIT THEN
dup 0 DO
dup recurse
dup over 1 and negate i and exchange
LOOP
recurse ;

10 PERMUTE

[Gerry Jackson]

ISTM that using Heap's algorithm to generate the permutations offers
more opportunities for optimisation of a solution to this problem. This
is because the algorithm generates each permutation from the previous
one by interchanging a single pair of elements. The position of the
other n-2 elements are unchanged. Therefore in the SEND + MORE = MONEY
equation only the increments/decrements for the three components of the
equation need to be calculated and applied to the result of the previous
calculation.

For example suppose digits 12345678 are allocated to SENDMORY as
SENDMORY
12345678
then
SEND MORE MONEY becomes
1234 5672 56328
suppose the next permutation is generated by exchanging digits 4 and 5
then D contributes +1 to SEND
M contributes -1000 to MORE and -10000 to MONEY
So instead of doing the entire calculation only these increments need to
be added to SEND MORE and MONEY from the previous permutation.

These increments could be pre-calculated as a power of 10 for each
letter to be multiplied by the difference in the digits changed for that
letter.

I don't know whether that's it's worth going to that much trouble.

As a wild speculation I wonder if this suggests a way of homing in on
the solution.

--
Gerry

[Paul Rubin]

Gerry Jackson <do-no...@swldwa.uk> writes:
> ISTM that using Heap's algorithm to generate the permutations... This

> is because the algorithm generates each permutation from the previous
> one by interchanging a single pair of elements.

I wasn't familiar with this algorithm. It sounds like a good approach,
and I will have to study it.

[dxforth]

On 15/02/2023 9:13 am, Paul Rubin wrote:
> Gerry Jackson <do-no...@swldwa.uk> writes:
>> ISTM that using Heap's algorithm to generate the permutations... This
>> is because the algorithm generates each permutation from the previous
>> one by interchanging a single pair of elements.
>
> I wasn't familiar with this algorithm.

Same here. Being short and simple, I've included it in my collection of
miscellaneous routines. Neat implementation.

[minf...@arcor.de]

Happy reading ;-)
https://sedgewick.io/wp-content/themes/sedgewick/papers/1977Permutation.pdf

[Marcel Hendrix]

On Tuesday, February 14, 2023 at 6:11:05 PM UTC+1, Gerry Jackson wrote:
> On 13/02/2023 22:11, minf...@arcor.de wrote:
> > Paul Rubin schrieb am Montag, 13. Februar 2023 um 21:31:27 UTC+1:
> >> an...@mips.complang.tuwien.ac.at (Anton Ertl) writes:

[..]

> ISTM that using Heap's algorithm to generate the permutations offers
> more opportunities for optimisation of a solution to this problem. This
> is because the algorithm generates each permutation from the previous
> one by interchanging a single pair of elements. The position of the
> other n-2 elements are unchanged. Therefore in the SEND + MORE = MONEY
> equation only the increments/decrements for the three components of the
> equation need to be calculated and applied to the result of the previous
> calculation.

[..]
This algorithm removes the random element that I mentioned in my remark on
parallellism. With no recursion overhead and no duplicated tries, that should be
quite efficient for certain types of problems. And, of course, simple to implement.

-marcel

[minf...@arcor.de]

It seems that the most efficient non-recursive permutation algorithms require
a second control array. So in addition to swapping cells in the target array, control
array cells have to be managed as well, which eats up the promised efficiency gain.
https://www.quickperm.org/

[Marcel Hendrix]

iForth64 now runs on snellius (https://servicedesk.surf.nl/wiki/display/WIKI/Snellius)
I didn't even need to recompile, just copied the binaries from my 5800X straight onto
the surf node.

FORTH> .TICKER-INFO
AMD EPYC 7F72 24-Core Processor
TICKS-GET uses os time & PROCESSOR-CLOCK 3000MHz
Do: < n TO PROCESSOR-CLOCK RECALIBRATE >
ok
FORTH> GO
Solving ... 26 microseconds elapsed, the solution is: 9567 + 1085 = 10652 ok

'Super' does not mean 'superfast' :--)

-marcel

[dxforth]

Brain the size of a planet and you give it useless tasks to perform.

[Marcel Hendrix]

On Thursday, February 16, 2023 at 1:20:08 AM UTC+1, dxforth wrote:
> Brain the size of a planet and you give it useless tasks to perform.

Starting Forth bottom-up.

-marcel

[minf...@arcor.de]

minf...@arcor.de schrieb am Mittwoch, 15. Februar 2023 um 10:16:33 UTC+1:
> It seems that the most efficient non-recursive permutation algorithms require
> a second control array. So in addition to swapping cells in the target array, control
> array cells have to be managed as well, which eats up the promised efficiency gain.

Here's with non-recursive permutation algorithm. Quick timing showed no speed
increase significant for practical purposes. Only benefit would be less 'stress' on the
return stack.

CREATE LET 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 0 ,

: EXCHANGE ( i j -- )
cells let + swap cells let +
dup @ >r swap dup @ rot ! r> swap ! ;

: LT@ ( n -- ) cells let + @ ;

: M 0 lt@ ; : O 1 lt@ ; : R 2 lt@ ; : Y 3 lt@ ;
: S 4 lt@ ; : E 5 lt@ ; : N 6 lt@ ; : D 7 lt@ ;

: S1 S 10 * E + 10 * N + 10 * D + ;
: S2 M 10 * O + 10 * R + 10 * E + ;
: S3 M 10 * O + 10 * N + 10 * E + 10 * Y + ;

: CONSTR ( -- flag )
false
M 1 <> IF EXIT THEN
s1 s2 + s3 <> IF EXIT THEN
drop true ;

: USE-PERM ( -- )
constr IF
cr ." SEND+MORE=MONEY -> " s1 . s2 . s3 .
ABORT THEN ;

\ ----- Heap's algorithm recursive -----

: PERMUTE-R ( n -- ) \ n assumed > 0

1- ?dup 0= IF use-perm EXIT THEN
dup 0 DO
dup recurse
dup over 1 and negate i and exchange
LOOP
recurse ;

\ 10 PERMUTE-R

\ +++++ Heap's algorithm non-recursive +++++

\ control array:
CREATE CAR 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,
: CA ( n -- ) cells car + ;

: PERMUTE-NR ( n -- ) \ n assumed > 0
use-perm
1 BEGIN 2dup >= WHILE
dup ca @ over <
IF dup 1 and
IF dup ca @ ELSE 0 THEN over exchange use-perm
1 swap ca +! 1
ELSE 0 over ca ! 1+
THEN
REPEAT 2drop ;

10 PERMUTE-NR

[Marcel Hendrix]

On Friday, February 17, 2023 at 2:36:38 PM UTC+1, minf...@arcor.de wrote:
> minf...@arcor.de schrieb am Mittwoch, 15. Februar 2023 um 10:16:33 UTC+1:

[..]
> 10 PERMUTE-NR

PERMUTE-NR is ~700x slower than my latest solution ( 14 microseconds ) :--(

-marcel

[Hans Bezemer]

Including program development, this was even quicker:

"Me> Assume every character is actually a figure, which calculation is made here: SEND+MORE=MONEY

ChatGPT> In the SEND+MORE=MONEY puzzle, the goal is to assign each letter a digit from 0 to 9 in such a way that the resulting mathematical equation is correct. Each letter represents a distinct digit, and the leftmost digit in any number cannot be 0.

Here is one possible solution to the puzzle:

O = 0
M = 1
Y = 2
E = 5
N = 6
D = 7
R = 8
S = 9

With these assignments, the equation becomes:

9567 + 1085 = 10652

which is true."

;-) Hans Bezemer

[minf...@arcor.de]

Think of it, computers have come a long way since:

The oldest computer can be traced back to Adam and Eve.
Surprise! Surprise!
It was an apple.
But with extremely limited memory.
Just 1 byte.
Then everything crashed.

[Hans Bezemer]

On Friday, February 17, 2023 at 7:15:40 PM UTC+1, minf...@arcor.de wrote:
> Think of it, computers have come a long way since.

It often is way off - but sometimes it amazes me. I recently wrote a medium sized program for work.
I fed it to ChatGPT - with minimal comments. Explain it. And it returned this (a bit more, but anyways):

"The program initializes some resources, including two binary search tables "names" and "counts" to store
field values and their frequencies, respectively, and an array of dynamic strings "field-names" to store
the field names.

The main logic of the program is in a loop that reads the CSV file, extracts the field values, and counts
the frequency of each field value. The loop continues until it reaches the end of the file, and then it
prints out the results for each field value. Finally, if the "fodsfile" flag is set, the program opens a FODS
file and writes the results to it".

That's right on the money. There was more, but those were pretty spot on as well. Amazing..

Hans Bezemer

[Marcel Hendrix]

On Friday, February 17, 2023 at 6:29:07 PM UTC+1, Hans Bezemer wrote:
> On Friday, February 17, 2023 at 6:05:51 PM UTC+1, Marcel Hendrix wrote:
> > On Friday, February 17, 2023 at 2:36:38 PM UTC+1, minf...@arcor.de wrote:
> > > minf...@arcor.de schrieb am Mittwoch, 15. Februar 2023 um 10:16:33 UTC+1:
> > [..]
> > > 10 PERMUTE-NR
> >
> > PERMUTE-NR is ~700x slower than my latest solution ( 14 microseconds ) :--(

[..]

> Including program development, this was even quicker:
>
> "Me> Assume every character is actually a figure, which calculation is made here: SEND+MORE=MONEY
>
> ChatGPT> In the SEND+MORE=MONEY puzzle, the goal is to assign each letter a digit from 0 to 9
> in such a way that the resulting mathematical equation is correct. Each letter represents a distinct digit,
> and the leftmost digit in any number cannot be 0.
>
> Here is one possible solution to the puzzle:
>
> O = 0
> M = 1
> Y = 2
> E = 5
> N = 6
> D = 7
> R = 8
> S = 9
>
> With these assignments, the equation becomes:
> 9567 + 1085 = 10652
> which is true."
>
> ;-) Hans Bezemer

I also asked it that. It gave almost the same explanation and the same solution.
However, then I asked for another solution, and it gave me a wrong one, twice --
apparently it assumes the audience is not checking. In the end it did produce
a correct answer. Of course, when I said it was wrong, it quickly agreed.

It also could place the quotes to "Who is on third," and "What is the answer to
everything?" Again, it refused to defend its answers and simply agreed with
me that the answer to the latter is 46.

I thought about it backing down so quickly. Commercially it makes sense -- what
would happen if chatGPT started giving correct and unrefutable but inconvenient
answers to (e.g.) its American audience? Stock would plummet.

-marcel

[dxforth]

On 18/02/2023 12:36 am, minf...@arcor.de wrote:
>
> Here's with non-recursive permutation algorithm. Quick timing showed no speed
> increase significant for practical purposes. Only benefit would be less 'stress' on the
> return stack.

Haven't measured it but appears to be less of an issue than the time taken
to generate the permutations which rises factorially. The latter is likely
to get you first.

[dxforth]

On 18/02/2023 5:32 am, Marcel Hendrix wrote:
>
> I thought about it backing down so quickly. Commercially it makes sense -- what
> would happen if chatGPT started giving correct and unrefutable but inconvenient
> answers to (e.g.) its American audience? Stock would plummet.

When is Forth's (our) second coming? Perhaps nobody here has invested in that :)

[minf...@arcor.de]

Brute-force permutations over the 10 decimal digits 0..9 don't rise factorially unless you
increase the base.

But principally you are right. The Magic Hexagon puzzle cannot be solved by calculating
all possible permutations over 19 positions - it would run for weeks (whereas Prolog
solves it within less than a second by working the constraints).

The point is that speed matters when you are sure a priori that there is at least one solution.

[Marcel Hendrix]

For me, there is still some magic attached to this approach. It seems obvious
that pruning the number of paths to try would always be better than randomly
trying them all.

-marcel

[minf...@arcor.de]

CLP is a truly fascinating topic, very much underrated. Sniff into the basics (see page 20ff):
https://www.cs.upc.edu/~erodri/webpage/cps/theory/cp/intro/slides.pdf

Software-wise, backtracking requires keeping complete search states in memory for each branch.
Those states comprise the (so-far pruned) domains of each variable, those are big objects.
https://en.wikipedia.org/wiki/AC-3_algorithm

There is a rather compact Python constraint solver:
https://files.pythonhosted.org/packages/37/8b/5f1bc2734ca611943e1d6733ee244238679f6410a10cd45ede55a61a8402/python-constraint-1.4.0.tar.bz2
Sources are in subfolder /constraint/__init.py__

Standard Forth would have to be tooled up too much to hope to come close to it.

[Marcel Hendrix]

On Saturday, February 18, 2023 at 8:59:35 AM UTC+1, Marcel Hendrix wrote:
[..]

> For me, there is still some magic attached to this approach. It seems obvious
> that pruning the number of paths to try would always be better than randomly
> trying them all.
>
> -marcel

One thing that tricked me was that the best algorithm had very little variation in the
elapsed time. That is solved: I forgot that I averaged over 1000 runs. That removes
most of the magic.

Here is a graph:

FORTH> GO:
data = [
1483 11
4711 32
2281 15
787 5
1418 10
1500 10
1218 8
194 1
2748 19
757 5
3062 20
6727 45
9049 61
996 7
139 1
5418 36
1530 10
7151 47
2122 14
6732 45
2220 15
1933 12
1448 9
526 3
353 2
9012 61
7225 49
3592 24
6518 45
351 2
253 1
3328 22
5591 37
530 3
642 4
908 6
2517 16
3824 26
1385 9
3503 23
6569 44
3014 20
494 3
2379 15
458 3
1606 11
243 2
4478 29
4999 33
362 2
3765 24
5302 37
9505 65
1267 8
1490 10
6159 41
1159 8
1787 12
3057 20
3445 23
3562 24
8708 62
1368 10
3411 24
1053 7
707 4
4901 32
51 0
1579 11
1292 8
2696 18
978 6
1026 7
3886 27
7605 50
2282 15
1088 7
2847 19
1502 10
1313 9
9272 66
3985 26
855 6
903 6
7492 50
477 3
6297 42
382 2
757 5
1498 9
4803 32
3441 23
1627 11
3508 23
7551 51
2280 16
2264 15
5765 38
560 4
43 0
]; sd = sort(data);
figure(1); clf;
plot(0.001*sd(:,1),sd(:,2),'LineWidth',2); grid on;
xlabel('\bftries [x1000]'); ylabel('\bfelapsed time [\mus]'); title('\bfSEND+MORE=MONEY in iForth')

See https://ibb.co/Brp9Hcy .

So it more or less linear in time, with a very likelyhood that it more than 10,000 tries are needed.
As shown earlier, with 1000 tries 20 useconds worst-case is almost guaranteed.

-marcel

[Marcel Hendrix]

On Saturday, February 18, 2023 at 10:25:20 AM UTC+1, minf...@arcor.de wrote:
> Marcel Hendrix schrieb am Samstag, 18. Februar 2023 um 08:59:35 UTC+1:
> > On Saturday, February 18, 2023 at 8:11:11 AM UTC+1, minf...@arcor.de wrote:

[..]

> Standard Forth would have to be tooled up too much to hope to come close to it.

I won't bite :--)

-marcel

[Hans Bezemer]

On Saturday, February 18, 2023 at 8:59:35 AM UTC+1, Marcel Hendrix wrote:

> For me, there is still some magic attached to this approach. It seems obvious
> that pruning the number of paths to try would always be better than randomly
> trying them all.

In essence you're right. I have my stack-optimizer discarding any diagrams which
result in datastack or returnstack underflow. However, there are plenty of sequences
that are clearly detrimental like:
DUP DROP
OVER DROP
SWAP SWAP
ROT ROT ROT
>R R>
R> >R
etc.

It makes no sense to pursue those. However, this list is not exhaustive. It would
most certainly complicate the program. And since it is a brute force program, it
eliminates only a limited number of cases - while burning up CPU time in order
to pursue them. So - how much time can you reasonably save here?

A seven word solution takes less than a second. Usually - if you need a solution
that exceeds 8 words, it's usually not going to work at all (in my experience) -
and you're better off with a solution using higher order words (like 2SWAP, 2DROP).

IMHO - always be careful when optimizing. I recently did some "optimizing" - and
while benchmarking I found out that in some cases, the "optimized" solution was
actually 10% SLOWER. So I combined the old AND the new routine in order to fix
that so in the WORST case scenario both were at least equally fast - and in the BEST
case the new one was almost twice as fast.

Lesson learned - no matter how well you think you know your own compiler, always
test your solutions and challenge your own assumptions.

Hans Bezemer

---8<---
$ pp4th -x stackopt.4th abc abcabc
- Trying a 1 word solution..
No solutions.
- Trying a 2 word solution..
No solutions.
- Trying a 3 word solution..
No solutions.
- Trying a 4 word solution..
No solutions.
- Trying a 5 word solution..
No solutions.
- Trying a 6 word solution..
No solutions.
- Trying a 7 word solution..
>r over over r@ rot rot r>
---8<---

[Marcel Hendrix]

On Saturday, February 18, 2023 at 4:01:54 PM UTC+1, Hans Bezemer wrote:
> On Saturday, February 18, 2023 at 8:59:35 AM UTC+1, Marcel Hendrix wrote:

[..]

> Hans Bezemer
>
> ---8<---
> $ pp4th -x stackopt.4th abc abcabc
> - Trying a 1 word solution..
> No solutions.
> - Trying a 2 word solution..
> No solutions.
> - Trying a 3 word solution..
> No solutions.
> - Trying a 4 word solution..
> No solutions.
> - Trying a 5 word solution..
> No solutions.
> - Trying a 6 word solution..
> No solutions.
> - Trying a 7 word solution..
> >r over over r@ rot rot r>
> ---8<---

: XINVERT5 PARAMS| a b c d e | e d c b a ;
: test 1 2 3 4 5 xinvert5 - - - * . ;

FORTH> see test
Flags: ANSI
$01348540 : test
$0134854A push #10 b#
$0134854C jmp .+10 ( $0124A102 ) offset NEAR
$01348551 ;
FORTH> test 10 ok

FORTH> : 3dup PARAMS| a b c | a b c a b c ;
Redefining `3dup` ok
FORTH> : test 1 2 3 3dup + - + - + . ;
Redefining `test` ok
FORTH> see test
Flags: ANSI
$013485C0 : test
$013485CA push 4 b#
$013485CC jmp .+10 ( $0124A102 ) offset NEAR
$013485D1 ;
FORTH> test 4 ok

-marcel