diff options
Diffstat (limited to 'plus.lisp')
-rw-r--r-- | plus.lisp | 94 |
1 files changed, 94 insertions, 0 deletions
diff --git a/plus.lisp b/plus.lisp new file mode 100644 index 0000000..03a347d --- /dev/null +++ b/plus.lisp @@ -0,0 +1,94 @@ +;;; plus one function + +(defvar *number-units-at-beginning* nil) + +(defun next-digit (numerals digit) + "Given a list of a numeral system and a digit, it returns the next digit." + (cond + ((eq (car (last numerals)) digit) (car numerals)) + ((not (eq (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-at-beginning* + number + (reverse number))) + +(defun explode-to-symbol (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-from-symbol (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 explode-string (string) + "Given a string of a number (which can have letters), it returns a list of strings of the number" + (loop for letter across string collect (string letter))) + +(defun implode-string (string) + "Given a list of strings of a number (which can have letters), it returns the string of this number" + (apply #'concatenate 'string string)) + +(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)) + ((eq (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)) + (eq (car number-list) + (if (eq (car numerals) '|0|) + (cadr numerals) + (car numerals)))) + nil) + ((and + (eq (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)) + (eq (car b) (if (eq (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-to-symbol a)) (may-reverse (explode-to-symbol b))))) + +(defun plus-string (numerals a b) + "Given a list of a numeral system and 2 strings, it returns the list of it's sum." + (may-reverse (plus-args-list numerals (may-reverse (explode-string a)) (may-reverse (explode-string b))))) + +(defun symbol-to-number (symbol) + "Given a symbol, returns it's number." + (nth-value 0 (parse-integer (symbol-name symbol)))) + +(defun plus-decimal (&rest args) + "Given decimal numbers, it returns the symbol it's sum." + (nth-value 0 (implode-from-symbol (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." + (symbol-to-number (nth-value 0 (implode-from-symbol (reduce (lambda (a b) (plus '(|1| |2| |3| |4| |5|) a b)) args))))) |