Abelian sandpile model: Difference between revisions

Line 32:

<br>

<lang forth>#! /usr/bin/gforth -m ~~50M~~

<lang forth>#! /usr/bin/gforth -d 20M

\ Abelian Sandpile Model

Line 52:

size^2 allot-erase arr

size^2 2 * allot-erase bottom

variable stack bottom 2cells - stack !

\ array processing

Line 64:

Line 62:

\ stack processing

: ~~inc~~-~~stack~~ ~~2cells stack +!~~ ;

: stack-empty? dup -1 = ;

: stack-empty? stack @ bottom u< ;

: stack-full? stack-empty? invert ;

: dec-stack assert( stack-full? ) -2cells stack +! ;

: peek assert( stack-full? ) stack @ 2@ ;

: pop peek dec-stack ;

: push inc-stack stack @ 2! ;

: point. swap [char] ( emit 1 u.r [char] , emit 1 u.r [char] ) emit space ;

: stack. stack @ 2cells + bottom ?do i 2@ point. 2cells +loop ;

\ pgm-handling

Line 84:

Line 75:

\ sandpile

: info. cr arr. stack. cr ;

: prep-arr HEIGHT center ix ! ;

: prep-stack HEIGHT 4 u>= if center ~~push~~ then ;

: prep-stack -1 HEIGHT 4 u>= if center then ;

: prepare prep-arr prep-stack ;

: ensure if else 2drop 0 2rdrop exit then ;

Line 98:

Line 88:

: south 1. d+ ;

: west 1- ;

: reduce ~~peek~~ 2dup ix dup -4 swap +! @ 4 < if ~~dec-stack~~ then ;

: reduce 2dup ix dup -4 swap +! @ 4 < if 2drop then ;

: increase 2dup legal? if 2dup ix dup 1 swap +! @ 4 = if ~~push~~ else 2drop then else 2drop then ;

: increase 2dup legal? if 2dup ix dup 1 swap +! @ 4 = if 2swap else 2drop then else 2drop then ;

: inc-north 2dup north increase ;

: inc-east 2dup east increase ;

Line 105:

Line 95:

: inc-west 2dup west increase ;

: inc-all inc-north inc-east inc-south inc-west 2drop ;

: simulate prepare begin stack-full? while reduce inc-all repeat to-pgm ." written to " filename type cr ;

: simulate prepare begin stack-full? while 2dup 2>r reduce 2r> inc-all repeat drop to-pgm ." written to " filename type cr ;

simulate bye</lang>