Jump to content

Roman Numeral Converter

Commandobill

By Commandobill
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Commandobill Proficient

Commandobill

Posted
Posted

Something I've been working on since yesterday thought i'd throw it out there and see what you guys think.

 

(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

Lee Mac Grand Master

Lee Mac

Posted
Posted

Nice one Bill - it works well. Not sure where you'd use it, but great as a novelty :)

Commandobill Proficient

Commandobill

Posted
  • Author
Posted
Not sure where you'd use it, but great as a novelty :)

 

Lol yeah i know. It started when i was trying to find out what a certain roman numeral meant. Then i found a converter and I decided to make my own. After many fails I finally got it.

  • 13 years later...
FROSTEE3510 Newbie

FROSTEE3510

Posted
Posted
On 6/10/2009 at 12:50 PM, Commandobill said:

 

Lol yeah i know. It started when i was trying to find out what a certain roman numeral meant. Then i found a converter and I decided to make my own. After many fails I finally got it.


Thanks Commando for sharing this code. I know it has been over a decade since sharing, but it just came in handy for a manual I am working on and intend to use the roman numerals as part of the sheet numbering - I have to come up with a custom function to handle it due to how this manual is built in ACAD.

As I tried the code out, I had an issue with a missing parentheses (it was a quick find) while erroring out on certain value types. The problematic value types are integers greater than nine and possessing zeros in the value, e.g. 108 and 1008. Below [and attached] is the patched version to rid it of that pesky bug.
  

;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
;;
;;	ROMAN NUMERAL CONVERTERS
;;
;;	ALL credit and source material belongs to the following source:
;;		Commandobill
;;		https://www.cadtutor.net/forum/topic/11354-roman-numeral-converter/
;;
;;	Alterations made from original author and source material are as follows:
;;		- Renamed vast majority most function and symbol names from original source due to OCD and personal practice to
;;		  digest source material.
;;		- Patched the -ROMANNUMERAL function (rn function in original source) to handle zeros when input integer is
;;		  greater than a value of nine (9) and contains zeros, e.g. 108 and 1008.
;;
;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %

(defun c:ROMANNUMERALCONVERTER
	(
		/
		intgen
		strgen
		)
	(if (> (setq intgen (atoi (setq strgen (getstring "\n Enter number between 1 (I) and 3999 (MMMCMXCIX): ")))) 0)
		(-ROMANNUMERAL intgen)
		(-ROMANNUMERALREVERSE strgen)
		)
	)

(defun -ROMANNUMERALREVERSE
	(
		strgen
		/
		lenstr
		output
		par
		romnum
		strgen
		)
	(setq
		lenstr (strlen (setq strgen (strcase strgen)))
		output 0
		romnum
		'(
			("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" . 8)
			("VII" . 7)
			("VI" . 6)
			("V" . 5)
			("IV" . 4)
			("III" . 3)
			("II" . 2)
			("I" . 1)
			)
		)
	(while
		(and
			(> lenstr 0)
			(cdr (assoc (substr strgen 1 1) romnum))
			)
		(cond
			(
				(setq par (cdr (assoc (substr strgen 1 4) romnum)))
				(setq strgen (substr strgen 5))
				)
			(
				(setq par (cdr (assoc (substr strgen 1 3) romnum)))
				(setq strgen (substr strgen 4))
				)
			(
				(setq par (cdr (assoc (substr strgen 1 2) romnum)))
				(setq strgen (substr strgen 3))
				)
			(
				(setq par (cdr (assoc (substr strgen 1 1) romnum)))
				(setq strgen (substr strgen 2))
				)
			)
		(setq
			romnum (-CUTLST romnum par)
			lenstr (strlen strgen)
			output (+ output par)
			)
		)
	(if (= lenstr 0)
		(princ output)
		(princ "Invalid format")
		)
	(princ)
	)

(defun -ROMANNUMERAL
	(
		intgen
		/
		intgen
		intstr
		numlst
		output
		lenstr
		)
	(setq
		lenstr (strlen (setq intstr (itoa intgen)))
		numlst (list "1" "2" "3" "4" "5" "6" "7" "8" "9")
		output ""
		)
	(if (and (> intgen 0) (< intgen 4000))
		(progn
			(while (> lenstr 0)
				(cond
					(
						(= lenstr 4)
						(setq
							output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "M" "MM" "MMM")))
							lenstr 3
							)
						)
					(
						(= lenstr 3)
						(setq
							output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM")))
							lenstr 2
							)
						)
					(
						(= lenstr 2)
						(setq
							output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC")))
							lenstr 1
							)
						)
					(
						(= lenstr 1)
						(setq
							output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX")))
							lenstr 0
							)
						)
					)
				(setq intstr (substr intstr 2))

				;; % % % % % % % % % % % % % % % % % % % % % % % % % % % %
				;; % % % % % % % % % % % % % % % % % % % % % % % % % % % %
				;;	START PATCH - alteration to original source material
				(if (= (substr intstr 1 1) "0")
					(while (and (> lenstr 0) (= (substr intstr 1 1) "0"))
						(setq
							intstr (substr intstr 2)
							lenstr (- lenstr 1)
							)
						)
					)
				;;	END PATCH - alteration to original source material
				;; % % % % % % % % % % % % % % % % % % % % % % % % % % % %
				;; % % % % % % % % % % % % % % % % % % % % % % % % % % % %
				)
			(princ output)
			)
		(princ "Number Invalid")
		)
	(princ)
	)

