tiistai 7. helmikuuta 2023 klo 20.34.08 UTC+2 minf...@arcor.de kirjoitti:Sorry about losing indentations and making code hard to read....
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 . ;
SENDMOREMONEYI have solved this one using 8th, mainly as a test for building permutations and letting the eval do the job:
----------------------------------
needs string/translate
private
: generate \ a n --
a:new ( 0 a:push ) 2 pick times -rot
over 4 pick w:exec
0
repeat
dup 2 pick n:< if
3 pick over a:_@ over n:< if
dup 2 n:mod !if
2 pick 0 2 pick a:<> drop
else
2 pick 4 pick 2 pick a:_@ 2 pick a:<> drop
then
2 pick 5 pick w:exec
3 pick over a:@ n:1+ 2 pick swap a:! drop
drop 0
else
3 pick over 0 a:! drop
n:1+
then
else
break
then
again 3drop drop ;
public
\ Note: callback word receives array reference
: a:permutations \ a w --
swap a:len #p:generate ;
\ Now, try solving alphametics...
"SEND MORE + MONEY =" constant alphametics
alphametics /[A-Z]/ r:/ ' s:cmp a:sort ' s:= a:uniq "" a:join constant unique-chars
: any-leading-zeros?
/\b[0]/ r:match nip ;
: app:main
"0123456789" null s:/
( 0 8 a:slice "" a:join
alphametics unique-chars rot s:translate dup any-leading-zeros? !if
dup eval if
. cr break
else
drop
then
else
drop
then ) a:permutations ;
----------------------------------
Running it gives:
root@DietPi:~# /opt/8th/bin/rpi64/8th permute.8th
9567 1085 + 10652 =
root@DietPi:~#
tiistai 7. helmikuuta 2023 klo 21.15.56 UTC+2 Jali Heinonen kirjoitti:
tiistai 7. helmikuuta 2023 klo 20.34.08 UTC+2 minf...@arcor.de kirjoitti:
Today I doodled with constraint logic programming in Forth.
A classic beginner's example is the SEND+MORE=MONEY puzzlee,
where each letter stands for a digit in the range of 0 to 9
and which when concatenated represent a decimal number.
Constraint: all digits must be different.
I came up with the little program below using brute force.
It does its job, but ugly. Any ideas for improvement and acceleration?
Or syntax-wise? (Prolog does it so much more nicely).
\ ##### SENDMORE.FTH #####
: ALLDIFFERENT {: a b c d e f g h -- flag :}
false
a b = IF exit THEN
a c = IF exit THEN
a d = IF exit THEN
a e = IF exit THEN
a f = IF exit THEN
a g = IF exit THEN
a h = IF exit THEN
b c = IF exit THEN
b d = IF exit THEN
b e = IF exit THEN
b f = IF exit THEN
b g = IF exit THEN
b h = IF exit THEN
c d = IF exit THEN
c e = IF exit THEN
c f = IF exit THEN
c g = IF exit THEN
c h = IF exit THEN
d e = IF exit THEN
d f = IF exit THEN
d g = IF exit THEN
d h = IF exit THEN
e f = IF exit THEN
e g = IF exit THEN
e h = IF exit THEN
f g = IF exit THEN
f h = IF exit THEN
g h = IF exit THEN
drop true ;
: SENDMOREMONEY {: | s e n d m o r y s1 s2 s3 ct -- :}
0 to ct
1 9 DO i to s
1 9 DO i to m
1 9 DO i to e
1 9 DO i to d
0 9 DO i to n
0 9 DO i to o
0 9 DO i to r
0 9 DO i to y
s e n d m o r y alldifferent
IF
ct 1+ to ct
s 1000 * e 100 * + n 10 * + d + to s1
m 1000 * o 100 * + r 10 * + e + to s2
m 10000 * o 1000 * + n 100 * + e 10 * + y + to s3
s1 s2 + s3 =
IF
cr ." S=" s . ." E=" e . ." N=" n . ." D=" d .
cr ." M=" m . ." O=" o . ." R=" r . ." Y=" y .
cr ." " s1 . cr ." +" s2 . cr ." -----" cr ." " s3 .
THEN
THEN
-1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP ." loops:" ct . ;
SENDMOREMONEYI 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.8thSorry about losing indentations and making code hard to read....
9567 1085 + 10652 =
root@DietPi:~#
Today I doodled with constraint logic programming in Forth.
A classic beginner's example is the SEND+MORE=MONEY puzzlee,
where each letter stands for a digit in the range of 0 to 9
and which when concatenated represent a decimal number.
Constraint: all digits must be different.
I came up with the little program below using brute force.
It does its job, but ugly. Any ideas for improvement and acceleration?
Or syntax-wise? (Prolog does it so much more nicely).
\ ##### SENDMORE.FTH #####
: ALLDIFFERENT {: a b c d e f g h -- flag :}
false
a b = IF exit THEN
a c = IF exit THEN
a d = IF exit THEN
a e = IF exit THEN
a f = IF exit THEN
a g = IF exit THEN
a h = IF exit THEN
b c = IF exit THEN
b d = IF exit THEN
b e = IF exit THEN
b f = IF exit THEN
b g = IF exit THEN
b h = IF exit THEN
c d = IF exit THEN
c e = IF exit THEN
c f = IF exit THEN
c g = IF exit THEN
c h = IF exit THEN
d e = IF exit THEN
d f = IF exit THEN
d g = IF exit THEN
d h = IF exit THEN
e f = IF exit THEN
e g = IF exit THEN
e h = IF exit THEN
f g = IF exit THEN
f h = IF exit THEN
g h = IF exit THEN
drop true ;
: SENDMOREMONEY {: | s e n d m o r y s1 s2 s3 ct -- :}
0 to ct
1 9 DO i to s
1 9 DO i to m
1 9 DO i to e
1 9 DO i to d
0 9 DO i to n
0 9 DO i to o
0 9 DO i to r
0 9 DO i to y
s e n d m o r y alldifferent
IF
ct 1+ to ct
s 1000 * e 100 * + n 10 * + d + to s1
m 1000 * o 100 * + r 10 * + e + to s2
m 10000 * o 1000 * + n 100 * + e 10 * + y + to s3
s1 s2 + s3 =
IF
cr ." S=" s . ." E=" e . ." N=" n . ." D=" d .
cr ." M=" m . ." O=" o . ." R=" r . ." Y=" y .
cr ." " s1 . cr ." +" s2 . cr ." -----" cr ." " s3 .
THEN
THEN
-1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP -1 +LOOP
." loops:" ct . ;
SENDMOREMONEY
I 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).
Jali Heinonen schrieb am Dienstag, 7. Februar 2023 um 20:22:24 UTC+1:
Thank you! Permutations could narrow the search space significantly indeed.
I have to think about how to implement them in standard Forth in order to replace
those eight nested DO..LOOPs with one single permutation loop.
Today I doodled with constraint logic programming in Forth.[..]
SENDMOREMONEY
Today I doodled with constraint logic programming in Forth.[..]
SENDMOREMONEY
Writing about it, I get inspired to try it myself:
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?
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
"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!Not even alldifferent([S,E,N,D,M,O,R,Y])? No way to influence the
The magic happens within the #= operator.
labeling? Too much magic.
0, M#>0,all_different([S,E,N,D,M,O,R,Y]), % step 2
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.
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 justified remark comes from my too abbreviated example. If you want to seeThis is the complete program to solve the puzzle!Not even alldifferent([S,E,N,D,M,O,R,Y])? No way to influence the
The magic happens within the #= operator.
labeling? Too much magic.
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
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
A classic beginner's example is the SEND+MORE=MONEY puzzlee,
SENDMOREMONEYHi everybody,
Here is a program that gives all possible solutions (there are 25), written in gforth.
Today I doodled with constraint logic programming in Forth.Hi everybody,
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
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 = MONEYOh. All 3 numbers have a '5' and that is not a problem... I will have to look elsewhere to get an exact description.
$ time python3 smm.py
9567 1085 10652
real 0m3.966s
user 0m3.960s
sys 0m0.001s
Paul Rubin <no.e...@nospam.invalid> writes:
$ time python3 smm.py
9567 1085 10652
real 0m3.966sI 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
user 0m3.960s
sys 0m0.001s
instructions:
Rubin minforth Ertl
9_969_117_645 6_428_853_392 39_964 cycles:u
31_937_879_569 19_625_679_081 114_372 instructions:u
You only generate 10!=3_628_800 permutations, while minforth generates 100_000_000 variants that he checks for the alldifferent property only afterwards, but apparently the constant factor of Python3 is so much
worse than that of gforth-fast that minforth's version prevails.
I have now also tried minforth's version on several Forth systems for performance comparison:
gforth-fast lxf SwiftForth 3.11 VFX 4.72
6_428_853_392 2_025_393_969 9_556_676_271 5_941_247_227 cycles:u 19_625_679_081 5_033_144_283 13_662_547_049 9_003_308_671 instructions:u
Let's see if SwiftForth and VFX are better in newer versions (on a Zen3):
gforth-fast lxf sf 4.0.0-RC52 VFX 64 5.11
5_996_105_179 1_661_344_432 5_205_443_081 6_991_357_051 cycles:u 19_625_279_724 5_033_144_483 11_408_344_112 9_084_604_055 instructions:u
My guess is that the locals in ALLDIFFERENT play a large role in the performance. Even with the mediocre locals implementation of
SwiftForth and VFX, it's surprising that gforth-fast is so close to
VFX and SwiftForth, even beating the old SwiftForth and the new VFX;
after all, Gforth's locals implementation is not that great, either.
lxf demonstrates that locals can be implemented much faster.
- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html New standard: https://forth-standard.org/
EuroForth 2022: https://euro.theforth.net
My guess is that the locals in ALLDIFFERENT play a large role in the performance.
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.
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?
Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 09:00:14 UTC+1:Hi,
Thanks! 25 solutions appear when M is allowed to be zero.SENDMOREMONEYHi everybody,
Here is a program that gives all possible solutions (there are 25), written in gforth.
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.
Le jeudi 9 février 2023 à 08:13:20 UTC, minf...@arcor.de a écrit :
Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 09:00:14 UTC+1:
Thanks! 25 solutions appear when M is allowed to be zero.SENDMOREMONEYHi everybody,
Here is a program that gives all possible solutions (there are 25), written in gforth.
Even more solutions appear when the all-digits-different constraint is taken out.
I am fascinated by those many completely different approaches in this thread.Hi,
For the case of m<>0 (so m must be 1), the same program gives the also the unique result, by selecting the solution with m=1.
To get the unique result directly,one can set 1 to m, and search for the others.
Here is the program (the same as the previous, with some changes)
s" random.fs" included
: not 0= ;
0 value s
0 value e
0 value n
0 value d
0 value m
0 value o
0 value r
0 value y
: send s 10 * e + 10 * n + 10 * d + ;
: more m 10 * o + 10 * r + 10 * e + ;
: money m 10 * o + 10 * n + 10 * e + 10 * y + ;
: is_send+more=money_? send more + money - 0= ;
create flags_chosen_vals 10 allot
flags_chosen_vals 10 erase
create flags_chosen_sendmory 8 allot
flags_chosen_sendmory 8 erase
: choose 10 random ;
: chosen flags_chosen_vals + 1 swap c! ;
: chosen_? flags_chosen_vals + c@ ;
: chosen_var_set flags_chosen_sendmory + 1 swap c! ;
: chosen_var_get flags_chosen_sendmory + c@ ;
: chosen--> dup chosen ;
: chosen_vars_init flags_chosen_sendmory 8 erase ;
: chosen_vals_init flags_chosen_vals 10 erase ;
: to_s choose chosen--> to s 0 chosen_var_set ;
: to_e choose dup chosen_? if drop else chosen--> to e 1 chosen_var_set then ;
: to_n choose dup chosen_? if drop else chosen--> to n 2 chosen_var_set then ;
: to_d choose dup chosen_? if drop else chosen--> to d 3 chosen_var_set then ;
: to_m choose dup chosen_? if drop else chosen--> to m 4 chosen_var_set then ;
: to_o choose dup chosen_? if drop else chosen--> to o 5 chosen_var_set then ;
: to_r choose dup chosen_? if drop else chosen--> to r 6 chosen_var_set then ;
: to_y choose dup chosen_? if drop else chosen--> to y 7 chosen_var_set then ;
: gen_sendmory
chosen_vals_init
1 chosen \ mark digit 1 as already chosen
chosen_vars_init
4 chosen_var_set \ mark m as already chosen
1 to m \ and set to 1
to_s
begin 1 chosen_var_get not while to_e repeat
begin 2 chosen_var_get not while to_n repeat
begin 3 chosen_var_get not while to_d repeat
\ begin 4 chosen_var_get not while to_m repeat
begin 5 chosen_var_get not while to_o repeat
begin 6 chosen_var_get not while to_r repeat
begin 7 chosen_var_get not while to_y repeat
;
: .sendmory s . e . n . d . m . o . r . y . ;
: sendmory_as_number s 10 * e + 10 * n + 10 * d + 10 * m + 10 * o + 10 * r + 10 * y + ;
1000 value max_results_size
create results max_results_size cells allot
0 value result_counter
: to_results
sendmory_as_number
result_counter 0 ?do
dup i cells results + @ = if
drop unloop exit
then
loop
result_counter cells results + !
result_counter 1+ to result_counter
result_counter cr . ." solutions found"
;
: go_sendmoremoney
cr
." solving ..."
0 to result_counter
0 do
gen_sendmory
is_send+more=money_? if
( cr .sendmory)
to_results
unloop exit
then
loop
cr cr result_counter . ." solutions found"
;
: .send send 4 .r ;
: .more more 4 .r ;
: .money money 5 .r ;
: to_sendmory
10000000 /mod to s
1000000 /mod to e
100000 /mod to n
10000 /mod to d
1000 /mod to m
100 /mod to o
10 /mod to r
to y
;
: .send+more=money .send ." + " .more ." = " .money ;Hi, again,
: .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 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 )
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.
Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 13:47:02 UTC+1:Hi again,
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 )
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.
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?
Le jeudi 9 février 2023 à 14:24:39 UTC, minf...@arcor.de a écrit :
Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 13:47:02 UTC+1:
For the case of m<>0 (so m must be 1), the same program gives the also the unique result, by selecting the solution with m=1.Merci de tes contributions! Of course M has to be 1 because it has to be a carry bit.
So you used a mathematical property of one of the constraints to manually reduce your search space.
BTW this shows an interesting common aspect between all the various Forth proposals:
In their manually coded program formulation they freely join/mix/meddle walking the search space with constraint properties.
Therefore many different solutions appear on the table depending on programmer's expertise or preference.
Declarative constraint programming languages don't have to do this (ideally). They go in distinctive not related steps:
1) declare the variable domains ( here: integers ranging from 0 to 9 )
2) span the search space in toto ( here: 8 variables SENDMORY )
3) declare the constraints ( here: M<>0 and SEND+MORE=MONEY and all variables unique)
\ BTW: M<>0 not because of the other constraint but because otherwise MONEY would be written as ONEY ! )
4) solve it.
( of course real CLP programmers also use their optimization toolbelts ... but that's a different story )
So this is a very generic and very versatile approach! One can add/delete/change constraints in one place without
having to rewrite the program. And the best: bug-free from start.
How would a Forth programmer come close to this?
( for fun: try to solve TO+GO=OUT )Hi again,
Prolog implemets CLP (Constrained Logic Programming), so one can solve this type of problems.
There is a prolog compiler written in forth, (see forth dimension magazine). One can create a DSL in forth to solve this type of problems.
Yes the solution given previously is specific to this case.
But the approach can be generalized.
Here is the adaptation of the previous program to the case to+go=out. Perhaps, this gives an idea to generalize this approach to solve this type of problems.
s" random.fs" included
: not 0= ;
0 value t
0 value o
0 value g
0 value u
: to_ t 10 * o + ;
: go_ g 10 * o + ;
: out_ o 10 * u + 10 * t + ;
: is_to+go=out_? to_ go_ + out_ - 0= ;
create flags_chosen_vals 10 allot
flags_chosen_vals 10 erase
create flags_chosen_togu 4 allot
flags_chosen_togu 4 erase
: choose 10 random ;
: chosen flags_chosen_vals + 1 swap c! ;
: chosen_? flags_chosen_vals + c@ ;
: chosen_var_set flags_chosen_togu + 1 swap c! ;
: chosen_var_get flags_chosen_togu + c@ ;
: chosen--> dup chosen ;
: chosen_vars_init flags_chosen_togu 4 erase ;
: chosen_vals_init flags_chosen_vals 10 erase ;
: to_t choose chosen--> to t 0 chosen_var_set ;
: to_o choose dup chosen_? if drop else chosen--> to o 1 chosen_var_set then ;
: to_g choose dup chosen_? if drop else chosen--> to g 2 chosen_var_set then ;
: to_u choose dup chosen_? if drop else chosen--> to u 3 chosen_var_set then ;
: gen_togu
chosen_vals_init
1 chosen \ mark digit 1 as already chosen
chosen_vars_init
1 chosen_var_set \ mark o as already chosen
1 to o \ and set to 1
begin 0 chosen_var_get not while to_t repeat
begin 2 chosen_var_get not while to_g repeat
begin 3 chosen_var_get not while to_u repeat
;
: .togu t . o . g . u . ;
: togu_as_number t 10 * o + 10 * g + 10 * u + ;
1000 value max_results_size
create results max_results_size cells allot
0 value result_counter
: to_results
togu_as_number
result_counter 0 ?do
dup i cells results + @ = if
drop
unloop exit
then
loop
result_counter cells results + !
result_counter 1+ to result_counter
result_counter cr . ." solutions found"
;
: go_togoout
cr
." solving ..."
0 to result_counter
0 do
gen_togu
is_to+go=out_? if
( cr .togu)
to_results
\ unloop exit
then
loop
cr cr result_counter . ." solutions found"
;
: .to to_ 2 .r ;
: .go go_ 2 .r ;
: .out out_ 3 .r ;
: to_togu
1000 /mod to t
100 /mod to o
10 /mod to g
to u
;
: .to+go=out .to ." + " .go ." = " .out ;
: .results
." sol_num togu to + go = out"
result_counter 0 ?do
cr i 7 .r 3 spaces
i cells results + @ dup
. 3 spaces
to_togu .to+go=out
loop
;
: .unique_resultHi,
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
Can ALLDIFFERENT be eliminated by using bit presentation for numbers,
The lxf result demonstrates that locals can be implemented much more >efficiently than in VFX or in SwiftForth.
"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:Not sure what step 2 and step 4 means.
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 )
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.
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 <no.e...@nospam.invalid> writes:
I will try the same thing in Haskell when I get a chance, and alsoHere is the Haskell version. CPU time with ghc 8.8.4 -O3 is 0.472s sec
try to figure out what is going wrong in my Forth version.
so about 6x the speed of Python3 3.9 on my laptop. In both cases there
are obvious optimizations possible at the expense of complicating the
code slightly, such as generating only half the permutations instead
of throwing away the ones with x0>=x1. GHC 8.8.4 is now somewhat
outdated and newer versions might generate the better code.
Note the type annotation (Int,Int,Int) which tells the compiler that
the values are (64 bit) machine integers. Without the annotation it
would use Integer which is bignums. In that case, cpu time is 1.085s,
so still 3x the speed of Python.
================================================================
import Data.List (permutations)
main = print $ [(send,more,money) :: (Int,Int,Int)
| [x0,x1,s,e,n,d,m,o,r,y] <- permutations [0..9]
, x0 < x1 && m > 0
, let { send=1000*s+100*e+10*n+d;
more=1000*m+100*o+10*r+e;
money=10000*m+1000*o+100*n+10*e+y
}
, send+more == money
]
This over my head. X0 and X1 declared but never used?
Wild guess: these are control variable to create a smaller triangulated (triangulized?) search space
Le jeudi 9 février 2023 à 12:47:02 UTC, Ahmed MELAHI a écrit :
Le jeudi 9 février 2023 à 08:13:20 UTC, minf...@arcor.de a écrit :
Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 09:00:14 UTC+1:
Thanks! 25 solutions appear when M is allowed to be zero.SENDMOREMONEYHi everybody,
Here is a program that gives all possible solutions (there are 25), written in gforth.
Even more solutions appear when the all-digits-different constraint is taken out.
I am fascinated by those many completely different approaches in this thread.Hi,
For the case of m<>0 (so m must be 1), the same program gives the also the unique result, by selecting the solution with m=1.
To get the unique result directly,one can set 1 to m, and search for the others.
Here is the program (the same as the previous, with some changes)
s" random.fs" included
: not 0= ;
0 value s
0 value e
0 value n
0 value d
0 value m
0 value o
0 value r
0 value y
: send s 10 * e + 10 * n + 10 * d + ;
: more m 10 * o + 10 * r + 10 * e + ;
: money m 10 * o + 10 * n + 10 * e + 10 * y + ;
: is_send+more=money_? send more + money - 0= ;
create flags_chosen_vals 10 allot
flags_chosen_vals 10 erase
create flags_chosen_sendmory 8 allot
flags_chosen_sendmory 8 erase
: choose 10 random ;
: chosen flags_chosen_vals + 1 swap c! ;
: chosen_? flags_chosen_vals + c@ ;
: chosen_var_set flags_chosen_sendmory + 1 swap c! ;
: chosen_var_get flags_chosen_sendmory + c@ ;
: chosen--> dup chosen ;
: chosen_vars_init flags_chosen_sendmory 8 erase ;
: chosen_vals_init flags_chosen_vals 10 erase ;
: to_s choose chosen--> to s 0 chosen_var_set ;
: to_e choose dup chosen_? if drop else chosen--> to e 1 chosen_var_set then ;
: to_n choose dup chosen_? if drop else chosen--> to n 2 chosen_var_set then ;
: to_d choose dup chosen_? if drop else chosen--> to d 3 chosen_var_set then ;
: to_m choose dup chosen_? if drop else chosen--> to m 4 chosen_var_set then ;
: to_o choose dup chosen_? if drop else chosen--> to o 5 chosen_var_set then ;
: to_r choose dup chosen_? if drop else chosen--> to r 6 chosen_var_set then ;
: to_y choose dup chosen_? if drop else chosen--> to y 7 chosen_var_set then ;
: gen_sendmory
chosen_vals_init
1 chosen \ mark digit 1 as already chosen
chosen_vars_init
4 chosen_var_set \ mark m as already chosen
1 to m \ and set to 1
to_s
begin 1 chosen_var_get not while to_e repeat
begin 2 chosen_var_get not while to_n repeat
begin 3 chosen_var_get not while to_d repeat
\ begin 4 chosen_var_get not while to_m repeat
begin 5 chosen_var_get not while to_o repeat
begin 6 chosen_var_get not while to_r repeat
begin 7 chosen_var_get not while to_y repeat
;
: .sendmory s . e . n . d . m . o . r . y . ;
: sendmory_as_number s 10 * e + 10 * n + 10 * d + 10 * m + 10 * o + 10 * r + 10 * y + ;
1000 value max_results_size
create results max_results_size cells allot
0 value result_counter
: to_results
sendmory_as_number
result_counter 0 ?do
dup i cells results + @ = if
drop unloop exit
then
loop
result_counter cells results + !
result_counter 1+ to result_counter
result_counter cr . ." solutions found"
;
: go_sendmoremoney
cr
." solving ..."
0 to result_counter
0 do
gen_sendmory
is_send+more=money_? if
( cr .sendmory)
to_results
unloop exit
then
loop
cr cr result_counter . ." solutions found"
;
: .send send 4 .r ;
: .more more 4 .r ;
: .money money 5 .r ;
: to_sendmory
10000000 /mod to s
1000000 /mod to e
100000 /mod to n
10000 /mod to d
1000 /mod to m
100 /mod to o
10 /mod to r
to y
;
: .send+more=money .send ." + " .more ." = " .money ;
: .results
." sol_num sendmory send + more = money"
result_counter 0 ?do
cr i 7 .r 3 spaces
i cells results + @ dup
. 3 spaces
to_sendmory .send+more=money
loop
;
: .unique_result
cr ." The unique solution is:" cr
cr
." send + more = money"
cr
result_counter 0 ?do
i cells results + @ dup
to_sendmory
m 1 = if
.send+more=money
unloop
exit
then
loop
;
: go go_sendmoremoney cr .unique_result ;
10000000 go
byeHi, again,
In the previous program, there is a result left on the data stack. it must be dropped.
The new version is here
s" random.fs" included
: not 0= ;
0 value s
0 value e
0 value n
0 value d
0 value m
0 value o
0 value r
0 value y
: send s 10 * e + 10 * n + 10 * d + ;
: more m 10 * o + 10 * r + 10 * e + ;
: money m 10 * o + 10 * n + 10 * e + 10 * y + ;
: is_send+more=money_? send more + money - 0= ;
create flags_chosen_vals 10 allot
flags_chosen_vals 10 erase
create flags_chosen_sendmory 8 allot
flags_chosen_sendmory 8 erase
: choose 10 random ;
: chosen flags_chosen_vals + 1 swap c! ;
: chosen_? flags_chosen_vals + c@ ;
: chosen_var_set flags_chosen_sendmory + 1 swap c! ;
: chosen_var_get flags_chosen_sendmory + c@ ;
: chosen--> dup chosen ;
: chosen_vars_init flags_chosen_sendmory 8 erase ;
: chosen_vals_init flags_chosen_vals 10 erase ;
: to_s choose chosen--> to s 0 chosen_var_set ;
: to_e choose dup chosen_? if drop else chosen--> to e 1 chosen_var_set then ;
: to_n choose dup chosen_? if drop else chosen--> to n 2 chosen_var_set then ;
: to_d choose dup chosen_? if drop else chosen--> to d 3 chosen_var_set then ;
: to_m choose dup chosen_? if drop else chosen--> to m 4 chosen_var_set then ;
: to_o choose dup chosen_? if drop else chosen--> to o 5 chosen_var_set then ;
: to_r choose dup chosen_? if drop else chosen--> to r 6 chosen_var_set then ;
: to_y choose dup chosen_? if drop else chosen--> to y 7 chosen_var_set then ;
: gen_sendmory
chosen_vals_init
1 chosen \ mark digit 1 as already chosen
chosen_vars_init
4 chosen_var_set \ mark m as already chosen
1 to m \ and set to 1
to_s
begin 1 chosen_var_get not while to_e repeat
begin 2 chosen_var_get not while to_n repeat
begin 3 chosen_var_get not while to_d repeat
\ begin 4 chosen_var_get not while to_m repeat
begin 5 chosen_var_get not while to_o repeat
begin 6 chosen_var_get not while to_r repeat
begin 7 chosen_var_get not while to_y repeat
;
: .sendmory s . e . n . d . m . o . r . y . ;
: sendmory_as_number s 10 * e + 10 * n + 10 * d + 10 * m + 10 * o + 10 * r + 10 * y + ;
1000 value max_results_size
create results max_results_size cells allot
0 value result_counter
: to_results
sendmory_as_number
result_counter 0 ?do
dup i cells results + @ = if
drop unloop exit
then
loop
result_counter cells results + !
result_counter 1+ to result_counter
result_counter cr . ." solutions found"
;
: go_sendmoremoney
cr
." solving ..."
0 to result_counter
0 do
gen_sendmory
is_send+more=money_? if
( cr .sendmory)
to_results
unloop exit
then
loop
cr cr result_counter . ." solutions found"
;
: .send send 4 .r ;
: .more more 4 .r ;
: .money money 5 .r ;
: to_sendmory
10000000 /mod to s
1000000 /mod to e
100000 /mod to n
10000 /mod to d
1000 /mod to m
100 /mod to o
10 /mod to r
to y
;
: .send+more=money .send ." + " .more ." = " .money ;
: .results
." sol_num sendmory send + more = money"
result_counter 0 ?do
cr i 7 .r 3 spaces
i cells results + @ dup
. 3 spaces
to_sendmory .send+more=money
loop
;
: .unique_resultHi,
cr ." The unique solution is:" cr
cr
." send + more = money"
cr
result_counter 0 ?do
i cells results + @
to_sendmory
m 1 = if
.send+more=money
unloop
exit
then
loop
;
: go go_sendmoremoney cr .unique_result ;
10000000 go
\ -------N.B.---------
utime 10000000 go utime d- dnegate d>f 1e-6 f* f. \ less than 1 second
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.
Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 13:47:02 UTC+1: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.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 )
Paul Rubin <no.email@nospam.invalid> writes:
I will try the same thing in Haskell when I get a chance, and also
try to figure out what is going wrong in my Forth version.
Here is the Haskell version. CPU time with ghc 8.8.4 -O3 is 0.472s sec
so about 6x the speed of Python3 3.9 on my laptop. In both cases there
are obvious optimizations possible at the expense of complicating the
code slightly, such as generating only half the permutations instead
of throwing away the ones with x0>=x1.
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
Plus, in a really good native-code Forth system (beyond what current
Forth systems do), locals will also be more efficient, because they
can be kept in registers, while global variables have to be stored
into memory.
- anton
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 currentI hope to demonstrate that VARIABLE can be optimised away as easily
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.
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 ;-) )
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.
Another solution using the same method by Wirth in nqueen problem (backtracking was called)[..]
It is not optimized and gets the solution.
On Saturday, February 11, 2023 at 8:21:06 AM UTC+1, Ala'a wrote: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:
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 FILLI found out when trying to run the program more than once.
-marcel
On Friday, February 10, 2023 at 9:22:12 PM UTC+1, Ala'a wrote:
Another solution using the same method by Wirth in nqueen problem (backtracking was called)[..]
It is not optimized and gets the solution.Not bad, only 1 unfamiliar word ( /allot ), and runs in 14.84 ms ( iForth64 ).
FORTH> go
9 5 6 7
1 0 8 5
+ _ _ _ _
1 0 6 5 2 14.83 milliseconds elapsed, tries# = 7921010 ok
-marcel
On Saturday, February 11, 2023 at 3:25:52 AM UTC+4, Marcel Hendrix wrote:[..]
On Friday, February 10, 2023 at 9:22:12 PM UTC+1, Ala'a wrote:
Another solution using the same method by Wirth in nqueen problem (backtracking was called)
/Allot is combination of ALLOT and 0 FILL
In article <2023Feb9.115420@mips.complang.tuwien.ac.at>,
Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
<SNIP>
Plus, in a really good native-code Forth system (beyond what current
Forth systems do), locals will also be more efficient, because they
can be kept in registers, while global variables have to be stored
into memory.
I hope to demonstrate that VARIABLE can be optimised away as easily
as locals.
Also there is a false dichotomy (cause by the LOCAL mindset)
between local and global variables.
In a proper Pascal implementation of qsort there is an intermediate
storage where e.g. the pointers to procedures are stored.
They are global to qsort proper, and local to the main program.
It is almost impossible to break out of the mindset of
language like c and Forth that cannot have local functions that
have their own variables. (So I don't blame you ;-) )
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.
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.
On Saturday, February 11, 2023 at 11:09:13 AM UTC+1, Marcel Hendrix wrote: [..]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)
That improves the timing from 14.83 to 8.93 milliseconds.I was quite happy to find this numerical shortcut:
The #tries decreases from 7921010 to 5092470.
\ : 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
On Saturday, February 11, 2023 at 6:52:50 PM UTC+4, Marcel Hendrix wrote:using the solution values and changing the indexes of the letters based on their value based on that, help in pruning the search space:
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.I was quite happy to find this numerical shortcut:
The #tries decreases from 7921010 to 5092470.
\ : 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.
-marcelThis 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)
Ahmed MELAHI schrieb am Donnerstag, 9. Februar 2023 um 13:47:02 UTC+1: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.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 )
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
gforth sendmoremoney_3.fs -e "bye"Solving ...
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.
Ahmed MELAHI schrieb am Samstag, 11. Februar 2023 um 23:41:19 UTC+1:Hi,
Hi,Each time you were restarting gforth, reloading the program from drive (cache)
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.
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?
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:
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
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:
Ahmed MELAHI schrieb am Samstag, 11. Februar 2023 um 23:41:19 UTC+1:
Hi,Each time you were restarting gforth, reloading the program from drive (cache)
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.
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?
gforthGforth 0.7.9_20170112, Copyright (C) 1995-2016 Free Software Foundation, Inc. Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
gforth sendmoremoney_4.fs -e "bye"
"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
On Saturday, February 11, 2023 at 11:41:19 PM UTC+1, Ahmed MELAHI wrote:Yes, I noticed that.
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 manyThanks for testing the program.
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 = ;
gforth example_17___.fs -e "bye"
-marcel
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.
Randomly test variable combinations and stop when a valid solution
is found.
There must be more to it ...=20
1. Can it be proven that this is faster than testing all possible combinati= >ons.=20
2. Does the algorithm stop in finite time.
This is parallellizable and scales linearly with the number of CPUs?!
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.
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?)
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.
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.
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.
gforth example_17___.fs
gforth example_17___.fs
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.
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.
Ahmed MELAHI schrieb am Sonntag, 12. Februar 2023 um 17:38:04 UTC+1:
The big difference to other optimization problems is that here the functions areThis 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.
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.
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.
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.
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
f RECURSE f>s d 1- ROLLLOOP
THEN ;
0 1 2 3 4 5 6 7 8 9 rec bye
Paul Rubin schrieb am Montag, 13. Februar 2023 um 21:31:27 UTC+1:
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
f RECURSE f>s d 1- ROLLLOOP
THEN ;
0 1 2 3 4 5 6 7 8 9 rec bye
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
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.
Gerry Jackson <do-not-use@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.
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.
Gerry Jackson <do-no...@swldwa.uk> writes:
ISTM that using Heap's algorithm to generate the permutations... ThisI wasn't familiar with this algorithm. It sounds like a good approach,
is because the algorithm generates each permutation from the previous
one by interchanging a single pair of elements.
and I will have to study it.
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.
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' :--)
Brain the size of a planet and you give it useless tasks to perform.
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.
minf...@arcor.de schrieb am Mittwoch, 15. Februar 2023 um 10:16:33 UTC+1:[..]
10 PERMUTE-NR
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 ) :--(
Think of it, computers have come a long way since.
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
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
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.
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.
On 18/02/2023 12:36 am, minf...@arcor.de wrote:
Here's with non-recursive permutation algorithm. Quick timing showed no speedHaven't measured it but appears to be less of an issue than the time taken
increase significant for practical purposes. Only benefit would be less 'stress' on the
return stack.
to generate the permutations which rises factorially. The latter is likely
to get you first.
dxforth schrieb am Samstag, 18. Februar 2023 um 01:51:35 UTC+1:
On 18/02/2023 12:36 am, minf...@arcor.de wrote:
Brute-force permutations over the 10 decimal digits 0..9 don't rise factorially unless youHere's with non-recursive permutation algorithm. Quick timing showed no speedHaven'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.
increase significant for practical purposes. Only benefit would be less 'stress' on the
return stack.
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.
On Saturday, February 18, 2023 at 8:11:11 AM UTC+1, minf...@arcor.de wrote:
dxforth schrieb am Samstag, 18. Februar 2023 um 01:51:35 UTC+1:
On 18/02/2023 12:36 am, minf...@arcor.de wrote:
Brute-force permutations over the 10 decimal digits 0..9 don't rise factorially unless youHere's with non-recursive permutation algorithm. Quick timing showed no speedHaven't measured it but appears to be less of an issue than the time taken
increase significant for practical purposes. Only benefit would be less 'stress' on the
return stack.
to generate the permutations which rises factorially. The latter is likely
to get you first.
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.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.
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
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.
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
R R>etc.
R
r over over r@ rot rot r>---8<---
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 - - - * . ;
On Saturday, February 18, 2023 at 5:13:05 PM UTC+1, Marcel Hendrix wrote:
: XINVERT5 PARAMS| a b c d e | e d c b a ;
: test 1 2 3 4 5 xinvert5 - - - * . ;
Yeah, if you don't mind using your stack as an array, this is quite a viable solution.
As a matter of fact - it would solve just about ANY issues one had with stack acrobatics.
Can't say I have never considered it. Can't say it wouldn't solve any issues. But
it doesn't quite feel like Forth.
And that's all I'm gonna say about THAT ;-)
Hans Bezemer
: 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
Marcel Hendrix schrieb am Samstag, 18. Februar 2023 um 17:13:05 UTC+1:
: 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
Nice example of compile-time evaluation!FORTH> : test0 2 3 4 5 xinvert5 - - - * . :
Being curious, what happens with:
: test0 2 3 4 5 xinvert5 - - - * . :
1 test0
Are you saying that ">r over over r@ rot rot r>" does NOT directly or eventually
lead to stack manipulation in the way you do it?
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.
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 <m...@iae.nl> writes:
Are you saying that ">r over over r@ rot rot r>" does NOT directly or eventually
lead to stack manipulation in the way you do it?
"minf...@arcor.de" <minf...@arcor.de> writes:
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__
More than 1500 lines. Compact?
Standard Forth would have to be tooled up too much to hope to come close to it.
I expect to need much less than 1500 lines for a semi-general approach
that you just need to feed the constraints, domains, and a labeler to
solve stuff like SEND+MORE=MONEY, the Magic Hexagon, and Sudokus. Of
course, if you want more involved solvers, you can invest a lot more
lines of code.
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.
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:
"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.
To become "digestible" you've got to scrap a darn lot of lines.More than 1500 lines. Compact?Take away the comments and it becomes more digestible.
However, the most import part of the input is clearly "SEND+MORE=MONEY", and chatGPT has been trained what that is, or can find it somewhere (just like a human
being would look it up with his Google glasses). This implies it also can find
answers to this puzzle, and can regurgitate or rewrite the most suitable (in a
technical sense) one. A more challenging question would be to create a puzzle
with a different trigger phrase, like "zend-meer=pecunia". I suspect it will find
the connection to the original, but it is now forced to write its own program
(although it probably just tries randomly, depending on its computing resources).
Now solve for this one: TILES+PUZZLES=PICTUREwill try again to find a valid solution to TILES + PUZZLES = PICTURE.
And the sum TILES + PUZZLES = PICTURE can be written as: 97546 + 5045021 = 5142567
That's incorrect. Both TILES and PUZZLES end with an "S" - yet the numbers are different in the addition. Try again.
This works! Therefore, the solution is TILES=19357, PUZZLES=73315, and PICTURE=926722.
Wrong again. Both TILES and PUZZLES end in an "S". Yet the numbers of the addition are different.
Therefore, TILES + PUZZLES = PICTURE is true when TILES is 95831 and PUZZLES is 762215.
What about 91542+3077542=3169084?
I'm sorry, but 91542+3077542 does not equal 3169084. The sum of those two numbers is actually 3169084.
Really? Add 91542+3077542 and compare it to 3169084.
I apologize, you are correct, my previous response was in error. The sum of 91542 and 3077542 is 3169084, but this is not a valid solution to the TILES + PUZZLES = PICTURE puzzle, as you pointed out. I'm sorry for any confusion I may have caused. I
On Sunday, February 19, 2023 at 11:32:50 AM UTC+1, Marcel Hendrix wrote:[..]
I'm way ahead of you (GPT responses abridged)
Now solve for this one: TILES+PUZZLES=PICTUREare different in the addition. Try again.
And the sum TILES + PUZZLES = PICTURE can be written as: 97546 + 5045021 = 5142567
That's incorrect. Both TILES and PUZZLES end with an "S" - yet the numbers
This matches with what I tried before. Also, if you insist your own (wrong) answerCompletely true! Although I haven't been so devious to persist on wrong answers.
is correct, it will back down after a single attempt to point out it is right. That is, of
course, a useless strategy.
Of course, we are not able to understand the machinations of a superior intelligence.I don't get the impression I'm talking to a person - even when it sometimes baffles me with its responses. For instance, I feed it a random program and it really
But it's just not like a real human would behave. So much for the Turing test..
I expect to need much less than 1500 lines for a semi-general approach
that you just need to feed the constraints, domains, and a labeler to
solve stuff like SEND+MORE=MONEY, the Magic Hexagon, and Sudokus.
"minf...@arcor.de" <minf...@arcor.de> writes:
I guess that you know Markus Triska.Yes.
So you might really have some ideasNot from him. I did my last work in the field of CLP in 1993, several
of how to do labeling in Forth?
years before Markus Triska appeared on the scene. I learned from
@book(vanhentenryck89,
Author = "Van Hentenryck, Pascal",
Title = "{Constraint Satisfaction in Logic Programming}",
Series = "{Logic Programming Series}",
Year = "1989",
Publisher= "MIT Press",
Address = "Cambridge, Massachusetts"
)
and from Thomas Graf who worked with Van Hentenryck and others on the
early CLP language CHIP <https://en.wikipedia.org/wiki/CHIP_(programming_language)> at ECRC.
- anton
I guess that you know Markus Triska.
So you might really have some ideas
of how to do labeling in Forth?
| Sysop: | Keyop |
|---|---|
| Location: | Huddersfield, West Yorkshire, UK |
| Users: | 300 |
| Nodes: | 16 (3 / 13) |
| Uptime: | 43:01:08 |
| Calls: | 6,709 |
| Calls today: | 2 |
| Files: | 12,243 |
| Messages: | 5,354,017 |