Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is faster than the last versions I have already posted.

Here begin the program:

\ Place the integers 1..19 in the following Magic Hexagon of rank 3
\ __A_B_C__
\ _D_E_F_G_
\ H_I_J_K_L
\ _M_N_O_P_
\ __Q_R_S__
\ so that the sum of all numbers in a straight line (horizontal and diagonal)
\ is equal to 38.

: values 0 ?do 0 value loop ;
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS

create marking_table 77 allot
marking_table 77 1 fill

marking_table 38 + value marked
marked 20 erase

: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;

0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone marked? postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: constraints_begin( marked 20 erase ;
: finish: nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked 20 erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate

: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish: vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;


Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:
gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

Enjoy

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On Tuesday, September 19, 2023 at 7:35:18 PM UTC+2, Ahmed MELAHI wrote:

Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is faster than the last versions I have already posted.

[..]

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:
gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

No idea how you timed that. I get 224 us with this:

: INIT marking_table #77 1 fill
marked #20 ERASE
loop_loc max_num_constraints ERASE ;

: TEST INIT
.mag_hex
CR DTICKS-RESET [TICKS solve TICKS] D-US? .USECS ." elapsed."
.mag_hex ;

FORTH> TEST

0 0 0
0 0 0 0
0 0 0 0 0
0 0 0 0
0 0 0

240 us elapsed.

3 17 18
19 7 1 11
16 2 5 6 9
12 4 8 14
10 13 15
ok

-marcel

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le mardi 19 septembre 2023 à 19:01:11 UTC, Marcel Hendrix a écrit :

On Tuesday, September 19, 2023 at 7:35:18 PM UTC+2, Ahmed MELAHI wrote:

Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is faster than the last versions I have already posted.

[..]

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:
gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

No idea how you timed that. I get 224 us with this:

: INIT marking_table #77 1 fill
marked #20 ERASE
loop_loc max_num_constraints ERASE ;

: TEST INIT
.mag_hex
CR DTICKS-RESET [TICKS solve TICKS] D-US? .USECS ." elapsed."
.mag_hex ;

FORTH> TEST

0 0 0
0 0 0 0
0 0 0 0 0
0 0 0 0
0 0 0

240 us elapsed.

3 17 18
19 7 1 11
16 2 5 6 9
12 4 8 14
10 13 15
ok

-marcel

for the timing I used
: timing_1000 timer-reset 1000 0 do solve loop .elapsed ;
I don't know if it is good or no.
Perhaps my PC is slow (PC portable lenovo ideapad330, Intel(R) Celeron(R) CPU 3867U @ 1.80GHz 1.80 GHz, RAM 12 GB).

My objective was to keep the performance of the previous program and simplify the presentation of the problem of the puzzle (in the word solve) and reduce the size of the program (to about 70 loc).
Here we can separate the puzzle itself from the tools (clp???) at the begining of the program.

Here, I did that ( I rewrote the program) and got:

\ tools: clp??? ---------------part----------
100 value marking_table_size_max
create marking_table marking_table_size_max allot
marking_table marking_table_size_max 1 fill

0 value vals_num
20 value vals_num_max
marking_table marking_table_size_max 2 / + value marked
marked vals_num_max erase

0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone marked? postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: finish| nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked vals_num erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate

: values dup 1+ to vals_num 0 ?do 0 value loop ;

\ puzzle: magic hexagon puzzle ----part------
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS

: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;

: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish| vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;

For example:
20 1 .-- --- ---> vA vA ?, is read like this: let vA between 1 and 19, is it acceptable? if yes continue with the others else change vA (backtrack???).
38 vA vB + - --- ---> vC vC ?, is read like this: calculate vC using the formula just before (the constraint), is it acceptable? if yes continue with the others else (backtrack???) (in fact I am not sure if this is backtracking).
When all vA, ..., vJ are accepted (solution found), the word finish| terminates the execution of the word solve.

for the timing, I use:
: timing_1000 timer-reset 1000 0 do solve loop .elapsed ;

for the moment I don't know if I can use the tools (at the begining) to solve other problems (puzzles) like: magic squares, sendmoremoney etc...
If so, one can save the first part (tools clp???) in a program named clp.fs for example.
This program will be included in the program where the problem (puzzle) iself will be programmed.
I did it, it works.
Bye

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

In article <ed0dfb07-3b15-431d-a9d1-b3ed28f6d096n@googlegroups.com>,
Marcel Hendrix <mhx@iae.nl> wrote:

On Tuesday, September 19, 2023 at 7:35:18 PM UTC+2, Ahmed MELAHI wrote:

Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is

faster than the last versions I have already posted.
[..]

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:
gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

No idea how you timed that. I get 224 us with this:

: INIT marking_table #77 1 fill
marked #20 ERASE
loop_loc max_num_constraints ERASE ;

: TEST INIT
.mag_hex
CR DTICKS-RESET [TICKS solve TICKS] D-US? .USECS ." elapsed."
.mag_hex ;

FORTH> TEST

0 0 0
0 0 0 0
0 0 0 0 0
0 0 0 0
0 0 0

240 us elapsed.

3 17 18
19 7 1 11
16 2 5 6 9
12 4 8 14
10 13 15
ok

-marcel

This comment makes no sense. It just proves that your machine
is four times as fast as Ahmed's.

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 -

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le mardi 19 septembre 2023 à 20:14:37 UTC, Ahmed MELAHI a écrit :

Le mardi 19 septembre 2023 à 19:01:11 UTC, Marcel Hendrix a écrit :

On Tuesday, September 19, 2023 at 7:35:18 PM UTC+2, Ahmed MELAHI wrote:

Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is faster than the last versions I have already posted.

[..]

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC: gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

No idea how you timed that. I get 224 us with this:

: INIT marking_table #77 1 fill
marked #20 ERASE
loop_loc max_num_constraints ERASE ;

: TEST INIT
.mag_hex
CR DTICKS-RESET [TICKS solve TICKS] D-US? .USECS ." elapsed."
.mag_hex ;

FORTH> TEST

0 0 0
0 0 0 0
0 0 0 0 0
0 0 0 0
0 0 0

240 us elapsed.

3 17 18
19 7 1 11
16 2 5 6 9
12 4 8 14
10 13 15
ok

-marcel

for the timing I used
: timing_1000 timer-reset 1000 0 do solve loop .elapsed ;
I don't know if it is good or no.
Perhaps my PC is slow (PC portable lenovo ideapad330, Intel(R) Celeron(R) CPU 3867U @ 1.80GHz 1.80 GHz, RAM 12 GB).

My objective was to keep the performance of the previous program and simplify the presentation of the problem of the puzzle (in the word solve) and reduce the size of the program (to about 70 loc).
Here we can separate the puzzle itself from the tools (clp???) at the begining of the program.

Here, I did that ( I rewrote the program) and got:

\ tools: clp??? ---------------part----------
100 value marking_table_size_max
create marking_table marking_table_size_max allot
marking_table marking_table_size_max 1 fill

0 value vals_num
20 value vals_num_max
marking_table marking_table_size_max 2 / + value marked
marked vals_num_max erase
0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone marked? postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: finish| nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked vals_num erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate
: values dup 1+ to vals_num 0 ?do 0 value loop ;

\ puzzle: magic hexagon puzzle ----part------
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS
: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;
: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish| vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;
For example:
20 1 .-- --- ---> vA vA ?, is read like this: let vA between 1 and 19, is it acceptable? if yes continue with the others else change vA (backtrack???).
38 vA vB + - --- ---> vC vC ?, is read like this: calculate vC using the formula just before (the constraint), is it acceptable? if yes continue with the others else (backtrack???) (in fact I am not sure if this is backtracking).
When all vA, ..., vJ are accepted (solution found), the word finish| terminates the execution of the word solve.

for the timing, I use:
: timing_1000 timer-reset 1000 0 do solve loop .elapsed ;

for the moment I don't know if I can use the tools (at the begining) to solve other problems (puzzles) like: magic squares, sendmoremoney etc...
If so, one can save the first part (tools clp???) in a program named clp.fs for example.
This program will be included in the program where the problem (puzzle) iself will be programmed.
I did it, it works.
Bye

Hi,
I separated the tools from the puzzle.

The tools: saved as clp.fs to be included in the programs where the puzzles (problems) will be defined. Here it is: (I added few words)


\ clp
100 value marking_table_size_max
create marking_table marking_table_size_max allot
marking_table marking_table_size_max 1 fill

0 value vals_num
20 value vals_num_max
marking_table marking_table_size_max 2 / + value marked
marked vals_num_max erase

0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

0 value min_val
0 value max_val


: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone dup postpone min_val postpone max_val postpone 1+ postpone within postpone swap postpone marked? postpone and postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: finish| nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked vals_num erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate
: =, postpone = postpone if ; immediate
: =| postpone then ; immediate

: values dup 1+ to vals_num 0 ?do 0 value loop ;

\ ------------------------------- here finishes the tools

The magic hexagon puzzle:

include clp.fs

\ magic hexagon puzzle
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS
1 to min_val
19 to max_val

: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;

: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish| vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;

\ here finishes the magic hexagon puzzle

Example 2: the magic square (3*3):
include clp.fs

\ magic hexagon puzzle
9 values vA vB vC vD vE vF vG vH vI
1 to min_val
9 to max_val

: -- 2 .r 2 spaces ;
: .mag_sq
cr
cr
4 spaces vA -- vB -- vC -- cr
4 spaces vD -- vE -- vF -- cr
4 spaces vG -- vH -- vI --
cr
;

: solve
_begin_
10 1 .-- --> vA vA ?,
10 1 .-- --> vB vB ?,
15 vA vB + - --- --> vC vC ?,
10 1 .-- --> vF vF ?,
15 vC vF + - --- --> vI vI ?,
10 1 .-- --> vH vH ?,
15 vI vH + - --- --> vG vG ?,
15 vG vA + - --- --> vD vD ?,
15 vD vF + - --- --> vE vE ?,
15 vA vE vI + + =,
15 vG vE vC + + =,
15 vG vE vC + + =,

finish| =| =| =| vE | vD | vG | vH | vI | vF | vC | vB | vA | ." no solution found!"
_end_
;
\ here ends the magic square program

for the timing, I use:
: timing_1000 timer-reset 1000 0 do solve loop .elapsed ;
for the magic square:
gforth 42 us
iforth 3.3 us
vfxforth 1.6us


any ideas, propositions ...
Bye

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On Tuesday, September 19, 2023 at 10:17:04 PM UTC+2, none albert wrote:

In article <ed0dfb07-3b15-431d...@googlegroups.com>,
Marcel Hendrix <m...@iae.nl> wrote:

[..]

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:

[..]

This comment makes no sense. It just proves that your machine
is four times as fast as Ahmed's.

No, it just points out that 1. the current version of iForth is "version 6.9.109,
generated 18:39:31, September 27, 2021", and 2. it was not clear how
to run a microsecond timer over the code on the mentioned Forths.

-marcel

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Marcel Hendrix schrieb am Mittwoch, 20. September 2023 um 06:45:03 UTC+2:

On Tuesday, September 19, 2023 at 10:17:04 PM UTC+2, none albert wrote:

In article <ed0dfb07-3b15-431d...@googlegroups.com>,
Marcel Hendrix <m...@iae.nl> wrote:

[..]

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:

[..]

This comment makes no sense. It just proves that your machine
is four times as fast as Ahmed's.

No, it just points out that 1. the current version of iForth is "version 6.9.109,
generated 18:39:31, September 27, 2021", and 2. it was not clear how
to run a microsecond timer over the code on the mentioned Forths.

Since we have timing problems now, it seems high time to burn more microseconds by solving the Magic Hexagon of rank 8:

Cells start with −84 and end with +84, and all its horizontal and diagonal sums are 0.

Solution:
https://commons.wikimedia.org/wiki/File:MagicHexagon-Order8.svg

Enjoy ;-)

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le mercredi 20 septembre 2023 à 05:17:19 UTC, minforth a écrit :

