'<Main>
'Ä=Ž , Ö=™ , Ü=š ; ä=„ , ö=”, ü=� , ß=á ,§=õ , ©=¸, °=ø
'Tested with FB 0.17f using FBIde 0.4.6
'+------------------------------------------------------------------------------------------+
'|    Header: Bestimmen der Übergabeparameter                                               |
'|            AnzeigeCheck:|Il1 sind Alt-0124,Großes i,Kleines L, Eins                      |
Const Author="MatInv.Bas ¸2005 by Dipl.-Ing. J”rg Z�hlke, MD"'                              |
'|           (Tastenkombination: keine)                                                     |
'|                  HIER STEHT DAS EINZIGE GOTO VOM GANZEN PROGRAMM..                       |
'|    Zweck : MatrizenInversion, MatrizenMultiplikation und Determinantenberechnung         |
'|            (MatrizenAddition ist mir zu kompliziert..*vbg*)                              |
'|    Anm.: Sicherlich kein optimales Programm(es ist mein erstes(fast) freeBasic-Programm) |
'|    Quelle: Port von FORTRAN IV(~1980)[über Pascal und Vbs] nach FreeBasic                |
'+------------------------------------------------------------------------------------------+
	Declare Sub MatrixAusgeben(byVal Titel As String, C() As Double, byVal Vk As Short, byVal Nk As Integer) '..wie der Name schon sagt..
	Declare Function MatMul(A() As Double, B() As Double, C() As Double) As Byte 'Function zu MatrizenMultiplikation
	Declare Function MatInv(B() As Double) As Byte           'Function zu MatrizenInversion
	Declare Function dMpy(i As Integer, j As Integer, k As Integer, Links() As Double, Rechts() As Double) As Double 'Funktioniert nur mit Determinante ZUSAMMEN..
	Declare Function Determinante(A() As Double) As Double 'Function zur Determinantenberechnung
	Const vbSpc=" ", CrLf=!"\r\n", Esc=!"\27", False=0, True=Not False
	Const MaxMat=8
	Dim m As String, Vk As Short=3
	Dim As Integer Nk=5, iLA, iUA, i, j, XL
	Dim As Double A(), B(), E()
	Print "Matrizen-Inversion mit " &Author
	Print "Matrix automatisch erzeugen oder manuell eingeben (A/M)?";
	Do
		m=UCase(Inkey)
		Sleep 1
	Loop Until Instr("MA" &Esc, m)
	Print m
	Select Case m
		Case Esc
			End
		Case "A"
			Print "Eingebaute Matrix nehmen oder Zufallsmatrix (E/Z)?";
			Do
				m=UCase(Input(1))
			Loop Until Instr("EZ", m)
			Print m
			If m="E" Then iUA=6
		Case Else
			Randomize Timer
			Do
				Print "Dimension der Matrix A (2.." &MaxMat &"):";
				Input iUA
			Loop Until iUA>1 And iUA<=MaxMat
	End Select
	iUA-=1
	ReDim A(iUA, iUA), B(iUA, iUA)
	Data 0.659327444, 0.072983257, 0.979894657, 0.756750136, 0.25441669, 0.83763853
	Data 0.559241606, 0.523137874, 0.948388093, 0.330784887, 0.849705537, 0.169404574
	Data 0.933652887, 0.616332953, 0.217258497, 0.907022842, 0.082662047, 0.03529322
	Data 0.826041544, 0.765330767, 0.52478838, 0.158009727, 0.024860119, 0.36255325
	Data 0.846792095, 0.556488281, 0.48273207, 0.122986243, 0.059224104, 0.851249939
	Data 0.33697323, 0.625423359, 0.494137015, 0.130947714, 0.248825667, 0.928200963
	XL=0.146436546
	If m="M" Then
		Print "Normales Beispiel: iUA=3, Data 1,2,3,4,5,6,7,8,8 ergibt Determinante=3"
		Print "Noch ein Beispiel: iUA=3, Data 1,2,3,4,5,6,7,8,9 ergibt Determinante=0"
	End If
	For i=LBound(A) To iUA 'Eingabeschleife ist JETZT Okay
		For j=LBound(A) To iUA
			Select Case m
				Case "E"
					Read a(i, j)
					b(i, j)=a(i, j)
				Case "Z"
					a(i, j)=Rnd
					b(i, j)=a(i, j)
				Case Else
					Print "a[" &(i+1) &"," &(j+1) &"]:";
					Input(a(i, j))
					b(i, j)=a(i, j)
			End Select
		Next
	Next
	Print "Dimension=" &(iUA+1)
	MatrixAusgeben("Ausgangs-Matrix A(quadratisch, praktisch, gut..)", A(), Vk, Nk)
	Print "Die Determinante der AusgangsMatrix:" &Determinante(A())
	If m="E" Then ?"Hier zur Probe die XL-Determinante:" &XL
	If MatInv(B()) Then
		MatrixAusgeben("Inverse Matrix B (..dito..)", B(), vk, nk)
		If MatMul(A(), B(), E()) Then
			MatrixAusgeben("Einheits-Matrix E=A.B=B.A(..nur in der Hauptdiagonalen 1, Rest [ñ]0)", E(), 2, 0)
			Print "Die Inversion hat geklappt, wenn hier eine Einheitsmatrix berechnet wurde.."
			Print "(Grobe Probe: AufSummieren der MatrizenElemente ergibt Dimension der Matrix..)";
		Else
			Print "Ooops, Matrizen-Multiplikation geht nicht, Dimensionierung prüfen..";
			GetKey
		End If
	Else
		Print "Matrix singulär (Determinante=0, d.h. nicht invertierbar.. *vbg*)";
	End If
	GetKey
