home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PROGRAMS / CALCULTR / ANNUITY.ARK / ANNUITY.BAS next >
BASIC Source File  |  1982-12-11  |  6KB  |  211 lines
  1. REM ANNUITY.BAS, Ver 1.0, December 11, 1982\
  2.     \
  3.     Phil Cary\
  4.     2025 Tyre Circle\
  5.     Las Cruces, NM 88001\
  6.     \
  7.     Mesilla Valley RCP/M (505) 522-8856\
  8.     \
  9.     This program must be compiled with CB80.  It calculates the missing\
  10.     variable of an ordinary annuity problem.  Repeated calculations may\
  11.     be made without reentering the unchanged variables - only a ".".\
  12.     A clear screen code can be substituted for the nulls at clear.screen.\
  13.     \
  14.     The interest rate calculation is iterative and make take a while\
  15.     depending upon how far off the true interest rate is from the built-in\
  16.     first guess rate of 50%.  This high guess value is needed to reach\
  17.     dymamic range interest rate limits of approximately .0002% to\
  18.     approximately 99.9991%.  There may be lesser limits for some untested\
  19.     input values.\
  20.     \
  21.     A compiled version of this program is available on Mesilla Valley\
  22.     RCP/M, (505) 522-8856, as ANNUITY.OBJ.
  23.  
  24. REM following notice required in composite program by Digital Research, Inc.
  25.  
  26.     license.notice$="Portions of this program (c)1982 Digital Research Inc"
  27.  
  28. REM constants
  29.  
  30.     true% = 1
  31.     false% =0
  32.     null$ = ""
  33.     escape$ = CHR$(27)
  34.     clear.screen$ = null$ + null$ REM Put clear screen code for your\
  35.         terminal here, i.e. escape$ + "E" for H-19
  36.  
  37.     ON ERROR GOTO process.error
  38.  
  39. REM start of program
  40.  
  41.     PRINT clear.screen$
  42.     PRINT " ORDINARY ANNUITY"
  43.     
  44. restart:
  45.     PRINT:PRINT "Enter known values, <CR> for unknown value, " +\
  46.         "period <.> for same value on rerun."
  47.  
  48.     PRINT
  49.     INPUT "   Present Value(Q to Quit): $";LINE reply$
  50.     GOSUB strip.commas:
  51.  
  52.         IF (answer$ = "Q" OR answer$ = "q") THEN STOP
  53.  
  54.         IF answer$ = "."\
  55.         THEN present.value = present.value\
  56.         ELSE present.value = VAL(answer$)
  57.  
  58.         IF present.value = 0 THEN function% = 1
  59.  
  60.  
  61.     INPUT "   Monthly Payment:          $";LINE reply$
  62.     GOSUB strip.commas
  63.  
  64.         IF answer$ = "."\
  65.         THEN monthly.payment = monthly.payment\
  66.         ELSE monthly.payment = VAL(answer$)
  67.  
  68.         IF monthly.payment = 0 THEN function% = 2
  69.  
  70.     INPUT "   Annual Interest Rate:     %";LINE reply$
  71.     GOSUB strip.commas
  72.     
  73.         IF answer$ = "."\
  74.         THEN annual.interest.rate = annual.interest.rate\
  75.         ELSE annual.interest.rate = VAL(answer$)
  76.  
  77.         IF annual.interest.rate = 0 THEN function% = 3:\
  78.             annual.interest.rate = 50   REM a guess to start
  79.  
  80.         monthly.interest.rate = annual.interest.rate / 1200
  81.  
  82.     INPUT "   Number Of Payments:        ";LINE reply$
  83.     GOSUB strip.commas
  84.     
  85.         IF answer$ = "."\
  86.         THEN number.of.payments% = number.of.payments%\
  87.         ELSE number.of.payments% = VAL(answer$)
  88.  
  89.         IF number.of.payments% = 0 THEN function% = 4
  90.  
  91.  
  92. REM define function used in calculations
  93.  
  94.     DEF partial.solution (monthly.interest.rate, number.of.payments%) =\
  95.         1-1/(1+monthly.interest.rate)^number.of.payments%
  96.  
  97. REM go perform the selected function
  98.  
  99.     ON function% GOSUB\
  100.         compute.present.value,\
  101.         compute.monthly.payment,\
  102.         compute.interest.rate,\
  103.         compute.number.of.payments
  104.  
  105.     GOTO restart
  106.  
  107. compute.present.value:
  108.  
  109.     present.value = monthly.payment *\
  110.             (partial.solution\
  111.             (monthly.interest.rate,number.of.payments%)/\
  112.             monthly.interest.rate)
  113.  
  114.     PRINT
  115.     PRINT USING " The Present Value Is: $$#,###,###,###.##";present.value
  116.     RETURN
  117.  
  118. compute.monthly.payment:
  119.  
  120.     monthly.payment = present.value *\
  121.               (monthly.interest.rate/partial.solution\
  122.               (monthly.interest.rate,number.of.payments%))
  123.  
  124.     IF interest.rate.flag% THEN RETURN
  125.  
  126.     PRINT
  127.     PRINT USING " The Monthly Payment Is: $$###,###,###.##";monthly.payment
  128.     RETURN
  129.  
  130. compute.interest.rate:
  131.  
  132.     interest.rate.flag% = true%
  133.  
  134.     target.payment = monthly.payment
  135.     entered.monthly.interest.rate = monthly.interest.rate
  136.  
  137.     PRINT:PRINT " Iterating calculation, please wait.";
  138.  
  139.     maximum.iterations% = 50
  140.  
  141. recompute.interest.rate:
  142.  
  143.     FOR iteration% = 1 TO maximum.iterations%
  144.  
  145.     GOSUB compute.monthly.payment
  146.  
  147.     IF ABS(target.payment - monthly.payment) < .001\
  148.     THEN annual.interest.rate = monthly.interest.rate * 1200:\
  149.         PRINT "  ";iteration%;"iterations.":\
  150.         PRINT:PRINT USING " The Annual Interest Rate Is: ##.####";\
  151.             annual.interest.rate;: PRINT " %":\
  152.         monthly.payment = target.payment:\
  153.         interest.rate.flag% = false%: RETURN
  154.  
  155.     correction = ABS(monthly.interest.rate - guess.new.rate)/2
  156.  
  157.     guess.new.rate = monthly.interest.rate
  158.  
  159.     IF monthly.payment < target.payment\
  160.     THEN monthly.interest.rate = monthly.interest.rate + correction\
  161.     ELSE monthly.interest.rate = monthly.interest.rate - correction
  162.  
  163.     NEXT iteration%
  164.  
  165.     PRINT:PRINT:PRINT "No solution after";maximum.iterations%;"iterations."
  166.     PRINT "There is";
  167.     PRINT USING "$$##,###,###.##";target.payment - monthly.payment;
  168.     PRINT " difference between actual payment and the computed "
  169.     PRINT "payment, and the computed annual interest rate is now";
  170.     PRINT USING "###.####";monthly.interest.rate * 1200;:PRINT "%."
  171.     PRINT
  172.     PRINT "You may have entered values that result in a negative" +\
  173.         " amortization, "
  174.     PRINT "or the dynamic range of the interest rate calculations has been"
  175.     PRINT "exceeded with the values entered.  Try again with different" +\
  176.         " values."
  177.     monthly.payment = target.payment:\
  178.     monthly.interest.rate = entered.monthly.interest.rate:\
  179.     interest.rate.flag% = false%:\
  180.     GOTO restart\
  181.  
  182. compute.number.of.payments:
  183.  
  184.     number.of.payments% =\
  185.         -LOG(1-(present.value *\
  186.          monthly.interest.rate/monthly.payment))/\
  187.          LOG(1 + monthly.interest.rate)
  188.  
  189.     PRINT
  190.     PRINT USING " The Number Of Payments Is: ###";number.of.payments%
  191.     RETURN
  192.  
  193. strip.commas:
  194.  
  195.     answer$ = null$
  196.  
  197.     FOR character.position% = 1 TO LEN(reply$)
  198.  
  199.         character$ = MID$(reply$,character.position%,1)
  200.         IF character$ = "," THEN character$ = null$
  201.         answer$ = answer$ + character$
  202.  
  203.     NEXT character.position%
  204.     RETURN
  205.  
  206. process.error:
  207.  
  208.     IF ERR = "DZ" THEN PRINT:PRINT " A division by zero was attempted." +\
  209.         " Please recheck your entries."
  210.     GOTO restart
  211.