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

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

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

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 -

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

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

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

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

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

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

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

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.

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

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

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

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

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?

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

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.

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 -

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

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 -

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?