1(cond (($get '$cartan '$version) (merror "CARTAN already loaded"))
2      (t ($put '$cartan '$v20041209 '$version))
3)
4
5
6; (SETQ SAVENO 2550)
7(DEFPROP $\| %\| VERB)
8(DEFPROP $\| "|" OP)
9(putopr "|" '$\|)
10(ADD2LNC (QUOTE "|") $PROPS)
11(DEFPROP $\| DIMENSION-infix DIMENSION)
12(DEFPROP $\| (#\Space #\| #\Space) DISSYM)
13(DEFPROP $\| 120 LBP)
14(DEFPROP $\| 180 RBP)
15(DEFPROP $\| PARSE-INFIX LED)
16(DEFPROP $\| MSIZE-INFIX GRIND)
17(DEFPROP %\| DIMENSION-infix DIMENSION)
18(DEFPROP %\| (#\Space #\| #\Space) DISSYM)
19(MDEFPROP $\| ((LAMBDA) ((MLIST) $V $F) ((MPROG SIMP) ((MLIST SIMP)
20 $I $J $EXT101 $EXT102 $EXT103 $EXT104) ((MSETQ SIMP) $EXT103
21(($EXPAND SIMP) $F)) ((MSETQ SIMP) $EXT102 ((MTIMES SIMP)
22(($V SIMP ARRAY) 1) (($COEFF SIMP) $EXT103 (($CARTAN_BASIS SIMP ARRAY) 1))))
23((MDO SIMP) $I 2 NIL NIL $CARTAN_DIM NIL ((MPROGN SIMP) ((MSETQ SIMP)
24$EXT101 (($COEFF SIMP) $EXT103 (($CARTAN_BASIS SIMP ARRAY) $I)))
25((MCOND SIMP) ((MNOTEQUAL SIMP) $EXT101 0) ((MSETQ SIMP) $EXT101
26 (($SUBSTITUTE SIMP) (($EXTSUB SIMP ARRAY) $I) $EXT101)) T $FALSE)
27 ((MSETQ SIMP) $EXT102 ((MPLUS SIMP) $EXT102 ((MTIMES SIMP) $EXT101
28 (($V SIMP ARRAY) $I)))))) ((MRETURN SIMP) (($EXPAND SIMP) $EXT102))))
29 MEXPR)
30(ADD2LNC (QUOTE (($\|) $V $F)) $FUNCTIONS)
31(DEFPROP %\| $\| NOUN)
32(DEFPROP $~ %~ VERB)
33(DEFPROP $~ "~" OP)
34(putopr "~" '$~)
35(ADD2LNC (QUOTE "~") $PROPS)
36(DEFPROP $~ DIMENSION-infix DIMENSION)
37(DEFPROP $~ (#\Space #\~ #\Space) DISSYM)
38(DEFPROP $~ 140 LBP)
39(DEFPROP $~ 180 RBP)
40(DEFPROP $~ PARSE-INFIX LED)
41(DEFPROP $~ MSIZE-INFIX GRIND)
42(DEFPROP %~ DIMENSION-infix DIMENSION)
43(DEFPROP %~ (#\Space #\~ #\Space) DISSYM)
44(MDEFPROP $~ ((LAMBDA) ((MLIST) $F $G) ((MPROG SIMP) ((MLIST SIMP) $I $J $EXT101 $EXT102 $EXT103 $EXT104 $EXT105) ((MSETQ SIMP) $EXT101 0) ((MSETQ SIMP) $EXT102 $TRUE) ((MSETQ SIMP) $EXT103 (($EXPAND SIMP) $F)) ((MDO SIMP) $I $CARTAN_DIM -1 NIL 1 NIL ((MPROGN SIMP) ((MSETQ SIMP) $EXT104 (($EXPAND SIMP) (($BOTHCOEF SIMP) $EXT103 (($CARTAN_BASIS SIMP ARRAY) $I)))) ((MSETQ SIMP) $EXT105 (($FIRST SIMP) $EXT104)) ((MCOND SIMP) ((MNOTEQUAL SIMP) $EXT105 0) ((MPROGN SIMP) ((MSETQ SIMP) $EXT103 (($LAST SIMP) $EXT104)) ((MSETQ SIMP) $CARTAN_DIM ((MPLUS SIMP) -1 $I)) ((MSETQ SIMP) $EXT101 ((MPLUS SIMP) $EXT101 (($~ SIMP) $EXT105 ((MTIMES SIMP) (($CARTAN_BASIS SIMP ARRAY) $I) (($SUBSTITUTE SIMP) (($EXTSUBB SIMP ARRAY) $I) $G))))) ((MSETQ SIMP) $CARTAN_DIM $EXTDIM) ((MSETQ SIMP) $EXT102 $FALSE)) T $FALSE))) ((MCOND SIMP) $EXT102 ((MRETURN SIMP) (($EXPAND SIMP) ((MTIMES SIMP) $F $G))) T ((MRETURN SIMP) (($EXPAND SIMP) $EXT101))))) MEXPR)
45(ADD2LNC (QUOTE (($~) $F $G)) $FUNCTIONS)
46(DEFPROP %~ $~ NOUN)
47(MDEFPROP $EXT_DIFF ((LAMBDA) ((MLIST) $F) (($SUM SIMP) (($~ SIMP)
48(($CARTAN_BASIS SIMP ARRAY) $I) (($DIFF SIMP) $F (($CARTAN_COORDS SIMP ARRAY) $I)))
49 $I 1 $CARTAN_DIM)) MEXPR)
50(ADD2LNC (QUOTE (($EXT_DIFF) $F)) $FUNCTIONS)
51(MDEFPROP $LIE_DIFF_F ((LAMBDA) ((MLIST) $V $F) ((MPLUS SIMP) (($\| SIMP) $V
52(($EXT_DIFF SIMP) $F)) (($EXT_DIFF SIMP) (($\| SIMP) $V $F)))) MEXPR)
53(ADD2LNC (QUOTE (($LIE_DIFF_F) $V $F)) $FUNCTIONS)
54(MDEFPROP $LIE_DIFF_V ((LAMBDA) ((MLIST) $V $W) ((MPROG SIMP) ((MLIST SIMP)
55$I $J $EXT101) ((MSETQ SIMP) $EXT101 ((MLIST SIMP))) ((MDO SIMP)
56$I 1 NIL NIL $CARTAN_DIM NIL ((MSETQ SIMP) $EXT101 (($ENDCONS SIMP)
57(($SUM SIMP) ((MPLUS SIMP) ((MTIMES SIMP) (($DIFF SIMP)
58 (($W SIMP ARRAY) $I) (($CARTAN_COORDS SIMP ARRAY) $J)) (($V SIMP ARRAY) $J))
59 ((MTIMES SIMP) -1 (($DIFF SIMP) (($V SIMP ARRAY) $I)
60(($CARTAN_COORDS SIMP ARRAY) $J)) (($W SIMP ARRAY) $J))) $J 1 $CARTAN_DIM) $EXT101)))
61 ((MRETURN SIMP) (($EXPAND SIMP) $EXT101)))) MEXPR)
62(ADD2LNC (QUOTE (($LIE_DIFF_V) $V $W)) $FUNCTIONS)
63(MDEFPROP $EDIT ((LAMBDA) ((MLIST) $F) ((MPROG SIMP) ((MLIST SIMP) $I
64 $EXT101 $EXT102 $EXT103 $EXT104 $EXT105) ((MSETQ SIMP) $EXT101 0)
65 ((MSETQ SIMP) $EXT102 (($EXPAND SIMP) $F)) ((MDO SIMP) $I $CARTAN_DIM -1
66NIL 1 NIL ((MPROGN SIMP) ((MSETQ SIMP) $EXT103 (($EXPAND SIMP)
67(($BOTHCOEF SIMP) $EXT102 (($CARTAN_BASIS SIMP ARRAY) $I)))) ((MSETQ SIMP)
68 $EXT104 (($FIRST SIMP) $EXT103)) ((MCOND SIMP) ((MNOTEQUAL SIMP)
69 $EXT104 0) ((MPROGN SIMP) ((MSETQ SIMP) $EXT102 (($LAST SIMP) $EXT103))
70 ((MSETQ SIMP) $CARTAN_DIM ((MPLUS SIMP) -1 $I)) ((MSETQ SIMP) $EXT105
71 (($EDIT SIMP) $EXT104)) ((MSETQ SIMP) $CARTAN_DIM $EXTDIM) ((MCOND SIMP)
72((MEQUAL SIMP) $EXT105 0) ((MSETQ SIMP) $EXT101 ((MPLUS SIMP) $EXT101
73 ((MTIMES SIMP) $EXT104 (($CARTAN_BASIS SIMP ARRAY) $I)))) T ((MCOND SIMP)
74 ((MEQUAL SIMP) (($INPART SIMP) $EXT105 0) "+") ((MSETQ SIMP) $EXT101
75 ((MPLUS SIMP) $EXT101 (($MULTTHRU SIMP) ((MTIMES SIMP) $EXT105
76 (($CARTAN_BASIS SIMP ARRAY) $I))))) T ((MSETQ SIMP) $EXT101 ((MPLUS SIMP)
77 $EXT101 ((MTIMES SIMP) $EXT105 (($CARTAN_BASIS SIMP ARRAY) $I)))))))
78T $FALSE))) ((MRETURN SIMP) $EXT101))) MEXPR)
79(ADD2LNC (QUOTE (($EDIT) $F)) $FUNCTIONS)
80(MDEFPROP $BASUB ((LAMBDA) ((MLIST) $F $G $H) ((MPROG SIMP)
81((MLIST SIMP) $I $EXT101 $EXT102 $EXT103 $EXT104) ((MSETQ SIMP)
82 $EXT101 (($EXPAND SIMP) $H)) ((MSETQ SIMP) $EXT102 (($EXPAND SIMP)
83 (($BOTHCOEF SIMP) $EXT101 $G))) ((MSETQ SIMP) $EXT103 (($FIRST SIMP)
84 $EXT102)) ((MCOND SIMP) ((MEQUAL SIMP) $EXT103 0) ((MRETURN SIMP) $H)
85 T $FALSE) ((MCOND SIMP) ((MEQUAL SIMP) $G (($CARTAN_BASIS SIMP ARRAY) 1))
86 ((MRETURN SIMP) ((MPLUS SIMP) (($LAST SIMP) $EXT102) (($~ SIMP) $F
87 $EXT103))) T $FALSE) ((MDO SIMP) $I 2 NIL NIL $CARTAN_DIM NIL ((MCOND SIMP)
88 ((MEQUAL SIMP) $G (($CARTAN_BASIS SIMP ARRAY) $I)) ((MRETURN SIMP)
89((MSETQ SIMP) $EXT104 ((MPLUS SIMP) (($LAST SIMP) $EXT102) (($~ SIMP)
90 $F (($SUBSTITUTE SIMP) (($EXTSUB SIMP ARRAY) $I) $EXT103)))))
91T $FALSE)) ((MRETURN SIMP) $EXT104))) MEXPR)
92(ADD2LNC (QUOTE (($BASUB) $F $G $H)) $FUNCTIONS)
93
94
95(meval '((MDEFINE) (($LIE_DIFF) $V $X)
96         ((MCOND) (($LISTP) $X) (($LIE_DIFF_V) $V $X) T
97          (($LIE_DIFF_F) $V $X))))
98
99(defmvar $cartan_dim)
100(defmvar $extdim)
101(defmvar $cartan_coords)
102(defmvar $cartan_basis)
103
104; The following is a hand translation (more or less) of this MAXIMA code:
105;
106; init_cartan(coords):=block
107; (
108;   [ci],
109;   cartan_coords:coords,
110;   cartan_dim:extdim:length(cartan_coords),
111;   cartan_basis:extsubb[1]:[],
112;   for i thru cartan_dim do
113;   (
114;     ci:concat(zzz,i),
115;     cartan_basis:endcons(ci,cartan_basis),
116;     extsub[i+1]:cons(ci=-ci,extsub[i]),
117;     extsubb[i]:cons(ci=0,extsub[i]),
118;     apply('alias,[concat(d,cartan_coords[i]),ci])
119;   )
120; );
121
122(defun $init_cartan (c)
123  (setq $cartan_coords c)
124  (setq $cartan_dim ($length $cartan_coords))
125  (setq $extdim $cartan_dim)
126  (setq $cartan_basis nil)
127  (meval (list '(msetq) '(($extsub array) 1) '((mlist simp))))
128  (meval (list '(msetq) '(($extsubb array) 1) '((mlist simp))))
129
130  (do
131    ((c (cdr $cartan_coords) (cdr c)) (i 1 (1+ i)) (ci))
132    ((null c) (setq $cartan_basis (cons '(mlist simp) (reverse $cartan_basis))))
133    (setq ci ($concat 'zzz (car c)))
134    (setq $cartan_basis (cons ci $cartan_basis))
135
136    (meval (list '(msetq) (list '($extsub array) (1+ i))
137           ($cons (list '(mequal simp) ci (list '(mtimes simp) -1 ci))
138                  (meval (list '($extsub array) i))
139           )
140    ))
141    (meval (list '(msetq) (list '($extsubb array) i)
142           ($cons (list '(mequal simp) ci 0)
143                  (meval (list '($extsub array) i))
144           )
145    ))
146    (meval (list '(alias) ($concat 'd (car c)) ci))
147  )
148)
149