Marcel Hendrix schrieb am Mittwoch, 20. September 2023 um 06:45:03 UTC+2:

On Tuesday, September 19, 2023 at 10:17:04 PM UTC+2, none albert wrote:

In article <ed0dfb07-3b15-431d...@googlegroups.com>,
Marcel Hendrix <m...@iae.nl> wrote:

[..]

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:

[..]

This comment makes no sense. It just proves that your machine
is four times as fast as Ahmed's.

No, it just points out that 1. the current version of iForth is "version 6.9.109,
generated 18:39:31, September 27, 2021", and 2. it was not clear how
to run a microsecond timer over the code on the mentioned Forths.

Since we have timing problems now, it seems high time to burn more microseconds
by solving the Magic Hexagon of rank 8:

Cells start with −84 and end with +84, and all its horizontal and diagonal sums are 0.

Solution:
https://commons.wikimedia.org/wiki/File:MagicHexagon-Order8.svg

Enjoy ;-)

HI,
A problem with:
169 unkowns,
45 constraints,
169 possible values
write a program to solve this problem for just fun!!! I don't dare write it. What about sudoku?
sudoku has: 81 unkowns, 27 constraints and 10 possible values.

In fact, I took the magic hexagon, the magic square and sendmoremoney problems just to test the possibility to write a simple clp solver.
bye

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le mardi 19 septembre 2023 à 21:44:05 UTC, Ahmed MELAHI a écrit :

