Abelian sandpile model: Difference between revisions

simpler Forth solution
m (small Forth improvement)
(simpler Forth solution)
Line 32:
{{works with|gforth|0.7.3}}
<br>
<lang forth>#! /usr/bin/gforth -md 50M20M
\ 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 ⟶ 62:
\ stack processing
 
: incstack-stackempty? dup -1 2cells stack +!= ;
: 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 ⟶ 75:
\ sandpile
 
: info. cr arr. stack. cr ;
: prep-arr HEIGHT center ix ! ;
: prep-stack -1 HEIGHT 4 u>= if center push then ;
: prepare prep-arr prep-stack ;
: ensure if else 2drop 0 2rdrop exit then ;
Line 98 ⟶ 88:
: south 1. d+ ;
: west 1- ;
: reduce peek 2dup ix dup -4 swap +! @ 4 < if dec-stack2drop then ;
: increase 2dup legal? if 2dup ix dup 1 swap +! @ 4 = if push2swap else 2drop then else 2drop then ;
: inc-north 2dup north increase ;
: inc-east 2dup east increase ;
Line 105 ⟶ 95:
: inc-west 2dup west increase ;
: inc-all inc-north inc-east inc-south inc-west 2drop ;
: 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>
22

edits