' Determinant solver
' made by Svjatoslav Agejenko
' in 2002
' H-Page: svjatoslav.eu
' E-Mail: svjatoslav@svjatoslav.eu
 
DECLARE SUB mulr2 (a!, b!)
DECLARE SUB show2 ()
DECLARE SUB mulr (a!, b!)
DECLARE SUB mkback ()
DECLARE SUB sut (a!, b!, c!)
DECLARE SUB addz ()
DECLARE SUB tee ()
DECLARE SUB lihts ()
DECLARE SUB findz ()
DECLARE SUB addkord (a!, t!)
DECLARE SUB misjag ()
DECLARE SUB teejag (a!)
DECLARE SUB subjag (b!)
DECLARE SUB show ()
DECLARE SUB sisend ()
DECLARE SUB start ()

DIM SHARED siz
DIM SHARED det(1 TO 100, 1 TO 100)
DIM SHARED det2(1 TO 100, 1 TO 100)
DIM SHARED jau(1 TO 1000)
DIM SHARED jam
DIM SHARED kord(1 TO 100)
DIM SHARED kordt(1 TO 100)
DIM SHARED kordj
DIM SHARED zerol
DIM SHARED zerom
DIM SHARED zerot
DIM SHARED oli

start
tee

SUB addkord (a, t)
kordj = kordj + 1
kord(kordj) = a
kordt(kordj) = t
END SUB

SUB addz
'DIM SHARED zerol
'DIM SHARED zerom
'DIM SHARED zerot

IF zerot = 1 THEN
y = zerol
FOR x = 1 TO siz
a = det(x, y)
IF a <> 0 THEN
FOR x1 = x + 1 TO siz
b = det(x1, y)
IF b <> 0 THEN
sut a, b, c
mkback
IF a <> c THEN
mulr x, c / a
addkord c / a, 1
END IF
IF b <> c THEN
mulr x1, c / b
addkord c / b, 2
END IF
'show2
FOR y1 = 1 TO siz
det(x1, y1) = det2(x1, y1) - det2(x, y1)
NEXT y1
GOTO 7
END IF
NEXT x1
END IF
NEXT x




ELSE

x = zerol
FOR y = 1 TO siz
a = det(x, y)
IF a <> 0 THEN
FOR y1 = y + 1 TO siz
b = det(x, y1)
IF b <> 0 THEN
sut a, b, c
mkback
IF a <> c THEN
mulr2 y, c / a
addkord c / a, 1
END IF
IF b <> c THEN
mulr y1, c / b
addkord c / b, 2
END IF
'show2
FOR x1 = 1 TO siz
det(x1, y1) = det2(x1, y1) - det2(x1, y)
NEXT x1
GOTO 7
END IF
NEXT y1
END IF
NEXT y




END IF





7
PRINT "null lisatud"
show
END SUB

SUB findz
zerom = -1

'DIM SHARED zerol
'DIM SHARED zerom
'DIM SHARED zerot

FOR y = 1 TO siz
z = 0
FOR x = 1 TO siz
IF det(x, y) = 0 THEN z = z + 1
NEXT x
IF z > zerom THEN
zerol = y
zerot = 1
zerom = z
END IF
NEXT y

FOR x = 1 TO siz
z = 0
FOR y = 1 TO siz
IF det(x, y) = 0 THEN z = z + 1
NEXT y
IF z > zerom THEN
zerol = x
zerot = 2
zerom = z
END IF
NEXT x

'PRINT "max nulle", zerom

END SUB

SUB lihts
IF zerot = 1 THEN
y = zerol
FOR x = 1 TO siz
IF ABS(det(x, y)) > 0 THEN x1 = x: GOTO 3
NEXT x
3
addkord det(x1, y), 1
x4 = x1
y4 = y
ELSE
x = zerol
FOR y = 1 TO siz
IF ABS(det(x, y)) > 0 THEN y1 = y: GOTO 4
NEXT y
4
addkord det(x, y1), 1
x4 = x
y4 = y1
END IF

FOR y2 = 1 TO siz
FOR x2 = 1 TO siz
x3 = x2
y3 = y2
d = det(x3, y3)
IF x3 > x4 THEN x3 = x3 - 1
IF y3 > y4 THEN y3 = y3 - 1
det(x3, y3) = d
NEXT x2
NEXT y2

