47 lines
1.4 KiB
Plaintext
47 lines
1.4 KiB
Plaintext
test_decode: procedure options (main); /* 28 January 2013 */
|
|
declare roman character (20) varying;
|
|
|
|
do roman = 'i', 'ii', 'iii', 'iv', 'v', 'vi', 'vii', 'viii', 'iix',
|
|
'ix', 'x', 'xi', 'xiv', 'MCMLXIV', 'MCMXC', 'MDCLXVI',
|
|
'MIM', 'MM', 'MMXIII';
|
|
put skip list (roman, decode(roman));
|
|
end;
|
|
|
|
decode: procedure (roman) returns (fixed(15));
|
|
declare roman character (*) varying;
|
|
declare (current, previous) character (1);
|
|
declare n fixed (15);
|
|
declare i fixed binary;
|
|
|
|
previous = ''; n = 0;
|
|
do i = length(roman) to 1 by -1;
|
|
current = substr(roman, i, 1);
|
|
if digit_value(current) < digit_value(previous) then
|
|
n = n - digit_value(current);
|
|
else if digit_value(current) > digit_value(previous) then
|
|
do;
|
|
n = n + digit_value(current);
|
|
previous = current;
|
|
end;
|
|
else
|
|
n = n + digit_value(current);
|
|
end;
|
|
return (n);
|
|
end decode;
|
|
|
|
digit_value: procedure (roman_char) returns (fixed);
|
|
declare roman_char character(1);
|
|
select (roman_char);
|
|
when ('M', 'm') return (1000);
|
|
when ('D', 'd') return (500);
|
|
when ('C', 'c') return (100);
|
|
when ('L', 'l') return (50);
|
|
when ('X', 'x') return (10);
|
|
when ('V', 'v') return (5);
|
|
when ('I', 'i') return (1);
|
|
otherwise return (0);
|
|
end;
|
|
end digit_value;
|
|
|
|
end test_decode;
|