Roman numbering (incerment)

sachindkini · 发表于 2022-7-6 10:41:07

Dear All
HOW TO CREATE IT
Roman numbering (incerment)
I
II
III
IV
V

MSasu · 发表于 2022-7-6 10:48:46

I suggest you to convert the number to a string and start processing from last digit to first one; increment the rule as you debase the digit.

David Bethel · 发表于 2022-7-6 10:52:33

(rem) is going to be your friend here:

copy

 [b][color=BLACK]([/color][/b]initget 7[b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]setq tint [b][color=FUCHSIA]([/color][/b]getint [color=#2f4f4f]"\nTest Number:   "[/color][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]setq ones [b][color=FUCHSIA]([/color][/b]cond [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]= [b][color=GREEN]([/color][/b]rem tint 5[b][color=GREEN])[/color][/b] 0[b][color=MAROON])[/color][/b]  [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b]                  [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]= [b][color=GREEN]([/color][/b]rem tint 5[b][color=GREEN])[/color][/b] 1[b][color=MAROON])[/color][/b]  [color=#2f4f4f]"I"[/color][b][color=NAVY])[/color][/b]                  [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]= [b][color=GREEN]([/color][/b]rem tint 5[b][color=GREEN])[/color][/b] 2[b][color=MAROON])[/color][/b]  [color=#2f4f4f]"II"[/color][b][color=NAVY])[/color][/b]                  [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]= [b][color=GREEN]([/color][/b]rem tint 5[b][color=GREEN])[/color][/b] 3[b][color=MAROON])[/color][/b]  [color=#2f4f4f]"III"[/color][b][color=NAVY])[/color][/b]                  [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]= [b][color=GREEN]([/color][/b]rem tint 5[b][color=GREEN])[/color][/b] 4[b][color=MAROON])[/color][/b]  [color=#2f4f4f]"IV"[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]setq fives [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]>= [b][color=MAROON]([/color][/b]rem tint 10[b][color=MAROON])[/color][/b] 5[b][color=NAVY])[/color][/b] [color=#2f4f4f]"V"[/color] [color=#2f4f4f]""[/color][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]princ [b][color=FUCHSIA]([/color][/b]strcat fives ones[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-David

gile · 发表于 2022-7-6 11:01:30

Hi,

This seems to from I to MMMCMXCIX (1 to 3999)

using examples:

(I+ "III") returns "IV"
(I+ "XV") returns "XVI"
(I+ "CXLIX") returns "CL"
(I+ "MMMCMXCIX") returns "MMMM"

copy

(defun I+ (n) (setq n (reverse (vl-string->list n))) (vl-list->string   (reverse     (cond   ((and (= 86 (car n)) (= 73 (cadr n))) (cons 86 (cddr n))); *IV -> *V   ((= 73 (caddr n))        ; *III    (if (= 86 (cadddr n))        ; *VIII      (cons 88 (cons 73 (cddddr n))) ; -> *IX      (cons 86 (cddr n))        ; -> *IV    )   )   ((and (= 88 (car n)) (= 73 (cadr n))) ; *IX    (if (= 88 (cadddr n))        ; *X-IX      (cond        ((= 76 (caddr n)) (cons 76 (cddddr n))) ; *XLIX -> *L        ((= 88 (nth 4 n))        ; *XXXIX         (if (= 76 (nth 5 n))    ; *LXXXIX       (cons 67 (cons 88 (cdddr (cdddr n)))) ; -> *XC       (cons 76 (cddddr n))    ; -> *XL         )        )        (T                ; *XCIX         (if (= 67 (nth 5 n))    ; *C-XCIX       (cond         ((= 68 (nth 4 n)) (cons 68 (cdddr (cdddr n)))); *CDXCIX -> _D         ((= 67 (nth 6 n))    ; *CCCXCIX          (if (= 68 (nth 7 n))    ; *DCCCXCIX            (cons 77 (cons 67 (cddddr (cddddr n)))) ; -> *CM            (cons 68 (cdddr (cdddr n))) ; -> *CD          )         )         (T (cons 77 (cdddr (cdddr n)))) ; -> *M       )       (cons 67 (cddddr n))        ; -> *C         )        )      )      (cons 88 (cddr n))        ; -> *X    )   )   (T (cons 73 n))     )   ) ))

David Bethel · 发表于 2022-7-6 11:04:28

I found this interesting:

http://www.novaroma.org/via_romana/numbers.html

I did finish it out to 4999:

copy

[b][color=BLACK]([/color][/b]defun c:romannmb [b][color=FUCHSIA]([/color][/b]/ tint ones fives tens fifty huns fvhun thos[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]initget 7[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq tint [b][color=NAVY]([/color][/b]getint [color=#2f4f4f]"\nTest Number [b][color=MAROON]([/color][/b] Less Than 4999 [b][color=MAROON])[/color][/b]:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq ones [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]rem tint 5[b][color=BLUE])[/color][/b] 0[b][color=GREEN])[/color][/b]  [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]rem tint 5[b][color=BLUE])[/color][/b] 1[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"I"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]rem tint 5[b][color=BLUE])[/color][/b] 2[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"II"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]rem tint 5[b][color=BLUE])[/color][/b] 3[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"III"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]rem tint 5[b][color=BLUE])[/color][/b] 4[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"IV"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq fives [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]>= [b][color=GREEN]([/color][/b]rem tint 10[b][color=GREEN])[/color][/b] 5[b][color=MAROON])[/color][/b] [color=#2f4f4f]"V"[/color] [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq tens [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 50[b][color=BLUE])[/color][/b] 40[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"XL"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 50[b][color=BLUE])[/color][/b] 30[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"XXX"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 50[b][color=BLUE])[/color][/b] 20[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"XX"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 50[b][color=BLUE])[/color][/b] 10[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"X"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]<  [b][color=BLUE]([/color][/b]rem tint 50[b][color=BLUE])[/color][/b] 10[b][color=GREEN])[/color][/b]  [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq fifty [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]>= [b][color=GREEN]([/color][/b]rem tint 100[b][color=GREEN])[/color][/b] 50[b][color=MAROON])[/color][/b] [color=#2f4f4f]"L"[/color] [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq huns [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 500[b][color=BLUE])[/color][/b] 400[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"CD"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 500[b][color=BLUE])[/color][/b] 300[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"CCC"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 500[b][color=BLUE])[/color][/b] 200[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"CC"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 500[b][color=BLUE])[/color][/b] 100[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"C"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]<  [b][color=BLUE]([/color][/b]rem tint 500[b][color=BLUE])[/color][/b] 100[b][color=GREEN])[/color][/b]  [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq fvhun [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]>= [b][color=GREEN]([/color][/b]rem tint 1000[b][color=GREEN])[/color][/b] 500[b][color=MAROON])[/color][/b] [color=#2f4f4f]"D"[/color] [color=#2f4f4f]""[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]setq thos [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 5000[b][color=BLUE])[/color][/b] 4000[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"MMMM"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 5000[b][color=BLUE])[/color][/b] 3000[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"MMM"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 5000[b][color=BLUE])[/color][/b] 2000[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"MM"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]>= [b][color=BLUE]([/color][/b]rem tint 5000[b][color=BLUE])[/color][/b] 1000[b][color=GREEN])[/color][/b]  [color=#2f4f4f]"M"[/color][b][color=MAROON])[/color][/b]                  [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]<  [b][color=BLUE]([/color][/b]rem tint 5000[b][color=BLUE])[/color][/b] 1000[b][color=GREEN])[/color][/b]  [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]princ [b][color=NAVY]([/color][/b]strcat thos fvhun huns fifty tens fives ones[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-David

gile · 发表于 2022-7-6 11:11:07

I said 3999 beacuse I didn't know how to write 4000 or 5000 with roman numbering.

But if MMMM or MMMMM are allowed for 4000 and 5000 and so on, the routine I posted doen't have limit...

gile · 发表于 2022-7-6 11:16:41

My way to convert arabic numbers to roman numbers and vice-versa

copy

(defun arabic2roman (n / m s) (setq s "") (mapcar '(lambda (a r)        (setq m (/ n a)          n (rem n a)        )        (repeat m (setq s (strcat s r)))      )     '(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)(defun roman2arabic (s / n) (setq n 0) (mapcar '(lambda (a r)        (while (= r (substr s 1 (strlen r)))          (setq n (+ n a)            s (substr s (1+ (strlen r)))          )        )      )     '(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") ) n)

sachindkini · 发表于 2022-7-6 11:20:20

dear sir
gile & david
very good lisp
thx for reply

sachindkini · 发表于 2022-7-6 11:25:24

dear sir
find lisp on net but error on this lisp

copy

(defun c:roman (/ stnum stst) (if (> (setq stnum (atoi (setq stst     (getstring       "\n Enter number between 1 (I) and 3999 (MMMCMXCIX): "     )     )      ) ) 0     )   (rn stnum)   (rnrev stst) ))(defun rnrev (st / sl st pout rn prt) (setq sl   (strlen (setq st (strcase st)))pout 0rn   '(("MMM" . 3000)       ("MM" . 2000)       ("M" . 1000)       ("CM" . 900)       ("DCCC" . 800)       ("DCC" . 700)       ("DC" . 600)       ("D" . 500)       ("CD" . 400)       ("CCC" . 300)       ("CC" . 200)       ("C" . 100)       ("XC" . 90)       ("LXXX" . 80)       ("LXX" . 70)       ("LX" . 60)       ("L" . 50)       ("XL" . 40)       ("XXX" . 30)       ("XX" . 20)       ("X" . 10)       ("IX" . 9)       ("VIII" .        ("VII" . 7)       ("VI" . 6)       ("V" . 5)       ("IV" . 4)       ("III" . 3)       ("II" . 2)       ("I" . 1)      ) )     ; /setq (while (and (> sl 0)      (cdr (assoc (substr st 1 1) rn)) )    ; /and   (cond     ((setq prt (cdr (assoc (substr st 1 4) rn)))      (setq st (substr st 5))     )     ; /cond 1     ((setq prt (cdr (assoc (substr st 1 3) rn)))      (setq st (substr st 4))     )     ; /cond 2     ((setq prt (cdr (assoc (substr st 1 2) rn)))      (setq st (substr st 3))     )     ; /cond 3     ((setq prt (cdr (assoc (substr st 1 1) rn)))      (setq st (substr st 2))     )     ; /cond 4   )     ; /cond   (setq rn   (cutlst rn prt)  sl   (strlen st)  pout (+ pout prt)   )     ; /setq )     ; /while (if (= sl 0)   (princ pout)   (princ "Invalid format") )     ; /if (princ)    ; silent exit)     ; /defun(defun rn (gi / sl is gi numlst pout) (setq sl     (strlen (setq is (itoa gi)))numlst (list "1" "2" "3" "4" "5" "6" "7" "8" "9")pout   "" ) (if (and (> gi 0)   (< gi 4000)     )   (progn     (while (> sl 0)(cond  ((= sl 4)   (setq pout (strcat pout        (nth (vl-position (substr is 1 1) numlst)      (list "M" "MM" "MMM")        )       )  sl   3   )  )    ; /cond1  ((= sl 3)   (setq pout (strcat pout        (nth (vl-position (substr is 1 1) numlst)      (list "C" "CC"   "CCC"  "CD"     "D" "DC"   "DCC"  "DCCC"     "CM"    )        )       )  sl   2   )  )    ; /cond2  ((= sl 2)   (setq pout (strcat pout        (nth (vl-position (substr is 1 1) numlst)      (list "X" "XX"   "XXX"  "XL"     "L" "LX"   "LXX"  "LXXX"     "XC"    )        )       )  sl   1   )  )    ; /cond3  ((= sl 1)   (setq pout (strcat pout        (nth (vl-position (substr is 1 1) numlst)      (list "I" "II"   "III"  "IV"     "V" "VI"   "VII"  "VIII"     "IX"    )        )       )  sl   0   )  )    ; /cond4)    ; /cond(setq is (substr is 2))     )     ; /while     (princ pout)   )     ; /progn   (princ "Number Invalid")  ; else )     ; /if (princ))     ; /defun(defun cutlst (lst num / z) (cond   ((> num 900)    (setq num 1000)   )     ; /cond 1   ((> num 90)    (setq num 100)   )     ; /cond 2   ((> num 9)    (setq num 10)   ) )     ; /cond 3 (setq lst (vl-remove-if      '(lambda (z) (>= (cdr z) num))      lst    ) )     ; /setq)     ; /defun

Lee Mac · 发表于 2022-7-6 11:32:04

Nice code Gile

[编程交流] Roman numbering (incerment)

发表回复

精选推荐