Le mardi 19 septembre 2023 à 20:14:37 UTC, Ahmed MELAHI a écrit :

Le mardi 19 septembre 2023 à 19:01:11 UTC, Marcel Hendrix a écrit :

On Tuesday, September 19, 2023 at 7:35:18 PM UTC+2, Ahmed MELAHI wrote:

Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is faster than the last versions I have already posted.

[..]

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC: gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

No idea how you timed that. I get 224 us with this:

: INIT marking_table #77 1 fill
marked #20 ERASE
loop_loc max_num_constraints ERASE ;

: TEST INIT
.mag_hex
CR DTICKS-RESET [TICKS solve TICKS] D-US? .USECS ." elapsed."
.mag_hex ;

FORTH> TEST

0 0 0
0 0 0 0
0 0 0 0 0
0 0 0 0
0 0 0

240 us elapsed.

3 17 18
19 7 1 11
16 2 5 6 9
12 4 8 14
10 13 15
ok

-marcel

for the timing I used
: timing_1000 timer-reset 1000 0 do solve loop .elapsed ;
I don't know if it is good or no.
Perhaps my PC is slow (PC portable lenovo ideapad330, Intel(R) Celeron(R) CPU 3867U @ 1.80GHz 1.80 GHz, RAM 12 GB).

My objective was to keep the performance of the previous program and simplify the presentation of the problem of the puzzle (in the word solve) and reduce the size of the program (to about 70 loc).
Here we can separate the puzzle itself from the tools (clp???) at the begining of the program.

Here, I did that ( I rewrote the program) and got:

\ tools: clp??? ---------------part----------
100 value marking_table_size_max
create marking_table marking_table_size_max allot
marking_table marking_table_size_max 1 fill

0 value vals_num
20 value vals_num_max
marking_table marking_table_size_max 2 / + value marked
marked vals_num_max erase
0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone marked? postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: finish| nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked vals_num erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate
: values dup 1+ to vals_num 0 ?do 0 value loop ;

\ puzzle: magic hexagon puzzle ----part------
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS
: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;
: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish| vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;
For example:
20 1 .-- --- ---> vA vA ?, is read like this: let vA between 1 and 19, is it acceptable? if yes continue with the others else change vA (backtrack???).
38 vA vB + - --- ---> vC vC ?, is read like this: calculate vC using the formula just before (the constraint), is it acceptable? if yes continue with the others else (backtrack???) (in fact I am not sure if this is backtracking).
When all vA, ..., vJ are accepted (solution found), the word finish| terminates the execution of the word solve.

for the timing, I use:
: timing_1000 timer-reset 1000 0 do solve loop .elapsed ;

for the moment I don't know if I can use the tools (at the begining) to solve other problems (puzzles) like: magic squares, sendmoremoney etc...
If so, one can save the first part (tools clp???) in a program named clp.fs for example.
This program will be included in the program where the problem (puzzle) iself will be programmed.
I did it, it works.
Bye

Hi,
I separated the tools from the puzzle.

The tools: saved as clp.fs to be included in the programs where the puzzles (problems) will be defined. Here it is: (I added few words)

\ clp
100 value marking_table_size_max
create marking_table marking_table_size_max allot
marking_table marking_table_size_max 1 fill

0 value vals_num
20 value vals_num_max
marking_table marking_table_size_max 2 / + value marked
marked vals_num_max erase

0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;
0 value min_val
0 value max_val
: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone dup postpone min_val postpone max_val postpone 1+ postpone within postpone swap postpone marked? postpone and postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: finish| nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked vals_num erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate
: =, postpone = postpone if ; immediate
: =| postpone then ; immediate
: values dup 1+ to vals_num 0 ?do 0 value loop ;
\ ------------------------------- here finishes the tools

The magic hexagon puzzle:

include clp.fs

\ magic hexagon puzzle
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS
1 to min_val
19 to max_val
: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;

