← Back to branch summary

~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to src/invert.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2006-10-18 14:52:42 UTC
  • mto: (1.1.5 upstream)
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20061018145242-vzyrm5hmxr8kiosf
Import upstream version 5.10.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/invert.lisp
2
2
;;;Translated on: 5/12/85 13:57:48;;Maxima System version 8
3
3
;;** Variable settings were **
4
4
 
5
 
(in-package "MAXIMA")
 
5
(in-package :maxima)
6
6
 
7
7
;;TRANSCOMPILE:FALSE;
8
8
;;TR_SEMICOMPILE:FALSE;
16
16
;;TR_ARRAY_AS_REF:TRUE;
17
17
;;TR_NUMER:FALSE;
18
18
;;DEFINE_VARIABLE:FALSE;
19
 
(EVAL-WHEN (COMPILE EVAL LOAD)
20
 
 (DEFPROP $ADJOINT T TRANSLATED)
21
 
 (ADD2LNC '$ADJOINT $PROPS)
22
 
 (DEFMTRFUN
23
 
  ($ADJOINT $ANY MDEFINE NIL NIL)
24
 
  ($MAT)
25
 
  NIL
26
 
  ((LAMBDA
27
 
    ($ADJ $N)
28
 
    NIL
29
 
    (SETQ $N ($LENGTH $MAT))
30
 
    (SETQ $ADJ (SIMPLIFY ($IDENT $N)))
31
 
    (COND
32
 
     ((NOT (LIKE $N 1))
33
 
      (DO (($I 1 (f+ 1 $I)))
34
 
          ((> $I $N) '$DONE)
35
 
        (DO (($J 1 (f+ 1 $J)))
36
 
            ((> $J $N) '$DONE)
37
 
         (MASET (MUL* (POWER -1 (f+ $I $J))
38
 
                      (SIMPLIFY ($DETERMINANT (SIMPLIFY ($MINOR $MAT
39
 
                                                                $J
40
 
                                                                $I)))))
41
 
                $ADJ
42
 
                $I
43
 
                $J)))))
44
 
    $ADJ)
45
 
   '$ADJ
46
 
   '$N)))
47
 
(EVAL-WHEN (COMPILE EVAL LOAD)
48
 
       (DEFPROP $INVERT T TRANSLATED)
49
 
       (ADD2LNC '$INVERT $PROPS)
50
 
       (DEFMTRFUN ($INVERT $ANY MDEFINE NIL NIL)
51
 
                  ($MAT)
52
 
                  NIL
53
 
                  ((LAMBDA ($ADJ $ANS)
54
 
                       NIL
55
 
                       (SETQ $ADJ (SIMPLIFY ($ADJOINT $MAT)))
56
 
                       (SETQ $ANS ((LAMBDA ($SCALARMATRIXP)
57
 
                                       NIL
58
 
                                       (DIV $ADJ
59
 
                                            (NCMUL2 (SIMPLIFY ($ROW $MAT 1))
60
 
                                                    (SIMPLIFY ($COL $ADJ
61
 
                                                                    1)))))
62
 
                                   T))
63
 
                       (COND ((AND (LIKE (TRD-MSYMEVAL $SCALARMATRIXP
64
 
                                                       '$SCALARMATRIXP)
65
 
                                         T)
66
 
                                   (EQL ($LENGTH $MAT) 1))
67
 
                              (MAREF $ANS 1 1))
68
 
                             (T $ANS)))
69
 
                   '$ADJ
70
 
                   '$ANS)))
 
 
b'\\ No newline at end of file'
 
19
(eval-when (compile eval load)
 
20
  (defprop $adjoint t translated)
 
21
  (add2lnc '$adjoint $props)
 
22
  (defmtrfun
 
23
      ($adjoint $any mdefine nil nil)
 
24
      ($mat)
 
25
    nil
 
26
    ((lambda
 
27
         ($adj $n)
 
28
       nil
 
29
       (setq $n ($length $mat))
 
30
       (setq $adj (simplify ($ident $n)))
 
31
       (cond
 
32
         ((not (like $n 1))
 
33
          (do (($i 1 (f+ 1 $i)))
 
34
              ((> $i $n) '$done)
 
35
            (do (($j 1 (f+ 1 $j)))
 
36
                ((> $j $n) '$done)
 
37
              (maset (mul* (power -1 (f+ $i $j))
 
38
                           (simplify ($determinant (simplify ($minor $mat
 
39
                                                                     $j
 
40
                                                                     $i)))))
 
41
                     $adj
 
42
                     $i
 
43
                     $j)))))
 
44
       $adj)
 
45
     '$adj
 
46
     '$n)))
 
47
(eval-when (compile eval load)
 
48
  (defprop $invert t translated)
 
49
  (add2lnc '$invert $props)
 
50
  (defmtrfun ($invert $any mdefine nil nil)
 
51
      ($mat)
 
52
    nil
 
53
    ((lambda ($adj $ans)
 
54
       nil
 
55
       (setq $adj (simplify ($adjoint $mat)))
 
56
       (setq $ans ((lambda ($scalarmatrixp)
 
57
                     nil
 
58
                     (div $adj
 
59
                          (ncmul2 (simplify ($row $mat 1))
 
60
                                  (simplify ($col $adj
 
61
                                                  1)))))
 
62
                   t))
 
63
       (cond ((and (like (trd-msymeval $scalarmatrixp
 
64
                                       '$scalarmatrixp)
 
65
                         t)
 
66
                   (eql ($length $mat) 1))
 
67
              (maref $ans 1 1))
 
68
             (t $ans)))
 
69
     '$adj
 
70
     '$ans)))
 
 
b'\\ No newline at end of file'