Topic: < Challenge > Integers into words / Ordinal Numbers into words

[pBe]

(Int2Words 1234)
 "One Thousand Two Hundred Thirty-Four"

(Int2Words 34567)
"Thirty-Four Thousand Five Hundred Sixty-Seven"

AND

(Ord2Words 17)
"Seventeenth"

(Ord2Words 345)
"Three Hundred Forty-Fifth"

[irneb]

Perhaps something like the int->word or int->wordth functions in the attached?

Wanted to link to my online version, though for some reason SourceForge seems to have an issue:
http://sourceforge.net/p/caddons/code/67/tree/Libraries/Math.LSP

[pBe]

Perhaps something like the int->word or int->wordth functions in the attached?
....

Rats!! you already have one, i'll post my attempt later.

Cheers Irné


EDIT:

Code - Auto/Visual Lisp: [Select]

1. (defun Int2Words (num /  _set a b c d e f i p place lst v)
2.   (defun _zerop (l) (zerop (apply '+ l)))
3.   (Defun _set (w f / f)
4.     (if   (setq zero (_zerop w))
5.       (setq f f)
6.       (progn
7.    (while (setq d (car w))
8.      (if (= (length w) 2)
9.        (setq f
10.           (if
11.             (> (setq g (read (apply 'strcat (mapcar 'itoa w)))) 19)
12.              (strcat f (nth d b) (nth (cadr w) a))
13.              (strcat f (nth g a))
14.              )
15.         w nil
16.         )
17.        (setq f (strcat f
18.              (nth d a)
19.              (if   (or zero (= d 0))
20.                ""
21.                (nth (1- (length w)) place)
22.                )
23.              )
24.         )
25.        )
26.      (setq w (cdr w))
27.      )
28.    )
29.       )
30.     f
31.     )
32.  
33.  
34.   (Setq   a     '(""         " One"       " Two"     " Three"
35.       " Four"         " Five"       " Six"     " Seven"
36.       " Eight"      " Nine"       " Ten"     " Eleven"
37.       " Twelve"     " Thirteen"   "Fourteen"     " Fifteen"
38.       " Sixteen"    " Seventeen"  " Eightteen"  " Nineteen"
39.       )
40.    b     '(""        " Ten"     " Twenty"    " Thirty"
41.       " Forty"     " Fifty"     " Sixty"     " Seventy"
42.       " Eighty"    " Ninety"
43.       )
44.    place '("" "" " Hundred" " Thousand" " Million"   " Billion"
45.       " Trillion")
46.    )
47.   (setq   f   ""
48.    lst nil
49.    v   (mapcar '(lambda (x) (- x 48)) (vl-string->list (rtos num 2 0)))
50.    i   (length v)
51.    )
52.   (while (>= i 3)
53.     (setq lst (cons (list
54.             (nth (- i 3) v)
55.             (nth (- i 2) v)
56.             (nth (1- i) v)
57.             )
58.           lst
59.           )
60.      i   (- i 3)
61.      )
62.     )
63.   (setq   lst
64.     (if (zerop i)
65.       lst
66.       (cons (if (= i 2)
67.          (list (car v) (cadr v))
68.          (list (car v))
69.          )
70.        lst
71.        )
72.       )
73.    )
74.   (foreach itm lst
75.     (setq f (_set itm f)  
76.      )
77.     (if   (> (length lst) 1)
78.       (setq f   (strcat   f
79.          (if (or (_zerop itm) (zerop (car itm)))
80.            ""
81.            (nth (1+ (length lst)) place)
82.            )
83.          )
84.        lst   (cdr lst)
85.        )
86.       )
87.     )
88. (if (eq f "") "zero" F)
89.   )
90.  

[pBe]

Odd

(INT->WORD 12345678901234)
"twelve thousand three hundred fourty five billion six hundred seventy eight million nine hundred one thousand two hundred thirty four"
(INT2WORDS 12345678901234)
"Twelve Trillion Three Hundred Forty Five Billion Six Hundred Seventy Eight Million Nine Hundred One Thousand Two Hundred Thirty Four"


(_COMMA (RTos 12345678901234 2 0))
"12,345,678,901,234"


"twelve trillion three hundred forty-five billion six hundred seventy-eight million nine hundred one thousand two hundred thirty-four"

