source: CGBLisp/tests/RCS/ratpoly-tests.lisp,v@ 1

head    1.1;
access;
symbols;
locks; strict;
comment @;;; @;


1.1
date    2009.01.19.18.19.46;    author marek;   state Exp;
branches;
next    ;


desc
@@


1.1
log
@Initial revision
@
text
@#|
        $Id: ratpoly-tests.lisp,v 1.10 1997/12/13 07:45:04 marek Exp $  
  *--------------------------------------------------------------------------*
  |  Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@@math.arizona.edu)    |
  |    Department of Mathematics, University of Arizona, Tucson, AZ 85721    |
  |                                                                          |
  | Everyone is permitted to copy, distribute and modify the code in this    |
  | directory, as long as this copyright note is preserved verbatim.         |
  *--------------------------------------------------------------------------*
|#
;; Tests of the ratpoly package
;; Example of exercise 3.6.1
;; f = x^2*y-3*x*y^2+x^2-3*x*y
;; g = x^3*y-4*y^2+y+x^3-4*y+1
;;(require "parse")
;;(require "monom")
;;(require "printer")
;;(require "ratpoly")
;;(use-package '("parse" "monom" "printer" "ratpoly"))

;; The value of this variable is a function that will do evaluation
;; instead of eval; this one just prints what it is evaluating and calls eval
(setf *evalhook* 
      #'(lambda (form env)
          (format t "~&EVAL> ~a~%" form)
          (format t "~&VALUE--> ~a~2%" (eval form))
          ))

(dribble "ratpoly-tests.output")
(setf f (parse-string-to-sorted-alist "x^2*y-3*x*y^2+x^2-3*x*y" '(x y)))
(setf g (parse-string-to-sorted-alist "x^3*y-4*y^2+y+x^3-4*y+1" '(x y)))

(princ ";; Print the polynomials")
(terpri)
(poly-print f '(x y))
(poly-print g '(x y))
(terpri)

(princ ";; Convert the polynomials to RATPOLY form")
(terpri)
(setf rf (poly-to-ratpoly f))
(setf rg (poly-to-ratpoly g))

(princ ";; Print converted polynomials")
(terpri)
(ratpoly-print rf '(x y))
(ratpoly-print rg '(x y))
(terpri)

(princ ";; Calculate the resultant")
(terpri)
(setf res (ratpoly-resultant rf rg))
(ratpoly-print res '(x y))
(setf res (ratpoly-to-poly res))
(poly-print res '(x y))
(terpri)

(princ ";; Calculate the discriminant of f")
(terpri)
(setf disc (ratpoly-discriminant rf))
(ratpoly-print disc '(x y))
(terpri)
(setf disc (ratpoly-to-poly disc))
(poly-print disc '(x y))
(terpri)

(princ ";; Exercise 3.6.4 of Cox-Little-O'Shea")
(terpri)
(setf f (parse-string-to-sorted-alist "x^2*y-3*x-1" '(x y)))
(setf g (parse-string-to-sorted-alist "6*x^2+y^2-4" '(x y)))
(setf rf (poly-to-ratpoly f))
(setf rg (poly-to-ratpoly g))
(setf res (ratpoly-resultant rf rg))
(setf res (ratpoly-to-poly res))
(poly-print res '(x y))
(terpri)
(setf res (poly-resultant f g))
(poly-print res '(x y))
(terpri)
(princ ";; Check that the package works on poly's in 1 variable")
(terpri)
(princ ";; Exercise 3.6.8 of Cox-Little-O'Shea")
(terpri)
(princ ";; Maple answer:")
(setf f (parse-string-to-sorted-alist "6*x^4-23*x^3+32*x^2-19*x+4" '(x)))
(setf rf (poly-to-ratpoly f))
(setf rg (ratpoly-diff rf))
(setf g (ratpoly-to-poly rg))
(setf res (ratpoly-resultant rf rg))
(setf res (ratpoly-to-poly res))
(poly-print res '(x))
(terpri)
(setf res (poly-resultant f g))
(poly-print res '(x))
(terpri)
(princ ";; Yes! it works on one variable as well")
(terpri)

(princ ";; The previous exercise repeated for some random polynomial")
(terpri)
(princ ";; Exercise 3.6.8 of Cox-Little-O'Shea")
(terpri)
(princ ";; Maple answer:")
(setf f (parse-string-to-sorted-alist "6*x^4+23*x^3-30*x^2-19*x+4" '(x)))
(setf rf (poly-to-ratpoly f))
(setf rg (ratpoly-diff rf))
(setf g (ratpoly-to-poly rg))
(setf res (ratpoly-resultant rf rg))
(setf res (ratpoly-to-poly res))
(poly-print res '(x))
(terpri)
(setf res (poly-resultant f g))
(poly-print res '(x))
(terpri)
(princ ";; Maple answer: 13867656600")
(terpri)
(setf disc (ratpoly-discriminant rf))
(ratpoly-print disc '(x y))
(terpri)
(setf disc (ratpoly-to-poly disc))
(poly-print disc '(x y))
(terpri)
(princ ";; Maple equivalent is discrim(f,x)")
(terpri)
(princ ";; and yields: 2311276100")
(terpri)

(dribble)
(setf *evalhook* nil)
@