Nп/п : 63 из 100
 От   : Ahmed MELAHI                        2:5075/128        29 сен 23 05:59:48
 К    : none) (albert                                         29 сен 23 16:03:05
 Тема : Re: new version of magic hexagon program
----------------------------------------------------------------------------------
                                                                                 
@MSGID:
<0cfbec25-d022-4200-85d0-d134a5838badn@googlegroups.com> 91ee1be6
@REPLY:
199fe6c2
@REPLYADDR Ahmed MELAHI
<ahmed.melahi@univ-bejaia.dz>
@REPLYTO 2:5075/128 Ahmed MELAHI
@CHRS: CP866 2
@RFC: 1 0
@RFC-References:
<3b96660a-56e6-4a84-ac82-2758fe6b9d06n@googlegroups.com>
@RFC-Message-ID:
<0cfbec25-d022-4200-85d0-d134a5838badn@googlegroups.com>
@TZUTC: -0700
@PID: G2/1.0
@TID: FIDOGATE-5.12-ge4e8b94
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?
 
--- G2/1.0
 * Origin: usenet.network (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



   GoldED+ VK   │                                                 │   09:55:30    
                                                                                
В этой области больше нет сообщений.

Остаться здесь
Перейти к списку сообщений
Перейти к списку эх