: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish| vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;
\ here finishes the magic hexagon puzzle

Example 2: the magic square (3*3):
include clp.fs

\ magic hexagon puzzle
9 values vA vB vC vD vE vF vG vH vI
1 to min_val
9 to max_val
: -- 2 .r 2 spaces ;
: .mag_sq
cr
cr
4 spaces vA -- vB -- vC -- cr
4 spaces vD -- vE -- vF -- cr
4 spaces vG -- vH -- vI --
cr
;

: solve
_begin_
10 1 .-- --> vA vA ?,
10 1 .-- --> vB vB ?,
15 vA vB + - --- --> vC vC ?,
10 1 .-- --> vF vF ?,
15 vC vF + - --- --> vI vI ?,
10 1 .-- --> vH vH ?,
15 vI vH + - --- --> vG vG ?,
15 vG vA + - --- --> vD vD ?,
15 vD vF + - --- --> vE vE ?,
15 vA vE vI + + =,
15 vG vE vC + + =,
15 vG vE vC + + =,

finish| =| =| =| vE | vD | vG | vH | vI | vF | vC | vB | vA | ." no solution found!"
_end_
;
\ here ends the magic square program
for the timing, I use:
: timing_1000 timer-reset 1000 0 do solve loop .elapsed ;
for the magic square:
gforth 42 us
iforth 3.3 us
vfxforth 1.6us

any ideas, propositions ...
Bye

Hi,
I wrote two versions for sendmoremoney problem. These versions show that one has to consider a best way (order) to use the constraints.
1. the first version:
include clp.fs

\ sendmoremoney
8 values vS vE vN vD vM vO vR vY
0 to min_val
9 to max_val

: -- 2 .r ( 2 spaces) ;
: .sendmoremoney
cr
cr
4 spaces vS -- vE -- vN -- vD -- cr
4 spaces vM -- vO -- vR -- vE -- cr
2 spaces vM -- vO -- vN -- vE -- vY --
cr
;

: solve
_begin_
10 0 .-- --> vS vS ?,
10 0 .-- --> vE vE ?,
10 0 .-- --> vN vN ?,
10 0 .-- --> vD vD ?,
2 1 .-- --> vM vM ?,
10 0 .-- --> vO vO ?,
10 0 .-- --> vR vR ?,
10 0 .-- --> vY vY ?,

vS 10 * vE + 10 * vN + 10 * vD +
vM 10 * vO + 10 * vR + 10 * vE + +
vM 10 * vO + 10 * vN + 10 * vE + 10 * vY + =,

finish| =| vY | vR | vO | vM | vD | vN | vE | vS | ." no solution found!"
_end_
;
\ ---------------------------------------------

2. The second version:
include clp.fs

\ sendmoremoney
8 values vS vE vN vD vM vO vR vY
0 to min_val
9 to max_val

0 value c1
0 value c2
0 value c3
0 value c4

: -- 2 .r ( 2 spaces) ;
: .sendmoremoney
cr
cr
4 spaces vS -- vE -- vN -- vD -- cr
4 spaces vM -- vO -- vR -- vE -- cr
2 spaces vM -- vO -- vN -- vE -- vY --
cr
;

: solve
_begin_
10 0 .-- --> vD vD ?,
10 0 .-- --> vE vE ?,
vD vE + 10 /mod to c1 --- --> vY vY ?,

10 0 .-- --> vN vN ?,
10 0 .-- --> vR vR ?,
c1 vN vR + + 10 /mod to c2 vE =,

10 0 .-- --> vO vO ?,
c2 vE vO + + 10 /mod to c3 vN =,

10 0 .-- --> vS vS ?,
2 1 .-- --> vM vM ?,
c3 vS vM + + 10 /mod to c4 vO =,

c4 vM =,

finish| =| =| vM | vS | =| vO | =| vR | vN | vY | vE | vD | ." no solution found!"
_end_
;

\ ------------------------
The timing is very intersting:

---------------- gforth iforth vfxforth
sendmoremoney.fs 60ms 9.7ms 8.075ms sendmoremoney_v2.fs 0.7ms 0.174ms 0.156ms
v2 is faster than v1: 85.71 57.06 51.76 times
there is a slight amelioration from version1 to version 2.

for the timing, I used:
gforth:
: timing_1000 utime 1000 0 do solve loop utime d>f d>f f- 1000e f/ cr cr ." Mean execution time : " f. ." micro seconds." ;

iforth and vfx:
: timing_1000 timer-reset 1000 0 do solve loop .elapsed ;
Here the time printed for 1000 exucutions of "solve".

Bye

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On Wednesday, September 20, 2023 at 8:04:14 AM UTC+2, Ahmed MELAHI wrote: [..]

A problem with:
169 unkowns,
45 constraints,
169 possible values
write a program to solve this problem for just fun!!! I don't dare write it. What about sudoku?
sudoku has: 81 unkowns, 27 constraints and 10 possible values.

In fact, I took the magic hexagon, the magic square and sendmoremoney problems just to test the possibility to write a simple clp solver.

This starts to get interesting. Is it possible for you to write down the solution
method refering to the way(s) in which it is conventionally approached?
A reference to a classic paper might suffice.

I'd like to understand which corners are cut (if any) and what the advantage is over
existing programs. I use the minion program when necessay, unfortunately I saw that it
is out of maintenance.

-marcel

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le mercredi 20 septembre 2023 à 07:03:46 UTC, Marcel Hendrix a écrit :

On Wednesday, September 20, 2023 at 8:04:14 AM UTC+2, Ahmed MELAHI wrote: [..]

A problem with:
169 unkowns,
45 constraints,
169 possible values
write a program to solve this problem for just fun!!! I don't dare write it.
What about sudoku?
sudoku has: 81 unkowns, 27 constraints and 10 possible values.

In fact, I took the magic hexagon, the magic square and sendmoremoney problems just to test the possibility to write a simple clp solver.

