path: root/cl-math.lisp

;;; plus one function

(defvar *number-units-beginning* nil)

(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 may-reverse (number)
  "If units is placed on the end, reverse; else keep it."
  (if *number-units-beginning*
	(reverse number)
	number))

(defun explode (number)
  "Given a number (which can have letters), it returns a list of the number"
  (may-reverse (loop for letter across (write-to-string number) collect (intern (string letter)))))

(defun implode (number)
  "Given a list of a number (which can have letters), it returns the number"
  (intern (apply #'concatenate 'string (mapcar #'symbol-name (may-reverse number)))))

(defun next-list-number (numerals number-list)
  "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)
     (cons (if (eq (car numerals) '|0|)
	       (cadr numerals)
	       (car numerals)) nil))
    ((eql (car number-list) (car (last numerals)))
     (cons (car numerals) (next-list-number numerals (cdr number-list))))
    (t (cons (next-digit numerals (car number-list)) (cdr number-list)))))

(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)
  "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))
      (eql (car number-list)
	   (if (eql (car numerals) '|0|)
	       (cadr numerals)
	       (car numerals))))
     nil)
    ((and
      (eql (car number-list) (car numerals))
      (not (null (cdr number-list))))
     (cons (previous-digit numerals (car number-list)) (previous-list-number numerals (cdr number-list))))
    (t (cons (previous-digit numerals (car number-list)) (cdr number-list)))))

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

(defun plus (numerals a b)
  "Given a list of a numeral system and 2 numbers, it returns the list of it's sum."
  (may-reverse (plus-args-list numerals (may-reverse (explode a)) (may-reverse (explode b)))))

(defun symbol-to-number (symbol)
  "Given a symbol, returns it's number."
  (values (parse-integer (symbol-name symbol))))

(defun plus-decimal (&rest args)
  "Given decimal numbers, it returns it's sum."
  (values (implode (reduce (lambda (a b) (plus '(|0| |1| |2| |3| |4| |5| |6| |7| |8| |9|) a b)) args))))

(defun plus-earth (&rest args)
  "Give earthal numbers, it returns it's sum."
  (values (implode (reduce (lambda (a b) (plus '(|1| |2| |3| |4| |5|) a b)) args))))