| [2637] | 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 | 
 | 
|---|
| [3056] | 40 | (require :utils "utils")
 | 
|---|
| [2637] | 41 | (require :ring "ring")
 | 
|---|
 | 42 | (require :monom "monom")
 | 
|---|
 | 43 | (require :term "term")
 | 
|---|
 | 44 | (require :order "order")
 | 
|---|
 | 45 | (require :polynomial "polynomial")
 | 
|---|
 | 46 | 
 | 
|---|
 | 47 | (defpackage #:5am-poly
 | 
|---|
 | 48 |   (:use :cl :it.bese.fiveam :ring :monom :term :order :polynomial))
 | 
|---|
 | 49 | 
 | 
|---|
 | 50 | (in-package :5am-poly)
 | 
|---|
 | 51 | 
 | 
|---|
| [2638] | 52 | (def-suite poly-suite 
 | 
|---|
| [2637] | 53 |     :description "Monom package suite")
 | 
|---|
 | 54 | 
 | 
|---|
| [2638] | 55 | (in-suite poly-suite)
 | 
|---|
| [2637] | 56 | 
 | 
|---|
 | 57 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 | 
|---|
 | 58 | ;;
 | 
|---|
 | 59 | ;;        POLY class tests
 | 
|---|
 | 60 | ;;
 | 
|---|
 | 61 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 | 
|---|
 | 62 | 
 | 
|---|
| [2932] | 63 | (def-fixture poly-add-context ()
 | 
|---|
| [2637] | 64 |   (let ((p (make-instance 'poly))
 | 
|---|
| [2677] | 65 |         (q (make-instance 'poly :order nil))
 | 
|---|
| [2648] | 66 |         (p+q (make-instance 'poly))
 | 
|---|
| [2688] | 67 |         (p-q (make-instance 'poly))
 | 
|---|
 | 68 |         (p-uminus (make-instance 'poly)))
 | 
|---|
| [2671] | 69 |     ;; Populate the polynomials; the lists of (exponents . coefficient) pairs
 | 
|---|
| [2678] | 70 |     ;; must be in increasing order in Q, but Q is unordered (:ORDER NIL)
 | 
|---|
 | 71 |     ;; so it will be automatically sorted.
 | 
|---|
| [2670] | 72 |     (dolist (x '( ((2) . 22)  ((4) . 44) ((5) . 55) ((8) . 88) ((9) . 99) ))
 | 
|---|
| [2673] | 73 |       (insert-item p (make-instance 'term :exponents (car x) :coeff (cdr x))))
 | 
|---|
| [2679] | 74 |     (dolist (x '( ((9) . 90) ((0) . 11)  ((2) . 20) ((3) . 33) ((4) . -44)  ((7) . 77) ((8) . 88) ))
 | 
|---|
| [2672] | 75 |       (insert-item q (make-instance 'term :exponents (car x) :coeff (cdr x))))
 | 
|---|
| [2737] | 76 |     ;; P+Q
 | 
|---|
| [2734] | 77 |     (dolist (x '(((0) . 11) ((2) . 42)  ((3) . 33) ((5) . 55) ((7) . 77) ((8) . 176) ((9) . 189) ))
 | 
|---|
| [2672] | 78 |       (insert-item p+q (make-instance 'term :exponents (car x) :coeff (cdr x))))
 | 
|---|
| [2737] | 79 |     ;; P-Q
 | 
|---|
| [2670] | 80 |     (dolist (x '(((0) . -11) ((2) . 2)  ((3) . -33) ((4) . 88) ((5) . 55) ((7) . -77) ((9) . 9)))
 | 
|---|
 | 81 |       (insert-item p-q (make-instance 'term :exponents (car x) :coeff (cdr x))))
 | 
|---|
| [2737] | 82 |     ;; -P
 | 
|---|
| [2687] | 83 |     (dolist (x '( ((2) . -22)  ((4) . -44) ((5) . -55) ((8) . -88) ((9) . -99) ))
 | 
|---|
| [2686] | 84 |       (insert-item p-uminus (make-instance 'term :exponents (car x) :coeff (cdr x))))
 | 
|---|
| [2664] | 85 |     ;;(print p) (print q) (print p+q) (print p-q)
 | 
|---|
| [2637] | 86 |     (&body)))
 | 
|---|
 | 87 | 
 | 
|---|
| [2931] | 88 | (test poly-add
 | 
|---|
| [2637] | 89 |   "Polynomial addition"
 | 
|---|
| [2933] | 90 |   (with-fixture poly-add-context () (is (r-equalp (add-to p q) p+q)))
 | 
|---|
 | 91 |   (with-fixture poly-add-context () (is (r-equalp (subtract-from p q) p-q)))
 | 
|---|
 | 92 |   (with-fixture poly-add-context () (is (r-equalp (unary-minus p) p-uminus)))
 | 
|---|
| [2652] | 93 |   )
 | 
|---|
| [2637] | 94 | 
 | 
|---|
| [2934] | 95 | (def-fixture poly-multiply-context ()
 | 
|---|
 | 96 |   (let ((p (make-instance 'poly))
 | 
|---|
 | 97 |         (q (make-instance 'poly :order nil))
 | 
|---|
 | 98 |         (p*q (make-instance 'poly)))
 | 
|---|
 | 99 |     ;; Populate the polynomials; the lists of (exponents . coefficient) pairs
 | 
|---|
 | 100 |     ;; must be in increasing order in Q, but Q is unordered (:ORDER NIL)
 | 
|---|
 | 101 |     ;; so it will be automatically sorted.
 | 
|---|
 | 102 |     (dolist (x '( ((0) . 1)  ((1) . 2) ))
 | 
|---|
 | 103 |       (insert-item p (make-instance 'term :exponents (car x) :coeff (cdr x))))
 | 
|---|
 | 104 |     (dolist (x '( ((0) . 1)  ((1) . 3) ))
 | 
|---|
| [2936] | 105 |       (insert-item q (make-instance 'term :exponents (car x) :coeff (cdr x))))
 | 
|---|
| [2934] | 106 |     ;; P*Q
 | 
|---|
 | 107 |     (dolist (x '( ((0) . 1) ((1) . 5) ((2) . 6)))
 | 
|---|
 | 108 |       (insert-item p*q (make-instance 'term :exponents (car x) :coeff (cdr x))))
 | 
|---|
 | 109 |     (&body)))
 | 
|---|
 | 110 | 
 | 
|---|
 | 111 | 
 | 
|---|
| [2935] | 112 | (test poly-multiply
 | 
|---|
 | 113 |   "Polynomial multiplication"
 | 
|---|
| [2937] | 114 |   (with-fixture poly-multiply-context () (is (r-equalp (r* p q) p*q)))
 | 
|---|
| [2935] | 115 |   )
 | 
|---|
 | 116 | 
 | 
|---|
 | 117 | 
 | 
|---|
| [3056] | 118 | 
 | 
|---|
| [2638] | 119 | (run! 'poly-suite)
 | 
|---|
| [2637] | 120 | (format t "All tests done!~%")
 | 
|---|
 | 121 | 
 | 
|---|
 | 122 | 
 | 
|---|