This starts to get interesting. Is it possible for you to write down the solution
method refering to the way(s) in which it is conventionally approached?
A reference to a classic paper might suffice.

I'd like to understand which corners are cut (if any) and what the advantage is over
existing programs. I use the minion program when necessay, unfortunately I saw that it
is out of maintenance.

-marcel

Hi,
I forgot to post the latest update of clp.fs
Here it is:


\ clp
100 value marking_table_size_max
create marking_table marking_table_size_max allot
marking_table marking_table_size_max 1 fill

0 value vals_num
20 value vals_num_max
marking_table marking_table_size_max 2 / + value marked
marked vals_num_max erase

0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

0 value min_val
0 value max_val

: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone dup postpone min_val postpone max_val postpone 1+ postpone within postpone swap postpone marked? postpone and postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: finish| nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked vals_num_max erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate
: =, postpone = postpone if ; immediate
: =| postpone then ; immediate

: values dup 1+ to vals_num 0 ?do 0 value loop ;

\----------------------------
For the documentation, I saw the website:
https://www.metalevel.at/
and in this page, the book (thesis) :
Correctness Considerations in CLP(FD) Systems (pdf, bib)
Doctoral thesis, under the supervision of Priv.-Doz. Dr. Nysret Musliu
Accepted in January 2014, Technische Universität Wien

I read just the first two chapters rapidly.
And some other books about constraint logic programming (summarily).
The advices I found (as I understood it ) and used:
- order the unkowns,
- order the constraints,
- calculate when possible

I applied these advices and wrote the first lenghty program.

Then with postpone and other ideas etc .. I tried to construct the same word "solve" in compile time.
I tried to simplify the presentation (the look) of the word solve in order to read the problem ( the constraints) easily.
With iterative refinements, I realized that I can separate the tools from the problems to solve.

The challange, now, is how to generalize the tools to deal with different types of problems.
Bye

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Ahmed MELAHI schrieb am Mittwoch, 20. September 2023 um 08:04:14 UTC+2:

Le mercredi 20 septembre 2023 à 05:17:19 UTC, minforth a écrit :

Marcel Hendrix schrieb am Mittwoch, 20. September 2023 um 06:45:03 UTC+2:

On Tuesday, September 19, 2023 at 10:17:04 PM UTC+2, none albert wrote:

In article <ed0dfb07-3b15-431d...@googlegroups.com>,
Marcel Hendrix <m...@iae.nl> wrote:

[..]

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC: [..]

This comment makes no sense. It just proves that your machine
is four times as fast as Ahmed's.

No, it just points out that 1. the current version of iForth is "version 6.9.109,
generated 18:39:31, September 27, 2021", and 2. it was not clear how
to run a microsecond timer over the code on the mentioned Forths.

Since we have timing problems now, it seems high time to burn more microseconds
by solving the Magic Hexagon of rank 8:

Cells start with −84 and end with +84, and all its horizontal and diagonal sums are 0.

Solution:
https://commons.wikimedia.org/wiki/File:MagicHexagon-Order8.svg

Enjoy ;-)

HI,
A problem with:
169 unkowns,
45 constraints,
169 possible values
write a program to solve this problem for just fun!!! I don't dare write it. What about sudoku?
sudoku has: 81 unkowns, 27 constraints and 10 possible values.

In fact, I took the magic hexagon, the magic square and sendmoremoney problems just to test the possibility to write a simple clp solver.
bye

Congrats for your work!

Just for comparison (an example for declarative programming without one single line of imperative algorithms):

/*
Sudoku solver (BProlog)
*/

:- initialization(main).

main :-

Vars = [ % declare sudoku board
X11,X12,X13, X14,X15,X16, X17,X18,X19,
X21,X22,X23, X24,X25,X26, X27,X28,X29,
X31,X32,X33, X34,X35,X36, X37,X38,X39,

X41,X42,X43, X44,X45,X46, X47,X48,X49,
X51,X52,X53, X54,X55,X56, X57,X58,X59,
X61,X62,X63, X64,X65,X66, X67,X68,X69,

X71,X72,X73, X74,X75,X76, X77,X78,X79,
X81,X82,X83, X84,X85,X86, X87,X88,X89,
X91,X92,X93, X94,X95,X96, X97,X98,X99 ],
Vars :: 1..9,

sudoku(Vars), % read puzzle

%row restrictions
alldifferent([X11,X12,X13, X14,X15,X16, X17,X18,X19]),
<snip: other 8 rows>

%column restr.
alldifferent([X11,X21,X31, X41,X51,X61, X71,X81,X91]),
<snip: other 8 cols>

%block restr.
alldifferent([X11,X12,X13, X21,X22,X23, X31,X32,X33]),
<snip: other 8 blocks>

labeling(Vars), %solver
writeln(Vars).

% Example:

sudoku([ % initialize board and solve puzzle
8,6,7, _,_,5, 9,1,_,
1,_,_, _,7,_, _,8,5,
_,3,_, _,_,_, _,_,_,

_,_,_, 7,6,2, 1,_,_,
_,8,_, _,9,_, _,6,_,
_,_,2, 8,1,4, _,_,_,

_,_,_, _,_,_, _,3,_,
9,1,_, _,3,_, _,_,6,
_,4,3, 1,_,_, 8,2,9
]).

Underscore characters _ are so-called unbound variables.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On Wednesday, September 20, 2023 at 6:40:23 PM UTC+2, minforth wrote:

Ahmed MELAHI schrieb am Mittwoch, 20. September 2023 um 08:04:14 UTC+2:

Le mercredi 20 septembre 2023 à 05:17:19 UTC, minforth a écrit :

[..]

%row restrictions
alldifferent([X11,X12,X13, X14,X15,X16, X17,X18,X19]),
Underscore characters _ are so-called unbound variables.

