1 | #|
|
---|
2 | $Id: ratpoly-tests.lisp,v 1.1 2009/01/19 18:19:46 marek Exp $
|
---|
3 | *--------------------------------------------------------------------------*
|
---|
4 | | Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@math.arizona.edu) |
|
---|
5 | | Department of Mathematics, University of Arizona, Tucson, AZ 85721 |
|
---|
6 | | |
|
---|
7 | | Everyone is permitted to copy, distribute and modify the code in this |
|
---|
8 | | directory, as long as this copyright note is preserved verbatim. |
|
---|
9 | *--------------------------------------------------------------------------*
|
---|
10 | |#
|
---|
11 | ;; Tests of the ratpoly package
|
---|
12 | ;; Example of exercise 3.6.1
|
---|
13 | ;; f = x^2*y-3*x*y^2+x^2-3*x*y
|
---|
14 | ;; g = x^3*y-4*y^2+y+x^3-4*y+1
|
---|
15 | ;;(require "parse")
|
---|
16 | ;;(require "monom")
|
---|
17 | ;;(require "printer")
|
---|
18 | ;;(require "ratpoly")
|
---|
19 | ;;(use-package '("parse" "monom" "printer" "ratpoly"))
|
---|
20 |
|
---|
21 | ;; The value of this variable is a function that will do evaluation
|
---|
22 | ;; instead of eval; this one just prints what it is evaluating and calls eval
|
---|
23 | (setf *evalhook*
|
---|
24 | #'(lambda (form env)
|
---|
25 | (format t "~&EVAL> ~a~%" form)
|
---|
26 | (format t "~&VALUE--> ~a~2%" (eval form))
|
---|
27 | ))
|
---|
28 |
|
---|
29 | (dribble "ratpoly-tests.output")
|
---|
30 | (setf f (parse-string-to-sorted-alist "x^2*y-3*x*y^2+x^2-3*x*y" '(x y)))
|
---|
31 | (setf g (parse-string-to-sorted-alist "x^3*y-4*y^2+y+x^3-4*y+1" '(x y)))
|
---|
32 |
|
---|
33 | (princ ";; Print the polynomials")
|
---|
34 | (terpri)
|
---|
35 | (poly-print f '(x y))
|
---|
36 | (poly-print g '(x y))
|
---|
37 | (terpri)
|
---|
38 |
|
---|
39 | (princ ";; Convert the polynomials to RATPOLY form")
|
---|
40 | (terpri)
|
---|
41 | (setf rf (poly-to-ratpoly f))
|
---|
42 | (setf rg (poly-to-ratpoly g))
|
---|
43 |
|
---|
44 | (princ ";; Print converted polynomials")
|
---|
45 | (terpri)
|
---|
46 | (ratpoly-print rf '(x y))
|
---|
47 | (ratpoly-print rg '(x y))
|
---|
48 | (terpri)
|
---|
49 |
|
---|
50 | (princ ";; Calculate the resultant")
|
---|
51 | (terpri)
|
---|
52 | (setf res (ratpoly-resultant rf rg))
|
---|
53 | (ratpoly-print res '(x y))
|
---|
54 | (setf res (ratpoly-to-poly res))
|
---|
55 | (poly-print res '(x y))
|
---|
56 | (terpri)
|
---|
57 |
|
---|
58 | (princ ";; Calculate the discriminant of f")
|
---|
59 | (terpri)
|
---|
60 | (setf disc (ratpoly-discriminant rf))
|
---|
61 | (ratpoly-print disc '(x y))
|
---|
62 | (terpri)
|
---|
63 | (setf disc (ratpoly-to-poly disc))
|
---|
64 | (poly-print disc '(x y))
|
---|
65 | (terpri)
|
---|
66 |
|
---|
67 | (princ ";; Exercise 3.6.4 of Cox-Little-O'Shea")
|
---|
68 | (terpri)
|
---|
69 | (setf f (parse-string-to-sorted-alist "x^2*y-3*x-1" '(x y)))
|
---|
70 | (setf g (parse-string-to-sorted-alist "6*x^2+y^2-4" '(x y)))
|
---|
71 | (setf rf (poly-to-ratpoly f))
|
---|
72 | (setf rg (poly-to-ratpoly g))
|
---|
73 | (setf res (ratpoly-resultant rf rg))
|
---|
74 | (setf res (ratpoly-to-poly res))
|
---|
75 | (poly-print res '(x y))
|
---|
76 | (terpri)
|
---|
77 | (setf res (poly-resultant f g))
|
---|
78 | (poly-print res '(x y))
|
---|
79 | (terpri)
|
---|
80 | (princ ";; Check that the package works on poly's in 1 variable")
|
---|
81 | (terpri)
|
---|
82 | (princ ";; Exercise 3.6.8 of Cox-Little-O'Shea")
|
---|
83 | (terpri)
|
---|
84 | (princ ";; Maple answer:")
|
---|
85 | (setf f (parse-string-to-sorted-alist "6*x^4-23*x^3+32*x^2-19*x+4" '(x)))
|
---|
86 | (setf rf (poly-to-ratpoly f))
|
---|
87 | (setf rg (ratpoly-diff rf))
|
---|
88 | (setf g (ratpoly-to-poly rg))
|
---|
89 | (setf res (ratpoly-resultant rf rg))
|
---|
90 | (setf res (ratpoly-to-poly res))
|
---|
91 | (poly-print res '(x))
|
---|
92 | (terpri)
|
---|
93 | (setf res (poly-resultant f g))
|
---|
94 | (poly-print res '(x))
|
---|
95 | (terpri)
|
---|
96 | (princ ";; Yes! it works on one variable as well")
|
---|
97 | (terpri)
|
---|
98 |
|
---|
99 | (princ ";; The previous exercise repeated for some random polynomial")
|
---|
100 | (terpri)
|
---|
101 | (princ ";; Exercise 3.6.8 of Cox-Little-O'Shea")
|
---|
102 | (terpri)
|
---|
103 | (princ ";; Maple answer:")
|
---|
104 | (setf f (parse-string-to-sorted-alist "6*x^4+23*x^3-30*x^2-19*x+4" '(x)))
|
---|
105 | (setf rf (poly-to-ratpoly f))
|
---|
106 | (setf rg (ratpoly-diff rf))
|
---|
107 | (setf g (ratpoly-to-poly rg))
|
---|
108 | (setf res (ratpoly-resultant rf rg))
|
---|
109 | (setf res (ratpoly-to-poly res))
|
---|
110 | (poly-print res '(x))
|
---|
111 | (terpri)
|
---|
112 | (setf res (poly-resultant f g))
|
---|
113 | (poly-print res '(x))
|
---|
114 | (terpri)
|
---|
115 | (princ ";; Maple answer: 13867656600")
|
---|
116 | (terpri)
|
---|
117 | (setf disc (ratpoly-discriminant rf))
|
---|
118 | (ratpoly-print disc '(x y))
|
---|
119 | (terpri)
|
---|
120 | (setf disc (ratpoly-to-poly disc))
|
---|
121 | (poly-print disc '(x y))
|
---|
122 | (terpri)
|
---|
123 | (princ ";; Maple equivalent is discrim(f,x)")
|
---|
124 | (terpri)
|
---|
125 | (princ ";; and yields: 2311276100")
|
---|
126 | (terpri)
|
---|
127 |
|
---|
128 | (dribble)
|
---|
129 | (setf *evalhook* nil)
|
---|