cut-digits to base-number, and other improvements

1 files changed, 46 insertions, 40 deletions

diff --git a/plus-inc.lisp b/plus-inc.lisp
index d548bc6..1d37417 100644
--- a/plus-inc.lisp
+++ b/plus-inc.lisp
@@ -2,13 +2,12 @@
 
 (defvar *number-units-at-beginning* nil)
 
-(defun cut-digits (number-list-reversed)
-  "Given a reversed number list it cuts unecessary digits."
+(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 (cdr number-list-reversed)) number-list-reversed)
-    ((eq (car number-list-reversed) '|0|)
-     (cut-digits (cdr number-list-reversed)))
-    (t number-list-reversed)))
+    ((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."
@@ -16,12 +15,6 @@
       number
       (reverse number)))
 
-(defun may-reverse-and-cut (number)
-  "If units is placed on the end, reverse; else keep it. Also cuts unecessary digits."
-  (if *number-units-at-beginning*
-      (reverse (cut-digits (reverse number)))
-      (reverse (cut-digits 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))))
@@ -41,19 +34,20 @@
 (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))
+    ((null digit) (car numerals))
     ((not (eq (car numerals) digit)) (next-digit (cdr numerals) digit))
     (t (cadr numerals))))
 
-(defun next-list-number (numerals number-list)
+(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
-    ((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))))
+     (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)
@@ -63,38 +57,50 @@
 (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)
+    ((base-number number-list (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))))
+      (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
-    ((and
-      (null (cdr b))
-      (eq (car b) (if (eq (car numerals) '|0|)
-				(cadr numerals)
-				(car numerals))))
-     (next-list-number numerals a))
+    ((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 symbols, it returns the list of it's sum."
-  (may-reverse (plus-args-list numerals (may-reverse-and-cut a) (may-reverse-and-cut 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 (may-reverse (reduce (lambda (a b) (plus-args-list '(|0| |1| |2| |3| |4| |5| |6| |7| |8| |9|) a b)) (mapcar #'may-reverse-and-cut (mapcar #'explode args)))))))
+  (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 plus-earth (&rest args)
-  "Give earthal numbers, it returns it's sum."
-  (symbol-to-number (nth-value 0 (implode (may-reverse (reduce (lambda (a b) (plus-args-list '(|1| |2| |3| |4| |5|) a b)) (mapcar #'may-reverse-and-cut (mapcar #'explode args))))))))
+(defun tab (fn a)
+  (dotimes (b 5)
+    (format t "~d . ~d = ~d~%" (1+ b) a (funcall fn (1+ b) a))))