That is the same syntax minion-0.12 is using ( alldifferent )!
It would be great to have a small Forth version of primitives like
abs, alldiff, difference, diseq, hamming ineq, occurence, ...

-marcel

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le mercredi 20 septembre 2023 à 17:32:27 UTC, Marcel Hendrix a écrit :

On Wednesday, September 20, 2023 at 6:40:23 PM UTC+2, minforth wrote:

Ahmed MELAHI schrieb am Mittwoch, 20. September 2023 um 08:04:14 UTC+2:

Le mercredi 20 septembre 2023 à 05:17:19 UTC, minforth a écrit :

[..]

%row restrictions
alldifferent([X11,X12,X13, X14,X15,X16, X17,X18,X19]),
Underscore characters _ are so-called unbound variables.

That is the same syntax minion-0.12 is using ( alldifferent )!
It would be great to have a small Forth version of primitives like
abs, alldiff, difference, diseq, hamming ineq, occurence, ...

-marcel

Hi,
There is also PICAT and MiniZinc for constraint logic programming, they all share approximately the same syntaxe as prolog.
Prolog is "programmation logique" (logic programming), but not for constraint logic programming. Prolog use the module clp(fd) for finite domain constraint logic programming (module in the library to be consulted with use).
But Picat and MiniZinc are oriented for contraint logic programming.
look at :
http://picat-lang.org
https://www.minizinc.org
have good investigations
Bye

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

On Wednesday, September 20, 2023 at 9:00:18 PM UTC+2, Ahmed MELAHI wrote:

( picat and minizinc )

[..]

I instantly liked the CLP page in Wikipedia. I can see how to write a primitive
CLP interpreter by just following the text, using the Forth dictionary and redefining words for a first start.

Simplifying the constraint store is also described but it remains to be seen
if the explanation is lucid enough for my foggy brain.

-marcel

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Marcel Hendrix <mhx@iae.nl> writes:

On Wednesday, September 20, 2023 at 6:40:23=E2=80=AFPM UTC+2, minforth wrot= >e:

%row restrictions=20
alldifferent([X11,X12,X13, X14,X15,X16, X17,X18,X19]),=20
Underscore characters _ are so-called unbound variables.

That is the same syntax minion-0.12 is using ( alldifferent )!
It would be great to have a small Forth version of primitives like
abs, alldiff, difference, diseq, hamming ineq, occurence, ...

You find alldifferent in Forth in <https://github.com/AntonErtl/magic-hexagon/blob/main/magichex.4th>.
This is good enough for, e.g., Sudoku. You can find an implementation
that also uses bounds information to implement more proactive variants
of arraysum (Var1+...+Varn=const) and #< in <https://github.com/AntonErtl/magic-hexagon/blob/main/magichex-bounds.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 2023: https://euro.theforth.net/2023

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Ahmed MELAHI schrieb am Mittwoch, 20. September 2023 um 21:00:18 UTC+2:

Le mercredi 20 septembre 2023 à 17:32:27 UTC, Marcel Hendrix a écrit :

On Wednesday, September 20, 2023 at 6:40:23 PM UTC+2, minforth wrote:

Ahmed MELAHI schrieb am Mittwoch, 20. September 2023 um 08:04:14 UTC+2:

Le mercredi 20 septembre 2023 à 05:17:19 UTC, minforth a écrit :

[..]

%row restrictions
alldifferent([X11,X12,X13, X14,X15,X16, X17,X18,X19]),
Underscore characters _ are so-called unbound variables.

That is the same syntax minion-0.12 is using ( alldifferent )!
It would be great to have a small Forth version of primitives like
abs, alldiff, difference, diseq, hamming ineq, occurence, ...

-marcel

Hi,
There is also PICAT and MiniZinc for constraint logic programming, they all share approximately the same syntaxe as prolog.
Prolog is "programmation logique" (logic programming), but not for constraint logic programming. Prolog use the module clp(fd) for finite domain constraint logic programming (module in the library to be consulted with use).
But Picat and MiniZinc are oriented for contraint logic programming.
look at :
http://picat-lang.org
https://www.minizinc.org
have good investigations

PICAT is the worthy successor of BProlog. But back to Forth:

Apart from the intellectually stimulating exercise, are there any
real-world applications to use Prolog-like inference engines
or even CLP within a Forth control or software solution?

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le vendredi 22 septembre 2023 à 07:54:48 UTC, minforth a écrit :

Ahmed MELAHI schrieb am Mittwoch, 20. September 2023 um 21:00:18 UTC+2:

Le mercredi 20 septembre 2023 à 17:32:27 UTC, Marcel Hendrix a écrit :

On Wednesday, September 20, 2023 at 6:40:23 PM UTC+2, minforth wrote:

Ahmed MELAHI schrieb am Mittwoch, 20. September 2023 um 08:04:14 UTC+2:

Le mercredi 20 septembre 2023 à 05:17:19 UTC, minforth a écrit :

[..]

%row restrictions
alldifferent([X11,X12,X13, X14,X15,X16, X17,X18,X19]),
Underscore characters _ are so-called unbound variables.

That is the same syntax minion-0.12 is using ( alldifferent )!
It would be great to have a small Forth version of primitives like
abs, alldiff, difference, diseq, hamming ineq, occurence, ...

-marcel

Hi,
There is also PICAT and MiniZinc for constraint logic programming, they all share approximately the same syntaxe as prolog.
Prolog is "programmation logique" (logic programming), but not for constraint logic programming. Prolog use the module clp(fd) for finite domain constraint logic programming (module in the library to be consulted with use).
But Picat and MiniZinc are oriented for contraint logic programming.
look at :
http://picat-lang.org
https://www.minizinc.org
have good investigations

PICAT is the worthy successor of BProlog. But back to Forth:

