はじめに

これは Delphi Advent Calendar 2019 の 2 日目の記事です。

ヴィルト先生の練習問題

Pascal 関係の本を眺めていてちょっと面白そうな問題を見つけました。

13.5 整数のパラメータ x の値をローマ数字でテキストファイル output に書く手続きを考えよ。
x > 0 とする。('I'=1, 'V'=5, 'X'=10, 'L'=50, 'C'=100, 'D'=500, 'M'=1000)

N・ヴィルト『系統的プログラミング入門 [第２版 補訂]』野下浩平, 筧捷彦, 武市正人訳, 近代科学社, 1986, P125

一般的なプログラミング言語の用語で言い換えると、「引数 x に与えられた整数をローマ数字 (文字列) に変換し、標準出力へ出力する (void) 関数を考えてね♪」って事ですね。

...でも、IV (4) とかの処理があるから、ローマ数字についてちゃんと Wikipedia 等で調べたほうがよさそうです。

ローマ数字 (Wikipedia)

私はこの問題を Delphi 10.3 Rio で解くことにしました。この辺で一旦読むのをやめて、各自お好きな言語でこの課題にチャレンジしてみるのもいいかと思います。

私の解答

Wikipedia を参照した結果、練習問題とはちょっと違う実装になりました。

手続き (関数) じゃなくてクラスで作りました。
0 を許容し、0 が与えられた場合には空文字列を返すようにしました。
4 や 9 等にも対応しました。
負の数または 3999 よりも大きな数は指定できないようにしました。
アラビア数字 (整数) への逆変換も作りました。

uRomanNumerals.pas

unit uRomanNumerals;

interface

uses
  System.SysUtils;

type
  TRomanNumRange = 0..3999;

  { TRomanNum }
  TRomanNum = class
  private
    const
      NumArr: array [0..12] of
        record n: Integer; c: string end = (
          (n:    1; c: 'I'), (n:   4; c: 'IV'),
          (n:    5; c: 'V'), (n:   9; c: 'IX'),
          (n:   10; c: 'X'), (n:  40; c: 'XL'),
          (n:   50; c: 'L'), (n:  90; c: 'XC'),
          (n:  100; c: 'C'), (n: 400; c: 'CD'),
          (n:  500; c: 'D'), (n: 900; c: 'CM'),
          (n: 1000; c: 'M'));
  public
    class function Roman(x: TRomanNumRange): string;
    class function Arabic(s: string): TRomanNumRange;
  end;

implementation

{ TRomanNum }

class function TRomanNum.Roman(x: TRomanNumRange): string;
begin
  result := '';
  var i := High(NumArr);
  while x > 0 do
    if x >= NumArr[i].n then
      begin
        result := result + NumArr[i].c;
        Dec(x, NumArr[i].n);
      end
    else
      Dec(i);
end;

class function TRomanNum.Arabic(s: string): TRomanNumRange;
begin
  result := 0;
  var i := High(NumArr);
  while s <> '' do
    if s.StartsWith(NumArr[i].c, True) then
      begin
        Inc(result, NumArr[i].n);
        s := s.Remove(0, NumArr[i].c.Length);
      end
    else
      begin
        Dec(i);
        if i < 0 then
          raise Exception.Create('Can not convert.');
      end;
end;
end.

このクラスを使って次のように変換できます。

RomanTest.dpr

program RomanTest;
{$APPTYPE CONSOLE}

uses
  System.SysUtils, uRomanNumerals;

begin
  Writeln(TRomanNum.Roman(   0));         //
  Writeln(TRomanNum.Roman(  12));         // XII
  Writeln(TRomanNum.Roman(  24));         // XXIV
  Writeln(TRomanNum.Roman(  42));         // XLII
  Writeln(TRomanNum.Roman(  49));         // XLIX
  Writeln(TRomanNum.Roman(  89));         // LXXXIX
  Writeln(TRomanNum.Roman( 299));         // CCXCIX
  Writeln(TRomanNum.Roman( 493));         // CDXCIII
  Writeln(TRomanNum.Roman(1960));         // MCMLX
  Writeln(TRomanNum.Roman(3999));         // MMMCMXCIX
  Writeln;

  Writeln(TRomanNum.Arabic(''         )); //    0
  Writeln(TRomanNum.Arabic('XII'      )); //   12
  Writeln(TRomanNum.Arabic('XXIV'     )); //   24
  Writeln(TRomanNum.Arabic('XLII'     )); //   42
  Writeln(TRomanNum.Arabic('XLIX'     )); //   49
  Writeln(TRomanNum.Arabic('LXXXIX'   )); //   89
  Writeln(TRomanNum.Arabic('CCXCIX'   )); //  299
  Writeln(TRomanNum.Arabic('CDXCIII'  )); //  493
  Writeln(TRomanNum.Arabic('MCMLX'    )); // 1960
  Writeln(TRomanNum.Arabic('MMMCMXCIX')); // 3999
  Readln;
end.

4 や 9 等の処理をうまくやればもっとスッキリしそうな気もするし、余計にコードが長くなるような気もするし...。

ヴィルト先生の解答 (?)

