-
Notifications
You must be signed in to change notification settings - Fork 4
Expand file tree
/
Copy path1029.bas
More file actions
200 lines (167 loc) · 3.85 KB
/
Copy path1029.bas
File metadata and controls
200 lines (167 loc) · 3.85 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
'program to solve a matrix equation of the form [a]*[b]=[c]
'[a] is a known square matrix
'[b] is an unknown matrix with the same number of rows as [a] has columns
'[c] is a known matrix
'edit matrix size and element values below - data line = row
'known square matrix
ranka = 6:rowsc=ranka:rowsb=ranka
DATA 3,6,10,-6,14,-17
DATA 1,1,4,7,-11,3
DATA 2,1,1,-2,-4,2
DATA -3,4,-5,9,8,13
data 7,-7,3,5,-6,12
data -2,-14,16,18,5,6
'edit [c] size and element values below - data line = row
colsc=4:colsb=colsc
data -1,5,-1,4
data 9,-5,-6,9
data 2,5,3,1
DATA 1,-5,7,-3
data 1,9,7,-6,
data 7,6,5,-4
DIM coefs(ranka, ranka + 1): DIM deter(ranka, ranka)
DIM numbs(ranka + 1): DIM answers(ranka, ranka)
DIM matb(ranka,colsb): DIM matc(ranka,colsb): DIM temp(ranka)
DIM mata(ranka,ranka):DIM matd(ranka, colsb)
'calculate the inverse of [a] called [answers]
'load values into array
FOR tt = 1 TO ranka
FOR qq = 1 TO ranka
READ coefs(tt, qq)
mata(tt,qq)=coefs(tt,qq)
coefs(tt, ranka + 1) = 0
NEXT qq
NEXT tt
CLS
IF ranka = 2 THEN GOTO 300
'create working determinate
FOR rr = 1 TO ranka
FOR cc = 1 TO ranka
deter(rr, cc) = coefs(rr, cc)
NEXT cc
NEXT rr
'evaluate determinate denominator without substitution
GOSUB 1000
numbs(ranka + 1) = DIAG
'create unit column
FOR qq = 1 TO ranka
coefs(qq, ranka + 1) = 1
'begin unit column substitution
'ff sets columns
FOR ff = 1 TO ranka
'uu sets row qq, column ranka+1 to 0 or 1
FOR uu = 1 TO ranka
deter(uu, ff) = coefs(uu, ranka + 1)
NEXT uu
'sub to evaluate deter with substitution
GOSUB 1000
'numbs stores matrix value when column ff is 1
numbs(ff) = DIAG
NEXT ff
FOR zz = 1 TO ranka
answers(zz, qq) = numbs(zz) / numbs(ranka + 1)
NEXT zz
PRINT
coefs(qq, ranka + 1) = 0
NEXT qq
'load [c]
FOR jj = 1 TO ranka
for gg= 1 to colsc
READ matc(jj,gg)
next gg
NEXT jj
'echo matrix [c]
print "MATRIX c"
FOR x = 1 TO ranka
for y=1 to colsb
PRINT using "##.#### "; matc(x,y) ,
next y
print
NEXT x
print
'[a] inv * [c] = [b] the unknown
'outer loop selects matrix element
FOR rr = 1 TO ranka
for cc= 1 to colsb
'inner loop
FOR n = 1 TO ranka
matb(rr,cc) = matb(rr,cc)+answers(rr, n) * matc(n,cc)
NEXT n
next cc
NEXT rr
print "MATRIX b"
FOR x = 1 TO ranka
for y=1 to colsb
PRINT using "##.#### "; matb(x,y) ,
next y
print
NEXT x
'***********************************************************
'outer loop selects product matrix element
print
print " check: recalculate matrix c by [a]*[b]"
FOR rr = 1 TO ranka
FOR cc = 1 TO colsc
'inner loop uses factor matrices to compute product
FOR n = 1 TO ranka
matd(rr, cc) = matd(rr, cc) + mata(rr, n) * matb(n, cc)
NEXT n
NEXT cc
NEXT rr
FOR x = 1 TO ranka
FOR y = 1 TO colsc
print using "##.#### "; matd(x, y),
NEXT y
print
NEXT x
'************************************************************
GOTO 2000
'special case of 2x2
300 denom = coefs(1, 1) * coefs(2, 2) - coefs(1, 2) * coefs(2, 1)
FOR qq = 1 TO 2
'set 3rd column equal to one
coefs(qq, ranka + 1) = 1
answers(1, qq) = (coefs(1, 3) * coefs(2, 2) - coefs(1, 2) * coefs(2, 3)) / denom
answers(2, qq) = (coefs(1, 1) * coefs(2, 3) - coefs(1, 3) * coefs(2, 1)) / denom
PRINT
PRINT "Results for column "; qq
FOR zz = 1 TO ranka
PRINT
PRINT answers(zz, qq)
NEXT zz
coefs(qq, ranka + 1) = 0
NEXT qq
GOTO 2000
'evaluate deter
1000
s = 1
FOR row = 1 TO ranka - 1
'check for zeros on the diagonal
IF deter(row, row) <> 0 THEN GOTO 50
FOR r = 1 TO ranka
temp(r) = deter(r, row)
deter(r, row) = deter(r, row + 1)
deter(r, row + 1) = temp(r)
NEXT r
s = s * (-1)
'make constants zero in first col, second,...
50 FOR r = row TO ranka - 1
fact = deter(r + 1, row) / deter(row, row)
FOR col = 1 TO ranka
deter(r + 1, col) = deter(r + 1, col) - fact * deter(row, col)
NEXT col
NEXT r
NEXT row
'calculate the diagonal product
DIAG = s
FOR d = 1 TO ranka
DIAG = DIAG * deter(d, d)
NEXT d
'restore working deter
FOR rr = 1 TO ranka
FOR cc = 1 TO ranka
deter(rr, cc) = coefs(rr, cc)
NEXT cc
NEXT rr
RETURN
2000 END