share/algebra/solver/misc.mac

   1 /*
   2 These functions implement misc functions needed by Solver
   3 Copyright (C) 2000 Dan Stanger
   4
   5 This library is free software; you can redistribute it and/or modify it
   6 under the terms of the GNU Library General Public License as published
   7 by the Free Software Foundation; either version 2 of the License, or (at
   8 your option) any later version.
   9
  10 This library is distributed in the hope that it will be useful, but
  11 WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 Library General Public License for more details.
  14
  15 You should have received a copy of the GNU Library General Public
  16 License along with this library; if not, write to the Free Software
  17 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
  18
  19 Dan Stanger dan.stanger@ieee.org
  20 please contact me for updates to this code
  21 */
  22
  23 /******************************************************************************/
  24 /* Powers creates a list of low powers in a variable                          */
  25 /******************************************************************************/
  26
  27 Powers(e,v) :=
  28   if atom(e) then [lopow(e,v)]
  29   else if part(e,0)="+" or part(e, 0)="-" then
  30     maplist(lambda([p],lopow(p,v)), e)
  31   else
  32     [lopow(e,v)]$
  33
  34 /******************************************************************************/
  35 /* pop pops the first element off a list and returns it                       */
  36 /******************************************************************************/
  37
  38 Pop(l) ::= buildq([l],block([t:first(l)],l:rest(l),t))$
  39
  40 /******************************************************************************/
  41 /* Set_Element modifies lists or matrixes and returns the list or matrix      */
  42 /******************************************************************************/
  43
  44 Set_Element(o,i,j, [l]):=
  45   if matrixp(o) then (
  46     if l # [] then (
  47       o[i,j]:first(l),
  48       o
  49     )
  50     else (
  51       o[i]:j,
  52       o
  53     )
  54   )
  55   else (
  56     o[i]:j,
  57     o
  58   )$
  59
  60 EquationP(eq) := part(eq,0)="="$
  61
  62 /******************************************************************************/
  63 /* Solver does not know maxima sets - workarounds for set functions.          */
  64 /******************************************************************************/
  65
  66 Setify(lst) :=
  67   if length(lst)=0 then []
  68   else append([lst[1]], Setify(delete(lst[1], lst)))$
  69
  70 DisjointP(l1, l2) := disjointp(setify(l1), setify(l2))$
  71
  72 Intersection(l1, l2) :=
  73   if length(l1)=0 then []
  74   else if member(l1[1], l2) then append([l1[1]], Intersection(rest(l1), l2))
  75   else Intersection(rest(l1), l2)$
  76
  77 SetDifference(l1, l2) := listify(setdifference(setify(l1), setify(l2)))$
  78
  79 Union([l]) := lreduce(Union2, l)$
  80
  81 Union2(l1, l2) :=
  82   if length(l2)=0 then l1
  83   else if not(member(l2[1], l1)) then Union2(append(l1, [l2[1]]), rest(l2))
  84   else Union2(l1, rest(l2))$
  85
  86 /******************************************************************************/
  87 /* Some work arounds for case sensitivity and function name changes.          */
  88 /******************************************************************************/
  89
  90 Empty( e) :=emptyp( e)$
  91 ZeroP( n) :=equal(n,0)$
  92 Flatten( e) :=flatten(e)$