Created
January 11, 2022 13:50
-
-
Save lokedhs/248aa65b9f43d919f9529d549f3a4423 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defun rischexpvar (expexpflag flag l) | |
(prog (lcm y m p alphar beta gamma delta r s | |
tt denom k wl wv i ytemp ttemp yalpha f a expg n yn yd) | |
(desetq (f a expg n) l) | |
(cond ((or (pzerop a) (pzerop (car a))) | |
(return (cond ((null flag) (rzero)) | |
(t (rischzero)))))) | |
(setq denom (ratdenominator f)) | |
(setq p (findpr (cdr (partfrac a mainvar)) | |
(cdr (partfrac f mainvar)))) | |
(setq lcm (plcm (ratdenominator a) p)) | |
(setq y (ratpl (spderivative (cons 1 p) mainvar) | |
(ratqu f p))) | |
(setq lcm (plcm lcm (ratdenominator y))) | |
(setq r (car (ratqu lcm p))) | |
(setq s (car (r* lcm y))) | |
(setq tt (car (r* a lcm))) | |
(setq beta (pdegree r mainvar)) | |
(setq gamma (pdegree s mainvar)) | |
(setq delta (pdegree tt mainvar)) | |
(setq alphar (max (- (1+ delta) beta) | |
(- delta gamma))) | |
(setq m 0) | |
(cond ((equal (1- beta) gamma) | |
(setq y (r* -1 | |
(ratqu (polcoef s gamma) | |
(polcoef r beta)))) | |
(and (equal (cdr y) 1) | |
(numberp (car y)) | |
(setq m (car y))))) | |
(setq alphar (max alphar m)) | |
(if (minusp alphar) | |
(return (if flag (cxerfarg (rzero) expg n a) nil))) | |
(cond ((not (and (equal alphar m) (not (zerop m)))) | |
(go down2))) | |
(setq k (+ alphar beta -2)) | |
(setq wl nil) | |
l2 (setq wv (list (cons (polcoef tt k) 1))) | |
(setq i alphar) | |
l1 (setq wv | |
(cons (r+ (r* (cons i 1) | |
(polcoef r (+ k 1 (- i)))) | |
(cons (polcoef s (+ k (- i))) 1)) | |
wv)) | |
(decf i) | |
(cond ((> i -1) (go l1))) | |
(setq wl (cons wv wl)) | |
(decf k) | |
(cond ((> k -1) (go l2))) | |
(setq y (lsa wl)) | |
(if (or (eq y 'singular) (eq y 'inconsistent)) | |
(cond ((null flag) (return nil)) | |
(t (return (cxerfarg (rzero) expg n a))))) | |
(setq k 0) | |
(setq lcm 0) | |
(setq y (cdr y)) | |
l3 (setq lcm | |
(r+ (r* (car y) (pexpt (list mainvar 1 1) k)) | |
lcm)) | |
(incf k) | |
(setq y (cdr y)) | |
(cond ((null y) | |
(return (cond ((null flag) (ratqu lcm p)) | |
(t (list (r* (ratqu lcm p) | |
(cons (list expg n 1) 1)) | |
0)))))) | |
(go l3) | |
down2 (cond ((> (1- beta) gamma) | |
(setq k (+ alphar (1- beta))) | |
(setq denom '(ratti alphar (polcoef r beta) t))) | |
((< (1- beta) gamma) | |
(setq k (+ alphar gamma)) | |
(setq denom '(polcoef s gamma))) | |
(t (setq k (+ alphar gamma)) | |
(setq denom | |
'(ratpl (ratti alphar (polcoef r beta) t) | |
(polcoef s gamma))))) | |
(setq y 0) | |
loop (setq yn (polcoef (ratnumerator tt) k) | |
yd (r* (ratdenominator tt) ;DENOM MAY BE 0 | |
(cond ((zerop alphar) (polcoef s gamma)) | |
(t (eval denom))) )) | |
(cond ((rzerop yd) | |
(cond ((pzerop yn) (setq k (1- k) alphar (1- alphar)) | |
(go loop)) ;need more constraints? | |
(t (cond | |
((null flag) (return nil)) | |
(t (return (cxerfarg (rzero) expg n a))))))) | |
(t (setq yalpha (ratqu yn yd)))) | |
(setq ytemp (r+ y (r* yalpha | |
(cons (list mainvar alphar 1) 1) ))) | |
(setq ttemp (r- tt (r* yalpha | |
(r+ (r* s (cons (list mainvar alphar 1) 1)) | |
(r* r alphar | |
(list mainvar (1- alphar) 1)))))) | |
(decf k) | |
(decf alphar) | |
(cond ((< alphar 0) | |
(cond | |
((rzerop ttemp) | |
(cond | |
((null flag) (return (ratqu ytemp p))) | |
(t (return (list (ratqu (r* ytemp (cons (list expg n 1) 1)) | |
p) | |
0))))) | |
((null flag) (return nil)) | |
((and (risch-constp (setq ttemp (ratqu ttemp lcm))) | |
$erfflag | |
(equal (pdegree (car (get expg 'rischarg)) mainvar) 2) | |
(equal (pdegree (cdr (get expg 'rischarg)) mainvar) 0)) | |
(return (list (ratqu (r* ytemp (cons (list expg n 1) 1)) p) | |
(erfarg2 (r* n (get expg 'rischarg)) ttemp)))) | |
(t (return | |
(cxerfarg | |
(ratqu (r* y (cons (list expg n 1) 1)) p) | |
expg | |
n | |
(ratqu tt lcm))))))) | |
(setq y ytemp) | |
(setq tt ttemp) | |
(go loop))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment