Recently a solution was published on forth for the magic 38 hexagon.
It is portable, iso 94 with an environmental dependency for case-insensitivity.
This makes it run on most any Forths.
It uses macro's to make the source more directly related to the problem.
This can be seen by immediate definitions that compile code using `POSTPONE.

\ -------------------8<------------------------------

\ 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
\ : finish: postpone .mag_hex ; 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 ?,

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

_end_
;

: main solve ;
\ -------------------8<------------------------------

Fast forths obtained the (first) solution in time under 1 mS.

I thought this was a typical lisp problem and indeed I found the following
lisp program, equally using macro's (using ` and , )
Straightened out a bit to not pass the 72 line limit.

; -------------------8<------------------------------
; (C) 2006 Markus Triska triska@metalevel.at
; Public domain code.

; A B C
; D E F G
; H I J K L
; M N O P
; Q R S

; "l", the "loop" macro

(defmacro l (var code)
`(loop for ,var from 1 to 19 do
(when (not (aref used ,var))
(setf (aref used ,var) t)
,code
(setf (aref used ,var) nil))))

; "sc", the "set & check" macro, used when all other variables in the line
; are already assigned values

(defmacro sc (var others code)
`(let ((,var (- 38 ,@others)))
(when (and (<= 1 ,var) (<= ,var 19) (not (aref used ,var)))
(setf (aref used ,var) t)
,code
(setf (aref used ,var) nil))))

(defun solve ()
(let ((used (make-array 20)))
(l a
(l b
(sc c (a b)
(l d
(sc h (a d)
(l e
(l f
(sc g (d e f)
(sc l (c g)
(l i
(sc m (b e i)
(sc q (h m)
(l n
(sc r (d i n)
(sc s (q r)
(sc p (s l)
(sc j (q n c f)
(sc o (a e j s)
(sc k (r o g)
(print (list a b c d e f g h i j k l m n o p q r s)))))))))))))))))))))))

(solve)
(quit)
; -------------------8<------------------------------

