fork download
copy 
  1. 1 Constant example
  2.  
  3. : num: ( c-) parse evaluate , ;
  4. : pair: ( -) '=' parse 2drop ',' num: bl num: ;
  5. : r: ( -) pair: pair: ;
  6. : robots: ( -u) BEGIN refill WHILE r: REPEAT ;
  7.  
  8. here example [IF]
  9.   r: p=0,4 v=3,-3
  10.   r: p=6,3 v=-1,-3
  11.   r: p=10,3 v=-1,2
  12.   r: p=2,0 v=2,-1
  13.   r: p=0,0 v=1,3
  14.   r: p=3,0 v=-2,-2
  15.   r: p=7,6 v=-1,-3
  16.   r: p=3,0 v=-1,-2
  17.   r: p=9,3 v=2,3
  18.   r: p=7,3 v=-1,2
  19.   r: p=2,4 v=2,-3
  20.   r: p=9,5 v=-3,-3
  21. [ELSE]
  22.   s" input" r/o bin open-file throw
  23.   dup ' robots: execute-parsing-file \ '
  24.   close-file throw
  25. [THEN] here swap
  26.   2Constant robots
  27.  
  28.  
  29. : @+ ( a-na) dup @ swap cell+ ;
  30. : +mod! ( nna-) tuck @ + rot mod swap ! ;
  31. : both ( nn-f) 0<> swap 0<> and ;
  32.  
  33. 0 Field: x   Field: y
  34.   Field: dx  Field: dy  Constant /robot
  35. example [IF] 11 7 [ELSE] 101 103 [THEN]
  36.   Constant ny  Constant nx
  37.  
  38. : seconds ( u-) robots DO
  39.   nx over i dx @ * i x +mod!  
  40.   ny over i dy @ * i y +mod!
  41.   /robot +LOOP drop ;
  42.  
  43. Create quads  4 cells allot
  44. : th-quad ( xy-a) 0> -2 * swap 0> -1 * +
  45.   cells quads + ;
  46. : sum-quads ( -) quads 4 cells erase  robots DO
  47.   i x @ nx 2/ -  i y @ ny 2/ -  2dup both
  48.   IF th-quad 1 swap +! THEN  /robot +LOOP ;
  49. : safety-factor ( -n) sum-quads
  50.   quads @+ @+ @+ @ * * * ;
  51.  
  52. 100 seconds  safety-factor .
  53.  
Success #stdin #stdout 0.01s 5276KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
12
https://ideone.com/HKF1R5
language:
Forth (gforth 0.7.3)
created:
8 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!