summary refs log tree commit diff stats
path: root/plus.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'plus.lisp')
-rw-r--r--plus.lisp94
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)))))