home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / plot / splot57.arc / FUNGEN.BAS < prev    next >
BASIC Source File  |  1989-08-15  |  5KB  |  110 lines
  1. 10 REM  PROGRAM FUNGEN GENERATES VALUES OF A FUNCTION.
  2. 20 REM  THE PROGRAM WRITES THE VALUES ALONG WITH PLOT COMMANDS TO A FILE
  3. 30 REM  NAMED FUNDATA.PLT; THE VALUES ARE THEN PLOTTED BY USING THE SHELL
  4. 40 REM  COMMAND TO RUN THE SPLOT PROGRAM.
  5. 50 REM
  6. 60 REM  COPYRIGHT 1988 BY WILLIAM G. HOOD
  7. 70 REM
  8. 80 REM  WARNING: DO NOT RENUMBER!
  9. 90 REM
  10. 100 CLS: KEY OFF
  11. 110 PRINT"This program plots up to 5 functions defined by subroutines"
  12. 120 PRINT"which follow the main program.  Each subroutine must set the"
  13. 130 PRINT"dependent variable Y equal to a function evaluated at the"
  14. 140 PRINT"current value of the independent variable X or, optionally,"
  15. 142 PRINT"set variables X and Y equal to a pair of parametrical functions
  16. 143 PRINT"evaluated at the current value of the parameter T.
  17. 150 PRINT
  18. 160 INPUT"Do you want to see current functions (N/Y)"; A$: A$=LEFT$(A$,1)
  19. 170 IF A$="Y" OR A$="y" THEN CLS: LIST 1000-1999: END
  20. 180 REM
  21. 182 PRINT:INPUT"Are the functions represented parametrically (N/Y)"; P.$
  22. 183 P.$=LEFT$(P.$,1): IF P.$ = "y" THEN P.$ = "Y"
  23. 190 OPEN "FUNDATA.PLT" FOR OUTPUT AS #2
  24. 200 PRINT: LINE INPUT"Title? "; TITLE$: PRINT#2,"TITLE "+TITLE$
  25. 210 PRINT: LINE INPUT"X-Axis Label? ";LX$: PRINT#2,"XLABEL "+LX$
  26. 220 LINE INPUT"Y-Axis Label? ";LY$: PRINT#2,"YLABEL "+LY$
  27. 230 PRINT: INPUT"Log X-Axis (N/Y)"; A$: A$=LEFT$(A$,1)
  28. 240 IF A$="Y" OR A$="y" THEN PRINT#2,"LOGX"
  29. 250 INPUT"Log Y-Axis (N/Y)"; A$: A$=LEFT$(A$,1)
  30. 260 IF A$="Y" OR A$="y" THEN PRINT#2,"LOGY"
  31. 270 PRINT: INPUT"Draw grid lines (N/Y)";A$: A$=LEFT$(A$,1)
  32. 280 IF A$="Y" OR A$="y" THEN PRINT#2,"GRID"
  33. 290 REM
  34. 300 NP.=1: PRINT: INPUT"Number of functions (1-5)"; NP.
  35. 310 IF NP. > 5 THEN PRINT"TOO MANY": END
  36. 320 IF NP. < 1 THEN NP. = 1
  37. 330 FOR J.=1 TO NP.
  38. 340  IF NP. > 0 THEN PRINT:PRINT"Function #";J.;":"
  39. 350  PRINT
  40. 360  PRINT"Enter initial value, final value & step size of ";
  41. 370  IF P.$ <> "Y" THEN PRINT"independent variable" ELSE PRINT"parameter"
  42. 372  PRINT"separated by spaces";
  43. 380  IF J. > 1 THEN PRINT" (press ENTER key if same)";
  44. 390  INPUT V$: IF V$="" GOTO 470
  45. 400   GOTO 420
  46. 410    INPUT"Initial Value, Final Value, Step Size"; V$: IF V$="" GOTO 470
  47. 420   P=1: GOSUB 680: XI. = V: GOSUB 680: XF. = V: GOSUB 680: XS. = V
  48. 430   IF XS. <= 0 THEN PRINT"ERROR: INVALID STEP SIZE": GOTO 410
  49. 440   ND. = INT( (XF.-XI.)/XS. + 1.5 )
  50. 450   IF ND. < 2 THEN PRINT"ERROR: INVALID RANGE": GOTO 410
  51. 460   IF ND. > 1024 THEN PRINT"ERROR: TOO MANY POINTS - MAX IS 1024": GOTO 410
  52. 470  PRINT:PRINT"Calculating..."
  53. 472  IF ND. <= 61 AND P.$ <> "Y" THEN PRINT#2,"CURVE ";J.
  54. 474  IF ND. <= 21 THEN PRINT#2,"SYMBOLS ";J.
  55. 480  PRINT#2,"READ ";ND.
  56. 490  FOR I.=1 TO ND.
  57. 500   IF P.$ <> "Y" THEN X = XI. + (I.-1)*XS. ELSE T = XI. + (I.-1)*XS.
  58. 510   ON J. GOSUB 1100, 1200, 1300, 1400, 1500
  59. 520   PRINT#2, X;" ";Y
  60. 530  NEXT I.
  61. 540 NEXT J.
  62. 545 PRINT#2,"PLOT": PRINT#2,"KEYBOARD"
  63. 550 CLOSE#2
  64. 560 REM
  65. 570 PRINT:PRINT"Press the ENTER key to display the plot";
  66. 580 PRINT" - press the ESC key to clear the plot."
  67. 590 A$=INKEY$: IF A$<>"" GOTO 590
  68. 600 A$=INKEY$: IF A$="" GOTO 600
  69. 610 IF ASC(A$)<>13 GOTO 600
  70. 620 SHELL( "SPLOT FUNDATA.PLT" )
  71. 630 END
  72. 670 REM EXTRACTS V FROM V$ STARTING AT POSITION P
  73. 680 P2=LEN(V$)
  74. 690 IF MID$(V$,P,1)=" " AND P<=P2 THEN P=P+1: GOTO 690
  75. 700 P0=P: IF P0>P2 THEN V=0: RETURN
  76. 710 IF MID$(V$,P,1)<>" " AND P<=P2 THEN P=P+1: GOTO 710
  77. 720 V = VAL( MID$( V$, P0, P-P0 ) )
  78. 730 RETURN
  79. 1000 REM
  80. 1010 REM NOTE: To avoid conflict with main program variables,
  81. 1020 REM       do not use variable names that contain a period.
  82. 1030 REM
  83. 1100 REM Subroutine #1 must set variable Y = FUNCTION(X) after this line #
  84. 1110 Y = COS(X)*EXP(-ABS(X/5))
  85. 1190 RETURN
  86. 1200 REM Subroutine #2 must set variable Y = FUNCTION(X) after this line #
  87. 1210 Y = SIN(X)*EXP(-ABS(X/5))
  88. 1290 RETURN
  89. 1300 REM Subroutine #3 must set variable Y = FUNCTION(X) after this line #
  90. 1310 N=0: GOSUB 2000: Y=J#: REM Y = J0(X) calculated by called subroutine
  91. 1390 RETURN
  92. 1400 REM Subroutine #4 must set variable Y = FUNCTION(X) after this line #
  93. 1410 N=1: GOSUB 2000: Y=J#: REM Y = J1(X) calculated by called subroutine
  94. 1490 RETURN
  95. 1500 REM Subroutine #5 must set variable Y = FUNCTION(X) after this line #
  96. 1510 N=2: GOSUB 2000: Y=J#: REM Y = J2(X) calculated by called subroutine
  97. 1999 RETURN
  98. 2000 REM SETS J# = BESSEL FUNCTION OF THE FIRST KIND OF ORDER N: Jn(X)
  99. 2010 IF INT(N)<>N THEN PRINT"Jn(X) MUST BE OF INTEGER ORDER.": END
  100. 2020 C# = (X/2#)^N
  101. 2030 IF N>1 THEN FOR K=2 TO N: C# = C#/K: NEXT K
  102. 2040 J# = C#: IF ABS(X)<.001 THEN RETURN
  103. 2050 Z# = -X*X/4#: K=0
  104. 2060  K = K+1: C# = Z#/K/(K+N)*C#: J# = J# + C#
  105. 2070  IF ABS(C#)>1E+08 OR K>100 GOTO 2100
  106. 2080 IF ABS(C#)>.00005 GOTO 2060
  107. 2090 RETURN
  108. 2100 PRINT"CAN NOT ACCURATELY CALCULATE Jn(X) FOR n =";N;" & |X| >";ABS(X)
  109. 2110 END
  110.