share/contrib/format/coeflistp.lisp

   1 ;;; -*- Mode: LISP; Syntax: Common-lisp; Package: CLIMAX; Base: 10 -*-
   2 ;;;>******************************************************************************************
   3 ;;;>   Software developed by Bruce R. Miller
   4 ;;;>   using Symbolics Common Lisp (system 425.111, ivory revision 4)
   5 ;;;>   at NIST - Computing and Applied Mathematics Laboratory
   6 ;;;>   a part of the U.S. Government; it is therefore not subject to copyright.
   7 ;;;>******************************************************************************************
   8
   9 (in-package 'climax)
  10
  11 ;;; To run in Schelter's Maxima comment the above and uncomment these:
  12 ;(in-package 'maxima)
  13 ;(defmacro mexp-lookup (item alist) `(assolike ,item ,alist))
  14 ;(defmacro mlist* (arg1 &rest more-args) `(list* '(mlist simp) ,arg1 ,@more-args))
  15
  16 ;;;;******************************************************************************************
  17 ;;;; Needed, but unrelated, stuff.  Possibly useful in its own right
  18 ;;;;******************************************************************************************
  19 ;;; Returns an mlist of all subexpressions of expr which `match' predicate.
  20 ;;; Predicate(expr,args,...) returns non-nil if the expression matches.
  21 ;;; [eg. a function constructed by $defmatch]
  22 (defun $matching_parts (expr predicate &rest args)
  23   (let ((matches nil))
  24     (labels ((srch (expr)
  25                (when (specrepp expr)
  26                  (setq expr (specdisrep expr)))
  27                (when (apply #'mfuncall predicate expr args)
  28                  (pushnew expr matches :test #'alike1))
  29                (unless (atom expr)
  30                  (mapc #'srch (cdr expr)))))
  31       (srch expr)
  32       (mlist* matches))))
  33
  34 ;;; Return an  mlist of all unique function calls of the function(s) FCNS in EXPR.
  35 ;;; (FCNS can also be a single function)
  36 (defun $function_calls (expr &rest functions)
  37   ;; Coerce fcns to a list of function names.
  38   (let ((fcns (mapcar #'(lambda (x)(or (get (setq x (getopr x)) 'verb) x)) functions)))
  39     ($matching_parts expr #'(lambda (p)(and (listp p)(member (caar p) fcns))))))
  40
  41 ;;; Return an mlist of all unique arguments used by FCNS in EXPR.
  42 (defun $function_arguments (expr &rest functions)
  43   (mlist* (remove-duplicates (cdr (map1 #'$args (apply #'$function_calls expr functions)))
  44                              :test #'alike1)))
  45
  46 ;;; $totaldisrep only `disrep's CRE (mrat), but not POIS!
  47 (defun totalspecdisrep (expr)
  48   (cond ((atom expr) expr)
  49         ((not (or (among 'mrat expr)(among 'mpois expr))) expr)
  50         ((eq (caar expr) 'mrat)(ratdisrep expr))
  51         ((eq (caar expr) 'mpois) ($outofpois expr))
  52         (t (cons (remove 'ratsimp (car expr))(mapcar 'totalspecdisrep (cdr expr))))))
  53
  54 ;;;;******************************************************************************************
  55 ;;;; Variable Lists
  56 ;;; A variable list consists of a list of variables, simple expressions and specs like
  57 ;;;   OPERATOR(fcn) or OPERATOR(fcn,...) represents ALL calls to fcn in the expression.
  58 ;;;   MATCH(fcn,arg..) represents subexpressions of expression which pass FCN(subexpr,args..)
  59 ;;; Instantiating the variable list involves replacing those special cases with those
  60 ;;; subexpressions of the relevant expression which pass the test.
  61 ;;;;******************************************************************************************
  62
  63 (defun instanciate-variable-list (vars expr caller &optional max-vars)
  64   (let ((ivars (mapcan #'(lambda (var)
  65                            (setq var (totalspecdisrep var))
  66                            (case (and (listp var)(caar var))
  67                              ($operator (cdr (apply #'$function_calls expr (cdr var))))
  68                              ($match    (cdr (apply #'$matching_parts expr (cdr var))))
  69                              (t (list var))))
  70                        vars)))
  71     (when (and max-vars (> (length ivars) max-vars))
  72       (merror "Too many variables for ~M: ~M" caller (mlist* ivars)))
  73     ivars))
  74
  75 ;;;;******************************************************************************************
  76 ;;;; Helpers
  77 ;;;;******************************************************************************************
  78
  79 ;;; Similar to lisp:reduce with the :key keyword.
  80 ;;; Apparently, the Lisp underneath the Sun version doesn't support it. Ugh.
  81 ;  (defmacro cl-reduce (function list key) `(lisp:reduce ,function ,list :key ,key))
  82
  83 (defun cl-reduce (function list key)
  84   (if (null list) nil
  85       (let ((result (funcall key (car list))))
  86         (dolist (item (cdr list))
  87           (setq result (funcall function result (funcall key item))))
  88         result)))
  89
  90 (defun map-mlist (list) (mapcar #'(lambda (e)(mlist* e)) list))
  91
  92 ;;;******************************************************************************************
  93 ;;; Coefficient List = Pseudo-polynomial : as list of ( (coefficient power(s) ...) ...)
  94 ;;;     coefficient: the coefficient of the monomial (anything algebraic thing)
  95 ;;;     power(s) : the power(s) of the variable(s) in the monomial (any algebraic thing)
  96 ;;; Pairs are sorted into increasing order of the power(s).
  97 ;;; 0 is represented by NIL.
  98 ;;;******************************************************************************************
  99 ;;; NOTE on ordering of terms.  The Macsyma predicate GREAT (& friends lessthan, etc)
 100 ;;; define a total ordering, but if non-numeric elements are allowed, the ordering is not
 101 ;;; robust under addition, eg L=[1,2,m] is in order, but L+m=[m,m+2,2*m] is not.
 102 ;;; We define the ordering of A & B by determining the `sign' of A-B, where the sign is
 103 ;;; the sign of the coefficient of the leading (highest degree) term.  We can use SIGNUM1
 104 ;;; for this.
 105 ;;;******************************************************************************************
 106
 107 ;;;******************************************************************************************
 108 ;;; CLIST Arithmetic
 109
 110 ;;; Add two CLISTs
 111 (defun clist-add (l1 l2)
 112   (do ((result nil))
 113       ((not (and l1 l2)) (if (or l1 l2)(nconc (nreverse result)(or l1 l2)) (nreverse result)))
 114     (do ((p1 (cdar l1) (cdr p1))
 115          (p2 (cdar l2) (cdr p2)))
 116         ((or (null p1) (not (alike1 (car p1)(car p2))))
 117          (if p1
 118              (push (if (plusp (signum1 (sub (car p1)(car p2))))(pop l2)(pop l1)) result)
 119              (let ((c3 (add (caar l1)(caar l2))))       ;If power is same, combine
 120                (unless (zerop1 c3)              ;And accumulate result, unless zero.
 121                  (push (cons c3 (cdar l1)) result))
 122                (pop l1)(pop l2)))))))
 123
 124 ;;; Multiply two CLISTs
 125 ;;; Optional ORDER is for use by series arithmetic (single variable): truncates powers>order
 126 (defun clist-mul (l1 l2 &optional order)
 127   (when (and l1 l2)
 128     (when (> (length l1)(length l2))            ; make l1 be shortest
 129       (psetq l1 l2 l2 l1))
 130     (let ((rl2 (reverse l2)))
 131       (flet ((mul1 (pair1)
 132                (let ((c1 (car pair1)) (p1 (cdr pair1)) result)
 133                  (dolist (i2 rl2)
 134                    (let ((p (mapcar #'add p1 (cdr i2))))
 135                      (unless (and order (great (car p) order))
 136                        (push (cons (mul c1 (car i2)) p) result))))
 137                  result)))
 138         (cl-reduce #'clist-add l1 #'mul1)))))
 139
 140 ;;; Take the Nth power of a CLIST, using "binary expansion of the exponent" method.
 141 ;;; Built-in code to handle P^2, instead of P*P.
 142 (defun clist-pow (l n)                          ; Assumes n>0
 143   (cond ((null l) nil)                          ; l=0 -> 0 (nil)
 144         ((null (cdr l))                         ; single term, trivial
 145          `((,(power (caar l) n) ,@(mapcar #'(lambda (p)($expand (mul p n)))(cdar l)))))
 146         (t (let ((l^i l) (l^n (if (logtest n 1) l)))
 147              (do ((bits (lsh n -1)(lsh bits -1)))
 148                  ((zerop bits) l^n)
 149                (do ((sq nil)                    ; Square l^i
 150                     (ll (reverse l^i) (cdr ll)))
 151                    ((null ll) (setq l^i sq))
 152                  (let* ((c1 (caar ll)) (2c1 (mul 2 c1))(p1 (cdar ll))
 153                         (psq (list (cons (power c1 2)(mapcar #'add p1 p1)))))
 154                    (dolist (lll (cdr ll))
 155                      (push (cons (mul 2c1 (car lll))(mapcar #'add p1 (cdr lll))) psq))
 156                    (setq sq (if sq (clist-add sq psq) psq))))
 157                (if (logtest bits 1) (setq l^n (if l^n (clist-mul l^n l^i) l^i))))))))
 158
 159 ;;; An MBAG includes lists, arrays and equations.
 160 ;;; Given the list of {list|array|equation} elements which have been converted to CLIST's,
 161 ;;; this function combines them into a single clist whose coefficients
 162 ;;; are {list|array|equation}s
 163
 164 (defun clist-mbag (op clists)
 165   (let ((z (if (eq op '$matrix)                 ; the `zero' of a matrix is an mlist of 0's!!!
 166                (mlist* (make-list (length (cdaaar clists)) :initial-element 0))
 167                0)))
 168     (flet ((keylessp (l1 l2)                    ; does key l1 precede l2?
 169              (do ((l1 l1 (cdr l1))
 170                   (l2 l2 (cdr l2)))
 171                  ((or (null l1)(not (alike1 (car l1)(car l2))))
 172                   (and l1 (minusp (signum1 (sub (car l1)(car l2)))))))))
 173       (mapcar #'(lambda (p)
 174                   `(((,op)
 175                      ,@(mapcar #'(lambda (l)(or (car (rassoc p l :test #'alike)) z)) clists))
 176                     ,@p))
 177               (sort (cl-reduce #'union1 clists #'(lambda (e)(mapcar #'cdr e))) #'keylessp)))))
 178
 179 ;;;;******************************************************************************************
 180 ;;;; Transform an expression into its polynomial coefficient list form.
 181
 182 (defun $coeffs (expr &rest vars)
 183   (setq expr (totalspecdisrep expr))
 184   (let* ((vs (instanciate-variable-list vars expr '$coeffs))
 185          (zeros (make-list (length vs) :initial-element 0))
 186          (cache nil))
 187     (dolist (v vs)                              ; preload the cache w/ encoded variables
 188       (let ((u (copy-list zeros)))
 189         (setf (nth (position v vs) u) 1)
 190         (push (cons v (list (cons 1 u))) cache)))
 191     (labels ((gcf (expr)                        ; Get coefficients.
 192                (or (mexp-lookup expr cache)     ; reuse cached value
 193                    (cdar (push (cons expr (gcf1 expr)) cache))))        ; or compute & store
 194              (gcf1 (expr)
 195                (let ((op (and (listp expr)(caar expr))) x y)
 196                  (cond ((mbagp expr)    (clist-mbag op (mapcar #'gcf (cdr expr))))
 197                        ((or (null op)(not (dependsall expr vs))) `((,expr . ,zeros)))
 198                        ((eq op 'mplus)  (cl-reduce #'clist-add (cdr expr) #'gcf))
 199                        ((eq op 'mtimes) (cl-reduce #'clist-mul (cdr expr) #'gcf))
 200                        ((and (eq op 'mexpt)     ; Check that we can actually compute X^Y:
 201                              (setq x (gcf (second expr)) y (third expr))
 202                              (or (and (integerp y)(plusp y))    ; Either integer y > 0
 203                                  (and (null (cdr x))    ; or x is a single monomial
 204                                       (not (dependsall y vs))   ; w/ y must be free of vars
 205                                       (or (eql $radexpand '$all) ; & dont care about cuts
 206                                           (integerp y)  ; or y is an integer
 207                                           (every #'(lambda (p)(or (zerop1 p)(onep p)))
 208                                                  (cdar x))))))  ; or x is linear in vars.
 209                         (clist-pow x y))        ; OK, so we CAN compute x^y (whew).
 210                        (t `((,expr . ,zeros)))))))
 211       (mlist* (mlist* '$%poly vs)(map-mlist (gcf expr))))))
 212
 213 ; Inverse of above: make an expression out of clist.
 214 ;;; Actually works for SERIES & Taylor too.
 215 (defun unclist (clist vars)
 216   (addn (mapcar #'(lambda (e)(mul (cadr e)(muln (mapcar #'power vars (cddr e)) t))) clist) t))
 217
 218 ;;;********************************************************************************
 219 ;;; TRIG SERIES
 220 ;;; Given an expression and a list of variables, v_i, construct the list of sine & cosine
 221 ;;; coefficients & multiples of the variables in the expression:
 222 ;;;  [[%trig, v_1, ...] sine_list, cosine_list]
 223 ;;;     sine_list: [[c,m_1,...],[c',m_1',...]....]
 224 ;;;     cosine_list: " "
 225 ;;;
 226 ;;; Use POISSON Series facilities to construct coefficient list.
 227 ;;;  1) Find maximum multiples for each variable and ensure that the poisson series
 228 ;;;     parameters can accommodate the expression.
 229 ;;;  2) use INTOPOIS to convert to POISSON representation.
 230 ;;;  3) walk the poisson form constructing the list of coefficients & multipliers.
 231 ;;;********************************************************************************
 232
 233 ;;; The declaration inside SHOULD be enough, but AKCL apparently doesn't handle it correctly
 234 (proclaim '(special $poisvars $poislim $pois_encode_liberalize
 235                     *pois-encoding* poishift *pois-guard* *poisz* *pois1*))
 236
 237 (defun $trig_coeffs (expr &rest vars)
 238   (unless (or (fboundp '$intopois) (mfboundp '$intopois))       ; Is this the `Right Way'?
 239     (load-function '$intopois nil))
 240   (setq expr (totalspecdisrep expr))
 241   (let* ((vars (instanciate-variable-list vars expr '$trig_coeffs))
 242          ($poisvars (mlist* vars))($poislim nil)($pois_encode_liberalize t)
 243          *pois-encoding* poishift *pois-guard* *poisz* *pois1*)
 244     (declare (special $poisvars $poislim $pois_encode_liberalize
 245                       *pois-encoding* poishift *pois-guard* *poisz* *pois1*))
 246     (unless (dependsall expr vars)
 247       (return-from $trig_coeffs
 248         (mlist* (mlist* '$%TRIG vars)'((mlist))
 249                 (mlist* (mlist* expr (mapcar #'(lambda (v) 0) vars)) nil) nil)))
 250     (pois-setup $poisvars $poislim)
 251     (flet ((make1 (pairs)
 252              (do ((p pairs (cddr p))
 253                   (l nil))
 254                  ((null p) (nreverse l))
 255                (push (cons (poiscdecode (cadr p)) (poisarg-unpack (car p))) l))))
 256       (labels ((makem (expr)
 257                  (if (mbagp expr)
 258                      (let ((elements (mapcar #'makem (cdr expr))))
 259                        (list (clist-mbag (caar expr) (mapcar #'car elements))
 260                              (clist-mbag (caar expr) (mapcar #'cadr elements))))
 261                      (let ((pois (intopois expr)))
 262                        (list (make1 (cadr pois)) (make1 (caddr pois)))))))
 263         (let ((trig (makem expr)))
 264           (mlist* (mlist* '$%trig vars)
 265                   (mlist* (map-mlist (car trig)))(mlist* (map-mlist (cadr trig))) nil))))))
 266
 267 (defun untlist (tlist vars)
 268   (flet ((un1 (list trig)
 269            (flet ((un2 (e)(mul (cadr e)(cons-exp trig (multl (cddr e) vars)))))
 270              (addn (mapcar #'un2 list) t))))
 271     (addn (mapcar #'un1 tlist '(%sin %cos)) t)))
 272
 273 ;;;********************************************************************************
 274 ;;; SERIES & TAYLOR
 275 ;;; Given an expression, a variable and an order, compute the coefficients of the
 276 ;;; expansion of the expression about variable=0 to order ORDER.
 277 ;;;  -> [[%series,variable,order],[c,p],[c',p'],...]
 278 ;;;  or [[%taylor,variable,order],[c,p],[c',p'],...]
 279 ;;; The difference is that TAYLOR computes the Taylor expansion, whereas
 280 ;;; SERIES only carries out the expansion over arithmetic functions (+,*,exp) and thus
 281 ;;; is significantly faster.
 282 ;;;********************************************************************************
 283
 284 (defun $taylor_coeffs (expr var order)
 285   (setq expr (totalspecdisrep expr))
 286   (let ((var (car (instanciate-variable-list (list var) expr '$taylor_coeffs 1))))
 287     (labels ((make1 (expr)
 288                (cond ((mbagp expr)      (clist-mbag (caar expr) (mapcar #'make1 (cdr expr))))
 289                      ((freeof var expr) (list (list expr 0)))
 290                      (t (let* ((r ($taylor expr var 0 order))
 291                                (ohdr (car r))
 292                                (hdr (list (first ohdr)(second ohdr)(third ohdr)(fourth ohdr))))
 293                           (if (eq (second r) 'ps)
 294                               (mapcar #'(lambda (p)
 295                                           (list (specdisrep (cons hdr (cdr p)))
 296                                                 (cons-exp 'rat (caar p)(cdar p))))
 297                                       (cddddr r))
 298                               (list (list (specdisrep (cons hdr (cdr r))) 0))))))))
 299       (mlist* (mlist* '$%taylor var order nil)(map-mlist (make1 expr))))))
 300
 301 ;;;;******************************************************************************************
 302 ;;;; SLIST Arithmetic.
 303 ;;; The addition & multiplication of polynomial arithmetic are used.
 304
 305 ;;; compute the N-th power of S through ORDER.
 306 (defun slist-pow (s n order)
 307   (when s
 308     (let* ((m (cadar s))
 309            (nm (mul n m))
 310            (s_m (caar s))
 311            (p (list (list (power s_m n) nm))))  ; 1st term of result
 312       (if (null (cdr s))                        ; Single term
 313           (or (great nm order) p)               ; then trivial single term (unless high order)
 314           (let* ((g (cl-reduce #'$gcd s #'(lambda (x)(sub (cadr x) m))))
 315                  (kmax (div (sub order nm) g)))
 316             (do ((k 1 (1+ k)))
 317                 ((great k kmax) (nreverse p))
 318               (let ((ff (div (add 1 n) k))
 319                     (trms nil))
 320                 (dolist (s (cdr s))
 321                   (let ((i (div (sub (cadr s) m) g)))
 322                     (when (lessthan k i)(return))
 323                     (let ((e (member (add nm (mul (sub k i) g)) p :key #'cadr :test #'like)))
 324                       (when e                   ; multthru limits expression depth
 325                         (push ($multthru (mul (sub (mul i ff) 1) (car s) (caar e))) trms)))))
 326                 (let ((pk ($multthru (div (addn trms t) s_m))))
 327                   (unless (zerop1 pk)
 328                     (push (list pk (add nm (mul k g))) p))))))))))
 329
 330 ;;;;******************************************************************************************
 331 ;;;; Extracting Series Coefficients.
 332
 333 (defun $series_coeffs (expr var order)
 334   (setq expr (totalspecdisrep expr))
 335   (let ((v (car (instanciate-variable-list (list var) expr '$series_coeffs 1))))
 336     (setq v ($ratdisrep v))
 337     (labels ((mino (expr)                       ; Find minimum power of V in expr (for mult)
 338                (let ((op (and (listp expr)(caar expr))))
 339                  (cond ((like expr v)   1)      ; Trivial case: expr is V itself
 340                        ((or ($atom expr)(freeof v expr)) 0)     ; `constant' case
 341                        ((member op '(mplus mlist mequal $matrix))
 342                         (cl-reduce #'$min (cdr expr) #'mino))
 343                        ((eq op 'mtimes)  (cl-reduce #'add (cdr expr) #'mino))
 344                        ((and (eq op 'mexpt)($numberp (third expr)))     ; can we compute?
 345                         (mul (mino (second expr)) (third expr)))
 346                        (t 0))))                 ; oh, well, Treat it as constant.
 347              (gcf (expr order)
 348                (let ((op (and (listp expr)(caar expr))))
 349                  (cond ((like expr v)   `((1 1)))       ; Trivial case: expr is V itself
 350                        ((or ($atom expr)(freeof v expr)) `((,expr 0)))  ; `constant' case
 351                        ((mbagp expr)
 352                         (clist-mbag op (mapcar #'(lambda (el)(gcf el order))(cdr expr))))
 353                        ((eq op 'mplus)
 354                         (cl-reduce #'clist-add (cdr expr) #'(lambda (el)(gcf el order))))
 355                        ((eq op 'mtimes)
 356                         (let* ((ms (mapcar #'mino (cdr expr)))
 357                                (mtot (addn ms t))
 358                                (prod '((1 0))))
 359                           (unless (great mtot order)
 360                             (do ((terms (cdr expr)(cdr terms))
 361                                  (m ms (cdr m)))
 362                                 ((null terms) prod)
 363                               (let ((term (gcf (car terms) (sub (add order (car m)) mtot))))
 364                                 (setq prod (clist-mul term prod order)))))))
 365                        ((and (eq op 'mexpt)($numberp (third expr)))     ; can we compute?
 366                         (slist-pow (gcf (second expr) order)(third expr) order))
 367                        (t `((,expr 0)))))))     ; just treat it as constant.
 368       (mlist* (mlist* '$%series v order nil)(map-mlist (gcf expr order))))))
 369
 370 (defun unslist (clist vars)
 371   ($trunc (unclist clist vars)))
 372
 373 ;;;********************************************************************************
 374 ;;; Find the coefficient associated with keys (powers or multiples) in the
 375 ;;; coefficient list clist.
 376 (defun $get_coef (clist &rest keys)
 377   (let ((sublist (case (and ($listp clist)($listp (cadr clist))(cadr (cadr clist)))
 378                    (($%poly $%series $%taylor) (cddr clist))
 379                    ($%trig (case (car keys)
 380                              (($sin %sin) (cdr (third clist)))
 381                              (($cos %cos) (cdr (fourth clist)))
 382                              (otherwise (merror "First KEY must be SIN or COS"))))
 383                    (otherwise (merror "Unknown coefficient list type: ~M" clist)))))
 384     (or (cadar (member keys sublist :test #'alike :key #'cddr)) 0)))
 385
 386 ;;; Reconstruct a macsyma expression from a coefficient list.
 387 (defun $uncoef (cl)
 388   (let ((spec (and ($listp cl)(second cl))))
 389     (case (and ($listp spec)(second spec))
 390       ($%poly  (unclist (cddr cl) (cddr spec)))
 391       (($%series $%taylor) (unslist (cddr cl) (cddr spec)))
 392       ($%trig   (untlist (mapcar #'cdr (cddr cl)) (cddr spec)))
 393       (otherwise (merror "UNCOEF: Unrecognized COEFFS form: ~M" cl)))))
 394
 395 ;;;********************************************************************************
 396 ;;; Partition a polynomial, trig series or series into those terms whose
 397 ;;; powers (or multiples) pass a certain test, and those who dont.
 398 ;;; Returns the pair [passed, failed].
 399 ;;; The TEST is applied to the exponents or multiples of each term.
 400
 401 (defun partition-clist (list test)
 402   (cond ((null test) (values nil list))
 403         ((eq test t) (values list nil))
 404         (t  (let ((pass nil)(fail nil))
 405               (dolist (item list)
 406                 (if ($is-boole-eval (mapply test (cddr item) '$partition_test))
 407                     (push item pass)
 408                     (push item fail)))
 409               (values (nreverse pass)(nreverse fail))))))
 410
 411 (defun $partition_poly (expr test &rest vars)
 412   (let* ((clist (apply #'$coeffs expr vars))
 413          (vars (cddr (second clist))))
 414     (multiple-value-bind (p f)(partition-clist (cddr clist) test)
 415       (mlist* (unclist p vars)(unclist f vars) nil))))
 416
 417 (defun $partition_trig (expr sintest costest &rest vars)
 418   (let* ((tlist (apply #'$trig_coeffs expr vars))
 419          (vars (cddr (second tlist))))
 420     (multiple-value-bind (sp sf)(partition-clist (cdr (third tlist)) sintest)
 421       (multiple-value-bind (cp cf)(partition-clist (cdr (fourth tlist)) costest)
 422         (mlist* (untlist (list sp cp) vars) (untlist (list sf cf) vars) nil)))))
 423
 424 (defun $partition_series (expr test var order)
 425   (let* ((clist ($series_coeffs expr var order))
 426          (var (caddr (second clist))))
 427     (multiple-value-bind (p f)(partition-clist (cddr clist) test)
 428       (mlist* (unslist p var)(unslist f var) nil))))
 429
 430 (defun $partition_taylor (expr test var order)
 431   (let* ((clist ($taylor_coeffs expr var order))
 432          (var (caddr (second clist))))
 433     (multiple-value-bind (p f)(partition-clist (cddr clist) test)
 434       (mlist* (unslist p var)(unslist f var) nil))))