Convert Integer to Roman

[cupak@rapnet.sanders.lockheed.com (John J Cupak Jr CCP)]

I was interested in the solutions to the Integer-to-Roman conversion programs
posted to comp.lang.pascal, so I went home and wrote the Roman.ada function
from a 1969 (!) flowchart. Pascal folks can convert it ;-)

------------------- CUT HERE -----------------------------------
function Roman(The_Number : in Integer) return String is

-- Since many computer manufactures and software houses are expanding their
-- marketing area to foreign countries, it may become necessary to convert
-- an integer number to a Roman Numeral format.  Conversion of numbers to
-- Roman Numerals does not lend itself to a mathematical conversion due to
-- lack of symmetrical relationship between the "digits" of the Roman Numeral
-- system. A reduction conversion method is used instead.
--
-- The Romans had no concept of fractions and so all their numerals were
-- integers. At the time their system was initiated, one thousand was as large
-- as could be conceived and was given the letter M (Magna = large). A later
-- modification to the Roman Numeral system extended the range a thousand fold
-- by defining any "digit" with a Bar over it as being 1000 times the normal
-- value. Since it is not possible to create a character with an over-bar, the
-- underscore ("_") is placed on the right of the character, thus M = 1000,
-- M_ = 1,000,000. In this way, numbers as high as one million can be expressed
-- and by use of multiple M_'s, even larger numbers are converted. If all
-- arithmetic is done in integer format, the conversion is exact.

-- This algorithm was extracted from a March 1969 flowchart provided on the
-- SPIRAS PROGRAMMER'S CALENDAR.  Spiras Systems, Inc. was (in 1969) an
-- affiliate of USM Corporation, and was based in Waltham, MA.

-- This Ada function was written by John J. Cupak, Jr., CCP

   Maximum_Chars   : constant Natural :=  4; -- Roman Numeral characters
   Maximum_Entries : constant Natural := 25; -- Roman Numeral entries

   -- Roman Numerals need 1-4 characters

   subtype String_Width is Natural 1..Maximum_Chars;
   subtype Roman_String is String(String_Width);

   -- Information about a single Roman Numeral "digit"
      
   type Roman_Data_Record is
      record
         Value : Positive;
         Width : String_Width;
         Chars : Roman_String;
      end record;

   -- Roman Numeral entries

   subtype Array_Entries is Natural range 1..Maximum_Array_Entries;

   -- Array of Roman Numeral Data

   type Roman_Data_Array is array(Array_Entries) of Roman_Data_Record;

   -- Roman Numeral Data

   Roman_Data : Roman_Data_Array := ( 1 => (1_000_000,    2, "M_  "),
                                      2 => (  900_000,    4, "C_M_"),
                                      3 => (  500_000,    2, "D_  "),
                                      4 => (  400_000,    4, "C_D_"),
                                      5 => (  100_000,    2, "C_  "),
                                      6 => (   90_000,    4, "X_C_"),
                                      7 => (   50_000,    2, "L_  "),
                                      8 => (   40_000,    4, "X_L_"),
                                      9 => (   10_000,    2, "X_  "),
                                     10 => (    9_000,    3, "MX_ "),
                                     11 => (    5_000,    2, "V_  "),
                                     12 => (    4_000,    3, "MV_ "),
                                     13 => (    1_000,    1, "M   "),
                                     14 => (      900,    2, "CM  "),
                                     15 => (      500,    1, "D   "),
                                     16 => (      400,    2, "CD  "),
                                     17 => (      100,    1, "C   "),
                                     18 => (       90,    2, "XC  "),
                                     19 => (       50,    1, "L   "),
                                     20 => (       40,    2, "XL  "),
                                     21 => (       10,    1, "X   "),
                                     22 => (        9,    2, "IX  "),
                                     23 => (        5,    1, "V   "),
                                     24 => (        4,    2, "IV  "),
                                     25 => (        1,    1, "I   "));

   Start : Natural := 0;   -- Starting position for Roman Numeral "digit"
   Finish: Natural := 0;   -- Ending   position for Roman Numeral "digit"

   Result: String(1..80);  -- Output Roman Numeral String
   Input_Value : Integer;
   Index : Array_Entries;  -- Index into Roman Numeral Data array

begin

  -- Initialize

  Input_Value := The_Number;           -- Copy in order to decrement later
  Index       := Array_Entries'First;  -- First Roman Numeral Data entry
  Result      := (others => ' ');      -- Blank output string

  -- Convert negative number to positive

  if Input_Value < 0 then              -- Negative number
     Start := Start + 1;               -- First character
     Result(Start) := '-';             -- Negative sign
     Input_Value := -Input_Value;      -- Make positive
  end if;

  -- Repeat while still data to convert

  while Input_Value > 0 loop

     -- Search for next Roman Numeral(s) to insert

     while Input_Value < Roman_Data(Index).Value loop
        Index := Index'Succ;
     end loop;

     -- Decrement Input_Value by Roman Numeral Value

     Input_Value := Input_Value - Roman_Data(Index).Value;

     -- Compute where to insert Roman Numerals in Result string

     Start  := Finish + 1;
     Finish := Start + Roman_Data(Index).Width - 1;

     -- Insert from 1 to 4 Roman Numerals in Result string.

     Result(Start..Finish) :=
        Roman_Data(Index).Chars(1..Roman_Data(Index).Width);

  end loop;

  return Result(1..Finish); 

end Roman_Number;  -- Finis

--
John J. Cupak, Jr., CCP       Lockheed DECNet: MERVAX::CUPAK
Lockheed Sanders, Inc.        Internet       : cupak@rapnet.sanders.LOCKHEED.COM
95 Canal Street / NCA15-221   CompuServe     : 72411,3176 
Nashua, NH 03061-0868         Telephone      : (603) 885-2134     FAX: 885-8033