# 【Delphi】整数をローマ数字 (文字列) に変換するコードを書いてみる --- tags: Delphi プログラミング Pascal embarcadero objectpascal created_at: 2019-11-11 updated_at: 2024-11-25 --- # はじめに これは [Delphi Advent Calendar 2019](https://qiita.com/advent-calendar/2019/delphi) の 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)](https://ja.wikipedia.org/wiki/%E3%83%AD%E3%83%BC%E3%83%9E%E6%95%B0%E5%AD%97) 私はこの問題を Delphi 10.3 Rio で解くことにしました。この辺で一旦読むのをやめて、各自お好きな言語でこの課題にチャレンジしてみるのもいいかと思います。 ## 私の解答 [Wikipedia](https://ja.wikipedia.org/wiki/%E3%83%AD%E3%83%BC%E3%83%9E%E6%95%B0%E5%AD%97) を参照した結果、練習問題とはちょっと違う実装になりました。 - 手続き (関数) じゃなくてクラスで作りました。 - 0 を許容し、0 が与えられた場合には空文字列を返すようにしました。 - 4 や 9 等にも対応しました。 - 負の数または 3999 よりも大きな数は指定できないようにしました。 - アラビア数字 (整数) への逆変換も作りました。 ```pascal: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. ``` このクラスを使って次のように変換できます。 ```pascal: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 のべき数の表を書く」というものです。 ```pascal: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** を使って判定回数を減らしてあります。 ```pascal: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** 文の例題だったのでマトモに読んでいませんでした。ごめんなさい、ヴィルト先生。 ### ・ヴィルト先生の解答をちょっと短く書いてみる ヴィルト先生の解答が冗長に見える [^1] のは、『J&W』で手続きや関数を覚える前の例題だからです。最後まで学習すれば次のように書けます [^2]。 [^1]: オリジナルで 49 行、1 行に複数の文を書かなければ 80 行弱 [^2]: 38 行 ```pascal: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 だと配列型やレコード型を使ったとしても意外と短くはなりません。型付き定数や構造化型に対する一括代入の手段はないし、文字列もないからです。次のコードは配列やレコード型を使って書き直した例です [^3]。 [^3]: 47 行、1 行に複数の文を書かなければ 70 行弱 ```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 のコードも例示しておきます。 ```pascal: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 のコードです。 ```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 のコードです。 ```Pascal: 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:** - [標準 Pascal 範囲内での Delphi 入門 (Qiita)](./e2796788c65c2cda1de5.md) - [『系統的プログラミング入門』 - Wirth 先生の邦訳本を読んでみる (Qiita)](./3086b7cff08928eca7a9.md#%E7%B3%BB%E7%B5%B1%E7%9A%84%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%9F%E3%83%B3%E3%82%B0%E5%85%A5%E9%96%80-pascal) - [『アルゴリズム + データ構造 = プログラム』 - Wirth 先生の邦訳本を読んでみる (Qiita)](./3086b7cff08928eca7a9.md#%E3%82%A2%E3%83%AB%E3%82%B4%E3%83%AA%E3%82%BA%E3%83%A0--%E3%83%87%E3%83%BC%E3%82%BF%E6%A7%8B%E9%80%A0--%E3%83%97%E3%83%AD%E3%82%B0%E3%83%A9%E3%83%A0-pascal) - [『データ構造とアルゴリズム』- 培風館の Pascal 関連書籍を読んでみる (Qiita)](./65e84a12e0203da77337.md#%E3%83%87%E3%83%BC%E3%82%BF%E6%A7%8B%E9%80%A0%E3%81%A8%E3%82%A2%E3%83%AB%E3%82%B4%E3%83%AA%E3%82%BA%E3%83%A0)