(in-package :kenzo-test)

(in-suite :kenzo)

(test disk-pasting-cmpr
      (let* ((c (cat:delta 3))
	     (cmpr (cat:disk-pasting-cmpr (cat:cmpr c) 'new)))
	(is (equal :equal (funcall cmpr 'new 'new)))
	(is (equal :less (funcall cmpr 'new 5)))
	(is (equal :greater (funcall cmpr 5 'new)))
	(is (equal :equal (funcall cmpr 5 5)))
	(is (equal :less (funcall cmpr 5 6)))
	(is (equal :greater (funcall cmpr 6 5)))))


(test disk-pasting-basis
      (cat:cat-init)
      (let* ((c (cat:delta 3))
	     (basis (cat:disk-pasting-basis (cat:basis c) 3 'new)))
	(funcall basis 3)
	(funcall basis 2)))


(test disk-pasting-intr-dffr
      (cat:cat-init)
      (let* ((c (cat:delta 3))
	     intr)
	(signals simple-error
		 (setf intr (cat:disk-pasting-intr-dffr
			     (cat:dffr c) 3 'new (cat:cmbn 2 1 7))))
	(setf intr (cat:disk-pasting-intr-dffr (cat:dffr c)
					       3 'new (cat:? c 3 15)))
	(funcall intr (cat:cmbn 2 1 7))
	(funcall intr (cat:cmbn 3))
	(funcall intr (cat:cmbn 3 1 15))
	(funcall intr (cat:cmbn 3 1 'new 1 15))
	(funcall intr (cat:cmbn 3 1 'new -1 15))
	(funcall intr (cat:cmbn 3 -1 'new 1 15))
	(funcall intr (cat:cmbn 3 -1 'new -1 15))))


(test chcm-disk-pasting
      (cat:cat-init)
      (let* ((c (cat:delta 3))
	     (s3 (cat:chcm-disk-pasting c 3 'new (cat:? c 3 15))))
	(cat:homology s3 0 5)))


(test disk-pasting-face
      (cat:cat-init)
      (let* ((c (cat:delta 3))
	     (face (cat:disk-pasting-face (cat:cmpr c) (cat:face c)
					  3 'new
					  (list 14 (cat:absm 0 13) 11 7))))
	(funcall face 0 2 7)
	(funcall face 0 3 15)
	(dotimes (i 4) (print (funcall face i 3 'new)))))


(test disk-pasting
      (cat:cat-init)
      (let* ((d2 (cat:delta 2))
	     (s2 (cat:disk-pasting d2 2 'new '(6 5 3)))
	     s2xs2)
	(cat:homology s2 0 4)
	(setf s2xs2 (cat:crts-prdc s2 s2))
	(cat:homology s2xs2 0 6)))


(test mrph-disk-pasting-intr
      (cat:cat-init)
      (let* ((m (cat:idnt-mrph (cat:delta 3)))
	     (intr (cat:mrph-disk-pasting-intr m (cat:cmpr (cat:delta 3))
					       3 'new (cat:cmbn 3 -1 15))))
	(funcall intr (cat:cmbn 2 3 7))
	(funcall intr (cat:cmbn 3))
	(funcall intr (cat:cmbn 3 4 15))
	(funcall intr (cat:cmbn 3 1 'new 1 15))
	(funcall intr (cat:cmbn 3 -1 'new 1 15))))


(test mrph-disk-pasting
      (cat:cat-init)
      (let* ((d (cat:delta 3))
	     (m (cat:idnt-mrph d))
	     (sorc (cat:chcm-disk-pasting d 3 'new (cat:? d 3 15)))
	     (nm (cat:mrph-disk-pasting m sorc sorc 3 'new
					(cat:cmbn 3 1 'new))))
	(cat:? nm (cat:cmbn 3 2 'new 3 15))))


(test disk-pasting1
      (cat:cat-init)
      (let* ((d (cat:delta 2))
	     (s2 (cat:disk-pasting d 2 'new '(6 5 3))))
	(cat:homology s2 0 4)))


(test hmeq-disk-pasting
      (cat:cat-init)
      (let* ((tcc (cat:build-chcm
		   :cmpr #'cat:s-cmpr
		   :basis #'(lambda (degr)
			      (case degr
				(0 (list 'a))
				(1 (list 'b))
				(otherwise nil)))
		   :intr-dffr #'(lambda (degr gnrt)
				  (if (= 1 degr)
				      (cat:cmbn 0 1 'a)
				      (cat:zero-cmbn (1- degr))))
		   :strt :gnrt
		   :orgn '(z-z)))
	     (bcc (cat:build-chcm
		   :cmpr #'cat:s-cmpr
		   :basis #'(lambda (degr) nil)
		   :intr-dffr #'(lambda (degr gnrt) (error "Impossible."))
		   :strt :gnrt
		   :orgn '(zero)))
	     (rh (cat:build-mrph
		  :sorc tcc :trgt tcc :degr +1
		  :intr #'(lambda (degr gnrt)
			    (if (zerop degr)
				(cat:cmbn 1 1 'b)
				(cat:zero-cmbn 2)))
		  :strt :gnrt
		  :orgn '(rh)))
	     (hmeq (cat:build-hmeq
		    :lrdct (cat:trivial-rdct tcc)
		    :rrdct (cat:build-rdct
			    :f (cat:zero-mrph tcc bcc 0)
			    :g (cat:zero-mrph bcc tcc 0)
			    :h rh
			    :orgn '(rrdct))))
	     (nhmeq (cat:hmeq-disk-pasting hmeq 1 'new (cat:cmbn 0 1 'a))))
	(cat:pre-check-rdct (cat:lrdct nhmeq))
	(setf cat:*tc* (cat:cmbn 0 1 'a))
	(setf cat:*bc* cat:*tc*)
	(check-rdct)
	(setf cat:*tc* (cat:cmbn 1 1 'new 10 'b))
	(setf cat:*bc* cat:*tc*)
	(check-rdct)
	(cat:pre-check-rdct (cat:rrdct nhmeq))
	(setf cat:*bc* (cat:zero-cmbn 0))
	(check-rdct)
	(setf cat:*tc* (cat:cmbn 0 1 'a))
	(check-rdct)))