home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C64Educational / EIGEN (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  5.6 KB  |  235 lines
  1. 1 POKE 53280,0:POKE 53281,0:PRINT""
  2. 5 PRINT"[147]"
  3. 10 REM JACOBI METHOD FOR FINDING THE
  4. 12 REM EIGENVALUES AND EIGENVECTORS OF
  5. 13 REM A SYMETRIC MATRIX
  6. 14 REM *******************************
  7. 15 REM ORIGINAL BASIC PROGRAM BY
  8. 16 REM DR. THOMAS MITCHEL. PORTED TO
  9. 17 REM THE COMMODORE 64 BY JIM STUBBE
  10. 18 REM *******************************
  11. 19 REM TITLE SCREEN
  12. 20 PRINT"     EIGENVALUE/EIGENVECTOR FINDER"
  13. 21 PRINT
  14. 22 PRINT:PRINT"        BY JIM STUBBE":PRINT
  15. 23 PRINT"       THIS PROGRAM FINDS THE"
  16. 24 PRINT"      EIGENVALUES AND EIGENVACTORS"
  17. 25 PRINT"      OF A SYMETRIC MATRIX USING"
  18. 26 PRINT"      THE JACOBI METHOD.":PRINT:PRINT"      THE EQN SOLVED IS:
  19. 27 [153]"      A(NN)B(N)=CI(NN)B(N)":[153]
  20. 28 [153]"       WHERE A IS A SQUARE MATRIX,"
  21. 29 [153]"      I IS THE IDENTITY MATRIX, C IS A"
  22. 30 [153]"      SCALAR AND B IS A VECTOR.":[153]
  23. 31 [153]
  24. 32 [143] INPUT DEGREE OF MATRIX A
  25. 33 [153]"ENTER DEGREE OF A (A IS N BY N)":[133] N%
  26. 34 N[178]N%
  27. 36 [153]:[153]"  ******(HIT ANY KEY TO CONTINUE)******  "
  28. 37 [161] A$:[139] A$[178]"" [167] 37
  29. 38 [153] "LOAD"
  30. 39 [143] DIMENSION A AND R
  31. 40 [134] A(N%,N%),R(N%,N%),XX(N%,N%),C(N%,N%)
  32. 41 [141] 6000
  33. 42 [143] INPUT ELEMENTS OF A
  34. 50 [129] I[178]1 [164] N%
  35. 60 [129] J[178]1 [164] N%
  36. 70 [153]" ENTER A("I""J"):":[133] A(I,J)
  37. 90 [130] J
  38. 100 [130] I
  39. 110 :[153]:[153]"DO YOU WANT OUTPUT PRINTED(Y/N)?"
  40. 111 [161] B$:[139] B$[178]"" [167] 111
  41. 112 [139] B$[178]"Y" [167] 114
  42. 113 CT[178]0:[137] 116
  43. 114 [143] OPEN PRINTER AND SET PRINT CONTROL (CT)
  44. 115 [159] 4,4:CT[178]1
  45. 116 [143] GOSUB TO PRINT A
  46. 117 [153]"LOAD":[141] 3000
  47. 119 [143] INITIALIZE UNIT MATRIX
  48. 120 [143]
  49. 121 [153]:[153]"THE MATRIX I IS:"
  50. 122 [153]
  51. 123 [139] CT[178]1 [167] [152]4,:[139] CT[178]1 [167] [152]4,"THE MATRIX I IS:"
  52. 124 [139] CT[178]1 [167] [152]4,
  53. 125 [143] SET TR (TRACE(A)) TO ZERO
  54. 126 TR[178]0
  55. 150 [129] A[178]1 [164] N%
  56. 160 [129] B[178]1 [164] N%
  57. 170 [139] A[178]B [167] R(A,B)[178]1: [139] A[178]B [167] [137] 180
  58. 175 R(A,B)[178]0
  59. 180 [139] CT[178]1 [167] [152]4, R(A,B);" ";
  60. 181 [153] R(A,B);" ";
  61. 182 [139] A[178]B [167] TR[178]TR[170]A(A,B)
  62. 190 [130] B
  63. 191 [139] CT[178]1 [167] [152]4,
  64. 192 [153]
  65. 200 [130] A
  66. 201 [153]:[139] CT[178]1 [167] [152]4,
  67. 205 [153]:[153]
  68. 206 [153]" *****(HIT ANY KEY TO CONTINUE*****"
  69. 207 [161] S$:[139] S$[178]"" [167] [137] 207
  70. 208 [153]"LOAD"
  71. 230 NUSWEEP[178]0
  72. 240 NSKIP[178]0
  73. 250 [129] I[178]1 [164] N%[171]1
  74. 260 L[178]I[170]1
  75. 270 [129] J[178]L [164] N%
  76. 280 AVRG[178].5[172](A(I,J)[170]A(J,I))
  77. 290 DELT[178]A(I,I)[171]A(J,J)
  78. 300 RAD[178][186](DELT[172]DELT[170]4[172]AVRG[172]AVRG)
  79. 310 [139] RAD[178]0 [167] [137] 430
  80. 320 [139] RAD[179]0 [167] [137] 390
  81. 330 [139] [182](A(I,I))[178][182](A(I,I))[170]100[172][182](AVRG) [167] [137] 350
  82. 340 [137] 360
  83. 350 [139] [182](A(J,J))[178][182](A(J,J))[170]100[172][182](AVRG) [167] [137] 430
  84. 360 CSN[178][186]((RAD[170]DELT)[173](2[172]RAD))
  85. 370 SN[178]AVRG[173](RAD[172]CSN)
  86. 380 [137] 420
  87. 390 SN[178][186]((RAD[171]DELT)[173](2[172]RAD))
  88. 400 [139] AVRG[179]0 [167] SN[178][171]SN
  89. 410 CSN[178]AVRG[173](RAD[172]SN)
  90. 420 [139] 1[179]1[170][182](SN) [167] [137] 450
  91. 430 NSKIP[178]NSKIP[170]1
  92. 440 [137] 580
  93. 450 [129] K[178]1 [164] N%
  94. 460 Q[178]A(I,K)
  95. 470 A(I,K)[178]CSN[172]Q[170]SN[172]A(J,K)
  96. 480 A(J,K)[178][171]SN[172]Q[170]CSN[172]A(J,K)
  97. 490 [130] K
  98. 500 [129] K[178]1 [164] N%
  99. 510 Q[178]A(K,I)
  100. 520 A(K,I)[178]CSN[172]Q[170]SN[172]A(K,J)
  101. 530 A(K,J)[178][171]SN[172]Q[170]CSN[172]A(K,J)
  102. 540 Q[178]R(K,I)
  103. 550 R(K,I)[178]CSN[172]Q[170]SN[172]R(K,J)
  104. 560 R(K,J)[178][171]SN[172]Q[170]CSN[172]R(K,J)
  105. 570 [130] K
  106. 580 [130] J
  107. 590 [130] I
  108. 591 [153]"---------------------------------------"
  109. 592 [139] CT[178]1 [167] [152]4,"---------------------------------------"
  110. 600 [139] CT[178]1 [167] [152]4,"NUSWEEP="NUSWEEP,"NSKIP="NSKIP
  111. 601 [153] "NUSWEEP="NUSWEEP,"NSKIP="NSKIP
  112. 602 [143] CALL SUBROUTINE TO PRINT A
  113. 603 [153]:[153]"THE MODIFIED MATRIX A IS:"
  114. 604 [153]
  115. 605 [139] CT[178]1 [167] [152]4,:[139] CT[178]1 [167] [152]4,"THE MODIFIED MATRIX A IS:"
  116. 606 [139] CT[178]1 [167] [152]4,
  117. 607 [141] 3010
  118. 609 NUSWEEP[178]NUSWEEP[170]1
  119. 610 [139] NUSWEEP[177]50 [167] [137] 630
  120. 620 [139] NSKIP[179]N[172](N[171]1)[173]2 [167] [137] 240
  121. 630 [143] PRINT FINAL SWEEP VALUES
  122. 631 [153]"---------------------------------------"
  123. 632 [139] CT[178]1 [167] [152]4,"---------------------------------------"
  124. 633 [153]"NUSWEEP="NUSWEEP,"NSKIP="NSKIP:[153]
  125. 634 [139] CT[178]1 [167] [152]4,"NUSWEEP="NUSWEEP,"NSKIP="NSKIP:[139] CT[178]1 [167] [152]4,
  126. 635 [153]"THE MODIFIED MATRIX A IS:":[153]
  127. 636 [139] CT[178]1 [167] [152]4,"THE MODIFIED MATRIX A IS:":[139] CT[178]1 [167] [152]4,
  128. 637 [141] 3010
  129. 640 [143] CHECK EIGENVALUES
  130. 641 [141] 4000
  131. 642 [143] PRINT EIGENVALUES
  132. 643 [141] 5000
  133. 645 [143] PRINT EIGENVALUES
  134. 646 [153]"THE EIGENVALUES ARE:"
  135. 647 [139] CT[178]1 [167] [152]4,"THE EIGENVALUES ARE:"
  136. 648 [153]
  137. 649 [139] CT[178]1 [167] [152]4,
  138. 650 [129] J[178]1 [164] N%
  139. 660 [153] J,A(J,J)
  140. 661 [139] CT[178]1 [167] [152]4,J,A(J,J)
  141. 670 [130] J
  142. 671 [153]
  143. 672 [139] CT[178]1 [167] [152]4,
  144. 681 [143] PRINT EIGENVECTORS
  145. 682 [153]"THE EIGENVECTORS ARE:":[153]
  146. 683 [139] CT[178]1 [167] [152]4,"THE EIGENVECTORS ARE:":[139] CT[178]1 [167] [152]4,
  147. 690 [129] I[178]1 [164] N%
  148. 700 [129] J[178]1 [164] N%
  149. 710 [153] R(I,J);" ";
  150. 711 [139] CT[178]1 [167] [152]4,R(I,J);" ";
  151. 720 [130] J
  152. 730 [139] CT[178]1 [167] [152]4,
  153. 731 [153]
  154. 740 [130] I
  155. 2990 [128]
  156. 2998 [143] **************************
  157. 2999 [143]     SUBROUTINE PRINT A
  158. 3000 [143] **************************
  159. 3004 [153]"THE MATRIX A IS:":[153]
  160. 3005 [139] CT[178]1 [167] [152]4,"THE MATRIX A IS:":[139] CT[178]1 [167] [152]4,
  161. 3010 [129] C[178]1 [164] N%
  162. 3012 [129] B[178]1 [164] N%
  163. 3020 [139] CT[178]1 [167] [152]4,A(C,B);" ";
  164. 3021 [153] A(C,B);" ";
  165. 3025 [130] B
  166. 3026 [139] CT[178]1 [167] [152]4,
  167. 3027 [153]
  168. 3030 [130] C
  169. 3031 [139] CT[178]1 [167] [152]4,
  170. 3032 [153]
  171. 3035 [142]
  172. 4000 [143] ***************************
  173. 4010 [143] SUBROUTINE CHECK EIGENVALUE
  174. 4050 [143] ***************************
  175. 4051 [153]"***************************************"
  176. 4052 [139] CT[178]1 [167] [152]4,"***************************************"
  177. 4055 TC[178]0
  178. 4060 [129] G[178]1 [164] N%
  179. 4070 TC[178]TC[170]A(G,G)
  180. 4080 [130] G
  181. 4081 [153]"(AS A CHECK THESE SHOULD BE THE SAME)":[153]
  182. 4082 [139] CT[178]1 [167] [152]4,"(AS A CHECK THESE SHOULD BE THE SAME)"
  183. 4083 [139] CT[178]1 [167] [152]4,
  184. 4085 [153]"THE TRACE OF ORIGINAL A IS:"TR
  185. 4086 [153]"SUM OF A'S EIGENVALUES ARE:"TC:
  186. 4090 [139] CT[178]1 [167] [152]4,"THE TRACE OF ORIGINAL A IS:"TR
  187. 4095 [139] CT[178]1 [167] [152]4,"SUM OF A'S EIGENVALUES ARE:"TC
  188. 4096 [153]:[139] CT[178]1 [167] [152]4,
  189. 4099 [142]
  190. 5000 [143] ****************************
  191. 5010 [143] SUBROUTINE CHECK EIGENVECTOR
  192. 5020 [143] ****************************
  193. 5030 [143] FIND TRANSPOSE OF EIGENVECTORS
  194. 5040 [129] I[178]1 [164] N%
  195. 5050 [129] J[178]1 [164] N%
  196. 5060 XX(J,I)[178]R(I,J)
  197. 5070 [130] J
  198. 5080 [130] I
  199. 5100 [143] MULTIPLY I BY ITS TRANSPOSE
  200. 5150 [129] I[178]1 [164] N%
  201. 5200 [129] J[178]1 [164] N%
  202. 5210 SUM[178]0.0
  203. 5220 [129] K[178]1 [164] N%
  204. 5300 SUM[178]SUM[170](R(I,K)[172]XX(K,J))
  205. 5310 C(I,J)[178]SUM
  206. 5320 [130] K
  207. 5325 [130] J
  208. 5400 [130] I
  209. 5420 [139] CT[178]1 [167] [152]4,"(AS A CHECK THE FOLLOWING SHOULD BE ";
  210. 5430 [139] CT[178]1 [167] [152]4,"THE IDENTITY MATRIX)"
  211. 5500 [153]:[153]"(AS A CHECK THE FOLLOWING SHOULD BE THE IDENTITIY MATRIX)"
  212. 5600 [153]:[139] CT[178]1 [167] [152]4,
  213. 5700 [129] I[178]1 [164] N%
  214. 5710 [129] J[178]1 [164] N%
  215. 5720 [153] C(I,J);" ";
  216. 5725 [139] CT[178]1 [167] [152]4,C(I,J);" ";
  217. 5730 [130] J
  218. 5740 [153]
  219. 5745 [139] CT[178]1 [167] [152]4,
  220. 5750 [130] I
  221. 5751 [153]:[139] CT[178]1 [167] [152]4,
  222. 5800 [142]
  223. 6000 [143] *************************
  224. 6010 [143]  SUBROUTINE GRAPHIC A
  225. 6020 [143] *************************
  226. 6030 [153]"MATRIX A IS AS FOLLOWS:":[153]
  227. 6040 [153]" CHR$A(1,1) A(1,2) ....A(1,N)CHR$"
  228. 6050 [153]" CHR$A(2,1) A(2,2) ....A(2,N)CHR$"
  229. 6060 [153]" CHR$A(3,1) A(3,2) ....A(3,N)CHR$"
  230. 6070 [153]" CHR$   .      .          .  CHR$"
  231. 6080 [153]" CHR$   .      .          .  CHR$"
  232. 6090 [153]" CHR$   .      .          .  CHR$"
  233. 6095 [153]" CHR$A(N,1) A(N,2) ....A(N,N)CHR$"
  234. 7000 [153]:[142]
  235.