| 1 | ;;; THIS FILE IS OBSOLETE!!! IT NEEDS A CONVERSION TO NEW FORMAT.
|
|---|
| 2 | #|
|
|---|
| 3 | SccsId="@(#)tests.lisp, version 1.7 of 5/14/94(11:23:03)
|
|---|
| 4 | *--------------------------------------------------------------------------*
|
|---|
| 5 | | Copyright (C) 1994, Marek Rychlik (e-mail: rychlik@math.arizona.edu) |
|
|---|
| 6 | | Department of Mathematics, University of Arizona, Tucson, AZ 85721 |
|
|---|
| 7 | | |
|
|---|
| 8 | | Everyone is permitted to copy, distribute and modify the code in this |
|
|---|
| 9 | | directory, as long as this copyright note is preserved verbatim. |
|
|---|
| 10 | *--------------------------------------------------------------------------*
|
|---|
| 11 | |#
|
|---|
| 12 |
|
|---|
| 13 | ;;(load "grobner-front-end")
|
|---|
| 14 |
|
|---|
| 15 | (defun run (test)
|
|---|
| 16 | (format t "Test ~a ~:[failed~;succeeded~]...~%" test (time (funcall test))))
|
|---|
| 17 |
|
|---|
| 18 | (defun test-1 ()
|
|---|
| 19 | (let* ((vars '(x y)))
|
|---|
| 20 | (equalp
|
|---|
| 21 | (mapcar #'(lambda (pred)
|
|---|
| 22 | (let* ((f (poly "4*x^2-3*x*y" vars pred))
|
|---|
| 23 | (g (poly "4*x+5*y" vars pred)))
|
|---|
| 24 | (spoly f g pred)))
|
|---|
| 25 | (list #'lex> #'grlex> #'grevlex>))
|
|---|
| 26 | (list
|
|---|
| 27 | (poly "-32*x*y" vars #'lex>)
|
|---|
| 28 | (poly "-32*x*y" vars #'grlex>)
|
|---|
| 29 | (poly "-32*x*y" vars #'grevlex>)))))
|
|---|
| 30 |
|
|---|
| 31 | (defun test-2 ()
|
|---|
| 32 | (let* ((vars '(x y z)))
|
|---|
| 33 | (equalp
|
|---|
| 34 | (mapcar #'(lambda (pred)
|
|---|
| 35 | (let* ((f (poly "4*x^5-3*x*y-z^2" vars pred))
|
|---|
| 36 | (g (poly-list "[4*x^3+5*y+z^2,y^2+z]" vars pred)))
|
|---|
| 37 | (normal-form f g pred)))
|
|---|
| 38 | (list #'lex> #'grlex> #'grevlex>))
|
|---|
| 39 | (list
|
|---|
| 40 | (poly "-5*x^2*y-x^2*z^2-3*x*y-z^2" vars #'lex>)
|
|---|
| 41 | (poly "-X^2*Z^2-5*X^2*Y-3*X*Y-Z^2" vars #'grlex>)
|
|---|
| 42 | (poly "-X^2*Z^2-5*X^2*Y-3*X*Y-Z^2" vars #'grevlex>)))))
|
|---|
| 43 |
|
|---|
| 44 |
|
|---|
| 45 | ;; Find the equation of the Enneper surface
|
|---|
| 46 | (defun test-3 ()
|
|---|
| 47 | (let* ((vars '(u v x y z))
|
|---|
| 48 | (eqns (poly-list
|
|---|
| 49 | "[x-3*u-3*u*v^2+u^3,y-3*v-3*u^2*v+v^3,z-3*u^2+3*v^2]"
|
|---|
| 50 | vars))
|
|---|
| 51 | (ans (poly-list
|
|---|
| 52 | "[X^6 - 3 * X^4 * Y^2 + 5/9 * X^4 * Z^3 + 6 * X^4 * Z^2 - 3 *
|
|---|
| 53 | X^4 * Z + 3 * X^2 * Y^4 + 26/9 * X^2 * Y^2 * Z^3 + 6 * X^2 *
|
|---|
| 54 | Y^2 * Z + 16/243 * X^2 * Z^6 + 16/9 * X^2 * Z^5 + 80/9 * X^2 *
|
|---|
| 55 | Z^4 - 16 * X^2 * Z^3 - Y^6 + 5/9 * Y^4 * Z^3 - 6 * Y^4 * Z^2 -
|
|---|
| 56 | 3 * Y^4 * Z - 16/243 * Y^2 * Z^6 + 16/9 * Y^2 * Z^5 - 80/9 *
|
|---|
| 57 | Y^2 * Z^4 - 16 * Y^2 * Z^3 - 64/19683 * Z^9 + 128/243 * Z^7 -
|
|---|
| 58 | 64/3 * Z^5]"
|
|---|
| 59 | vars)))
|
|---|
| 60 | (set-coefficient-ring nil) ;char=0
|
|---|
| 61 | (equalp (elimination-ideal eqns 2) ans)))
|
|---|
| 62 |
|
|---|
| 63 | (defun test-4 ()
|
|---|
| 64 | (let* ((vars '(x y))
|
|---|
| 65 | (id1 (poly-list "[x-y^2,y^2*x]" vars))
|
|---|
| 66 | (id2 (poly-list "[x^2-x*y^2,y^2]" vars))
|
|---|
| 67 | (ans (poly-list "[x^2,y^4,x*y^2]" vars)))
|
|---|
| 68 | (equalp (ideal-intersection id1 id2) ans)))
|
|---|
| 69 |
|
|---|
| 70 | (defun test-5 ()
|
|---|
| 71 | (let* ((vars '(x y z))
|
|---|
| 72 | (f (poly-list "[x^5+y^4+z^3-1, x^3+y^2+z^2-1]" vars))
|
|---|
| 73 | (ans (poly-list
|
|---|
| 74 | "[ X^2 * Z^4 + X^2 * Z^3 - 2 * X^2 * Z^2 - 1/6 * X * Z^10 - 2/3
|
|---|
| 75 | * X * Z^9 - 1/4 * X * Z^8 + 7/6 * X * Z^7 - 1/12 * X * Z^6 - X
|
|---|
| 76 | * Z^5 + X * Z^4 + 1/2 * Y^10 * Z^2 + 1/3 * Y^10 * Z - 5/12 *
|
|---|
| 77 | Y^10 - 1/6 * Y^8 * Z^4 + 1/3 * Y^8 * Z^3 + 1/4 * Y^8 * Z^2 +
|
|---|
| 78 | 1/2 * Y^8 + Y^6 * Z^5 - 5/3 * Y^6 * Z^4 - 17/6 * Y^6 * Z^3 +
|
|---|
| 79 | 17/6 * Y^6 * Z^2 + 2/3 * Y^6 * Z - 1/3 * Y^6 - 1/3 * Y^4 * Z^7
|
|---|
| 80 | - 7/2 * Y^4 * Z^6 - 3 * Y^4 * Z^5 + 131/12 * Y^4 * Z^4 + 23/4 *
|
|---|
| 81 | Y^4 * Z^3 - 13 * Y^4 * Z^2 - 8/3 * Y^4 * Z + 29/6 * Y^4 - 17/6
|
|---|
| 82 | * Y^2 * Z^8 - 4 * Y^2 * Z^7 + 119/12 * Y^2 * Z^6 + 17/2 * Y^2 *
|
|---|
| 83 | Z^5 - 16 * Y^2 * Z^4 - 14/3 * Y^2 * Z^3 + 12 * Y^2 * Z^2 + 5/3
|
|---|
| 84 | * Y^2 * Z - 55/12 * Y^2 - 7/6 * Z^10 - 7/6 * Z^9 + 55/12 * Z^8
|
|---|
| 85 | + 21/4 * Z^7 - 31/4 * Z^6 - 15/2 * Z^5 + 83/12 * Z^4 + 41/12 *
|
|---|
| 86 | Z^3 - 31/12 * Z^2, X * Y^2 * Z - X * Y^2 - 1/8 * X * Z^10 -
|
|---|
| 87 | 7/24 * X * Z^9 + 1/2 * X * Z^8 + 7/8 * X * Z^7 - 23/24 * X *
|
|---|
| 88 | Z^6 + 1/2 * X * Z^4 - 1/2 * X * Z^3 - X * Z + X + 3/8 * Y^10 *
|
|---|
| 89 | Z^2 - 3/8 * Y^10 * Z - 7/24 * Y^10 - 1/8 * Y^8 * Z^4 + 11/24 *
|
|---|
| 90 | Y^8 * Z^3 - 3/8 * Y^8 * Z^2 + 1/4 * Y^8 * Z - 1/4 * Y^8 + 3/4 *
|
|---|
| 91 | Y^6 * Z^5 - 5/2 * Y^6 * Z^4 + 5/6 * Y^6 * Z^3 + 31/12 * Y^6 *
|
|---|
| 92 | Z^2 - Y^6 * Z - 1/3 * Y^6 - 1/4 * Y^4 * Z^7 - 53/24 * Y^4 * Z^6
|
|---|
| 93 | + 11/6 * Y^4 * Z^5 + 113/12 * Y^4 * Z^4 - 55/8 * Y^4 * Z^3 -
|
|---|
| 94 | 29/4 * Y^4 * Z^2 + 15/4 * Y^4 * Z + 19/12 * Y^4 - 17/8 * Y^2 *
|
|---|
| 95 | Z^8 + 13/24 * Y^2 * Z^7 + 239/24 * Y^2 * Z^6 - 59/12 * Y^2 *
|
|---|
| 96 | Z^5 - 151/12 * Y^2 * Z^4 + 85/12 * Y^2 * Z^3 + 43/8 * Y^2 * Z^2
|
|---|
| 97 | - 29/8 * Y^2 * Z + 7/24 * Y^2 - 7/8 * Z^10 + 7/12 * Z^9 + 31/8
|
|---|
| 98 | * Z^8 - 11/12 * Z^7 - 103/12 * Z^6 + 17/6 * Z^5 + 127/24 * Z^4
|
|---|
| 99 | - 3/2 * Z^3 - 17/24 * Z^2 + Z - 1, X * Z^11 + 4 * X * Z^10 + X
|
|---|
| 100 | * Z^9 - 10 * X * Z^8 - 4 * X * Z^7 + 8 * X * Z^6 - 3 * Y^10 *
|
|---|
| 101 | Z^3 - 2 * Y^10 * Z^2 + 4 * Y^10 * Z + 4 * Y^10 + Y^8 * Z^5 - 2
|
|---|
| 102 | * Y^8 * Z^4 - 2 * Y^8 * Z^3 - 6 * Y^6 * Z^6 + 10 * Y^6 * Z^5 +
|
|---|
| 103 | 20 * Y^6 * Z^4 - 16 * Y^6 * Z^3 - 24 * Y^6 * Z^2 + 8 * Y^6 * Z
|
|---|
| 104 | + 8 * Y^6 + 2 * Y^4 * Z^8 + 21 * Y^4 * Z^7 + 17 * Y^4 * Z^6 -
|
|---|
| 105 | 78 * Y^4 * Z^5 - 64 * Y^4 * Z^4 + 90 * Y^4 * Z^3 + 76 * Y^4 *
|
|---|
| 106 | Z^2 - 32 * Y^4 * Z - 32 * Y^4 + 17 * Y^2 * Z^9 + 24 * Y^2 * Z^8
|
|---|
| 107 | - 68 * Y^2 * Z^7 - 80 * Y^2 * Z^6 + 106 * Y^2 * Z^5 + 108 * Y^2
|
|---|
| 108 | * Z^4 - 77 * Y^2 * Z^3 - 70 * Y^2 * Z^2 + 20 * Y^2 * Z + 20 *
|
|---|
| 109 | Y^2 + 7 * Z^11 + 7 * Z^10 - 31 * Z^9 - 42 * Z^8 + 55 * Z^7 + 77
|
|---|
| 110 | * Z^6 - 39 * Z^5 - 62 * Z^4 + 8 * Z^3 + 20 * Z^2, Y^12 - Y^10 +
|
|---|
| 111 | 3 * Y^8 * Z^3 - 5 * Y^8 * Z^2 + 2 * Y^8 - 10 * Y^6 * Z^4 + 20 *
|
|---|
| 112 | Y^6 * Z^2 - 10 * Y^6 - 7 * Y^4 * Z^6 + 30 * Y^4 * Z^4 - 6 * Y^4
|
|---|
| 113 | * Z^3 - 30 * Y^4 * Z^2 + 13 * Y^4 - 5 * Y^2 * Z^8 + 20 * Y^2 *
|
|---|
| 114 | Z^6 - 30 * Y^2 * Z^4 + 20 * Y^2 * Z^2 - 5 * Y^2 - Z^10 + Z^9 +
|
|---|
| 115 | 5 * Z^8 - 13 * Z^6 + 10 * Z^4 + 3 * Z^3 - 5 * Z^2, X * Y^4 + X
|
|---|
| 116 | * Z^3 - X + Y^4 + 2 * Y^2 * Z^2 - 2 * Y^2 + Z^4 - 2 * Z^2 + 1,
|
|---|
| 117 | X^2 * Y^2 + X^2 * Z^2 - X^2 - Y^4 - Z^3 + 1, X^3 + Y^2 + Z^2 -
|
|---|
| 118 | 1 ]" vars)))
|
|---|
| 119 | (equalp (grobner f :reduce t) ans)))
|
|---|
| 120 |
|
|---|
| 121 | (defun test-6 ()
|
|---|
| 122 | (let* ((vars '(x y z))
|
|---|
| 123 | (f (poly-list "[x^5+y^4+z^3-1,x^3+y^3+z^2-1]" vars))
|
|---|
| 124 | (ans (poly-list "[x]" vars))) ;unknown yet
|
|---|
| 125 | (equalp (grobner f :reduce t) ans)))
|
|---|
| 126 |
|
|---|
| 127 | ;;----------------------------------------------------------------
|
|---|
| 128 |
|
|---|
| 129 | (defun run-short-tests ()
|
|---|
| 130 | (dolist (test '(test-1 test-2 test-4))
|
|---|
| 131 | (run test)))
|
|---|
| 132 |
|
|---|
| 133 | (defun run-long-tests ()
|
|---|
| 134 | (dolist (test '(test-3 test-5))
|
|---|
| 135 | (run test)))
|
|---|
| 136 |
|
|---|
![(please configure the [header_logo] section in trac.ini)](/trac/CGBLisp/chrome/site/your_project_logo.png){kind=logo}
