path: root/plus-inc.lisp

;;;; plus function

(defvar *number-units-at-beginning* nil)

(defun base-number (number-list base-digit)
  "Given a number list and a digit, it says if the number list has all the base digits."
  (cond
    ((null number-list) t)
    ((eq (car number-list) base-digit) (base-number (cdr number-list) base-digit))
    (t nil)))

(defun may-reverse (number)
  "If units is placed on the end, reverse; else keep it."
  (if *number-units-at-beginning*
      number
      (reverse number)))

(defun explode-string (string)
  "Given a string, it returns a list of the symbol of this string"
  (loop for letter across string collect (intern (string letter))))

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

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

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

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

(defun next-list-number (numerals number-list &optional self-recursing)
  "Given a list of a numeral system and a list of a number, it returns a list of the next number."
  (cond
    ((eq (car number-list) (car (last numerals)))
     (cons (car numerals) (next-list-number numerals (cdr number-list) t)))
    ((and (not self-recursing) (null number-list)) (cons (car numerals) nil))
    ((or
      (null number-list)
      (and self-recursing (base-number number-list (car numerals))))
     (cons (cadr numerals) 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
    ((base-number number-list (car numerals)) nil)
    ((and
      (eq (car number-list) (car numerals))
      (eq (cadr number-list) (cadr numerals))
      (base-number (cddr number-list) (car numerals)))
     (cons (car (last numerals)) (cddr number-list)))
    ((eq (car number-list) (car numerals))
     (cons (car (last numerals)) (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
    ((base-number b (car numerals)) a)
    ((null b) a)
    ((or (> (length b) (length a)) (null a)) (plus-args-list numerals b 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 lists of numbers, it returns the list of it's sum according to it's units direction."
  (may-reverse (plus-args-list numerals (may-reverse a) (may-reverse b))))

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

(defun p (&rest args)
  "Given earthal numbers, it returns it's sum."
  (symbol-to-number (nth-value 0 (implode (reduce (lambda (a b) (plus '(|1| |2| |3| |4| |5|) a b)) (mapcar #'explode args))))))

(defun acc (fn a b)
  (cond
    ((equal b '(|1|)) a)
    (t (funcall fn a (acc fn a (previous-list-number (explode 12345) b))))))

(defun m (a b)
  (symbol-to-number (implode (acc (lambda (a b) (plus (explode 12345) a b)) (explode a) (explode b)))))

(defun po (a b)
  (acc #'m a b))

(defun z (a b)
  (acc #'po a b))

(defun tab (fn a)
  (dotimes (b 5)
    (format t "~d . ~d = ~d~%" (1+ b) a (funcall fn (1+ b) a))))