Data commit

Task/Roman-numerals-Decode/PL-I/roman-numerals-decode.pli

@@ -0,0 +1,46 @@
+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;