(defun -CUTLST
	(
		lst
		num
		/
		z
		)
	(cond
		(
			(> num 900)
			(setq num 1000)
			)
		(
			(> num 90)
			(setq num 100 )
			)
		(
			(> num 9)
			(setq num 10 )
			)
		)
	(setq
		lst
		(vl-remove-if
			'(lambda
				(z)
				(>= (cdr z) num)
				)
			lst
			)
		)
	)


Thanks again CommandoBill! This was an impressive approach to converting Roman Numerals - so simple that it's elegant.

marko_ribar Veteran

marko_ribar

Posted
Posted

I've took some of my free time to make it prettier (I mean code), and BTW. I don't understand last (vl-remove-if (function (lambda ( z ) (z) ...)) lst), so I removed that (z) ...

  

;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
;;
;;        ROMAN NUMERAL CONVERTERS
;;
;;        ALL credit and source material belongs to the following source:
;;                Commandobill
;;                https://www.cadtutor.net/forum/topic/11354-roman-numeral-converter/
;;
;;        Alterations made from original author and source material are as follows:
;;                - Renamed vast majority most function and symbol names from original source due to OCD and personal practice to
;;                  digest source material.
;;                - Patched the -ROMANNUMERAL function (rn function in original source) to handle zeros when input integer is
;;                  greater than a value of nine (9) and contains zeros, e.g. 108 and 1008.
;;
;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %
;; % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % %

(defun c:ROMANNUMERALCONVERTER ( / intgen strgen )
  (if (> (setq intgen (atoi (setq strgen (getstring "\n Enter number between 1 (I) and 3999 (MMMCMXCIX): ")))) 0)
    (-ROMANNUMERAL intgen)
    (-ROMANNUMERALREVERSE strgen)
  )
)

(defun -ROMANNUMERALREVERSE ( strgen / lenstr output par romnum )
  (setq
     lenstr (strlen (setq strgen (strcase strgen)))
     output 0
     romnum
   '(
      ("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" . 8)
      ("VII" . 7)
      ("VI" . 6)
      ("V" . 5)
      ("IV" . 4)
      ("III" . 3)
      ("II" . 2)
      ("I" . 1)
    )
  )
  (while (and
           (> lenstr 0)
           (cdr (assoc (substr strgen 1 1) romnum))
         )
         (cond
           (
             (setq par (cdr (assoc (substr strgen 1 4) romnum)))
             (setq strgen (substr strgen 5))
           )
           (
             (setq par (cdr (assoc (substr strgen 1 3) romnum)))
             (setq strgen (substr strgen 4))
           )
           (
             (setq par (cdr (assoc (substr strgen 1 2) romnum)))
             (setq strgen (substr strgen 3))
           )
           (
             (setq par (cdr (assoc (substr strgen 1 1) romnum)))
             (setq strgen (substr strgen 2))
           )
         )
         (setq
           romnum (-CUTLST romnum par)
           lenstr (strlen strgen)
           output (+ output par)
         )
  )
  (if (= lenstr 0)
    (princ output)
    (princ "Invalid format")
  )
  (princ)
)

(defun -ROMANNUMERAL ( intgen / intstr numlst output lenstr )
  (setq lenstr (strlen (setq intstr (itoa intgen)))
        numlst (list "1" "2" "3" "4" "5" "6" "7" "8" "9")
        output ""
  )
  (if (and (> intgen 0) (< intgen 4000))
    (progn
      (while (> lenstr 0)
        (cond
          (
            (= lenstr 4)
            (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "M" "MM" "MMM"))))
            (setq lenstr 3)
          )
          (
            (= lenstr 3)
            (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"))))
            (setq lenstr 2)
          )
          (
            (= lenstr 2)
            (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"))))
            (setq lenstr 1)
          )
          (
            (= lenstr 1)
            (setq output (strcat output (nth (vl-position (substr intstr 1 1) numlst) (list "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"))))
            (setq lenstr 0)
          )
        )
        (setq intstr (substr intstr 2))

        ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % %
        ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % %
        ;;        START PATCH - alteration to original source material
        (if (= (substr intstr 1 1) "0")
          (while (and (> lenstr 0) (= (substr intstr 1 1) "0"))
            (setq intstr (substr intstr 2)
                  lenstr (- lenstr 1)
            )
          )
        )
        ;;        END PATCH - alteration to original source material
        ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % %
        ;; % % % % % % % % % % % % % % % % % % % % % % % % % % % %
      )
      (princ output)
    )
    (princ "Number Invalid")
  )
  (princ)
)

(defun -CUTLST ( lst num )
  (cond
    (
      (> num 900)
      (setq num 1000)
    )
    (
      (> num 90)
      (setq num 100 )
    )
    (
      (> num 9)
      (setq num 10 )
    )
  )
  (setq lst
    (vl-remove-if
      (function (lambda ( z )
        (>= (cdr z) num)
      ))
      lst
    )
  )
)

 

  • Like 1

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...