326 lines
14 KiB
Common Lisp
326 lines
14 KiB
Common Lisp
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*
|
|
|
|
(in-package :kenzo-test)
|
|
|
|
(in-suite :kenzo)
|
|
|
|
(test f-cmpr
|
|
(is (equal (cat:f-cmpr 1 2) :less))
|
|
(is (equal (cat:f-cmpr 2 2) :equal))
|
|
(is (equal (cat:f-cmpr 3 2) :greater))
|
|
(is (equal (cat:f-cmpr 123 789) :less))
|
|
(is (equal (cat:maplexico #'cat:f-cmpr '(1 2 3) '(1 3)) :less))
|
|
(is (equal (cat:maplexico #'cat:f-cmpr '(1 2 3) '(1 1)) :greater))
|
|
(is (equal (cat:maplexico #'cat:f-cmpr '(1 1) '(1 1 0)) :less))
|
|
(is (equal (cat:maplexico #'cat:f-cmpr '(1 1 0) '(1 1)) :greater))
|
|
(is (equal (cat:maplexico #'cat:f-cmpr '(1 1) '(1 1)) :equal))
|
|
(is (equal (cat:maplexico #'cat:f-cmpr nil nil) :equal)))
|
|
|
|
(test l-cmpr
|
|
(is (equal (cat:l-cmpr nil nil) :equal))
|
|
(is (equal (cat:l-cmpr nil '(1)) :less))
|
|
(is (equal (cat:l-cmpr '(1) nil) :greater))
|
|
(is (equal (cat:l-cmpr '(a) '(a)) :equal))
|
|
(is (equal (cat:l-cmpr '(a) '(1)) :greater))
|
|
(is (equal (cat:l-cmpr '(1) '(a)) :less))
|
|
(is (equal (cat:l-cmpr '(1) '(1)) :equal))
|
|
(is (equal (cat:l-cmpr '(1 a) '(1 1)) :greater))
|
|
(is (equal (cat:l-cmpr '(1 a b) '(1 a)) :greater))
|
|
(is (equal (cat:l-cmpr '(1 a) '(1 a b)) :less)))
|
|
|
|
(test s-cmpr
|
|
(is (equal (cat:s-cmpr 'a 'b) :less))
|
|
(is (equal (cat:s-cmpr 'b 'b) :equal))
|
|
(is (equal (cat:s-cmpr 'c 'b) :greater))
|
|
(is (equal (cat:s-cmpr 'circulation 'circular) :greater))
|
|
(is (equal (cat:s-cmpr 'qwerty 'qwerty) :equal)))
|
|
|
|
(test cmbn
|
|
(let ((comb (cat:cmbn 2)))
|
|
(is (equal (cat:cmbn-degr comb) 2))
|
|
(is (equal (cat:cmbn-list comb) nil)))
|
|
|
|
(let ((comb (cat:cmbn 2 2 'a)))
|
|
(is (equal (cat:cmbn-degr comb) 2))
|
|
(is (equal (cat:cmbn-list comb) '((2 . a)))))
|
|
|
|
(let ((comb (cat:cmbn 2 'a)))
|
|
(is (equal (cat:cmbn-degr comb) 2))
|
|
(is (equal (cat:cmbn-list comb) '((a)))))
|
|
|
|
(let ((comb (cat:cmbn 2 2 'a -3 'b)))
|
|
(is (equal (cat:cmbn-degr comb) 2))
|
|
(is (equal (cat:cmbn-list comb) '((2 . a) (-3 . b)))))
|
|
|
|
(let ((comb (cat:term-cmbn 3 -5 'a)))
|
|
(is (equal (cat:cmbn-degr comb) 3))
|
|
(is (equal (cat:cmbn-list comb) '((-5 . a))))))
|
|
|
|
(test zero-cmbn
|
|
(let ((comb (cat:zero-cmbn 3)))
|
|
(is (equal (cat:cmbn-degr comb) 3))
|
|
(is (equal (cat:cmbn-list comb) nil)))
|
|
|
|
(let ((comb (cat:zero-intr-dffr (cat:cmbn 2))))
|
|
(is (equal (cat:cmbn-degr comb) 1))
|
|
(is (equal (cat:cmbn-list comb) nil)))
|
|
|
|
(is (null (cat:cmbn-non-zero-p (cat:cmbn 0))))
|
|
(is (cat:cmbn-non-zero-p (cat:cmbn 0 1 'a)))
|
|
(is (cat:cmbn-zero-p (cat:cmbn 0)))
|
|
(is (null (cat:cmbn-zero-p (cat:cmbn 0 1 'a)))))
|
|
|
|
(test cmbn-opps
|
|
(let* ((comb (cat:cmbn 0 1 'a -2 'b))
|
|
(comb1 (cat:cmbn-opps comb)))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((1 . a) (-2 . b))))
|
|
(is (equal (cat:cmbn-degr comb1) 0))
|
|
(is (equal (cat:cmbn-list comb1) '((-1 . a) (2 . b))))))
|
|
|
|
(test n-cmbn
|
|
(let* ((comb (cat:cmbn 2 3 'a))
|
|
(comb1 (cat:n-cmbn 1 comb))
|
|
(comb2 (cat:n-cmbn -1 comb))
|
|
(comb3 (cat:n-cmbn -3 comb)))
|
|
(is (eq comb comb1))
|
|
(is (equal (cat:cmbn-degr comb2) 2))
|
|
(is (equal (cat:cmbn-list comb2) '((-3 . a))))
|
|
(is (equal (cat:cmbn-degr comb3) 2))
|
|
(is (equal (cat:cmbn-list comb3) '((-9 . a))))))
|
|
|
|
(test 2cmbn-add
|
|
(signals simple-error (cat:2cmbn-add #'cat:s-cmpr (cat:cmbn 0) (cat:cmbn 1)))
|
|
|
|
(is (cat:cmbn-zero-p (cat:2cmbn-add #'cat:s-cmpr (cat:cmbn 0) (cat:cmbn 0))))
|
|
|
|
(let ((comb (cat:2cmbn-add #'cat:s-cmpr (cat:cmbn 0 1 'a) (cat:cmbn 0))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((1 . a)))))
|
|
|
|
(let ((comb (cat:2cmbn-add #'cat:s-cmpr (cat:cmbn 0 1 'a) (cat:cmbn 0 2 'a))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((3 . a)))))
|
|
|
|
(let ((comb (cat:2cmbn-add #'cat:s-cmpr (cat:cmbn 0 1 'a) (cat:cmbn 0 -1 'a))))
|
|
(is (cat:cmbn-zero-p comb)))
|
|
|
|
(let ((comb (cat:2cmbn-add #'cat:s-cmpr (cat:cmbn 0 1 'a) (cat:cmbn 0 2 'b))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((1 . a) (2 . b)))))
|
|
|
|
(let ((comb (cat:2cmbn-add #'cat:s-cmpr (cat:cmbn 0 1 'a -2 'b)
|
|
(cat:cmbn 0 2 'b))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((1 . a)))))
|
|
|
|
(let ((comb (cat:2cmbn-add #'cat:s-cmpr (cat:cmbn 0 2 'b)
|
|
(cat:cmbn 0 1 'a 3 'c))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((1 . a) (2 . b) (3 . c))))))
|
|
|
|
(test 2cmbn-sbtr
|
|
(signals simple-error (cat:2cmbn-sbtr #'cat:s-cmpr (cat:cmbn 0) (cat:cmbn 1)))
|
|
|
|
(is (cat:cmbn-zero-p (cat:2cmbn-sbtr #'cat:s-cmpr (cat:cmbn 0) (cat:cmbn 0))))
|
|
|
|
(let ((comb (cat:2cmbn-sbtr #'cat:s-cmpr (cat:cmbn 0) (cat:cmbn 0 1 'a))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((-1 . a)))))
|
|
|
|
(let ((comb (cat:2cmbn-sbtr #'cat:s-cmpr (cat:cmbn 0 2 'b) (cat:cmbn 0))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((2 . b)))))
|
|
|
|
(is (cat:cmbn-zero-p (cat:2cmbn-sbtr #'cat:s-cmpr (cat:cmbn 0 3 'b)
|
|
(cat:cmbn 0 3 'b))))
|
|
|
|
(let ((comb (cat:2cmbn-sbtr #'cat:s-cmpr (cat:cmbn 0 3 'b) (cat:cmbn 0 4 'b))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((-1 . b)))))
|
|
|
|
(let ((comb (cat:2cmbn-sbtr #'cat:s-cmpr
|
|
(cat:cmbn 0 1 'a 2 'c 2 'd 3 'g)
|
|
(cat:cmbn 0 1 'c -2 'd 4 'f -3 'g 4 'h))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((1 . a) (1 . c) (4 . d) (-4 . f) (6 . g)
|
|
(-4 . h)))))
|
|
|
|
(let ((comb (cat:2cmbn-sbtr #'cat:s-cmpr
|
|
(cat:cmbn 0 1 'c -2 'd 4 'f -3 'g 4 'h)
|
|
(cat:cmbn 0 1 'a 2 'c 2 'd 3 'g))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((-1 . a) (-1 . c) (-4 . d) (4 . f)
|
|
(-6 . g) (4 . h)))))
|
|
|
|
(let ((comb (cat:2cmbn-sbtr #'cat:s-cmpr
|
|
(cat:cmbn 0 1 'c -2 'd 4 'f -3 'g)
|
|
(cat:cmbn 0 1 'a 2 'c 2 'd 3 'g))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((-1 . a) (-1 . c) (-4 . d) (4 . f)
|
|
(-6 . g)))))
|
|
|
|
(let ((comb (cat:2cmbn-sbtr #'cat:s-cmpr (cat:cmbn 0 1 'b 2 'a)
|
|
(cat:cmbn 0 1 'a 1 'b))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((-1 . a) (2 . a)))))
|
|
|
|
(let ((comb (cat:2cmbn-sbtr #'cat:s-cmpr (cat:cmbn 0 1 'b 2 'c)
|
|
(cat:cmbn 0 1 'a 1 'b))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((-1 . a) (2 . c))))))
|
|
|
|
(test 2n-2cmbn
|
|
(signals simple-error (cat:2n-2cmbn #'cat:s-cmpr 3 (cat:cmbn 0)
|
|
4 (cat:cmbn 1)))
|
|
|
|
(is (cat:cmbn-zero-p (cat:2n-2cmbn #'cat:s-cmpr 3 (cat:cmbn 0)
|
|
4 (cat:cmbn 0))))
|
|
|
|
(let ((comb (cat:2n-2cmbn #'cat:s-cmpr 3 (cat:cmbn 0 1 'a) 4 (cat:cmbn 0))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((3 . a)))))
|
|
|
|
(let ((comb (cat:2n-2cmbn #'cat:s-cmpr
|
|
3 (cat:cmbn 0 1 'a 2 'b 3 'c)
|
|
1 (cat:cmbn 0 -3 'a 2 'b 4 'd))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((8 . b) (9 . c) (4 . d)))))
|
|
|
|
(let ((comb (cat:2n-2cmbn #'cat:s-cmpr
|
|
3 (cat:cmbn 0 -3 'a 2 'b 4 'd)
|
|
1 (cat:cmbn 0 1 'a 2 'b 3 'c))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((-8 . a) (8 . b) (3 . c) (12 . d)))))
|
|
|
|
(let ((comb (cat:2n-2cmbn #'cat:s-cmpr
|
|
1 (cat:cmbn 0 1 'a 2 'b 3 'c)
|
|
1 (cat:cmbn 0 -3 'a 2 'b 4 'd))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((-2 . a) (4 . b) (3 . c) (4 . d)))))
|
|
|
|
(let ((comb (cat:2n-2cmbn #'cat:s-cmpr
|
|
1 (cat:cmbn 0 -3 'a 2 'b 4 'd)
|
|
1 (cat:cmbn 0 1 'a 2 'b 3 'c))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((-2 . a) (4 . b) (3 . c) (4 . d)))))
|
|
|
|
(let ((comb (cat:2n-2cmbn #'cat:s-cmpr
|
|
1 (cat:cmbn 0 -3 'a 2 'b 4 'd)
|
|
3 (cat:cmbn 0 1 'a 2 'b 3 'c))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((8 . b) (9 . c) (4 . d))))))
|
|
|
|
(test cmbn-cmbn
|
|
(let* ((cons (cons 3 (cat:cmbn 0 4 'a)))
|
|
(comb (cat:cmbn-cmbn #'cat:s-cmpr
|
|
(make-list 5 :initial-element cons))))
|
|
(is (equal (cat:cmbn-degr comb) 0))
|
|
(is (equal (cat:cmbn-list comb) '((60 . a)))))
|
|
|
|
(let* ((cffc '(12 24 36 48 60 72 84 96 108 120))
|
|
(cons (cons 3 (cat:cmbn 0 4 'a))))
|
|
(dotimes (i 10)
|
|
(is (equal (nth i cffc)
|
|
(cat:cffc (first (cat:cmbn-list
|
|
(cat:cmbn-cmbn #'cat:s-cmpr
|
|
(make-list (1+ i)
|
|
:initial-element
|
|
cons))))))))))
|
|
|
|
(test nterm-add
|
|
(let ((comb (cat:nterm-add #'cat:s-cmpr 11)))
|
|
(is (equal (cat:cmbn-degr comb) 11))
|
|
(is (equal (cat:cmbn-list comb) nil)))
|
|
|
|
(let ((comb (cat:nterm-add #'cat:s-cmpr 11 (cat:term 1 'a))))
|
|
(is (equal (cat:cmbn-degr comb) 11))
|
|
(is (equal (cat:cmbn-list comb) '((1 . a)))))
|
|
|
|
(let ((comb (cat:nterm-add #'cat:s-cmpr 11 (cat:term 1 'a)
|
|
(cat:term 2 'b))))
|
|
(is (equal (cat:cmbn-degr comb) 11))
|
|
(is (equal (cat:cmbn-list comb) '((1 . a) (2 . b)))))
|
|
|
|
(let ((comb (cat:nterm-add #'cat:s-cmpr 11 (cat:term 1 'b)
|
|
(cat:term 2 'a) (cat:term 3 'aa)
|
|
(cat:term -2 'aa) (cat:term -2 'a)
|
|
(cat:term 4 'aa) (cat:term 5 'c))))
|
|
(is (equal (cat:cmbn-degr comb) 11))
|
|
(is (equal (cat:cmbn-list comb) '((5 . aa) (1 . b) (5 . c))))))
|
|
|
|
(test ncmbn-add
|
|
(let* ((c (cat:cmbn 3 4 'a))
|
|
(comb (cat:ncmbn-add #'cat:s-cmpr c c c c c)))
|
|
(is (equal (cat:cmbn-degr comb) 3))
|
|
(is (equal (cat:cmbn-list comb) '((20 . a))))))
|
|
|
|
(test dstr-add-term-to-cmbn
|
|
(let* ((c (cat:zero-cmbn 10))
|
|
(comb (cat:dstr-add-term-to-cmbn #'cat:s-cmpr 3 'f c)))
|
|
(is (eq comb c))
|
|
(is (equal (cat:cmbn-degr comb) 10))
|
|
(is (equal (cat:cmbn-list comb) '((3 . f))))
|
|
(setq comb (cat:dstr-add-term-to-cmbn #'cat:s-cmpr 3 'g c))
|
|
(is (eq comb c))
|
|
(is (equal (cat:cmbn-degr comb) 10))
|
|
(is (equal (cat:cmbn-list comb) '((3 . f) (3 . g))))
|
|
(setq comb (cat:dstr-add-term-to-cmbn #'cat:s-cmpr 3 'a c))
|
|
(is (eq comb c))
|
|
(is (equal (cat:cmbn-degr comb) 10))
|
|
(is (equal (cat:cmbn-list comb) '((3 . a) (3 . f) (3 . g))))
|
|
(setq comb (cat:dstr-add-term-to-cmbn #'cat:s-cmpr 3 'd c))
|
|
(is (eq comb c))
|
|
(is (equal (cat:cmbn-degr comb) 10))
|
|
(is (equal (cat:cmbn-list comb) '((3 . a) (3 . d) (3 . f) (3 . g))))
|
|
(setq comb (cat:dstr-add-term-to-cmbn #'cat:s-cmpr -3 'd c))
|
|
(is (eq comb c))
|
|
(is (equal (cat:cmbn-degr comb) 10))
|
|
(is (equal (cat:cmbn-list comb) '((3 . a) (3 . f) (3 . g))))
|
|
(setq comb (cat:dstr-add-term-to-cmbn #'cat:s-cmpr -2 'a c))
|
|
(is (eq comb c))
|
|
(is (equal (cat:cmbn-degr comb) 10))
|
|
(is (equal (cat:cmbn-list comb) '((1 . a) (3 . f) (3 . g))))
|
|
(setq comb (cat:dstr-add-term-to-cmbn #'cat:s-cmpr -1 'a c))
|
|
(is (eq comb c))
|
|
(is (equal (cat:cmbn-degr comb) 10))
|
|
(is (equal (cat:cmbn-list comb) '((3 . f) (3 . g))))
|
|
(setq comb (cat:dstr-add-term-to-cmbn #'cat:s-cmpr -3 'g c))
|
|
(is (eq comb c))
|
|
(is (equal (cat:cmbn-degr comb) 10))
|
|
(is (equal (cat:cmbn-list comb) '((3 . f))))
|
|
(setq comb (cat:dstr-add-term-to-cmbn #'cat:s-cmpr -3 'f c))
|
|
(is (eq comb c))
|
|
(is (equal (cat:cmbn-degr comb) 10))
|
|
(is (equal (cat:cmbn-list comb) nil))))
|
|
|
|
(test uvwz
|
|
(let* ((comb1 (cat:cmbn 1 1 'u 2 'v 3 'w 4 'z))
|
|
(comb1-list (cat:cmbn-list comb1))
|
|
(term3 (third comb1-list))
|
|
(mcomb1 (cat:cmbn-opps comb1))
|
|
(comb2 (cat:n-cmbn 10 comb1))
|
|
(comb12 (cat:2cmbn-add #'cat:s-cmpr comb1 comb2))
|
|
(comb112 (cat:2cmbn-sbtr #'cat:s-cmpr comb1 comb12))
|
|
(comb12n (cat:ncmbn-add #'cat:s-cmpr comb1 comb2 comb1 comb2
|
|
comb1 comb2 comb1 comb2 comb1 comb2)))
|
|
(is (cat:cmbn-non-zero-p comb1))
|
|
(is (equal comb1-list '((1 . u) (2 . v) (3 . w) (4 . z))))
|
|
(is (equal (cat:cffc term3) 3))
|
|
(is (equal (cat:gnrt term3) 'w))
|
|
(is (equal (cat:cmbn-degr comb1) (cat:cmbn-degr mcomb1)))
|
|
(is (equal (cat:cmbn-list mcomb1) '((-1 . u) (-2 . v)
|
|
(-3 . w) (-4 . z))))
|
|
(is (equal (cat:cmbn-degr comb1) (cat:cmbn-degr comb2)))
|
|
(is (equal (cat:cmbn-list comb2) '((10 . u) (20 . v)
|
|
(30 . w) (40 . z))))
|
|
(is (equal (cat:cmbn-degr comb1) (cat:cmbn-degr comb12)))
|
|
(is (equal (cat:cmbn-list comb12) '((11 . u) (22 . v)
|
|
(33 . w) (44 . z))))
|
|
(is (equal (cat:cmbn-degr comb1) (cat:cmbn-degr comb112)))
|
|
(is (equal (cat:cmbn-list comb112) '((-10 . u) (-20 . v)
|
|
(-30 . w) (-40 . z))))
|
|
(is (equal (cat:cmbn-degr comb1) (cat:cmbn-degr comb12n)))
|
|
(is (equal (cat:cmbn-list comb12n) '((55 . u) (110 . v)
|
|
(165 . w) (220 . z))))))
|