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 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 y0
   
label "counts=
   
setxy 290 y0
   
label "seconds
   
home
   
setFC white
   
fillRect p0 list radius+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 [0.5/nx 1 1/nx]
   
[   for [0.5/nx 1 1/nx]
      
[   dot x y
         
if (modulo :N 1000)==0
         
[   drawCounter
         
]
         
setPixelXY -350+700*:N/totdots -150+10000*(:pie-piblack
      
]
   
]
end

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

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