Abelian sandpile model: Difference between revisions
Forth solution
m (added calls to reproduce the sample outputs) |
(Forth solution) |
||
Line 28:
0 0 0 0 0 0 0 1 0 0
</pre>
=={{header|Forth}}==
{{works with|gforth|0.7.3}}
<br>
<lang forth>#! /usr/bin/gforth -m 50M
\ Abelian Sandpile Model
0 assert-level !
\ command-line
: parse-number s>number? invert throw drop ;
: parse-size ." size : " next-arg parse-number dup . cr ;
: parse-height ." height: " next-arg parse-number dup . cr ;
: parse-args cr parse-size parse-height ;
parse-args constant HEIGHT constant SIZE
: allot-erase create here >r dup allot r> swap erase ;
: size^2 SIZE dup * cells ;
: 2cells [ 2 cells ] literal ;
: -2cells [ 2cells negate ] literal ;
size^2 allot-erase arr
size^2 2 * allot-erase bottom
variable stack bottom 2cells - stack !
\ array processing
: ix swap SIZE * + cells arr + ;
: center SIZE 2/ dup ;
: write-cell ix @ u. ;
: write-row SIZE 0 ?do dup i write-cell loop drop cr ;
: arr. SIZE 0 ?do i write-row loop ;
\ stack processing
: inc-stack 2cells stack +! ;
: dec-stack -2cells stack +! ;
: stack-empty? stack @ bottom u< ;
: stack-full? stack-empty? invert ;
: 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
: concat { a1 l1 a2 l2 } l1 l2 + allocate throw dup dup a1 swap l1 cmove a2 swap l1 + l2 cmove l1 l2 + ;
: write-pgm ." P2" cr SIZE u. SIZE u. cr ." 3" cr arr. ;
: u>s 0 <# #s #> ;
: filename s" sandpile-" SIZE u>s concat s" -" concat HEIGHT u>s concat s" .pgm" concat ;
: to-pgm filename w/o create-file throw ['] write-pgm over outfile-execute close-file throw ;
\ sandpile
: info. cr arr. stack. cr ;
: prep-arr HEIGHT center ix ! ;
: prep-stack HEIGHT 4 u>= if center push then ;
: prepare prep-arr prep-stack ;
: ensure if else 2drop 0 rdrop rdrop exit then ;
: col>=0 dup 0>= ensure ;
: col<SIZE dup SIZE < ensure ;
: row>=0 over 0>= ensure ;
: row<SIZE over SIZE < ensure ;
: legal? col>=0 col<SIZE row>=0 row<SIZE 2drop true ;
: north swap 1- swap ;
: east 1+ ;
: south swap 1+ swap ;
: west 1- ;
: reduce peek 2dup ix dup -4 swap +! @ 4 < if dec-stack then ;
: increase 2dup legal? if 2dup ix dup 1 swap +! @ 4 = if push else 2drop then else 2drop then ;
: inc-north 2dup north increase ;
: inc-east 2dup east increase ;
: inc-south 2dup south increase ;
: 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 bye</lang>
{{out}}
sandpile with 5000 grains of sand:
<tt>./sandpile.fs 61 5000</tt>:
[http://commons.wikimedia.org/wiki/File:Sandpile-61-5000.png]<br>
sandpile with 50000 grains of sand:
<tt>./sandpile.fs 201 50000</tt>:
[http://commons.wikimedia.org/wiki/File:Sandpile-201-50000.png]<br>
sandpile with 500000 grains of sand:
<tt>./sandpile.fs 601 500000</tt>:
[http://commons.wikimedia.org/wiki/File:Sandpile-601-500000.png]<br>
=={{header|Go}}==
| |||