End
'</Main>

'<Subs&Functions>
Sub MatrixAusgeben(byVal Titel As String, C() As Double, byVal Vk As Short, byVal Nk As Integer)
	Dim As String m="+" &CrLf, Format="+" &String(Vk, "#")
	Dim As Integer i, j, iLC=LBound(C), iUC=UBound(C)
	Print Titel
	If Nk>0 Then Format+="." &String(Nk, "#")
		Format+=vbSpc
	For i=iLC To iUC
		For j=iLC To iUC
			Print Using Format;c(i, j);Mid(m, IIF(j=iUC, 1, 2), 1); 'IFF gibt es als Befehl gar nicht: Danke, Dusky_Joe
		Next
		Print
	Next
End Sub

Function MatMul(A() As Double, B() As Double, C() As Double) As Byte
	Dim As Integer iLA1=LBound(A, 1), iUA1=UBound(A, 1), iLA2=LBound(A, 2), iUA2=UBound(A, 2)
	Dim As Integer iUB1=UBound(B, 1), iLB2=LBound(B, 2), iUB2=UBound(B, 2) 'Diese Werte sind theoretisch(!!) richtig..
	Dim As Integer i, j, k
	If iUA2=iUB1 Then
		ReDim C(iUA1, iUB2)
		For i=iLA1 To iUA1 '..oder soll der jedesmal in der Schleife die Funktionen berechnen?
			For j=iLB2 To iUB2
				c(i, j)=0.0
				For k=iLA2 To iUB1
					c(i, j)+=a(i, k)*b(k, j)
				Next
			Next
		Next
	End If
	MatMul=iUA2=iUB1 'MatMul ist True, wenn die Dimensionierung stimmt..
End Function

Function MatInv(B() As Double) As Byte ' liefert False, wenn die Inversion nicht möglich ist, sonst True und die Inverse in B
	Dim d As Double
	Dim As Integer i, j, k, n, iLB=LBound(B), iUB=UBound(B)
	For i=iLB To iUB
		n=i-1
		Do
			n=n+1
			If n>iUB Then 'Matrix singulär.
				MatInv=False ' als Meldung speichern
				Exit Function '.. und ab dafür..
			End If
		Loop Until b(n, i)<>0.0
		k=n
		For j=iLB To iUB
      Swap b(i, j), b(k, j)
		Next
		b(i, i)=1.0/b(i, i)
		For j=iLB To iUB
			If j<>i Then b(i, j)*=b(i, i)
		Next
		For n=iLB To iUB
			If n<>i Then
				d=-b(n, i)
				b(n, i)=0.0
				For j=iLB To iUB
					b(n, j)+=d*b(i, j)
				Next
			End If
		Next
	Next
	MatInv=True 'jetzt müßte die Inversion geklappt haben..
End Function

Function Determinante(A() As Double) As Double 'Determinantenberechnung, das Original stand mal in mc..
	Dim As Integer i, j, k
	Dim As Integer iLA=LBound(A), iUA=UBound(A)
	Dim As Double Links(iUA, iUA), Rechts(iUA, iUA), d
	rechts(iLA, iLA)=1.0
	links(iLA, iLA)=A(iLA, iLA)
	For k=iLA To iUA-1
		If links(k, k)=0.0 Then Determinante=0.0:Exit Function
		i=k+1
		For j=iLA To k
			rechts(j, i)=(a(j, i)-dMpy(j-1, j, i, Links(), Rechts()))/links(j, j)
			links(i, j)=a(i, j)-dMpy(j-1, i, j, Links(), Rechts())
			links(i, i)=a(i, i)-dMpy(k, i, i, Links(), Rechts())
			rechts(i, i)=1.0
		Next
	Next
	d=1.0
	For i=iLA To iUA
		d*=links(i, i)
	Next
	Determinante=d 'Funktionsergebnis an den Namen zuweisen!!!
End Function

Function dMpy(i As Integer, j As Integer, k As Integer, Links() As Double, Rechts() As Double) As Double 'wird NUR von Determinante() benutzt..
	Dim m As Integer, d As Double
	For m=LBound(Links) To i
		d+=Links(j, m)*Rechts(m, k)
	Next
	Return d
End Function
'</Subs&Functions>