siz = siz - 1
PRINT "taandatult"
show

END SUB

SUB misjag
l = 0
FOR y = 1 TO siz
teejag det(1, y)
FOR x = 2 TO siz
subjag det(x, y)
NEXT x

IF jam > 0 THEN
s = -1
FOR a = 1 TO jam
IF jau(a) > s THEN s = jau(a)
NEXT a
FOR x = 1 TO siz
det(x, y) = det(x, y) / s
NEXT x
addkord s, 1
l = 1
END IF
NEXT y




FOR x = 1 TO siz
teejag det(x, 1)
FOR y = 2 TO siz
subjag det(x, y)
NEXT y

IF jam > 0 THEN
s = -1
FOR a = 1 TO jam
IF jau(a) > s THEN s = jau(a)
NEXT a
FOR y = 1 TO siz
det(x, y) = det(x, y) / s
NEXT y
addkord s, 1
l = 1
END IF
NEXT x


IF l = 1 THEN
PRINT "lihtsustatult"
show
END IF


END SUB

SUB mkback
FOR y = 1 TO siz
FOR x = 1 TO siz
det2(x, y) = det(x, y)
NEXT x
NEXT y
END SUB

SUB mulr (a, b)
FOR y = 1 TO siz
det2(a, y) = det2(a, y) * b
NEXT y
END SUB

SUB mulr2 (a, b)
FOR x = 1 TO siz
det2(x, a) = det2(x, a) * b
NEXT x
END SUB

SUB show
FOR a = 1 TO kordj
IF kordt(a) = 1 THEN PRINT " *";  ELSE PRINT " /";
PRINT STR$(kord(a));
NEXT a
PRINT " "

FOR y = 1 TO siz
FOR x = 1 TO siz
PRINT CHR$(9) + STR$(det(x, y));
NEXT x
PRINT " "
PRINT " "
NEXT y
a$ = INPUT$(1)
END SUB

SUB show2
FOR y = 1 TO siz
FOR x = 1 TO siz
PRINT CHR$(9) + STR$(det2(x, y));
NEXT x
PRINT " "
PRINT " "
NEXT y
a$ = INPUT$(1)

END SUB

SUB sisend
INPUT "sisesta determinandi suurus ", siz

FOR y = 1 TO siz
FOR x = 1 TO siz
PRINT "rida" + STR$(y) + "  veerg" + STR$(x)
INPUT det(x, y)
NEXT x
NEXT y

PRINT "sisestatud determinant"
show
END SUB

SUB start
WIDTH 80, 50
kordj = 0
END SUB

SUB subjag (b)
IF oli = 1 THEN teejag b: GOTO 2
IF jam = 0 THEN GOTO 2
a = 1
1
c = jau(a)
IF b / c <> INT(b / c) THEN
jau(a) = jau(jam)
jam = jam - 1
a = a - 1
END IF
a = a + 1
IF a <= jam THEN GOTO 1
2

END SUB

SUB sut (a, b, c)
c = a * b
END SUB

SUB tee
sisend
5
misjag

IF siz = 2 THEN
a = det(1, 1) * det(2, 2) - det(1, 2) * det(2, 1)
PRINT "vahepealne vastus oli:" + STR$(a)
FOR b = 1 TO kordj
IF kordt(b) = 1 THEN a = a * kord(b): c$ = "*" ELSE a = a / kord(b): c$ = "/"
PRINT c$ + STR$(kord(b)) + " = " + STR$(a) + " ";
NEXT b
PRINT " "
PRINT "vastus on:" + STR$(a)
GOTO 6
END IF

findz
IF zerom = siz THEN PRINT "vastus on: 0": GOTO 6
IF zerom = siz - 1 THEN
lihts
ELSE
addz
END IF
GOTO 5
6
END SUB

SUB teejag (a)
oli = 0
jam = 0
IF a = 0 THEN oli = 1: GOTO 8
FOR b = 2 TO ABS(a)
IF a / b = INT(a / b) THEN
jam = jam + 1
jau(jam) = b
END IF
NEXT b
8
END SUB