（autolisp递归算法）整数转罗马数字
本帖最后由 freedom_ice 于 2022-11-17 08:39 编辑刷算法，整数转为罗马数字，用递归方法。供讨论学习。
另求助，用正则表达式应该可以判断一个字符串是否是合法的罗马数字？
搜到如下匹配规则。待验证。
未经验证的罗马数字：
^+$
严格验证罗马数字：
^(?=)M*(C|D?C{0,3})(X|L?X{0,3})(I|V?I{ 0,3})$
灵活验证罗马数字：
^(?=)M*(C|D?C*)(X|L?X*)(I|V?I*)$
简单的罗马数字：
^(?=)M*D?C{0,4}L?X{0,4}V?I{0,4}$
罗马数字包含以下七种字符: I， V， X， L，C，D 和 M。
字符 数值
I 1
V 5
X 10
L 50
C 100
D 500
M 1000
例如， 罗马数字 2 写做 II ，即为两个并列的 1 。12 写做 XII ，即为 X + II 。 27 写做XXVII, 即为 XX + V + II 。
通常情况下，罗马数字中小的数字在大的数字的右边。但也存在特例，例如 4 不写做 IIII，而是 IV。数字 1 在数字 5 的左边，所表示的数等于大数 5 减小数 1 得到的数值 4 。同样地，数字 9 表示为 IX。这个特殊的规则只适用于以下六种情况：
I 可以放在 V (5) 和 X (10) 的左边，来表示 4 和 9。
X 可以放在 L (50) 和 C (100) 的左边，来表示 40 和 90。
C 可以放在 D (500) 和 M (1000) 的左边，来表示 400 和 900。
给定一个罗马数字，将其转换成整数。
;;;*****************************************************************************
;;;*****************************************************************************
;;;函数名: digit->roman ******************************************************
;;;功能: 4000以内的整数转罗马数字 ******************************************
;;;参数: num - 整数 ********************************************************
;;;返回值: 罗马数字字符串 ****************************************************
( defun digit->roman( num )
( setq roman "" )
(cond ( ( >= num 1000 )
( progn
( setq quotient ( / num 1000 )
remainders ( rem num 1000 ))
( repeat quotient
( setq roman ( strcat roman "M" ) )
)
( setq roman ( strcat roman ( romantodigit remainders ) ) )
)
)
( ( and ( > 1000 num ) ( >=num 900 ) )
( progn ( setq remainders ( rem num 900 ))
( setq roman ( strcat "CM" ( romantodigit remainders ) ) )
)
)
( ( and ( > 900 num ) ( >=num 500 ) )
( progn ( setq num ( - num 500 )
quotient ( / num 100 )
remainders ( rem num 100 ))
( repeat quotient
( setq roman ( strcat roman "C" ) )
)
( setq roman ( strcat "D" roman ( romantodigit remainders ) ) )
)
)
( ( and ( > 500 num ) ( >=num 400 ) )
( progn ( setq remainders ( rem num 100 ) )
( setq roman ( strcat "CD" ( romantodigit remainders ) ) )
)
)
( ( and ( > 400 num ) ( >=num 100 ) )
( progn ( setq quotient ( / num 100 )
remainders ( rem num 100 ))
( repeat quotient
( setq roman ( strcat roman "C" ) )
)
( setq roman ( strcat roman ( romantodigit remainders ) ) )
)
)
( ( and ( > 100 num ) ( >=num 90 ) )
( progn ( setq num ( - num 90 )
remainders ( rem num 10 ))
( setq roman ( strcat "XC" ( romantodigit remainders ) ) )
)
)
( ( and ( > 90 num ) ( >=num 50 ) )
( progn ( setq num ( - num 50 )
quotient ( / num 10 )
remainders ( rem num 10 ))
( repeat quotient
( setq roman ( strcat roman "X" ) )
)
( setq roman ( strcat "L" roman ( romantodigit remainders ) ) )
)
)
( ( and ( > 50 num ) ( >=num 40 ) )
( progn ( setq num ( - num 40 ) )
( setq roman ( strcat "XL" roman ( romantodigit num ) ) )
)
)
( ( and ( > 40 num ) ( >=num 10 ) )
( progn ( setq quotient ( / num 10 )
remainders ( rem num 10 ))
( repeat quotient
( setq roman ( strcat roman "X" ) )
)
( setq roman ( strcat roman ( romantodigit remainders ) ) )
)
)
( ( = num 9 )
( setq roman "IX" )
)
( ( = num 8 )
( setq roman "VIII" )
)
( ( = num 7 )
( setq roman "VII" )
)
( ( = num 6 )
( setq roman "VI" )
)
( ( = num 5 )
( setq roman "V" )
)
( ( = num 4 )
( setq roman "IV" )
)
( ( = num 3 )
( setq roman "III" )
)
( ( = num 2 )
( setq roman "II" )
)
( ( = num 1 )
( setq roman "I" )
)
( ( = num 0 )
( setq roman "" )
)
)
)
;;;*****************************************************************************
;;;*****************************************************************************
;;;*****************************************************************************
( defun c:xx()
( setq ss ( getint "\n>>>>>>>>>>输入整数:" ) )
( digit->roman ss )
)
(defun df(N)
(setq str "")
(cond
((>= N 1000) (progn (repeat (/ N 1000) (setq str (strcat "M" str))) (setq str (strcat str (df (rem N 1000))))))
((and (> 1000 N) (>= N 900)) (setq str (strcat "CM" (df (rem (- N 900) 1000)))))
((and (> 900 N) (>= N 500)) (setq str (strcat "D" (df (rem (- N 500) 1000)))))
((and (> 500 N) (>= N 400)) (setq str (strcat "CD" (df (rem (- N 400) 100)))))
((and (> 400 N) (>= N 100)) (progn (repeat (/ N 100) (setq str (strcat "C" str))) (setq str (strcat str (df (rem N 100))))))
((and (> 100 N) (>= N 90)) (setq str (strcat "XC" (df (rem (- N 90) 10 )))))
((and (> 90 N) (>= N 50))(setq str (strcat "L"(df (rem (- N 50) 100)))))
((and (> 50 N) (>= N 40)) (setq str (strcat "XL" (df (rem (- N 40) 10)))))
((and (> 40 N) (>= N 10)) (progn (repeat (/ N 10) (setq str (strcat "X" str))) (setq str (strcat str (df (rem N 10))))))
((and (> 10 N) (>= N 9)) (setq str (strcat "IX" (df (rem (- N 9) 10)))))
((and (> 9 N) (>= N 5)) (setq str (strcat "V" (df (rem (- N 5) 10)))))
((and (> 5 N) (>= N 4)) (setq str (strcat "IX" (df (rem (- N 4) 10)))))
(t(progn (if (= N 0) (setq str "") (repeat N (setq str (strcat "I" str))))))
)
)
学习了，我一直认为罗马数值只有I V X,原来还有其它的
(setq str (list "Ⅰ" "Ⅱ" "Ⅲ" "Ⅳ" "Ⅴ" "Ⅵ" "Ⅶ" "Ⅷ" "Ⅸ" "Ⅹ" "Ⅺ" "Ⅻ"))
(mapcar 'VL-STRING->LIST str);===>((162 241) (162 242) (162 243) (162 244) (162 245) (162 246) (162 247) (162 248) (162 249) (162 250) (162 251) (162 252))
(setq str (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12"))
(mapcar 'VL-STRING->LIST str);;==>((49) (50) (51) (52) (53) (54) (55) (56) (57) (49 48) (49 49) (49 50)) 罗马数字字符串转为整数，不进行罗马数字合法性判断。
;;;*****************************************************************************
;;;*****************************************************************************
;;;函数名: Roman->digit ******************************************************
;;;功能: 罗马数字转为整数，不进行合法性判断 ********************************
;;;参数: str- 罗马数字字符串 ***********************************************
;;;返回值: 整数 **************************************************************
( defun Roman->digit ( str )
( setq roman_digit_dic ( list ( cons "I" 1 )
( cons "V" 5 )
( cons "X" 10 )
( cons "L" 50 )
( cons "C" 100 )
( cons "D" 500 )
( cons "M" 1000 )
)
)
( setq digit_roman_dic ( list ( cons 1 "I" )
( cons 5 "V" )
( cons 10 "X" )
( cons 50 "L" )
( cons 100 "C" )
( cons 500 "D" )
( cons 1000 "M" )
)
)
( setq i 1 )
( setq num 0 )
( repeat ( - ( strlen str ) 1 )
( setq value_i ( cdr ( assoc ( substr str i 1 ) roman_digit_dic ) ) )
( setq value_i+1 ( cdr ( assoc ( substr str ( + i 1 ) 1 ) roman_digit_dic ) ) )
( if ( < value_i value_i+1 )
( setq num ( - num value_i ) )
( setq num ( + num value_i ) )
)
( setq i ( 1+ i ) )
)
( setq num ( + num value_i+1 ) )
)
;;;*****************************************************************************
;;;*****************************************************************************
;;;***************************************************************************** 罗马写数字的大数还有上划线的，这些更难搞，另外罗马数字很多地方书写不规范，到处用大写字母I，V，X，然后随意组合实际是不正确的，规范的罗马数字是没有半角字符的 llsheng_73 发表于 2022-11-17 14:38
罗马写数字的大数还有上划线的，这些更难搞，另外罗马数字很多地方书写不规范，到处用大写字母I，V，X，然 ...
是的 罗马数字的合法性判断很困难
也没有统一的书写规范 freedom_ice 发表于 2022-11-17 15:30
是的 罗马数字的合法性判断很困难
也没有统一的书写规范
只要人能判断出来，机器也就能判断出来。 llsheng_73 发表于 2022-11-17 14:38
罗马写数字的大数还有上划线的，这些更难搞，另外罗马数字很多地方书写不规范，到处用大写字母I，V，X，然 ...
你这个说法是不对的。罗马数字本来就是用拉丁字符进行组合，8 实际上就是 VIII，写成 Ⅷ 不过就是 Unicode 为常用的数值比较小的罗马数字提供一个单独的码位方便用于有序列表的编号而已。就好像同样会有阿拉伯数字有自己的码位，比如： ㉌（324C）⒛ （249B），除了用作有序列表的编号时，你在正常表达20的时候规范的用法就是用一个2和一个0，没有必要写成 ⒛ 去使用这个码位的字符（这种用法才是不规范的）。
推荐链接：https://stone-zeng.github.io/2019-02-09-circled-numbers/ 本帖最后由 vormittag 于 2022-11-18 13:47 编辑
有些特殊码位的字符，网页上还渲染不出来。。。
罗马数字几乎只会用在文本里，CAD 不以文本排版见长，没有太大的必要在这里搞。文本中的处理可以使用 LaTeX ，数字转换非常方便。
楼主，少了ROMANTODIGIT 这个函数哦，可以补上吗？
页:
[1]
2