home *** CD-ROM | disk | FTP | other *** search
/ 64'er / 64ER_CD.iso / 87xx / 8712a.d64 / kurvenanp.c64 (.txt) < prev    next >
Commodore BASIC  |  1995-03-30  |  7KB  |  207 lines
  1. 1 REM ----- NACHLADEN GRAFIK -------
  2. 2 IF A$="N" THEN 100
  3. 3 PRINTCHR$(147)CHR$(17)"GRAFIK NACHLADEN (J/N)"
  4. 4 GET A$:IF A$="" THEN 4
  5. 5 IF A$="N" THEN 100
  6. 6 A$="N":LOAD"SYSGRAF.OBJ",8,1
  7. 10 REM*********************************
  8. 20 REM*                               *
  9. 30 REM*       KURVENANPASSUNG         *
  10. 40 REM*                               *
  11. 50 REM*STATISTIK-PROGR. ZUR EXPONENT. *
  12. 60 REM*REGRESSIONSANALYSE INCL. GRAFIK*
  13. 70 REM*  HEIMO PONNATH  HAMBURG 1987  *
  14. 80 REM*        C64 - VERSION          *
  15. 90 REM*********************************
  16. 100 CLR:SYS 49152:SYS 49242:REM GRAFIKSPEICHER SICHERN
  17. 105 REM:GRAPHIC1,1:GOSUB 4000
  18. 110 REM ----- VARIABLE ----------------
  19. 120 SX=0:SY=0:QX=0:QY=0:XY=0:B=0:M=0:R=0:S=0:N=0:I=0:J=0:G=0:A=0:X1=0:Y1=0
  20. 130 BB=319:BH=199:W=0:MX=-1E12:LX=1E12:MY=-1E12:LX=1E12:X2=0:Y2=0
  21. 140 XU=0:XO=0:YU=0:YO=0:RA=0:RD=0:TA=0:TB=0:X=0:Y=0:BL=0:D=0
  22. 150 A$="":B$=""
  23. 160 REM
  24. 170 DEFFN E(X)=B*EXP(M*X)
  25. 180 DEFFN X(X)=RA*X+TA:DEFFN Y(Y)=RD*Y+TB
  26. 190 REM
  27. 200 REM ----- TITEL,ERKLAERUNG --------
  28. 210 POKE 53280,0:POKE 53281,0:PRINTCHR$(30)
  29. 220 PRINTCHR$(147)CHR$(18)"       EXPONENTIELLE  ANPASSUNG         "CHR$(146)
  30. 230 PRINT
  31. 240 PRINT" DURCH EINE ANZAHL VON N PUNKTEN AUS"
  32. 250 PRINT"WERTEPAAREN LEGT DIESES PROGRAMM DIE AM"
  33. 260 PRINT"BESTEN ANGEPASSTE EXPONENTIALFUNKTION"
  34. 270 PRINT"Y=A*E^(B*X).DER KORRELATIONSKOEFFIZIENT"
  35. 280 PRINT"R UND DIE STANDARDABWEICHUNG S WERDEN"
  36. 290 PRINT"ANGEGEBEN UND MAN KANN BELIEBIGE Y-WERTE"
  37. 300 PRINT"AUS EINGEGEBENEN X-WERTEN BERECHNEN.":PRINT
  38. 310 PRINT" EIN SCATTERDIAGRAMM UND DIE ERMITTELTE"
  39. 320 PRINT"KURVE WERDEN GEZEICHNET. AUF DIESE"
  40. 330 PRINT"WEISE KANN DIE QUALITAET DER ANPASSUNG"
  41. 340 PRINT"EINGESCHAETZT WERDEN.":PRINT
  42. 350 PRINT" SOGENANNTE AUSREISSER-WERTE SOLLTEN"
  43. 360 PRINT"VOR EINER GENAUEREN BERECHNUNG NOCH"
  44. 370 PRINT"ENTFERNT WERDEN.":PRINT:PRINT
  45. 380 PRINTCHR$(18)"TASTE DRUECKEN!"CHR$(146)
  46. 390 GET A$:IF A$="" THEN 390
  47. 400 REM ----- HAUPTMENUE --------------
  48. 410 PRINTCHR$(147):PRINT:PRINT:PRINT:PRINT
  49. 420 PRINTTAB(4)"WERTE VON HAND EINGEBEN.......1":PRINT
  50. 430 PRINTTAB(4)"WERTE AUS DATEI LESEN.........2":PRINT
  51. 440 PRINTTAB(4)"GRAFIK ZEIGEN.................3":PRINT
  52. 450 PRINTTAB(4)"TEXTMODUS EINSCHALTEN.........4":PRINT
  53. 460 PRINTTAB(4)"EXPONENTIALFUNKTION BERECHNEN.5":PRINT
  54. 470 PRINTTAB(4)"WERTE BERECHNEN...............6":PRINT
  55. 480 PRINTTAB(4)"PROGRAMMENDE..................7":PRINT:PRINT
  56. 490 PRINTTAB(10)CHR$(18)"BITTE WAEHLEN SIE!"CHR$(146)
  57. 500 GET A$:IF VAL(A$)<1 OR VAL(A$)>7 THEN 500
  58. 510 PRINTCHR$(147):IF VAL(A$)=7 THEN END
  59. 520 ON VAL(A$) GOSUB 1000,2000,3000,4000,5000,6000
  60. 530 GOTO 410
  61. 540 REM ----- ENDE HAUPTPROGRAMM ------
  62. 1000 REM ----- WERTE VON HAND ---------
  63. 1005 GOSUB 4000:REM TEXTMODUS
  64. 1010 IF W=1 THEN PRINT"WERTE SCHON VORHANDEN!":FOR I=0 TO 500:NEXT I:RETURN
  65. 1020 W=1
  66. 1030 PRINT"WIEVIELE WERTE WERDEN VERWENDET ?":INPUTN:PRINT
  67. 1040 DIM W(2,N)
  68. 1050 PRINT"BITTE WERTEPAARE EINGEBEN!":PRINT
  69. 1060 FOR I=1 TO N
  70. 1070 PRINTI,"X=";:INPUTW(1,I):PRINTCHR$(145),,"Y=";:INPUTW(0,I):PRINT
  71. 1080 GOSUB 1300:REM ZWISCHENWERTE BERECHNEN
  72. 1090 NEXT I
  73. 1100 PRINTCHR$(147):PRINT:PRINT"SOLLEN DIE WERTE GESPEICHERT WERDEN?"
  74. 1110 GET A$:IF A$<>"J" AND A$<>"N" THEN 1110
  75. 1120 IF A$="N" THEN 1190
  76. 1130 PRINT:PRINT"NAME DER DATEI (11 ZEICHEN)";:INPUT B$
  77. 1140 B$=LEFT$(B$,11)+".DAT"+",S,W"
  78. 1150 OPEN 1,8,2,B$
  79. 1160 PRINT#1,N
  80. 1170 FOR I=1 TO N:PRINT#1,W(1,I):PRINT#1,W(0,I):NEXT I
  81. 1180 CLOSE 1
  82. 1190 GOSUB 1500:REM SCATTERDIAGRAMM ZEICHNEN
  83. 1200 RETURN
  84. 1300 REM --- ZWISCHENWERTE BERECHNEN --
  85. 1305 W(2,I)=LOG(W(0,I))
  86. 1310 SX=SX+W(1,I)
  87. 1320 SY=SY+W(2,I)
  88. 1330 QX=QX+W(1,I)*W(1,I)
  89. 1340 QY=QY+W(2,I)*W(2,I)
  90. 1350 XY=XY+W(1,I)*W(2,I)
  91. 1360 IF W(1,I)>MX THEN MX=W(1,I)
  92. 1370 IF W(1,I)<LX THEN LX=W(1,I)
  93. 1380 IF W(0,I)>MY THEN MY=W(0,I)
  94. 1390 IF W(0,I)<LY THEN LY=W(0,I)
  95. 1400 RETURN
  96. 1500 REM --- SCATTERDIAGRAMM ----------
  97. 1510 FOR I=1 TO N-1:REM SORTIEREN NACH X
  98. 1520 FOR J=I+1 TO N
  99. 1530 IF W(1,I)<=W(1,J) THEN 1560
  100. 1540 W(1,0)=W(1,I):W(0,0)=W(0,I):W(1,I)=W(1,J):W(0,I)=W(0,J)
  101. 1550 W(1,J)=W(1,0):W(0,J)=W(0,0)
  102. 1560 NEXT J:NEXT I
  103. 1570 SYS 49152:SYS 49180:SYS 49202,6,0:REM GRAFIK LOESCHEN FARBE
  104. 1580 REM:GRAPHIC1,1:COLOR0,1:COLOR1,7
  105. 1590 SYS 49352,0,0,319,0,1:SYS 49352,319,0,319,199,1
  106. 1600 REM:DRAW 1,0,0 TO 319,0 TO 319,199 TO 0,199 TO 0,0
  107. 1610 SYS 49352,319,199,0,199,1:SYS 49352,0,199,0,0,1:REM RAHMEN
  108. 1620 XU=LX-(MX-LX)*.02:XO=MX+(MX-LX)*.02
  109. 1630 YU=LY-(MY-LY)*.02:YO=MY+(MY-LY)*.02
  110. 1640 RA=BB/(XO-XU):RD=-BH/(YO-YU)
  111. 1650 TA=-BB*XU/(XO-XU):TB=BH*YO/(YO-YU)
  112. 1660 FOR I=1 TO N
  113. 1670 X=FNX(W(1,I)):Y=FNY(W(0,I))
  114. 1680 SYS49352,X-3,Y,X+3,Y,1:SYS49352,X,Y-3,X,Y+3,1:REM KREUZ
  115. 1681 REM:DRAW1,X-3,Y TO X+3,Y:DRAW1,X,Y-3 TO X,Y+3
  116. 1690 NEXT I
  117. 1700 GET A$:IF A$="" THEN 1700
  118. 1710 SYS 49242:REM TEXTMODUS
  119. 1711 REM:IF PEEK(238)=79 THEN GRAPHIC5:ELSE GRAPHIC0
  120. 1720 PRINT"XU =  "LX,"XO =  "MX"
  121. 1730 [153]"YU =  "LY,"YO =  "MY"
  122. 1740 GET A$:IF A$="" THEN 1740
  123. 1750 RETURN
  124. 2000 REM ----- WERTE AUS DATEI --------
  125. 2005 GOSUB 4000:REM TEXTMODUS
  126. 2010 IF W=1 THEN PRINT"WERTE SCHON VORHANDEN!":FOR I=0 TO 500:NEXT I:RETURN
  127. 2020 W=1
  128. 2030 PRINT" DIE DATEI MUSS EIN BESTIMMTES FORMAT"
  129. 2040 PRINT"HABEN:     1.ANZAHL DER WERTEPAARE"
  130. 2050 PRINT"           1.WERT X, 1.WERT Y"
  131. 2060 PRINT"           2.WERT X, 2.WERT Y ...":PRINT
  132. 2070 PRINT"DIESE DATEIEN WERDEN UNTER MENUEPUNKT 1"
  133. 2080 PRINT"ERSTELLT. SIE TRAGEN DIE ENDUNG .DAT .":PRINT
  134. 2090 PRINT" ALLES KLAR..1  ACH SOO..2"
  135. 2100 GET A$:IF VAL(A$)<1 OR VAL(A$)>2 THEN 2100
  136. 2110 IF VAL(A$)=2 THEN W=0:RETURN
  137. 2120 PRINT:PRINT"WIE HEISST DENN DIE DATEI (ENDUNG .DAT)"
  138. 2130 INPUT B$
  139. 2140 B$=B$+",S,R"
  140. 2150 OPEN1,8,2,B$
  141. 2160 INPUT#1,N
  142. 2170 DIM W(2,N)
  143. 2180 FOR I=1 TO N
  144. 2190 INPUT#1,W(1,I):INPUT#1,W(0,I)
  145. 2200 GOSUB 1300:REM ZWISCHENWERTE BERECHNEN
  146. 2210 NEXT I
  147. 2220 CLOSE 1
  148. 2230 GOSUB 1500:REM SCATTERDIAGRAMM
  149. 2240 RETURN
  150. 3000 REM ----- GRAFIK ZEIGEN ----------
  151. 3010 IF W=0 THEN PRINT"DA FEHLEN NOCH DIE WERTE!":FOR I=0 TO 500:NEXT I:RETURN
  152. 3020 SYS 49152:SYS 49202,6,0:REM GRAFIK EIN
  153. 3021 REM:GRAPHIC1:RETURN
  154. 3030 GET A$:IF VAL(A$)<>4 THEN 3020
  155. 3040 GOTO 4010:REM TEXTMODUS EIN
  156. 4000 REM ----- TEXTMODUS EIN ----------
  157. 4010 SYS 49242:REM TEXTMODUS EIN
  158. 4011 REM:IF PEEK(238)=79 THEN GRAPHIC5:ELSE GRAPHIC0
  159. 4020 RETURN
  160. 5000 REM -LOGARITHMISCHE GERADE BERECHNEN -
  161. 5002 GOSUB 4000:REM TEXTMODUS
  162. 5005 IF W=0 THEN PRINT"DA FEHLEN DIE WERTE!":FOR I=0 TO 500:NEXT I:RETURN
  163. 5007 G=1
  164. 5010 BL=(QX*SY-SX*XY)/(N*QX-SX*SX):REM ACHSENABSCHNITT
  165. 5015 B=EXP(BL)
  166. 5020 M=(N*XY-SX*SY)/(N*QX-SX*SX):REM STEIGUNG
  167. 5030 R=(N*XY-SX*SY)/SQR((N*QX-SX*SX)*(N*QY-SY*SY)):REM KORRELATIONSKOEFFIZIENT
  168. 5040 FOR I=1 TO N:D=FNE(W(1,I))-W(0,I):REM STANDARDABWEICHUNG BERECHNEN
  169. 5045 S=S+D*D:NEXT I:S=SQR(S/(N-2))
  170. 5050 GOSUB 4010:REM TEXTMODUS EIN
  171. 5060 PRINT:PRINT"IN DER EXPONENTIALGLEICHUNG":PRINT"   Y = A*E^(B*X) IST"
  172. 5070 PRINT:PRINT"   B = ",M
  173. 5080 PRINT:PRINT"   A = ",B:PRINT
  174. 5090 PRINT"DER KORRELATIONSKOEFFIZIENT IST"
  175. 5100 PRINT:PRINT"   R = ",R:PRINT
  176. 5110 PRINT"DIE MITTLERE STANDARDABWEICHUNG BETRAEGT"
  177. 5120 PRINT:PRINT"   S = ",S:PRINT
  178. 5130 PRINT:PRINT"BITTE TASTE DRUECKEN! (_ = MENUE)"
  179. 5140 GET A$:IF A$=""THEN 5140
  180. 5150 IF A$="_" THEN RETURN
  181. 5160 A=1:SYS 49152:SYS49202,6,0:REM GRAFIK EIN
  182. 5161 REM:GOSUB 3000
  183. 5170 FOR I=LX TO MX STEP (MX-LX)/100
  184. 5180 X1=FNX(I):Y1=FNY(FNE(I)):IF Y1<0 THEN 5195
  185. 5190 SYS 49266 X1,Y1,1:REM PUNKT ZEICHNEN
  186. 5191 REM:DRAW 1,X1,Y1
  187. 5195 NEXT I
  188. 5200 GET A$:IF A$="" THEN 5200
  189. 5210 IF A$="_" THEN GOSUB 4000:RETURN
  190. 5220 IF A=1 THEN A=0:GOSUB 4000:GOTO 5200
  191. 5230 IF A=0 THEN A=1:SYS 49152:SYS49202,6,0
  192. 5231 REM:IF A=0 THEN A=1:GOSUB 3000
  193. 5240 GOTO 5200
  194. 6000 REM ----- WERTE BERECHNEN --------
  195. 6010 GOSUB 4000:REM TEXTMODUS
  196. 6020 IF G=0 AND W=0 THEN PRINT"BITTE GEBEN SIE ZUERST WERTE EIN UND"
  197. 6030 IF G=0 THEN PRINT"BITTE DIE KURVE BERECHNEN!":FOR I=0 TO 500:NEXT:RETURN
  198. 6040 PRINT:PRINT" AUF DER BASIS DER REGRESSIONSKURVE"
  199. 6050 PRINT"KOENNEN BELIEBIGE WERTE BERECHNET WERDEN"
  200. 6060 PRINT:PRINT" ZURUECK ZUM MENUE KOMMEN SIE DURCH _":PRINT
  201. 6070 INPUT"WERT X =";A$
  202. 6080 IF A$="_" THEN RETURN
  203. 6090 X=VAL(A$)
  204. 6100 Y=FNE(X)
  205. 6110 PRINTCHR$(145),,"Y ="Y
  206. 6120 GOTO6060
  207.