Apart from the intellectually stimulating exercise, are there any
real-world applications to use Prolog-like inference engines
or even CLP within a Forth control or software solution?

Hi,
I don't know.
You can see these papers
https://vfxforth.com/flag/jfar/vol4/no4/article4.pdf https://vfxforth.com/flag/jfar/vol4/no4/article3.pdf
I use matlab for my lectures (automatic control, system identification, artificial intelligence in control systems like fuzzy logic, artificial neural nets, neuro-fuzzy systems, GA, PSO, meta-heuristic and nature inspired optimization algorithms,
probabilistic reasoning, expert systems, and use forth to express my ideas and to sharpen my understandings.
I looked to different software ( programming languages and others) to get ideas.
Bye

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le vendredi 22 septembre 2023 à 07:54:48 UTC, minforth a écrit :

Ahmed MELAHI schrieb am Mittwoch, 20. September 2023 um 21:00:18 UTC+2:

Le mercredi 20 septembre 2023 à 17:32:27 UTC, Marcel Hendrix a écrit :

On Wednesday, September 20, 2023 at 6:40:23 PM UTC+2, minforth wrote:

Ahmed MELAHI schrieb am Mittwoch, 20. September 2023 um 08:04:14 UTC+2:

Le mercredi 20 septembre 2023 à 05:17:19 UTC, minforth a écrit :

[..]

%row restrictions
alldifferent([X11,X12,X13, X14,X15,X16, X17,X18,X19]),
Underscore characters _ are so-called unbound variables.

That is the same syntax minion-0.12 is using ( alldifferent )!
It would be great to have a small Forth version of primitives like
abs, alldiff, difference, diseq, hamming ineq, occurence, ...

-marcel

Hi,
There is also PICAT and MiniZinc for constraint logic programming, they all share approximately the same syntaxe as prolog.
Prolog is "programmation logique" (logic programming), but not for constraint logic programming. Prolog use the module clp(fd) for finite domain constraint logic programming (module in the library to be consulted with use).
But Picat and MiniZinc are oriented for contraint logic programming.
look at :
http://picat-lang.org
https://www.minizinc.org
have good investigations

PICAT is the worthy successor of BProlog. But back to Forth:

Apart from the intellectually stimulating exercise, are there any
real-world applications to use Prolog-like inference engines
or even CLP within a Forth control or software solution?

Hi again,
you can get a look at this too:
https://vfxforth.com/flag/jfar/vol4.html
Enjoy.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

In article <3b96660a-56e6-4a84-ac82-2758fe6b9d06n@googlegroups.com>,
Ahmed MELAHI <ahmed.melahi@univ-bejaia.dz> wrote:

Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is faster than the last versions I have already posted.

Here begin the program:

\ Place the integers 1..19 in the following Magic Hexagon of rank 3
\ __A_B_C__
\ _D_E_F_G_
\ H_I_J_K_L
\ _M_N_O_P_
\ __Q_R_S__
\ so that the sum of all numbers in a straight line (horizontal and diagonal) >\ is equal to 38.

: values 0 ?do 0 value loop ;
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS

create marking_table 77 allot
marking_table 77 1 fill

marking_table 38 + value marked
marked 20 erase

: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;

0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone marked? postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: constraints_begin( marked 20 erase ;
: finish: nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked 20 erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate

: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish: vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:
gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

I have investigated the lisp versions. They run in the seconds (10-15)
where the Forth program runs in 33 ms (ciforth) 16 ms (gforth) and faster
still at home.
Both programs rely on macro expansion.

He las the comparison is not fair, because lisp calculates all solutions
(which doesn't make sense because all solutions are equivalent, but anyway.)

Could some one alter the program, such that all solutions are generated?
Then we can go boasting on comp.lang.lisp.

Enjoy

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 -

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le mercredi 27 septembre 2023 à 13:46:27 UTC+2, none albert a écrit :

In article <3b96660a-56e6-4a84...@googlegroups.com>,
Ahmed MELAHI <ahmed....@univ-bejaia.dz> wrote:

Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is faster than the last versions I have already posted.

Here begin the program:

\ Place the integers 1..19 in the following Magic Hexagon of rank 3
\ __A_B_C__
\ _D_E_F_G_
\ H_I_J_K_L
\ _M_N_O_P_
\ __Q_R_S__
\ so that the sum of all numbers in a straight line (horizontal and diagonal)
\ is equal to 38.

: values 0 ?do 0 value loop ;
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS

create marking_table 77 allot
marking_table 77 1 fill

marking_table 38 + value marked
marked 20 erase

: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;

0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone marked? postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: constraints_begin( marked 20 erase ;
: finish: nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked 20 erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate

: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish: vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:
gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

I have investigated the lisp versions. They run in the seconds (10-15)
where the Forth program runs in 33 ms (ciforth) 16 ms (gforth) and faster still at home.
Both programs rely on macro expansion.

He las the comparison is not fair, because lisp calculates all solutions (which doesn't make sense because all solutions are equivalent, but anyway.)

Could some one alter the program, such that all solutions are generated? Then we can go boasting on comp.lang.lisp.

Enjoy

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 -

Hi,
To get the 12 solutions with printing them on the terminal:
In the word solve: put the word finish: in parenthesis ( comment it out), and before it add the word .mag_hex
with gforth: I got 265200 us ( printing included)
For timing, I use :
utime solve utime d>f d>f f- f. ." us"

Enjoy

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

In article <3b96660a-56e6-4a84-ac82-2758fe6b9d06n@googlegroups.com>,
Ahmed MELAHI <ahmed.melahi@univ-bejaia.dz> wrote:

Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is faster than the last versions I have already posted.

Here begin the program:

\ Place the integers 1..19 in the following Magic Hexagon of rank 3
\ __A_B_C__
\ _D_E_F_G_
\ H_I_J_K_L
\ _M_N_O_P_
\ __Q_R_S__
\ so that the sum of all numbers in a straight line (horizontal and diagonal) >\ is equal to 38.

: values 0 ?do 0 value loop ;
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS

create marking_table 77 allot
marking_table 77 1 fill

marking_table 38 + value marked
marked 20 erase

: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;

0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone marked? postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: constraints_begin( marked 20 erase ;
: finish: nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked 20 erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate

: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish: vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:
gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

Enjoy

I'm puzzled why there is a 77 long array of bytes.
As far as I can see there are only 20 bytes used in the
`marked subtable.
I have decorated the `mark with { DUP . } and sure enough
the parameters passed to `mark are in the range 1..19.

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 -

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Le vendredi 29 septembre 2023 à 11:33:27 UTC, none albert a écrit :

In article <3b96660a-56e6-4a84...@googlegroups.com>,
Ahmed MELAHI <ahmed....@univ-bejaia.dz> wrote:

Hi,
I rewrote the program for the magic hexagon.
It appears elegant without any loss of performance. I think it is faster than the last versions I have already posted.

Here begin the program:

\ Place the integers 1..19 in the following Magic Hexagon of rank 3
\ __A_B_C__
\ _D_E_F_G_
\ H_I_J_K_L
\ _M_N_O_P_
\ __Q_R_S__
\ so that the sum of all numbers in a straight line (horizontal and diagonal)
\ is equal to 38.

: values 0 ?do 0 value loop ;
19 values vA vB vC vD vE vF vG vH vI vJ vK vL vM vN vO vP vQ vR vS

create marking_table 77 allot
marking_table 77 1 fill

marking_table 38 + value marked
marked 20 erase

: -- 2 .r 2 spaces ;
: .mag_hex
cr
cr
4 spaces vA -- vB -- vC -- cr
2 spaces vD -- vE -- vF -- vG -- cr
vH -- vI -- vJ -- vK -- vL -- cr
2 spaces vM -- vN -- vO -- vP -- cr
4 spaces vQ -- vR -- vS --
cr
;

0 value nloops_prec
0 value nloops
0 value constraint_num
20 value max_num_constraints
create loop_loc max_num_constraints allot
loop_loc max_num_constraints erase
: mark 1 swap marked + c! ;
: unmark 0 swap marked + c! ;
: marked? marked + c@ 0= ;

: .-- nloops 1+ to nloops postpone do postpone i ; immediate
: ?, postpone dup postpone marked? postpone if postpone mark ; immediate
: --> postpone to constraint_num 1+ to constraint_num nloops nloops_prec <> if 1 loop_loc constraint_num + c! nloops to nloops_prec then ; immediate
: constraints_begin( marked 20 erase ;
: finish: nloops 0 do postpone unloop loop postpone exit ; immediate
: --- ; immediate
: _begin_ marked 20 erase ;
: | postpone unmark postpone else postpone drop postpone then loop_loc constraint_num + c@ if postpone loop then constraint_num 1- to constraint_num ; immediate
: _end_ ; immediate

: solve
_begin_
20 1 .-- --> vA vA ?,
20 1 .-- --> vB vB ?,
38 vA vB + - --- --> vC vC ?,
20 1 .-- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vP vP ?,
38 vL vP + - --- --> vS vS ?,
20 1 .-- --> vR vR ?,
38 vS vR + - --- --> vQ vQ ?,
20 1 .-- --> vM vM ?,
38 vQ vM + - --- --> vH vH ?,
38 vA vH + - --- --> vD vD ?,
20 1 .-- --> vE vE ?,
38 vD vE + vG + - --- --> vF vF ?,
38 vB vF + vP + - --- --> vK vK ?,
38 vG vK + vR + - --- --> vO vO ?,
38 vP vO + vM + - --- --> vN vN ?,
38 vR vN + vD + - --- --> vI vI ?,
38 vH vI + vK + vL + - --- --> vJ vJ ?,

finish: vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
_end_
;

Tested with: gforth, vfxforth anf iforth v4 (evaluation) on my PC:
gforth: 4.5 ms
vfxforth: 0.734 ms
iforth: 0.976 ms

Enjoy

I'm puzzled why there is a 77 long array of bytes.
As far as I can see there are only 20 bytes used in the
`marked subtable.
I have decorated the `mark with { DUP . } and sure enough
the parameters passed to `mark are in the range 1..19.
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 -

Hi,
The idea was to avoid the use of the test (range check) 20 1+ 1 within in the definition of the word ?,
We have
77 = 38 +38 +1
77 = (19 +19) + (19 +19) +1
For example: we know that 1<=vA<=19, ... 1<=vS<=19 and all different.
But when using the constraints for example the last one: 38 - (vH + vI + vK + vL) == vJ, we have to verify that vJ is between 1 and 19.
For extreme values (whithout considering all different) 38 - (19 + 19 +19 +19 ) = -38
and 38 - ( 0 + 0 + 0 + 0) = 38
so 38 - (-38) +1 = 77 possible values for vJ ...
But by filling the marking_table initially with 1s and and then erasing the 20 bytes from 38 to (38 +19) ( see the definition of marked) we can get:
0 ..........38......(38+19).....76
-38 .......0.............19......... 38
1111110000000001111111
So we can see that all the values from -38 to 0 and from 20 to 38 are marked initially and not changed when solving the problem.
but the values from 1 to 19 can be marked or unmarked.
using this trick, I avoided the tests for example 1<=vJ <=19 which is 1<=38-(vH+vI+ vK + vL)<=19.
Like this, I can use the word ?, in the same manner for the cases (for example):
20 1 .-- ---> vA vA ?, ( here I haven't to to check the range)
38 vA vB + - --- --> vC vC ?, ( here we must check the range, but using this trick I avoided range checking)
but one can use range checking with for example 20 1+ 1 within in the word ?, I don't know if the expalanation is clear?


--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)