path: root/cl-math.lisp

;;; plus one function
;;; it is the (next-number) and the (next-number-reversed)

(defun next-digit (numerals digit)
  "Given a list of a numeral system and a digit, it returns the next digit."
  (cond
    ((eql (car (last numerals)) digit) (car numerals))
    ((not (eql (car numerals) digit)) (next-digit (cdr numerals) digit))
    (t (cadr numerals))))

(defun split-number-reversed (number)
  "Given a number, it returns a list of the number in reverse (because the decimal number system a reversed number system)."
  (cond
    ((zerop number) nil)
    (t (cons (mod number 10) (split-number-reversed (truncate number 10))))))

(defun next-list-number (numerals number-list-reversed)
  "Given a list of a numeral system and a list of a number, it returns a list of the next number."
  (cond
    ((null number-list-reversed)
     (cons (if (zerop (car numerals))
	       (cadr numerals)
	       (car numerals)) nil))
    ((eql (car number-list-reversed) (car (last numerals)))
     (cons (car numerals) (next-list-number numerals (cdr number-list-reversed))))
    (t (cons (next-digit numerals (car number-list-reversed)) (cdr number-list-reversed)))))

(defun next-number (numerals number)
  "Given a list of a numeral system and a number, it returns the list of the next number."
  (reverse (next-list-number numerals (split-number-reversed number))))

(defun next-number-reversed (numerals number)
  "Given a list of a numeral system and a number, it returns the reversed list of the next number (returns list, because the interpreter cuts zero's on the left)."
  (next-list-number numerals (reverse (split-number-reversed number))))

(defun previous-digit (numerals digit)
  "Given a list of a numeral system and a digit, it returns the previous digit."
  (next-digit (reverse numerals) digit))

(defun previous-list-number (numerals number-list-reversed)
  "Given a list of a numeral system and a list of a number, it returns a list of the previous number."
  (cond
    ((and
      (null (cdr number-list-reversed))
      (eql (car number-list-reversed)
	   (if (zerop (car numerals))
	       (cadr numerals)
	       (car numerals))))
     nil)
    ((and
      (eql (car number-list-reversed) (car numerals))
      (not (null (cdr number-list-reversed))))
     (cons (previous-digit numerals (car number-list-reversed)) (previous-list-number numerals (cdr number-list-reversed))))
    (t (cons (previous-digit numerals (car number-list-reversed)) (cdr number-list-reversed)))))

(defun previous-number (numerals number)
  "Given a list of a numeral system and a number, it returns the list of the previous number."
  (reverse (previous-list-number numerals (split-number-reversed number))))

(defun plus-args-list (numerals a-reversed b-reversed)
  "Given a list of a numeral system and two lists of numbers, it returns the list of it's sum."
  (cond
    ((and
      (null (cdr b-reversed))
      (eql (car b-reversed) (if (zerop (car numerals))
				(cadr numerals)
				(car numerals))))
     (next-list-number numerals a-reversed))
    (t (plus-args-list numerals (next-list-number numerals a-reversed) (previous-list-number numerals b-reversed)))))

(defun plus (numerals a b)
  "Given a list of a numeral system and two numbers, it returns the list of it's sum."
  (reverse (plus-args-list numerals (split-number-reversed a) (split-number-reversed b))))

;; (defun next-number (numerals number)
;;   "Given a list of a numeral system and a number, it returns the next number."
;;   (reduce (lambda (a b) (+ (* b 10) a))
;; 	  (next-list-number numerals (split-number-reversed number))
;; 	  :initial-value 0
;; 	  :from-end t))

(defun plus-number (numerals number1 number2)
  "Given a list of a numeral system and 2 numbers, it returns it's sum."
  (reduce (lambda (a b) (+ (* a 10) b))
	  (plus numerals number1 number2)
	  :initial-value 0))

(defun plus-decimal (a b)
  "Given 2 decimal numbers, it returns it's sum."
  (plus-number '(0 1 2 3 4 5 6 7 8 9) a b))

(defun plus-earth (a b)
  "Give 2 earthal numbers, it returns it's sum."
  (plus-number '(1 2 3 4 5) a b))