1000 REM >RULE78.BAS (c) Brian Stewart 1994
1010 REM RULE OF 78 Rebate/Settlement Figure Calculator
1020 :
1030 REM set up arrays
1040 DIM LEVEL(100),LENGTH%(100),EXTRA(100),TIME(100)
1050 F$=" ########.##  ":REM format string
1060 :
1070 REM get repayment pattern
1080 CLS
1090 PRINT "RULE OF 78 CALCULATOR:":PRINT
1100 INPUT "   Number of Levels?  ",LEVELS%
1110 INPUT " and Extra Payments?  ",EXTRAS%
1120 :
1130 PRINT
1140 INPUT "   Amount of Credit? œ",LOAN
1150 INPUT "        and Deposit? œ",DEPOSIT
1160 TAP=DEPOSIT
1165 MAX=0
1170 :
1180 IF LEVELS%=0 THEN 1310
1190 :
1200 REM load levels
1210 FOR N%=1 TO LEVELS%
1220 PRINT
1230   PRINT "Amount of Level ";N%;"? œ";:INPUT "",LEVEL(N%)
1240   LENGTH%(N%)=0
1250   WHILE LENGTH%(N%)=0
1260     PRINT " ... and length ";N%;"?  ";:INPUT "",LENGTH%(N%)
1270   WEND
1280   TAP=TAP+LEVEL(N%)*LENGTH%(N%)
1285   MAX=MAX+LENGTH%(N%)
1290 NEXT N%
1300 :
1310 IF EXTRAS%=0 THEN 1420
1320 :
1330 REM load extra payments
1340 FOR N%=1 TO EXTRAS%
1350 PRINT
1360   PRINT "  Extra payment ";N%;"? œ";:INPUT "",EXTRA(N%)
1370   TAP=TAP+EXTRA(N%)
1380   PRINT "   ... and time ";N%;"?  ";:INPUT "",TIME(N%)
1385   IF TIME(N%)>MAX THEN MAX=TIME(N%)
1390 NEXT N%
1400 :
1410 REM get settlement details
1420 PRINT
1430 INPUT "    Settlement Time?  ",SETT%
1440 INPUT "  ... and Deferment?  ",DEFR%
1450 :
1460 REM set initial values
1470 PAID=DEPOSIT:U=0:V=0
1480 DS%=SETT%+DEFR%:REM deferred settlement
1490 :
1500 IF LEVELS%=0 THEN 1640
1510 :
1520 REM calculate V, paid and U for levels
1530 X%=0
1540 FOR N%=1 TO LEVELS%
1550   Y%=X%+LENGTH%(N%)
1560   V=V+LEVEL(N%)/2*(Y%*(Y%+1)-X%*(X%+1))
1570   IF SETT%>=Y% THEN PAID=PAID+LEVEL(N%)*(Y%-X%)
1580   IF SETT%>X% AND SETT%<Y% THEN PAID=PAID+LEVEL(N%)*(SETT%-X%)
1590   IF DS%<=X% THEN U=U+LEVEL(N%)/2*((Y%-DS%)*(Y%+1-DS%)-(X%-DS%)*(X%+1-DS%))
1600   IF DS%>X% AND DS%<Y% THEN U=U+LEVEL(N%)/2*((Y%-DS%)*(Y%+1-DS%))
1610   X%=Y%
1620 NEXT N%
1630 :
1640 IF EXTRAS%=0 THEN 1740
1650 :
1660 REM calculate V, paid and U for extra payments
1670 FOR N%=1 TO EXTRAS%
1680   V=V+EXTRA(N%)*TIME(N%)
1690   IF TIME(N%)<=SETT% THEN PAID=PAID+EXTRA(N%)
1700   IF TIME(N%)>DS% THEN U=U+EXTRA(N%)*(TIME(N%)-DS%)
1710 NEXT N%
1720 :
1730 REM calculate other information
1740 TCC=TAP-LOAN
1745 GOSUB 5000
1750 REBATE=(U/V)*TCC
1760 REMAIN=TAP-PAID
1770 SETTFIG=REMAIN-REBATE
1780 :
1790 REM output results
1800 PRINT:PRINT "RESULTS:":PRINT
1810 PRINT "      Total Amount Payable:  œ";USING F$;TAP;:PRINT "(TAP)"
1820 PRINT "   Total Charge for Credit:  œ";USING F$;TCC;:PRINT "(TCC)"
1830 PRINT "  Total Amount Paid so far:  œ";USING F$;PAID
1840 PRINT
1850 PRINT "Total Remaining to be Paid:  œ";USING F$;REMAIN
1860 PRINT "          Statutory Rebate:  œ";USING F$;REBATE;:PRINT" <=="
1870 PRINT "         Settlement Figure:  œ";USING F$;SETTFIG
1880 :
1890 PRINT:PRINT "Another (Y/N)? ";
1900 K$=INKEY$:IF K$="" THEN 1900
1910 IF INSTR("YyNn",K$)=0 THEN 1900
1920 IF INSTR("Yy",K$) THEN 1080
1930 PRINT "No":PRINT
1940 END
4980 :
4990 REM Pro-rata Rule
5000 PRINT:PRINT "Use the Pro-rata rule (Y/N)? ";
5010 K$=INKEY$:IF K$="" THEN 5010
5020 IF INSTR("YyNn",K$)=0 THEN 5010
5030 PRINT K$:PRINT
5040 :
5050 IF INSTR("Nn",K$) THEN PRINT "RULE OF 78";:RETURN
5060 U=MAX-DS%:V=MAX:PRINT "PRO-RATA RULE";:RETURN