;;; -*- Mode: Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2 of the License, or ;;; (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Run tests using 5am unit testing framework ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; We assume that QuickLisp package manager is installed. ;; See : ;; https://www.quicklisp.org/beta/ ;; ;; The following is unnecessary after running: ;; * (ql:add-to-init-file) ;; at lisp prompt: ;;(load "~/quicklisp/setup") (ql:quickload :fiveam) (require :utils "utils") (require :ring "ring") (require :monom "monom") (require :term "term") (require :order "order") (require :polynomial "polynomial") (defpackage #:5am-poly (:use :cl :it.bese.fiveam :ring :monom :term :order :polynomial)) (in-package :5am-poly) (def-suite poly-suite :description "Monom package suite") (in-suite poly-suite) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; POLY class tests ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def-fixture poly-add-context () (let ((p (make-instance 'poly)) (q (make-instance 'poly :order nil)) (p+q (make-instance 'poly)) (p-q (make-instance 'poly)) (p-uminus (make-instance 'poly))) ;; Populate the polynomials; the lists of (exponents . coefficient) pairs ;; must be in increasing order in Q, but Q is unordered (:ORDER NIL) ;; so it will be automatically sorted. (dolist (x '( ((2) . 22) ((4) . 44) ((5) . 55) ((8) . 88) ((9) . 99) )) (insert-item p (make-instance 'term :exponents (car x) :coeff (cdr x)))) (dolist (x '( ((9) . 90) ((0) . 11) ((2) . 20) ((3) . 33) ((4) . -44) ((7) . 77) ((8) . 88) )) (insert-item q (make-instance 'term :exponents (car x) :coeff (cdr x)))) ;; P+Q (dolist (x '(((0) . 11) ((2) . 42) ((3) . 33) ((5) . 55) ((7) . 77) ((8) . 176) ((9) . 189) )) (insert-item p+q (make-instance 'term :exponents (car x) :coeff (cdr x)))) ;; P-Q (dolist (x '(((0) . -11) ((2) . 2) ((3) . -33) ((4) . 88) ((5) . 55) ((7) . -77) ((9) . 9))) (insert-item p-q (make-instance 'term :exponents (car x) :coeff (cdr x)))) ;; -P (dolist (x '( ((2) . -22) ((4) . -44) ((5) . -55) ((8) . -88) ((9) . -99) )) (insert-item p-uminus (make-instance 'term :exponents (car x) :coeff (cdr x)))) ;;(print p) (print q) (print p+q) (print p-q) (&body))) (test poly-add "Polynomial addition" (with-fixture poly-add-context () (is (r-equalp (add-to p q) p+q))) (with-fixture poly-add-context () (is (r-equalp (subtract-from p q) p-q))) (with-fixture poly-add-context () (is (r-equalp (unary-minus p) p-uminus))) ) (def-fixture poly-multiply-context () (let ((p (make-instance 'poly)) (q (make-instance 'poly :order nil)) (p*q (make-instance 'poly))) ;; Populate the polynomials; the lists of (exponents . coefficient) pairs ;; must be in increasing order in Q, but Q is unordered (:ORDER NIL) ;; so it will be automatically sorted. (dolist (x '( ((0) . 1) ((1) . 2) )) (insert-item p (make-instance 'term :exponents (car x) :coeff (cdr x)))) (dolist (x '( ((0) . 1) ((1) . 3) )) (insert-item q (make-instance 'term :exponents (car x) :coeff (cdr x)))) ;; P*Q (dolist (x '( ((0) . 1) ((1) . 5) ((2) . 6))) (insert-item p*q (make-instance 'term :exponents (car x) :coeff (cdr x)))) (&body))) (test poly-multiply "Polynomial multiplication" (with-fixture poly-multiply-context () (is (r-equalp (r* p q) p*q))) ) (test poly-standard-extension "Standard extension" (let* ((p (alist-poly '( ((0) . 1) ((1) . 2)))) (q (alist-poly '( ((0) . 1) ((2) . 3)))) (plist (list p q)) (p-ext (alist->poly '( ((1 0 0) . 1) ((1 0 1) . 2)))) (q-ext (alist->poly '( ((0 1 0) . 1) ((0 1 2) . 3)))) (plist-st-ext (p-ext q-ext))) (is (r-equalp (standard-extension plist) plist-st-ext)))) (run! 'poly-suite) (format t "All tests done!~%")