Magic Hexagon

[minf...@arcor.de]

Another while-away-your-afternoon-teatime puzzle:

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.

It is said that this puzzle is almost impossibly hard to solve manually.
But with the techniques developed in the SEND+MORE=MONEY thread
it should be easy in Forth.

One solution is
__3_17_18__
_19_7_1_11_
16_2_5_6_9
_12_4_8_14_
__10_13_15__

[minf...@arcor.de]

\ Here's the obvious SOLUTION IMPOSSIBLE :o)

DECIMAL

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

: H@ cells hxg + @ ;

: EXCHANGE ( i j -- )
cells hxg + swap cells hxg + \ aj ai
dup @ >r swap dup @ \ ai aj fj r: fi
rot ! r> swap ! ;

: A 0 h@ ; : B 1 h@ ; : C 2 h@ ;
: D 3 h@ ; : E 4 h@ ; : F 5 h@ ; : G 6 h@ ;
: H 7 h@ ; : _I 8 h@ ; : _J 9 h@ ; : K 10 h@ ; : L 11 h@ ;
: M 12 h@ ; : N 13 h@ ; : O 14 h@ ; : P 15 h@ ;
: Q 16 h@ ; : R 17 h@ ; : S 18 h@ ;

: CHECK-CONSTRAINTS
false
\ rows:
A B C + + 38 <> IF EXIT THEN
D E F G + + + 38 <> IF EXIT THEN
H _I _J K L + + + + 38 <> IF EXIT THEN
M N O P + + + 38 <> IF EXIT THEN
Q R S + + 38 <> IF EXIT THEN
\ rot1:
C G L + + 38 <> IF EXIT THEN
B F K P + + + 38 <> IF EXIT THEN
A E _J O S + + + + 38 <> IF EXIT THEN
D _I N R + + + 38 <> IF EXIT THEN
H M Q + + 38 <> IF EXIT THEN
\ rot2:
A D H + + 38 <> IF EXIT THEN
B E _I M + + + 38 <> IF EXIT THEN
C F _J N Q + + + + 38 <> IF EXIT THEN
G K O R + + + 38 <> IF EXIT THEN
L P S + + 38 <> IF EXIT THEN
drop true ;

: SHOW-HEXAGON
19 0 DO i h@ . LOOP ;

VARIABLE CT 0 ct !

: USE-PERM
cr ct @ . space 1 ct +! show-hexagon
check-constraints IF show-hexagon ABORT THEN ;

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

: MAGIC ( -- ) \ check constraints
19 permute ;

MAGIC

[Marcel Hendrix]

On Sunday, February 19, 2023 at 9:18:12 PM UTC+1, minf...@arcor.de wrote:
> minf...@arcor.de schrieb am Sonntag, 12. Februar 2023 um 11:43:46 UTC+1:
> > Another while-away-your-afternoon-teatime puzzle:

[..]
> MAGIC

I got a bit restless when after a few seconds ct
became higher than 124,000,000,000. Is 64 bits
enough for this one?

-marcel

[minf...@arcor.de]

:-) it should: fac(19)=1.2e17 < 2^64=1.8e19

[Marcel Hendrix]

Okay! Only 120 thousand more hours to go then.

-marcel

[Anton Ertl]

That's the problem with totally naive generate-and-test. Even a
slightly more sophisticated generate-and-test approach is going to be
far superior:

__A_B_C__
_D_E_F_G_
H_I_J_K_L
_M_N_O_P_
__Q_R_S__

Generate A C L S Q H E (19*18*17*16*15*14*13=253_955_520 variants).
Then compute

B=38-A-C
compute G P R M D likewise
I=38-B-E-M
compute N O K F likewise
J=38-H-I-K-L

now check that they are all different (or check it as soon as you
compute each number).

You can interleave the computations and the generation, as I have done
in my SEND+MORE=MONEY program, pruning the search tree early (e.g.,
already for A=1, you can prune C<18 as soon as you compute B).

Plus, you can apply the constraints early that eliminate rotated and
mirrored solutions.

This all can can be done with a program similar to my SEND+MORE=MONEY
program.

I am amazed that despite the inefficiency of the
generate-permutations-and-test approach for SEND+MORE=MONEY, people
seem to be more interested in this kind of approach than in more
efficient approaches.

- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: https://forth-standard.org/
EuroForth 2022: https://euro.theforth.net

[minf...@arcor.de]

Sure, one can do constraint propagation by hand and rewrite the solver for each step.
The SEND+MORE=MONEY puzzle can even be solved completely just by manual constraint
propagation as demonstrated in
https://en.wikipedia.org/wiki/Verbal_arithmetic

That's okay - when feasible - for solving fun puzzles or little textbook examples,
and when one can/want rewrite the solver for every new task.

But it is still miles and miles away from what can be done (comfort-wise and
speed-wise) with algorithmic constraint handling. Brute force is a dead end.

[Marcel Hendrix]

On Monday, February 20, 2023 at 8:41:34 AM UTC+1, Anton Ertl wrote:
> Marcel Hendrix <m...@iae.nl> writes:
[..]
My problem with your approach was that I could not 'decode' your
first post, certainly not in the stage that even the puzzle itself was
unclear!

As time progressed, I was distracted by the seemingly 'magical'
behavior of the trivial approaches.

Yesterday, I recalled a few problems where constraint logic actually
could have helped me, but (unfortunately) at the time I found a
brute-force hack that sufficed.

It's on the top of my spare-time stack now.

-marcel

[Anton Ertl]

"minf...@arcor.de" <minf...@arcor.de> writes:
>Sure, one can do constraint propagation by hand and rewrite the
>solver for each step. The SEND+MORE=MONEY puzzle can even be solved
>completely just by manual constraint propagation as demonstrated in
>https://en.wikipedia.org/wiki/Verbal_arithmetic
>
>That's okay - when feasible - for solving fun puzzles or little
>textbook examples, and when one can/want rewrite the solver for every
>new task.
>
>But it is still miles and miles away from what can be done (comfort-wise and
>speed-wise) with algorithmic constraint handling. Brute force is a dead end.

It may look less comfortable than just throwing a bunch of constraints
over the wall, and letting the solver work its magic, but when it
comes to debugging, the latter approach is very uncomfortable, and the
more constraints you have, the more uncomfortable it is: You have a
large number of constraints, typically generated from the data, so you
typically don't see them all explicitly, and the solver produces too
few or no solutions (for bugs where it produces too many (i.e., wrong)
"solutions", you can add additional constraints).

How do you learn which combination of constraints is responsible for
that? Even if you determine which constraint failed at a particular
point, there are two problems:

* Failing a constraint is just normal business in this kind of search.
How do you know which of the millions of failures in a search is due
to a bug and which is not?

* The failing constraint may actually be correct; the buggy constraint
may have reduced the possible values of some variable involved in
the constraint earlier, and it might even have taken several
propagation steps from the buggy constraint to the failing
constraint.

Performancewise yes, when you have the right constraints, the
constraint propagation may be able to prune the search space in ways
that the approach I outlined cannot achieve, and therefore it may be
necessary to use constraint propagation or other solving techniques
(e.g., integer linear programming) for performance reasons. In that
case, you have to bite the bullet and live with the lack of
debuggability.

In any case, when you don't need such approaches for performance
reasons, controlling the labeling and constraint propagation
explicitly is a less beautiful to look at, but easier to debug.

[minf...@arcor.de]

You are 100% right.

In my career I was bitten once with a task of what I later learnt to be a
knapsack problem: how much (or better little) RAM would be optimal for a
remote data acquisition system (of dozens up to hundreds) of sensors,
each sensor generating time series data in different speed and of different
size.

Increase remote RAM is obvious but costs money and electric power,
send older data packets to a central server increases transmission load
and you have to manage transmission failures. So there is an optimum
somewhere. But it depends on the number and types of sensors; in
CLP terms: constraints were variable.

Just one example where manual approach would have been difficult.

Another example: Modern logistic industry wouldn't be possible without
optimized planning, routing and storing. CLP solvers are in the heart of it.

[Marcel Hendrix]

On Sunday, February 19, 2023 at 11:53:42 PM UTC+1, minf...@arcor.de wrote:

> Marcel Hendrix schrieb am Sonntag, 19. Februar 2023 um 23:37:58 UTC+1:
> > On Sunday, February 19, 2023 at 9:18:12 PM UTC+1, minf...@arcor.de wrote:
> > > minf...@arcor.de schrieb am Sonntag, 12. Februar 2023 um 11:43:46 UTC+1:
> > > > Another while-away-your-afternoon-teatime puzzle:
> > [..]
> > > MAGIC

[..]

There is only one solution: 3 17 18 19 7 1 11 16 2 5 6 9 12 4 8 14 10 13 15.
It is found in less than 25ms.

Indeed a useful algorithm.

-marcel

[Anton Ertl]

