Abelian sandpile model: Difference between revisions
Content added Content deleted
m (added calls to reproduce the sample outputs) |
(Forth solution) |
||
Line 28: | Line 28: | ||
0 0 0 0 0 0 0 1 0 0 |
0 0 0 0 0 0 0 1 0 0 |
||
</pre> |
</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}}== |
=={{header|Go}}== |