?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
SRRAT: use MRAT reader functions instead of CADDAR, etc.
[maxima.git] / archive / src / nusum.lisp
blobab278b17cdcc3577c340bc542d458b86fa754c75
1 ;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
2 ;;;Translated on: 4/21/85 11:00:16
3 (in-package :maxima)
4
5 (eval-when (compile eval load)
6 (eval-when (compile eval load)
7 (defprop $dva t translated)
8 (add2lnc '$dva $props)
9 (defmtrfun ($dva $any mdefmacro nil nil)
10 ($var)
11 nil
12 (mbuildq-subst (list (cons '$var $var))
13 '(($define_variable) $var
14 ((mquote) $var) $any)))))
15 (eval-when (compile eval load)
16 (meval* '(($modedeclare) $%n $any))
17 (meval* '(($declare) $%n $special))
18 nil
19 (def-mtrvar $%n '$%n))
20 (eval-when (compile eval load)
21 (meval* '(($modedeclare) $%pw $any))
22 (meval* '(($declare) $%pw $special))
23 nil
24 (def-mtrvar $%pw '$%pw))
25 (eval-when (compile eval load)
26 (meval* '(($modedeclare) $%f $any))
27 (meval* '(($declare) $%f $special))
28 nil
29 (def-mtrvar $%f '$%f))
30 (eval-when (compile eval load)
31 (meval* '(($modedeclare) $%f1 $any))
32 (meval* '(($declare) $%f1 $special))
33 nil
34 (def-mtrvar $%f1 '$%f1))
35 (eval-when (compile eval load)
36 (meval* '(($modedeclare) $l% $any))
37 (meval* '(($declare) $l% $special))
38 nil
39 (def-mtrvar $l% '$l%))
40 (eval-when (compile eval load)
41 (meval* '(($modedeclare) $solvep $any))
42 (meval* '(($declare) $solvep $special))
43 nil
44 (def-mtrvar $solvep '$solvep))
45 (eval-when (compile eval load)
46 (meval* '(($modedeclare) $%r $any))
47 (meval* '(($declare) $%r $special))
48 nil
49 (def-mtrvar $%r '$%r))
50 (eval-when (compile eval load)
51 (meval* '(($modedeclare) $p $any))
52 (meval* '(($declare) $p $special))
53 nil
54 (def-mtrvar $p '$p))
55 (eval-when (compile eval load)
56 (meval* '(($modedeclare) $%cf $any))
57 (meval* '(($declare) $%cf $special))
58 nil
59 (def-mtrvar $%cf '$%cf)
60 (proclaim '(special $%0 $%1 $%% $y $maperror $mapprint
61 ;$%2 $n $%n $%pw $p $%g ;thing the problem was errset.
62 ))
63 )
64 (eval-when (compile eval load)
65 (defprop $algebraicp t translated)
66 (add2lnc '$algebraicp $props)
67 (defmtrfun
68 ($algebraicp $boolean mdefine nil nil)
69 ($%1)
70 nil
71 ((lambda
72 nil
73 ((lambda
74 (mcatch)
75 (prog2
76 nil
77 (catch
78 'mcatch
79 (progn
80 (simplify
81 ($substitute
82 (simplify
83 (list
84 '(mequal)
85 '&^
86 (m-tlambda
87 ($%1 $%2)
88 nil
89 (cond
90 ((not ($integerp $%2))
91 ((lambda (x)
92 (cond ((null mcatch)
93 (displa x)
94 (merror "`throw' not within `catch'")))
95 (throw 'mcatch x))
96 t))))))
97 $%1))
98 nil))
99 (errlfun1 mcatch)))
100 (cons bindlist loclist))))))
101 (eval-when (compile eval load)
102 (defprop $hicoef t translated)
103 (add2lnc '$hicoef $props)
104 (defmtrfun ($hicoef $any mdefine nil nil)
105 ($x $n)
106 nil
107 (progn (setq $x (simplify ($ratsimp $x $n)))
108 (simplify ($coeff $x $n (simplify ($hipow $x $n)))))))
109 (eval-when (compile eval load)
110 (defprop $genpol t translated)
111 (add2lnc '$genpol $props)
112 (defmtrfun ($genpol $any mdefine nil nil)
113 ($n)
114 nil
115 (cond ((is-boole-check (mlsp $n 0)) 0)
116 (t (add* (simplify ($concat '$% $n))
117 (mul* (trd-msymeval $%n '$%n)
118 (simplify ($genpol (add* $n -1)))))))))
119 (eval-when (compile eval load)
120 (defprop $clist t translated)
121 (add2lnc '$clist $props)
122 (defmtrfun
123 ($clist $any mdefine nil nil)
124 ($p)
125 nil
126 (cond
127 ((like 0 (trd-msymeval $p '$p)) '((mlist)))
128 (t
129 ($cons
130 (simplify
131 ($ratdisrep (setq $%pw (simplify ($ratcoef (trd-msymeval $p '$p)
132 (trd-msymeval $%n '$%n)
133 0)))))
134 (simplify ($clist (ratf (div (add* (trd-msymeval $p '$p)
135 (*mminus (trd-msymeval $%pw
136 '$%pw)))
137 (trd-msymeval $%n '$%n))))))))))
138 (eval-when (compile eval load)
139 (defprop $unsum t translated)
140 (add2lnc '$unsum $props)
141 (defmtrfun
142 ($unsum $any mdefine nil nil)
143 ($%g $%n)
144 nil
145 (cond
146 ((or ($atom $%g)
147 (not (like ($part $%g 0) '&+)))
148 (simplify
149 ($factor
150 (mul*
151 (add*
152 (div
153 ($num $%g)
154 (simplify
155 ($substitute (add* (trd-msymeval $%n '$%n) -1)
156 (trd-msymeval $%n '$%n)
157 (simplify ($prodgunch ($num $%g)
158 (trd-msymeval $%n '$%n)
159 1)))))
160 (*mminus
161 (div
162 ($denom $%g)
163 (simplify
164 ($substitute (add* (trd-msymeval $%n '$%n) -1)
165 (trd-msymeval $%n '$%n)
166 (simplify ($prodgunch ($denom $%g)
167 (trd-msymeval $%n '$%n)
168 1)))))))
169 (div (simplify ($substitute (add* (trd-msymeval $%n '$%n) -1)
170 (trd-msymeval $%n '$%n)
171 ($num $%g)))
172 ($denom $%g))))))
173 (t
174 (simplify
175 (map1 (getopr (m-tlambda ($x)
176 nil
177 (simplify ($unsum $x
178 (trd-msymeval $%n '$%n)))))
179 $%g))))))
180 (eval-when (compile eval load)
181 (defprop $prodflip t translated)
182 (add2lnc '$prodflip $props)
183 (defmtrfun
184 ($prodflip $any mdefine nil nil)
185 ($%0)
186 nil
187 (simplify
188 ($substitute
189 (list
190 '(mlist)
191 (simplify (list '(mequal) (simplify ($nounify '$product)) '$product))
192 (simplify
193 (list '(mequal)
194 '$product
195 (m-tlambda ($%0 $%1 $% $%%)
196 nil
197 (div 1
198 (simplify ($produ (div 1 $%0)
199 $%1
200 (trd-msymeval $% '$%)
201 (trd-msymeval $%% '$%%))))))))
202 $%0))))
203 (eval-when (compile eval load)
204 (defprop $prodgunch t translated)
205 (add2lnc '$prodgunch $props)
206 (defmtrfun
207 ($prodgunch $any mdefine nil nil)
208 ($%0 $%n $%2)
209 nil
210 (simplify
211 ($substitute
212 (list
213 '(mlist)
214 (simplify
215 (list
216 '(mequal)
217 (simplify ($nounify '%sin))
218 (m-tlambda&env
219 (($%0) ($%2))
220 nil
221 (mul*
222 (simplify
223 (list '(%sin)
224 (simplify ($substitute (add* (trd-msymeval $%n '$%n)
225 $%2)
226 (trd-msymeval $%n '$%n)
227 $%0))))
228 ((lambda
229 ($trigexpand)
230 nil
231 (simplify
232 ($expand
233 (div
234 (simplify (list '(%sin) $%0))
235 (simplify
236 (list
237 '(%sin)
238 (simplify ($substitute (add* (trd-msymeval $%n
239 '$%n)
240 $%2)
241 (trd-msymeval $%n '$%n)
242 $%0))))))))
243 t)))))
244 (simplify
245 (list
246 '(mequal)
247 (simplify ($nounify '$product))
248 (m-tlambda&env
249 (($%0 $%1 $% $%3) ($%2))
250 nil
251 (div
252 (mul*
253 (simplify
254 ($funmake
255 (simplify ($nounify '$product))
256 (list '(mlist)
257 $%0
258 $%1
259 (simplify ($substitute (add* (trd-msymeval $%n '$%n)
260 $%2)
261 (trd-msymeval $%n '$%n)
262 (trd-msymeval $% '$%)))
263 (simplify ($substitute (add* (trd-msymeval $%n '$%n)
264 $%2)
265 (trd-msymeval $%n '$%n)
266 $%3)))))
267 (simplify
268 ($produ
269 $%0
270 $%1
271 (trd-msymeval $% '$%)
272 (add* (simplify ($substitute (add* (trd-msymeval $%n '$%n)
273 $%2)
274 (trd-msymeval $%n '$%n)
275 (trd-msymeval $% '$%)))
276 -1))))
277 (simplify
278 ($produ $%0
279 $%1
280 (add* $%3 1)
281 (simplify ($substitute (add* (trd-msymeval $%n '$%n)
282 $%2)
283 (trd-msymeval $%n '$%n)
284 $%3))))))))
285 (simplify
286 (list
287 '(mequal)
288 '%binomial
289 (m-tlambda&env
290 (($%0 $%1) ($%2))
291 nil
292 (mul*
293 (simplify ($substitute (add* (trd-msymeval $%n '$%n) $%2)
294 (trd-msymeval $%n '$%n)
295 (simplify `((%binomial) ,$%0 ,$%1))))
296 (simplify
297 ($produ
298 (div (add* $%1 '$%) (add* $%0 '$%))
299 '$%
300 1
301 (add* (simplify ($substitute (add* (trd-msymeval $%n '$%n)
302 $%2)
303 (trd-msymeval $%n '$%n)
304 $%1))
305 (*mminus $%1))))
306 (simplify
307 ($produ
308 (div (add* (*mminus $%1) $%0 '$%)
309 (add* (simplify ($substitute (add* (trd-msymeval $%n
310 '$%n)
311 $%2)
312 (trd-msymeval $%n '$%n)
313 $%1))
314 (*mminus $%1)
315 $%0
316 '$%))
317 '$%
318 1
319 (add* (simplify ($substitute (add* (trd-msymeval $%n '$%n)
320 $%2)
321 (trd-msymeval $%n '$%n)
322 (add* $%0 (*mminus $%1))))
323 $%1
324 (*mminus $%0))))))))
325 (simplify
326 (list
327 '(mequal)
328 '$beta
329 (m-tlambda&env
330 (($%0 $%1) ($%2))
331 nil
332 (mul*
333 (simplify ($substitute (add* (trd-msymeval $%n '$%n) $%2)
334 (trd-msymeval $%n '$%n)
335 (simplify (list '($beta) $%0 $%1))))
336 (simplify
337 ($produ (div (add* $%0 $%1 '$%) (add* $%0 '$%))
338 '$%
339 0
340 (add* (mul* (simplify ($ratcoef $%0
341 (trd-msymeval $%n
342 '$%n)))
343 $%2)
344 -1)))
345 (simplify
346 ($produ
347 (div (add* $%0
348 $%1
349 (mul* $%2
350 (simplify ($ratcoef $%0
351 (trd-msymeval $%n
352 '$%n))))
353 '$%)
354 (add* $%1 '$%))
355 '$%
356 0
357 (add* (mul* (simplify ($ratcoef $%1
358 (trd-msymeval $%n '$%n)))
359 $%2)
360 -1)))))))
361 (simplify
362 (list
363 '(mequal)
364 '&!
365 (m-tlambda&env
366 (($%0) ($%2))
367 nil
368 (div
369 (simplify `((mfactorial) ,
370 (simplify ($substitute (add* (trd-msymeval $%n
371 '$%n)
372 $%2)
373 (trd-msymeval $%n '$%n)
374 $%0))))
375 (simplify
376 ($produ
377 (add* $%0 '$%)
378 '$%
379 1
380 (add* (simplify ($substitute (add* (trd-msymeval $%n '$%n)
381 $%2)
382 (trd-msymeval $%n '$%n)
383 $%0))
384 (*mminus $%0))))))))
385 (simplify
386 (list
387 '(mequal)
388 '%gamma
389 (m-tlambda&env
390 (($%0) ($%2))
391 nil
392 (div
393 (simplify `((%gamma) ,
394 (simplify ($substitute (add* (trd-msymeval $%n
395 '$%n)
396 $%2)
397 (trd-msymeval $%n '$%n)
398 $%0))))
399 (simplify
400 ($produ
401 (add* $%0 '$% -1)
402 '$%
403 1
404 (add* (simplify ($substitute (add* (trd-msymeval $%n '$%n)
405 $%2)
406 (trd-msymeval $%n '$%n)
407 $%0))
408 (*mminus $%0)))))))))
409 $%0))))
410 (eval-when (compile eval load)
411 (defprop $produ t translated)
412 (add2lnc '$produ $props)
413 (defmtrfun
414 ($produ $any mdefine nil nil)
415 ($%0 $%1 $% $%3)
416 nil
417 ((lambda
418 ($x $y)
419 nil
420 (cond
421 ((not ($integerp $y))
422 (simplify ($funmake (simplify ($nounify '$product))
423 (list '(mlist)
424 $%0
425 $%1
426 (trd-msymeval $% '$%)
427 $%3))))
428 ((is-boole-check (mlsp $y -1))
429 (div 1
430 (simplify ($produ $%0
431 $%1
432 (add* $%3 1)
433 (add* (trd-msymeval $% '$%) -1)))))
434 (t (do (($i 0 (f+ 1 $i)))
435 ((> $i $y) '$done)
436 (setq $x (mul* $x
437 (simplify ($substitute (add* $i
438 (trd-msymeval $%
439 '$%))
440 $%1
441 $%0)))))
442 $x)))
443 1
444 (simplify ($ratsimp (add* $%3 (*mminus (trd-msymeval $% '$%))))))))
445 #+nil
446 (eval-when (compile eval load)
447 (defprop $nusum t translated)
448 (add2lnc '$nusum $props)
449 (defmtrfun ($nusum nil mdefine nil nil)
450 ($%a $%n $%l $%h)
451 nil
452 ((lambda ($mapprint $programmode $solvenullwarn)
453 nil
454 (maref 'mqapply
455 (simplify ($nusuml $%a
456 (trd-msymeval $%n '$%n)
457 $%l
458 $%h
459 '((mlist))))
460 1))
461 nil
462 t
463 nil)))
464 (eval-when (compile eval load)
465 (defprop $nusum t translated)
466 (add2lnc '$nusum $props)
467 (defmtrfun ($nusum $any mdefine nil nil)
468 ($%a $%n $%l $%h)
469 nil
470 ((lambda ($mapprint $programmode $solvenullwarn)
471 nil
472 (simplify ($first (simplify ($nusuml $%a
473 (trd-msymeval $%n
474 '$%n)
475 $%l
476 $%h
477 '((mlist)))))))
478 nil
479 t
480 nil)))
481 (eval-when (compile eval load)
482 (defprop $funcsolve t translated)
483 (add2lnc '$funcsolve $props)
484 (defmtrfun ($funcsolve nil mdefine nil nil)
485 ($%a $%f)
486 nil
487 ((lambda ($mapprint $programmode $solvenullwarn)
488 nil
489 (maref 'mqapply
490 (simplify ($funcsol $%a
491 (trd-msymeval $%f '$%f)
492 '((mlist))))
493 1))
494 nil
495 t
496 nil)))
497 (eval-when (compile eval load)
498 (defprop $dimsum t translated)
499 (add2lnc '$dimsum $props)
500 (defmtrfun
501 ($dimsum $any mdefine nil nil)
502 ($%cl)
503 nil
504 ((lambda
505 (|tr-gensym~128| |tr-gensym~129| |tr-gensym~130| |tr-gensym~131|)
506 (unwind-protect
507 (progn
508 (msetchk '$ratfac |tr-gensym~128|)
509 ((lambda
510 ($ratfac $%cd $%pt $%pw)
511 nil
512 (setq
513 $%cd
514 (simplify
515 (map1
516 (getopr
517 (m-tlambda
518 ($x)
519 nil
520 (simplify ($hipow (add* (simplify ($ratsimp $x))
521 (div 1 (trd-msymeval $%n '$%n)))
522 (trd-msymeval $%n '$%n)))))
523 (list '(mlist)
524 (add* (maref $%cl 1) (maref $%cl 2))
525 (add* (maref $%cl 1) (*mminus (maref $%cl 2)))
526 (maref $%cl 3)))))
527 (maset (max (maref $%cd 1) (f+ (maref $%cd 2) -1)) $%cd 1)
528 (simplify
529 ($inpart
530 (simplify
531 ($substitute
532 (setq
533 $solvep
534 (simplify
535 ($solve
536 (simplify
537 ($clist
538 (simplify
539 ($substitute
540 (setq
541 $%pt
542 (simplify
543 ($funmake
544 'lambda
545 (list
546 '(mlist)
547 (list '(mlist) (trd-msymeval $%n '$%n))
548 (simplify
549 ($genpol
550 (cond
551 ((and
552 (is-boole-check
553 (mlsp (maref $%cd 1)
554 (maref $%cd 2)))
555 ($integerp
556 (setq
557 $%pw
558 (simplify
559 ($substitute
560 (simplify
561 ($solve
562 (simplify
563 ($ratcoef
564 (add*
565 (mul*
566 (maref $%cl 1)
567 (add*
568 (trd-msymeval
569 $%n
570 '$%n)
571 '$%))
572 (mul*
573 (maref $%cl 2)
574 (trd-msymeval
575 $%n
576 '$%n)))
577 (trd-msymeval $%n
578 '$%n)
579 (maref $%cd 2)))
580 '$%))
581 '$%)))))
582 (maximum
583 (list
584 (trd-msymeval $%pw '$%pw)
585 (add* (maref $%cd 3)
586 (*mminus (maref $%cd
587 1))))))
588 (t (add* (maref $%cd 3)
589 (*mminus (maref $%cd 1)))))))))))
590 (simplify ($inpart (trd-msymeval $%f '$%f) 0))
591 (ncmul2 $%cl
592 (list '(mlist)
593 (trd-msymeval $%f1 '$%f1)
594 (trd-msymeval $%f '$%f)
595 1))))))
596 ($append (cond (($listp (trd-msymeval $l% '$l%))
597 (trd-msymeval $l% '$l%))
598 (t
599 (setq $l% (list '(mlist)
600 (trd-msymeval $l%
601 '$l%)))))
602 (simplify ($clist (simplify ($inpart $%pt
603 2))))))))
604 (progn
605 (setq
606 $l%
607 (simplify
608 (map1 (getopr '&=)
609 (trd-msymeval $l% '$l%)
610 (simplify ($substitute (trd-msymeval $solvep
611 '$solvep)
612 (trd-msymeval $l% '$l%))))))
613 $%pt)))
614 2)))
615 |tr-gensym~128|
616 |tr-gensym~129|
617 |tr-gensym~130|
618 |tr-gensym~131|))
619 (msetchk '$ratfac (trd-msymeval $ratfac nil))))
620 nil
621 '$%cd
622 '$%pt
623 '$%pw)))
624 (eval-when (compile eval load)
625 (defprop $ratsolve t translated)
626 (add2lnc '$ratsolve $props)
627 (defmtrfun
628 ($ratsolve $any mdefine nil nil)
629 ($p $x)
630 nil
631 (simplify
632 (mapply-tr
633 '$append
634 (maplist_tr
635 (m-tlambda&env
636 (($p) ($x))
637 nil
638 (cond
639 ((or (like (simplify ($hipow (trd-msymeval $p '$p) $x)) 1)
640 (like (simplify ($substitute 0 $x (trd-msymeval $p '$p))) 0))
641 (simplify ($solve (simplify ($substitute (m-tlambda ($x $y)
642 nil
643 $x)
644 '&^
645 (trd-msymeval $p '$p)))
646 $x)))
647 (t '((mlist)))))
648 (mul* 2 (power (simplify ($factor (trd-msymeval $p '$p))) 2)))))))
649 (eval-when (compile eval load)
650 (defprop $prodshift t translated)
651 (add2lnc '$prodshift $props)
652 (defmtrfun
653 ($prodshift $any mdefine nil nil)
654 ($%0 $%2)
655 nil
656 (simplify
657 ($substitute
658 (list
659 '(mlist)
660 (simplify (list '(mequal) (simplify ($nounify '$product)) '$product))
661 (simplify
662 (list
663 '(mequal)
664 '$product
665 (m-tlambda&env
666 (($%0 $%1 $% $%3) ($%2))
667 nil
668 (simplify ($produ (simplify ($substitute (add* $%1
669 (*mminus $%2))
670 $%1
671 $%0))
672 $%1
673 (add* (trd-msymeval $% '$%) $%2)
674 (add* $%3 $%2)))))))
675 $%0))))
676 (eval-when (compile eval load)
677 (defprop $rforn t translated)
678 (add2lnc '$rforn $props)
679 (defmtrfun
680 ($rforn $any mdefine nil nil)
681 ($%3)
682 nil
683 ((lambda
684 (|tr-gensym~132| |tr-gensym~133|)
685 (unwind-protect
686 (progn
687 (msetchk '$ratfac |tr-gensym~133|)
688 ((lambda
689 ($y $ratfac)
690 nil
691 (setq $p (mul* (trd-msymeval $p '$p)
692 (simplify ($produ $y
693 (trd-msymeval $%n '$%n)
694 (trd-msymeval $%n '$%n)
695 (add* (trd-msymeval $%n '$%n)
696 $%3
697 -1)))))
698 (setq
699 $%r
700 (simplify
701 ($ratsimp
702 (div (trd-msymeval $%r '$%r)
703 (list '(mlist)
704 (simplify ($substitute (add* (trd-msymeval $%n
705 '$%n)
706 $%3)
707 (trd-msymeval $%n '$%n)
708 $y))
709 $y))))))
710 |tr-gensym~132|
711 |tr-gensym~133|))
712 (msetchk '$ratfac (trd-msymeval $ratfac nil))))
713 (simplify ($gcd (maref (trd-msymeval $%r '$%r) 2)
714 (simplify ($substitute (add* (trd-msymeval $%n '$%n)
715 (*mminus $%3))
716 (trd-msymeval $%n '$%n)
717 (maref (trd-msymeval $%r '$%r)
718 1)))))
719 t)))
720 (eval-when (compile eval load)
721 (defprop $rform t translated)
722 (add2lnc '$rform $props)
723 (defmtrfun
724 ($rform $any mdefine nil nil)
725 ($%r)
726 nil
727 (cond
728 ((is-boole-check (simplify (ratp (div (maref (trd-msymeval $%r '$%r) 1)
729 (maref (trd-msymeval $%r '$%r) 2))
730 (trd-msymeval $%n '$%n))))
731 (cond (($algebraicp (trd-msymeval $%r '$%r))
732 (progn (msetchk '$gcd '$red)
733 (setq $gcd '$red))
734 (setq $algebraic t)))
735 ((lambda
736 ($p)
737 nil
738 (simplify ($rforn 1))
739 (do
740 (($%3)
741 (mdo
742 (cdr
743 (simplify
744 ($ratsolve
745 (simplify
746 ($resultant
747 (maref (trd-msymeval $%r '$%r) 1)
748 (simplify ($substitute (add* (trd-msymeval $%n '$%n) '$%)
749 (trd-msymeval $%n '$%n)
750 (maref (trd-msymeval $%r '$%r) 2)))
751 (trd-msymeval $%n '$%n)))
752 '$%)))
753 (cdr mdo)))
754 ((null mdo) '$done)
755 (setq $%3 (car mdo))
756 (cond
757 ((and ($integerp (setq $%3 (simplify ($substitute (list '(mlist)
758 $%3)
759 '$%))))
760 (is-boole-check (mgrp $%3 0)))
761 (simplify ($rforn $%3)))))
762 (list '(mlist)
763 (trd-msymeval $p '$p)
764 (div (maref (trd-msymeval $%r '$%r) 1)
765 (maref (trd-msymeval $%r '$%r) 2))))
766 1))
767 (t (simplify ($error (div (maref (trd-msymeval $%r '$%r) 1)
768 (maref (trd-msymeval $%r '$%r) 2))
769 '|&NON-RATIONAL TERM RATIO TO NUSUM|))))))
770 (eval-when (compile eval load)
771 (defprop $nusuml t translated)
772 (add2lnc '$nusuml $props)
773 (defmtrfun
774 ($nusuml $any mdefine nil nil)
775 ($%a $%n $%l $%h $l%)
776 nil
777 (cond
778 ((like $%a 0) (list '(mlist) 0))
779 (t
780 ((lambda
781 (|tr-gensym~135| |tr-gensym~136|
782 |tr-gensym~137|
783 |tr-gensym~138|
784 |tr-gensym~139|
785 |tr-gensym~140|
786 |tr-gensym~141|
787 |tr-gensym~142|
788 |tr-gensym~143|
789 |tr-gensym~144|
790 |tr-gensym~145|
791 |tr-gensym~146|
792 |tr-gensym~147|)
793 (unwind-protect
794 (progn
795 (msetchk 'modulus |tr-gensym~136|)
796 (msetchk '$ratfac |tr-gensym~139|)
797 (msetchk '$gcd |tr-gensym~140|)
798 ((lambda
799 ($solvep modulus
800 $rv
801 $prodhack
802 $ratfac
803 $gcd
804 $algebraic
805 $ratalgdenom
806 $matrix_element_mult
807 $dispflag
808 $maperror
809 $%f
810 $%f1)
811 nil
812 (simplify ($ratvars (trd-msymeval $%n '$%n)))
813 (cond
814 ((and
815 (not
816 (like
817 '((mlist))
818 ((lambda
819 (errcatch ret)
820 (cond
821 ((null
822 (setq
823 ret
824 (errset
825 (progn
826 (setq
827 $%cf
828 (simplify
829 ($dimsum
830 (list
831 '(mlist)
832 (*mminus
833 ($num
834 (maref
835 'mqapply
836 (setq
837 $%r
838 (simplify
839 ($rform
840 ((lambda ($%a)
841 nil
842 (list '(mlist)
843 ($num $%a)
844 ($denom $%a)))
845 (simplify
846 ($factor
847 (div
848 (simplify
849 ($substitute
850 (add*
851 (trd-msymeval
852 $%n
853 '$%n)
854 1)
855 (trd-msymeval
856 $%n
857 '$%n)
858 $%a))
859 (simplify
860 ($prodgunch
861 $%a
862 (trd-msymeval
863 $%n
864 '$%n)
865 1)))))))))
866 2)))
867 (simplify
868 ($substitute
869 (add* (trd-msymeval $%n '$%n) -1)
870 (trd-msymeval $%n '$%n)
871 ($denom
872 (maref (trd-msymeval $%r '$%r)
873 2))))
874 (maref (trd-msymeval $%r '$%r) 1))))))
875 lisperrprint)))
876 (errlfun1 errcatch)))
877 (cons '(mlist) ret))
878 (cons bindlist loclist)
879 nil)))
880 (not (like '((mlist)) (trd-msymeval $solvep '$solvep))))
881 ($cons
882 (progn
883 (setq $%f (div (simplify ($prodgunch ($num $%a)
884 (trd-msymeval $%n
885 '$%n)
886 1))
887 ($denom $%a)))
888 (setq
889 $%f1
890 (simplify
891 ($ratsimp (simplify ($radcan (trd-msymeval $%cf
892 '$%cf))))))
893 (simplify (mapply-tr '$ratvars $rv))
894 (setq
895 $%f1
896 (simplify
897 ($substitute
898 (m-tlambda ($%0 $%1 $% $%3)
899 nil
900 (simplify ($produ $%0
901 $%1
902 (trd-msymeval $% '$%)
903 $%3)))
904 (simplify ($nounify '$product))
905 (add*
906 (simplify
907 ($factor
908 (simplify
909 ($substitute
910 $%h
911 (trd-msymeval $%n '$%n)
912 (simplify
913 ($factor
914 (div
915 (mul*
916 ($num (maref (trd-msymeval $%r '$%r)
917 2))
918 (trd-msymeval $%f '$%f)
919 (simplify
920 ($substitute
921 (add* (trd-msymeval $%n '$%n) 1)
922 (trd-msymeval $%n '$%n)
923 (trd-msymeval $%f1 '$%f1))))
924 (maref (trd-msymeval $%r '$%r) 1))))))))
925 (*mminus
926 (simplify
927 ($factor
928 (simplify
929 ($substitute
930 $%l
931 (trd-msymeval $%n '$%n)
932 (simplify
933 ($factor
934 (div
935 (mul*
936 $%a
937 (trd-msymeval $%f1 '$%f1)
938 (simplify
939 ($substitute
940 (add* (trd-msymeval $%n '$%n)
941 -1)
942 (trd-msymeval $%n '$%n)
943 ($denom
944 (maref (trd-msymeval $%r
945 '$%r)
946 2)))))
947 (maref (trd-msymeval $%r '$%r) 1)))))))))))))
948 (cond
949 ((is-boole-check (simplify (ratp $%a
950 (trd-msymeval $%n
951 '$%n))))
952 (simplify ($factor (trd-msymeval $%f1 '$%f1))))
953 (t (trd-msymeval $%f1 '$%f1))))
954 (trd-msymeval $l% '$l%)))
955 (t (simplify (mapply-tr '$ratvars $rv))
956 (list '(mlist)
957 (simplify (mfuncall '$sum
958 $%a
959 (trd-msymeval $%n '$%n)
960 $%l
961 $%h))))))
962 |tr-gensym~135|
963 |tr-gensym~136|
964 |tr-gensym~137|
965 |tr-gensym~138|
966 |tr-gensym~139|
967 |tr-gensym~140|
968 |tr-gensym~141|
969 |tr-gensym~142|
970 |tr-gensym~143|
971 |tr-gensym~144|
972 |tr-gensym~145|
973 |tr-gensym~146|
974 |tr-gensym~147|))
975 (msetchk 'modulus (trd-msymeval modulus 'modulus))
976 (msetchk '$ratfac (trd-msymeval $ratfac nil))
977 (msetchk '$gcd (trd-msymeval $gcd '$gcd))))
978 nil
979 nil
980 (trd-msymeval $ratvars '$ratvars)
981 t
982 t
983 '$spmod
984 nil
985 t
986 '&*
987 nil
988 nil
989 (simplify ($funmake '$%f (list '(mlist) (trd-msymeval $%n '$%n))))
990 (simplify ($funmake '$%f
991 (list '(mlist) (add* (trd-msymeval $%n '$%n) 1)))))))))
992 (eval-when (compile eval load)
993 (defprop $funcsol t translated)
994 (add2lnc '$funcsol $props)
995 (defmtrfun
996 ($funcsol $any mdefine nil nil)
997 ($%a $%f $l%)
998 nil
999 ((lambda
1000 (|tr-gensym~148| |tr-gensym~149|
1001 |tr-gensym~150|
1002 |tr-gensym~151|
1003 |tr-gensym~152|
1004 |tr-gensym~153|
1005 |tr-gensym~154|
1006 |tr-gensym~155|)
1007 (unwind-protect
1008 (progn
1009 (msetchk '$ratfac |tr-gensym~148|)
1010 ((lambda
1011 ($ratfac $maperror $linenum $dispflag $%f1 $%cl $%cm $%n)
1012 nil
1013 (setq
1014 $%f1
1015 (simplify
1016 ($substitute (simplify (list '(mequal)
1017 (trd-msymeval $%n '$%n)
1018 (add* (trd-msymeval $%n '$%n) 1)))
1019 (trd-msymeval $%f '$%f))))
1020 (setq
1021 $%cl
1022 (simplify
1023 ($factor
1024 (maref
1025 'mqapply
1026 (simplify
1027 ($augcoefmatrix
1028 (list
1029 '(mlist)
1030 (setq
1031 $%a
1032 ($num (simplify ($xthru (add* ($lhs $%a)
1033 (*mminus ($rhs $%a))))))))
1034 (list '(mlist)
1035 (trd-msymeval $%f1 '$%f1)
1036 (trd-msymeval $%f '$%f))))
1037 1))))
1038 (setq $%cm (simplify ($rform (simplify ($rest $%cl -1)))))
1039 (maset
1040 (simplify
1041 ($ratsimp (div (simplify ($substitute (add* (trd-msymeval $%n
1042 '$%n)
1043 1)
1044 (trd-msymeval $%n '$%n)
1045 (maref $%cm 1)))
1046 (maref $%cm 1))))
1047 $%cm
1048 2)
1049 ($append
1050 ((lambda
1051 (errcatch ret)
1052 (cond
1053 ((null
1054 (setq
1055 ret
1056 (errset
1057 (progn
1058 (simplify
1059 (list
1060 '(mequal)
1061 (trd-msymeval $%f '$%f)
1062 (simplify
1063 ($factor
1064 (div
1065 (simplify
1066 ($dimsum
1067 (simplify
1068 ($ratsimp
1069 (list '(mlist)
1070 (div (maref $%cl 1)
1071 ($num (maref $%cm 2)))
1072 (div (maref $%cl 2)
1073 ($denom (maref $%cm 2)))
1074 (div (mul* (maref $%cm 1)
1075 (maref $%cl 3))
1076 ($denom (maref $%cm 2))))))))
1077 (maref $%cm 1)))))))
1078 lisperrprint)))
1079 (errlfun1 errcatch)))
1080 (cons '(mlist) ret))
1081 (cons bindlist loclist)
1082 nil)
1083 (trd-msymeval $l% '$l%)))
1084 |tr-gensym~148|
1085 |tr-gensym~149|
1086 |tr-gensym~150|
1087 |tr-gensym~151|
1088 |tr-gensym~152|
1089 |tr-gensym~153|
1090 |tr-gensym~154|
1091 |tr-gensym~155|))
1092 (msetchk '$ratfac (trd-msymeval $ratfac nil))))
1093 t
1094 nil
1095 (trd-msymeval $linenum '$linenum)
1096 nil
1097 '$%f1
1098 '$%cl
1099 '$%cm
1100 (simplify ($inpart (trd-msymeval $%f '$%f) 1)))))
Maxima, a Computer Algebra System