DECLARE SUB PrintRows (m$(), col!) DECLARE SUB PutPins () DECLARE SUB DropOne () DECLARE SUB CircleMove (a!, B!, c!, d!, Delay) DECLARE FUNCTION TypingBox$ (w%, m$, d$) KEY 15, CHR$(&H4) + CHR$(&H2E) ' ctrl-c key to abort the program KEY(15) ON ON KEY(15) GOSUB 1000 SCREEN 12 RANDOMIZE TIMER REM ********** CONSTANTS AND PARAMETERS ********** Delay = 300 ' longer delays = marble falls slower N = 20 ' no. of trials (or no. of rows of pins) NumCols = 2 * N + 1 ' no. of columns of pins i = N + 1 ' current bin -- start in the middle p = .5# ' probability of success (moving to right) NumIter = 2000 ' number of iterations NumBins = NumCols + 1 ' number of "bins" into which the marbles fall Bottom = 430 ' bottom pixel of screen BinWidth = 12 ' Bin Width in pixels top = 20 ' pixel for top of screen left = 40 ' pixel for bottom of screen PinBottom = top + N * BinWidth ' where the bottom row of pins is located r = 4 ' marble radius DIM Pin(NumCols) ' holds current location DIM Sum(NumBins) ' holds sums of end locations -- i.e. Sum(i) is ' the number of marbles that fell into Bin i REM ********** PRINT OPENING MESSAGES ********** ' ------------- Clear to new screen with border COLOR 6 ' brown VIEW (15, 10)-(600, 470), , 5 ' magenta border CLS ' ------------- Print first message box LINE (52, 32)-(532, 260), 15, B ' white box NumLines = 30 ' number of lines on the screen DIM m$(NumLines) ' holds the messages ' M$(6) = "This program is designed to show how the Binomial" ' M$(7) = "distribution can (and sometimes cannot) be approximated" ' M$(8) = "by the Normal distribution." ' M$(11) = "Imagine an array of nails hammered into a board...." ' M$(16) = " " m$(5) = " ZforB version 1.0" m$(6) = " Frank Tutzauer, Dept. of Communication" m$(7) = " State Univ. of New York at Buffalo" m$(8) = " October 1997" m$(10) = "This program is designed to show how the Binomial" m$(11) = "distribution can (and sometimes cannot) be approximated" m$(12) = "by the Normal distribution." m$(14) = "Imagine an array of nails hammered into a board...." m$(16) = " " CALL PrintRows(m$(), 12) CALL PauseIt LINE (52, 32)-(532, 260), 0, BF ' erase old message ' ---------- Put second message box CALL PutPins ' First put some pins LINE (52, 284)-(532, 420), 15, B REDIM m$(NumLines) m$(21) = "If the board of nails is held vertically, and a marble" m$(22) = "is dropped, it must bounce to either the left or right." m$(23) = "When it hits the next row, it again bounces either left" m$(24) = "or right." m$(26) = " " CALL PrintRows(m$(), 12) CALL PauseIt LINE (53, 285)-(531, 419), 0, BF CALL DropOne ' drop a marble ' ---------- Put third message box m$(20) = "If we define bouncing right as SUCCESS and bouncing left" m$(21) = "as FAILURE, then we have a sequence of Bernoulli trials," m$(22) = "and simply counting how many marbles fall at each of the" m$(23) = "final pins tells us how many times we had exactly 0 " m$(24) = "successes, exactly 1 success, 2 successes, and so forth." CALL PrintRows(m$(), 11) CALL PauseIt LINE (52, 284)-(532, 420), 0, BF LINE (51, 19)-(533, 264), 0, BF LINE (52, 32)-(532, 280), 15, B ' ---------- Fourth message box REDIM m$(NumLines) m$(6) = "Since this is a computer program, we can even suspend" m$(7) = "the laws of physics and make the marble bounce to the" m$(8) = "left or right with something other than a 50-50" m$(9) = "probability." m$(11) = "In all, there are 3 parameters you can set in" m$(12) = "addition to the probability. You can determine how" m$(13) = "many marbles are dropped, what the delay is (the longer" m$(14) = "the delay, the longer each marble takes to fall), and" m$(15) = "whether or not the results are written to a data file." m$(17) = " " CALL PrintRows(m$(), 12) CALL PauseIt LINE (51, 19)-(533, 264), 0, BF LINE (52, 32)-(532, 280), 15, B ' ---------- Final message box REDIM m$(NumLines) m$(6) = "There's not much error checking in this program, so if" m$(7) = "it crashes, just try again! If you get stuck, ctrl-C" m$(8) = "aborts." m$(17) = " " CALL PrintRows(m$(), 12) CALL PauseIt LINE (52, 32)-(532, 280), 0, BF REM ********** DATA INPUT *********** ' ---------- Get NumIter COLOR 15 ' Bright white LINE (37, 90)-(547, 153), 15, B ' put box LOCATE 10, 41 ' print message PRINT ""; LOCATE 8, 8 INPUT "How many marbles do you want to drop (1-3000)"; NumIter LINE (38, 91)-(546, 152), 0, BF 'erase box interior ' ---------- Get p LOCATE 10, 41 ' print message PRINT ""; LOCATE 8, 8 INPUT "What is the probability of success (0.00-1.00)"; p LINE (38, 91)-(546, 152), 0, BF 'erase box interior LOCATE 10, 41 'print message PRINT ""; ' ---------- Get delay LOCATE 8, 8 INPUT "What delay factor do you want to use (0-1000)"; Delay LINE (38, 91)-(546, 152), 0, BF 'erase box interior LOCATE 10, 26 'print message PRINT ""; ' ---------- Get filename (f$) LOCATE 8, 8 INPUT "What filename for the output (12 characters max)"; f$ LINE (38, 91)-(546, 152), 0, BF 'erase box interior REM ****************** Start main program ******************* ' ------------ Print Pins SCREEN 12 COLOR 15 CLS CALL PutPins ' ------------- print bottom material f$ = LTRIM$(RTRIM$(f$)) ' fix filename for printing pfn$ = f$ ' pfn$ = "printed file name" IF pfn$ = "" THEN pfn$ = "[none]" IF LEN(pfn$) > 12 THEN pfn$ = "name too big" ' too big to print ELSE pfn$ = SPACE$(12 - LEN(pfn$)) + pfn$ 'pad with left blanks END IF LOCATE 29, 8 PRINT "Marble:"; LOCATE 29, 22 PRINT "File:"; LOCATE 29, 27 PRINT USING "\ \"; pfn$; LOCATE 29, 40 PRINT "Delay:"; LOCATE 29, 49 PRINT USING "#####"; Delay; IF p >= 1 THEN LOCATE 29, 57 PRINT "p = "; PRINT USING "#.####"; p; ELSE LOCATE 29, 58 PRINT "p = "; PRINT USING ".####"; p; END IF LINE (left, Bottom)-(left + NumBins * BinWidth, Bottom), 4 LINE (39, Bottom)-(39, Bottom + 40), 4 LINE (292, Bottom)-(292, Bottom + 40), 4 LINE (148, Bottom)-(148, Bottom + 40), 4 LINE (412, Bottom)-(412, Bottom + 40), 4 LINE (545, Bottom)-(545, Bottom + 40), 4 LINE (200, 320)-(392, 347), 15, B LOCATE 22, 29 PRINT "Press any key to begin" CALL PauseIt LINE (200, 320)-(392, 347), 0, BF '---------------Main Loop COLOR 15 FOR iter = 1 TO NumIter CALL DropOne ' drop a marble BinNum = i 'i is set in DropOne; it is the bin that the marble fell into Sum(BinNum) = Sum(BinNum) + 1 ' one more marble in BinNum i newx = oldx newy = top + Trial * BinWidth CALL CircleMove(oldx, oldy, newx, newy, Delay) 'move down a bit CIRCLE (oldx, oldy), 1, 2 ' Put pin back oldx = newx: oldy = newy newy = Bottom - Sum(BinNum) - r IF newy - oldy <= 1 THEN ' check to see if room to move LINE (200, 320)-(392, 365), 15, B LOCATE 22, 29 PRINT " Too many marbles!"; LOCATE 23, 29 PRINT " Press any key" CALL PauseIt GOTO finish END IF 'if ok, move to top of histogram column CALL CircleMove(oldx, oldy, newx, newy - 1, Delay) 'have to subtract a little so lines don't get wiped CIRCLE (newx, newy - 1), r, 0 LINE (newx - BinWidth / 2, Bottom - Sum(BinNum))-(newx + BinWidth / 2, Bottom - Sum(BinNum)), 4 LOCATE 29, 16 PRINT USING "#####"; iter; NEXT iter REM ********** END ROUTINES ********** finish: ' ---------- Notify user that all marbles have been dropped LINE (172, 104)-(412, 164), 0, BF LINE (172, 104)-(412, 164), 15, B LOCATE 9, 25 PRINT "All marbles have been dropped"; LOCATE 10, 25 PRINT "Press any key to view summary"; CALL PauseIt ' ---------- Print overall Summary info VIEW (15, 10)-(600, 470), , 5 CLS LOCATE 9, 6 PRINT USING "\ \#####"; "Number of Marbles: "; NumIter; LOCATE 10, 6 PRINT USING "\ \.####"; "Probability: "; p LOCATE 11, 6 PRINT USING "\ \\ \"; "Output File: "; pfn$; ' ---------- Print "Num of Success"/"Num of Marbles" summary LOCATE 4, 49 PRINT "No. of"; LOCATE 5, 48 PRINT "Successes"; LOCATE 4, 62 PRINT "No. of"; LOCATE 5, 62 PRINT "Marbles"; 'Calculate column to print the number for multi-digit numbers Biggest = 0 FOR k = 0 TO NumBins IF Sum(k) > Biggest THEN Biggest = Sum(k) NEXT k num$ = LTRIM$(RTRIM$(STR$(Biggest))) NumDigits = LEN(num$) format$ = STRING$(NumDigits, "#") SELECT CASE NumDigits CASE 1, 2 col = 65 CASE 3, 4 col = 64 CASE 5 col = 63 END SELECT ' Get data from Sum() and print FOR k = 0 TO NumBins IF k MOD 2 = 0 THEN GOTO foot: ' only the odd bins are used NumSuc% = (k - 1) / 2 ' this translates BinNum into Number of Successes LOCATE 6 + NumSuc%, 52 PRINT USING "##"; NumSuc%; LOCATE 6 + NumSuc%, col PRINT USING format$; Sum(k); foot: NEXT k ' Lets user end LOCATE 26, 6 PRINT ""; CALL PauseIt ' ---------- Print Output to file IF f$ = "" THEN GOTO alldone: OPEN f$ FOR OUTPUT AS #1 FOR k = 0 TO NumBins IF k MOD 2 = 0 THEN GOTO foot2: ' only the odd bins are used NumSuc% = (k - 1) / 2 ' this translates BinNum into Number of Successes FOR j = 1 TO Sum(k) PRINT #1, NumSuc% NEXT j foot2: NEXT k CLOSE #1 alldone: 1000 END RETURN SUB CircleMove (a, B, c, d, Delay) SHARED PinBottom 'delete this line is making this a general routine x0 = a 'initial x coord y0 = B 'initial y coord xn = c 'final x coord yn = d 'final y coord distance = SQR((x0 - xn) ^ 2 + (y0 - yn) ^ 2) 'total distance traveled in pixels xtot = xn - x0 'total x distance moved in pixels ytot = yn - y0 'total y distance moved in pixels xinc = xtot / distance 'increment to be moved in x direction yinc = ytot / distance 'increment to be moved in y direction r = 4 'radius of circle colr = 4 'color of circle x% = x0: y% = y0 FOR i = 1 TO distance CIRCLE (x%, y%), r, colr FOR j = 1 TO Delay: NEXT j CIRCLE (x%, y%), r, 0 IF y% <= PinBottom + r THEN CIRCLE (a, B), 1, 2' to make this sub a general routine, delete this line because it is to replace dots specific to the ZforB program x% = x0 + i * xinc y% = y0 + i * yinc NEXT i CIRCLE (xn, yn), r, colr END SUB SUB DropOne SHARED Trial, N, Pin(), p, newx, newy, left, i, BinWidth SHARED top, oldx, oldy, Delay '------ Initialize FOR k = 1 TO NumCols: Pin(k) = 0: NEXT k ' zero out Pin array i = N + 1 ' middle Pin Pin(i) = 1 ' Position first ball oldx = left + (N + 1) * BinWidth oldy = top CIRCLE (oldx, oldy), r, 4 FOR Trial = 1 TO N Pin(i) = 0 ' zero out current location Success = RND IF Success < p THEN i = i + 1 ELSE i = i - 1 Pin(i) = 1 ' put new location newx = left + i * BinWidth newy = top + Trial * BinWidth CALL CircleMove(oldx, oldy, newx, newy, Delay) oldx = newx oldy = newy NEXT Trial END SUB SUB PrintRows (m$(), col) REM print the 30 rows of m$ at col 30 FOR i = 1 TO 30 LOCATE i, col PRINT m$(i); NEXT i END SUB SUB PutPins SHARED left, top, NumCols, N, BinWidth, r x = left y = top FOR i = 1 TO NumCols FOR j = 1 TO N '- 1 x = left + i * BinWidth y = top + j * BinWidth CIRCLE (x, y), 1, 2 NEXT j NEXT i CIRCLE (left + (N + 1) * BinWidth, top), 1, 2 CIRCLE (left + (N + 1) * BinWidth, top), r, 4 END SUB