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

;;; -*-  Mode: Lisp -*- 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;                                                                              

;;;  Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>          

;;;                                                                              

;;;  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 (list p-ext q-ext)))

    (is (r-equalp (standard-extension plist) plist-st-ext))))



(test poly-standard-extension-1

  "Standard extension 1"

  (let* ((p (alist->poly '( ((0) . 1) ((1) . 2))))

         (q (alist->poly '( ((0) . 1) ((2) . 3))))

         (plist (list p q))

         (p-ext (alist->poly '( ((0 0 0) . -1) ((1 0 0) . 1) ((1 0 1) . 2))))

         (q-ext (alist->poly '( ((0 0 0) . -1) ((0 1 0) . 1) ((0 1 2) . 3))))

         (plist-st-ext (list p-ext q-ext)))

    (is (r-equalp (standard-extension-1 plist) plist-st-ext))))



(test poly-standard-sum

  "Standard sum"

  (let* ((p (alist->poly '( ((0) . 1) ((1) . 2))))

         (q (alist->poly '( ((0) . 1) ((2) . 3))))

         (plist (list p q))

         (std-sum (alist->poly '(((0 0 0) . -1) ((0 1 0) . 1) ((0 1 2) . 3)

                                 ((1 0 0) . 1) ((1 0 1) . 2)))))

    (is (r-equalp (standard-sum plist) std-sum))))



(run! 'poly-suite)

(format t "All tests done!~%")