Posted By

Scooter on 05/19/08


Tagged

roman numerals


Versions (?)

Who likes this?

1 person have marked this snippet as a favorite

wizard04


Roman Numerals


 / Published in: ASP
 

URL: http://reusablecode.blogspot.com/search/label/roman%20numerals

A library of functions for converting between Arabic and Roman numerals. Requires my InStrCount() function available here: http://snipplr.com/view/5392/count-instances-of-one-string-in-another/

  1. <%
  2. ' ASP Roman Numeral Library
  3. '
  4. ' Copyright (c) 2008, reusablecode.blogspot.com; some rights reserved.
  5. '
  6. ' This work is licensed under the Creative Commons Attribution License. To view
  7. ' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
  8. ' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
  9. ' 94305, USA.
  10.  
  11. ' Convert Arabic numerals into Roman numerals.
  12. function roman(ByVal arabic)
  13. Dim fractions
  14. Dim ones
  15. Dim tens
  16. Dim hundreds
  17. Dim thousands
  18.  
  19. fractions = Array("", "�¢ï¿½�¢", "�¢ï¿½�¢�¢ï¿½�¢", "�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢", "�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢", "�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢", "S", "S�¢ï¿½�¢", "S�¢ï¿½�¢�¢ï¿½�¢", "S�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢", "S�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢", "S�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢�¢ï¿½�¢", "I")
  20. ones = Array("", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
  21. tens = Array("", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC")
  22. hundreds = Array("", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM")
  23. thousands = Array("", "M", "MM", "MMM", "MMMM")
  24.  
  25. if arabic > 4999 then
  26. ' For large numbers (five thousand and above), a bar is placed above a base numeral to indicate multiplication by 1000.
  27. ' Since it is not possible to illustrate this in plain ASCII, this function will refuse to convert numbers above 4999.
  28. Err.Clear
  29. Err.Raise 9
  30. elseif arabic = 0 then
  31. ' About 725, Bede or one of his colleagues used the letter N, the initial of nullae,
  32. ' in a table of epacts, all written in Roman numerals, to indicate zero.
  33. roman = "N"
  34. else
  35. ' Handle fractions that will round up to 1.
  36. if round((arabic mod 1) * 12) = 12 then
  37. arabic = round(arabic)
  38. end if
  39.  
  40. ' With special cases out of the way, we can proceed.
  41. roman = thousands((arabic - (arabic mod 1000)) / 1000)
  42. arabic = arabic mod 1000
  43. roman = roman & hundreds((arabic - (arabic mod 100)) / 100)
  44. arabic = arabic mod 100
  45. roman = roman & tens((arabic - (arabic mod 10)) / 10)
  46. arabic = arabic mod 10
  47. roman = roman & ones((arabic - (arabic mod 1)) / 1)
  48. arabic = arabic mod 1
  49.  
  50. ' Handling for fractions.
  51. if arabic > 0 then
  52. roman = roman & fractions(round(arabic * 12))
  53. end if
  54. end if
  55. end function
  56.  
  57. ' Expand subtractive notation in Roman numerals.
  58. function roman_expand(ByVal roman)
  59. roman = replace(roman, "CM", "DCCCC")
  60. roman = replace(roman, "CD", "CCCC")
  61. roman = replace(roman, "XC", "LXXXX")
  62. roman = replace(roman, "XL", "XXXX")
  63. roman = replace(roman, "IX", "VIIII")
  64. roman = replace(roman, "IV", "IIII")
  65. roman_expand = roman
  66. end function
  67.  
  68. ' Compress Roman numerals using subtractive notation.
  69. function roman_compress(ByVal roman)
  70. roman = replace(roman, "DCCCC", "CM")
  71. roman = replace(roman, "CCCC", "CD")
  72. roman = replace(roman, "LXXXX", "XC")
  73. roman = replace(roman, "XXXX", "XL")
  74. roman = replace(roman, "VIIII", "IX")
  75. roman = replace(roman, "IIII", "IV")
  76. roman_compress = roman
  77. end function
  78.  
  79. ' Convert Roman numerals to Arabic numerals.
  80. ' Requires InstrCount()
  81. function arabic(ByVal roman)
  82. Dim result
  83.  
  84. result = 0
  85.  
  86. ' Remove subtractive notation.
  87. roman = roman_expand(roman)
  88.  
  89. ' Calculte for each numeral.
  90. result = result + InstrCount(roman, "M") * 1000
  91. result = result + InstrCount(roman, "D") * 500
  92. result = result + InstrCount(roman, "C") * 100
  93. result = result + InstrCount(roman, "L") * 50
  94. result = result + InstrCount(roman, "X") * 10
  95. result = result + InstrCount(roman, "V") * 5
  96. result = result + InstrCount(roman, "I")
  97. end function
  98.  
  99. ' Validate a roman number.
  100. function isRoman(roman)
  101. dim regEx
  102. set regEx = new RegExp
  103.  
  104. with regEx
  105. .IgnoreCase = true
  106. .Global = true
  107. .Pattern = "[MDCLXVI]"
  108. end with
  109.  
  110. if regEx.Test(roman) then
  111. isRoman = true
  112. else
  113. isRoman = false
  114. end if
  115.  
  116. set regEx = nothing
  117. end function
  118. %>

Report this snippet  

You need to login to post a comment.