(* unitVector[dim,pos] : 単位ベクトル dim : ベクトルの次元 pos : 1 となる要素の場所 *) unitVector[dim_,dim_,_] := {} unitVector[pos_, dim_, pos_] := Prepend[unitVector[pos + 1, dim, pos], 1] unitVector[row_, dim_, pos_] := Prepend[unitVector[row + 1, dim, pos], 0] unitVector[dim_, pos_] := unitVector[0,dim,pos-1] (* unitVector[4, 2] -> { 0, 1, 0, 0 } *) (* unitMatrix[dim] : 単位行列 dim : 行列の次元 unitMatrix[line,dim] : dim 次元の単位行列の下から line 行分 dim : 行列の次元 *) unitMatrix[0, _] := {} unitMatrix[line_, dim_] := Prepend[unitMatrix[line - 1, dim], unitVector[dim,dim - line + 1]] unitMatrix[dim_] := unitMatrix[dim, dim] (* unitMatrix[4] -> { { 1, 0, 0, 0 }, { 0, 1, 0, 0 }, { 0, 0, 1, 0 }, { 0, 0, 0, 1 } } *) (* replaceAt[vect,pos,new] : vect の pos の要素を new に置き換える vect : 置き換える前のリスト pos : 置き換える場所 new : 置き換える新しい式 *) replaceAt[vect_,1,new_] := Prepend[Rest[vect],new] replaceAt[vect_,pos_,new_] := Prepend[replaceAt[Rest[vect],pos-1,new],First[vect]] (* replaceAt[{1, 2, 3, 4}, 3, 100] -> {1, 2, 100, 4} *) (* replaceAt[matrix,row,col,new] : matrix の row, col の要素を new に置き換える matrix : 置き換える前の行列 pos : 置き換える場所 new : 置き換える新しい式 *) replaceAt[matrix_,row_,col_,new_] := replaceAt[matrix,row,replaceAt[matrix[[ row]],col,new]] (* replaceAt[unitMatrix[4], 2, 3, 10] -> {{1, 0, 0, 0}, {0, 1, 10, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}} *) (* replaceAt[matrix,newList] : matrix の複数部分を置き換える matrix : 置き換える前の行列 newList : 置き換える新しい式の場所と値のリスト *) replaceAt[matrix_,{}] := matrix replaceAt[matrix_,newList_] := replaceAt[replaceAt[matrix,First[newList][[1]],First[newList][[2]],First[newList][[3]]],Rest[newList]] (* replaceAt[unitMatrix[4], {{1,1,0},{2,2,0},{1,2,1},{2,1,1}}] -> {{0, 1, 0, 0}, {1, 0, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}} *) (* primitiveP[dim,i,j] : 基本行列 P(i,j) dim : 次元 i : 交換する一つ目の場所 j : 交換する二つ目の場所 *) primitiveP[dim_,i_,j_] := replaceAt[unitMatrix[dim], {{i,i,0},{j,j,0},{i,j,1},{j,i,1}}] (* primitiveP[4,1,2] -> {{0, 1, 0, 0}, {1, 0, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}} *) (* primitiveQ[dim,i,c] : 基本行列 Q(i;c) dim : 次元 i : 定数倍する場所 c : 定数倍の値 *) primitiveQ[dim_,i_,c_] := replaceAt[unitMatrix[dim], i, i, c] (* primitiveQ[4,2,9] -> {{1, 0, 0, 0}, {0, 9, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}} *) (* primitiveR[dim,i,j,c] : 基本行列 R(i,j;c) dim : 次元 i,j : 変更する場所 c : 定数倍の値 *) primitiveR[dim_,i_,j_,c_] := replaceAt[unitMatrix[dim], i, j, c] (* primitiveR[4,2,3,9] -> {{1, 0, 0, 0}, {0, 1, 9, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}} *) (* primitiveOpRP[matrix,i,j] : 行の交換 matrix : 操作する行列 i, j : 交換する行の番号 *) primitiveOpRP[matrix_,i_,j_] := primitiveP[Length[matrix],i,j] . matrix (* testMatrix = { { 11, 12, 13, 14 }, { 21, 22, 23, 24 }, { 31, 32, 33, 34 }, { 41, 42, 43, 44 } } *) (* primitiveOpRP[testMatrix,2,4] -> {{11, 12, 13, 14}, {41, 42, 43, 44}, {31, 32, 33, 34}, {21, 22, 23, 24}} *) (* primitiveOpLP[matrix,i,j] : 列の交換 matrix : 操作する行列 i, j : 交換する列の番号 *) primitiveOpLP[matrix_,i_,j_] := matrix . primitiveP[Length[matrix],i,j] (* MatrixForm[testMatrix] MatrixForm[primitiveOpLP[testMatrix,2,4]] -> {{11, 14, 13, 12}, {21, 24, 23, 22}, {31, 34, 33, 32}, {41, 44, 43, 42}} *) (* primitiveOpRQ[matrix,i,c] : 行の定数倍 matrix : 操作する行列 i : 定数倍する行の番号 c : 定数倍の大きさ *) primitiveOpRQ[matrix_,i_,c_] := primitiveQ[Length[matrix],i,c] . matrix (* primitiveOpRQ[testMatrix,2,4] -> {{11, 12, 13, 14}, {84, 88, 92, 96}, {31, 32, 33, 34}, {41, 42, 43, 44}} *) (* primitiveOpLQ[matrix,i,j] : 列の定数倍 matrix : 操作する行列 i : 定数倍する列の番号 c : 定数倍の大きさ *) primitiveOpLQ[matrix_,i_,c_] := matrix . primitiveQ[Length[matrix],i,c] (* MatrixForm[primitiveOpLQ[testMatrix,2,4]] -> {{11, 48, 13, 14}, {21, 88, 23, 24}, {31, 128, 33, 34}, {41, 168, 43, 44}} *) (* primitiveOpRR[matrix,i,j,c] : 行の定数倍を加える matrix : 操作する行列 i : 加えられる行の番号 j : 定数倍して加える行の場号 c : 定数倍の大きさ *) primitiveOpRR[matrix_,i_,j_,c_] := primitiveR[Length[matrix],i,j,c] . matrix (* primitiveOpRR[testMatrix,1,3,100] -> {{3111, 3212, 3313, 3414}, {21, 22, 23, 24}, {31, 32, 33, 34}, {41, 42, 43, 44}} *) (* primitiveOpLR[matrix,i,j,c] : 列の定数倍を加える matrix : 操作する行列 i : 定数倍して加える行の場号 j : 加えられる行の番号 c : 定数倍の大きさ *) primitiveOpLR[matrix_,i_,j_,c_] := matrix . primitiveR[Length[matrix],i,j,c] (* MatrixForm[primitiveOpLR[testMatrix,1,3,100]] -> {{11, 12, 1113, 14}, {21, 22, 2123, 24}, {31, 32, 3133, 34}, {41, 42, 4143, 44}} *) (* selectAix[matrix,i] : 枢軸選び matrix : 枢軸選びの対象となる行列 i : 枢軸にする場所 (i,i) 要素 もし、枢軸がなければ、 -1 を返す *) selectAix[matrix_, i_] := selectAix[matrix, i, i, Length[matrix] + 1] selectAix[matrix_, i_, dim_, dim_] := -1 selectAix[matrix_, i_, j_, dim_] := If[Part[Part[matrix, j], i] == 0, selectAix[matrix, i, j + 1, dim], j] (* selectAix[{{1,2,3,4},{0,0,5,6},{0,0,7,8},{0,9,10,11}},2] selectAix[{{1,2,3,4},{0,0,5,6},{0,0,7,8},{0,0,10,11}},2] *) (* doSelectAix[matrix,i] : 枢軸選びの実行 matrix : 枢軸選びの対象となる行列 i : 枢軸にする場所 (i,i) 要素 もし、枢軸があれば、行を交換する。なければ {} になる。 *) doSelectAix[matrix_,i_] := If[ selectAix[matrix,i] == -1, {}, If[selectAix[matrix,i] == i, matrix, primitiveOpRP[matrix,i,selectAix[matrix,i]]]] (* doSelectAix[{{1,2,3,4},{0,0,5,6},{0,0,7,8},{0,9,10,11}},2] doSelectAix[{{1,2,3,4},{0,0,5,6},{0,0,7,8},{0,0,10,11}},2] *) (* doNormalDiag[matrix,i] : 対角要素を1にする matrix : 枢軸選びの対象となる行列 i : 1 にする場所 (i,i) 要素 対角要素が 0 の場合は {} となる *) doNormalDiag[matrix_,i_] := If[ Part[Part[matrix, i], i] == 0, {}, primitiveOpRQ[matrix,i,1/Part[Part[matrix,i],i]]] (* doNormalDiag[{{1,2,3,4},{0,0,5,6},{0,0,7,8},{0,0,10,11}},2] doNormalDiag[{{1,2,3,4},{0,0,5,6},{0,0,7,8},{0,9,10,11}},3] *) (* doClearElements[matrix,i] : i 番目の対角要素の下の要素を払う matrix : 枢軸選びの対象となる行列 i : 払う軸 対角要素が 0 の場合は {} となる *) doClearElements[matrix_,i_] := If[ Part[Part[matrix,i],i] == 0, {}, doClearElements[matrix,i,i+1,Length[matrix]+1]] doClearElements[matrix_,i_,j_,j_] := matrix doClearElements[matrix_,i_,j_,dim_] := primitiveOpRR[ doClearElements[matrix,i,j+1,dim], j, i, -Part[Part[matrix,j],i]] (* doClearElements[{{1,2,3,4},{2,3,4,5},{3,4,5,6},{4,5,6,7}},1] *) (* q1 = {{1,2,3,4},{2,3,4,5},{3,4,5,6},{4,5,6,7}} q2 = {{-2, -4, -6, -8}, {2, 4, 4, 0}, {2, 2, 8, 4}, {-1, -2, 0, 9}} *)