sachindkini Posted April 13, 2010 Posted April 13, 2010 Dear All HOW TO CREATE IT Roman numbering (incerment) I II III IV V Quote
MSasu Posted April 13, 2010 Posted April 13, 2010 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. Quote
David Bethel Posted April 13, 2010 Posted April 13, 2010 (rem) is going to be your friend here: [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 Quote
gile Posted April 13, 2010 Posted April 13, 2010 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" (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)) ) ) ) ) Quote
David Bethel Posted April 13, 2010 Posted April 13, 2010 I found this interesting: http://www.novaroma.org/via_romana/numbers.html I did finish it out to 4999: [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 Quote
gile Posted April 13, 2010 Posted April 13, 2010 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... Quote
gile Posted April 13, 2010 Posted April 13, 2010 My way to convert arabic numbers to roman numbers and vice-versa (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 ) Quote
sachindkini Posted April 14, 2010 Author Posted April 14, 2010 I found this interesting: http://www.novaroma.org/via_romana/numbers.html I did finish it out to 4999: [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 My way to convert arabic numbers to roman numbers and vice-versa (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 ) dear sir gile & david very good lisp thx for reply Quote
sachindkini Posted April 14, 2010 Author Posted April 14, 2010 dear sir find lisp on net but error on this lisp (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 0 rn '(("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 Quote
gile Posted July 24, 2010 Posted July 24, 2010 (edited) Here's a better implementation of I+ (defun I+ (s / foo) (defun foo (l1 l2) (cond ((= (car l1) (cadddr l1) (car l2)) (if (cdr l2) (foo (cons (cadr l2) (cdddr l1)) l2) l1 ) ) ((and (= (cadr l1) (cadr l2)) (= (caddr l1) (car l2))) (cons (cadr l2) (cdddr l1)) ) ((and (= (cadr l1) (caddr l2)) (= (caddr l1) (car l2))) (foo (cons (caddr l2) (cdddr l1)) (cddr l2)) ) ((and (= (car l1) (caddr l1) (cadr l2)) (= (cadr l1) (car l2))) (cons (caddr l2) (cons (car l2) (cdddr l1))) ) (T l1) ) ) (vl-list->string (reverse (foo (cons 73 (reverse (vl-string->list s))) '(73 86 88 76 67 68 77)) ) ) ) Edited July 24, 2010 by gile Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.