home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1987 December / 64er_Magazin_87-12_1987_Markt__Technik_de_Side_A.d64 / kurvenanp.c64 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  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.