share/contrib/Zeilberger/norm.mac

   1
   2 /* Conversion routines */
   3
   4 /* RISC Institute, Linz, Austria */
   5 /* by Fabrizio Caruso            */
   6
   7
   8 /* It computes the norm of a non-trivial integer linear expression */
   9 intLinConst(intLin,k,n) :=
  10    intLin - coeff(intLin,n,1)*n - coeff(intLin,k,1)*k;
  11
  12 /* It converts an intLinNorm into an integer linear */
  13 norm2intLin(norm,k) :=
  14   first(norm);
  15
  16 /* It converts an intLinNorm into a power of an integer linear */
  17 norm2polyPower(norm) :=
  18   first(norm)^second(norm);
  19
  20
  21 /* Norm of a non-zero degree (in k) integer linear */
  22 intLinPolyNorm(expr,k) :=
  23    if(freeof(k,expr)) then
  24       [expr,1]
  25    else
  26       [expand(expr/coeff(expr,k,1)),coeff(expr,k,1)];
  27
  28 polyNorm(expr,k) :=
  29    if (freeof(k,expr)) then
  30       [expr,1]
  31    else
  32       [expand(expr/coeff(expr,k,degree(expr,k))),
  33        coeff(expr,k,degree(expr,k))];
  34
  35 intLinNorm(expr,k) :=
  36  block([polyNorm,res,constRes],
  37   if zb_operatorp(expr,"^") then
  38      (
  39      polyNorm : intLinPolyNorm(first(expr),k),
  40      res : [polyNorm[1],second(expr)],
  41      constRes : polyNorm[2]^second(expr)
  42      )
  43   else
  44      (
  45      polyNorm : intLinPolyNorm(expr,k),
  46      res : [polyNorm[1],1],
  47      constRes : polyNorm[2]
  48      ),
  49   return([res,constRes])
  50   );
  51
  52
  53 powerNorm(expr,k) :=
  54   block([base,res,constRes],
  55   if zb_operatorp(expr,"^") then
  56      (
  57      base : polyNorm(first(expr),k),
  58      res : [base[1],second(expr)],
  59      constRes : base[2]^second(expr)
  60      )
  61   else
  62      (
  63      base : polyNorm(expr,k),
  64      res : [base[1],1],
  65      constRes : base[2]
  66      ),
  67   return([res,constRes])
  68   );
  69
  70
  71 /* It outputs the integer linear factor and non-integer linear factor of a given expression */
  72 intLinCreate(expr,k) :=
  73   block(
  74   [nonIntLinList,intLinList,length],
  75
  76   nonIntLinList:[],
  77   intLinList:[],
  78   if atom(expr) or not(zb_operatorp(expr,"*")) then
  79      if(integerLinear(expr,k)) then
  80        if (expr=1) then
  81            return([])
  82        else
  83         return([expr])
  84      else
  85         return([expr])
  86   else
  87      (
  88      length:length(expr),
  89
  90      for i:1 thru length-1 do
  91        (
  92        /*
  93        if integerLinear(first(expr),k) then
  94          intLinList:cons(first(expr),intLinList)
  95        else
  96          nonIntLinList:cons(first(expr),nonIntLinList),
  97        */
  98        intLinList : cons(first(expr),intLinList),
  99        expr:expr/first(expr)
 100        ),
 101
 102      intLinList:cons(expr,intLinList),
 103
 104      return(intLinList)
 105      )
 106   );
 107
 108 /* It outputs the integer linear factor and non-integer linear factor of a given expression */
 109 intLinSep(expr,k) :=
 110   block(
 111   [nonIntLinList,intLinList,length],
 112
 113   nonIntLinList:[],
 114   intLinList:[],
 115
 116   if atom(expr) or not(zb_operatorp(expr,"*")) then
 117      if(integerLinear(expr,k)) then
 118        if (expr=1) then
 119            return([[],[]])
 120        else
 121         return([[],[expr]])
 122      else
 123         return([[expr],[]])
 124   else
 125      (
 126      length:length(expr),
 127
 128      for i:1 thru length-1 do
 129        (
 130        if integerLinear(first(expr),k) then
 131          intLinList:cons(first(expr),intLinList)
 132        else
 133          nonIntLinList:cons(first(expr),nonIntLinList),
 134        expr:expr/first(expr)
 135        ),
 136      if integerLinear(expr,k) then
 137       intLinList:cons(expr,intLinList)
 138      else
 139       nonIntLinList:cons(expr,nonIntLinList),
 140
 141      return([nonIntLinList,intLinList])
 142      )
 143   );
 144
 145
 146
 147 /* It creates a list of irreducible factors out of a factorized polynomial */
 148 factored2List(expr) :=
 149   block(
 150   [list,length,i],
 151
 152   list:[],
 153   if atom(expr)or not(zb_operatorp(expr,"*")) then
 154      return([expr])
 155   else
 156      (
 157      length:length(expr),
 158      for i:1 thru length-1 do
 159        (
 160        list:cons(first(expr),list),
 161        expr:expr/first(expr)
 162        ),
 163      list:cons(expr,list),
 164      return(list)
 165      )
 166   );
 167
 168
 169 /* It generates a list of normalized powers of integer linears */
 170 intLinNormList(exprList,k) :=
 171   block([res,i],
 172    res:[],
 173    for i:1 thru length(exprList) do
 174       res:cons(intLinNorm(part(exprList,i),k),res),
 175
 176    return(res)
 177    );
 178
 179 normList(exprList,k) :=
 180    block([res,i],
 181    res:[],
 182    for i:1 thru length(exprList) do
 183       res:cons(powerNorm(part(exprList,i),k),res),
 184    return(res)
 185    );
 186
 187
 188