share/contrib/sarag/lowLevel.mac

   1 /* ------------------------------------------------------------------- */
   2 /* SARAG - Low Level Routines                                          */
   3 /* by Fabrizio Caruso                                                  */
   4 /*modified by Alexandre Le Meur and Marie-Françoise Roy */
   5
   6 /* ------------------------------------------------------ */
   7 /* Polynomial related functions */
   8
   9 /* It expands a polynomial if ASSUME_EXPANDED is false */
  10 expandIf(pol)::=
  11   buildq([pol],
  12   if ASSUME_EXPANDED then
  13     pol
  14   else
  15     ratexpand(pol));
  16
  17
  18 /* Degree of a polynomial (MACRO) */
  19 degree(poly,indet) ::=
  20   buildq([poly,indet],if poly = 0 then -1 else hipow(poly,indet));
  21
  22
  23 /* Leading coefficient of a polynomial */
  24 leadCoeff(poly,indet)::=
  25    buildq([poly,indet],
  26           ratcoeff(poly,indet,degree(poly,indet)));
  27
  28
  29 /* Leading term of a polynomial */
  30 leadTerm(poly,indet)::=
  31    buildq([poly,indet],
  32           indet^degree(poly,indet));
  33
  34 /* Leading monomial of a polynomial */
  35 leadMono(poly,indet)::=
  36    buildq([poly,indet],
  37           leadCoeff(poly,indet)*leadTerm(poly,indet));
  38
  39 /* Tail of a polynomial */
  40 Tail(poly,indet) ::=
  41    buildq([poly,indet],
  42           poly-leadMono(poly,indet));
  43
  44
  45 /* ------------------------------------------------------ */
  46 /* Sign function */
  47
  48 sgn(val) ::=
  49   buildq([val], if val = 0 then 0 else if val < 0 then -1 else 1);
  50
  51
  52 /* ------------------------------------------------------ */
  53 /* Array-related routines */
  54
  55 /* Number of dimensions */
  56 numOfDim(ar) :=
  57   second(arrayinfo(ar));
  58
  59 /* Array degree */
  60 arrayDegree(ar) :=
  61   first(third(arrayinfo(ar)));
  62
  63 /* Array length */
  64 arrayLength(ar) :=
  65   first(third(arrayinfo(ar)))+1;
  66
  67 /* Number of rows */
  68 numOfRows(ar) :=
  69   first(third(arrayinfo(ar)))+1;
  70
  71 /* Number of columns */
  72 numOfCols(ar) :=
  73   second(third(arrayinfo(ar)))+1;
  74
  75 /* It makes a polynomial out of a list */
  76 list2poly(lst,var) :=
  77   sum(lst[i]*var^(i-1),i,1,length(lst));
  78
  79 poly2list(pol,var) :=
  80     makelist(coeff(pol,var,i),i,0,degree(pol,var));
  81
  82 matrix2list(mtx) :=
  83     makelist(mtx[i],i,1,length(mtx));
  84
  85
  86 /* list of lists -> bidimensional array */
  87 list2array(lst) :=
  88   block([nRows,nCols,i,j,res],
  89    nRows : length(lst),
  90    nCols : length(lst[1]),
  91    res : make_array( 'any,nRows,nCols ),
  92    for i : 1 thru nRows do
  93      for j : 1 thru nCols do
  94        res[i-1,j-1] : lst[i][j],
  95    return(res)
  96    );
  97
  98
  99
 100 /* bidimensional array -> list of lists */
 101 array2list(arr) :=
 102   block([nRows,nCols,i,j,newRow,res],
 103    nRows : first(third(arrayinfo(arr)))+1,
 104    nCols : second(third(arrayinfo(arr)))+1,
 105    res : [],
 106
 107    for i : 1 thru nRows do
 108      (
 109      newRow : [],
 110      for j : 1 thru nCols do
 111        newRow : endcons(arr[i-1,j-1],newRow),
 112
 113      res : endcons(newRow,res)
 114      ),
 115    return(res)
 116    );
 117
 118
 119 array2singleList(arr) :=
 120   makelist(arr[j],j,0,first(third(arrayinfo(arr))));
 121
 122
 123 singleList2array(lst) :=
 124   block([res,i],
 125   res:make_array('any,length(lst)),
 126   for i : 1 thru length(lst) do
 127      res[i-1] : lst[i],
 128   return(res)
 129   );
 130
 131
 132 poly2array(pol,var) :=
 133   singleList2array(poly2list(pol,var));
 134
 135 array2poly(arr,var) :=
 136   list2poly(array2singleList(arr),var);
 137
 138
 139 /* ------------------------------------------------------ */
 140 /* List manipulation */
 141
 142 /* It removes the zeroes from a list */
 143 trimZerosRec(seq) :=
 144   if seq = [] then
 145     []
 146   else
 147     if first(seq) = 0 then
 148       trimZerosRec(rest(seq))
 149     else
 150       cons(first(seq),trimZerosRec(rest(seq)));
 151
 152 trimZeros(seq) :=
 153 block([list,i],
 154   list: [],
 155   for i:1 thru length(seq) do
 156     if not(seq[i] = 0) then
 157       list:append(list,[seq[i]]),
 158 return(list)
 159 );
 160
 161
 162
 163 /* Mergesort of two sorted lists wrt to a given total ordering*/
 164
 165 mergeSorted(lhs,rhs,ordering) :=
 166   block([i,j,k,lhsLen,rhsLen,res],
 167   lhsLen : length(lhs),
 168   rhsLen : length(rhs),
 169   i : 1,
 170   j : 1,
 171   res : [],
 172   while (i<= lhsLen) and (j<= rhsLen) do
 173     (
 174
 175     if ordering(lhs[i],rhs[j]) then
 176       (
 177       res : endcons(lhs[i],res),
 178       i : i + 1
 179       )
 180     else
 181       if lhs[i]=rhs[j] then
 182         (
 183         res : endcons(lhs[i],res),
 184         i : i + 1,
 185         j : j + 1
 186         )
 187       else
 188         (
 189         res : endcons(rhs[j],res),
 190         j : j + 1
 191         )
 192      ),
 193   if i<= lhsLen then
 194     res : append(res, makelist(lhs[k],k,i,lhsLen))
 195   else
 196      if j <= rhsLen then
 197         res : append(res, makelist(rhs[k],k,j,rhsLen)),
 198   return(res)
 199
 200  );