<> <> DIRECTORY Rope, Basics, Atom, Ascii, Convert, IO, AlgebraClasses, Structures, MathConstructors, MathExpr, Bools, Ints, Matrices; MatricesImpl: CEDAR PROGRAM IMPORTS Rope, IO, Convert, AlgebraClasses, Structures, Ints, MathConstructors EXPORTS Matrices = BEGIN OPEN AC: AlgebraClasses, Matrices; <> ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Object: TYPE = AC.Object; Method: TYPE = AC.Method; <> SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE; BadElementStructure: PUBLIC ERROR [elementStructure: Object] = CODE; CantInvertError: PUBLIC ERROR [elementStructure: Object] = CODE; TypeError: PUBLIC ERROR [message: ATOM _ $Unspecified] = CODE; <> MakeMatrixStructure: PUBLIC AC.MatrixStructureConstructor ~ { matrixStructureData: MatrixStructureData _ NEW[MatrixStructureDataRec _ [ elementStructure: elementStructure, nRows: nRows, nCols: nCols ] ]; method: Method _ AC.LookupMethodInStructure[$category, elementStructure]; category: REF AC.Category _ NARROW[method.value]; IF nRows#nCols OR category^=group THEN matrixStructure _ AC.MakeStructure[ name: NIL, class: matrixClass, instanceData: matrixStructureData ] ELSE SELECT category^ FROM -- assumes square matrices ring, algebra => matrixStructure _ AC.MakeStructure[ name: NIL, class: squareMatricesOverRingClass, instanceData: matrixStructureData ]; field, divisionAlgebra => matrixStructure _ AC.MakeStructure[ name: NIL, class: squareMatricesOverFieldClass, instanceData: matrixStructureData ]; ENDCASE => ERROR BadElementStructure[elementStructure]; matrixStructure.name _ ShortPrintName[matrixStructure]; IF AC.LookupStructure[matrixStructure.name] = NIL THEN AC.InstallStructure[matrixStructure]; }; <> <> <> <> <<" x ",>> <> <<" Matrices over ",>> <> <<] ];>> <<};>> ShortPrintName: PUBLIC AC.ToRopeOp = { data: MatrixStructureData _ NARROW[in.data]; shortPrintNameMethod: Method _ AC.LookupMethodInStructure[$shortPrintName, data.elementStructure]; RETURN[Rope.Cat[ Rope.Cat[ "M", Convert.RopeFromCard[data.nRows], ",", Convert.RopeFromCard[data.nCols] ], "(", NARROW[AC.ApplyNoLkpNoRecastRef[shortPrintNameMethod,LIST[data.elementStructure] ] ], ")" ] ]; }; <> <> <> <<}; >> <> <> <> <<}; >> <<>> IsMatrixStructure: PUBLIC AC.UnaryPredicate = { IF ~arg.flavor = Structure THEN RETURN[FALSE]; RETURN[ AC.LookupMethodInStructure[$matrixStructure, arg]#NIL ] }; <> Recast: PUBLIC AC.BinaryOp = { <> thisMatrixStructure: Object _ secondArg; thisMatrixStructureData: MatrixStructureData _ NARROW[thisMatrixStructure.data]; thisStructureElementStructure: Object _ thisMatrixStructureData.elementStructure; canRecastMethod: Method _ AC.LookupMethodInStructure[$canRecast, thisStructureElementStructure]; recastMethod: Method _ AC.LookupMethodInStructure[$recast, thisStructureElementStructure]; refBOOL: REF BOOL; <> IF AC.StructureEqual[firstArg.class, secondArg] THEN RETURN[firstArg]; -- nothing to do <> refBOOL _ NARROW[AC.ApplyNoLkpNoRecastRef[canRecastMethod,LIST[firstArg.class, thisStructureElementStructure] ] ]; IF refBOOL^ THEN { recastElement: Object _ AC.ApplyNoLkpNoRecastObject[recastMethod, LIST[firstArg, thisStructureElementStructure] ]; RETURN[DiagonalMatrix[recastElement, thisMatrixStructure] ]; }; <> IF AC.LookupMethodInStructure[$matrixStructure, firstArg.class]#NIL THEN { inputMatrixStructure: Object _ firstArg.class; inputMatrixStructureData: MatrixStructureData _ NARROW[inputMatrixStructure.data]; inputStructureElementStructure: Object _ inputMatrixStructureData.elementStructure; argData: MatrixData _ NARROW[firstArg.data]; resultData: MatrixData; IF inputMatrixStructureData.nRows # thisMatrixStructureData.nRows THEN RETURN[NIL]; IF inputMatrixStructureData.nCols # thisMatrixStructureData.nCols THEN RETURN[NIL]; refBOOL _ NARROW[AC.ApplyNoLkpNoRecastRef[canRecastMethod,LIST[inputStructureElementStructure, thisStructureElementStructure] ] ]; IF NOT refBOOL^ THEN RETURN[NIL]; result _ Create[thisMatrixStructure]; resultData _ NARROW[result.data]; FOR i:NAT IN [1..thisMatrixStructureData.nRows] DO FOR j:NAT IN [1..thisMatrixStructureData.nCols] DO resultData[i][j] _ AC.ApplyNoLkpNoRecastObject[recastMethod, LIST[argData[i][j], thisStructureElementStructure] ]; ENDLOOP; ENDLOOP; RETURN[result]; }; <> RETURN[NIL]; }; CanRecast: PUBLIC AC.BinaryPredicate = { <> thisMatrixStructure: Object _ secondArg; thisMatrixStructureData: MatrixStructureData _ NARROW[thisMatrixStructure.data]; thisStructureElementStructure: Object _ thisMatrixStructureData.elementStructure; canRecastMethod: Method _ AC.LookupMethodInStructure[$canRecast, thisStructureElementStructure]; refBOOL: REF BOOL; firstArgStructure: Object _ IF firstArg.flavor = StructureElement THEN firstArg.class ELSE IF firstArg.flavor = Structure THEN firstArg ELSE ERROR; <> IF AC.StructureEqual[firstArgStructure, thisMatrixStructure] THEN RETURN[TRUE]; <> refBOOL _ NARROW[AC.ApplyNoLkpNoRecastRef[canRecastMethod,LIST[firstArgStructure, thisStructureElementStructure] ] ]; IF refBOOL^ THEN RETURN[TRUE]; <> IF AC.LookupMethodInStructure[$matrixStructure, firstArgStructure]#NIL THEN { inputMatrixStructure: Object _ firstArgStructure; inputMatrixStructureData: MatrixStructureData _ NARROW[inputMatrixStructure.data]; inputStructureElementStructure: Object _ inputMatrixStructureData.elementStructure; IF inputMatrixStructureData.nRows # thisMatrixStructureData.nRows THEN RETURN[FALSE]; IF inputMatrixStructureData.nCols # thisMatrixStructureData.nCols THEN RETURN[FALSE]; refBOOL _ NARROW[AC.ApplyNoLkpNoRecastRef[canRecastMethod,LIST[inputStructureElementStructure, thisStructureElementStructure] ] ]; IF NOT refBOOL^ THEN RETURN[FALSE] ELSE RETURN[TRUE]; }; <> RETURN[FALSE]; }; ToExpr: PUBLIC AC.ToExprOp = { matrixData: MatrixData _ NARROW[in.data]; matrixStructureData: MatrixStructureData _ NARROW[in.class.data]; outMatrix: LIST OF LIST OF MathExpr.EXPR _ NIL; method: Method _ AC.LookupMethodInStructure[$toExpr, matrixStructureData.elementStructure]; FOR i:NAT DECREASING IN [1..matrixStructureData.nRows] DO outRow: LIST OF MathExpr.EXPR _ NIL; FOR j:NAT DECREASING IN [1..matrixStructureData.nCols] DO <> outRow _ CONS[NARROW[AC.ApplyNoLkpNoRecastRef[method, LIST[matrixData[i][j] ] ] ], outRow]; ENDLOOP; outMatrix _ CONS[outRow, outMatrix]; ENDLOOP; out _ MathConstructors.MakeMatrix[matrixStructureData.nRows, matrixStructureData.nCols, outMatrix]; }; LegalFirstChar: PUBLIC AC.LegalFirstCharOp = { SELECT char FROM '[ => RETURN[TRUE]; ENDCASE; RETURN[FALSE]; }; Read: PUBLIC AC.ReadOp = { data: MatrixStructureData _ NARROW[structure.data]; elementStructure: AC.Object _ data.elementStructure; puncChar: CHAR; rows: RowSeq _ NEW[RowSeqRec[data.nRows]]; readMethod: AC.Method _ AC.LookupMethodInStructure[$read, elementStructure]; []_ in.SkipWhitespace[]; puncChar _ in.GetChar[]; IF puncChar # '[ THEN ERROR SyntaxError[$LeftBracketExpected]; FOR i:NAT IN [1..data.nRows] DO row: Row _ NEW[RowRec[data.nCols]]; []_ in.SkipWhitespace[]; puncChar _ in.GetChar[]; IF puncChar # '[ THEN ERROR SyntaxError[$LeftBracketExpected]; FOR j:NAT IN [1..data.nCols] DO row[j] _ AC.ApplyReadMethod[readMethod, in, elementStructure]; []_ in.SkipWhitespace[]; puncChar _ in.GetChar[]; []_ in.SkipWhitespace[]; IF j < data.nCols THEN IF puncChar # ', THEN ERROR SyntaxError[$CommaExpected]; ENDLOOP; IF puncChar # '] THEN ERROR SyntaxError[$RightBracketExpected]; rows[i] _ row; puncChar _ in.GetChar[]; []_ in.SkipWhitespace[]; IF i < data.nRows THEN IF puncChar # ', THEN SyntaxError[$CommaExpected]; ENDLOOP; IF puncChar # '] THEN ERROR SyntaxError[$RightBracketExpected]; out _ NEW[AC.ObjectRec _ [flavor: StructureElement, class: structure, data: rows] ]; }; FromRope: PUBLIC AC.FromRopeOp = { stream: IO.STREAM _ IO.RIS[in]; out _ Read[stream, structure]; }; ToRope: PUBLIC AC.ToRopeOp = { data: MatrixData _ NARROW[in.data]; matrixStructureData: MatrixStructureData _ NARROW[in.class.data]; elementStructure: AC.Object _ matrixStructureData.elementStructure; toRopeMethod: AC.Method _ AC.LookupMethodInStructure[$toRope, elementStructure]; out _ "[ "; FOR i:NAT IN [1..matrixStructureData.nRows] DO out _ out.Concat["[ "]; FOR j:NAT IN [1..matrixStructureData.nCols] DO out _ out.Concat[NARROW[AC.ApplyNoLkpNoRecastRef[toRopeMethod, LIST[data[i][j] ] ] ] ]; IF j < matrixStructureData.nCols THEN out _ out.Concat[", "]; ENDLOOP; out _ out.Concat["] "]; IF i < matrixStructureData.nRows THEN out _ out.Concat[", "]; ENDLOOP; out _ out.Concat["] "]; }; Write: PUBLIC AC.WriteOp = { stream.PutF["\n %g \n", IO.rope[ToRope[in]] ]; }; <> DiagonalMatrix: PUBLIC AC.UnaryImbedOp ~ { <> matrixStructureData: MatrixStructureData _ NARROW[structure.data]; rows: RowSeq _ NEW[RowSeqRec[matrixStructureData.nRows]]; IF NOT AC.StructureEqual[in.class, matrixStructureData.elementStructure] THEN TypeError[]; -- check that we really are constructing an element of matrixStructure FOR i:NAT IN [1..matrixStructureData.nRows] DO rows[i] _ MostlyZeroRow[in, i, matrixStructureData.nCols]; ENDLOOP; out _ NEW[AC.ObjectRec _ [class: structure, flavor: StructureElement, data: rows] ]; }; MostlyZeroRow: PROC [element: Object, position, size: NAT] RETURNS [row: Row] ~ { <> zero: Object _ AC.ApplyLkpRecastObject[$zero, element.class, LIST[element.class] ]; row _ NEW[RowRec[size]]; FOR i:NAT IN [1..size] DO row[i] _ IF i = position THEN element ELSE zero; ENDLOOP; }; MakeMatrix: PUBLIC AC.MatrixImbedOp ~ { data: MatrixStructureData _ NARROW[structure.data]; nRows: NAT _ data.nRows; nCols: NAT _ data.nCols; rows: RowSeq _ NEW[RowSeqRec[nRows]]; FOR i:NAT IN [1..nRows] DO row: Row _ NEW[RowRec[nCols]]; FOR j:NAT IN [1..nCols] DO row[j] _ elements.first; elements _ elements.rest ENDLOOP; rows[i] _ row; ENDLOOP; out _ NEW[AC.ObjectRec _ [flavor: StructureElement, class: structure, data: rows] ]; }; <> Create: PROC [matrixStructure: Object] RETURNS [a: Matrix] = { data: MatrixData; matrixStructureData: MatrixStructureData _ NARROW[matrixStructure.data]; a _ NEW[AC.ObjectRec _ [ flavor: StructureElement, class: matrixStructure, data: NEW[RowSeqRec[matrixStructureData.nRows]] ] ]; data _ NARROW[a.data]; FOR i: NAT IN [1..matrixStructureData.nRows] DO data[i] _ NEW[RowRec[matrixStructureData.nCols]]; ENDLOOP; }; Zero: PUBLIC AC.NullaryOp = { matrixStructureData: MatrixStructureData _ NARROW[structure.data]; elementStructure: Object _ matrixStructureData.elementStructure; zeroMethod: Method _ AC.LookupMethodInStructure[$zero, elementStructure]; resultData: MatrixData; result _ Create[structure]; resultData _ NARROW[result.data]; FOR i:NAT IN [1..matrixStructureData.nRows] DO FOR j:NAT IN [1..matrixStructureData.nCols] DO resultData[i][j] _ AC.ApplyNoLkpNoRecastObject[zeroMethod, LIST[elementStructure] ]; ENDLOOP; ENDLOOP; }; One: PUBLIC AC.NullaryOp = { data: MatrixStructureData _ NARROW[structure.data]; oneMethod: Method _ AC.LookupMethodInStructure[$one, data.elementStructure]; RETURN[ DiagonalMatrix[ AC.ApplyNoLkpNoRecastObject[oneMethod, LIST[data.elementStructure] ], structure] ]; }; Add: PUBLIC AC.BinaryOp ~ { firstData: MatrixData _ NARROW[firstArg.data]; secondData: MatrixData _ NARROW[secondArg.data]; resultData: MatrixData; matrixStructureData: MatrixStructureData _ NARROW[firstArg.class.data]; result _ Create[firstArg.class]; resultData _ NARROW[result.data]; FOR i:NAT IN [1..matrixStructureData.nRows] DO FOR j:NAT IN [1..matrixStructureData.nCols] DO <> resultData[i][j] _ AC.ApplyLkpRecastObject[$sum, matrixStructureData.elementStructure, LIST[firstData[i][j], secondData[i][j] ] ]; ENDLOOP; ENDLOOP; }; Negate: PUBLIC AC.UnaryOp ~ { argData: MatrixData _ NARROW[arg.data]; resultData: MatrixData; matrixStructureData: MatrixStructureData _ NARROW[arg.class.data]; result _ Create[arg.class]; resultData _ NARROW[result.data]; FOR i:NAT IN [1..matrixStructureData.nRows] DO FOR j:NAT IN [1..matrixStructureData.nCols] DO <> resultData[i][j] _ AC.ApplyLkpRecastObject[$negation, matrixStructureData.elementStructure, LIST[argData[i][j]] ]; ENDLOOP; ENDLOOP; }; Subtract: PUBLIC AC.BinaryOp ~ { RETURN[ Add[ firstArg, Negate[ secondArg] ] ]; }; Multiply: PUBLIC AC.BinaryOp ~ { <> firstData: MatrixData _ NARROW[firstArg.data]; secondData: MatrixData _ NARROW[secondArg.data]; resultData: MatrixData; matrixStructureData: MatrixStructureData _ NARROW[firstArg.class.data]; <> zero: Object _ AC.ApplyLkpRecastObject[$zero, matrixStructureData.elementStructure, LIST[matrixStructureData.elementStructure] ]; result _ Create[firstArg.class]; resultData _ NARROW[result.data]; FOR i:NAT IN [1..matrixStructureData.nRows] DO FOR j:NAT IN [1..matrixStructureData.nCols] DO resultData[i][j] _ zero; FOR k:NAT IN [1..matrixStructureData.nCols] DO <> <> <> prod: Object _ AC.ApplyLkpRecastObject[$product, matrixStructureData.elementStructure, LIST[firstData[i][k], secondData[k][j]] ]; resultData[i][j] _ AC.ApplyLkpRecastObject[$sum, matrixStructureData.elementStructure, LIST[resultData[i][j], prod ] ]; ENDLOOP; ENDLOOP; ENDLOOP; }; Power: PUBLIC AC.BinaryOp ~ { -- this simple algorithm is Structure independent power: INT _ Ints.ToINT[secondArg]; structure: Object _ firstArg.class; one: Object _ AC.ApplyLkpNoRecastObject[$one, structure, LIST[structure] ]; productMethod: Method _ AC.LookupMethodInStructure[$product, structure]; IF power < 0 THEN { invertMethod: Method _ AC.LookupMethodInStructure[$invert, structure]; temp: Object; IF invertMethod = NIL THEN ERROR; temp _ Power[firstArg, Ints.FromINT[ABS[power] ] ]; RETURN[AC.ApplyNoLkpNoRecastObject[invertMethod, LIST[temp] ] ]; }; IF power = 0 THEN RETURN[one]; result _ firstArg; FOR i:INT IN [2..power] DO result _ AC.ApplyNoLkpNoRecastObject[productMethod, LIST[firstArg, result] ]; ENDLOOP; }; Invert: PUBLIC AC.UnaryOp ~ { resultData: MatrixData; matrixStructureData: MatrixStructureData _ NARROW[arg.class.data]; elementStructure: Object _ matrixStructureData.elementStructure; det: Object _ Determinant[arg]; tempVal: Object; scratchMatrixRing: Object _ MakeMatrixStructure[elementStructure, matrixStructureData.nRows - 1, matrixStructureData.nCols - 1]; Aij: Matrix _ Create[scratchMatrixRing]; <> IF NOT AC.IsCategory[elementStructure, field] AND NOT AC.IsCategory[elementStructure, divisionAlgebra] THEN ERROR CantInvertError[elementStructure]; result _ Create[arg.class]; resultData _ NARROW[result.data]; FOR i: NAT IN [1..matrixStructureData.nRows] DO FOR j: NAT IN [1..matrixStructureData.nCols] DO MakeAij[arg, Aij, i, j]; <> tempVal _ AC.ApplyLkpRecastObject[$fraction, matrixStructureData.elementStructure, LIST[Determinant[Aij], det ] ]; -- error will be generated here if Determinant[Aij] = 0 <> IF NOT Even[i + j] THEN tempVal _ AC.ApplyLkpRecastObject[$negation, matrixStructureData.elementStructure, LIST[tempVal ] ]; resultData[j][i] _ tempVal; ENDLOOP; ENDLOOP; RETURN[result]; }; Divide: PUBLIC AC.BinaryOp~ { RETURN[ Multiply[ firstArg, Invert[ secondArg] ] ]; }; <<>> ScalarMultiply: PUBLIC AC.BinaryOp~ { <> <> secondData: MatrixData _ NARROW[secondArg.data]; resultData: MatrixData; matrixStructureData: MatrixStructureData _ NARROW[secondArg.class.data]; elementStructure: Object _ matrixStructureData.elementStructure; recastMethod: Method _ AC.LookupMethodInStructure[$recast, elementStructure]; scalar: Object _ AC.ApplyNoLkpNoRecastObject[recastMethod, LIST[firstArg, elementStructure] ]; productMethod: Method _ AC.LookupMethodInStructure[$product, elementStructure]; IF scalar = NIL THEN TypeError[]; -- recast failed result _ Create[secondArg.class]; resultData _ NARROW[result.data]; FOR i:NAT IN [1..matrixStructureData.nRows] DO FOR j:NAT IN [1..matrixStructureData.nCols] DO resultData[i][j] _ AC.ApplyNoLkpNoRecastObject[productMethod, LIST[scalar, secondData[i][j] ] ]; ENDLOOP; ENDLOOP; }; Transpose: PUBLIC AC.UnaryOp ~ { argData: MatrixData _ NARROW[arg.data]; argStructureData: MatrixStructureData _ NARROW[arg.class.data]; resultData: MatrixData; nRows: NAT _ argStructureData.nRows; nCols: NAT _ argStructureData.nCols; resultStructure: Object _ MakeMatrixStructure[argStructureData.elementStructure, nCols, nRows]; result _ Create[resultStructure]; resultData _ NARROW[result.data]; FOR i: INTEGER IN [1..argStructureData.nRows] DO FOR j: INTEGER IN [1..argStructureData.nCols] DO resultData[j][i] _ argData[i][j]; ENDLOOP; ENDLOOP; RETURN[result]; }; MakeAij: PROC[a, Aij: Matrix, i,j: INTEGER] = { --assume Aij is well formed n, m: NAT _ 1; --row index, column index for new matrix firstData: MatrixData _ NARROW[a.data]; secondData: MatrixData _ NARROW[Aij.data]; matrixStructureData: MatrixStructureData _ NARROW[a.class.data]; FOR row: NAT IN [1..matrixStructureData.nRows] DO IF row = i THEN LOOP; --row index for original matrix m _ 1; FOR col: NAT IN [1..matrixStructureData.nCols] DO --column index for original matrix IF col = j THEN LOOP; secondData[n][m] _ firstData[row][col]; m _ m+1; ENDLOOP; n _ n+1; ENDLOOP; }; Even: PROC[I: NAT] RETURNS[BOOL] = {RETURN[I MOD 2 = 0]}; Determinant: PUBLIC AC.StructuredToGroundOp ~ { <> argData: MatrixData _ NARROW[structuredElt.data]; matrixStructureData: MatrixStructureData _ NARROW[structuredElt.class.data]; IF matrixStructureData.nRows = 1 THEN groundElement _ argData[1][1] <> <> <> ELSE IF matrixStructureData.nRows=2 THEN { prod1: Object _ AC.ApplyLkpRecastObject[$product, matrixStructureData.elementStructure, LIST[argData[1][1], argData[2][2] ] ]; prod2: Object _ AC.ApplyLkpRecastObject[$product, matrixStructureData.elementStructure, LIST[argData[1][2], argData[2][1] ] ]; groundElement _ AC.ApplyLkpRecastObject[$difference, matrixStructureData.elementStructure, LIST[prod1, prod2 ] ]; } ELSE { i, j: NAT; zero: Object _ AC.ApplyLkpRecastObject[$zero, matrixStructureData.elementStructure, LIST[matrixStructureData.elementStructure] ]; scratchMatrixRing: Object _ MakeMatrixStructure[matrixStructureData.elementStructure, matrixStructureData.nRows - 1, matrixStructureData.nCols - 1]; Aij: Matrix _ Create[scratchMatrixRing]; groundElement _ zero; j _ 1; --always use column 1 for now FOR i IN [1..matrixStructureData.nRows] DO tempVal: Object; MakeAij[structuredElt, Aij, i, j]; <> tempVal _ AC.ApplyLkpRecastObject[$product, matrixStructureData.elementStructure, LIST[argData[i][j], Determinant[Aij] ] ]; <> IF NOT Even[i + j] THEN tempVal _ AC.ApplyLkpRecastObject[$negation, matrixStructureData.elementStructure, LIST[tempVal ] ]; <> groundElement _ AC.ApplyLkpRecastObject[$sum, matrixStructureData.elementStructure, LIST[groundElement, tempVal ] ]; ENDLOOP; }; RETURN[groundElement]; }; <> Equal: PUBLIC AC.BinaryPredicate ~ { firstData: MatrixData _ NARROW[firstArg.data]; secondData: MatrixData _ NARROW[secondArg.data]; matrixStructureData: MatrixStructureData _ NARROW[firstArg.class.data]; elementEqualsMethod: Method _ AC.LookupMethodInStructure[$eqFormula, matrixStructureData.elementStructure]; FOR i: INTEGER IN [1..matrixStructureData.nRows] DO FOR j: INTEGER IN [1..matrixStructureData.nCols] DO IF NOT AC.ApplyPredNoLkpNoRecast[elementEqualsMethod, LIST[firstData[i][j], secondData[i][j] ] ] THEN RETURN[FALSE]; ENDLOOP; ENDLOOP; RETURN[TRUE]; }; <> ObjectAndIntDesired: PUBLIC AC.UnaryToListOp ~ { RETURN[ LIST[arg, Ints.Ints] ]; -- arg assumed to be a Matrix Structure }; MatrixAndElementDesired: PUBLIC AC.UnaryToListOp ~ { thisMatrixStructureData: MatrixStructureData _ NARROW[arg.data]; elementStructure: Object _ thisMatrixStructureData.elementStructure; RETURN[ LIST[arg, elementStructure] ]; -- arg assumed to be a Matrix Structure }; ElementAndMatrixDesired: PUBLIC AC.UnaryToListOp ~ { thisMatrixStructureData: MatrixStructureData _ NARROW[arg.data]; elementStructure: Object _ thisMatrixStructureData.elementStructure; RETURN[ LIST[elementStructure, arg] ]; -- arg assumed to be a Matrix Structure }; <> <> <> <> <<};>> <> <> <> <> <> <> <> <> <<] ];>> <<>> <> <> <> <> <> <> <> <> <> <> <<] ];>> matrixClass: AC.Object _ AC.MakeClass["MatrixClass", NIL, NIL]; squareMatricesOverRingClass: AC.Object _ AC.MakeClass["SquareMatricesOverRingClass", matrixClass, NIL]; -- squareMatricesOverRingClass is subclass[matrixClass] squareMatricesOverFieldClass: AC.Object _ AC.MakeClass["SquareMatricesOverFieldClass", squareMatricesOverRingClass, NIL]; -- squareMatricesOverFieldClass is subclass[squareMatricesOverRingClass] algebraCategoryMethod: Method _ AC.MakeMethod[Value, FALSE, NEW[AC.Category _ algebra], NIL, NIL]; ringCategoryMethod: Method _ AC.MakeMethod[Value, FALSE, NEW[AC.Category _ ring], NIL, NIL]; setCategoryMethod: Method _ AC.MakeMethod[Value, FALSE, NEW[AC.Category _ set], NIL, NIL]; matrixStructureMethod: Method _ AC.MakeMethod[Value, FALSE, NIL, NIL, "matrixStructure"]; shortPrintNameMethod: Method _ AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp _ ShortPrintName], NIL, "shortPrintName"]; recastMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Recast], NIL, "recast"]; canRecastMethod: Method _ AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate _ CanRecast], NIL, "canRecast"]; toExprMethod: Method _ AC.MakeMethod[ToExprOp, FALSE, NEW[AC.ToExprOp _ ToExpr], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "toExpr"]; legalFirstCharMethod: Method _ AC.MakeMethod[LegalFirstCharOp, FALSE, NEW[AC.LegalFirstCharOp _ LegalFirstChar], NIL, "legalFirstChar"]; readMethod: Method _ AC.MakeMethod[ReadOp, FALSE, NEW[AC.ReadOp _ Read], NIL, "read"]; fromRopeMethod: Method _ AC.MakeMethod[FromRopeOp, TRUE, NEW[AC.FromRopeOp _ FromRope], NIL, "fromRope"]; toRopeMethod: Method _ AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp _ ToRope], NIL, "toRope"]; diagonalMatrixMethod: Method _ AC.MakeMethod[UnaryImbedOp, TRUE, NEW[AC.UnaryImbedOp _ DiagonalMatrix], NIL, "diagonalMatrix"]; -- 4/17/87 recast procs need to be able to handle Structure args; could then have nonNIL DesiredArgStructures matrixMethod: Method _ AC.MakeMethod[MatrixImbedOp, FALSE, NEW[AC.MatrixImbedOp _ MakeMatrix], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "matrix"]; parenMethod: Method _ AC.MakeMethod[UnaryOp, FALSE, NEW[AC.UnaryOp _ AC.Copy], NIL, "paren"]; zeroMethod: Method _ AC.MakeMethod[NullaryOp, FALSE, NEW[AC.NullaryOp _ Zero], NIL, "zero"]; oneMethod: Method _ AC.MakeMethod[NullaryOp, FALSE, NEW[AC.NullaryOp _ One], NIL, "one"]; sumMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Add], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "sum"]; negationMethod: Method _ AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp _ Negate], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "negation"]; differenceMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Subtract], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "difference"]; productMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Multiply], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "product"]; powerMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Power], NEW[AC.UnaryToListOp _ ObjectAndIntDesired], "power"]; invertMethod: Method _ AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp _ Invert], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "invert"]; fractionMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Divide], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "divide"]; scalarProductMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ ScalarMultiply], NEW[AC.UnaryToListOp _ ElementAndMatrixDesired], "scalarProduct"]; equalMethod: Method _ AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate _ Equal], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "equals"]; transposeMethod: Method _ AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp _ Transpose], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "transpose"]; determinantMethod: Method _ AC.MakeMethod[StructuredToGroundOp, TRUE, NEW[AC.StructuredToGroundOp _ Determinant], NEW[AC.UnaryToListOp _ AC.DefaultDesiredArgStructures], "determinant"]; makeMatrixStructureMethod: Method _ AC.MakeMethod[MatrixStructureConstructor, FALSE, NEW[AC.MatrixStructureConstructor _ MakeMatrixStructure], NIL, "makeMatrixStructure"]; AC.AddMethodToClass[$matrixStructure, matrixStructureMethod, matrixClass]; AC.AddMethodToClass[$category, setCategoryMethod, matrixClass]; AC.AddMethodToClass[$shortPrintName, shortPrintNameMethod, matrixClass]; AC.AddMethodToClass[$recast, recastMethod, matrixClass]; AC.AddMethodToClass[$canRecast, canRecastMethod, matrixClass]; AC.AddMethodToClass[$toExpr, toExprMethod, matrixClass]; AC.AddMethodToClass[$legalFirstChar, legalFirstCharMethod, matrixClass]; AC.AddMethodToClass[$read, readMethod, matrixClass]; AC.AddMethodToClass[$fromRope, fromRopeMethod, matrixClass]; AC.AddMethodToClass[$toRope, toRopeMethod, matrixClass]; AC.AddMethodToClass[$matrix, matrixMethod, matrixClass]; AC.AddMethodToClass[$paren, parenMethod, matrixClass]; AC.AddMethodToClass[$zero, zeroMethod, matrixClass]; AC.AddMethodToClass[$sum, sumMethod, matrixClass]; AC.AddMethodToClass[$negation, negationMethod, matrixClass]; AC.AddMethodToClass[$difference, differenceMethod, matrixClass]; AC.AddMethodToClass[$transp, transposeMethod, matrixClass]; AC.AddMethodToClass[$eqFormula, equalMethod, matrixClass]; AC.AddMethodToClass[$category, ringCategoryMethod, squareMatricesOverRingClass]; AC.AddMethodToClass[$one, oneMethod, squareMatricesOverRingClass]; AC.AddMethodToClass[$diagonalMatrix, diagonalMatrixMethod, squareMatricesOverRingClass]; AC.AddMethodToClass[$product, productMethod, squareMatricesOverRingClass]; AC.AddMethodToClass[$pow, powerMethod, squareMatricesOverRingClass]; AC.AddMethodToClass[$det, determinantMethod, squareMatricesOverRingClass]; AC.AddMethodToClass[$scalarProduct, scalarProductMethod, squareMatricesOverRingClass]; AC.AddMethodToClass[$category, algebraCategoryMethod, squareMatricesOverFieldClass]; AC.AddMethodToClass[$invert, invertMethod, squareMatricesOverFieldClass]; AC.AddMethodToClass[$fraction, fractionMethod, squareMatricesOverFieldClass]; AC.AddMethodToClass[$makeMatrixStructure, makeMatrixStructureMethod, Structures.StructuresClass]; END.