aUCBLogo Demos and Tests / pi_montecarlo

to pi_montecarlo
   aaa 1000000
end

to aaa :totdots
   ; LogoForum, Tue Nov 2, 2004 3:52 pm
   ; Message 10143
   ; For just one run try: erns aaa 10000
   ; For many runs try: main 1000 10
   ; A random number generator is needed for this program.
   cs ht pu
   setlabelfont "Times
   ;[[Courier New] -24 0 0 800 0 0 0 177 3 2 1 57]
   setLabelSize [20 30]
   rt 90
   setxy 0 275
   red=RGB 1 0 0
   blue=RGB 0 0 1
   white=RGB 1 1 1
   black=RGB 0 0 0
   y0=0
   y1=135
   p0=List 0 y1
   setpc black
   enableTextureFont
   label [Monte Carlo Method to approximate PI]
   setpensize 0
   setxy -350 -150
   setpc black pd fd 700 pu
   setxy -360 -150 label "3.14159
   make "radius 100
   make "M 0
   make "pie 0
   make "N 0
   make "runtime 0
   make "start timemilli
   dotting
   timer
   (print "PI "= :pie " " "time "= :runtime)
   setxy -170 y0
   label "PI=
   setxy 0 y0
   label "counts=
   setxy 310 y0
   label "seconds
;   setactivearea [-250 -100 450 300]
   ;gifsave "MonteCarlo.gif
end

to counter
   if (modulo :N 1000)==0
   [   timer
      ;Count the calculated PI
      setxy -120 y0
      rubout
      label :pie
      ; Count the Total Runtime
      setxy 105 y0
      rubout
      label :N
      setxy 210 y0
      rubout
      label :runtime
      updateGraph
   ]
end

to dot
   ifelse (distance p0) > :radius
   [   setpixel pos blue
   ][   setpixel pos red
      make "M :M+1
   ]
   make "pie 4*:M/:N
end

to dotting
   norefresh
   repeat :totdots
   [   setxy (2*rnd-1)*:radius y1+(2*rnd-1)*:radius
      make "N repcount
      dot counter plot
      if key? [break]
   ]
   refresh
end

to main :totdots :number_of_runs
   repeat :number_of_runs
   [   aaa :totdots
      wait 100
   ]
end

to plot
   setpc HSB 360*N/totdots 1 1
   setpensize 0
   setxy -350+700*:N/totdots -150+10000*(:pie-pi)
   pd fd N/totdots pu
end

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

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