The idea is much the same:
Loop over a for the full range
(l a
Loop for vA in the range [1,20) , mark vA as used up
20 1 .-- --> vA vA ?,
Loop over c , range restricted to 38-a-b
(sc c (a b)
Loop over c , range restriced to 38-a-b, mark vA as used up
38 vA vB + - --- --> vC vC ?,

To fairly compare the two programs, the Forth program must generate
all solutions. This is done by uncommenting the second definition
of finish.

The difference in run time are dramatic!
We compare sf (try out version of a commercial program Swiftforth )
to clisp.

~/PROJECT/magic: time time sf magicgoon.f

MARKED isn't unique.
finish: isn't unique.
finish: isn't unique.

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

....
real 0m0.055s
user 0m0.035s
sys 0m0.012s

~/PROJECT/magic: time clisp mhex1.lisp

(3 17 18 19 7 1 11 16 2 5 6 9 12 4 8 14 10 13 15)
....
real 0m8.415s
user 0m7.191s
sys 0m0.041s

Even if the lisp source is compiled, the difference is approximately
25 to 1.
~/PROJECT/magic: time clisp mhex1.fas
(3 17 18 19 7 1 11 16 2 5 6 9 12 4 8 14 10 13 15)
.....
real 0m1.058s
user 0m0.855s
sys 0m0.018s

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 jeudi 28 septembre 2023 à 11:06:13 UTC, none albert a écrit :
> Recently a solution was published on forth for the magic 38 hexagon.
> It is portable, iso 94 with an environmental dependency for case-insensitivity.
> This makes it run on most any Forths.
> It uses macro's to make the source more directly related to the problem.
> This can be seen by immediate definitions that compile code using `POSTPONE.
>
> \ -------------------8<------------------------------
>
> \ 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
> \ : finish: postpone .mag_hex ; 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 ?,
>
> .mag_hex vJ | vI | vN | vO | vK | vF | vE | vD | vH | vM | vQ | vR | vS | vP | vL | vG | vC | vB | vA |
>
> _end_
> ;
>
> : main solve ;
> \ -------------------8<------------------------------
>
> Fast forths obtained the (first) solution in time under 1 mS.
>
> I thought this was a typical lisp problem and indeed I found the following
> lisp program, equally using macro's (using ` and , )
> Straightened out a bit to not pass the 72 line limit.
>
> ; -------------------8<------------------------------
> ; (C) 2006 Markus Triska tri...@metalevel.at
> ; Public domain code.
>
> ; A B C
> ; D E F G
> ; H I J K L
> ; M N O P
> ; Q R S
>
>
> ; "l", the "loop" macro
>
> (defmacro l (var code)
> `(loop for ,var from 1 to 19 do
> (when (not (aref used ,var))
> (setf (aref used ,var) t)
> ,code
> (setf (aref used ,var) nil))))
>
> ; "sc", the "set & check" macro, used when all other variables in the line
> ; are already assigned values
>
> (defmacro sc (var others code)
> `(let ((,var (- 38 ,@others)))
> (when (and (<= 1 ,var) (<= ,var 19) (not (aref used ,var)))
> (setf (aref used ,var) t)
> ,code
> (setf (aref used ,var) nil))))
>
>
> (defun solve ()
> (let ((used (make-array 20)))
> (l a
> (l b
> (sc c (a b)
> (l d
> (sc h (a d)
> (l e
> (l f
> (sc g (d e f)
> (sc l (c g)
> (l i
> (sc m (b e i)
> (sc q (h m)
> (l n
> (sc r (d i n)
> (sc s (q r)
> (sc p (s l)
> (sc j (q n c f)
> (sc o (a e j s)
> (sc k (r o g)
> (print (list a b c d e f g h i j k l m n o p q r s)))))))))))))))))))))))
>
>
> (solve)
> (quit)
> ; -------------------8<------------------------------
>
> The idea is much the same:
> Loop over a for the full range
> (l a
> Loop for vA in the range [1,20) , mark vA as used up
> 20 1 .-- --> vA vA ?,
> Loop over c , range restricted to 38-a-b
> (sc c (a b)
> Loop over c , range restriced to 38-a-b, mark vA as used up
> 38 vA vB + - --- --> vC vC ?,
>
> To fairly compare the two programs, the Forth program must generate
> all solutions. This is done by uncommenting the second definition
> of finish.
>
> The difference in run time are dramatic!
> We compare sf (try out version of a commercial program Swiftforth )
> to clisp.
>
> ~/PROJECT/magic: time time sf magicgoon.f
>
> MARKED isn't unique.
> finish: isn't unique.
> finish: isn't unique.
>
> 3 17 18
> 19 7 1 11
> 16 2 5 6 9
> 12 4 8 14
> 10 13 15
>
> ...
> real 0m0.055s
> user 0m0.035s
> sys 0m0.012s
>
> ~/PROJECT/magic: time clisp mhex1.lisp
>
> (3 17 18 19 7 1 11 16 2 5 6 9 12 4 8 14 10 13 15)
> ...
> real 0m8.415s
> user 0m7.191s
> sys 0m0.041s
>
> Even if the lisp source is compiled, the difference is approximately
> 25 to 1.
> ~/PROJECT/magic: time clisp mhex1.fas
> (3 17 18 19 7 1 11 16 2 5 6 9 12 4 8 14 10 13 15)
> ....
> real 0m1.058s
> user 0m0.855s
> sys 0m0.018s
>
> 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,
Very interresting.
In CLP, it is known that the order of getting unkowns and also the order of using constraints has an effect on the speed.
Here, I rewrote the word solve with the same order of getting unkowns and using the same constraints as in the lisp program you have provided.

\ 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 .-- --> vD vD ?,
38 vA vD + - --- --> vH vH ?,
20 1 .-- --> vE vE ?,
20 1 .-- --> vF vF ?,
38 vD vE vF + + - --- --> vG vG ?,
38 vC vG + - --- --> vL vL ?,
20 1 .-- --> vI vI ?,
38 vB vE vI + + - --- --> vM vM ?,
38 vH vM + - --- --> vQ vQ ?,
20 1 .-- --> vN vN ?,
38 vD vI vN + + - --- --> vR vR ?,
38 vQ vR + - --- --> vS vS ?,
38 vS vL + - --- --> vP vP ?,
38 vQ vN vC vF + + + - --- --> vJ vJ ?,
38 vA vE vJ vS + + + - --- --> vO vO ?,
38 vR vO vG + + - --- --> vK vK ?,

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

On my PC, with gforth, I found:
original forth program : about 263 ms
new forth program : about 353 ms
You should compare this last forth program with the lisp program.
Enjoy.