(* 1. rowreduce *) TNF[M_] := Module[ {A, n, m, r, c, p, i, j}, A = M; {n, m} = Dimensions[A]; r = 1; Do[ (* find pivot *) p = 0; Do[If[ A[[i, c]] =!= 0, p = i ], {i, r, n}]; If[ p != 0, (* pivot found *) {A[[p]], A[[r]]} = {A[[r]], A[[p]]}; (* change rows p and r *) A[[r]] = A[[r]]/A[[r, c]]; (* normalize pivot row *) (* eliminate using rth row *) Do[ Do[ A[[i, j]] = A[[i, j]] - A[[i, c]]A[[r, j]]; , {j, c + 1, m}]; A[[i, c]] = 0; , {i, r + 1, n}]; r += 1; ]; , {c, 1, m}]; (* back substitution *) Do[ c = 1; While[ c <= m && A[[r, c]] == 0, c++ ]; If[ c <= m, Do[ Do[ A[[i, j]] = A[[i, j]] - A[[i, c]]A[[r, j]]; , {j, c + 1, m}]; A[[i, c]] = 0; , {i, r - 1, 1, -1}]; ]; , {r, n, 1, -1}]; A ]; (* 2. ker and coker*) Ker[M_] := Module[ {A, idx, n}, A = DeleteCases[TNF[M], {0..}]; n = Length[First[A]]; (* assuming M was not the zero matrix *) idx = {}; Do[ If[ i > Length[A] || A[[i, i]] == 0, A = Join[Take[A, i-1], {-IdentityMatrix[n][[i]]}, Drop[A, i-1]]; AppendTo[idx, i]; ]; , {i, 1, n}]; Extract[Transpose[A], List /@ idx] ]; Coker[M_] := Ker[Transpose[M]] (* 3. Matrixinverse *) MatrixInverse[M_] := Module[ {n, A}, n = Length[M]; If[ Dimensions[M] =!= {n, n}, Return[\$Failed] ]; A = TNF[Join[M, IdentityMatrix[n], 2]]; If[ MatchQ[Take[Last[A], n], {0..}], Return[\$Failed] ]; Take[#, -n]& /@ A ]; (* 4. basis und dimension *) Basis[V_] := DeleteCases[TNF[V], {0..}]; (* standardbasis *) Dim[V_] := Length[Basis[V]]; (* 5. vektorraumvergleiche *) IstGleich[U1_, U2_] := (Basis[U1] === Basis[U2]) (* !! *) IstUnterraum[U_, V_] := (Basis[Join[U, V]] === Basis[V]) IstElement[u_, V_] := IstUnterraum[{u}, V] IstDirekt[U1_, U2_] := (Dim[Join[U1, U2]] == Dim[U1] + Dim[U2]) (* 6. schnitt und summe *) Summe[U1_, U2_] := Basis[Join[U1, U2]] Schnitt[U1_, U2_] := Module[ {K}, K = Take[#, Length[U1]]& /@ Ker[Transpose[Join[U1, U2]]]; Table[Sum[k[[i]]U1[[i]], {i, 1, Length[k]}], {k, K}] ]; (* 7. komplementaerraum *) Komplementaer[U_] := Module[ {A, n, idx}, A = TNF[U]; n = Length[First[A]]; (* assuming A was not the zero matrix *) idx = {}; Do[ If[ i > Length[A] || A[[i, i]] == 0, A = Join[Take[A, i-1], {-IdentityMatrix[n][[i]]}, Drop[A, i-1]]; AppendTo[idx, i]; ]; , {i, 1, n}]; Extract[IdentityMatrix[n], List /@ idx] ]; Komplementaer[U_, V_] := If[ IstUnterraum[U, V], Schnitt[Komplementaer[U], V], \$Failed ]