Context Navigation

close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

source: branches/f4grobner/5am-symbolic-poly.lisp@ 4391

Last change on this file since 4391 was 4325, checked in by Marek Rychlik, 9 years ago
Now classes INTEGER-RING and RATIONAL-FIELD are a part of the RING package
File size: 8.2 KB

Line
1	;;; -- Mode: Lisp --
2	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3	;;;
4	;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>
5	;;;
6	;;; This program is free software; you can redistribute it and/or modify
7	;;; it under the terms of the GNU General Public License as published by
8	;;; the Free Software Foundation; either version 2 of the License, or
9	;;; (at your option) any later version.
10	;;;
11	;;; This program is distributed in the hope that it will be useful,
12	;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14	;;; GNU General Public License for more details.
15	;;;
16	;;; You should have received a copy of the GNU General Public License
17	;;; along with this program; if not, write to the Free Software
18	;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19	;;;
20	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21
22	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23	;;
24	;; Run tests using 5am unit testing framework
25	;;
26	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27
28	;; We assume that QuickLisp package manager is installed.
29	;; See :
30	;; https://www.quicklisp.org/beta/
31	;;
32
33	;; The following is unnecessary after running:
34	;; * (ql:add-to-init-file)
35	;; at lisp prompt:
36	;;(load "~/quicklisp/setup")
37
38	(ql:quickload :fiveam)
39
40	(defpackage #:5am-symbolic-poly
41	(:use :cl :it.bese.fiveam :monom :polynomial :infix :symbolic-polynomial))
42
43	(in-package :5am-symbolic-poly)
44
45	(def-suite symbolic-poly-suite
46	:description "Symbolic polynomial package suite")
47
48	(in-suite symbolic-poly-suite)
49
50	(test read-infix-form
51	"Infix form reader"
52	(is (equalp (with-input-from-string (s "X^2-Y^2+(-4/3)U^2W^3-5") (read-infix-form :stream s))
53	'(+ (- (EXPT X 2) (EXPT Y 2)) (* (- (/ 4 3)) (EXPT U 2) (EXPT W 3)) (- 5))))
54	(is (equalp (poly->string (string->poly "1" '(x y u w))) "1"))
55	(is (equalp (->sexp (string->poly "X^2-Y^2+(-4/3)U^2W^3-5" '(x y u w)))
56	'(+ (EXPT X 2) (* -1 (EXPT Y 2)) (* -4/3 (EXPT U 2) (EXPT W 3)) -5))))
57
58
59	(def-fixture sym-poly-context ()
60	(let ((p (make-instance 'poly))
61	(p-symbolic (make-instance 'symbolic-poly :vars '(x))))
62	(dolist (x '( ((2) . 22) ((4) . 44) ((5) . 55) ((8) . 88) ((9) . 99) ))
63	(poly-insert-term p (make-instance 'term :exponents (car x) :coeff (cdr x)))
64	(poly-insert-term p-symbolic (make-instance 'term :exponents (car x) :coeff (cdr x))))
65	(&body)))
66
67	(test sym-poly
68	"Symbolic polynomial"
69	(with-fixture sym-poly-context ()
70	(is (universal-equalp (change-class p 'symbolic-poly :vars '(x)) p-symbolic )))
71	(with-fixture sym-poly-context ()
72	(signals
73	(error "Number of variables does not equal dimension.")
74	(universal-equalp (change-class p 'symbolic-poly :vars '(x y)) p-symbolic ))))
75
76	;; The following example uses the Grobner basis obtained with Maxima
77	;; Grobner package
78	;;
79	;; poly_grobner([x-3u-3uv^2+u^3,y-3v-3u^2v+v^3,z-3u^2+3v^2],[u,v,x,y,z]);
80	;;
81	;; The Maxima output is placed in the string STR-1. The string STR-1
82	;; is parsed STRING->POLY to a polynomial list GB-1. Then we take GB-1 and apply
83	;; POLY->STRING to it. Then we feed the string STR-2 into Maxima as
84	;; input and format according to Maxima rules. The resulting string is
85	;; STR-3. We parse it with STRING->POLY to a polynomial list GB-2.
86	;; Obviously, we should have equality GB-1 and GB-2. This is the test.
87	;;
88	(def-fixture big-poly-list-context ()
89	(let* ((vars '(u v x y z))
90	(str-1 "[x-3uv^2+u^3-3u,y+v^3-3u^2v-3v,z+3v^2-3u^2,
91	(-uz)-3x+6uv^2+9u,(-vz)+y-2v^3-3v,z^2+6v^2z-9z-9vy+9u*x,
92	4uvz-3uy+3vx,2uz^2+6xz-18uz-9uvy+9v^2x,
93	(-8uz^3)-24xz^2+72uz^2-36v^2xz+27uy^2-27vxy,
94	z^3+18v^2z^2-18z^2-54vyz+54v^2z+81z+27y^2-27*x^2,
95	(-4z^4)+48z^3-108vyz^2+108z^2+135y^2z+324vyz+108x^2*z
96	-1296v^2z-1944z-243v^2y^2-648y^2+243v^2x^2+648*x^2,
97	8vz^3-9yz^2+72vz^2+54v^2yz-27yz-27vy^2+27v*x^2,
98	(-8vz^4)+12yz^3-96vz^3-216vz^2-135vy^2z+324yz-27vx^2z
99	+81y^3+81vy^2-81x^2y-81v*x^2,
100	(-64vz^6)+120yz^5-1152vz^5+288yz^4-5184vz^4-648vy^2*z^3
101	-216yz^3+6912vz^3+81y^3z^2-9720vy^2*z^2
102	-1539x^2yz^2+31104yz^2+62208vz^2+8505y^3*z
103	+46656vy^2z-8505x^2yz-93312yz+729vy^4-23328*y^3
104	-1458vx^2y^2-23328vy^2+23328x^2y+729v*x^4
105	+23328vx^2,
106	8z^6-72z^5+648vyz^4-648z^4-945y^2z^3+5184vyz^3-189x^2*z^3
107	+5832z^3+972y^2z^2+17496vyz^2-2430x^2z^2+8748vy^3*z
108	-19683y^2z+2187x^2z-5103y^4-4374vy^3+5832x^2*y^2
109	+4374vx^2y-729x^4,
110	8z^7-48z^6+648vyz^5-864z^5-945y^2z^4+5832vyz^4-189x^2*z^4
111	+3888z^4+81y^2z^3+17496vyz^3-2997x^2z^3+17496*z^3
112	+8748vy^3z^2-16767y^2z^2+17496vyz^2-5103x^2z^2
113	-5103y^4z+5832x^2y^2z-6561y^2z-729x^4z+6561x^2*z
114	-2187y^4+4374x^2y^2-2187x^4,
115	64z^9-10368z^7+1296y^2z^6-1296x^2z^6-34992y^2z^5-34992x^2z^5
116	+419904z^5+174960y^2z^4-174960x^2z^4-10935y^4*z^3
117	-56862x^2y^2z^3+314928y^2z^3-10935x^4z^3+314928x^2*z^3
118	+118098y^4z^2-118098x^4z^2+59049y^4z-118098x^2y^2*z
119	+59049x^4z+19683y^6-59049x^2y^4+59049x^4y^2-19683x^6]")
120	;; Parse STR-1 to polynomial list GB-1
121	(gb-1 (string->poly str-1 vars))
122	;; Format GB-1 as a string STR-2
123	(str-2 (poly->string gb-1))
124	;; Here STR-3 is a Maxima-postprocessed STR-2"
125	(str-3 "[X-3UV^2+U^3-3U,Y+V^3-3U^2V-3V,Z+3V^2-3U^2,
126	(-UZ)-3X+6UV^2+9U,(-VZ)+Y-2V^3-3V,Z^2+6V^2Z-9Z-9VY+9U*X,
127	4UVZ-3UY+3VX,2UZ^2+6XZ-18UZ-9UVY+9V^2X,
128	(-8UZ^3)-24XZ^2+72UZ^2-36V^2XZ+27UY^2-27VXY,
129	Z^3+18V^2Z^2-18Z^2-54VYZ+54V^2Z+81Z+27Y^2-27*X^2,
130	(-4Z^4)+48Z^3-108VYZ^2+108Z^2+135Y^2Z+324VYZ+108X^2*Z
131	-1296V^2Z-1944Z-243V^2Y^2-648Y^2+243V^2X^2+648*X^2,
132	8VZ^3-9YZ^2+72VZ^2+54V^2YZ-27YZ-27VY^2+27V*X^2,
133	(-8VZ^4)+12YZ^3-96VZ^3-216VZ^2-135VY^2Z+324YZ-27VX^2Z
134	+81Y^3+81VY^2-81X^2Y-81V*X^2,
135	(-64VZ^6)+120YZ^5-1152VZ^5+288YZ^4-5184VZ^4-648VY^2*Z^3
136	-216YZ^3+6912VZ^3+81Y^3Z^2-9720VY^2*Z^2
137	-1539X^2YZ^2+31104YZ^2+62208VZ^2+8505Y^3*Z
138	+46656VY^2Z-8505X^2YZ-93312YZ+729VY^4-23328*Y^3
139	-1458VX^2Y^2-23328VY^2+23328X^2Y+729V*X^4
140	+23328VX^2,
141	8Z^6-72Z^5+648VYZ^4-648Z^4-945Y^2Z^3+5184VYZ^3-189X^2*Z^3
142	+5832Z^3+972Y^2Z^2+17496VYZ^2-2430X^2Z^2+8748VY^3*Z
143	-19683Y^2Z+2187X^2Z-5103Y^4-4374VY^3+5832X^2*Y^2
144	+4374VX^2Y-729X^4,
145	8Z^7-48Z^6+648VYZ^5-864Z^5-945Y^2Z^4+5832VYZ^4-189X^2*Z^4
146	+3888Z^4+81Y^2Z^3+17496VYZ^3-2997X^2Z^3+17496*Z^3
147	+8748VY^3Z^2-16767Y^2Z^2+17496VYZ^2-5103X^2Z^2
148	-5103Y^4Z+5832X^2Y^2Z-6561Y^2Z-729X^4Z+6561X^2*Z
149	-2187Y^4+4374X^2Y^2-2187X^4,
150	64Z^9-10368Z^7+1296Y^2Z^6-1296X^2Z^6-34992Y^2Z^5-34992X^2Z^5
151	+419904Z^5+174960Y^2Z^4-174960X^2Z^4-10935Y^4*Z^3
152	-56862X^2Y^2Z^3+314928Y^2Z^3-10935X^4Z^3+314928X^2*Z^3
153	+118098Y^4Z^2-118098X^4Z^2+59049Y^4Z-118098X^2Y^2*Z
154	+59049X^4Z+19683Y^6-59049X^2Y^4+59049X^4Y^2-19683X^6]")
155	;; Finally, obtain a polynomial list GB-2 by parsing STR-3
156	(gb-2 (string->poly str-3 vars)))
157	;; Discart STR-2
158	(declare (ignore str-2))
159	(&body)))
160
161	(test big-poly-list
162	"Big polynomial list"
163	(with-fixture big-poly-list-context ()
164	(is (universal-equalp gb-1 gb-2))))
165
166
167	(run! 'symbolic-poly-suite)
168	(format t "All tests done!~%")
169
170

Note: See TracBrowser for help on using the repository browser.

Download in other formats: