share/diff_form/f_star_test4.mac

   1 /* written by Gosei Furuya <go.maxima@gmail.com>
   2 #  This program is free software; you can redistribute it and/or modify
   3 #  it under the terms of the GNU General Public License as published by
   4 #  the Free Software Foundation; either version 2 of the License, or
   5 #  (at your option) any later version.
   6 */
   7
   8
   9 infix("@");
  10 infix("&");
  11
  12 f_star(newcoords,'a_form):=
  13         block([dim,i:1,coords,extdim:2,basis,extsub,extsubb,pu_],
  14         dim:length(newcoords),array(pu_,dim),
  15         mode_declare([basis,extsub,extsubb],any),
  16         coords:newcoords,
  17         for i thru dim do
  18         (
  19         pu_[i]:concat(D,newcoords[i])
  20         ),basis:makelist(pu_[i],i,1,dim),
  21         extsub[1]:[],
  22         for i thru dim do
  23          (
  24          extsub[i+1]:cons(basis[i]=-basis[i],extsub[i]),
  25
  26          extsubb[i]:cons(basis[i]=0,extsub[i])),ev(a_form)
  27         );
  28
  29 fstar_with_clf(newcoords,n_table,'a_form):=
  30         block([dim,i:1,coords,extdim:2,basis,extsub,extsubb,extsubb2,
  31         norm_table,scale_factor,volume,a_,b_,x_,pu_],
  32         mode_declare([basis,extsub,extsubb,extsubb2],any),
  33         dim:length(newcoords),
  34         coords:newcoords,array(pu_,dim),
  35         for i thru dim do
  36          (pu_[i]:concat(D,newcoords[i])
  37         ),
  38         basis:makelist(pu_[i],i,1,dim),
  39         extsub[1]:[],
  40         for i thru dim do
  41          (
  42                 extsub[i+1]:cons(basis[i]=-basis[i],extsub[i]),
  43                 extsubb[i]:cons(basis[i]=0,extsub[i])),
  44         norm_table:clif_norm(n_table,coords),
  45         a_:solve(x_^2-apply("*",norm_table),[x_]),
  46         volume:rhs(a_[2]),volume:1/volume,
  47         scale_factor:[],
  48         for i:1 thru dim do
  49         ( a_:solve(x_^2-1/norm_table[i],[x_]),
  50         scale_factor:cons(rhs(a_[2]),scale_factor)
  51         ),
  52         scale_factor:reverse(scale_factor),
  53         for i:1 thru dim do
  54         ( extsubb2[i]:cons(basis[i]=norm_table[i]/basis[i],extsub[i])
  55         ),
  56         ev(a_form)
  57         );
  58
  59 clif_norm(list_,coords_):=
  60         block([dim,_p,coords,cliffordtype,ntable:[],_l:[]],
  61         coords:coords_,
  62         dim:length(coords),
  63         cliffordtype:makelist(1,i,1,dim),
  64         for i:1 thru dim do
  65         (_l:map(lambda([x],diff(x,coords[i])),list_),
  66                 _l:map(lambda([x],x^2),_l),_p:ratsimp(trigsimp(apply("+",_l))),
  67                 ntable:endcons(cliffordtype[i]/_p,ntable)),
  68         ntable
  69         );
  70
  71 /*inner[_f](_g) */
  72 inner(_f,_g):= block([_a,_b:[],_r],
  73       _a:expand(_f),
  74       for i:1 thru dim do (_b:endcons(ratcoef(_a,basis[i]),_b)),
  75       _r:_b | _g);
  76
  77 /*Lie[_f1](_g1)    Lie differential operator*/
  78 Lie(_f1,_g1):=d(inner(_g1,_f1))+inner(d(_g1),_f1);
  79
  80
  81
  82
  83  nest2(_f,_x):=block([_a:[_x],i],if listp(_f) then (
  84          _f:reverse(_f),for i:1 thru length(_f) do(_a:map(_f[i],_a)))
  85         else (_a:map(_f,_a)),_a[1])$
  86  nest3(_f,_x,_n):=block([_a,i],_a:[_x],for i:1 thru _n do (_a:map(_f,_a)),_a)$