1
2(SDEFUN |POLYROOT;zroot|
3        ((|x| |Integer|) (|n| |NonNegativeInteger|)
4         ($ |Record| (|:| |exponent| (|NonNegativeInteger|))
5          (|:| |coef| (|Integer|)) (|:| |radicand| (|Integer|))))
6        (SPROG
7         ((#1=#:G409 NIL) (#2=#:G408 #3=(|Integer|)) (#4=#:G410 #3#)
8          (#5=#:G413 NIL) (#6=#:G400 NIL)
9          (|s|
10           (|Record| (|:| |exponent| (|NonNegativeInteger|))
11                     (|:| |coef| (|Integer|)) (|:| |radicand| (|List| #3#)))))
12         (SEQ
13          (COND ((OR (ZEROP |x|) (EQL |x| 1)) (VECTOR 1 |x| 1))
14                ('T
15                 (SEQ
16                  (LETT |s|
17                        (SPADCALL (SPADCALL |x| (QREFELT $ 15)) |n|
18                                  (QREFELT $ 20)))
19                  (EXIT
20                   (VECTOR (QVELT |s| 0) (QVELT |s| 1)
21                           (PROGN
22                            (LETT #1# NIL)
23                            (SEQ (LETT #6# NIL) (LETT #5# (QVELT |s| 2)) G190
24                                 (COND
25                                  ((OR (ATOM #5#)
26                                       (PROGN (LETT #6# (CAR #5#)) NIL))
27                                   (GO G191)))
28                                 (SEQ
29                                  (EXIT
30                                   (PROGN
31                                    (LETT #4# #6#)
32                                    (COND (#1# (LETT #2# (* #2# #4#)))
33                                          ('T
34                                           (PROGN
35                                            (LETT #2# #4#)
36                                            (LETT #1# 'T)))))))
37                                 (LETT #5# (CDR #5#)) (GO G190) G191
38                                 (EXIT NIL))
39                            (COND (#1# #2#) ('T 1)))))))))))
40
41(SDEFUN |POLYROOT;czroot|
42        ((|x| |Integer|) (|n| |NonNegativeInteger|)
43         ($ |Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| F)
44          (|:| |radicand| F)))
45        (SPROG
46         ((|rec|
47           (|Record| (|:| |exponent| (|NonNegativeInteger|))
48                     (|:| |coef| (|Integer|)) (|:| |radicand| (|Integer|)))))
49         (SEQ (LETT |rec| (|POLYROOT;zroot| |x| |n| $))
50              (COND
51               ((EQL (QVELT |rec| 0) 2)
52                (COND
53                 ((< (QVELT |rec| 2) 0)
54                  (EXIT
55                   (VECTOR (QVELT |rec| 0)
56                           (SPADCALL (QVELT |rec| 1)
57                                     (SPADCALL
58                                      (SPADCALL (SPADCALL (QREFELT $ 21))
59                                                (QREFELT $ 22))
60                                      (QREFELT $ 23))
61                                     (QREFELT $ 24))
62                           (SPADCALL (- (QVELT |rec| 2)) (QREFELT $ 25))))))))
63              (EXIT
64               (VECTOR (QVELT |rec| 0)
65                       (SPADCALL (QVELT |rec| 1) (QREFELT $ 25))
66                       (SPADCALL (QVELT |rec| 2) (QREFELT $ 25)))))))
67
68(SDEFUN |POLYROOT;qroot;FNniR;3|
69        ((|x| |Fraction| (|Integer|)) (|n| |NonNegativeInteger|)
70         ($ |Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| F)
71          (|:| |radicand| F)))
72        (SPROG
73         ((|m| (|NonNegativeInteger|)) (#1=#:G421 NIL)
74          (|sd|
75           #2=(|Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| F)
76                        (|:| |radicand| F)))
77          (|sn| #2#))
78         (SEQ
79          (LETT |sn| (|POLYROOT;czroot| (SPADCALL |x| (QREFELT $ 27)) |n| $))
80          (LETT |sd| (|POLYROOT;czroot| (SPADCALL |x| (QREFELT $ 28)) |n| $))
81          (LETT |m|
82                (PROG1
83                    (LETT #1#
84                          (SPADCALL (QVELT |sn| 0) (QVELT |sd| 0)
85                                    (QREFELT $ 29)))
86                  (|check_subtype2| (>= #1# 0) '(|NonNegativeInteger|)
87                                    '(|Integer|) #1#)))
88          (EXIT
89           (VECTOR |m| (SPADCALL (QVELT |sn| 1) (QVELT |sd| 1) (QREFELT $ 30))
90                   (SPADCALL
91                    (SPADCALL (QVELT |sn| 2) (QUOTIENT2 |m| (QVELT |sn| 0))
92                              (QREFELT $ 31))
93                    (SPADCALL (QVELT |sd| 2) (QUOTIENT2 |m| (QVELT |sd| 0))
94                              (QREFELT $ 31))
95                    (QREFELT $ 30)))))))
96
97(SDEFUN |POLYROOT;qroot;FNniR;4|
98        ((|x| |Fraction| (|Integer|)) (|n| |NonNegativeInteger|)
99         ($ |Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| F)
100          (|:| |radicand| F)))
101        (SPROG
102         ((|m| (|NonNegativeInteger|)) (#1=#:G427 NIL)
103          (|sd|
104           #2=(|Record| (|:| |exponent| (|NonNegativeInteger|))
105                        (|:| |coef| (|Integer|)) (|:| |radicand| (|Integer|))))
106          (|sn| #2#))
107         (SEQ
108          (LETT |sn| (|POLYROOT;zroot| (SPADCALL |x| (QREFELT $ 27)) |n| $))
109          (LETT |sd| (|POLYROOT;zroot| (SPADCALL |x| (QREFELT $ 28)) |n| $))
110          (LETT |m|
111                (PROG1
112                    (LETT #1#
113                          (SPADCALL (QVELT |sn| 0) (QVELT |sd| 0)
114                                    (QREFELT $ 29)))
115                  (|check_subtype2| (>= #1# 0) '(|NonNegativeInteger|)
116                                    '(|Integer|) #1#)))
117          (EXIT
118           (VECTOR |m|
119                   (SPADCALL (SPADCALL (QVELT |sn| 1) (QREFELT $ 25))
120                             (SPADCALL (QVELT |sd| 1) (QREFELT $ 25))
121                             (QREFELT $ 30))
122                   (SPADCALL
123                    (SPADCALL
124                     (EXPT (QVELT |sn| 2) (QUOTIENT2 |m| (QVELT |sn| 0)))
125                     (QREFELT $ 25))
126                    (SPADCALL
127                     (EXPT (QVELT |sd| 2) (QUOTIENT2 |m| (QVELT |sd| 0)))
128                     (QREFELT $ 25))
129                    (QREFELT $ 30)))))))
130
131(SDEFUN |POLYROOT;rroot;RNniR;5|
132        ((|x| R) (|n| |NonNegativeInteger|)
133         ($ |Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| F)
134          (|:| |radicand| F)))
135        (SPROG ((|r| (|Union| (|Fraction| (|Integer|)) "failed")))
136               (SEQ (LETT |r| (SPADCALL |x| (QREFELT $ 35)))
137                    (EXIT
138                     (COND
139                      ((QEQCAR |r| 1)
140                       (VECTOR |n| (|spadConstant| $ 36)
141                               (SPADCALL (SPADCALL |x| (QREFELT $ 22))
142                                         (QREFELT $ 23))))
143                      ('T (SPADCALL (QCDR |r|) |n| (QREFELT $ 33))))))))
144
145(SDEFUN |POLYROOT;rroot;RNniR;6|
146        ((|x| R) (|n| |NonNegativeInteger|)
147         ($ |Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| F)
148          (|:| |radicand| F)))
149        (SPROG ((|r| (|Union| (|Integer|) "failed")))
150               (SEQ (LETT |r| (SPADCALL |x| (QREFELT $ 39)))
151                    (EXIT
152                     (COND
153                      ((QEQCAR |r| 1)
154                       (VECTOR |n| (|spadConstant| $ 36)
155                               (SPADCALL (SPADCALL |x| (QREFELT $ 22))
156                                         (QREFELT $ 23))))
157                      ('T
158                       (SPADCALL (SPADCALL (QCDR |r|) (QREFELT $ 40)) |n|
159                                 (QREFELT $ 33))))))))
160
161(SDEFUN |POLYROOT;rroot;RNniR;7|
162        ((|x| R) (|n| |NonNegativeInteger|)
163         ($ |Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| F)
164          (|:| |radicand| F)))
165        (VECTOR |n| (|spadConstant| $ 36)
166                (SPADCALL (SPADCALL |x| (QREFELT $ 22)) (QREFELT $ 23))))
167
168(SDEFUN |POLYROOT;rsplit|
169        ((|l| |List| P) ($ |Record| (|:| |coef| R) (|:| |poly| P)))
170        (SPROG
171         ((|r| (R)) (|p| (P)) (|u| (|Union| R "failed")) (#1=#:G452 NIL)
172          (|q| NIL))
173         (SEQ (LETT |r| (|spadConstant| $ 11)) (LETT |p| (|spadConstant| $ 12))
174              (SEQ (LETT |q| NIL) (LETT #1# |l|) G190
175                   (COND
176                    ((OR (ATOM #1#) (PROGN (LETT |q| (CAR #1#)) NIL))
177                     (GO G191)))
178                   (SEQ (LETT |u| (SPADCALL |q| (QREFELT $ 42)))
179                        (EXIT
180                         (COND
181                          ((QEQCAR |u| 1)
182                           (LETT |p| (SPADCALL |p| |q| (QREFELT $ 43))))
183                          ('T
184                           (LETT |r|
185                                 (SPADCALL |r| (QCDR |u|) (QREFELT $ 44)))))))
186                   (LETT #1# (CDR #1#)) (GO G190) G191 (EXIT NIL))
187              (EXIT (CONS |r| |p|)))))
188
189(SDEFUN |POLYROOT;nthr;PNniR;9|
190        ((|x| P) (|n| |NonNegativeInteger|)
191         ($ |Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| P)
192          (|:| |radicand| (|List| P))))
193        (SPROG
194         ((|rec|
195           (|Record| (|:| |exponent| (|NonNegativeInteger|))
196                     (|:| |coef| (|Integer|)) (|:| |radicand| (|Integer|))))
197          (|r| (|Union| (|Integer|) "failed")))
198         (SEQ (LETT |r| (SPADCALL |x| (QREFELT $ 45)))
199              (EXIT
200               (COND
201                ((QEQCAR |r| 1)
202                 (SPADCALL (SPADCALL |x| (QREFELT $ 46)) |n| (QREFELT $ 50)))
203                ('T
204                 (SEQ (LETT |rec| (|POLYROOT;zroot| (QCDR |r|) |n| $))
205                      (EXIT
206                       (VECTOR (QVELT |rec| 0)
207                               (SPADCALL (QVELT |rec| 1) (QREFELT $ 51))
208                               (LIST
209                                (SPADCALL (QVELT |rec| 2)
210                                          (QREFELT $ 51))))))))))))
211
212(SDEFUN |POLYROOT;nthr;PNniR;10|
213        ((|x| P) (|n| |NonNegativeInteger|)
214         ($ |Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| P)
215          (|:| |radicand| (|List| P))))
216        (SPADCALL (SPADCALL |x| (QREFELT $ 46)) |n| (QREFELT $ 50)))
217
218(SDEFUN |POLYROOT;froot;FNniR;11|
219        ((|x| F) (|n| |NonNegativeInteger|)
220         ($ |Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| F)
221          (|:| |radicand| F)))
222        (SPROG
223         ((|m| (|NonNegativeInteger|)) (#1=#:G467 NIL)
224          (|rd|
225           #2=(|Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| F)
226                        (|:| |radicand| F)))
227          (|rn| #2#) (|pd| #3=(|Record| (|:| |coef| R) (|:| |poly| P)))
228          (|pn| #3#)
229          (|sd|
230           #4=(|Record| (|:| |exponent| (|NonNegativeInteger|)) (|:| |coef| P)
231                        (|:| |radicand| (|List| P))))
232          (|sn| #4#))
233         (SEQ
234          (COND
235           ((OR (SPADCALL |x| (QREFELT $ 54))
236                (SPADCALL |x| (|spadConstant| $ 36) (QREFELT $ 55)))
237            (VECTOR 1 |x| (|spadConstant| $ 36)))
238           ('T
239            (SEQ
240             (LETT |sn|
241                   (SPADCALL (SPADCALL |x| (QREFELT $ 56)) |n| (QREFELT $ 52)))
242             (LETT |sd|
243                   (SPADCALL (SPADCALL |x| (QREFELT $ 57)) |n| (QREFELT $ 52)))
244             (LETT |pn| (|POLYROOT;rsplit| (QVELT |sn| 2) $))
245             (LETT |pd| (|POLYROOT;rsplit| (QVELT |sd| 2) $))
246             (LETT |rn| (SPADCALL (QCAR |pn|) (QVELT |sn| 0) (QREFELT $ 37)))
247             (LETT |rd| (SPADCALL (QCAR |pd|) (QVELT |sd| 0) (QREFELT $ 37)))
248             (LETT |m|
249                   (PROG1
250                       (LETT #1#
251                             (SPADCALL
252                              (LIST (QVELT |rn| 0) (QVELT |rd| 0)
253                                    (QVELT |sn| 0) (QVELT |sd| 0))
254                              (QREFELT $ 59)))
255                     (|check_subtype2| (>= #1# 0) '(|NonNegativeInteger|)
256                                       '(|Integer|) #1#)))
257             (EXIT
258              (VECTOR |m|
259                      (SPADCALL
260                       (SPADCALL (SPADCALL (QVELT |sn| 1) (QREFELT $ 23))
261                                 (SPADCALL (QVELT |sd| 1) (QREFELT $ 23))
262                                 (QREFELT $ 30))
263                       (SPADCALL (QVELT |rn| 1) (QVELT |rd| 1) (QREFELT $ 30))
264                       (QREFELT $ 60))
265                      (SPADCALL
266                       (SPADCALL
267                        (SPADCALL
268                         (SPADCALL (QVELT |rn| 2)
269                                   (QUOTIENT2 |m| (QVELT |rn| 0))
270                                   (QREFELT $ 31))
271                         (SPADCALL (QVELT |rd| 2)
272                                   (QUOTIENT2 |m| (QVELT |rd| 0))
273                                   (QREFELT $ 31))
274                         (QREFELT $ 30))
275                        (SPADCALL
276                         (SPADCALL (QCDR |pn|) (QUOTIENT2 |m| (QVELT |sn| 0))
277                                   (QREFELT $ 61))
278                         (QREFELT $ 23))
279                        (QREFELT $ 60))
280                       (SPADCALL
281                        (SPADCALL (QCDR |pd|) (QUOTIENT2 |m| (QVELT |sd| 0))
282                                  (QREFELT $ 61))
283                        (QREFELT $ 23))
284                       (QREFELT $ 30))))))))))
285
286(DECLAIM (NOTINLINE |PolynomialRoots;|))
287
288(DEFUN |PolynomialRoots| (&REST #1=#:G470)
289  (SPROG NIL
290         (PROG (#2=#:G471)
291           (RETURN
292            (COND
293             ((LETT #2#
294                    (|lassocShiftWithFunction| (|devaluateList| #1#)
295                                               (HGET |$ConstructorCache|
296                                                     '|PolynomialRoots|)
297                                               '|domainEqualList|))
298              (|CDRwithIncrement| #2#))
299             ('T
300              (UNWIND-PROTECT
301                  (PROG1 (APPLY (|function| |PolynomialRoots;|) #1#)
302                    (LETT #2# T))
303                (COND
304                 ((NOT #2#)
305                  (HREM |$ConstructorCache| '|PolynomialRoots|))))))))))
306
307(DEFUN |PolynomialRoots;| (|#1| |#2| |#3| |#4| |#5|)
308  (SPROG
309   ((|pv$| NIL) ($ NIL) (|dv$| NIL) (DV$5 NIL) (DV$4 NIL) (DV$3 NIL) (DV$2 NIL)
310    (DV$1 NIL))
311   (PROGN
312    (LETT DV$1 (|devaluate| |#1|))
313    (LETT DV$2 (|devaluate| |#2|))
314    (LETT DV$3 (|devaluate| |#3|))
315    (LETT DV$4 (|devaluate| |#4|))
316    (LETT DV$5 (|devaluate| |#5|))
317    (LETT |dv$| (LIST '|PolynomialRoots| DV$1 DV$2 DV$3 DV$4 DV$5))
318    (LETT $ (GETREFV 63))
319    (QSETREFV $ 0 |dv$|)
320    (QSETREFV $ 3
321              (LETT |pv$|
322                    (|buildPredVector| 0 0
323                                       (LIST
324                                        (|HasCategory| |#3| '(|GcdDomain|))))))
325    (|haddProp| |$ConstructorCache| '|PolynomialRoots|
326                (LIST DV$1 DV$2 DV$3 DV$4 DV$5) (CONS 1 $))
327    (|stuffDomainSlots| $)
328    (QSETREFV $ 6 |#1|)
329    (QSETREFV $ 7 |#2|)
330    (QSETREFV $ 8 |#3|)
331    (QSETREFV $ 9 |#4|)
332    (QSETREFV $ 10 |#5|)
333    (SETF |pv$| (QREFELT $ 3))
334    (COND
335     ((|HasSignature| |#3| (LIST '|imaginary| (LIST (|devaluate| |#3|))))
336      (PROGN
337       (QSETREFV $ 33 (CONS (|dispatchFunction| |POLYROOT;qroot;FNniR;3|) $))))
338     ('T
339      (QSETREFV $ 33 (CONS (|dispatchFunction| |POLYROOT;qroot;FNniR;4|) $))))
340    (COND
341     ((|HasCategory| |#3| '(|RetractableTo| (|Fraction| (|Integer|))))
342      (QSETREFV $ 37 (CONS (|dispatchFunction| |POLYROOT;rroot;RNniR;5|) $)))
343     ((|HasCategory| |#3| '(|RetractableTo| (|Integer|)))
344      (QSETREFV $ 37 (CONS (|dispatchFunction| |POLYROOT;rroot;RNniR;6|) $)))
345     ('T
346      (QSETREFV $ 37 (CONS (|dispatchFunction| |POLYROOT;rroot;RNniR;7|) $))))
347    (COND
348     ((|testBitVector| |pv$| 1)
349      (PROGN
350       (COND
351        ((|HasCategory| |#3| '(|RetractableTo| (|Integer|)))
352         (QSETREFV $ 52 (CONS (|dispatchFunction| |POLYROOT;nthr;PNniR;9|) $)))
353        ('T
354         (QSETREFV $ 52
355                   (CONS (|dispatchFunction| |POLYROOT;nthr;PNniR;10|) $))))
356       (QSETREFV $ 62
357                 (CONS (|dispatchFunction| |POLYROOT;froot;FNniR;11|) $)))))
358    $)))
359
360(MAKEPROP '|PolynomialRoots| '|infovec|
361          (LIST
362           '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
363              (|local| |#3|) (|local| |#4|) (|local| |#5|) (0 . |One|)
364              (4 . |One|) (|Factored| $) (|Integer|) (8 . |squareFree|)
365              (|Record| (|:| |exponent| 18) (|:| |coef| 14)
366                        (|:| |radicand| (|List| 14)))
367              (|Factored| 14) (|NonNegativeInteger|) (|FactoredFunctions| 14)
368              (13 . |nthRoot|) (19 . |imaginary|) (23 . |coerce|)
369              (28 . |coerce|) (33 . *) (39 . |coerce|) (|Fraction| 14)
370              (44 . |numer|) (49 . |denom|) (54 . |lcm|) (60 . /) (66 . ^)
371              (|Record| (|:| |exponent| 18) (|:| |coef| 10)
372                        (|:| |radicand| 10))
373              (72 . |qroot|) (|Union| 26 '#1="failed") (78 . |retractIfCan|)
374              (83 . |One|) (87 . |rroot|) (|Union| 14 '#1#)
375              (93 . |retractIfCan|) (98 . |coerce|) (|Union| 8 '#1#)
376              (103 . |retractIfCan|) (108 . *) (114 . *) (120 . |retractIfCan|)
377              (125 . |squareFree|)
378              (|Record| (|:| |exponent| 18) (|:| |coef| 9)
379                        (|:| |radicand| (|List| 9)))
380              (|Factored| 9) (|FactoredFunctions| 9) (130 . |nthRoot|)
381              (136 . |coerce|) (141 . |nthr|) (|Boolean|) (147 . |zero?|)
382              (152 . =) (158 . |numer|) (163 . |denom|) (|List| $)
383              (168 . |lcm|) (173 . *) (179 . ^) (185 . |froot|))
384           '#(|rroot| 191 |qroot| 197 |nthr| 203 |froot| 209) 'NIL
385           (CONS (|makeByteWordVec2| 1 '(0))
386                 (CONS '#(NIL)
387                       (CONS
388                        '#((|Join|
389                            (|mkCategory|
390                             (LIST
391                              '((|rroot|
392                                 ((|Record|
393                                   (|:| |exponent| (|NonNegativeInteger|))
394                                   (|:| |coef| |#5|) (|:| |radicand| |#5|))
395                                  |#3| (|NonNegativeInteger|)))
396                                T)
397                              '((|qroot|
398                                 ((|Record|
399                                   (|:| |exponent| (|NonNegativeInteger|))
400                                   (|:| |coef| |#5|) (|:| |radicand| |#5|))
401                                  (|Fraction| (|Integer|))
402                                  (|NonNegativeInteger|)))
403                                T)
404                              '((|froot|
405                                 ((|Record|
406                                   (|:| |exponent| (|NonNegativeInteger|))
407                                   (|:| |coef| |#5|) (|:| |radicand| |#5|))
408                                  |#5| (|NonNegativeInteger|)))
409                                (|has| 8 (|GcdDomain|)))
410                              '((|nthr|
411                                 ((|Record|
412                                   (|:| |exponent| (|NonNegativeInteger|))
413                                   (|:| |coef| |#4|)
414                                   (|:| |radicand| (|List| |#4|)))
415                                  |#4| (|NonNegativeInteger|)))
416                                T))
417                             (LIST) NIL NIL)))
418                        (|makeByteWordVec2| 62
419                                            '(0 8 0 11 0 9 0 12 1 14 13 0 15 2
420                                              19 16 17 18 20 0 8 0 21 1 9 0 8
421                                              22 1 10 0 9 23 2 10 0 14 0 24 1
422                                              10 0 14 25 1 26 14 0 27 1 26 14 0
423                                              28 2 14 0 0 0 29 2 10 0 0 0 30 2
424                                              10 0 0 18 31 2 0 32 26 18 33 1 8
425                                              34 0 35 0 10 0 36 2 0 32 8 18 37
426                                              1 8 38 0 39 1 26 0 14 40 1 9 41 0
427                                              42 2 9 0 0 0 43 2 8 0 0 0 44 1 9
428                                              38 0 45 1 9 13 0 46 2 49 47 48 18
429                                              50 1 9 0 14 51 2 0 47 9 18 52 1
430                                              10 53 0 54 2 10 53 0 0 55 1 10 9
431                                              0 56 1 10 9 0 57 1 14 0 58 59 2
432                                              10 0 0 0 60 2 9 0 0 18 61 2 0 32
433                                              10 18 62 2 0 32 8 18 37 2 0 32 26
434                                              18 33 2 0 47 9 18 52 2 1 32 10 18
435                                              62)))))
436           '|lookupComplete|))
437