home *** CD-ROM | disk | FTP | other *** search
/ 64'er / 64ER_CD.iso / 87xx / 8712a.d64 / polynome.c64 (.txt) < prev    next >
Commodore BASIC  |  1995-03-30  |  8KB  |  226 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-PROGRAMM ZUR     *
  12. 60 REM*  REGRESSIONSANALYSE MITTELS   *
  13. 65 REM*     POLYNOMEN INCL.GRAFIK     *
  14. 70 REM*  HEIMO PONNATH  HAMBURG 1987  *
  15. 80 REM*       C64  - VERSION          *
  16. 90 REM*********************************
  17. 100 CLR:SYS 49152:SYS 49242:REM GRAFIKSPEICHER SICHERN
  18. 105 REM GRAPHIC1,1:GOSUB 4000
  19. 110 REM ----- VARIABLE ----------------
  20. 120 M=0:S=0:N=0:I=0:J=0:K=0:G=0:A=0:G2=0:ZZ=0:HH=0:Q=0:P=0:A0=0:B=0
  21. 130 BB=319:BH=199:W=0:MX=-1E12:LX=1E12:MY=-1E12:LY=1E12:R=0
  22. 140 XU=0:XO=0:YU=0:YO=0:RA=0:RD=0:TA=0:TB=0:X=0:Y=0:X1=0:Y1=0
  23. 150 A$="":B$=""
  24. 160 REM
  25. 170 DEFFN G(N)=INT(.2*SQR(5*(A-10*N-17))-4):REM MAX. POLYNOMGRAD BERECHNEN
  26. 180 DEFFN X(X)=RA*X+TA:DEFFN Y(Y)=RD*Y+TB
  27. 190 REM
  28. 200 REM ----- TITEL,ERKLAERUNG --------
  29. 210 POKE 53280,0:POKE 53281,0:PRINTCHR$(30)
  30. 220 PRINTCHR$(147)CHR$(18)"            POLYNOMANPASSUNG            "CHR$(146)
  31. 230 PRINT
  32. 240 PRINT" DURCH EINE ANZAHL VON N PUNKTEN AUS"
  33. 250 PRINT"WERTEPAAREN LEGT DIESES PROGRAMM DAS AM"
  34. 260 PRINT"BESTEN ANGEPASSTE POLYNOM DER FORM"
  35. 270 PRINT"Y=A0+A1*X+A2*X^2+A3*X^3+... . DER GRAD"
  36. 275 PRINT"DES POLYNOMS IST FREI WAEHLBAR. DER"
  37. 277 PRINT"KORRELATIONSKOEFFIZIENT R UND DIE"
  38. 280 PRINT"STANDARDABWEICHUNG S WERDEN ANGEGEBEN"
  39. 290 PRINT"UND SIE KOENNEN BELIEBIGE Y-WERTE"
  40. 300 PRINT"AUS EINGEGEBENEN X-WERTEN BERECHNEN.":PRINT
  41. 310 PRINT" EIN SCATTERDIAGRAMM UND DIE ERMITTELTE"
  42. 320 PRINT"KURVE WERDEN GEZEICHNET. AUF DIESE"
  43. 330 PRINT"WEISE KANN DIE QUALITAET DER ANPASSUNG"
  44. 340 PRINT"EINGESCHAETZT WERDEN.":PRINT
  45. 350 PRINT" SOGENANNTE AUSREISSER-WERTE SOLLTEN"
  46. 360 PRINT"VOR EINER GENAUEREN BERECHNUNG NOCH"
  47. 370 PRINT"ENTFERNT WERDEN.":PRINT:PRINT
  48. 380 PRINTCHR$(18)"TASTE DRUECKEN!"CHR$(146)
  49. 390 GET A$:IF A$="" THEN 390
  50. 400 REM ----- HAUPTMENUE --------------
  51. 410 PRINTCHR$(147):PRINT:PRINT:PRINT:PRINT
  52. 420 PRINTTAB(4)"WERTE VON HAND EINGEBEN.......1":PRINT
  53. 430 PRINTTAB(4)"WERTE AUS DATEI LESEN.........2":PRINT
  54. 440 PRINTTAB(4)"GRAFIK ZEIGEN.................3":PRINT
  55. 450 PRINTTAB(4)"TEXTMODUS EINSCHALTEN.........4":PRINT
  56. 460 PRINTTAB(4)"POLYNOMFUNKTION BERECHNEN.....5":PRINT
  57. 470 PRINTTAB(4)"WERTE BERECHNEN...............6":PRINT
  58. 480 PRINTTAB(4)"PROGRAMMENDE..................7":PRINT:PRINT
  59. 490 PRINTTAB(10)CHR$(18)"BITTE WAEHLEN SIE!"CHR$(146)
  60. 500 GET A$:IF VAL(A$)<1 OR VAL(A$)>7 THEN 500
  61. 510 PRINTCHR$(147):IF VAL(A$)=7 THEN END
  62. 520 ON VAL(A$) GOSUB 1000,2000,3000,4000,5000,6000
  63. 530 GOTO 410
  64. 540 REM ----- ENDE HAUPTPROGRAMM ------
  65. 1000 REM ----- WERTE VON HAND ---------
  66. 1005 GOSUB 4000:REM TEXTMODUS
  67. 1010 IF W=1 THEN PRINT"WERTE SCHON VORHANDEN!":FOR I=0 TO 500:NEXT I:RETURN
  68. 1020 W=1
  69. 1030 PRINT"WIEVIELE WERTE WERDEN VERWENDET ?":INPUTN:PRINT
  70. 1040 DIM W(1,N)
  71. 1043 A=FRE(0)-2000:REM FREIER SPEICHERPLATZ C64
  72. 1045 REM A=FRE(1)-2000
  73. 1047 G=FNG(N):REM MAXIMALER POLYNOMGRAD
  74. 1050 PRINT"BITTE WERTEPAARE EINGEBEN!":PRINT
  75. 1060 FOR I=1 TO N
  76. 1070 PRINTI,"X=";:INPUTW(0,I):PRINTCHR$(145),,"Y=";:INPUTW(1,I):PRINT
  77. 1080 GOSUB 1300:REM ZWISCHENWERTE BERECHNEN
  78. 1090 NEXT I
  79. 1100 PRINTCHR$(147):PRINT:PRINT"SOLLEN DIE WERTE GESPEICHERT WERDEN?"
  80. 1110 GET A$:IF A$<>"J" AND A$<>"N" THEN 1110
  81. 1120 IF A$="N" THEN 1190
  82. 1130 PRINT:PRINT"NAME DER DATEI (11 ZEICHEN)";:INPUT B$
  83. 1140 B$=LEFT$(B$,11)+".DAT"+",S,W"
  84. 1150 OPEN 1,8,2,B$
  85. 1160 PRINT#1,N
  86. 1170 FOR I=1 TO N:PRINT#1,W(0,I):PRINT#1,W(1,I):NEXT I
  87. 1180 CLOSE 1
  88. 1190 GOSUB 1500:REM SCATTERDIAGRAMM ZEICHNEN
  89. 1200 RETURN
  90. 1300 REM --- ZWISCHENWERTE BERECHNEN --
  91. 1360 IF W(0,I)>MX THEN MX=W(0,I)
  92. 1370 IF W(0,I)<LX THEN LX=W(0,I)
  93. 1380 IF W(1,I)>MY THEN MY=W(1,I)
  94. 1390 IF W(1,I)<LY THEN LY=W(1,I)
  95. 1400 RETURN
  96. 1500 REM --- SCATTERDIAGRAMM ----------
  97. 1505 DIM A(2*G+1),R(G+1,G+2),T(G+2):REM ARRAYS FUER BERECHNUNGEN
  98. 1510 FOR I=1 TO N-1:REM SORTIEREN NACH X
  99. 1520 FOR J=I+1 TO N
  100. 1530 IF W(0,I)<=W(0,J) THEN 1560
  101. 1540 W(0,0)=W(0,I):W(1,0)=W(1,I):W(0,I)=W(0,J):W(1,I)=W(1,J)
  102. 1550 W(0,J)=W(0,0):W(1,J)=W(1,0)
  103. 1560 NEXT J:NEXT I
  104. 1570 SYS 49152:SYS 49180:SYS 49202,6,0:REM GRAFIK LOESCHEN FARBE
  105. 1580 REM GRAPHIC1,1:COLOR0,1:COLOR1,7
  106. 1590 SYS 49352,0,0,319,0,1:SYS 49352,319,0,319,199,1
  107. 1600 REM DRAW 1,0,0 TO 319,0 TO 319,199 TO 0,199 TO 0,0
  108. 1610 SYS 49352,319,199,0,199,1:SYS 49352,0,199,0,0,1:REM RAHMEN
  109. 1620 XU=LX-(MX-LX)*.02:XO=MX+(MX-LX)*.02
  110. 1630 YU=LY-(MY-LY)*.02:YO=MY+(MY-LY)*.02
  111. 1640 RA=BB/(XO-XU):RD=-BH/(YO-YU)
  112. 1650 TA=-BB*XU/(XO-XU):TB=BH*YO/(YO-YU)
  113. 1660 FOR I=1 TO N
  114. 1670 X=FNX(W(0,I)):Y=FNY(W(1,I))
  115. 1680 SYS49352,X-3,Y,X+3,Y,1:SYS49352,X,Y-3,X,Y+3,1:REM KREUZ
  116. 1681 REM DRAW1,X-3,Y TO X+3,Y:DRAW1,X,Y-3 TO X,Y+3
  117. 1690 NEXT I
  118. 1700 GET A$:IF A$="" THEN 1700
  119. 1710 SYS 49242:REM TEXTMODUS
  120. 1711 REM IF PEEK(238)=79 THEN GRAPHIC5:ELSE GRAPHIC0
  121. 1720 PRINT"XU =  "LX,"XO =  "MX"
  122. 1730 [153]"YU =  "LY,"YO =  "MY"
  123. 1740 GET A$:IF A$="" THEN 1740
  124. 1750 RETURN
  125. 2000 REM ----- WERTE AUS DATEI --------
  126. 2005 GOSUB 4000:REM TEXTMODUS
  127. 2010 IF W=1 THEN PRINT"WERTE SCHON VORHANDEN!":FOR I=0 TO 500:NEXT I:RETURN
  128. 2020 W=1
  129. 2030 PRINT" DIE DATEI MUSS EIN BESTIMMTES FORMAT"
  130. 2040 PRINT"HABEN:     1.ANZAHL DER WERTEPAARE"
  131. 2050 PRINT"           1.WERT X, 1.WERT Y"
  132. 2060 PRINT"           2.WERT X, 2.WERT Y ...":PRINT
  133. 2070 PRINT"DIESE DATEIEN WERDEN UNTER MENUEPUNKT 1"
  134. 2080 PRINT"ERSTELLT. SIE TRAGEN DIE ENDUNG .DAT .":PRINT
  135. 2090 PRINT" ALLES KLAR..1  ACH SOO..2"
  136. 2100 GET A$:IF VAL(A$)<1 OR VAL(A$)>2 THEN 2100
  137. 2110 IF VAL(A$)=2 THEN W=0:RETURN
  138. 2120 PRINT:PRINT"WIE HEISST DENN DIE DATEI (ENDUNG .DAT)"
  139. 2130 INPUT B$
  140. 2140 B$=B$+",S,R"
  141. 2150 OPEN1,8,2,B$
  142. 2160 INPUT#1,N
  143. 2170 DIM W(1,N)
  144. 2173 A=FRE(0)-2000:REM FREIER SPEICHERPLATZ C64
  145. 2175 REM A=FRE(1)-2000
  146. 2177 G=FNG(N):REM MAXIMALER POLYNOMGRAD
  147. 2180 FOR I=1 TO N
  148. 2190 INPUT#1,W(0,I):INPUT#1,W(1,I)
  149. 2200 GOSUB 1300:REM ZWISCHENWERTE BERECHNEN
  150. 2210 NEXT I
  151. 2220 CLOSE 1
  152. 2230 GOSUB 1500:REM SCATTERDIAGRAMM
  153. 2240 RETURN
  154. 3000 REM ----- GRAFIK ZEIGEN ----------
  155. 3010 IF W=0 THEN PRINT"DA FEHLEN NOCH DIE WERTE!":FOR I=0 TO 500:NEXT I:RETURN
  156. 3020 SYS 49152:SYS 49202,6,0:REM GRAFIK EIN
  157. 3021 REM GRAPHIC1:RETURN
  158. 3030 GET A$:IF VAL(A$)<>4 THEN 3020
  159. 3040 GOTO 4010:REM TEXTMODUS EIN
  160. 4000 REM ----- TEXTMODUS EIN ----------
  161. 4010 SYS 49242:REM TEXTMODUS EIN
  162. 4011 REM IF PEEK(238)=79 THEN GRAPHIC5:ELSE GRAPHIC0
  163. 4020 RETURN
  164. 5000 REM ---- POLYNOM-BERECHNUNG ----------------------
  165. 5002 GOSUB 4000:REM TEXTMODUS
  166. 5004 IF W=0 THEN PRINT"DA FEHLEN DIE WERTE!":FOR I=0 TO 500:NEXT I:RETURN
  167. 5010 PRINTCHR$(147)CHR$(17)CHR$(17)"WELCHEN GRAD SOLL DAS POLYNOM HABEN ?"
  168. 5020 PRINT:PRINT"MAXIMAL ERLAUBT IST EIN POLYNOM ":PRINT,G".GRADES ."
  169. 5030 PRINT:PRINT"BEI OVERFLOW-ERROR IST DER":PRINT"WIEDEREINSTIEG INS PROGRAMM"
  170. 5040 PRINT"MOEGLICH MIT 'GOTO 400' !"
  171. 5050 PRINT:INPUT"POLYNOMGRAD=";G2:IFG2>GTHEN5020
  172. 5060 FORI=1TOG2+2:T(I)=0:A(I)=0:A(ABS(2*I-3))=0:FORK=1TOG+1:R(K,I)=0:NEXTK:NEXTI
  173. 5070 A(1)=N:ZZ=0:M=0:S=0:HH=0:Q=0:P=0:A0=0
  174. 5080 FORI=1TON:FORL=2TO2*G2+1:A(L)=A(L)+W(0,I)^(L-1):NEXTL
  175. 5090 FORK=1TOG2+1:R(K,G2+2)=T(K)+W(1,I)*W(0,I)^(K-1)
  176. 5100 T(K)=T(K)+W(1,I)*W(0,I)^(K-1):NEXTK:T(G2+2)=T(G2+2)+W(1,I)^2:NEXTI
  177. 5110 FORI=1TOG2+1:FORK=1TOG2+1:R(I,K)=A(I+K-1):NEXTK:NEXTI
  178. 5120 FORI=1TOG2+1:FORK=ITOG2+1:IFR(K,I)<>0THEN5150
  179. 5130 GOSUB 4000:REM TEXTMODUS
  180. 5140 PRINT"KEINE EINDEUTIGE LOESUNG":RETURN
  181. 5150 FORL=1TOG2+2:S=R(I,L):R(I,L)=R(K,L):R(K,L)=S:NEXTL
  182. 5160 M=1/R(I,I):FORL=1TOG2+2:R(I,L)=M*R(I,L):NEXTL
  183. 5170 FORK=1TOG2+1:IFK=ITHEN5190
  184. 5180 M=-R(K,I):FORL=1TOG2+2:R(K,L)=R(K,L)+M*R(I,L):NEXTL
  185. 5190 NEXTK:NEXTI:A0=1:PRINTCHR$(147)
  186. 5200 P=0:FORI=2TOG2+1:P=P+R(I,G2+2)*(T(I)-A(I)*T(1)/N):NEXTI
  187. 5210 Q=T(G2+2)-T(1)^2/N:ZZ=Q-P:B=N-G2-1:HH=P/Q:IFB=0THENB=1E-23
  188. 5215 A0=1:GOSUB 4000:PRINTCHR$(147)
  189. 5220 PRINT"DAS POLYNOM "G2".GRADES IST:":PRINT:PRINTTAB(5)"Y=A0+A1*X+A2*X^2+..."
  190. 5230 PRINT:PRINTTAB(3)"KONSTANTE A0="R(1,G2+2):FORI=1TOG2
  191. 5240 PRINTTAB(3)"KOEFFIZIENT A"I"="R(I+1,G2+2):NEXTI:PRINT
  192. 5250 PRINTTAB(3)"KORRELATIONSKOEFFIZIENT=":PRINT,HH
  193. 5260 PRINT:PRINTTAB(3)"STANDARDABWEICHUNG=":PRINT,SQR(ABS(ZZ/B))
  194. 5270 PRINT:PRINTTAB(3)"GRAFIK...TASTE DRUECKEN ! (_ = MENUE)"
  195. 5280 GETA$:IF A$=""THEN 5280
  196. 5290 IF A$="_" THEN RETURN
  197. 5300 R=1:SYS 49152:SYS 49202,6,0:REM GRAFIK EIN
  198. 5301 REM GOSUB 3000
  199. 5310 FOR I=LX TO MX STEP (MX-LX)/100
  200. 5320 P=R(1,G2+2):GOSUB 7010:REM FUNKTIONSWERT BERECHNEN
  201. 5330 X1=FNX(I):Y1=FNY(P):IF Y1<0 THEN 5350
  202. 5340 SYS 49266 X1,Y1,1:REM PUNKT ZEICHNEN
  203. 5341 REM DRAW 1,X1,Y1
  204. 5350 NEXT I
  205. 5360 GET A$:IF A$ ="" THEN 5360
  206. 5370 IF A$="_" THEN GOSUB 4000:RETURN
  207. 5380 IF R=1 THEN R=0:GOSUB 4000:GOTO5360
  208. 5390 IF R=0 THEN R=1:SYS 49152:SYS 49202,6,0
  209. 5391 REM IF R=0 THEN R=1:GOSUB 3000
  210. 5400 GOTO 5360
  211. 6000 REM ------ WERTE BERECHNEN ----------
  212. 6010 GOSUB 4000:REM TEXTMODUS
  213. 6020 IF A0=0 AND W=0 THEN PRINT"BITTE GEBEN SIE ZUERST WERTE EIN UND"
  214. 6030 IF A0=0 THEN PRINT"BITTE DIE KURVE BERECHNEN!":FOR I=0 TO 500:NEXT I:RETURN
  215. 6040 PRINT:PRINT" AUF DER BASIS DER REGRESSIONSKURVE"
  216. 6050 PRINT"KOENNEN BELIEBIGE WERTE BERECHNET WERDEN"
  217. 6060 PRINT:PRINT" ZURUECK ZUM MENUE KOMMEN SIE DURCH _":PRINT
  218. 6070 INPUT"WERT X = ";A$
  219. 6080 IF A$ ="_" THEN RETURN
  220. 6090 I=VAL(A$)
  221. 6100 P=R(1,G2+2):GOSUB7010
  222. 6110 PRINTCHR$(145),,"Y = "P
  223. 6120 GOTO 6060
  224. 7000 REM ----- POLYNOMWERT BERECHNEN -----
  225. 7010 FORJ=1TOG2:P=P+R(J+1,G2+2)*I^J:NEXTJ:RETURN
  226.