1 ;;this program is derived from maxima/share/calculus/cartan.lisp
2 ;;I add clifford operator &,&2
3 ;;I add clifford differential operator d_c
9 (add2lnc (quote "|") $props
)
10 (defprop $\| dimension-infix dimension
)
11 (defprop $\|
(#\Space
#\|
#\Space
) dissym
)
14 (defprop $\| parse-infix led
)
15 (defprop $\| msize-infix grind
)
16 (defprop %\| dimension-infix dimension
)
17 (defprop %\|
(#\Space
#\|
#\Space
) dissym
)
18 (mdefprop $\|
((lambda) ((mlist) $v $f
) ((mprog simp
) ((mlist simp
)
19 $i $j $ext101 $ext102 $ext103 $ext104
) ((msetq simp
) $ext103
20 (($expand simp
) $f
)) ((msetq simp
) $ext102
((mtimes simp
)
21 (($v simp array
) 1) (($coeff simp
) $ext103
(($basis simp array
) 1))))
22 ((mdo simp
) $i
2 nil nil $dim nil
((mprogn simp
) ((msetq simp
)
23 $ext101
(($coeff simp
) $ext103
(($basis simp array
) $i
)))
24 ((mcond simp
) ((mnotequal simp
) $ext101
0) ((msetq simp
) $ext101
25 (($substitute simp
) (($extsub simp array
) $i
) $ext101
)) t $false
)
26 ((msetq simp
) $ext102
((mplus simp
) $ext102
((mtimes simp
) $ext101
27 (($v simp array
) $i
)))))) ((mreturn simp
) (($expand simp
) $ext102
))))
29 (add2lnc (quote (($\|
) $v $f
)) $functions
)
30 (defprop %\| $\| noun
)
35 (add2lnc (quote "@") $props
)
36 (defprop $
@ dimension-infix dimension
)
37 (defprop $
@ (#\Space
#\
& #\Space
) dissym
)
38 ;;(defprop $@ 140 lbp)
39 ;;(defprop $@ 180 rbp)
42 (defprop $
@ parse-infix led
)
43 (defprop $
@ msize-infix grind
)
44 (defprop %
@ dimension-infix dimension
)
45 (defprop %
@ (#\Space
#\
& #\Space
) dissym
)
51 ((mlist simp
) $i $j $ext101 $ext102 $ext103 $ext104 $ext105
)
52 ((msetq simp
) $ext101
0)
53 ((msetq simp
) $ext102 $true
)
56 ((mdo simp
) $i $dim -
1 nil
1 nil
60 (($bothcoef simp
) $ext103
61 (($basis simp array
) $i
))))
63 (($first simp
) $ext104
))
65 ((mnotequal simp
) $ext105
0)
67 ((msetq simp
) $ext103
(($last simp
) $ext104
))
74 (($basis simp array
) $i
)
76 (($extsubb simp array
) $i
) $g
)) )))
77 ((msetq simp
) $ext102 $false
)) t $false
)))
80 (($expand simp
) ((mtimes simp
) $f $g
)))
81 t
((mreturn simp
) (($expand simp
) $ext101
)))))
84 (add2lnc (quote (($
@) $f $g
)) $functions
)
86 ;;start definition with clifford operator
90 (add2lnc (quote "&") $props
)
91 (defprop $
& dimension-infix dimension
)
92 (defprop $
& (#\Space
#\
& #\Space
) dissym
)
95 (defprop $
& parse-infix led
)
96 (defprop $
& msize-infix grind
)
97 (defprop %
& dimension-infix dimension
)
98 (defprop %
& (#\Space
#\
& #\Space
) dissym
)
100 (mdefprop $
& ((lambda)
103 ((mlist simp
) $i $j $ext101 $ext102 $ext103 $ext104 $ext105
)
104 ((msetq simp
) $ext101
0)
105 ((msetq simp
) $ext102 $true
)
106 ((msetq simp
) $ext103
108 ((mdo simp
) $i $dim -
1 nil
1 nil
109 ((mprogn simp
) ((msetq simp
) $ext104
111 (($bothcoef simp
) $ext103
112 (($basis simp array
) $i
))))
113 ((msetq simp
) $ext105
(($first simp
) $ext104
))
114 ((mcond simp
) ((mnotequal simp
) $ext105
0)
115 ((mprogn simp
) ((msetq simp
) $ext103
(($last simp
) $ext104
))
116 ((msetq simp
) $ext101
((mplus simp
) $ext101
120 (($basis simp array
) $i
)
122 (($extsubb2 simp array
) $i
) $g
))
124 ((msetq simp
) $ext102 $false
)) t $false
)))
125 ((mcond simp
) $ext102
126 ((mreturn simp
) (($expand simp
)
127 ((mtimes simp
) $f $g
))) t
128 ((mreturn simp
) (($expand simp
) $ext101
))))) mexpr
)
130 (add2lnc (quote (($
&) $f $g
)) $functions
)
133 ;;exterior differential operator
134 (mdefprop $d
((lambda)
138 (($basis simp array
) $i
)
140 (($coords simp array
) $i
)))
143 (add2lnc (quote (($d2
) $f
)) $functions
)
145 ;;clifford differential operator
146 (mdefprop $d_c
((lambda)
150 (($basis simp array
) $i
)
152 (($coords simp array
) $i
)))
155 (add2lnc (quote (($d_c
) $f
)) $functions
)
157 ;;another clifford operator with different basis.
158 ;;clifford operator & and exterior operator go with.
159 ;;but we ofen need to calc clifford algebra another basis at the same time.
160 ;;before using &2 operator you must "infix("&2")$ "
161 (defprop $
&2 %
&2 verb
)
162 (defprop $
&2 "&2" op
)
164 (add2lnc (quote "&2") $props
)
165 (defprop $
&2 dimension-infix dimension
)
166 (defprop $
&2 (#\Space
#\
& #\Space
) dissym
)
167 (defprop $
&2 140 lbp
)
168 (defprop $
&2 180 rbp
)
169 (defprop $
&2 parse-infix led
)
170 (defprop $
&2 msize-infix grind
)
171 (defprop %
&2 dimension-infix dimension
)
172 (defprop %
&2 (#\Space
#\
& #\Space
) dissym
)
173 ;;clifford operator &
174 (mdefprop $
&2 ((lambda)
177 ((mlist simp
) $i $j $ext101 $ext102 $ext103 $ext104 $ext105
)
178 ((msetq simp
) $ext101
0)
179 ((msetq simp
) $ext102 $true
)
180 ((msetq simp
) $ext103
182 ((mdo simp
) $i $n_dim -
1 nil
1 nil
183 ((mprogn simp
) ((msetq simp
) $ext104
185 (($bothcoef simp
) $ext103
186 (($basis2 simp array
) $i
))))
187 ((msetq simp
) $ext105
(($first simp
) $ext104
))
188 ((mcond simp
) ((mnotequal simp
) $ext105
0)
189 ((mprogn simp
) ((msetq simp
) $ext103
(($last simp
) $ext104
))
190 ((msetq simp
) $ext101
((mplus simp
) $ext101
191 (($
&2 simp
) $ext105
((mtimes simp
)
192 (($basis2 simp array
) $i
)
194 (($extsubb4 simp array
) $i
) $g
)))))
195 ((msetq simp
) $ext102 $false
)) t $false
)))
196 ((mcond simp
) $ext102
197 ((mreturn simp
) (($expand simp
)
198 ((mtimes simp
) $f $g
))) t
199 ((mreturn simp
) (($expand simp
) $ext101
))))) mexpr
)
201 (add2lnc (quote (($
&2) $f $g
)) $functions
)
202 (defprop %
&2 $
&2 noun
)
