1 2(SDEFUN |SMATCAT-;positivePower| ((|x| S) (|n| |Integer|) ($ S)) 3 (SPROG ((|y| (S))) 4 (SEQ 5 (COND ((EQL |n| 1) |x|) 6 ((ODDP |n|) 7 (SPADCALL |x| (|SMATCAT-;positivePower| |x| (- |n| 1) $) 8 (QREFELT $ 11))) 9 ('T 10 (SEQ 11 (LETT |y| 12 (|SMATCAT-;positivePower| |x| (QUOTIENT2 |n| 2) 13 $)) 14 (EXIT (SPADCALL |y| |y| (QREFELT $ 11))))))))) 15 16(SDEFUN |SMATCAT-;^;SNniS;2| ((|x| S) (|n| |NonNegativeInteger|) ($ S)) 17 (COND ((ZEROP |n|) (SPADCALL (|spadConstant| $ 12) (QREFELT $ 13))) 18 ('T (|SMATCAT-;positivePower| |x| |n| $)))) 19 20(SDEFUN |SMATCAT-;coerce;RS;3| ((|r| R) ($ S)) (SPADCALL |r| (QREFELT $ 13))) 21 22(SDEFUN |SMATCAT-;differentiate;SMS;4| ((|x| S) (|d| |Mapping| R R) ($ S)) 23 (SPADCALL |d| |x| (QREFELT $ 18))) 24 25(SDEFUN |SMATCAT-;diagonal;SRow;5| ((|x| S) ($ |Row|)) 26 (SPROG 27 ((#1=#:G426 NIL) (|i| NIL) (#2=#:G427 NIL) (|j| NIL) (#3=#:G428 NIL) 28 (|k| NIL) (|v| (|Vector| R))) 29 (SEQ (LETT |v| (MAKEARR1 (QREFELT $ 7) (|spadConstant| $ 20))) 30 (SEQ (LETT |k| (SPADCALL |v| (QREFELT $ 27))) 31 (LETT #3# (QVSIZE |v|)) 32 (LETT |j| (SPADCALL |x| (QREFELT $ 24))) 33 (LETT #2# (SPADCALL |x| (QREFELT $ 25))) 34 (LETT |i| (SPADCALL |x| (QREFELT $ 22))) 35 (LETT #1# (SPADCALL |x| (QREFELT $ 23))) G190 36 (COND ((OR (> |i| #1#) (> |j| #2#) (> |k| #3#)) (GO G191))) 37 (SEQ 38 (EXIT 39 (QSETAREF1O |v| |k| (SPADCALL |x| |i| |j| (QREFELT $ 28)) 40 1))) 41 (LETT |i| 42 (PROG1 (+ |i| 1) 43 (LETT |j| (PROG1 (+ |j| 1) (LETT |k| (+ |k| 1)))))) 44 (GO G190) G191 (EXIT NIL)) 45 (EXIT (SPADCALL |v| (QREFELT $ 29)))))) 46 47(SDEFUN |SMATCAT-;retract;SR;6| ((|x| S) ($ R)) 48 (COND 49 ((SPADCALL |x| (QREFELT $ 32)) 50 (SPADCALL (SPADCALL |x| (QREFELT $ 33)) (QREFELT $ 34))) 51 ('T (|error| "Not retractable")))) 52 53(SDEFUN |SMATCAT-;retractIfCan;SU;7| ((|x| S) ($ |Union| R "failed")) 54 (COND 55 ((SPADCALL |x| (QREFELT $ 32)) 56 (SPADCALL (SPADCALL |x| (QREFELT $ 33)) (QREFELT $ 37))) 57 ('T (CONS 1 "failed")))) 58 59(SDEFUN |SMATCAT-;equation2R| ((|v| |Vector| S) ($ |Matrix| R)) 60 (SPROG 61 ((#1=#:G441 NIL) (|j| NIL) (#2=#:G440 NIL) (|i| NIL) 62 (|ans| (|Matrix| |Col|))) 63 (SEQ 64 (LETT |ans| 65 (MAKE_MATRIX1 (QREFELT $ 7) (QVSIZE |v|) 66 (|spadConstant| $ 39))) 67 (SEQ (LETT |i| (PROGN |ans| 1)) 68 (LETT #2# (SPADCALL |ans| (QREFELT $ 41))) G190 69 (COND ((> |i| #2#) (GO G191))) 70 (SEQ 71 (EXIT 72 (SEQ (LETT |j| (PROGN |ans| 1)) 73 (LETT #1# (SPADCALL |ans| (QREFELT $ 42))) G190 74 (COND ((> |j| #1#) (GO G191))) 75 (SEQ 76 (EXIT 77 (QSETAREF2O |ans| |i| |j| 78 (SPADCALL (QAREF1O |v| |j| 1) |i| 79 (QREFELT $ 43)) 80 1 1))) 81 (LETT |j| (+ |j| 1)) (GO G190) G191 (EXIT NIL)))) 82 (LETT |i| (+ |i| 1)) (GO G190) G191 (EXIT NIL)) 83 (EXIT (SPADCALL |ans| (QREFELT $ 46)))))) 84 85(SDEFUN |SMATCAT-;reducedSystem;MM;9| ((|x| |Matrix| S) ($ |Matrix| R)) 86 (SPROG ((#1=#:G448 NIL) (|i| NIL) (#2=#:G447 NIL)) 87 (SEQ 88 (COND 89 ((SPADCALL |x| (QREFELT $ 48)) 90 (MAKE_MATRIX1 91 (* (* (QREFELT $ 7) (QREFELT $ 7)) (ANROWS |x|)) 92 (ANCOLS |x|) (|spadConstant| $ 20))) 93 ('T 94 (SPADCALL (ELT $ 49) 95 (PROGN 96 (LETT #2# NIL) 97 (SEQ (LETT |i| (PROGN |x| 1)) 98 (LETT #1# (SPADCALL |x| (QREFELT $ 50))) G190 99 (COND ((> |i| #1#) (GO G191))) 100 (SEQ 101 (EXIT 102 (LETT #2# 103 (CONS 104 (|SMATCAT-;equation2R| 105 (SPADCALL |x| |i| (QREFELT $ 52)) 106 $) 107 #2#)))) 108 (LETT |i| (+ |i| 1)) (GO G190) G191 109 (EXIT (NREVERSE #2#)))) 110 (QREFELT $ 55))))))) 111 112(SDEFUN |SMATCAT-;reducedSystem;MVR;10| 113 ((|m| |Matrix| S) (|v| |Vector| S) 114 ($ |Record| (|:| |mat| (|Matrix| R)) (|:| |vec| (|Vector| R)))) 115 (SPROG ((|vh| (|Vector| R)) (|rh| (|Matrix| R))) 116 (SEQ 117 (LETT |vh| 118 (COND 119 ((SPADCALL |v| (QREFELT $ 57)) 120 (MAKEARR1 0 (|spadConstant| $ 20))) 121 ('T 122 (SEQ 123 (LETT |rh| 124 (SPADCALL (SPADCALL |v| (QREFELT $ 58)) 125 (QREFELT $ 59))) 126 (EXIT 127 (SPADCALL |rh| (PROGN |rh| 1) (QREFELT $ 60))))))) 128 (EXIT (CONS (SPADCALL |m| (QREFELT $ 59)) |vh|))))) 129 130(SDEFUN |SMATCAT-;trace;SR;11| ((|x| S) ($ R)) 131 (SPROG ((|tr| (R)) (#1=#:G458 NIL) (|i| NIL) (#2=#:G459 NIL) (|j| NIL)) 132 (SEQ (LETT |tr| (|spadConstant| $ 20)) 133 (SEQ (LETT |j| (SPADCALL |x| (QREFELT $ 24))) 134 (LETT #2# (SPADCALL |x| (QREFELT $ 25))) 135 (LETT |i| (SPADCALL |x| (QREFELT $ 22))) 136 (LETT #1# (SPADCALL |x| (QREFELT $ 23))) G190 137 (COND ((OR (> |i| #1#) (> |j| #2#)) (GO G191))) 138 (SEQ 139 (EXIT 140 (LETT |tr| 141 (SPADCALL |tr| 142 (SPADCALL |x| |i| |j| 143 (QREFELT $ 64)) 144 (QREFELT $ 65))))) 145 (LETT |i| (PROG1 (+ |i| 1) (LETT |j| (+ |j| 1)))) 146 (GO G190) G191 (EXIT NIL)) 147 (EXIT |tr|)))) 148 149(SDEFUN |SMATCAT-;diagonalProduct;SR;12| ((|x| S) ($ R)) 150 (SPROG ((|pr| (R)) (#1=#:G463 NIL) (|i| NIL) (#2=#:G464 NIL) (|j| NIL)) 151 (SEQ 152 (LETT |pr| 153 (SPADCALL |x| (SPADCALL |x| (QREFELT $ 22)) 154 (SPADCALL |x| (QREFELT $ 24)) (QREFELT $ 64))) 155 (SEQ (LETT |j| (+ (SPADCALL |x| (QREFELT $ 24)) 1)) 156 (LETT #2# (SPADCALL |x| (QREFELT $ 25))) 157 (LETT |i| (+ (SPADCALL |x| (QREFELT $ 22)) 1)) 158 (LETT #1# (SPADCALL |x| (QREFELT $ 23))) G190 159 (COND ((OR (> |i| #1#) (> |j| #2#)) (GO G191))) 160 (SEQ 161 (EXIT 162 (LETT |pr| 163 (SPADCALL |pr| 164 (SPADCALL |x| |i| |j| (QREFELT $ 64)) 165 (QREFELT $ 67))))) 166 (LETT |i| (PROG1 (+ |i| 1) (LETT |j| (+ |j| 1)))) 167 (GO G190) G191 (EXIT NIL)) 168 (EXIT |pr|)))) 169 170(SDEFUN |SMATCAT-;^;SIS;13| ((|x| S) (|n| |Integer|) ($ S)) 171 (SPROG ((|xInv| (|Union| S "failed"))) 172 (SEQ 173 (COND 174 ((ZEROP |n|) (SPADCALL (|spadConstant| $ 12) (QREFELT $ 13))) 175 ((PLUSP |n|) (|SMATCAT-;positivePower| |x| |n| $)) 176 (#1='T 177 (SEQ (LETT |xInv| (SPADCALL |x| (QREFELT $ 70))) 178 (EXIT 179 (COND 180 ((QEQCAR |xInv| 1) 181 (|error| "^: matrix must be invertible")) 182 (#1# 183 (|SMATCAT-;positivePower| (QCDR |xInv|) (- |n|) 184 $)))))))))) 185 186(DECLAIM (NOTINLINE |SquareMatrixCategory&;|)) 187 188(DEFUN |SquareMatrixCategory&| (|#1| |#2| |#3| |#4| |#5|) 189 (SPROG 190 ((|pv$| NIL) ($ NIL) (|dv$| NIL) (DV$5 NIL) (DV$4 NIL) (DV$3 NIL) (DV$2 NIL) 191 (DV$1 NIL)) 192 (PROGN 193 (LETT DV$1 (|devaluate| |#1|)) 194 (LETT DV$2 |#2|) 195 (LETT DV$3 (|devaluate| |#3|)) 196 (LETT DV$4 (|devaluate| |#4|)) 197 (LETT DV$5 (|devaluate| |#5|)) 198 (LETT |dv$| (LIST '|SquareMatrixCategory&| DV$1 DV$2 DV$3 DV$4 DV$5)) 199 (LETT $ (GETREFV 82)) 200 (QSETREFV $ 0 |dv$|) 201 (QSETREFV $ 3 202 (LETT |pv$| 203 (|buildPredVector| 0 0 204 (LIST (|HasCategory| |#3| '(|Field|)) 205 (|HasCategory| |#3| 206 '(|CommutativeRing|)) 207 (|HasCategory| |#3| '(|Ring|)) 208 (|HasCategory| |#3| 209 '(|SemiRing|)))))) 210 (|stuffDomainSlots| $) 211 (QSETREFV $ 6 |#1|) 212 (QSETREFV $ 7 |#2|) 213 (QSETREFV $ 8 |#3|) 214 (QSETREFV $ 9 |#4|) 215 (QSETREFV $ 10 |#5|) 216 (SETF |pv$| (QREFELT $ 3)) 217 (COND 218 ((|HasCategory| |#3| '(|Monoid|)) 219 (QSETREFV $ 15 (CONS (|dispatchFunction| |SMATCAT-;^;SNniS;2|) $)))) 220 (COND 221 ((|testBitVector| |pv$| 3) 222 (PROGN 223 (QSETREFV $ 56 224 (CONS (|dispatchFunction| |SMATCAT-;reducedSystem;MM;9|) $)) 225 (QSETREFV $ 63 226 (CONS (|dispatchFunction| |SMATCAT-;reducedSystem;MVR;10|) 227 $))))) 228 (COND 229 ((|testBitVector| |pv$| 1) 230 (QSETREFV $ 71 (CONS (|dispatchFunction| |SMATCAT-;^;SIS;13|) $)))) 231 $))) 232 233(MAKEPROP '|SquareMatrixCategory&| '|infovec| 234 (LIST 235 '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) 236 (|local| |#3|) (|local| |#4|) (|local| |#5|) (0 . *) (6 . |One|) 237 (10 . |scalarMatrix|) (|NonNegativeInteger|) (15 . ^) 238 |SMATCAT-;coerce;RS;3| (|Mapping| 8 8) (21 . |map|) 239 |SMATCAT-;differentiate;SMS;4| (27 . |Zero|) (|Integer|) 240 (31 . |minRowIndex|) (36 . |maxRowIndex|) (41 . |minColIndex|) 241 (46 . |maxColIndex|) (|Vector| 8) (51 . |minIndex|) (56 . |qelt|) 242 (63 . |directProduct|) |SMATCAT-;diagonal;SRow;5| (|Boolean|) 243 (68 . |diagonal?|) (73 . |diagonal|) (78 . |retract|) 244 |SMATCAT-;retract;SR;6| (|Union| 8 '#1="failed") 245 (83 . |retractIfCan|) |SMATCAT-;retractIfCan;SU;7| (88 . |Zero|) 246 (|Matrix| 10) (92 . |maxRowIndex|) (97 . |maxColIndex|) 247 (102 . |column|) (|Matrix| 8) (|Matrix| $) 248 (108 . |reducedSystem|) (|Matrix| 6) (113 . |empty?|) 249 (118 . |vertConcat|) (124 . |maxRowIndex|) (|Vector| 6) 250 (129 . |row|) (|Mapping| 44 44 44) (|List| 44) (135 . |reduce|) 251 (141 . |reducedSystem|) (146 . |empty?|) (151 . |coerce|) 252 (156 . |reducedSystem|) (161 . |column|) 253 (|Record| (|:| |mat| 44) (|:| |vec| 26)) (|Vector| $) 254 (167 . |reducedSystem|) (173 . |elt|) (180 . +) 255 |SMATCAT-;trace;SR;11| (186 . *) |SMATCAT-;diagonalProduct;SR;12| 256 (|Union| $ '"failed") (192 . |inverse|) (197 . ^) (|List| 74) 257 (|List| 14) (|Symbol|) (|Matrix| 21) 258 (|Record| (|:| |mat| 75) (|:| |vec| (|Vector| 21))) 259 (|Fraction| 21) (|Union| 77 '#1#) (|Union| 21 '#1#) 260 (|OutputForm|) (|PositiveInteger|)) 261 '#(|trace| 203 |retractIfCan| 208 |retract| 213 |reducedSystem| 218 262 |differentiate| 229 |diagonalProduct| 235 |diagonal| 240 |coerce| 263 245 ^ 250) 264 'NIL 265 (CONS (|makeByteWordVec2| 1 '(0)) 266 (CONS '#(NIL) 267 (CONS 268 '#((|Join| 269 (|mkCategory| 270 (LIST '((^ (|#1| |#1| (|NonNegativeInteger|))) T) 271 '((|coerce| (|#1| (|Integer|))) T) 272 '((|differentiate| 273 (|#1| |#1| (|Mapping| |#3| |#3|))) 274 T) 275 '((|differentiate| 276 (|#1| |#1| (|Mapping| |#3| |#3|) 277 (|NonNegativeInteger|))) 278 T) 279 '((|differentiate| 280 (|#1| |#1| (|List| (|Symbol|)) 281 (|List| (|NonNegativeInteger|)))) 282 T) 283 '((|differentiate| 284 (|#1| |#1| (|Symbol|) 285 (|NonNegativeInteger|))) 286 T) 287 '((|differentiate| 288 (|#1| |#1| (|List| (|Symbol|)))) 289 T) 290 '((|differentiate| (|#1| |#1| (|Symbol|))) 291 T) 292 '((|differentiate| 293 (|#1| |#1| (|NonNegativeInteger|))) 294 T) 295 '((|differentiate| (|#1| |#1|)) T) 296 '((|reducedSystem| 297 ((|Matrix| |#3|) (|Matrix| |#1|))) 298 T) 299 '((|reducedSystem| 300 ((|Record| (|:| |mat| (|Matrix| |#3|)) 301 (|:| |vec| (|Vector| |#3|))) 302 (|Matrix| |#1|) (|Vector| |#1|))) 303 T) 304 '((|reducedSystem| 305 ((|Record| 306 (|:| |mat| (|Matrix| (|Integer|))) 307 (|:| |vec| (|Vector| (|Integer|)))) 308 (|Matrix| |#1|) (|Vector| |#1|))) 309 T) 310 '((|reducedSystem| 311 ((|Matrix| (|Integer|)) (|Matrix| |#1|))) 312 T) 313 '((^ (|#1| |#1| (|Integer|))) T) 314 '((|diagonalProduct| (|#3| |#1|)) T) 315 '((|trace| (|#3| |#1|)) T) 316 '((|diagonal| (|#4| |#1|)) T) 317 '((|coerce| (|#1| |#3|)) T) 318 '((|retractIfCan| ((|Union| |#3| #1#) |#1|)) 319 T) 320 '((|retract| (|#3| |#1|)) T) 321 '((|retract| 322 ((|Fraction| (|Integer|)) |#1|)) 323 T) 324 '((|retractIfCan| 325 ((|Union| (|Fraction| (|Integer|)) #1#) 326 |#1|)) 327 T) 328 '((|coerce| (|#1| (|Fraction| (|Integer|)))) 329 T) 330 '((|retract| ((|Integer|) |#1|)) T) 331 '((|retractIfCan| 332 ((|Union| (|Integer|) #1#) |#1|)) 333 T) 334 '((^ (|#1| |#1| (|PositiveInteger|))) T) 335 '((|coerce| ((|OutputForm|) |#1|)) T)) 336 (LIST) NIL NIL))) 337 (|makeByteWordVec2| 71 338 '(2 6 0 0 0 11 0 8 0 12 1 6 0 8 13 339 2 0 0 0 14 15 2 6 0 17 0 18 0 8 0 340 20 1 6 21 0 22 1 6 21 0 23 1 6 21 341 0 24 1 6 21 0 25 1 26 21 0 27 3 6 342 8 0 21 21 28 1 9 0 26 29 1 6 31 0 343 32 1 6 9 0 33 1 9 8 0 34 1 9 36 0 344 37 0 10 0 39 1 40 21 0 41 1 40 21 345 0 42 2 6 10 0 21 43 1 10 44 45 46 346 1 47 31 0 48 2 44 0 0 0 49 1 47 347 21 0 50 2 47 51 0 21 52 2 54 44 348 53 0 55 1 0 44 45 56 1 51 31 0 57 349 1 47 0 51 58 1 6 44 45 59 2 44 26 350 0 21 60 2 0 61 45 62 63 3 6 8 0 351 21 21 64 2 8 0 0 0 65 2 8 0 0 0 352 67 1 6 69 0 70 2 0 0 0 21 71 1 0 353 8 0 66 1 0 36 0 38 1 0 8 0 35 2 0 354 61 45 62 63 1 0 44 45 56 2 0 0 0 355 17 19 1 0 8 0 68 1 0 9 0 30 1 0 0 356 8 16 2 0 0 0 14 15 2 0 0 0 21 357 71))))) 358 '|lookupComplete|)) 359