@MSGID:
199fe6c2
@REPLY:
<3b96660a-56e6-4a84-ac82-2758fe6b9d06n@googlegroups.com> 42328d4e
@REPLYADDR none) (albert
@REPLYTO 2:5075/128 none) (albert
@CHRS: CP866 2
@RFC: 1 0
@RFC-References:
<3b96660a-56e6-4a84-ac82-2758fe6b9d06n@googlegroups.com>
@RFC-Message-ID:

@TZUTC: 0200
@TID: FIDOGATE-5.12-ge4e8b94
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 -
--- trn 4.0-test77 (Sep 1, 2010)
 * Origin: KPN B.V. (2:5075/128)
SEEN-BY: 5001/100 5005/49 5015/255 5019/40 5020/715
848 1042 4441 12000
SEEN-BY: 5030/49 1081 5058/104 5075/128
@PATH: 5075/128 5020/1042 4441