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