add plus operation and low-level functions

1 files changed, 94 insertions, 0 deletions

diff --git a/numericx.lisp b/numericx.lisp
new file mode 100644
index 0000000..9efa61f
--- /dev/null
+++ b/numericx.lisp
@@ -0,0 +1,94 @@
+;;; 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
+      (eql (length b-reversed) 1)
+      (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))