summary refs log blame commit diff stats
path: root/test-vartika-plus.lisp
blob: 1f45933a04b14a12472199bcd66d987fa84d08d7 (plain) (tree)





















































































































































                                                                                           
(load "test.lisp")
(load "plus-inc.lisp")

;;; basic functions

(deftest test-explode ()
  (check
    (equal (explode 1) '(|1|))
    (equal (explode 22211) '(|2| |2| |2| |1| |1|))))

(deftest test-explode-string ()
  (check
    (equal (explode-string "1") '(|1|))
    (equal (explode-string "22211") '(|2| |2| |2| |1| |1|))))

(deftest test-implode ()
  (check
    (eq (implode '(|1|)) '|1|)
    (eq (implode '(|2| |1| |3|)) '|213|)))

(deftest test-symbol-to-number ()
  (check
    (eql (symbol-to-number '|1|) 1)
    (eql (symbol-to-number '|231|) 231)))

(deftest test-base-number ()
  (check
    (base-number '(|1|) '|1|)
    (base-number '(|1| |1| |1|) '|1|)
    (base-number nil '|1|)
    (null (base-number '(|2|) '|1|))
    (null (base-number '(|1| |2| |1|) '|1|))
    (null (base-number '(|1| |2| |3|) '|1|))
    (null (base-number '(|2| |3| |4|) '|1|))))

(deftest test-may-reverse-units-first ()
  (setf *number-units-at-beginning* t)
  (check
    (equal (may-reverse '(|1|)) '(|1|))
    (equal (may-reverse '(|1| |1| |1|)) '(|1| |1| |1|))
    (equal (may-reverse '(|1| |2| |3|)) '(|1| |2| |3|))))

(deftest test-may-reverse-units-last ()
  (setf *number-units-at-beginning* nil)
  (check
    (equal (may-reverse '(|1|)) '(|1|))
    (equal (may-reverse '(|1| |1| |1|)) '(|1| |1| |1|))
    (equal (may-reverse '(|1| |2| |3|)) '(|3| |2| |1|))))


(deftest test-basic ()
  (combine-results
    (test-explode)
    (test-explode-string)
    (test-implode)
    (test-symbol-to-number)
    (test-base-number)
    (test-may-reverse-units-first)
    (test-may-reverse-units-last)))


;;; one
;;; earthal, infinite

(deftest test-earth-next-digit ()
  (let ((numerals '(|1| |2| |3| |4| |5|)))
    (check
      (eq (next-digit numerals '|1|) '|2|)
      (eq (next-digit numerals '|3|) '|4|)
      (eq (next-digit numerals '|5|) nil))))

(deftest test-earth-previous-digit ()
  (let ((numerals '(|1| |2| |3| |4| |5|)))
    (check
      (eq (previous-digit numerals '|1|) nil)
      (eq (previous-digit numerals '|3|) '|2|)
      (eq (previous-digit numerals '|5|) '|4|))))

(deftest test-earth-infinite-next-list-number ()
  (setf *number-units-at-beginning* t)
  (let ((numerals '(|1| |2| |3| |4| |5|)))
    (check
      (equal (next-list-number numerals nil) '(|1|))
      (equal (next-list-number numerals '(|1|)) '(|2|))
      (equal (next-list-number numerals '(|1| |3|)) '(|2| |3|))
      (equal (next-list-number numerals '(|5|)) '(|1| |2|))
      (equal (next-list-number numerals '(|1| |1|)) '(|2| |1|))
      (equal (next-list-number numerals '(|1| |3| |1| |1|)) '(|2| |3| |1| |1|))
      (equal (next-list-number numerals '(|5| |5|)) '(|1| |1| |2|))
      (equal (next-list-number numerals '(|1| |5| |5|)) '(|2| |5| |5|))
      (equal (next-list-number numerals '(|5| |5| |5|)) '(|1| |1| |1| |2|))
      (equal (next-list-number numerals '(|5| |5| |1|)) '(|1| |1| |2| |1|))
      (equal (next-list-number numerals '(|5| |5| |1| |1| |1|)) '(|1| |1| |2| |1| |1| |1|))
      (equal (next-list-number numerals '(|4| |5| |1| |1| |1|)) '(|5| |5| |1| |1| |1|))
      (equal (next-list-number numerals '(|4| |5| |1|)) '(|5| |5| |1|))
      (equal (next-list-number numerals '(|5| |5| |2| |1|)) '(|1| |1| |3| |1|)))))

(deftest test-earth-infinite-previous-list-number ()
  (setf *number-units-at-beginning* t)
  (let ((numerals '(|1| |2| |3| |4| |5|)))
    (check
      (equal (previous-list-number numerals '(|1|)) nil)
      (equal (previous-list-number numerals '(|1| |1|)) nil)
      (equal (previous-list-number numerals '(|1| |1| |1|)) nil)
      (equal (previous-list-number numerals '(|2|)) '(|1|))
      (equal (previous-list-number numerals '(|5|)) '(|4|))
      (equal (previous-list-number numerals '(|2| |3|)) '(|1| |3|))
      (equal (previous-list-number numerals '(|5| |5|)) '(|4| |5|))
      (equal (previous-list-number numerals '(|1| |5|)) '(|5| |4|))
      (equal (previous-list-number numerals '(|1| |2|)) '(|5|))
      (equal (previous-list-number numerals '(|2| |3| |1|)) '(|1| |3| |1|))
      (equal (previous-list-number numerals '(|2| |3| |1| |1|)) '(|1| |3| |1| |1|))
      (equal (previous-list-number numerals '(|1| |1| |2| |3|)) '(|5| |5| |1| |3|))
      (equal (previous-list-number numerals '(|5| |5| |1| |1| |1|)) '(|4| |5| |1| |1| |1|))
      (equal (previous-list-number numerals '(|1| |5| |1|)) '(|5| |4| |1|))
      (equal (previous-list-number numerals '(|1| |5| |1| |1|)) '(|5| |4| |1| |1|))
      (equal (previous-list-number numerals '(|1| |2| |1|)) '(|5| |1|))
      (equal (previous-list-number numerals '(|1| |2| |1| |1|)) '(|5| |1| |1|))
      (equal (previous-list-number numerals '(|2| |2| |1| |1|)) '(|1| |2| |1| |1|)))))

(deftest test-earth-plus-args-list ()
  (setf *number-units-at-beginning* t)
  (let ((numerals '(|1| |2| |3| |4| |5|)))
    (check
      (equal (plus-args-list numerals '(|1|) '(|1|)) '(|1|))
      (equal (plus-args-list numerals '(|2|) '(|1|)) '(|2|))
      (equal (plus-args-list numerals '(|1|) '(|2|)) '(|2|))
      (equal (plus-args-list numerals '(|2|) '(|2|)) '(|3|))
      (equal (plus-args-list numerals '(|5|) '(|2|)) '(|1| |2|))
      (equal (plus-args-list numerals '(|2|) '(|5|)) '(|1| |2|))
      (equal (plus-args-list numerals '(|1| |3|) '(|1|)) '(|1| |3|))
      (equal (plus-args-list numerals '(|2| |3|) '(|2|)) '(|3| |3|))
      (equal (plus-args-list numerals '(|2| |3|) '(|5|)) '(|1| |4|))
      (equal (plus-args-list numerals '(|2| |2|) '(|2| |2|)) '(|3| |3|))
      (equal (plus-args-list numerals '(|3| |2|) '(|5| |3|)) '(|2| |5|))
      (equal (plus-args-list numerals '(|3| |3|) '(|5| |3|)) '(|2| |1| |2|)))))

(deftest test-earth-inf ()
  (combine-results
    (test-earth-next-digit)
    (test-earth-previous-digit)
    (test-earth-infinite-next-list-number)
    (test-earth-infinite-previous-list-number)
    (test-earth-plus-args-list)))



(deftest test-earth ()
  (test-basic)
  (test-earth-inf))