『系統的プログラミング入門 [第２版補訂]』の練習問題に答えはなく、ヴィルト先生から模範解答的なものは提示されていないのですが、『J&W』に解答らしきものがありました。次のコードは『J&W (第 2 版)』にあった「ローマ数字とアラビア数字で 2 のべき数の表を書く」というものです。

roman.pas

(* program  4.7
 write roman numerals *)

program roman(output);

var x, y : integer;
begin y := 1;
   repeat x := y; write(x, ' ');
      while x >= 1000 do
         begin write('m'); x := x - 1000 end;
      if x >= 500 then
         begin write('d'); x := x - 500 end;
      while x >= 100 do
         begin write('c'); x := x - 100 end;
      if x >= 50 then
         begin write('l'); x := x - 50 end;
      while x >= 10 do
         begin write('x'); x := x - 10 end;
      if x >= 5 then
         begin write('v'); x := x - 5 end;
      while x >= 1 do
         begin write('i'); x := x - 1 end;
      writeln; y := 2 * y
   until y > 5000
end.

新しい『J&W』(第 4 版) のものは 4 や 9 を考慮してあり、ちょっと判りにくいですが else if を使って判定回数を減らしてあります。

ArabicToRoman.pas

program ArabicToRoman(Output);
  { Program 4.9 - Write a table of powers of 2 in
                  Arabic numbers and Roman numerals. }

  var
    Rem { remainder },
    Number: Integer;

begin
   Number := 1;
   repeat
      Write(Output, Number, ' ');
      Rem := Number;
      while Rem >= 1000 do
         begin  Write(Output, 'M');  Rem := Rem - 1000  end;
      if Rem >= 900 then
         begin  Write(Output, 'CM');  Rem := Rem - 900  end
      else
         if Rem >= 500 then
            begin  Write(Output, 'D');  Rem := Rem - 500  end
         else
            if Rem >= 400 then
               begin  Write(Output, 'CD');  Rem := Rem - 400  end;
      while Rem >= 100 do
         begin  Write(Output, 'C');  Rem := Rem - 100  end;
      if Rem >= 90 then
         begin  Write(Output, 'XC');  Rem := Rem - 90  end
      else
         if Rem >= 50 then
            begin  Write(Output, 'L');  Rem := Rem - 50  end
         else
            if Rem >= 40 then
               begin  Write(Output, 'XL');  Rem := Rem - 40  end;
      while Rem >= 10 do
         begin  Write(Output, 'X');  Rem := Rem - 10  end;
      if Rem = 9 then                 
         begin  Write(Output, 'IX');  Rem := Rem - 9  end
      else
         if Rem >= 5 then
            begin  Write(Output, 'V');  Rem := Rem - 5  end
         else
            if Rem = 4 then
               begin  Write(Output, 'IV');  Rem := Rem - 4  end;
      while Rem >= 1 do
         begin  Write(Output, 'I');  Rem := Rem - 1;  end;
      Writeln(Output);
      Number := Number * 2
   until Number > 5000
end .

『J&W』のコードは uRomanNumerals.pas を書いた後で気付きました。第 2 版の 4.7. も、第 4 版の 4.9. も if 文の例題だったのでマトモに読んでいませんでした。ごめんなさい、ヴィルト先生。

・ヴィルト先生の解答をちょっと短く書いてみる

ヴィルト先生の解答が冗長に見える ¹ のは、『J&W』で手続きや関数を覚える前の例題だからです。最後まで学習すれば次のように書けます ²。

ArabicToRoman2.pas

program ArabicToRoman2(Output);
type
  Str = packed array [1..2] of Char;
var
  Rem, Number: Integer;
  procedure ProcessNum(n: Integer; c: Str);
  begin
    while Rem >= n do
      begin 
        if c[2] = ' ' then
          Write(c[1])
        else
          Write(c);    
        Rem := Rem - n;  
      end;
  end; { ProcessNum }
begin
  Number := 1;
  repeat
    Write(Number, ' ');
    Rem := Number;
    ProcessNum(1000, 'M ');
    ProcessNum( 900, 'CM');
    ProcessNum( 500, 'D ');
    ProcessNum( 400, 'CD');
    ProcessNum( 100, 'C ');
    ProcessNum(  90, 'XC');
    ProcessNum(  50, 'L ');
    ProcessNum(  40, 'XL');
    ProcessNum(  10, 'X ');
    ProcessNum(   9, 'IX');
    ProcessNum(   5, 'V ');
    ProcessNum(   4, 'IV');
    ProcessNum(   1, 'I ');
    Writeln;
    Number := Number * 2
  until Number > 5000
end.

もちろん標準 Pascal で実行できるコードです。

・ヴィルト先生の解答を配列型やレコード型を使って書き直す

標準 Pascal だと配列型やレコード型を使ったとしても意外と短くはなりません。型付き定数や構造化型に対する一括代入の手段はないし、文字列もないからです。次のコードは配列やレコード型を使って書き直した例です ³。

ArabicToRoman3.pas

program ArabicToRoman3(Output);
const
  HIGH = 12;
var
  loop: Boolean;
  i, Rem, Number: Integer;
  NumArr: array [0..HIGH] of 
    record 
      n: Integer; 
      c: packed array [1..2] of Char; 
    end;   
