aUCBLogo Demos and Tests / pi_nonmontecarlo

to pi_nonmontecarlo
   aaa 2^7
end

to aaa nx
   ; no random number generator is needed in this program!
   ; all computation is done without trigonometry,
   ; only with counting.
   totdots=sqr nx
   cs ht pu
   setlabelfont "Times
   ;[[Courier New] -24 0 0 800 0 0 0 177 3 2 1 57]
   setLabelSize [20 30]
   red=RGB 1 0 0
   blue=RGB 0 0 1
   white=RGB 1 1 1
   black=RGB 0 0 0
   y0=100
   y1=135
   p0=List 0 y1
   enableTextureFont
   make "radius 100
   make "M 0
   make "pie 0
   make "N 0
   make "runtime 0
   make "start timemilli
   cs
   drawTexts
   dotting
   timer
   drawTexts
   (print "PI "= :pie " " "time "= :runtime)
;   setactivearea [-250 -100 450 300]
   ;gifsave "MonteCarlo.gif
end

to drawTexts
   home
   rt 90
   setxy 0 275
   setpc black
   label [Counting Method to approximate PI]
   setpensize 0
   setxy -350 -150
   setpc black pd fd 700 pu
   setxy -360 -150 label "3.14159
   drawCounter
   setxy -170 y0
   label "PI=
   setxy -120 y0
   rubout
   label :pie
   setxy 0 y0
   label "counts=
   setxy 290 y0
   label "seconds
   home
   setFC white
   fillRect p0 list radius+1 y1+radius+1
   rt 90
end

to drawCounter
   timer
   ;Count the calculated PI
;   setxy -120 y0
;   rubout
;   label :pie
   ; Count the Total Runtime
   setxy 80 y0
   rubout
   label :N
   setxy 210 y0
   rubout
   label :runtime
   updateGraph
end

to dot x y
   N=N+1
   norefresh
   ifelse (norm x y) > 1
   [   setpixelXY x*radius y1+y*radius blue
   ][   setpixelXY x*radius y1+y*radius red
      M=M+1
   ]
   refresh
   pie=4*M/N
end

to dotting
   ia=nx
   ib=ia*1.5
   N=0
   totdots=0
   for [in ia ib]
   [   totdots=totdots+(sqr in^1.1)
   ]
   for [in ia ib]
   [   drawTexts
      dotting1 in^1.1
      if key? [break]
   ]
end

to dotting1 nx
   for [y 0.5/nx 1 1/nx]
   [   for [x 0.5/nx 1 1/nx]
      [   dot x y
         if (modulo :N 1000)==0
         [   drawCounter
         ]
         setPixelXY -350+700*:N/totdots -150+10000*(:pie-pi) black
      ]
   ]
end

to rubout
   local [width]
   width=40
   pd
   setpc white
   setpensize 20
   bk width fd width*2 bk width
   setPenSize 0
   pu
   setpc black
end

to timer
   make "runtime (timemilli - :start)/1000
end