;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; 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) (load "ngrobner.asd") (asdf:load-system :ngrobner) (defpackage #:ngrobner-tests (:use :cl :it.bese.fiveam :ngrobner :priority-queue :monomial :utils)) (in-package #:ngrobner-tests) (def-suite ngrobner-suite :description "New Groebner Package Suite") (in-suite ngrobner-suite) #+nil (test dummy-test "Makelist" (is (= (+ 2 2)) "2 plus 2 wasn't equal to 4 (using #'= to test equality)") (is (= 0 (+ -1 1))) (signals (error "Trying to add 4 to FOO didn't signal an error") (+ 'foo 4)) (is (= 0 (+ 1 1)) "this should have failed")) (test makelist-1 "makelist-1 test" (is (equal (makelist-1 (* 2 i) i 0 10) '(0 2 4 6 8 10 12 14 16 18 20))) (is (equal (makelist-1 (* 2 i) i 0 10 3) '(0 6 12 18)))) (test makelist "makelist" (is (equal (makelist (+ (* i i) (* j j)) (i 1 4) (j 1 i)) '(2 5 8 10 13 18 17 20 25 32))) (is (equal (makelist (list i j '---> (+ (* i i) (* j j))) (i 1 4) (j 1 i)) '((1 1 ---> 2) (2 1 ---> 5) (2 2 ---> 8) (3 1 ---> 10) (3 2 ---> 13) (3 3 ---> 18) (4 1 ---> 17) (4 2 ---> 20) (4 3 ---> 25) (4 4 ---> 32))))) (test monom "monom" (is (equalp (make-monom 3) #(0 0 0)) "Trivial monomial is a vector of 0's") (is (equalp (make-monom 3 :initial-contents '(1 2 3)) #(1 2 3)) "Monomial with powers 1,2,3")) (test order "order" (let ((p (make-monom 3 :initial-contents '(1 3 2))) (q (make-monom 3 :initial-contents '(1 2 3)))) (is-true (lex> p q)) (is-true (grlex> p q)) (is-true (revlex> p q)) (is-true (grevlex> p q)) (is-false (invlex> p q))) (let ((p (make-monom 3 :initial-contents '(1 2 3))) (q (make-monom 3 :initial-contents '(4 5 6)))) (is-false (elimination-order-1 p q)) (is-false (funcall (elimination-order 2) p q)))) (test term "term" (let* ((m1 (ngrobner:make-monom 3 :initial-contents '(1 2 3))) (m2 (ngrobner:make-monom 3 :initial-contents '(3 5 2))) (m3 (ngrobner::monom-mul m1 m2)) (t1 (ngrobner:make-term m1 7)) (t2 (ngrobner:make-term m2 9)) (t3 (ngrobner:make-term m3 (* 7 9)))) (is (equalp (ngrobner::term-mul ngrobner::*ring-of-integers* t1 t2) t3)))) (test coerce-to-infix "Conversion to infix form" (is (equal (ngrobner::coerce-to-infix :term (ngrobner::make-term-variable ngrobner::*ring-of-integers* 5 3) '(x y z w u v)) '(* 1 (EXPT X 0) (EXPT Y 0) (EXPT Z 0) (EXPT W 1) (EXPT U 0))))) (test priority-queue "Priority queue" (let ((q (priority-queue:make-priority-queue))) (priority-queue::priority-queue-insert q 7) (priority-queue::priority-queue-insert q 8) (is (= (priority-queue::priority-queue-size q) 3) "Note that there is always a dummy element in the queue.") (is (equalp (priority-queue::priority-queue-heap q) #(0 7 8))) (is (= (priority-queue::priority-queue-remove q) 7)) (is (= (priority-queue::priority-queue-remove q) 8)) (is-true (priority-queue::priority-queue-empty-p q)))) (run! 'ngrobner-suite) (format t "All tests done!~%")