1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
;;;; plus function
(defvar *number-units-at-beginning* 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
((eq (car (last numerals)) digit) (car numerals))
((not (eq (car numerals) digit)) (next-digit (cdr numerals) digit))
(t (cadr numerals))))
(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 lists of symbols, it returns the list of it's sum."
(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 (mapcar #'explode args)))))))
(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 (mapcar #'explode args))))))))
|