"minf...@arcor.de" <minf...@arcor.de> writes:
>Another while-away-your-afternoon-teatime puzzle:
>
>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.
>
>It is said that this puzzle is almost impossibly hard to solve manually.

According to <https://en.wikipedia.org/wiki/Magic_hexagon>:

|The order-3 magic hexagon has been published many times as a 'new'
|discovery. An early reference, and possibly the first discoverer, is
|Ernst von Haselberg (1887).

I guess that von Haselberg did it manually.

Anyway, unlike Marcel Hendrix I could not resist and implemented a
simple constraint-satisfaction problem framework and the magic hexagon
on top of it.

You can find the code at
<https://github.com/AntonErtl/magic-hexagon/blob/main/magichex.4th>

There is about 170 lines for the framework, and another 90 for the
magic hexagon problem (all including comments and some debugging
words). I only implemented the constraints ALLDIFFERENT and ARRAYSUM
(the only ones needed for the magic hexagon). The result produces all
twelve solutions (which are rotations and mirror images of one
solution); I was too lazy to implement and use the less-than
constraint necessary to exclude the rotations and mirror image.

The central data structure is the constrained variable:

0
field: var-val \ value 0-63 if instantiated, negative if not
field: var-bits \ potential values
field: var-wheninst \ linked list of constraints woken up when instantiated
constant var-size

"Instantiated" is logic programming jargon and means that the variable
has one value, rather than waiting for one.

Such a variable can only hold values in the range 0-63 (with 8-byte
cells). VAR-BITS is a cell with one bit for each potential value; a
bit is clear if it is known that the variable cannot take on the value
represented by that bit. If only one bit is set, the variable is
instantiated to the value specified by that bit. It's not clear if
VAR-BITS really helps for the Magic Hexagon with the current
constraint implementations (only ALLDIFFERENT actually uses VAR-BITS);
eliminating it an all that's related would make the framework smaller
and more general (no need to limit yourself to values 0-63).
Alternatively, a more general framework would have allow arbitrarily
large VAR-BITS, to support more values.

I have implemented the ARRAYSUM constraint as doing nothing until
all-but-one variable are instantiated; then the last variable is
computed from the others. A more sophisticated ARRAYSUM would compute
bounds of the variables from the bounds of the other variables, which
might prune the search tree earlier.

The other interesting part is the backtracking: Backtracking itself is
performed by performing FAILURE THROW. To have a place to backtrack
to, you first LABEL a variable: LABEL instantiates the variable to one
of its potential values; when it CATCHes a FAILURE, it UNDOes all the
changes to cells recorded on the trail stack; in order to be able to
do that, we store values into cells with !BT (instead of just !),
which records the address and old value of the cell on the trail
stack.

LABEL is used as follows:

<var> [: <code> ;] label

which means that <var> is instantiated, and then <code> is called,
which is currently expected to FAILURE THROW eventually (possibly
after printing or otherwise recording a solution).

This code uses several Gforth features. I find the use of closures
especially notable: They are used to transfer data from the constraint
creation to the run-time. E.g., with

create vars
A , B , C , D , E , F , G , H , I , J , K , L , M , N , O , P , Q , R , S ,
vars 19 alldifferent

we declare that variables A..S all have different values. The
definition of ALLDIFFERENT is:

: alldifferent ( addr u -- )
2dup [d:d alldifferent-c ;]
rot rot array-constraint! ;

ALLDIFFERENT-C ( u1 var addr u -- ) is the core of the constraint
action that is called when one of the variables in the constraint is
instantiated; it gets U VAR passed as parameter, but for ADDR1 U1 it
needs the data ADDR u passed to ALLDIFFERENT, and that is achieved
through the closure [d:d ... ;] : This passes two cells from the time
when ALLDIFFERENT runs to the time when the xt for the closure is
EXECUTEd. You can do that in other ways in Forth, but using a closure
here is substantially more convenient. Well, actually, using run-time
code generation would be similarly convenient (and demonstrates other
Gforth features:-):

