math/determ.bas

   1 ' Determinant solver\r
   2 ' made by Svjatoslav Agejenko\r
   3 ' in 2002\r
   4 ' H-Page: svjatoslav.eu\r
   5 ' E-Mail: svjatoslavagejenko@gmail.com\r
   6  \r
   7 DECLARE SUB mulr2 (a!, b!)\r
   8 DECLARE SUB show2 ()\r
   9 DECLARE SUB mulr (a!, b!)\r
  10 DECLARE SUB mkback ()\r
  11 DECLARE SUB sut (a!, b!, c!)\r
  12 DECLARE SUB addz ()\r
  13 DECLARE SUB tee ()\r
  14 DECLARE SUB lihts ()\r
  15 DECLARE SUB findz ()\r
  16 DECLARE SUB addkord (a!, t!)\r
  17 DECLARE SUB misjag ()\r
  18 DECLARE SUB teejag (a!)\r
  19 DECLARE SUB subjag (b!)\r
  20 DECLARE SUB show ()\r
  21 DECLARE SUB sisend ()\r
  22 DECLARE SUB start ()\r
  23 \r
  24 DIM SHARED siz\r
  25 DIM SHARED det(1 TO 100, 1 TO 100)\r
  26 DIM SHARED det2(1 TO 100, 1 TO 100)\r
  27 DIM SHARED jau(1 TO 1000)\r
  28 DIM SHARED jam\r
  29 DIM SHARED kord(1 TO 100)\r
  30 DIM SHARED kordt(1 TO 100)\r
  31 DIM SHARED kordj\r
  32 DIM SHARED zerol\r
  33 DIM SHARED zerom\r
  34 DIM SHARED zerot\r
  35 DIM SHARED oli\r
  36 \r
  37 start\r
  38 tee\r
  39 \r
  40 SUB addkord (a, t)\r
  41 kordj = kordj + 1\r
  42 kord(kordj) = a\r
  43 kordt(kordj) = t\r
  44 END SUB\r
  45 \r
  46 SUB addz\r
  47 'DIM SHARED zerol\r
  48 'DIM SHARED zerom\r
  49 'DIM SHARED zerot\r
  50 \r
  51 IF zerot = 1 THEN\r
  52 y = zerol\r
  53 FOR x = 1 TO siz\r
  54 a = det(x, y)\r
  55 IF a <> 0 THEN\r
  56 FOR x1 = x + 1 TO siz\r
  57 b = det(x1, y)\r
  58 IF b <> 0 THEN\r
  59 sut a, b, c\r
  60 mkback\r
  61 IF a <> c THEN\r
  62 mulr x, c / a\r
  63 addkord c / a, 1\r
  64 END IF\r
  65 IF b <> c THEN\r
  66 mulr x1, c / b\r
  67 addkord c / b, 2\r
  68 END IF\r
  69 'show2\r
  70 FOR y1 = 1 TO siz\r
  71 det(x1, y1) = det2(x1, y1) - det2(x, y1)\r
  72 NEXT y1\r
  73 GOTO 7\r
  74 END IF\r
  75 NEXT x1\r
  76 END IF\r
  77 NEXT x\r
  78 \r
  79 \r
  80 \r
  81 \r
  82 ELSE\r
  83 \r
  84 x = zerol\r
  85 FOR y = 1 TO siz\r
  86 a = det(x, y)\r
  87 IF a <> 0 THEN\r
  88 FOR y1 = y + 1 TO siz\r
  89 b = det(x, y1)\r
  90 IF b <> 0 THEN\r
  91 sut a, b, c\r
  92 mkback\r
  93 IF a <> c THEN\r
  94 mulr2 y, c / a\r
  95 addkord c / a, 1\r
  96 END IF\r
  97 IF b <> c THEN\r
  98 mulr y1, c / b\r
  99 addkord c / b, 2\r
 100 END IF\r
 101 'show2\r
 102 FOR x1 = 1 TO siz\r
 103 det(x1, y1) = det2(x1, y1) - det2(x1, y)\r
 104 NEXT x1\r
 105 GOTO 7\r
 106 END IF\r
 107 NEXT y1\r
 108 END IF\r
 109 NEXT y\r
 110 \r
 111 \r
 112 \r
 113 \r
 114 END IF\r
 115 \r
 116 \r
 117 \r
 118 \r
 119 \r
 120 7\r
 121 PRINT "null lisatud"\r
 122 show\r
 123 END SUB\r
 124 \r
 125 SUB findz\r
 126 zerom = -1\r
 127 \r
 128 'DIM SHARED zerol\r
 129 'DIM SHARED zerom\r
 130 'DIM SHARED zerot\r
 131 \r
 132 FOR y = 1 TO siz\r
 133 z = 0\r
 134 FOR x = 1 TO siz\r
 135 IF det(x, y) = 0 THEN z = z + 1\r
 136 NEXT x\r
 137 IF z > zerom THEN\r
 138 zerol = y\r
 139 zerot = 1\r
 140 zerom = z\r
 141 END IF\r
 142 NEXT y\r
 143 \r
 144 FOR x = 1 TO siz\r
 145 z = 0\r
 146 FOR y = 1 TO siz\r
 147 IF det(x, y) = 0 THEN z = z + 1\r
 148 NEXT y\r
 149 IF z > zerom THEN\r
 150 zerol = x\r
 151 zerot = 2\r
 152 zerom = z\r
 153 END IF\r
 154 NEXT x\r
 155 \r
 156 'PRINT "max nulle", zerom\r
 157 \r
 158 END SUB\r
 159 \r
 160 SUB lihts\r
 161 IF zerot = 1 THEN\r
 162 y = zerol\r
 163 FOR x = 1 TO siz\r
 164 IF ABS(det(x, y)) > 0 THEN x1 = x: GOTO 3\r
 165 NEXT x\r
 166 3\r
 167 addkord det(x1, y), 1\r
 168 x4 = x1\r
 169 y4 = y\r
 170 ELSE\r
 171 x = zerol\r
 172 FOR y = 1 TO siz\r
 173 IF ABS(det(x, y)) > 0 THEN y1 = y: GOTO 4\r
 174 NEXT y\r
 175 4\r
 176 addkord det(x, y1), 1\r
 177 x4 = x\r
 178 y4 = y1\r
 179 END IF\r
 180 \r
 181 FOR y2 = 1 TO siz\r
 182 FOR x2 = 1 TO siz\r
 183 x3 = x2\r
 184 y3 = y2\r
 185 d = det(x3, y3)\r
 186 IF x3 > x4 THEN x3 = x3 - 1\r
 187 IF y3 > y4 THEN y3 = y3 - 1\r
 188 det(x3, y3) = d\r
 189 NEXT x2\r
 190 NEXT y2\r
 191 \r
 192 siz = siz - 1\r
 193 PRINT "taandatult"\r
 194 show\r
 195 \r
 196 END SUB\r
 197 \r
 198 SUB misjag\r
 199 l = 0\r
 200 FOR y = 1 TO siz\r
 201 teejag det(1, y)\r
 202 FOR x = 2 TO siz\r
 203 subjag det(x, y)\r
 204 NEXT x\r
 205 \r
 206 IF jam > 0 THEN\r
 207 s = -1\r
 208 FOR a = 1 TO jam\r
 209 IF jau(a) > s THEN s = jau(a)\r
 210 NEXT a\r
 211 FOR x = 1 TO siz\r
 212 det(x, y) = det(x, y) / s\r
 213 NEXT x\r
 214 addkord s, 1\r
 215 l = 1\r
 216 END IF\r
 217 NEXT y\r
 218 \r
 219 \r
 220 \r
 221 \r
 222 FOR x = 1 TO siz\r
 223 teejag det(x, 1)\r
 224 FOR y = 2 TO siz\r
 225 subjag det(x, y)\r
 226 NEXT y\r
 227 \r
 228 IF jam > 0 THEN\r
 229 s = -1\r
 230 FOR a = 1 TO jam\r
 231 IF jau(a) > s THEN s = jau(a)\r
 232 NEXT a\r
 233 FOR y = 1 TO siz\r
 234 det(x, y) = det(x, y) / s\r
 235 NEXT y\r
 236 addkord s, 1\r
 237 l = 1\r
 238 END IF\r
 239 NEXT x\r
 240 \r
 241 \r
 242 IF l = 1 THEN\r
 243 PRINT "lihtsustatult"\r
 244 show\r
 245 END IF\r
 246 \r
 247 \r
 248 END SUB\r
 249 \r
 250 SUB mkback\r
 251 FOR y = 1 TO siz\r
 252 FOR x = 1 TO siz\r
 253 det2(x, y) = det(x, y)\r
 254 NEXT x\r
 255 NEXT y\r
 256 END SUB\r
 257 \r
 258 SUB mulr (a, b)\r
 259 FOR y = 1 TO siz\r
 260 det2(a, y) = det2(a, y) * b\r
 261 NEXT y\r
 262 END SUB\r
 263 \r
 264 SUB mulr2 (a, b)\r
 265 FOR x = 1 TO siz\r
 266 det2(x, a) = det2(x, a) * b\r
 267 NEXT x\r
 268 END SUB\r
 269 \r
 270 SUB show\r
 271 FOR a = 1 TO kordj\r
 272 IF kordt(a) = 1 THEN PRINT " *";  ELSE PRINT " /";\r
 273 PRINT STR$(kord(a));\r
 274 NEXT a\r
 275 PRINT " "\r
 276 \r
 277 FOR y = 1 TO siz\r
 278 FOR x = 1 TO siz\r
 279 PRINT CHR$(9) + STR$(det(x, y));\r
 280 NEXT x\r
 281 PRINT " "\r
 282 PRINT " "\r
 283 NEXT y\r
 284 a$ = INPUT$(1)\r
 285 END SUB\r
 286 \r
 287 SUB show2\r
 288 FOR y = 1 TO siz\r
 289 FOR x = 1 TO siz\r
 290 PRINT CHR$(9) + STR$(det2(x, y));\r
 291 NEXT x\r
 292 PRINT " "\r
 293 PRINT " "\r
 294 NEXT y\r
 295 a$ = INPUT$(1)\r
 296 \r
 297 END SUB\r
 298 \r
 299 SUB sisend\r
 300 INPUT "sisesta determinandi suurus ", siz\r
 301 \r
 302 FOR y = 1 TO siz\r
 303 FOR x = 1 TO siz\r
 304 PRINT "rida" + STR$(y) + "  veerg" + STR$(x)\r
 305 INPUT det(x, y)\r
 306 NEXT x\r
 307 NEXT y\r
 308 \r
 309 PRINT "sisestatud determinant"\r
 310 show\r
 311 END SUB\r
 312 \r
 313 SUB start\r
 314 WIDTH 80, 50\r
 315 kordj = 0\r
 316 END SUB\r
 317 \r
 318 SUB subjag (b)\r
 319 IF oli = 1 THEN teejag b: GOTO 2\r
 320 IF jam = 0 THEN GOTO 2\r
 321 a = 1\r
 322 1\r
 323 c = jau(a)\r
 324 IF b / c <> INT(b / c) THEN\r
 325 jau(a) = jau(jam)\r
 326 jam = jam - 1\r
 327 a = a - 1\r
 328 END IF\r
 329 a = a + 1\r
 330 IF a <= jam THEN GOTO 1\r
 331 2\r
 332 \r
 333 END SUB\r
 334 \r
 335 SUB sut (a, b, c)\r
 336 c = a * b\r
 337 END SUB\r
 338 \r
 339 SUB tee\r
 340 sisend\r
 341 5\r
 342 misjag\r
 343 \r
 344 IF siz = 2 THEN\r
 345 a = det(1, 1) * det(2, 2) - det(1, 2) * det(2, 1)\r
 346 PRINT "vahepealne vastus oli:" + STR$(a)\r
 347 FOR b = 1 TO kordj\r
 348 IF kordt(b) = 1 THEN a = a * kord(b): c$ = "*" ELSE a = a / kord(b): c$ = "/"\r
 349 PRINT c$ + STR$(kord(b)) + " = " + STR$(a) + " ";\r
 350 NEXT b\r
 351 PRINT " "\r
 352 PRINT "vastus on:" + STR$(a)\r
 353 GOTO 6\r
 354 END IF\r
 355 \r
 356 findz\r
 357 IF zerom = siz THEN PRINT "vastus on: 0": GOTO 6\r
 358 IF zerom = siz - 1 THEN\r
 359 lihts\r
 360 ELSE\r
 361 addz\r
 362 END IF\r
 363 GOTO 5\r
 364 6\r
 365 END SUB\r
 366 \r
 367 SUB teejag (a)\r
 368 oli = 0\r
 369 jam = 0\r
 370 IF a = 0 THEN oli = 1: GOTO 8\r
 371 FOR b = 2 TO ABS(a)\r
 372 IF a / b = INT(a / b) THEN\r
 373 jam = jam + 1\r
 374 jau(jam) = b\r
 375 END IF\r
 376 NEXT b\r
 377 8\r
 378 END SUB\r
 379 \r