share/diff_form/hodge_test3.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 inargs(q):=block([inflag:true],args(q));
   9 inop(q):=block([inflag:true],op(q));
  10
  11 /* hodge star operator*/
  12 h_st(_f):=block([_f1:expand(_f),_l1:[],_l2:[],_l3:[],_l4,_l5,_l6,_l7,abasis],
  13         match_declare(abasis,any),
  14         abasis:[],
  15         if _f=0 then return(0)
  16         else (
  17             if atom(_f1) then _l1:[_f1]
  18                else (
  19                       if is(inop(_f1)="+") then _l1:inargs(_f1)
  20                          else (
  21         _l1:[_f1]))),
  22         for i:1 thru dim do (
  23         abasis:endcons(basis[i],abasis)
  24         ),abasis,
  25 /*      _l2:sublis(ev(map("=",abasis,makelist(1,i,1,dim))),_l1),*/
  26         _l2:sublis(map("=",abasis,makelist(1,i,1,dim)),_l1),
  27         _l3:map(lambda([x,y],y/x),_l2,_l1),
  28         _l6:sublis(map("=",abasis,norm_table),_l3),
  29         _l4:map(lambda([x],(apply("*",abasis))/x),_l3),
  30         _l5:map(lambda([x,y],(x@y)/(apply("*",abasis))),_l3,_l4),
  31         _l4:map(lambda([x,y,z],x*y*z),_l6,_l5,_l4),
  32         _l7:apply("+",map(lambda([x,y],x*y*volume),_l2,_l4)),
  33         _l7);
  34
  35  nest2(_f,_x):=block([_a:[_x],i],if listp(_f) then (
  36          _f:reverse(_f),for i:1 thru length(_f) do(_a:map(_f[i],_a)))
  37         else (_a:map(_f,_a)),_a[1]);
  38  nest3(_f,_x,_n):=block([_a,i],_a:[_x],for i:1 thru _n do (_a:map(_f,_a)),_a);