← Back to branch summary

~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to src/csimp2.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2010-04-30 13:30:33 UTC
  • mto: This revision was merged to the branch mainline in revision 12.
  • Revision ID: james.westby@ubuntu.com-20100430133033-wtewap0zdnmsix1y
Tags: upstream-5.21.1
Import upstream version 5.21.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/csimp2.lisp
108
108
                     ((alike1 r '((mexpt) 3 ((rat) -1 2)))
109
109
                      (archk a b (list '(mtimes) '((rat) 1 6) '$%pi))))))))
110
110
 
111
 
(defmfun simpbinocoef (x vestigial z) 
 
111
;; Binomial has Mirror symmetry
 
112
(defprop %binomial t commutes-with-conjugate)
 
113
 
 
114
(defun simpbinocoef (x vestigial z)
112
115
  (declare (ignore vestigial))
113
116
  (twoargcheck x)
114
117
  (let ((u (simpcheck (cadr x) z))
116
119
        (y))
117
120
    (cond ((integerp v)
118
121
           (cond ((minusp v)
119
 
                  (if (and (integerp u) (minusp u) (< v u)) (bincomp u (- u v)) 0))
 
122
                  (if (and (integerp u) (minusp u) (< v u))
 
123
                      (bincomp u (- u v))
 
124
                      0))
120
125
                 ((or (zerop v) (equal u v)) 1)
121
 
                 ((and (integerp u) (not (minusp u))) (bincomp u (min v (- u v))))
 
126
                 ((and (integerp u) (not (minusp u)))
 
127
                  (bincomp u (min v (- u v))))
122
128
                 (t (bincomp u v))))
123
 
          ((integerp (setq y (sub u v))) (bincomp u y))
124
 
          ((and (floatp u) (floatp v)) ($makegamma (list '(%binomial) u v)))
125
 
          (t (eqtest (list '(%binomial) u v) x)))))
 
129
          ((integerp (setq y (sub u v)))
 
130
           (cond ((zerop1 y)
 
131
                  ;; u and v are equal, simplify not if argument can be negative
 
132
                  (if (member ($csign u) '($pnz $pn $neg $nz))
 
133
                      (eqtest (list '(%binomial) u v) x)
 
134
                      (bincomp u y)))
 
135
                 (t (bincomp u y))))
 
136
          ((complex-float-numerical-eval-p u v)
 
137
           ;; Numercial evaluation for real and complex floating point numbers.
 
138
           (let (($numer t) ($float t))
 
139
             ($rectform
 
140
               ($float 
 
141
                 ($makegamma (list '(%binomial) ($float u) ($float v)))))))
 
142
          ((complex-bigfloat-numerical-eval-p u v)
 
143
           ;; Numerical evaluation for real and complex bigfloat numbers.
 
144
           ($rectform
 
145
             ($bfloat
 
146
               ($makegamma (list '(%binomial) ($bfloat u) ($bfloat v))))))
 
147
          (t (eqtest (list '(%binomial) u v) x)))))
126
148
 
127
149
(defun bincomp (u v) 
128
150
  (cond ((minusp v) 0)