: alldifferent {: addr u -- :}
:noname ]] addr u alldifferent-c ; [[
addr u arrayconstraint! ;

Enough for one evening, performance results tomorrow.

[minf...@arcor.de]

Impressive work! In CLP(FD) so-called "tagged variables" more or less replace
normal integer variables. The tags comprise domain information including
actual domain pruning state while following search tree branches.
You called these "constrained variables".

A variables stack is built during depth-first search so that backtracking
automatically lands on branches with (memoized) pruned domain information.
BTW good idea to short-circuit backtracking through a CATCH mechanism!

[Ahmed MELAHI]

Hi,
Here is a program for magic hexagon, it gives one solution in about 109 milli seconds (gforth)
The serach is deterministic, no random, no permutations used.
It is based on reducing the size of search space by :
- begin with constraints with low number of unknowns
- when possible, calculate directly the values (for example, A, B given, then C is 38 -A-B)
- constuct tables for already calculated values
We begin by constructing the table ABC: A from 1 to 19, B from 1 to 19 and b<>A, and C calculated using the constaint A+B+C =38.
For each entry of this table (A,B,C), construct table GL, G from 1...19, G<>A,G<>B, G<>C, C is already known, we can calculate L using the constraint C+G+L =38 ......
So, in general, with this approach, the search space size decrease from 19! to 19*18*16*14*12*10*7 = 64 350 720
the order of the constraints: A+B+C=38, C+G+L=38, L+P+S=38, S+R+Q=38, Q+M+H=38, H+D+A=38,
D+E+F+G=38, G+K+O+R=38, P+O+N+M=38, R+N+I+D=38,
H+I+J+K+L=38

with A+B+C, A,B kown int 1...19 and different, we calculate C and verify that is different from A and B and it is in 1...19
with C+G+L, C kown, G in 1...19 and diff of A,B,C, we calculate L and verify that it is in 1...19 and diff of A,B,C,G
with L+P+S, L known, P in 1...19 and diff A,B,C,G,L, we calculate S and verify that it is in 1...19 and diff of A,B,C,G,L,P
....
like this, we have
for A 19 possible values
for B 18 possible values, for each of these values C is calculated and the table ABC filled
for G 16 possible values for each value of G, L is calculated and table GL filled
for P 14 poosible values for each value of P, S is calculated and table PS filled
for R 12 possible values for each value of R, Q is calculated and table RQ filled
for M 10 possible values for eachvalue of M, H is calculated and table MH filled
for D 1 possible values, calculated from A+D+H=38 (A,H already known)
for E 7 possible values, for each value of E, F is calculated and table EF filled
for K 1 possible value calculated (B+F+K+P=38 , B,F,P already known)
for O 1 possible value calculated (G+K+O+R=38 , G,K,R already known)
for N 1 possible value calculated (M+N+O+P=38 ,M,O,P already known)
for I 1 possible value calculated (R+N+I+D=38 , R,N,D already known)
for J 1 possible value calculated (H+I+J+K+L=38 , H,I,K,L already known)

This program is tested, but not optimized.
this program is about 600 lines (detail)

The program listing begins here:

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

\ here begins the application

0 value vA
0 value vB
0 value vC
0 value vD
0 value vE
0 value vF
0 value vG
0 value vH
0 value vI
0 value vJ
0 value vK
0 value vL
0 value vM
0 value vN
0 value vO
0 value vP
0 value vQ
0 value vR
0 value vS



0 value nth_ABC
0 value nth_GL
0 value nth_PS
0 value nth_RQ
0 value nth_MH
0 value nth_EF

0 value vD_ok
0 value vK_ok
0 value vO_ok
0 value vN_ok
0 value vI_ok
0 value vJ_ok

0 value n_sol

0 value solution_found_?

create marked 20 allot
marked 20 erase


create solutions 10 20 * allot


create ABC 19 18 * 3 * allot
create GL 16 2 * allot
create PS 14 2 * allot
create RQ 12 2 * allot
create MH 10 2 * allot
create EF 8 2 * allot

: solve
marked 20 erase
0 to nth_ABC
0 to nth_GL
0 to nth_PS
0 to nth_RQ
0 to nth_MH
0 to nth_EF

\ ABC
20 1
do
i to vA
1 vA marked + c!
20 1
do
i to vB
vB marked + c@ 0=
if
1 vB marked + c!

38 vA vB + - to vC
vC marked + c@ 0=
vC 0> and
vC 20 < and
if
vA 0 nth_ABC 3 * + ABC + c!
vB 1 nth_ABC 3 * + ABC + c!
vC 2 nth_ABC 3 * + ABC + c!
nth_ABC 1+ to nth_ABC
then
then
0 vB marked + c!
loop
0 vA marked + c!
loop

\ cycle through ABC
nth_ABC 0
do
marked 20 erase
0 to nth_GL
\ cr ." ABC: " i .

0 i 3 * + ABC + c@ to vA
1 i 3 * + ABC + c@ to vB
2 i 3 * + ABC + c@ to vC
\ cr vA . vB . vC . .s \ -----------------------------------
1 vA marked + c!
1 vB marked + c!
1 vC marked + c!

\ GL
20 1
do
i to vG
vG marked + c@ 0=
if
1 vG marked + c!

38 vC vG + - to vL
vL marked + c@ 0=
vL 0> and
vL 20 < and
if
vG 0 nth_GL 2 * + GL + c!
vL 1 nth_GL 2 * + GL + c!
nth_GL 1+ to nth_GL
then
then
0 vG marked + c!
loop

\ cycle through GL
nth_GL 0
?do
0 to nth_PS
\ cr ." GL:" i .
0 i 2 * + GL + c@ to vG
1 i 2 * + GL + c@ to vL
\ cr vA . vB . vC . vG . vL . .s \ ----------------------------------------
1 vG marked + c!
1 vL marked + c!

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!



\ PS
20 1
do
i to vP
vP marked + c@ 0=
if
1 vP marked + c!

38 vL vP + - to vS
vS marked + c@ 0=
vS 0> and
vS 20 < and
if
vP 0 nth_PS 2 * + PS + c!
vS 1 nth_PS 2 * + PS + c!
nth_PS 1+ to nth_PS
then
then
0 vP marked + c!
loop

\ cycle through PS
nth_PS 0
?do
0 to nth_RQ
\ ." PS: " i .
0 i 2 * + PS + c@ to vP
1 i 2 * + PS + c@ to vS
\ cr vA . vB . vC . vG . vL . vP . vS . .s \ -------------------
1 vP marked + c!
1 vS marked + c!

1 vG marked + c!
1 vL marked + c!

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!


\ RQ
20 1
do
i to vR
vR marked + c@ 0=
if
1 vR marked + c!
1 vG marked + c!


38 vS vR + - to vQ
vQ marked + c@ 0=
vQ 0> and
vQ 20 < and
if
vR 0 nth_RQ 2 * + RQ + c!
vQ 1 nth_RQ 2 * + RQ + c!
nth_RQ 1+ to nth_RQ
then
then
0 vR marked + c!
loop

\ cycle through RQ
nth_RQ 0
?do
0 to nth_MH
0 i 2 * + RQ + c@ to vR
1 i 2 * + RQ + c@ to vQ
\ cr vA . vB . vC . vG . vL . vP . vS . vR . vQ . .s \ ------------------------------
1 vR marked + c!
1 vQ marked + c!

1 vP marked + c!
1 vS marked + c!

1 vG marked + c!
1 vL marked + c!

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!

\ MH
20 1
do
i to vM
vM marked + c@ 0=
if
1 vM marked + c!
1 vH marked + c!

38 vQ vM + - to vH
vH marked + c@ 0=
vH 0> and
vH 20 < and
if
vM 0 nth_MH 2 * + MH + c!
vH 1 nth_MH 2 * + MH + c!
nth_MH 1+ to nth_MH
then
then
0 vM marked + c!
loop
\ cycle through MH
nth_MH 0
?do
0 i 2 * + MH + c@ to vM
1 i 2 * + MH + c@ to vH

1 vM marked + c!
1 vH marked + c!

1 vR marked + c!
1 vQ marked + c!

1 vP marked + c!
1 vS marked + c!

1 vG marked + c!
1 vL marked + c!

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!

\ cr vA . vB . vC . vG . vL . vP . vS . vR . vQ . vM . vH . .s \ -------------------------------------------------

\ calculate D (38-A-H = D)
0 to vD_ok
38 vA vH + - to vD
vD marked + c@ 0=
vD 0> and
vD 20 < and
if
1 to vD_ok
then
0 vD marked + c!
0 to nth_EF
vD_ok
if
\ EF
1 vD marked + c!

1 vM marked + c!
1 vH marked + c!

1 vR marked + c!
1 vQ marked + c!

1 vP marked + c!
1 vS marked + c!

1 vG marked + c!
1 vL marked + c!

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!

\ cr vA . vB . vC . vG . vL . vP . vS . vR . vQ . vM . vH . vD . .s \ -------------------------------------------------

20 1
do
i to vE
vE marked + c@ 0=
if
1 vE marked + c!
1 vC marked + c!

38 vD vE + vG + - to vF
vF marked + c@ 0=
vF 0> and
vF 20 < and
if
vE 0 nth_EF 2 * + EF + c!
vF 1 nth_EF 2 * + EF + c!
nth_EF 1+ to nth_EF
then
then
0 vE marked + c!
loop \ EF

nth_EF 0
?do
0 i 2 * + EF + c@ to vE
1 i 2 * + EF + c@ to vF

1 vE marked + c!
1 vF marked + c!

1 vD marked + c!

1 vM marked + c!
1 vH marked + c!

1 vR marked + c!
1 vQ marked + c!

1 vP marked + c!
1 vS marked + c!

1 vG marked + c!
1 vL marked + c!

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!

\ cr vA . vB . vC . vG . vL . vP . vS . vR . vQ . vM . vH . vD . vE . vF . .s \ -------------------------------------------------


\ calculate K (K = 38-B-F-P)
0 to vK_ok
38 vB vF + vP + - to vK
vK marked + c@ 0=
vK 0> and
vK 20 < and
if
1 to vK_ok
then
0 vK marked + c!

vK_ok
if
\ calculate O (O = 38-G-K-R)
1 vK marked + c!

\ cr vA . vB . vC . vG . vL . vP . vS . vR . vQ . vM . vH . vD . vE . vF . vK . .s \ -------------------------------------------------

0 to vO_ok
38 vG vK + vR + - to vO
vO marked + c@ 0=
vO 0> and
vO 20 < and
if
1 to vO_ok
then
0 vO marked + c!

vO_ok
if
\ calculate N (N = 38-P-O-M)
1 vO marked + c!


0 to vN_ok
38 vP vO + vM + - to vN
vN marked + c@ 0=
vN 0> and
vN 20 < and
if
1 to vN_ok
then
0 vN marked + c!

vN_ok
if
\ calculate I (I = 38-R-N-D)
1 vN marked + c!

0 to vI_ok
38 vR vN + vD + - to vI
vI marked + c@ 0=
vI 0> and
vI 20 < and
if
1 to vI_ok
then
0 vI marked + c!

vI_ok
if
\ calculate J (J = 38-H-I-K-L)
1 vI marked + c!

0 to vJ_ok
38 vH vI + vK + vL + - to vJ
vJ marked + c@ 0=
vJ 0> and
vJ 20 < and
if
1 to vJ_ok
1 to solution_found_?
then
0 vJ marked + c!

vJ_ok
if
1 vJ marked + c!

n_sol 1+ to n_sol

vA 0 n_sol 20 * + solutions + c!
vB 1 n_sol 20 * + solutions + c!
vC 2 n_sol 20 * + solutions + c!
vD 3 n_sol 20 * + solutions + c!
vE 4 n_sol 20 * + solutions + c!
vF 5 n_sol 20 * + solutions + c!
vG 6 n_sol 20 * + solutions + c!
vH 7 n_sol 20 * + solutions + c!
vI 8 n_sol 20 * + solutions + c!
vJ 9 n_sol 20 * + solutions + c!
vK 10 n_sol 20 * + solutions + c!
vL 11 n_sol 20 * + solutions + c!
vM 12 n_sol 20 * + solutions + c!
vN 13 n_sol 20 * + solutions + c!
vO 14 n_sol 20 * + solutions + c!
vP 15 n_sol 20 * + solutions + c!
vQ 16 n_sol 20 * + solutions + c!
vR 17 n_sol 20 * + solutions + c!
vS 18 n_sol 20 * + solutions + c!


then \ vJ_ok
then \ vI_ok
then \ vN_ok
then \ vO_ok
then \ vK_ok
loop \ EF
then \ vD_ok
loop \ MH
loop \ RQ
loop \ PS
loop \ GL
loop \ ABC
;

: .solution
n_sol 0
?do
0 n_sol 20 * + solutions + c@ to vA
1 n_sol 20 * + solutions + c@ to vB
2 n_sol 20 * + solutions + c@ to vC
3 n_sol 20 * + solutions + c@ to vD
4 n_sol 20 * + solutions + c@ to vE
5 n_sol 20 * + solutions + c@ to vF
6 n_sol 20 * + solutions + c@ to vG
7 n_sol 20 * + solutions + c@ to vH
8 n_sol 20 * + solutions + c@ to vI
9 n_sol 20 * + solutions + c@ to vJ
10 n_sol 20 * + solutions + c@ to vK
11 n_sol 20 * + solutions + c@ to vL
12 n_sol 20 * + solutions + c@ to vM
13 n_sol 20 * + solutions + c@ to vN
14 n_sol 20 * + solutions + c@ to vO
15 n_sol 20 * + solutions + c@ to vP
16 n_sol 20 * + solutions + c@ to vQ
17 n_sol 20 * + solutions + c@ to vR
18 n_sol 20 * + solutions + c@ to vS

cr
." A=" vA 2 .r space
." B=" vB 2 .r space
." C=" vC 2 .r space
." D=" vD 2 .r space
." E=" vE 2 .r space
." F=" vF 2 .r space
." G=" vG 2 .r space
." H=" vH 2 .r space
." I=" vI 2 .r space
." J=" vJ 2 .r space
." K=" vK 2 .r space
." L=" vL 2 .r space
." M=" vM 2 .r space
." N=" vN 2 .r space
." O=" vO 2 .r space
." P=" vP 2 .r space
." Q=" vQ 2 .r space
." R=" vR 2 .r space
." S=" vS 2 .r
loop

;


: -- 2 .r 2 spaces ;
: .mag_hex
n_sol 0
?do
0 n_sol 20 * + solutions + c@ to vA
1 n_sol 20 * + solutions + c@ to vB
2 n_sol 20 * + solutions + c@ to vC
3 n_sol 20 * + solutions + c@ to vD
4 n_sol 20 * + solutions + c@ to vE
5 n_sol 20 * + solutions + c@ to vF
6 n_sol 20 * + solutions + c@ to vG
7 n_sol 20 * + solutions + c@ to vH
8 n_sol 20 * + solutions + c@ to vI
9 n_sol 20 * + solutions + c@ to vJ
10 n_sol 20 * + solutions + c@ to vK
11 n_sol 20 * + solutions + c@ to vL
12 n_sol 20 * + solutions + c@ to vM
13 n_sol 20 * + solutions + c@ to vN
14 n_sol 20 * + solutions + c@ to vO
15 n_sol 20 * + solutions + c@ to vP
16 n_sol 20 * + solutions + c@ to vQ
17 n_sol 20 * + solutions + c@ to vR
18 n_sol 20 * + solutions + c@ to vS

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



utime solve utime d>f d>f f- cr cr ." execution time : " f. ." micro seconds." cr cr .solution cr cr .mag_hex
: timing_10
utime
10 0
do
solve
loop
utime
d>f d>f f- 10e f/
cr cr ." Mean execution time : " f. ." micro seconds."
;

[Anton Ertl]

Which one? Following the references leads to minforth's program that
you estimate to take 120.000h.

[Anton Ertl]

an...@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>You can find the code at
><https://github.com/AntonErtl/magic-hexagon/blob/main/magichex.4th>

You can now also find minforth's program, Ahmed Melahi's program and a
75-line program I wrote that uses the same approach as my
SEND+MORE=MONEY program at
<https://github.com/AntonErtl/magic-hexagon>.

>Enough for one evening, performance results tomorrow.

Here are the results for gforth-fast (development) on a Ryzen 5800X:

for i in "bye" "include ~/forth/magic-hexagon/ertl-simple.4th mhex bye" "include ~/forth/magic-hexagon/melahi.4th bye" "include ~/forth/magic-hexagon/magichex.4th labeling bye"; do LC_NUMERIC=prog perf stat -e cycles:u -e instructions:u gforth-fast -e "warnings off" -e "$i" >/dev/null; done

overhead ertl-simple melahi magichex
25_905_373 53_619_662 115_022_609 1_246_546_909 cycles:u
70_131_630 112_618_256 270_913_299 3_057_748_466 instructions:u
0.007722082 0.013866993 0.027026899 0.265033371 seconds time elapsed

In this case the additional effort for the more sophisticated approach
with the constraint-propagation framework (magichex) has not paid off.
Admittedly magichex does not eliminate rotated and mirrored solutions
and so produces 12 solutions, but the slowdown is by more than a
factor of 12. Maybe if we added even more sophistication; I have some
ideas in that direction (let ARRAYSUM compute upper and lower bounds
on the variables and propagate that), but I won't find the time to
implement them.

Looking at the coverage results, we see for magichex the following
interesting details:

gforth coverage.fs ~/forth/magic-hexagon/magichex.4th -e "labeling cr bw-cover .coverage bye"

: alldifferent-c ( 297512) {: u var addr1 u1 -- :}
( 297512) \ in the variables in addr1 u1, var has been instantiated to u
( 297512) addr1 u1 th addr1 u+do ( 5496662)
( 5496662) i @ {: vari :}
( 5496662) vari var <> if ( 5212205)
( 5212205) vari var-val @ dup u = if ( 17577) failure throw then ( 5194628) ( val )
( 5194628) 0< if ( 2552422) \ not yet instantiated
( 2552422) 1 u lshift vari var-bits @ 2dup and 0= if ( 0) failure throw then ( 2552422)
( 2552422) xor dup pow2? if ( 0) ( x ) \ only one bit set
( 0) ctz vari !var
( 0) else ( 2552422)
( 2552422) vari var-bits !bt
( 2552422) then ( 2552422) ( )
( 2552422) then ( 5194628)
( 5194628) then ( 5479085)
( 5479085) 1 cells +loop ( 279935) ( 279935) ;
...
: arraysum-c ( 2702304) {: u var addr1 u1 usum -- :}
( 2702304) \ with var set to u, deal with the constraint that the sum of the
( 2702304) \ variables in addr1 u1 equals usum.
( 2702304) 0 0 u1 0 +do ( 8429715) ( usum1 var1 )
( 8429715) addr1 i th @ {: vari :}
( 8429715) vari var-val @ dup 0< if ( 3945022) ( usum1 var1 vali )
( 3945022) drop if ( 1467519) ( usum1 ) \ constraint has >1 free variables, do nothing
( 1467519) drop unloop exit then ( 2477503)
( 2477503) vari
( 2477503) else ( 4484693)
( 4484693) rot + swap
( 4484693) then ( 6962196)
( 6962196) loop ( 1234785) ( 1234785)
( 1234785) dup if ( 1009984)
( 1009984) usum rot - swap !var
( 190532) else ( 224801)
( 224801) drop usum <> if ( 0) failure throw then ( 224801)
( 224801) then ( 415333) ;
...
: labeling ( 1) ( -- )
( 1) \ start with the corner variables in 3sums
( 1) \ B G P R N D follow from the 3sum constraints
( 1) \ then label one other 4sum variable: E
( 1) \ I N O K F J follow from the constraints
( 1) [: ( 1) A
( 1) [: ( 19) C
( 19) [: ( 180) L
( 180) [: ( 1760) S
( 1760) [: ( 11176) Q
( 11176) [: ( 45752) H
( 45752) [: ( 30504) E
( 30504) [: ( 12) printsolution failure throw ;]
( 30504) label ;]
( 45752) label ;]
( 11176) label ;]
( 1760) label ;]
( 180) label ;]
( 19) label ;]
( 1) label ;]
( 1) catch dup failure <> and throw
( 1) ." no (more) solutions" cr ;

In particular, we see that there are 0 cases where the domain of a
variable is reduced by ALLDIFFERENT so much that the variable is
instantiated (the "0" lines in ALLDIFFERENT-C), so the tree is not
pruned faster with this constraint-propagation approach than with the
manual ertl-simple.4th.

For comparison:

gforth coverage.fs ~/forth/magic-hexagon/ertl-simple.4th -e "mhex cr bw-cover .coverage bye"

...
: mhex ( 1) ( -- )
( 1) \ SEND+MORE=MONEY
( 1) occupationmap 20 erase
( 1) try< ( 19) ( 19) {: A :}
( 19) try< ( 361) ( 342) {: C :} A C < if ( 171)
( 171) 38 A - C - occupy< ( 94) {: B :}
( 94) try< ( 1786) ( 1508) {: L :} A L < if ( 802)
( 802) 38 C - L - occupy< ( 694) {: G :}
( 694) try< ( 13186) ( 9734) {: S :} A S < if ( 5824)
( 5824) 38 L - S - occupy< ( 3742) {: P :}
( 3742) try< ( 71098) ( 45099) {: Q :} A Q < if ( 27954)
( 27954) 38 S - Q - occupy< ( 14499) {: R :}
( 14499) try< ( 275481) ( 146172) {: H :} A H < if ( 92817) C H < if ( 23637)
( 23637) 38 Q - H - occupy< ( 12374) {: M :}
( 12374) 38 H - A - occupy< ( 2606) {: D :}
( 2606) try< ( 49514) ( 18370) {: E :}
( 18370) 38 D - E - G - occupy< ( 6063) {: F :}
( 6063) 38 B - F - P - occupy< ( 2326) {: K :}
( 2326) 38 G - K - R - occupy< ( 251) {: O :}
( 251) 38 P - O - M - occupy< ( 82) {: N :}
( 82) 38 R - N - D - occupy< ( 31) {: I :}
( 31) 38 M - I - B - E = if ( 31)
( 31) 38 A - E - O - S - occupy< ( 1) {: J :}
( 1) H I + J + K + L + 38 = if ( 1)
( 1) C F + J + N + Q + 38 = if ( 1)
( 1) cr ." " A .. B .. C ..
( 1) cr ." " D .. E .. F .. G ..
( 1) cr H .. I .. J .. K .. L ..
( 1) cr ." " M .. N .. O .. P ..
( 1) cr ." " Q .. R .. S .. cr
( 1) then ( 1)
( 1) then ( 1)
( 1) >occupy ( 31)
( 31) then ( 31)
( 31) >occupy ( 82)
( 82) >occupy ( 251)
( 251) >occupy ( 2326)
( 2326) >occupy ( 6063)
( 6063) >occupy ( 18370)
( 18370) >try ( 49514) ( 2606)
( 2606) >occupy ( 12374)
( 12374) >occupy ( 23637)
( 23637) then ( 92817) then ( 146172) >try ( 275481) ( 14499)
( 14499) >occupy ( 27954)
( 27954) then ( 45099) >try ( 71098) ( 3742)
( 3742) >occupy ( 5824)
( 5824) then ( 9734) >try ( 13186) ( 694)
( 694) >occupy ( 802)
( 802) then ( 1508) >try ( 1786) ( 94)
( 94) >occupy ( 171)
( 171) then ( 342) >try ( 361) ( 19)
( 19) >try ( 19) ( 1) ;

[Ahmed MELAHI]

HI, Thanks for testing.
The previous program was done in one shot, so it is not optimized, and contains some problems that concerns marking and unmarking already pruned values.
Hereafter, I modified the program so that :
- problem of marking and umarking is fixed
- the program now can get the 12 solutions
- we can get just one solution
tested with gforth:
- just one solution : 0.07745 second
- 12 solutions : 0.243362 seconds
tested with gforth-fast:
- just one solution: 0.074116 second
- 12 solutions: 0.129788 seconds

I did not optimize it for the moment, it still be one long long long word.
In fact, the approach is:
- fill table ABC (using 1st constraint)
- cycle through entries of the table ABC: for each entry of ABC do:
- fill table GL
- cycle through entries of GL: for each entry of GL do:
- fill table PS
- cycle through PS: for each entry of PS do:
- .....
-......
- caculate I
- for this value of I do:
-calulate J
- if J is ok, put this solution in a the table "solutions" and increase the count of solutions

this is the structure: fill table, cycle through this table (fill table, cycle....

the search is systematic: (Dynamic Programing??!!!).

---------------------here begin the listing:

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

0 to n_sol

0 to nth_ABC
0 to nth_GL
0 to nth_PS
0 to nth_RQ
0 to nth_MH
0 to nth_EF

\ ABC fill ABC

marked 20 erase

0 to nth_PS
\ cr ." GL:" i .
0 i 2 * + GL + c@ to vG
1 i 2 * + GL + c@ to vL
\ cr vA . vB . vC . vG . vL . .s \ ----------------------------------------

marked 20 erase

0 to nth_RQ
\ ." PS: " i .
0 i 2 * + PS + c@ to vP
1 i 2 * + PS + c@ to vS
\ cr vA . vB . vC . vG . vL . vP . vS . .s \ -------------------

\ RQ
20 1
do
i to vR
vR marked + c@ 0=
if
1 vR marked + c!

1 vP marked + c!
1 vS marked + c!

1 vG marked + c!
1 vL marked + c!

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!

38 vS vR + - to vQ
vQ marked + c@ 0=
vQ 0> and
vQ 20 < and
if
vR 0 nth_RQ 2 * + RQ + c!
vQ 1 nth_RQ 2 * + RQ + c!
nth_RQ 1+ to nth_RQ
then
then
0 vR marked + c!
loop

\ cycle through RQ
nth_RQ 0
?do

marked 20 erase

0 to nth_MH
0 i 2 * + RQ + c@ to vR
1 i 2 * + RQ + c@ to vQ
\ cr vA . vB . vC . vG . vL . vP . vS . vR . vQ . .s \ ------------------------------

\ MH
20 1
do
i to vM
vM marked + c@ 0=
if
1 vM marked + c!

1 vR marked + c!
1 vQ marked + c!

1 vP marked + c!
1 vS marked + c!

1 vG marked + c!
1 vL marked + c!

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!

38 vQ vM + - to vH
vH marked + c@ 0=
vH 0> and
vH 20 < and
if
vM 0 nth_MH 2 * + MH + c!
vH 1 nth_MH 2 * + MH + c!
nth_MH 1+ to nth_MH
then
then
0 vM marked + c!
loop
\ cycle through MH
nth_MH 0
?do

marked 20 erase

\ cr vA . vB . vC . vG . vL . vP . vS . vR . vQ . vM . vH . vD . .s \ -------------------------------------------------

20 1
do
i to vE
vE marked + c@ 0=
if

marked 20 erase

1 vE marked + c!

1 vD marked + c!

1 vM marked + c!
1 vH marked + c!

1 vR marked + c!
1 vQ marked + c!

1 vP marked + c!
1 vS marked + c!

1 vG marked + c!
1 vL marked + c!

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!

38 vD vE + vG + - to vF
vF marked + c@ 0=
vF 0> and
vF 20 < and
if
vE 0 nth_EF 2 * + EF + c!
vF 1 nth_EF 2 * + EF + c!
nth_EF 1+ to nth_EF
then
then
0 vE marked + c!
loop \ EF

nth_EF 0
?do

marked 20 erase

\ +---------------------------------------------------------------------------------------------------------------+
\ | to get just one solution uncomment the line hereafter, to get all solutions (12) comment the line hereafter. |
\ +---------------------------------------------------------------------------------------------------------------+
cr ." one solution found." unloop unloop unloop unloop unloop unloop exit

then 0 vJ marked + c! \ vJ_ok

then 0 vI marked + c! \ vI_ok

then 0 vN marked + c! \ vN_ok

then 0 vO marked + c! \ vO_ok

then 0 vK marked + c! \ vK_ok

loop 0 vE marked + c! 0 vF marked + c! \ EF
then 0 vD marked + c! \ vD_ok
loop 0 vM marked + c! 0 vH marked + c! \ MH
loop 0 vR marked + c! 0 vQ marked + c! \ RQ
loop 0 vP marked + c! 0 vS marked + c! \ PS
loop 0 vG marked + c! 0 vL marked + c! \ GL
loop \ 0 vA marked + c! 0 vB marked + c! 0 vC marked + c! \ ABC
;

: .solution
cr n_sol . ." solutions found."
n_sol 1+ 1
?do
0 i 20 * + solutions + c@ to vA
1 i 20 * + solutions + c@ to vB
2 i 20 * + solutions + c@ to vC
3 i 20 * + solutions + c@ to vD
4 i 20 * + solutions + c@ to vE
5 i 20 * + solutions + c@ to vF
6 i 20 * + solutions + c@ to vG
7 i 20 * + solutions + c@ to vH
8 i 20 * + solutions + c@ to vI
9 i 20 * + solutions + c@ to vJ
10 i 20 * + solutions + c@ to vK
11 i 20 * + solutions + c@ to vL
12 i 20 * + solutions + c@ to vM
13 i 20 * + solutions + c@ to vN
14 i 20 * + solutions + c@ to vO
15 i 20 * + solutions + c@ to vP
16 i 20 * + solutions + c@ to vQ
17 i 20 * + solutions + c@ to vR
18 i 20 * + solutions + c@ to vS

cr
." A=" vA 2 .r space
." B=" vB 2 .r space
." C=" vC 2 .r space
." D=" vD 2 .r space
." E=" vE 2 .r space
." F=" vF 2 .r space
." G=" vG 2 .r space
." H=" vH 2 .r space
." I=" vI 2 .r space
." J=" vJ 2 .r space
." K=" vK 2 .r space
." L=" vL 2 .r space
." M=" vM 2 .r space
." N=" vN 2 .r space
." O=" vO 2 .r space
." P=" vP 2 .r space
." Q=" vQ 2 .r space
." R=" vR 2 .r space
." S=" vS 2 .r
loop

;


: -- 2 .r 2 spaces ;
: .mag_hex

cr n_sol . ." solutions found."
n_sol 1+ 1
?do
0 i 20 * + solutions + c@ to vA
1 i 20 * + solutions + c@ to vB
2 i 20 * + solutions + c@ to vC
3 i 20 * + solutions + c@ to vD
4 i 20 * + solutions + c@ to vE
5 i 20 * + solutions + c@ to vF
6 i 20 * + solutions + c@ to vG
7 i 20 * + solutions + c@ to vH
8 i 20 * + solutions + c@ to vI
9 i 20 * + solutions + c@ to vJ
10 i 20 * + solutions + c@ to vK
11 i 20 * + solutions + c@ to vL
12 i 20 * + solutions + c@ to vM
13 i 20 * + solutions + c@ to vN
14 i 20 * + solutions + c@ to vO
15 i 20 * + solutions + c@ to vP
16 i 20 * + solutions + c@ to vQ
17 i 20 * + solutions + c@ to vR
18 i 20 * + solutions + c@ to vS

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



utime solve utime d>f d>f f- cr cr ." execution time : " f. ." micro seconds." cr cr .solution cr cr .mag_hex
: timing_10
utime
10 0
do
solve
loop
utime
d>f d>f f- 10e f/
cr cr ." Mean execution time : " f. ." micro seconds."
;

Thanks

[Marcel Hendrix]

On Tuesday, February 21, 2023 at 4:01:00 AM UTC+1, Ahmed MELAHI wrote:
> Le dimanche 12 février 2023 à 10:43:46 UTC, minf...@arcor.de a écrit :
> > Another while-away-your-afternoon-teatime puzzle:

[..]

Nice! Completely portable and fast. Only gripe: When I ran timing_10 a few
times, it bombs out to the OS. Completely re-initializing the values and arrays
solved that.

FORTH> .TICKER-INFO
AMD Ryzen 7 5800X 8-Core Processor
TICKS-GET uses os time & PROCESSOR-CLOCK 4192MHz

FORTH> timing_1000
Mean execution time : 5.519 milliseconds.

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

This is about 3x faster than minion-0.12.

d:\minion\minion-0.12\bin>minion hexagon.minion
# Minion Version 0.12
# Git version: 65512633daee570de1fdf16a0025d919f6f3753e
# Git last changed date: Mon Feb 8 17:33:56 2010 +0000
# Run at: UTC Tue Feb 21 21:39:58 2023

# http://minion.sourceforge.net
# Minion is still very new and in active development.
# If you have problems with Minion or find any bugs, please tell us!
# Mailing list at: https://mail.cs.st-andrews.ac.uk/mailman/listinfo/mug
# Input filename: hexagon.minion
# Command line: minion hexagon.minion
Parsing Time: 0.000000
Setup Time: 0.015625
First Node Time: 0.000000
Initial Propagate: 0.000000
First node time: 0.015625
Sol: 3 17 18 19 7 1 11 16 2 5 6 9 12 4 8 14 10 13 15

Solution Number: 1
Time:0.015625
Nodes: 774

Solve Time: 0.015625
Total Time: 0.046875
Total System Time: 0.015625
Total Wall Time: 0.031000
Maximum Memory (kB): 0
Total Nodes: 774
Problem solvable?: yes
Solutions Found: 1

-marcel

[Anton Ertl]

Ahmed MELAHI <ahmed....@univ-bejaia.dz> writes:
>Hereafter, I modified the program so that :
> - problem of marking and umarking is fixed

> - the program now can get the 12 solutions =20
> - we can get just one solution=20
>tested with gforth:=20

> - just one solution : 0.07745 second
> - 12 solutions : 0.243362 seconds
>tested with gforth-fast:
> - just one solution: 0.074116 second
> - 12 solutions: 0.129788 seconds

On an Ryzen 5800X with gforth-fast:

overhead ertl-simple melahi melahi2 e-s A e-s B
25_905_373 53_619_662 115_022_609 40_282_001 32_745_355 33_870_576 c
70_131_630 112_618_256 270_913_299 99_171_877 81_093_523 83_096_994 i
0.007722082 0.013866993 0.027026899 0.011071537 0.009659665 0.009792036 s

cycles:u
instructions:u # 2.45 insn per cycle
seconds time elapsed


"overhead" is just the startup overhead of gforth-fast.
"melahi2" is your new version.
"e-s A" is ertl-simple modified to just stop after finding the solution
"e-s B" is e-s A modified to not eliminated rotated and mirrored sols.

<https://github.com/AntonErtl/magic-hexagon/blob/main/ertl-simple.4th>
now contains the stopping part as commented-out code.

"e-s B", also with the stopping part commented out is available on
<https://github.com/AntonErtl/magic-hexagon/blob/main/ertl-simple-all.4th>

Note that ertl-simple produces only one solution even if you let it
run to the end: It checks that A < C,L,S,Q,H to eliminate rotated
solutions. and that C < H to eliminate the mirrored solutions. This
obviously reduces the time to explore the whole search space (because
the search space is smaller); to check whether and how much it reduces
the time to find one solution, I commented out these checks, giving
e-s B; it's slightly slower than e-s A.

Here you find a comparison of the all-solutions performance with
rotated and mirrored solutions:

overhead e-s B melahi2 magichex
26_210_741 164_908_219 207_753_513 1_255_498_158 cycles:u
70_131_592 252_011_139 501_578_813 3_057_748_265 instructions:u
0.007824568 0.037550770 0.046885166 0.267070972 seconds time elapsed

Interesting difference in instructions per cycle (IPC) between e-s B
(1.53) and melahi2 (2.41). Typical code without particular dependence
problems has an IPC more like melahi2; however, I don't see an obvious
dependence problem in ertl-simple. Looking at the performance counter
results, branch misses contribute significantly, but less than half of
the difference.

[Ahmed MELAHI]

HI, thanks for testing
Here, The last version of the program, I removed superfluous consecutive unmarks and and marks that consumed time.
I tested it on my PC: Intel(R) Celeron(R) CPU 3867U @ 1.80GHz 1.80 GHz, 12GB:
- gforth-fast:
- 1 solution: about 2.3 ms (the same result if I use A<C,...)
- 12 solutions (all): 70 ms
- gforth:
- 1 solution: 5 ms
- 12 solutions: 146 ms

The listing begins here:

create marked 20 allot
marked 20 erase

create solutions 20 20 * allot

create ABC 19 18 * 3 * allot
create GL 16 2 * allot
create PS 14 2 * allot
create RQ 12 2 * allot
create MH 10 2 * allot

create EF 7 2 * allot

\ begin search: cycling and filling
marked 20 erase

\ cycle through ABC
nth_ABC 0
do

0 to nth_GL

0 i 3 * + ABC + c@ to vA
1 i 3 * + ABC + c@ to vB
2 i 3 * + ABC + c@ to vC

1 vA marked + c!
1 vB marked + c!
1 vC marked + c!

\ GL
20 1
do
i to vG
vG marked + c@ 0=
if
1 vG marked + c!

38 vC vG + - to vL
vL marked + c@ 0=
vL 0> and
vL 20 < and
if
vG 0 nth_GL 2 * + GL + c!
vL 1 nth_GL 2 * + GL + c!
nth_GL 1+ to nth_GL
then

0 vG marked + c!

then

loop

\ cycle through GL
nth_GL 0
?do

0 to nth_PS

0 i 2 * + GL + c@ to vG
1 i 2 * + GL + c@ to vL

1 vG marked + c!
1 vL marked + c!

\ PS
20 1
do
i to vP
vP marked + c@ 0=
if
1 vP marked + c!

38 vL vP + - to vS
vS marked + c@ 0=
vS 0> and
vS 20 < and
if
vP 0 nth_PS 2 * + PS + c!
vS 1 nth_PS 2 * + PS + c!
nth_PS 1+ to nth_PS
then

0 vP marked + c!

then

loop

\ cycle through PS
nth_PS 0
?do

0 to nth_RQ

0 i 2 * + PS + c@ to vP
1 i 2 * + PS + c@ to vS

1 vP marked + c!
1 vS marked + c!

\ RQ
20 1
do
i to vR
vR marked + c@ 0=
if
1 vR marked + c!

38 vS vR + - to vQ
vQ marked + c@ 0=
vQ 0> and
vQ 20 < and
if
vR 0 nth_RQ 2 * + RQ + c!
vQ 1 nth_RQ 2 * + RQ + c!
nth_RQ 1+ to nth_RQ
then

0 vR marked + c!

then

loop

\ cycle through RQ
nth_RQ 0
?do

0 to nth_MH
0 i 2 * + RQ + c@ to vR
1 i 2 * + RQ + c@ to vQ

1 vR marked + c!
1 vQ marked + c!

\ MH
20 1
do
i to vM
vM marked + c@ 0=
if
1 vM marked + c!

38 vQ vM + - to vH
vH marked + c@ 0=
vH 0> and
vH 20 < and
if
vM 0 nth_MH 2 * + MH + c!
vH 1 nth_MH 2 * + MH + c!
nth_MH 1+ to nth_MH
then

0 vM marked + c! \ cr vM .
then

loop

\ cycle through MH
nth_MH 0
?do

0 i 2 * + MH + c@ to vM
1 i 2 * + MH + c@ to vH

1 vM marked + c!
1 vH marked + c!

\ calculate D (38-A-H = D)
0 to vD_ok
38 vA vH + - to vD
vD marked + c@ 0=
vD 0> and
vD 20 < and
if
1 to vD_ok
then

0 to nth_EF
vD_ok
if
\ EF

1 vD marked + c!

20 1
do
i to vE
vE marked + c@ 0=
if

1 vE marked + c!

38 vD vE + vG + - to vF
vF marked + c@ 0=
vF 0> and
vF 20 < and
if
vE 0 nth_EF 2 * + EF + c!
vF 1 nth_EF 2 * + EF + c!
nth_EF 1+ to nth_EF
then

0 vE marked + c!

then

loop \ EF
nth_EF 0
?do

0 i 2 * + EF + c@ to vE
1 i 2 * + EF + c@ to vF

1 vE marked + c!
1 vF marked + c!

\ calculate K (K = 38-B-F-P)
0 to vK_ok
38 vB vF + vP + - to vK
vK marked + c@ 0=
vK 0> and
vK 20 < and
if
1 to vK_ok
then

vK_ok
if
\ calculate O (O = 38-G-K-R)
1 vK marked + c!

0 to vO_ok
38 vG vK + vR + - to vO
vO marked + c@ 0=
vO 0> and
vO 20 < and
if
1 to vO_ok
then

vO_ok
if
\ calculate N (N = 38-P-O-M)
1 vO marked + c!

0 to vN_ok
38 vP vO + vM + - to vN
vN marked + c@ 0=
vN 0> and
vN 20 < and
if
1 to vN_ok
then

vN_ok
if
\ calculate I (I = 38-R-N-D)
1 vN marked + c!

0 to vI_ok
38 vR vN + vD + - to vI
vI marked + c@ 0=
vI 0> and
vI 20 < and
if
1 to vI_ok
then

vI_ok
if
\ calculate J (J = 38-H-I-K-L)
1 vI marked + c!

0 to vJ_ok
38 vH vI + vK + vL + - to vJ
vJ marked + c@ 0=
vJ 0> and
vJ 20 < and
if
1 to vJ_ok

then

vJ_ok
if
1 vJ marked + c!
n_sol 1+ to n_sol
vA 0 n_sol 20 * + solutions + c!
vB 1 n_sol 20 * + solutions + c!
vC 2 n_sol 20 * + solutions + c!
vD 3 n_sol 20 * + solutions + c!
vE 4 n_sol 20 * + solutions + c!
vF 5 n_sol 20 * + solutions + c!
vG 6 n_sol 20 * + solutions + c!
vH 7 n_sol 20 * + solutions + c!
vI 8 n_sol 20 * + solutions + c!
vJ 9 n_sol 20 * + solutions + c!
vK 10 n_sol 20 * + solutions + c!
vL 11 n_sol 20 * + solutions + c!
vM 12 n_sol 20 * + solutions + c!
vN 13 n_sol 20 * + solutions + c!
vO 14 n_sol 20 * + solutions + c!
vP 15 n_sol 20 * + solutions + c!
vQ 16 n_sol 20 * + solutions + c!
vR 17 n_sol 20 * + solutions + c!
vS 18 n_sol 20 * + solutions + c!

\ +---------------------------------------------------------------------------------------------------------------+

\ | to get just one solution uncomment out the line hereafter, to get all solutions (12) comment out the line hereafter. |
\ +---------------------------------------------------------------------------------------------------------------+

unloop unloop unloop unloop unloop unloop exit

0 vJ marked + c!

then \ vJ_ok

0 vI marked + c!

then \ vI_ok

0 vN marked + c!

then \ vN_ok

0 vO marked + c!

then \ vO_ok

0 vK marked + c!

then \ vK_ok

0 vE marked + c!
0 vF marked + c!

loop \ EF

0 vD marked + c!

then \ vD_ok

0 vM marked + c!
0 vH marked + c!

loop \ MH

0 vR marked + c!
0 vQ marked + c!

loop \ RQ

0 vP marked + c!
0 vS marked + c!

loop \ PS

0 vG marked + c!
0 vL marked + c!

loop \ GL

0 vA marked + c!
0 vB marked + c!
0 vC marked + c!

loop \ ABC

: timing_1000
utime
1000 0
do
solve
loop
utime
d>f d>f f- 1000e f/

cr cr ." Mean execution time : " f. ." micro seconds."
;

utime solve utime d>f d>f f- cr cr ." execution time : " f. ." micro seconds." cr cr .solution cr cr .mag_hex

\ timing_10000

Thanks.

[Anton Ertl]

Ahmed MELAHI <ahmed....@univ-bejaia.dz> writes:
>Here, The last version of the program, I removed superfluous consecutive un=

>marks and and marks that consumed time.

>I tested it on my PC: Intel(R) Celeron(R) CPU 3867U @ 1.80GHz 1.80 GHz, =
>12GB:=20
> - gforth-fast:=20
> - 1 solution: about 2.3 ms (the same result if I use A<C=

>,...)
> - 12 solutions (all): 70 ms
> - gforth:
> - 1 solution: 5 ms
> - 12 solutions: 146 ms

Again gforth-fast on Ryzen 5800X:

overhead e-s A e-s B melahi3
25_905_373 32_745_355 33_870_576 35_218_929 cycles:u
70_131_630 81_093_523 83_096_994 89_686_731 instructions:u
0.007722082 0.009659665 0.009792036 0.010334186 seconds time elapsed

"overhead" is just the startup overhead of gforth-fast.

"melahi3" is your newest version.

"e-s A" is ertl-simple modified to just stop after finding the solution
"e-s B" is e-s A modified to not eliminated rotated and mirrored sols.

They are very close to each other now.

[Marcel Hendrix]

On Thursday, February 23, 2023 at 5:37:16 PM UTC+1, Anton Ertl wrote:
> Ahmed MELAHI <ahmed....@univ-bejaia.dz> writes:
[..]

> Again gforth-fast on Ryzen 5800X:
>
> overhead e-s A e-s B melahi3
> 25_905_373 32_745_355 33_870_576 35_218_929 cycles:u
> 70_131_630 81_093_523 83_096_994 89_686_731 instructions:u
> 0.007722082 0.009659665 0.009792036 0.010334186 seconds time elapsed

melahi-3 on iForth:

FORTH> TRUE TO one? timing_1000
214 microseconds elapsed, 1 solution found.
FORTH> FALSE TO one? timing_1000
7,935 microseconds elapsed, 12 solutions found.

From 5.519 ms to 0.214 ms is quite an improvement,
and 0.214 ms is 73x faster than the minions 'C' program.

-marcel

[Ahmed MELAHI]

HI,
Thanks for testing.
Here is the final version of the program magic_hexagon.
Here, there is no tables to fill, the search is applied directly.
The program is now reduced in size, and faster.

\ ----------------------Here begins the listing

0 value n_sol

create marked 20 allot
marked 20 erase

create solutions 20 20 * allot

: solve
0 to n_sol
marked 20 erase

\ A

20 1
do
i to vA
1 vA marked + c!

\ B

20 1
do
i to vB
vB marked + c@ 0=
if
1 vB marked + c!

38 vA vB + - to vC

vC 0>
vC 20 < and
vC marked + c@ 0= and

if \ C

1 vC marked + c!
\ G

20 1
do
i to vG
vG marked + c@ 0=
if
1 vG marked + c!

38 vC vG + - to vL

vL 0>
vL 20 < and
vL marked + c@ 0= and
if

1 vL marked + c!

\ PS
20 1
do
i to vP
vP marked + c@ 0=
if
1 vP marked + c!

38 vL vP + - to vS

vS 0>
vS 20 < and
vS marked + c@ 0= and
if

1 vS marked + c!

\ RQ
20 1
do
i to vR
vR marked + c@ 0=
if
1 vR marked + c!

38 vS vR + - to vQ

vQ 0>
vQ 20 < and
vQ marked + c@ 0= and
if

1 vQ marked + c!

\ MH
20 1
do
i to vM
vM marked + c@ 0=
if
1 vM marked + c!

38 vQ vM + - to vH

vH 0>
vH 20 < and
vH marked + c@ 0= and
if

1 vH marked + c!

\ calculate D (38-A-H = D)

38 vA vH + - to vD

vD 0>
vD 20 < and
vD marked + c@ 0= and
if

1 vD marked + c!

20 1
do
i to vE
vE marked + c@ 0=
if
1 vE marked + c!

38 vD vE + vG + - to vF

vF 0>
vF 20 < and
vF marked + c@ 0= and
if

1 vF marked + c!

\ calculate K (K = 38-B-F-P)

38 vB vF + vP + - to vK

vK 0>
vK 20 < and
vK marked + c@ 0= and

if
\ calculate O (O = 38-G-K-R)
1 vK marked + c!

38 vG vK + vR + - to vO

vO 0>
vO 20 < and
vO marked + c@ 0= and

if
\ calculate N (N = 38-P-O-M)
1 vO marked + c!

38 vP vO + vM + - to vN

vN 0>
vN 20 < and
vN marked + c@ 0= and

if
\ calculate I (I = 38-R-N-D)
1 vN marked + c!

38 vR vN + vD + - to vI

vI 0>
vI 20 < and
vI marked + c@ 0= and

if
\ calculate J (J = 38-H-I-K-L)
1 vI marked + c!

38 vH vI + vK + vL + - to vJ

vJ 0>
vJ 20 < and
vJ marked + c@ 0= and

if
\ 1 vJ marked + c!
n_sol 1+ to n_sol
vA 0 n_sol 20 * + solutions + c!
vB 1 n_sol 20 * + solutions + c!
vC 2 n_sol 20 * + solutions + c!
vD 3 n_sol 20 * + solutions + c!
vE 4 n_sol 20 * + solutions + c!
vF 5 n_sol 20 * + solutions + c!
vG 6 n_sol 20 * + solutions + c!
vH 7 n_sol 20 * + solutions + c!
vI 8 n_sol 20 * + solutions + c!
vJ 9 n_sol 20 * + solutions + c!
vK 10 n_sol 20 * + solutions + c!
vL 11 n_sol 20 * + solutions + c!
vM 12 n_sol 20 * + solutions + c!
vN 13 n_sol 20 * + solutions + c!
vO 14 n_sol 20 * + solutions + c!
vP 15 n_sol 20 * + solutions + c!
vQ 16 n_sol 20 * + solutions + c!
vR 17 n_sol 20 * + solutions + c!
vS 18 n_sol 20 * + solutions + c!

\ +-----------------------------------------------------------------------------------------------------------------------+

\ | to get just one solution uncomment out the line hereafter, to get all solutions (12) comment out the line hereafter. |

\ +-----------------------------------------------------------------------------------------------------------------------+
unloop unloop unloop unloop unloop unloop unloop exit

\ 0 vJ marked + c!
then \ vJ

0 vI marked + c!
then \ vI

0 vN marked + c!
then \ vN

0 vO marked + c!
then \ vO

0 vK marked + c!
then \ vK

0 vF marked + c!

then \ vF

0 vE marked + c!
then

loop \ vE

0 vD marked + c!
then \ vD

0 vH marked + c!

then \ vH

0 vM marked + c!

then
loop \ vM

0 vQ marked + c!

then \ vQ

0 vR marked + c!
then

loop \ vR

0 vS marked + c!

then \ vS

0 vP marked + c!
then

loop \ vP

0 vL marked + c!

then \ vL

0 vG marked + c!
then

loop \ vG

0 vC marked + c!

then \ vC

0 vB marked + c!

then

loop
0 vA marked + c!

loop \ vA

;


: timing_1000
utime
1000 0
do
solve
loop
utime
d>f d>f f- 1000e f/
cr cr ." Mean execution time : " f. ." micro seconds."
;

utime solve utime d>f d>f f- cr cr ." execution time : " f. ." micro seconds." cr cr .solution cr cr .mag_hex
\ timing_10000

\ -----------Here, the listing finishes.

[Anton Ertl]

Ahmed MELAHI <ahmed....@univ-bejaia.dz> writes:
>Here is the final version of the program magic_hexagon.
>Here, there is no tables to fill, the search is applied directly.
>The program is now reduced in size, and faster.

I put it in
<https://github.com/AntonErtl/magic-hexagon/blob/main/melahi4.4th>.

Here are some results on a Ryzen 5800X:

overhead e-s B melahi3
25_905_373 33_870_576 35_218_929 cycles:u
70_131_630 83_096_994 89_686_731 instructions:u
0.007722082 0.009792036 0.010334186 seconds time elapsed


overhead ertl-simple e-s A melahi3 melahi4
25_618_534 52_989_008 32_745_355 34_748_825 32_780_729 cycles:u
70_015_798 112_534_500 81_093_523 89_563_036 85_089_218 instructions:u
0.007561816 0.013706553 0.009659665 0.009785266 0.009325339 seconds elapsed

The programs are:

"overhead" is just the startup overhead of gforth-fast.

"ertl-simple" finds the solution and proves that there is no other

"e-s A" is ertl-simple modified to just stop after finding the solution

"melahi3" is your previous version.
"melahi4" is your newest version

The "e-s A" measurement is taken from my last rounds of measurements,
everything else is measured again.

[Anton Ertl]

an...@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>"minf...@arcor.de" <minf...@arcor.de> writes:
>>Another while-away-your-afternoon-teatime puzzle:
>>
>>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.
>>
>>It is said that this puzzle is almost impossibly hard to solve manually.
>
>According to <https://en.wikipedia.org/wiki/Magic_hexagon>:
>
>|The order-3 magic hexagon has been published many times as a 'new'
>|discovery. An early reference, and possibly the first discoverer, is
>|Ernst von Haselberg (1887).
>
>I guess that von Haselberg did it manually.
>
>Anyway, unlike Marcel Hendrix I could not resist and implemented a
>simple constraint-satisfaction problem framework and the magic hexagon
>on top of it.
>
>You can find the code at
><https://github.com/AntonErtl/magic-hexagon/blob/main/magichex.4th>

That framework just triggered constraints when a variable is
instantiated (i.e., receives a value). I have now extended it to work
with bounds. E.g., if we have variables A and C with the possible
values

A,C in [1,19]

and we have a constraint

A C #< \ i.e., A<C

then, if the constraint is value-triggered, it will only become active
when A or C receive a value. With a bounds-triggered constraint, the
constraint can become active immediately, reducing the ranges of A and
C to

A in [1,18]
C in [2,19]

And whenever a bound of A or C changes, the constraint is triggered
again and can reduce the range of the other variable. One might make
this more efficient by triggering the constraint only when the upper
bound of C falls, or the lower bound of A rises, but for now I trigger
it when either bound of either variable changes; triggering the
constraint unnecessarily costs CPU time, but does not change the
results.

With the bounds-triggered constraints I have also implemented the #<
constraint (which I did not implement as a value-triggered
constraint), and therefore have added (optional) constraints for
eliminating the symmetric solutions:

\ eliminate rotational symmetry
A C #<
A L #<
A S #<
A Q #<
A H #<
\ eliminate mirror symmetry
C H #<

And of course I changed ARRAYSUM to use bounds; ALLDIFFERENT works in
a value-triggered way just as before, but of course there are changes
to cover the changes in the data structures.

You can find the result in

https://github.com/AntonErtl/magic-hexagon/blob/main/magichex-bounds.4th

Performance results on a Ryzen 5800X, produced with:

for i in "bye" "include ~/forth/magic-hexagon/ertl-simple-all.4th mhex bye" "include ~/forth/magic-hexagon/magichex.4th labeling bye" "create symsolutions include ~/forth/magic-hexagon/magichex-bounds.4th labeling bye" "include ~/forth/magic-hexagon/magichex-bounds.4th labeling bye" "include ~/forth/magic-hexagon/ertl-simple.4th mhex bye"; do LC_NUMERIC=prog taskset -c 6 perf stat -e cycles:u -e instructions:u gforth-fast -e "warnings off" -e "$i"; done

| with symmetric solutions |without symmetric sols
overhead | simple value bounds | bounds simple
25_586_735|160_482_071 1_248_350_451 2_503_188_624|280_888_069 53_157_746 c
70_015_764|251_843_818 3_061_504_311 6_136_581_094|685_887_156 112_534_236 i
0.007591329|0.036142430 0.265906860 0.531105561|0.061859780 0.013864220 s

The lines are:

c: cycles spent in user level
i: instructions executed in user level
s: seconds time elapsed

The columns are:

overhead: just starting and ending gforth-fast
simple: no constraints; ertl-simple-all.4th and ertl-simple.4th
value: value-triggered constraints; magichex.4th
bounds: bounds-triggered constraints; magichex-bounds.4th

We see that for this puzzle the reduced search space does not pay for
the increased overhead of constraints, especially of bounds-triggered
constraints. For problems with a bigger search space, the balance may
be different.

To demonstrate the search space reduction, here's the data I have
extracted from the profiles of thes programs that we get with
coverage.fs. All three programs set the variables in the same order:
A, C, L, S, Q, H, E.

For A, there are at most 19 variants, for C a naive approach would try
another 19 variants (for a total of 361), etc. Smarter variants prune
the search tree earlier, resulting in fewer variants to try. So how
well do they prune?

~/gforth/gforth coverage.fs ~/forth/magic-hexagon/ertl-simple-all.4th -e "mhex cr bw-cover .coverage bye"

with symmetric solutions|without sym. sols
simple value bounds | bounds simple
A 19 19 19 | 16 19
C 342 180 182 | 50 171
L 3016 1760 1700 | 303 802
S 25460 11176 9477 | 875 5824
Q 142440 45752 13971 | 472 27954
H 501764 30504 286 | 1 23637
E 220440 12 12 | 1 18370
m 2382124 8429715 15563945 | 1494494 527982

The simple approaches tend to produce wider search trees, while the
two constrain approaches prunes the search trees earlier. In case of
bounds without symmetric solutions, already instantiating H leads to
the solution, instantiating E is unnecessary. The numbers at the
other search levels are also much smaller. The "m" line shows the
most-executed piece of code in the program, and here we can see that
despite the significant pruning of the search tree, this number tends
to grow with constraints and especially the more sophisticated
bounds-triggered constraints; and that explains the worse performance
of the more sophisticated approaches.

Looking at the lines of code, we see

79 ertl-simple-all.4th
79 ertl-simple.4th
345 magichex-bounds.4th
262 magichex.4th
645 melahi.4th
731 melahi2.4th
523 melahi3.4th
428 melahi4.4th
92 minforth.4th

So the simple approach is also smallest.