DECLARE SUB pause (secs!) DECLARE FUNCTION normrv! (dummy!) 'GUVX1B REM uses bold lines governed by ht SCREEN 12 REM program assumes VGA (640x480) screen DEFINT I-J DIM pia(0 TO 639) DIM rreal(0 TO 639) DIM rnat(0 TO 639) DIM mdc(0 TO 639) RANDOMIZE TIMER up$ = CHR$(0) + CHR$(72) down$ = CHR$(0) + CHR$(80) rt$ = CHR$(0) + CHR$(77) lft$ = CHR$(0) + CHR$(75) REM ht + 1 is line height in pixels REM axht + 1 is axis ht in pixels ht = 1 axht = 1 REM axis locations for r, m, u in pixels, with offsets for real rate etc: ror = 180 rror = 181 rnor = 182 mor = 320 por = 321 mdor = 322 uor = 459 unor = 460 REM vertical scales for r, m, u in pixels per percentage point: rsc = 8 msc = 8 usc = 8 REM text locations for r, m, u, in lines: rlab = 3 mlab = 16 ulab = 24 REM colors for text and graphs: backcol = 7 axiscol = 0 rcol = 14 pcol = 15 mcol = 10 mdcol = 2 ucol = 12 unatcol = 4 rnatcol = 5 realcol = 13 picol = 11 piacol = 9 begin: DO LOOP UNTIL INKEY$ = "" CLS LINE (0, 0)-(639, 479), 15, B COLOR mcol LOCATE 3, 28 PRINT "THE GUV@ -- Version X.1" PRINT " " PRINT " Monetary Policy Simulation Program" PRINT " to accompany McCulloch," PRINT " Economics of Money, Banking, and Financial Institutions" PRINT "" PRINT "Congratulations! You've just been appointed to a 14-" PRINT "year term on the Federal Reserve Board. 5 members of the FOMC " PRINT "favor easy money, while 5 members favor tight money, and the 11th" PRINT "member will go along with whatever you say, so you have complete" PRINT "control over monetary policy!" PRINT " " PRINT "You may set either the nominal money stock M or the nominal interest" PRINT "rate R as your policy instrument. The up/down" PRINT "arrows will move your instrument up/down by 1 percentage point," PRINT "while the right/left arrows will fine tune it up/down by 0.1 percentage" PRINT "point. " PRINT " " PRINT "At any moment you may `call an FOMC meeting' by pressing" PRINT "the spacebar. This will freeze the action until you press the" PRINT "spacebar again. If you select M, you may also set its growth rate," PRINT "and change your selection during an FOMC meeting by pressing the" PRINT "g key." PRINT "" PRINT "At any time you may rebase the price level to 100 by pressing the b key." PRINT "M will change in the same proportion. This enables you to keep P and M" PRINT "near their axis." PRINT "" PRINT "Press spacebar to continue." SLEEP PRINT " " PRINT "You will see three groups of lines, plotted relative to three black axes." PRINT "" PRINT "Top group:" COLOR rcol PRINT " R = nominal interest rate" COLOR picol PRINT " pi = inflation (annualized rate)" COLOR piacol PRINT " pia = anticipated inflation" COLOR realcol PRINT " r = real interest rate" COLOR rnatcol PRINT " r* = equilibrium real interest rate" PRINT "" COLOR mcol PRINT "Middle group (ratio scale, axis = initial value = 100):" COLOR pcol PRINT " P = price level" COLOR mcol PRINT " M = nominal money stock" COLOR mdcol PRINT " mdc = shift in money demand function" PRINT "" COLOR mcol PRINT "Bottom group:" COLOR ucol PRINT " U = unemployment rate" COLOR unatcol PRINT " UN = natural unemployment rate" PRINT " " REM LOCATE 5, 10 COLOR mcol PRINT "How many minutes do you want your 14-year term to take?" PRINT "Suggested time: 1 or 2. ( + Enter)"; INPUT Pace dt = Pace * 60 / 640 REM dt is real time per pixel in seconds. PRINT " " DO PRINT "Do you want M or R as your instrument? (just m/r, no Enter)" SLEEP in$ = INKEY$ SELECT CASE in$ CASE "m" mrule = 1 EXIT DO CASE "r" mrule = 0 EXIT DO CASE ELSE SOUND 40, 2 END SELECT LOOP REM LOCATE 7, 10 PRINT " " PRINT "Until you get the hang of your new job, you may want to try it " PRINT "without random disturbances to the equilibrium real interest rate," PRINT "the price level, and the money demand schedule. Do you want" PRINT "disturbances? (y/n) " SLEEP noise = 0 IF INKEY$ = "y" THEN noise = 1 END IF PRINT " " PRINT "Policy makers do not directly observe expected inflation," PRINT "the real interest rate, or the constant in the money demand function." PRINT "Do you want to see these state variables as you go? If not, they" PRINT "will appear at the end of your term. (y/n)" SLEEP states = 0 IF INKEY$ = "y" THEN states = 1 END IF PRINT "" PRINT "Unless you are pretending to be working, you will want sound effects." PRINT "Do you want sound effects? (y/n) " SLEEP snd = 0 IF INKEY$ = "y" THEN snd = 1 SOUND 400, .5 SOUND 800, 1 END IF PRINT "" PRINT "Press spacebar to be sworn in." SLEEP start: DO LOOP UNTIL INKEY$ = "" CLS LINE (0, 0)-(639, 479), backcol, BF LINE (0, ror + axht)-(639, ror), axiscol, BF LINE (0, mor + axht)-(639, mor), axiscol, BF LINE (0, uor + axht)-(639, uor), axiscol, BF REM dy is simulated time lapse of 1 pixel in yrs (640 pixels = 14 years) dy = 14 / 640 rbar = 4 rnat(0) = rbar rreal(0) = rbar pia(0) = 0 pi = 0 oldpi = 0 r = rnat(0) + pia(0) rold = r M = 100 p = 100 mdc(0) = 100 unat = 5 u = unat ustate = 0 cslope = 1 uslope = 1 alpha = .2 beta = 1 gamma = 1 radj = 1 sigp = 20 * noise * SQR(dy) sigr = noise * SQR(2 * radj * dy) sigmd = noise * SQR(dy) g = 0 COLOR rcol LOCATE rlab, 2 PRINT "R = " LOCATE rlab + 1, 2 COLOR picol PRINT "pi ____" IF states THEN LOCATE rlab + 2, 2 COLOR piacol PRINT "pia ____" LOCATE rlab + 3, 2 COLOR realcol PRINT "r ____" LOCATE rlab + 4, 2 COLOR rnatcol PRINT "r* ____" END IF COLOR pcol LOCATE mlab, 2 PRINT "P = " COLOR mcol LOCATE mlab + 1, 2 PRINT "M = " IF states THEN LOCATE mlab + 2, 2 COLOR mdcol PRINT "mdc ____" END IF COLOR ucol LOCATE ulab, 2 PRINT "U = " IF states THEN LOCATE ulab + 1, 2 COLOR unatcol PRINT "UN ____" LINE (0, unor - unat * usc + ht)-(639, unor - unat * usc), unatcol END IF IF states AND NOT noise THEN LINE (0, rror - rbar * rsc + ht)-(639, rror - rbar * rsc), rnatcol END IF t = TIMER FOR i = 1 TO 639 t = t + dt pia(i) = pia(i - 1) + beta * (pi - pia(i - 1)) * dy rnat(i) = rnat(i - 1) + radj * (rbar - rnat(i - 1)) * dy + sigr * normrv(0) mdc(i) = mdc(i - 1) * EXP(sigmd * normrv(0) / 100) IF states THEN LINE (i - 1, rror - pia(i - 1) * rsc + ht)-(i, rror - pia(i) * rsc), piacol LINE (i - 1, rnor - rnat(i - 1) * rsc + ht)-(i, rnor - rnat(i) * rsc), rnatcol mdpix1 = mdor - (mdc(i - 1) - 100) * msc mdpix2 = mdor - (mdc(i - 1) - 100) * msc LINE (i - 1, mdpix1 + ht)-(i, mdpix2), mdcol END IF COLOR pcol LOCATE mlab, 6 PRINT USING "####.##"; p IF p > 1000 THEN LOCATE 14, 12 PRINT "P exceeds 1000. Hungry retirees eject you from office!" SOUND 40, 18 * snd rreal(i) = r - pia(i) GOTO endgame END IF COLOR mcol LOCATE mlab + 1, 6 PRINT USING "####.##"; M LOCATE ulab, 6 COLOR ucol PRINT USING "##.##"; u IF u > 50 THEN LOCATE 18, 18 PRINT "U exceeds 50%. Laid off workers eject you from office!" SOUND 40, 18 * snd rreal(i) = r - pia(i) GOTO endgame END IF IF mrule THEN GOTO mset END IF REM rset: r = rold rreal(i) = r - pia(i) IF states THEN LINE (i - 1, rror - rreal(i - 1) * rsc + ht)-(i, rror - rreal(i) * rsc), realcol END IF LINE (i - 1, ror - r * rsc + ht)-(i, ror - r * rsc), rcol COLOR rcol LOCATE rlab, 6 PRINT USING "###.##"; r DO GOSUB readkey GOTO endread readkey: in$ = INKEY$ SELECT CASE in$ CASE up$ r = rold + 1 SOUND 400, .5 * snd SOUND 800, 1 * snd CASE down$ r = rold - 1 IF r >= 0 THEN SOUND 800, .5 * snd SOUND 400, 1 * snd ELSE r = 0 END IF CASE rt$ r = rold + .1 SOUND 800, .5 * snd CASE lft$ r = rold - .1 IF r >= 0 THEN SOUND 400, .5 * snd ELSE r = 0 END IF END SELECT SELECT CASE in$ CASE up$, down$, rt$, lft$ rreal(i) = r - pia(i) IF states THEN LINE (i, rror - rreal(i - 1) * rsc + ht)-(i, rror - rreal(i) * rsc), realcol END IF LINE (i, ror - rold * rsc + ht)-(i, ror - r * rsc), rcol PSET (i, ror - r * rsc), 0 rold = r COLOR rcol LOCATE rlab, 6 PRINT USING "###.##"; r CASE "b" oldp = oldp * 100 / p M = M * 100 / p oldm = oldm * 100 / p p = 100 mpix = mor - (M - 100) * msc LINE (i - 1, mor + 1 + ht)-(i + 1, mor - 1), pcol, BF LINE (i - 1, mpix + 1 + ht)-(i + 1, mpix - 1), mcol, BF END SELECT RETURN endread: REM FOMC: IF in$ = " " THEN DO GOSUB readkey LOOP UNTIL in$ = " " t = TIMER END IF LOOP UNTIL TIMER > t md = (1 - alpha * (r - rbar) / 100) * mdc(i) / 100 REM normal md = 1 rreal(i) = r - pia(i) cd = cslope * (rnat(i) - rreal(i)) / 100 xsm = cd oldm = M lastm = M M = p * (md + xsm) REM m = max(m, 1), xsm = m/p-md etc GOTO picalc mset: lastm = M M = M * EXP(g * dy / 100) oldm = M DO GOSUB mreadkey GOTO mendread mreadkey: in$ = INKEY$ SELECT CASE in$ CASE up$ M = oldm * 1.01 SOUND 400, .5 * snd SOUND 800, 1 * snd CASE down$ M = oldm / 1.01 IF M >= 1 THEN SOUND 800, .5 * snd SOUND 400, 1 * snd ELSE M = 1 END IF CASE rt$ M = oldm * 1.001 SOUND 800, .5 * snd CASE lft$ M = oldm / 1.001 IF M >= 1 THEN SOUND 400, .5 * snd ELSE M = 1 END IF CASE "g" COLOR mcol LOCATE 30, 15 PRINT "annual growth rate for M (% / yr)"; INPUT ; g LINE (0, 464)-(639, 479), backcol, BF t = TIMER END SELECT SELECT CASE in$ CASE up$, down$, rt$, lft$ LINE (i, mor - (oldm - 100) * msc + ht)-(i, mor - (M - 100) * msc), mcol oldm = M lastm = M COLOR mcol LOCATE mlab + 1, 6 PRINT USING "####.##"; M CASE "b" oldp = oldp * 100 / p M = M * 100 / p oldm = oldm * 100 / p lastm = oldm p = 100 mpix = mor - (M - 100) * msc LINE (i - 1, mor + 1 + ht)-(i + 1, mor - 1), pcol, BF LINE (i - 1, mpix + 1 + ht)-(i + 1, mpix - 1), mcol, BF END SELECT RETURN mendread: REM FOMC: IF in$ = " " THEN DO GOSUB mreadkey LOOP UNTIL in$ = " " t = TIMER END IF LOOP UNTIL TIMER > t xxx = mdc(i) * (1 + alpha * rbar / 100) + cslope * (rnat(i) + pia(i)) r = (xxx - 100 * M / p) / (alpha * mdc(i) / 100 + cslope) rreal(i) = r - pia(i) xsm = cslope * (rnat(i) - rreal(i)) / 100 IF states THEN LINE (i - 1, rror - rreal(i - 1) * rsc + ht)-(i, rror - rreal(i) * rsc), realcol END IF LINE (i - 1, ror - rold * rsc + ht)-(i, ror - r * rsc), rcol rold = r COLOR rcol LOCATE rlab, 6 PRINT USING "###.##"; r picalc: oldpi = pi pi = xsm * 100 + pia(i) + sigp * normrv(0) oldp = p p = p * EXP(pi * dy / 100) oldu = u ustate = ustate - ustate * dy - xsm * 100 * dy u = unat * EXP(uslope * ustate / unat) u = u / (1 + u / 100) * (1 + unat / 100) LINE (i - 1, por - (oldp - 100) * msc + ht)-(i, por - (p - 100) * msc), pcol LINE (i, mor - (lastm - 100) * msc + ht)-(i, mor - (M - 100) * msc), mcol LINE (i - 1, ror - oldpi * rsc + ht)-(i, ror - pi * rsc), picol LINE (i - 1, uor - oldu * usc + ht)-(i, uor - u * usc), ucol IF states THEN PSET (i, rror - rreal(i) * rsc), realcol END IF PSET (i, ror - r * rsc), rcol NEXT i endgame: CALL pause(1) REM ii = max(i, 639) ii = i IF ii = 640 THEN ii = 639 END IF in$ = INKEY$ IF states THEN ELSE COLOR piacol LOCATE 30, 20 PRINT "press spacebar to see expected inflation"; LOCATE rlab + 2, 2 SLEEP PRINT "pia ____" FOR i = 1 TO ii LINE (i - 1, rror - pia(i - 1) * rsc + ht)-(i, rror - pia(i) * rsc), piacol NEXT i COLOR realcol LOCATE 30, 20 PRINT "press spacebar to see real interest rate"; SLEEP LOCATE rlab + 3, 2 PRINT "r ____" FOR i = 1 TO ii LINE (i - 1, rror - rreal(i - 1) * rsc + ht)-(i, rror - rreal(i) * rsc), realcol NEXT i COLOR rnatcol LOCATE 30, 15 PRINT "press spacebar to see equilibrium real interest rate"; SLEEP LOCATE rlab + 4, 2 PRINT "r* ____" FOR i = 1 TO ii LINE (i - 1, rnor - rnat(i - 1) * rsc + ht)-(i, rnor - rnat(i) * rsc), rnatcol NEXT i COLOR mdcol LOCATE 30, 15 PRINT "press spacebar to see shift in money demand function"; SLEEP LOCATE mlab + 2, 2 PRINT "mdc ____" FOR i = 1 TO ii mdpix1 = mdor - (mdc(i - 1) - 100) * msc + ht mdpix2 = mdor - (mdc(i) - 100) * msc LINE (i - 1, mdpix1)-(i, mdpix2), mdcol NEXT i COLOR unatcol LOCATE 30, 15 PRINT " press spacebar to see natural unemployment rate "; SLEEP LOCATE ulab + 1, 2 COLOR unatcol PRINT "UN ____" LINE (0, unor - unat * usc + ht)-(ii, unor - unat * usc), unatcol END IF LOCATE 30, 15 COLOR mcol DO LOOP UNTIL INKEY$ = "" PRINT "s = start new term b = begin program over q = quit"; sbq: in$ = INKEY$ SLEEP in$ = INKEY$ SELECT CASE in$ CASE "s" GOTO start CASE "b" GOTO begin CASE "q" END CASE ELSE SOUND 40, 2 GOTO sbq END SELECT END FUNCTION normrv (dummy) s = 0 FOR i = 1 TO 12 s = s + RND(1) NEXT i normrv = s - 6 END FUNCTION SUB pause (secs) t = TIMER DO LOOP UNTIL TIMER > t + secs END SUB