Perhaps something like the int->word or int->wordth functions in the attached?
....
Though one which is still making my head spin a bit (was working on it last night and just gave up for bed) is the reverse: Taking the string of words and reverting it into a number.
(defun LM:int->words ( n / f1 f2 )
(defun f1 ( n )
(if (< n 20)
(nth (fix n) '("" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"))
(strcat (nth (- (fix (/ n 10)) 2) '("twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety")) " " (f1 (rem n 10)))
)
)
(defun f2 ( n l )
(cond
( (null l) (f1 n))
( (< n (caar l)) (f2 n (cdr l)))
( (vl-string-right-trim " " (strcat (f2 (fix (/ n (caar l))) (cdr l)) " " (cadar l) " " (f2 (rem n (caar l)) (cdr l)))))
)
)
(if (zerop n)
"zero"
(vl-string-right-trim " "
(f2 n
'(
(1e18 "quintillion")
(1e15 "quadrillion")
(1e12 "trillion")
(1e09 "billion")
(1e06 "million")
(1e03 "thousand")
(1e02 "hundred")
)
)
)
)
)
Here is my version:Code: [Select](defun LM:int->words ( n / f1 f2 )
.......
(f2 n
'(
(1e18 "quintillion")
(1e15 "quadrillion")
(1e12 "trillion")
(1e09 "billion")
(1e06 "million")
(1e03 "thousand")
(1e02 "hundred")
)
)
)
)
)
Nice challenge pBe :)
(vl-load-com)
(defun vk_PostRemoteText (URL Data / objHTTP Result)
(if (setq objHTTP (vlax-create-object "Msxml2.ServerXMLHTTP"))
(progn
(setq Result (vl-catch-all-apply
(function
(lambda ()
(vlax-invoke-method
objHTTP "Open" "POST" URL :vlax-false)
(vlax-invoke-method
objHTTP
"setRequestHeader"
"Content-type"
"application/x-www-form-urlencoded"
)
(vlax-invoke objHTTP "Send" Data)
(vlax-get-property objHTTP "ResponseText")
)
)
)
)
(vlax-release-object objHTTP)
(if (not (vl-catch-all-error-p Result))
Result
)
)
)
)
(defun vk_test (Num Lng / Result)
(if (setq Result (vk_PostRemoteText
"http://www.tools4noobs.com/"
(strcat "action=ajax_number_spell_words&number="
(rtos Num 2 0)
"&type=0&locale="
Lng
)
)
)
(substr Result 19 (- (strlen Result) 24))
)
)
;;;(vk_test 662423123123442 "en_US")
;;;(vk_test 662423123123442 "en_GB")
;;;(vk_test 662423123123442 "it")
sorry to disappoint you guys, but no Ukrainian language support :( :-PIt took me a a while to understand your approach.
I see that you have an uncanny understanding of numbers LM, i wouldnt have thought of that.
Clever :)
one from me
no thinking involvedCode: [Select](vl-load-com)
(defun vk_PostRemoteText (URL Data / objHTTP Result)
..........
)
;;;(vk_test 662423123123442 "en_US")
;;;(vk_test 662423123123442 "en_GB")
;;;(vk_test 662423123123442 "it")
Figured as much 8)
I have a mathematics degree... :)
(defun ALE_IntsToWords (IntVal / IntStr 1119Ls 000Lst TmpNum TmpDec OutVal FlgThs StrXxx StrLst)
(setq
IntStr (itoa IntVal) OutVal ""
100Lst
'(((48 . "" )(49 . "One" )(50 . "Two" )(51 . "Three" )(52 . "Four" )
(53 . "Five" )(54 . "Six" )(55 . "Seven" )(56 . "Eight" )(57 . "Nine" ))
((48 . "" )(49 . "Ten" )(50 . "Twenty" )(51 . "Thirty")(52 . "Forty" )
(53 . "Fifty")(54 . "Sixty")(55 . "Seventy")(56 . "Eighty")(57 . "Ninety")
))
1119Ls
'((11 . "Eleven" )(12 . "Twelve" )(13 . "Thirteen" )(14 . "Fourteen")
(15 . "Fifteen" )(16 . "Sixteen")(17 . "Seventeen")(18 . "Eighteen")
(19 . "Nineteen")
)
000Lst '("Thousand" "Million" "Billion" "Trillion" ; "Quadrillion"
; "Quintillion" "Sextillion" "Septillion" "Octillion" "Nonillion"
; "Decillion" "Undecillion" "Deuodecillion" "Tredecillion"
; "Quattuordecillion" "Quindecillion" "Sexdecillion" "Septendecillion"
; "Octodecillion" "Novemdecillion" "Vigintillion"
)
StrLst (ALE_SplitThousand IntStr)
)
(While (setq StrXxx (car StrLst))
(setq StrLst (cdr StrLst) TmpNum (atoi StrXxx))
(if TmpDec
(progn
(and
(or (and FlgThs (not (zerop TmpNum))) (not StrLst))
(setq OutVal (strcat " " (car 000Lst) " " OutVal))
)
(setq 000Lst (cdr 000Lst))
)
)
(setq TmpDec (substr StrXxx 2) FlgThs T)
(cond
( (zerop TmpNum) (setq FlgThs nil) )
( (< 0 TmpNum 11) (setq OutVal (strcat (ALE_OneToHundred StrXxx 100Lst) OutVal)) )
( (> 20 TmpNum 10)
(setq OutVal (strcat (cdr (assoc TmpNum 1119Ls)) OutVal))
)
( (> 20 (atoi TmpDec) 10)
(setq OutVal (strcat (cdr (assoc (atoi TmpDec) 1119Ls)) OutVal))
)
( (> TmpNum 99) (setq OutVal (strcat (ALE_OneToHundred TmpDec 100Lst) OutVal)) )
( T (setq OutVal (strcat (ALE_OneToHundred StrXxx 100Lst) OutVal)) )
)
(and
(> TmpNum 99)
(setq OutVal
(strcat (cdr (assoc (ascii (substr StrXxx 1 1)) (car 100Lst))) " Hundred " OutVal)
)
)
)
(if (zerop IntVal) "Zero" (vl-string-right-trim " " OutVal))
)
(defun ALE_OneToHundred (IntStr DatLst / OutStr)
(foreach ForElm (reverse (vl-string->list IntStr))
(setq OutStr
(cond
( (eq 48 ForElm) OutStr )
( OutStr (strcat (cdr (assoc ForElm (car DatLst))) "-" OutStr) )
( T (cdr (assoc ForElm (car DatLst))) )
)
)
(setq DatLst (cdr DatLst))
)
(if OutStr OutStr "")
)
(defun ALE_SplitThousand (IntStr / TmpLen StrLng OutLst)
(setq StrLng (strlen IntStr) TmpLen StrLng)
(if (= (setq TmpLen (rem TmpLen 3)) 0)(setq TmpLen 3))
(while (<= TmpLen StrLng)
(setq
OutLst (cons (substr IntStr 1 TmpLen) OutLst)
IntStr (substr IntStr (1+ TmpLen))
StrLng (- StrLng TmpLen)
TmpLen 3
)
)
OutLst
)
(ALE_Int->Roman 3886) => "MMMDCCCLXXXVI"
(defun LM:int->words ( n / f1 f2 )
(defun f1 ( n )
(if (< n 20)
(nth (fix n) '("" "wa'" "cha'" "wej" "loS" "vagh" "jav" "Soch" "chorgh" "Hut"
"wa'maH" "wa’maH wa’" "wa’maH cha’" "wa’maH wej" "wa’maH loS" "wa’maH vagh" "wa’maH jav"
"wa’maH Soch" "wa’maH chorgh" "wa’maH Hut"))
(strcat (nth (- (fix (/ n 10)) 2) '("cha'maH" "wejmaH" "IosMah" "vaghmaH"
"javmaH" "SochmaH" "chorghmaH" "HutmaH")) " " (f1 (rem n 10)))
)
)
(defun f2 ( n l )
(cond
( (null l) (f1 n))
( (< n (caar l)) (f2 n (cdr l)))
( (vl-string-right-trim " " (strcat (f2 (fix (/ n (caar l))) (cdr l)) " "
(cadar l) " " (f2 (rem n (caar l)) (cdr l)))))
)
)
(if (zerop n)
"zero"
(vl-string-right-trim " "
(f2 n
'(
(1e18 " ")
(1e15 " ")
(1e12 " ")
(1e09 "wa'Sad uy")
(1e06 "uy")
(1e03 "wa’SaD")
(1e02 "wa’vatlh")
)
)
)
)
)
Here is my version:Code: [Select](defun LM:int->words ( n / f1 f2 )
(defun f1 ( n )
(if (< n 20)
(nth (fix n) '("" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"))
(strcat (nth (- (fix (/ n 10)) 2) '("twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety")) " " (f1 (rem n 10)))
)
)
(defun f2 ( n l )
(cond
( (null l) (f1 n))
( (< n (caar l)) (f2 n (cdr l)))
( (vl-string-right-trim " " (strcat (f2 (fix (/ n (caar l))) (cdr l)) " " (cadar l) " " (f2 (rem n (caar l)) (cdr l)))))
)
)
(if (zerop n)
"zero"
(vl-string-right-trim " "
(f2 n
'(
(1e18 "quintillion")
(1e15 "quadrillion")
(1e12 "trillion")
(1e09 "billion")
(1e06 "million")
(1e03 "thousand")
(1e02 "hundred")
)
)
)
)
)
Nice challenge pBe :-)
Thank you for participating on the challenge Marc.
Here is my version:Code: [Select](defun LM:int->words ( n / f1 f2 ) ... )
(defun ALE_SplitThousand (NumVal / TmpVal OutLst)
(while (not (zerop NumVal))
(if (zerop (setq TmpVal (fix (rem NumVal 1e03))))
(setq OutLst (cons "000" OutLst))
(setq OutLst (cons (itoa TmpVal) OutLst))
)
(setq NumVal (fix (/ NumVal 1e03)))
)
OutLst
)
Lee, I discovered that:
(LM:int->words 12300120123010211)
"twelve quadrillion three hundred trillion one hundred twenty billion
one hundred twenty three million ten thousand two hundred ten"
(defun LM:int->roman ( n / f )
(defun f ( n r )
(cond
((or (< n 1) (null r)) "")
((<= (caar r) n) (strcat (cadar r) (f (- n (caar r)) r)))
((f n (cdr r)))
)
)
(f n '((1000 "M") (900 "CM") (500 "D") (400 "CD") (100 "C") (90 "XC") (50 "L") (40 "XL") (10 "X") (9 "IX") (5 "V") (4 "IV") (1 "I")))
)
_$ (LM:int->roman 3886)
"MMMDCCCLXXXVI"
Here is another for conversion to roman numerals (for integers < 4000):Thanks. I see that recursion is your passion!
...
Doubles can only hold about 16 significant figures of precision.Grazie. :oops:
Here is another for conversion to roman numerals (for integers < 4000):Thanks. I see that recursion is your passion!
...
Cheers.
Exactly! Just look at the monster I had in one of my old addons - using only iteration (AInc:Num2Roman):Here is another for conversion to roman numerals (for integers < 4000):Thanks. I see that recursion is your passion!
...
Cheers.
Indeed, I love the elegance and concision of recursive solutions :-)
Recursion is elegant, concise but often is slower and cause problems with long lists of data. If I must do a very frequently-used function I prefer the classic form... maybe I will say this because my mind is not well suited to recursive thinking! (Lee is a monster)
> "Indeed, I love the elegance and concision of recursive solutions :-)"
Exactly! Just look at the monster I had in one of my old addons - using only iteration (AInc:Num2Roman):
http://sourceforge.net/p/caddons/code/67/tree/General/AutoIncr.LSP
Lee's is literally less than a 1/10th of the coding I needed. 10 lines instead of 130!
Question: I seem to have noticed that in the files "Lisp" original Autodesk (see also ExpressTools) does not makes heavy use of recursion. This is due to the lack of skill of the Autodesk programmers?I would really not know, but I doubt it's a case of not knowing recursion. It's probably more a case of knowing iteration better.
(defun LM:int->roman2 ( n / s )
(setq s "")
(mapcar (function (lambda ( d r ) (while (<= d n) (setq s (strcat s r) n (- n d)))))
'(1000 900 500 400 100 90 50 40 10 9 5 4 1)
'("M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX" "V" "IV" "I")
)
s
)
If you prefer iteration:Meraviglioso. :kewl: I think this is the best in elegance, concision and performance. :kewl: :kewl: :kewl:Code: [Select](defun LM:int->roman2 ( n / s )
(setq s "")
(mapcar (function (lambda ( d r ) (while (<= d n) (setq s (strcat s r) n (- n d)))))
'(1000 900 500 400 100 90 50 40 10 9 5 4 1)
'("M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX" "V" "IV" "I")
)
s
)
_$ (Int->Babilonian 62)
(" T" " TT")
_$ (Int->Babilonian 79)
(" T" " <TTTTTTTTT")
_$ (Int->Babilonian 19)
(" <TTTTTTTTT")
_$ (Int->Babilonian 11)
(" < T")
_$ (Int->Babilonian 600)
(" < " " ")
_$ (Int->Babilonian 3600)
(" T" " " " ")
_$ (Int->Babilonian 3599)
("<<<<<TTTTTTTTT" "<<<<<TTTTTTTTT")
BTW, this is apparently where the concept of 360 degrees in a circle comes from. Notice the "pattern":_$ (Int->Babilonian 30)
(" <<< ")
_$ (Int->Babilonian 60)
(" T" " ")
_$ (Int->Babilonian 90)
(" T" " <<< ")
_$ (Int->Babilonian 120)
(" TT" " ")
_$ (Int->Babilonian 150)
(" TT" " <<< ")
_$ (Int->Babilonian 180)
(" TTT" " ")
_$ (Int->Babilonian 210)
(" TTT" " <<< ")
_$ (Int->Babilonian 240)
(" TTTT" " ")
_$ (Int->Babilonian 270)
(" TTTT" " <<< ")
_$ (Int->Babilonian 300)
(" TTTTT" " ")
_$ (Int->Babilonian 330)
(" TTTTT" " <<< ")
_$ (Int->Babilonian 360)
(" TTTTTT" " ")
The "circle's" degrees would be the sidereal turns of the earth in a year. I.e. around 366, and the Babilonians then used the closest "round" number in their system = 360. since then we're stuck with it. http://www.physlink.com/education/askexperts/ae373.cfmWow ... once I saw your code I though: How simple! (read as compliment ;) ) I could've kicked myself for not getting to that half-functional / half-imperative but iterative method!
I'm now thinking, what about other more convoluted numbering systems? Say the Babilonian (http://www-history.mcs.st-and.ac.uk/HistTopics/Babylonian_numerals.html) system?
(defun LM:int->babylonian ( n )
(if (< n 60)
(strcat (substr "<<<<<" 1 (/ n 10)) (substr "TTTTTTTTT" 1 (rem n 10)))
(strcat (LM:int->babylonian (/ n 60)) " " (LM:int->babylonian (rem n 60)))
)
)
_$ (LM:int->babylonian 424000)
"T <<<<<TTTTTTT <<<<TTTTTT <<<<"
Good one! Slight correction though < ... >
I'm just in 2 minds about the use of spaces. It's a bit difficult to figure out if "T " (60) or "T " (3600) is the same thing.
Actually again, your code's inspired me to get to a much more succinct algorithm (the iterative version of yours)
_$ (IB:int->babylonian 60)
"T <<<<<"
_$ (IB:int->babylonian 70)
"T <<<<<"
_$ (IB:int->babylonian 80)
"T <<<<<"
(defun LM:int->babylonian-i ( n / d r )
(setq r "")
(while (< 0 n)
(setq d (rem n 60)
r (strcat " " (substr "<<<<<" 1 (/ d 10)) (substr "TTTTTTTTT" 1 (rem d 10)) r)
n (/ n 60)
)
)
(vl-string-left-trim " " r)
)
(defun LM:int->mayan ( n )
(if (zerop n) "0"
(if (< n 20)
(strcat (substr "····" 1 (rem n 5)) (substr "|||" 1 (/ n 5)))
(strcat (LM:int->mayan (/ n 20)) " " (LM:int->mayan (rem n 20)))
)
)
)
_$ (LM:int->mayan 5125)
"··|| ·||| |"
Careful Irne...Good catch! Thanks Lee.
No worries! :-)Careful Irne...Good catch! Thanks Lee.
(defun LM:int->morse ( n )
(if (< n 10)
(substr "-----·····-----" (- 11 n) 5)
(strcat (LM:int->morse (/ n 10)) " " (LM:int->morse (rem n 10)))
)
)
or:(defun LM:int->morse ( n )
(substr
(apply 'strcat
(mapcar '(lambda ( n ) (strcat " " (substr "-----·····-----" (- 59 n) 5)))
(vl-string->list (itoa n))
)
)
2
)
)
_$ (LM:int->morse 2013)
"··--- ----- ·---- ···--"
Another, for fun: Morse (http://en.wikipedia.org/wiki/Morse_code)
Another, for fun: Morse (http://en.wikipedia.org/wiki/Morse_code)
you should add "mind-reading" on your set of skills Lee, as that would have been my next challenge. <decrypting morse code>
Good times LM
(defun words->morse ( s )
(substr
(apply 'strcat
(mapcar
(function
(lambda ( a )
(if (setq a (cadr (assoc a morsetable)))
(strcat " " a)
""
)
)
)
(vl-string->list (strcase s))
)
)
2
)
)
(defun morse->words ( s / f )
(defun f ( s l / c p )
(cond
( (wcmatch s " *")
(cons 32 (f (substr s 4) l))
)
( (setq p (vl-string-position 32 s))
(if (setq c (cadr (assoc (substr s 1 p) l)))
(cons c (f (substr s (+ 2 p)) l))
(f (substr s (+ 2 p)) l)
)
)
( (setq c (cadr (assoc s l)))
(list c)
)
( "" )
)
)
(vl-list->string (f s (mapcar 'reverse morsetable)))
)
(setq morsetable
'(
(32 " ")
(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 "--··")
)
)
_$ (words->morse "THE SWAMP")
"- ···· · ··· ·-- ·- -- ·--·"
_$ (morse->words (words->morse "THE SWAMP"))
"THE SWAMP"
I have a mathematics degree... :-)THAT explains it!! :kewl:
:lol:I have a mathematics degree... :-)THAT explains it!! :kewl:
Here is my version:Hello!Code: [Select](defun LM:int->words ( n / f1 f2 )
(defun f1 ( n )
(if (< n 20)
(nth (fix n) '("" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"))
(strcat (nth (- (fix (/ n 10)) 2) '("twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety")) " " (f1 (rem n 10)))
)
)
(defun f2 ( n l )
(cond
( (null l) (f1 n))
( (< n (caar l)) (f2 n (cdr l)))
( (vl-string-right-trim " " (strcat (f2 (fix (/ n (caar l))) (cdr l)) " " (cadar l) " " (f2 (rem n (caar l)) (cdr l)))))
)
)
(if (zerop n)
"zero"
(vl-string-right-trim " "
(f2 n
'(
(1e18 "quintillion")
(1e15 "quadrillion")
(1e12 "trillion")
(1e09 "billion")
(1e06 "million")
(1e03 "thousand")
(1e02 "hundred")
)
)
)
)
)
Nice challenge pBe :-)
Hello!
And how to make words-> int?
From "twenty one thousand five hundred thirty seven" in 21537.
For example.
Thank you very much for the two answers.Hello!
And how to make words-> int?
From "twenty one thousand five hundred thirty seven" in 21537.
For example.
Already created in this topic: http://www.theswamp.org/index.php?topic=43830.msg491651#msg491651