[irneb]

Yeah! Mine is using the American "Short Scale" naming. Yours is actually using the Long Scale (more logical use though).

I just went with the most prevalent one throughout the world: http://en.wikipedia.org/wiki/Long_and_short_scales#Current_usage

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.

[pBe]

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.

For now I wouldn't go there either  , but i guess a play with wcmatch would do the trick taking into consideration typos and all.

[Lee Mac]

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 

[pBe]

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 

It 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 

[VovKa]

one from me
no thinking involved

Code: [Select]

(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  

[Lee Mac]

It 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 

Cheers pBe 
I have a mathematics degree...  

[pBe]

one from me
no thinking involved

Code: [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")

    You took the fun out of thinking/debugging/brain freeze/nose bleed.. hang on, come to think of  it.. nobody deserves to go through all that for a challenge ...


Carry on VovKa 

I have a mathematics degree...

Figured as much 


Cheers Lee

[Marc'Antonio Alessi]

This is my version, needs to be optimized, accepts only integers...
I wanted start from my function ALE_Int->Roman (see attached) but it was better if I left from zero.
(ALE_Int->Roman 3886) => "MMMDCCCLXXXVI"

Code: [Select]

(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
)

[pBe]

(ALE_Int->Roman 3886) => "MMMDCCCLXXXVI"

I like it 

Thank you for participating on the challenge Marc.

Cheers

[bchapman]

Modified Lee's to be partially in Klingon lol:

Code: [Select]

(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 

[Marc'Antonio Alessi]

Thank you for participating on the challenge Marc.

Thanks to you.

Here is my version:

Code: [Select]

(defun LM:int->words ( n / f1 f2 )  ...  )

Lee,

I was rewriting my version to accept reals:

Code: [Select]

(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
)
and 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"

[Lee Mac]

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"

Doubles can only hold about 16 significant figures of precision.

[Lee Mac]

Here is another for conversion to roman numerals (for integers < 4000):

Code: [Select]

(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")))
)

Code: [Select]

_$ (LM:int->roman 3886)
"MMMDCCCLXXXVI"

[Marc'Antonio Alessi]

Here is another for conversion to roman numerals (for integers < 4000):
...

Thanks. I see that recursion is your passion!
Cheers.

[Marc'Antonio Alessi]

Doubles can only hold about 16 significant figures of precision.

Grazie.   

[Lee Mac]

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 

[irneb]

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 

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!

[Marc'Antonio Alessi]

> "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!

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)
I have downloaded your file, interesting, I put it in my collection of Lisp.

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?

My apologies for my english.

; Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
; Elapsed milliseconds / relative speed for 32768 iteration(s):
;    (ALE_INT->ROMAN 3886).....1123 / 2.35 <fastest>
;    (LM:INT->ROMAN 3886)......2637 / 1    <slowest>

[irneb]

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.

Same principle as you can see a C++ programmer declaring & initializing local variables needlessly in a functional program. That's also quite prevalent in the express tools. It doesn't mean they don't know how to use functional programming, it's more a case of they know imperative a lot better and are used to variable declaration & initialization at the start of the function (which is generally a good idea in languages like C++).

That code of mine is also written more imperatively centric, since then I've learnt to embrace the functional way a lot more. And in lisp it's not extremely bad to go with functional and/or recursive, it's sometimes not even less efficient than an imperative & iterative method. Not to mention, the time you waste in typing all the code and then debugging the inevitable typo is greatly reduced when using recursion / functional.

You and me are in the same boat about recursion though. I know how, it's just that the recursive solution isn't the first one I think of. My mind seems to be iterative - but perhaps since I come from a C++/Pascal/Delphi/Java background. What i do miss greatly in AutoLisp is Object Orientation - sometimes that can also reduce coding a lot and make your programs a lot more robust.

[Lee Mac]

If you prefer iteration:

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
)

[Marc'Antonio Alessi]

If you prefer iteration:

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
)

Meraviglioso.  :kewl: I think this is the best in elegance, concision and performance.  :kewl: :kewl: :kewl:

[Lee Mac]

Thank you Marc

[hmspe]

My guess on the original lisp routines from Autocad is that they were written quickly and that the authors stopped when the code was "good enough" rather than take the time to optimize the code.  Back when I was programming for a living (Turbo/Borland Pascal and Borland C++) I generally wanted to write everything twice.  I'd get the first pass code working and relatively bug free, then I would want to do a complete re-write to make the code faster and more elegant.  I seldom got the chance to re-write.  Most of the Express Tools code looks to me like the same thing happened there.

[irneb]

Wow ... 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! It's a perfect example of how to make use of mapcar in a way not strictly as intended. You could've done the same using foreach I guess, but then your list should look similar to your previous recursive method:

Code - Auto/Visual Lisp: [Select]

1. (defun Int->Roman  (num / result)
2.   (setq result "")
3.   (foreach code  '((1000 "M") (900 "CM") (500 "D") (400 "CD") (100 "C") (90 "XC")
4.                    (50 "L") (40 "XL") (10 "X") (9 "IX") (5 "V") (4 "IV") (1 "I"))
5.     (while (<= (car code) num) (setq result (strcat result (cadr code)) num (- num (car code)))))
6.   result)

I'm now thinking, what about other more convoluted numbering systems? Say the Babilonian system? A mix of decimal and senary written in binary (edit: make that ternary, since zero is represented by a space) forming a base 60 numbering system.

Code - Auto/Visual Lisp: [Select]

1. (defun Int->Babilonian (num / item result bases)
2.   (setq bases '((10 "T") (6 "<")) result "")
3.   (while (> num 0)
4.     (setq item "")
5.     (repeat (rem num (caar bases)) (setq item (strcat (cadar bases) item)))
6.     (repeat (- (caar bases) (strlen item)) (setq item (strcat " " item)))
7.     (setq result (strcat item result)
8.           num (fix (/ num (caar bases)))
9.           bases (reverse bases)))
10.   result)

[irneb]

Actually a more strictly "correct" algorithm for the Babilonian system would be:

Code - Auto/Visual Lisp: [Select]

1. (defun Int->Babilonian (num / digit item result bases)
2.   (setq bases '((10 "T") (6 "<")))
3.   (while (or (> num 0) (= (caar bases) 6))
4.     (setq item "")
5.     (repeat (rem num (caar bases)) (setq item (strcat (cadar bases) item)))
6.     (repeat (- (caar bases) (strlen item) 1) (setq item (strcat " " item)))
7.     (cond ((= (caar bases) 6) (setq result (cons (strcat item digit) result)))
8.           (t (setq digit item)))
9.     (setq num (fix (/ num (caar bases)))
10.           bases (reverse bases)))
11.   result)

Some "nifty" samples:

Code: [Select]

_$ (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":

Code: [Select]

_$ (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.cfm

And for what it's worth the 60 seconds, 60 minutes was also from them. You can thank the Egyptians for the 24 hours: http://www.abc.net.au/science/articles/2011/11/15/3364432.htm

[irneb]

As for the reverse of this challenge (words into numbers), I think I've got it:

Code - Auto/Visual Lisp: [Select]

1. (defun word->int  (words / fact)
2.   (setq fact 1)
3.   (apply '+
4.     (mapcar (function
5.               (lambda (sym / pos)
6.                 (cond ((setq pos (vl-position sym
7.                                    '(nil       One       Two       Three     Four      Five      Six       Seven
8.                                      Eight     Nine      Ten       Eleven    Twelve    Thirteen  Fourteen  Fifteen
9.                                      Sixteen   Seventeen Eighteen  Nineteen)))
10.                        (* fact pos))
11.                       ((setq pos (vl-position sym '(nil nil Twenty Thirty Fourty Fifty Sixty Seventy Eighty Ninety)))
12.                        (* fact pos 10))
13.                       ((= sym 'Hundred) (setq fact (* fact 100)) 0)
14.                       ((setq pos (assoc sym '((thousand 1000) (million 1e6) (billion 1e9) (trillion 1e12) (quadrillion 1e15) (quintillion 1e18))))
15.                        (setq fact (if (>= fact (cadr pos)) (* fact 1000) (cadr pos)))
16.                        0)
17.                       (t 0))))
18.             (reverse (read (strcat "(" words ")"))))))

[Lee Mac]

Wow ... 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!

Thanks Irne! 

I'm now thinking, what about other more convoluted numbering systems? Say the Babilonian system?

Nice idea! - here is my Babylonian function (assuming I have understood the system correctly):

Code: [Select]

(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)))
    )
)

Code: [Select]

_$ (LM:int->babylonian 424000)
"T <<<<<TTTTTTT <<<<TTTTTT <<<<"

[irneb]

Good one! Slight correction though:

Code - Auto/Visual Lisp: [Select]

1. (defun LM:int->babylonian ( n )
2.     (if (< n 60)
3.         (strcat (substr "<<<<<" 1 (/ n 10)) (substr "TTTTTTTTT" 1 (rem n 10)))
4.         (strcat (LM:int->babylonian  (/ n 60)) " " (LM:int->babylonian  (rem n 60)))
5.     )
6. )

But it works!

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.

[Lee Mac]

Good one! Slight correction though  < ... >

Oops! That'll teach me to modify code in the forum post box... code updated above.
Thanks Irne!

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.

True - I saw that point noted in the article but wanted to emulate the Babylonian system as they described. 

[irneb]

Actually again, your code's inspired me to get to a much more succinct algorithm (the iterative version of yours):

Code - Auto/Visual Lisp: [Select]

1. (defun IB:Int->Babylonian (num / result)
2.   (setq result "")
3.   (while (> num 0) (setq result (strcat " " (substr "<<<<<" 1 (fix (/ num 10)))
4.                                         (substr "TTTTTTTTT" 1 (fix (rem num 10))) result)
5.                          num (/ num 60)))
6.   (vl-string-left-trim " " result))

[Lee Mac]

Actually again, your code's inspired me to get to a much more succinct algorithm (the iterative version of yours)

Careful Irne...

Code: [Select]

_$ (IB:int->babylonian 60)
"T <<<<<"
_$ (IB:int->babylonian 70)
"T <<<<<"
_$ (IB:int->babylonian 80)
"T <<<<<"
I would write the iterative version as:

Code: [Select]

(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)
)

[Lee Mac]

How about Mayan 

Code: [Select]

(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)))
        )
    )
)

Code: [Select]

_$ (LM:int->mayan 5125)
"··|| ·||| |"
[ Read with head tipped sideways ]

[nobody]

lol

[pBe]

I applaud each and everyone who participated on this challenge. even the "klingon" inspired conversion.
Hats off to you guys
I learned a lot.


Thank you very much. 

[irneb]

Careful Irne...

Good catch! Thanks Lee.

[Lee Mac]

Careful Irne...

Good catch! Thanks Lee.

No worries! 

Another, for fun: Morse

Code: [Select]

(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:

Code: [Select]

(defun LM:int->morse ( n )
    (substr
        (apply 'strcat
            (mapcar '(lambda ( n ) (strcat " " (substr "-----·····-----" (- 59 n) 5)))
                (vl-string->list (itoa n))
            )
        )
        2
    )
)

Code: [Select]

_$ (LM:int->morse 2013)
"··--- ----- ·---- ···--"

[pBe]

Another, for fun: Morse

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

[Lee Mac]

Another, for fun: Morse

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

Though, unfortunately general alphabetical Morse code isn't as interesting, since it doesn't follow a pattern like the Morse code for the integers...

Here are two very quickly written conversion functions:

Code: [Select]

(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 "--··")
    )
)

Code: [Select]

_$ (words->morse "THE SWAMP")
"- ···· ·    ··· ·-- ·- -- ·--·"
_$ (morse->words (words->morse "THE SWAMP"))
"THE SWAMP"

[StykFacE]

I have a mathematics degree...  

THAT explains it!!  :kewl:

[Lee Mac]

I have a mathematics degree...  

THAT explains it!!  :kewl:

[Dilan]

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 

Hello!
And how to make words-> int?
From "twenty one thousand five hundred thirty seven" in 21537.
For example.

[PKENEWELL]

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

[Dilan]

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

Thank you very much for the two answers.

[Lee Mac]

Here are a pair of complementary functions:

Integer to Words

Code - Auto/Visual Lisp: [Select]

1. (defun LM:int->words ( n / f1 f2 )
2.     (defun f1 ( n )
3.         (if (< n 20)
4.             (nth (fix n) '("" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"))
5.             (strcat (nth (- (fix (/ n 10)) 2) '("twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety")) " " (f1 (rem n 10)))
6.         )
7.     )
8.     (defun f2 ( n l )
9.         (cond
10.             (   (null l) (f1 n))
11.             (   (< n (caar l)) (f2 n (cdr l)))
12.             (   (vl-string-right-trim " " (strcat (f2 (fix (/ n (caar l))) (cdr l)) " " (cadar l) " " (f2 (rem n (caar l)) (cdr l)))))
13.         )
14.     )
15.     (if (zerop n)
16.         "zero"
17.         (vl-string-right-trim " "
18.             (f2 n
19.                '(
20.                     (1e18 "quintillion")
21.                     (1e15 "quadrillion")
22.                     (1e12 "trillion")
23.                     (1e09 "billion")
24.                     (1e06 "million")
25.                     (1e03 "thousand")
26.                     (1e02 "hundred")
27.                 )
28.             )
29.         )
30.     )
31. )

Words to Integer

Code - Auto/Visual Lisp: [Select]

1. (defun LM:words->int ( s / f1 f2 )
2.     (defun f1 ( s l / p )
3.         (cond
4.             (   (null l)
5.                 (cond
6.                     (   (vl-position (vl-string-trim " " s)
7.                            '("" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" "ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen" "seventeen" "eighteen" "nineteen")
8.                         )
9.                     )
10.                     (   0   )
11.                 )
12.             )
13.             (   (not (setq p (vl-string-search (car l) s))) (f1 s (cdr l)))
14.             (   (+ (* 10 (- 10 (length l))) (f1 (substr s (+ 2 p (strlen (car l)))) (cdr l))))
15.         )
16.     )
17.     (defun f2 ( s l / p )
18.         (cond
19.             (   (null l) (f1 s '("twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety")))
20.             (   (not (setq p (vl-string-search (caar l) s))) (f2 s (cdr l)))
21.             (   (+ (* (f2 (substr s 1 p) (cdr l)) (cadar l)) (f2 (substr s (+ 2 p (strlen (caar l)))) (cdr l))))
22.         )
23.     )
24.     (if (= "zero" (strcase s t))
25.         0
26.         (f2 (strcase s t)
27.            '(
28.                 ("quintillion" 1e18)
29.                 ("quadrillion" 1e15)
30.                 ("trillion"    1e12)
31.                 ("billion"     1e09)
32.                 ("million"     1e06)
33.                 ("thousand"    1e03)
34.                 ("hundred"     1e02)
35.             )
36.         )
37.     )
38. )

Examples:

Code - Auto/Visual Lisp: [Select]

1. _$ (rtos (LM:words->int (LM:int->words 3)) 2 0)
2. "3"
3. _$ (rtos (LM:words->int (LM:int->words 31)) 2 0)
4. "31"
5. _$ (rtos (LM:words->int (LM:int->words 314)) 2 0)
6. "314"
7. _$ (rtos (LM:words->int (LM:int->words 3141)) 2 0)
8. "3141"
9. _$ (rtos (LM:words->int (LM:int->words 31415)) 2 0)
10. "31415"
11. _$ (rtos (LM:words->int (LM:int->words 314159)) 2 0)
12. "314159"
13. _$ (rtos (LM:words->int (LM:int->words 3141592)) 2 0)
14. "3141592"
15. _$ (rtos (LM:words->int (LM:int->words 31415926)) 2 0)
16. "31415926"
17. _$ (rtos (LM:words->int (LM:int->words 314159265)) 2 0)
18. "314159265"
19. _$ (rtos (LM:words->int (LM:int->words 3141592653)) 2 0)
20. "3141592653"
21. _$ (rtos (LM:words->int (LM:int->words 31415926535)) 2 0)
22. "31415926535"
23. _$ (rtos (LM:words->int (LM:int->words 314159265358)) 2 0)
24. "314159265358"
25. _$ (LM:int->words 314159265358)
26. "three hundred fourteen billion one hundred fifty nine million two hundred sixty five thousand three hundred fifty eight"
27. _$ (rtos (LM:words->int "three hundred fourteen billion one hundred fifty nine million two hundred sixty five thousand three hundred fifty eight") 2 0)
28. "314159265358"