begin
  NumArr[ 0].n :=    1; NumArr[ 0].c := 'I '; NumArr[ 1].n :=   4; NumArr[ 1].c := 'IV';
  NumArr[ 2].n :=    5; NumArr[ 2].c := 'V '; NumArr[ 3].n :=   9; NumArr[ 3].c := 'IX';
  NumArr[ 4].n :=   10; NumArr[ 4].c := 'X '; NumArr[ 5].n :=  40; NumArr[ 5].c := 'XL';
  NumArr[ 6].n :=   50; NumArr[ 6].c := 'L '; NumArr[ 7].n :=  90; NumArr[ 7].c := 'XC';
  NumArr[ 8].n :=  100; NumArr[ 8].c := 'C '; NumArr[ 9].n := 400; NumArr[ 9].c := 'CD';
  NumArr[10].n :=  500; NumArr[10].c := 'D '; NumArr[11].n := 900; NumArr[11].c := 'CM';
  NumArr[12].n := 1000; NumArr[12].c := 'M ';

  Number := 1;
  repeat
    Write(Number, ' ');
    Rem := Number;
    i := HIGH;
    while Rem > 0 do
      begin
        Loop := True;  
        while Loop do
          if Rem >= NumArr[i].n then
            begin
              if Odd(i) then
                write(NumArr[i].c)
              else
                write(NumArr[i].c[1]);
              Rem := Rem - NumArr[i].n;
            end
          else
            begin
              i := i - 1;  
              Loop := False;
          end;  
      end;      
    Writeln;
    Number := Number * 2
  until Number > 5000
end.

こちらも標準 Pascal で実行できるコードです。

・ヴィルト先生の解答をuRomanNumerals.pas を使って書き直す

uRomanNumerals.pas を使って 2 のべき数を表示する Delph のコードも例示しておきます。

RomanTest2.dpr

program RomanTest2;
{$APPTYPE CONSOLE}

uses
  System.SysUtils, uRomanNumerals;

begin
  var Number := 1;
  repeat
    Writeln(Number : 8, ' ', TRomanNum.Roman(Number));
    Number := Number shl 1;
  until Number > 5000;
  Readln;
end.

ヴィルト先生の練習問題をお題に忠実に記述してみる

ヴィルト先生の練習問題をお題に忠実に書いてみました。最初からこっちを書けって話ではありますが、標準出力にローマ数字を吐くという汎用性のないコードを書きたくなかったんですよね。

・標準 Pascal の場合

お題に忠実な標準 Pascal のコードです。

  procedure ArabicToRoman(x: Integer);
  type
    Str = packed array [1..2] of Char;
    procedure ProcessNum(n: Integer; c: Str);
    begin
      while x >= n do
        begin 
          if c[2] = ' ' then
            Write(c[1])
          else
            Write(c); // Delphi の場合には Write(String(c));   
          x := x - n;  
        end;
    end; { ProcessNum }
  begin
    ProcessNum(1000, 'M ');
    ProcessNum( 900, 'CM');
    ProcessNum( 500, 'D ');
    ProcessNum( 400, 'CD');
    ProcessNum( 100, 'C ');
    ProcessNum(  90, 'XC');
    ProcessNum(  50, 'L ');
    ProcessNum(  40, 'XL');
    ProcessNum(  10, 'X ');
    ProcessNum(   9, 'IX');
    ProcessNum(   5, 'V ');
    ProcessNum(   4, 'IV');
    ProcessNum(   1, 'I ');
  end; { ArabicToRoman }

・Delphi 10.3 Rio の場合

お題に忠実な Delphi のコードです。

  procedure ArabicToRoman(x: Integer);
  const
    NumArr: array [0..12] of
      record n: Integer; c: string end = (
        (n:    1; c: 'I'), (n:   4; c: 'IV'),
        (n:    5; c: 'V'), (n:   9; c: 'IX'),
        (n:   10; c: 'X'), (n:  40; c: 'XL'),
        (n:   50; c: 'L'), (n:  90; c: 'XC'),
        (n:  100; c: 'C'), (n: 400; c: 'CD'),
        (n:  500; c: 'D'), (n: 900; c: 'CM'),
        (n: 1000; c: 'M'));
  begin
    var i := High(NumArr);
    while x > 0 do
      if x >= NumArr[i].n then
        begin
          Write(NumArr[i].c);
          Dec(x, NumArr[i].n);
        end
      else
        Dec(i);
  end; { ArabicToRoman }

おわりに

現在の Delphi 使いにも、昔 Pascal (Turbo Pascal や Delphi を含む) 使ってた人にも「ん？」と一瞬思ってもらえるコードが書けたような気がします。もっとスッキリ書けたり、他言語でチャレンジしたものがありましたら、コメント欄に投稿して頂けると幸いです。

See also:

オリジナルで 49 行、1 行に複数の文を書かなければ 80 行弱 ↩
38 行 ↩
47 行、1 行に複数の文を書かなければ 70 行弱 ↩

【Delphi】整数をローマ数字 (文字列) に変換するコードを書いてみる