-
Notifications
You must be signed in to change notification settings - Fork 0
/
n2str.lisp
194 lines (181 loc) · 10.7 KB
/
n2str.lisp
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
;;;;
;;;; Функції що вертають задане число прописом вказаною мовою
;;;; --------------------------------------------------------
;;;; (c) 2014 Eugene Yukhno
;; n2str999 - Функція, що вертає список строкових значеннь прописом
;; для чисел від 0 до 999 у реверсному напрямку
;; наприклад: 43 => '("три" "сорок")
;;
;; Спосіб використання:
;; (n2str999 n gender language digital-table gender-table)
;;
;; n - число що буде сконвертовано прописом
;; gender - у чоловічому чи жіночому роді має бути результата
;; наприклад: "одна" (гривня) чи "один" (долар)
;; "дві" (гривні) чи "два" (долари)
;; nil (за замовченням) - чоловічий рід
;; t - жіночий рід
;; language - ('ua | 'ru | 'en) -- вибір мови представлення результату
;; за замовченням українська мова ('ua)
;;
;; digital-table - можливо перевизначити слова, що відповідают
;; значенням чисел. За замовченням визначено три
;; мови (українська, російська, англійська). Якщо є
;; потреба додати інші мови, або перевизначити існуючі,
;; достатньо передати цей параметр у форматі списку
;; накшталт змінної digit (дв. код функції)
;; Наприклад: `(0 (fr "une" it "uno")
;; 1 (fr "due" it "duos")
;; ....
;; 900 (fr "???" it "???"))
;;
;; gender-table - також, якщо треба, можна перевизначити таблицю для
;; заміни слів у випадку чоловічого та жіночого роду
;; За замовчування налаштовано для укарїнської, російскої
;; та англійскої мови.
;; Приклад перевизначення:
;; `((1 2)
;; ((ua "одна" ru "одна")
;; (ua "дві" ru "две")))
(defun n2str999 (n &optional (gender nil)(l 'ua)(dig nil)(chgen nil))
(setf digit
`(0 (ua "нуль" ru "ноль" en "zero")
1 (ua "один" ru "один" en "one")
2 (ua "два" ru "два" en "two")
3 (ua "три" ru "три" en "three")
4 (ua "чотири" ru "четыри" en "four")
5 (ua "п'ять" ru "пять" en "five")
6 (ua "шість" ru "шесть" en "six")
7 (ua "сім" ru "семь" en "seven")
8 (ua "вісім" ru "восем" en "eight")
9 (ua "дев'ять" ru "девять" en "nine")
10 (ua "десять" ru "десять" en "ten")
11 (ua "одинадцять" ru "одинадцать" en "eleven")
12 (ua "дванадцять" ru "двенадцать" en "twelve")
13 (ua "тринадцять" ru "тринадцать" en "thirteen")
14 (ua "чотирнадцять" ru "четырнадцать" en "fourteen")
15 (ua "пя'тнадцять" ru "пятнадцать" en "fifteen")
16 (ua "шістнадцять" ru "шестнадцать" en "sixteen")
17 (ua "сімнадцять" ru "семнадцать" en "seventeen")
18 (ua "вісімнадцять" ru "восемнадцать" en "eighteen")
19 (ua "дев'ятнадцять" ru "девятнадцать" en "nineteen")
20 (ua "двадцять" ru "двадцать" en "tewnty")
30 (ua "тридцять" ru "тридцать" en "thirty")
40 (ua "сорок" ru "сорок" en "forty")
50 (ua "п'ятдесят" ru "пятьдесят" en "fifty")
60 (ua "шістдесят" ru "шестьдесят" en "sixty")
70 (ua "сімдесят" ru "семьдесят" en "seventy")
80 (ua "вісімдесят" ru "восемьдесят" en "eighty")
90 (ua "дев'яносто" ru "девяносто" en "ninety")
100 (ua "сто" ru "сто" en "one hundred")
200 (ua "двісті" ru "двести" en "two hundred")
300 (ua "триста" ru "триста" en "three hundred")
400 (ua "чотириста" ru "четиреста" en "four hundred")
500 (ua "п'ятсот" ru "пятьсот" en "five hundred")
600 (ua "шістсот" ru "шетьсот" en "six hundred")
700 (ua "сімсот" ru "семьсот" en "seven hundred")
800 (ua "вісімсот" ru "восемьсот" en "eight hundred")
900 (ua "дев'ятсот" ru "девятьсот" en "nine hundred")))
(if dig (setf digit dig))
(setf chgender '((1 2)((ua "одна" ru "одна" en "one")(ua "дві" ru "две" en "two"))))
(if chgen (setf chgender chgen))
(setf r nil)
(setf n (mod (abs n) 1000))
(if (/= n 0)
(progn
(if (> (- n (mod n 100)) 0)
(push (getf (getf digit (- n (mod n 100))) l) r))
(setf n (mod n 100))
(if (getf digit n)
(if (/= n 0)
(push (getf (getf digit n) l) r))
(progn
(push (getf (getf digit (- n (mod n 10))) l) r)
(push (getf (getf digit (mod n 10)) l) r))))
(push (getf (getf digit 0) l) r))
(cond (gender
(do ((cn (car chgender) (cdr cn))
(cc (cadr chgender) (cdr cc)))
((null cn))
(cond ((= (mod n 10) (car cn))
(pop r)
(push (getf (car cc) l) r))))))
r)
;; n2str - Функція, що вертає список строкових значеннь прописом
;; для чисел від 0 до 999*10^33 у правильному напрямку
;; наприклад: 43001 => '("сорок" "три" "тисячі" "один")
;;
;; Спосіб використання:
;; (n2str n gender language digital-table case-table)
;;
;; n - число що буде сконвертовано прописом
;; gender - у чоловічому чи жіночому роді має бути результата
;; наприклад: "одна" (гривня) чи "один" (долар)
;; "дві" (гривні) чи "два" (долари)
;; nil (за замовченням) - чоловічий рід
;; t - жіночий рід
;; language - ('ua | 'ru | 'en) -- вибір мови представлення результату
;; за замовченням українська мова ('ua)
;;
;; digital-table - можливо перевизначити слова, що відповідают
;; значенням порядків чисел (тисяцячі, мільйони и т.п.).
;; За замовченням визначено три мови (українська, російська,
;; англійська). Якщо є потреба додати інші мови, або перевизначити
;; існуючі, достатньо передати цей параметр у форматі списку
;; накшталт змінної da (дв. код функції)
;; Наприклад: `(ua ("дециліон" "нонильон" ...)
;; ru ("децилион" ...))
;;
;; case-table - також, якщо треба, можна перевизначити таблицю для
;; заміни слів у відповідності до падежів.
;; За замовчування налаштовано для укарїнської, російскої
;; та англійскої мови.
;; Приклад перевизначення:
;; `(ua (((1)(2 3 4)(5 6 7 8 9 0))(("а" "")("і" "и")("" "ів")))
;; ru (((1)(2 3 4)(5 6 7 8 9 0))(("а" "")("и" "а")("" "ов")))
;; en (((1 2 3 4 5 6 7 8 9 0))(("" "")))))
(defun n2str (n &optional (gender nil)(l 'ua)(d nil)(sf nil))
(setf rr nil)
(setf da
`(ua ("деціліон" "ноніліон" "октіліон"
"септіліон" "секстильйон" "квінтильйон"
"квадрильйон" "трильйон" "мільярд" "мільйон"
"тисяч")
ru ("дециллион" "нониллион" "октиллион"
"септиллион" "секстиллион" "квинтиллион"
"квадриллион" "триллион" "миллиард" "миллион"
"тысяч")
en ("decillion" "nonillion" "octillion"
"septillion" "sixtillion" "quintillion"
"quadrillion" "trillion" "billion" "million"
"thousand")))
(if d (setf da d))
(setf sfx
`(ua (((1)(2 3 4)(5 6 7 8 9 0))(("а" "")("і" "и")("" "ів")))
ru (((1)(2 3 4)(5 6 7 8 9 0))(("а" "")("и" "а")("" "ов")))
en (((1 2 3 4 5 6 7 8 9 0))(("" "")))))
(if sf (setf sfx sf))
(setf ad (getf da l))
(setf sfxl (getf sfx l))
(setf ss "")
(do ((dd 1000000000000000000000000000000000))
((= dd 1) r)
(if (> (- n (mod n dd)) 0)
(progn
(setf nn (/ (- n (mod n dd)) dd))
(setf rr (append (n2str999 nn (if (= dd 1000) t nil) l) rr))
(setf z "")
(do ((x (car sfxl) (cdr x))
(y (cadr sfxl) (cdr y)))
((null x))
(setf z (if (member (mod nn 10) (car x))
(if (= dd 1000)
(caar y)
(car (cdar y)))
z)))
(push (concatenate 'string ss (car ad) z) rr )))
(setf n (- n (- n (mod n dd))))
(setf dd (/ dd 1000))
(setf ad (cdr ad)))
(if (> (mod n 1000) 0) (setf rr (append (n2str999 (mod n 1000) gender l) rr)))
(reverse rr))