| [3222] | 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 | 
 | 
|---|
| [3777] | 40 | ;; Unless NGROBNER system loaded by ASDF,
 | 
|---|
 | 41 | ;; load the dependencies directly
 | 
|---|
 | 42 | #-ngrobner
 | 
|---|
 | 43 | (progn
 | 
|---|
 | 44 |   (require :utils "utils")
 | 
|---|
 | 45 |   (require :copy "copy")
 | 
|---|
 | 46 |   (require :monom "monom")
 | 
|---|
 | 47 |   (require :polynomial "polynomial")
 | 
|---|
 | 48 |   (require :infix "infix")
 | 
|---|
 | 49 |   (require :symbolic-polynomial "symbolic-polynomial"))
 | 
|---|
| [3222] | 50 | 
 | 
|---|
| [3224] | 51 | (defpackage #:5am-symbolic-poly
 | 
|---|
| [3725] | 52 |   (:use :cl :it.bese.fiveam :monom :polynomial :infix :symbolic-polynomial))
 | 
|---|
| [3222] | 53 | 
 | 
|---|
| [3224] | 54 | (in-package :5am-symbolic-poly)
 | 
|---|
| [3222] | 55 | 
 | 
|---|
| [3225] | 56 | (def-suite symbolic-poly-suite 
 | 
|---|
 | 57 |     :description "Symbolic polynomial package suite")
 | 
|---|
| [3222] | 58 | 
 | 
|---|
| [3227] | 59 | (in-suite symbolic-poly-suite)
 | 
|---|
| [3222] | 60 | 
 | 
|---|
| [3391] | 61 | (test read-infix-form
 | 
|---|
 | 62 |   "Infix form reader"
 | 
|---|
 | 63 |   (is (equalp (with-input-from-string (s "X^2-Y^2+(-4/3)*U^2*W^3-5") (read-infix-form :stream s))
 | 
|---|
 | 64 |               '(+ (- (EXPT X 2) (EXPT Y 2)) (* (- (/ 4 3)) (EXPT U 2) (EXPT W 3)) (- 5))))
 | 
|---|
| [3888] | 65 |   (is (equalp (->infix (string->poly "X^2-Y^2+(-4/3)*U^2*W^3-5" '(x y u w)) '(x y u w))
 | 
|---|
| [3889] | 66 |               '(+ (* 1 (EXPT X 2)) (* -1 (EXPT Y 2)) (* -4/3 (EXPT U 2) (EXPT W 3)) (* -5)))))
 | 
|---|
| [3391] | 67 | 
 | 
|---|
| [3888] | 68 | 
 | 
|---|
| [3271] | 69 | (def-fixture sym-poly-context ()
 | 
|---|
| [3267] | 70 |   (let ((p (make-instance 'poly))
 | 
|---|
| [3271] | 71 |         (p-symbolic (make-instance 'symbolic-poly :vars '(x))))
 | 
|---|
| [3267] | 72 |     (dolist (x '( ((2) . 22)  ((4) . 44) ((5) . 55) ((8) . 88) ((9) . 99) ))
 | 
|---|
| [3730] | 73 |       (poly-insert-term p (make-instance 'term :exponents (car x) :coeff (cdr x)))
 | 
|---|
 | 74 |       (poly-insert-term p-symbolic (make-instance 'term :exponents (car x) :coeff (cdr x))))
 | 
|---|
| [3271] | 75 |     (&body)))
 | 
|---|
| [3222] | 76 | 
 | 
|---|
| [3271] | 77 | (test sym-poly
 | 
|---|
 | 78 |   "Symbolic polynomial"
 | 
|---|
 | 79 |   (with-fixture sym-poly-context ()
 | 
|---|
| [3726] | 80 |     (is (universal-equalp (change-class p 'symbolic-poly :vars '(x)) p-symbolic )))
 | 
|---|
| [3281] | 81 |   (with-fixture sym-poly-context ()
 | 
|---|
 | 82 |     (signals
 | 
|---|
 | 83 |         (error "Number of variables does not equal dimension.")
 | 
|---|
| [3726] | 84 |       (universal-equalp (change-class p 'symbolic-poly :vars '(x y)) p-symbolic ))))
 | 
|---|
| [3267] | 85 | 
 | 
|---|
| [3271] | 86 | 
 | 
|---|
| [3225] | 87 | (run! 'symbolic-poly-suite)
 | 
|---|
| [3222] | 88 | (format t "All tests done!~%")
 | 
|---|
 | 89 | 
 | 
|---|
 | 90 | 
 | 
|---|