[1] | 1 | #|
|
---|
| 2 | $Id$
|
---|
| 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 | ;;(use-package '("parse" "monom" "printer" "colored-poly" "grobner" "coefficient-ring"))
|
---|
| 12 |
|
---|
| 13 | ;; The value of this variable is a function that will do evaluation
|
---|
| 14 | ;; instead of eval; this one just prints what it is evaluating and calls eval
|
---|
| 15 |
|
---|
| 16 | (dribble "colored-poly-tests.output")
|
---|
| 17 |
|
---|
| 18 |
|
---|
| 19 | #|
|
---|
| 20 | (warn "Test 1")
|
---|
| 21 | (setf f (parse-string-to-sorted-alist "4*x^2-3*x*y" '(x y)))
|
---|
| 22 | (setf g (parse-string-to-sorted-alist "4*x+5*y" '(x y)))
|
---|
| 23 | (setf cf (make-colored-poly f 2))
|
---|
| 24 | (setf cg (make-colored-poly g 2))
|
---|
| 25 | (time (cond-system-print (grobner-system (list cf cg)) '(x y) '()))
|
---|
| 26 | (time (poly-print (cons '[ (grobner (list f g))) '(x y)))
|
---|
| 27 |
|
---|
| 28 | (warn" Test 2 - Enneper surface")
|
---|
| 29 | (setf fl
|
---|
| 30 | (cdr
|
---|
| 31 | (parse-string-to-sorted-alist
|
---|
| 32 | "[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]"
|
---|
| 33 | '(u v x y z))))
|
---|
| 34 | (setf cfl (make-colored-poly-list fl 5))
|
---|
| 35 | (time (cond-system-print (grobner-system cfl) '(u v x y z) '()))
|
---|
| 36 | (time (poly-print (cons '[ (reduced-grobner fl)) '(u v x y z)))
|
---|
| 37 |
|
---|
| 38 | (warn" Test 3 - staple")
|
---|
| 39 | (setf fl
|
---|
| 40 | (cdr (parse-string-to-sorted-alist
|
---|
| 41 | "[x+y,x+u*y]"
|
---|
| 42 | '(x y u))))
|
---|
| 43 | (setf cfl (make-colored-poly-list fl 2))
|
---|
| 44 | (time (cond-system-print (grobner-system cfl) '(x y) '(u)))
|
---|
| 45 |
|
---|
| 46 | (warn" Test 4 - staple")
|
---|
| 47 | (setf fl
|
---|
| 48 | (cdr
|
---|
| 49 | (parse-string-to-sorted-alist
|
---|
| 50 | "[x+y,u*x+y]"
|
---|
| 51 | '(x y u))))
|
---|
| 52 | (setf cfl (make-colored-poly-list fl 2))
|
---|
| 53 | (time (cond-system-print (grobner-system cfl) '(x y) '(u)))
|
---|
| 54 |
|
---|
| 55 | (warn "Test 5 - a small robot example")
|
---|
| 56 | (setf vars-params '(s1 c1 s2 c2 a b l1 l2 l3 ))
|
---|
| 57 | (setf vars (butlast vars-params 5))
|
---|
| 58 | (setf params (nthcdr 4 vars-params))
|
---|
| 59 | (setf cover2 (cdr (parse-string-to-sorted-alist "[l1,l2,l3]" params)))
|
---|
| 60 | (setf cover (list (list nil cover2)))
|
---|
| 61 | (setf fl (cdr
|
---|
| 62 | (parse-string-to-sorted-alist
|
---|
| 63 | "[a-l3*c1*c2+l3*s1*s2, b-l3*c1*s2-l3*c2*s1+l2*s1, c1^2+s1^2-1, c2^2+s2^2-1]"
|
---|
| 64 | vars-params)))
|
---|
| 65 | (setf cfl (make-colored-poly-list fl 4))
|
---|
| 66 |
|
---|
| 67 | (time (cond-system-print (grobner-system cfl :cover cover)
|
---|
| 68 | vars params))
|
---|
| 69 | |#
|
---|
| 70 |
|
---|
| 71 | (warn "Test 1")
|
---|
| 72 | (string-grobner-system "[4*x^2-3*x*y,4*x+5*y]" '(x y) '())
|
---|
| 73 |
|
---|
| 74 | (warn "Test 2 - Enneper")
|
---|
| 75 | (let* ((val1
|
---|
| 76 | (string-grobner-system
|
---|
| 77 | "[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]"
|
---|
| 78 | '(u v x y z) '() :suppress-value nil))
|
---|
| 79 | (val1 (grobner (mapcar #'colored-poly-to-poly (cadar val1))))
|
---|
| 80 | (val2
|
---|
| 81 | (string-grobner "[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]"
|
---|
| 82 | '(u v x y z) :suppress-value nil)))
|
---|
| 83 | (grobner-equal val1 val2))
|
---|
| 84 |
|
---|
| 85 |
|
---|
| 86 | (warn" Test 3 - staple")
|
---|
| 87 | (string-grobner-system "[x+y,x+u*y]" '(x y) '(u))
|
---|
| 88 |
|
---|
| 89 | (warn" Test 4 - staple")
|
---|
| 90 | (string-grobner-system "[x+y,u*x+y]" '(x y) '(u))
|
---|
| 91 |
|
---|
| 92 |
|
---|
| 93 | (warn "Test 5 - a small robot example")
|
---|
| 94 | (string-grobner-system "[a-l3*c1*c2+l3*s1*s2-l2*c1, b-l3*c1*s2-l3*c2*s1-l2*s1, c1^2+s1^2-1, c2^2+s2^2-1]" '(c2 s2 c1 s1) '(a b l2 l3) :cover '(("[]" "[l2,l3]")))
|
---|
| 95 |
|
---|
| 96 | (warn "Test 6 - Circle of Apollonius")
|
---|
| 97 | (string-grobner-system
|
---|
| 98 | "[2*x1-u1,2*x2-u2,2*x3-u1,2*x4-u2,x5*u1-x6*u2,x5*u2+x6*u1-u1*u2,x1^2-2*x1*x7+x7^2+x8^2-x7^2-x8^2+2*x8*x2-x2^2,x1^2-2*x1*x7+x7^2+x6^2-2*x6*x8+x8^2-x3^2+2*x3*x7-x7^2-x4^2+2*x4*x8-x8^2,1-s*x5^2+2*s*x5*x7-s*x7^2-s*x6^2+2*s*x6*x8-s*x8^2+s*x1^2-2*s*x1*x7+s*x7^2+s*x8^2]"
|
---|
| 99 | '(s x1 x2 x3 x4 x5 x6 x7 x8) ;vars
|
---|
| 100 | '(u1 u2) ;parameters
|
---|
| 101 | )
|
---|
| 102 |
|
---|
| 103 | (warn "Test 7")
|
---|
| 104 | (setf fl (cdr (parse-string-to-sorted-alist
|
---|
| 105 | "[a^2*x^2*y+b*x^2*y+a^3*b*x*y+a^3*c*x*y,c^2*a*x^2+c^2*b*x^2+b*y+4]"
|
---|
| 106 | '(x y a b c))))
|
---|
| 107 | (setf cfl (make-colored-poly-list fl 2))
|
---|
| 108 | (cond-system-print (determine cfl) '(x y) '(a b c))
|
---|
| 109 |
|
---|
| 110 | (warn "Test 8")
|
---|
| 111 | (setf fl (cdr (parse-string-to-sorted-alist
|
---|
| 112 | "[a^2*x+5*a]"
|
---|
| 113 | '(x a))))
|
---|
| 114 | (setf cfl (make-colored-poly-list fl 1))
|
---|
| 115 | (cond-system-print (determine cfl) '(x) '(a))
|
---|
| 116 |
|
---|
| 117 | (warn "Test 9 - the discriminant of a quadratic polynomial")
|
---|
| 118 | (string-grobner-system
|
---|
| 119 | "[a*x^2+b*x+c,2*a*x+b]" '(x) '(a b c)
|
---|
| 120 | :cover (list (list "[]" "[a]")))
|
---|
| 121 |
|
---|
| 122 | (warn "Test 10 - the discriminant of a cubic polynomial")
|
---|
| 123 | (string-grobner-system
|
---|
| 124 | "[x^3+p*x+q,3*x^2+p]" '(x) '(p q)
|
---|
| 125 | :cover (list (list "[]" "[]")))
|
---|
| 126 |
|
---|
| 127 | (warn "Test 11 - the discriminant of a quartic polynomial")
|
---|
| 128 | (string-grobner-system
|
---|
| 129 | "[x^4+p*x^2+q*x+r,4*x^3+2*p*x+q]" '(x) '(p q r)
|
---|
| 130 | :cover (list (list "[]" "[]")))
|
---|
| 131 |
|
---|
| 132 |
|
---|
| 133 | (dribble)
|
---|
| 134 |
|
---|