はじめに
これは 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・ヴィルト『系統的プログラミング入門 [第2版 補訂]』野下浩平, 筧捷彦, 武市正人訳, 近代科学社, 1986, P125
一般的なプログラミング言語の用語で言い換えると、**「引数 x に与えられた整数をローマ数字 (文字列) に変換し、標準出力へ出力する (void) 関数を考えてね♪」**って事ですね。
...でも、IV (4)
とかの処理があるから、ローマ数字についてちゃんと Wikipedia 等で調べたほうがよさそうです。
私はこの問題を Delphi 10.3 Rio で解くことにしました。この辺で一旦読むのをやめて、各自お好きな言語でこの課題にチャレンジしてみるのもいいかと思います。
私の解答
Wikipedia を参照した結果、練習問題とはちょっと違う実装になりました。
- 手続き (関数) じゃなくてクラスで作りました。
- 0 を許容し、0 が与えられた場合には空文字列を返すようにしました。
- 4 や 9 等にも対応しました。
- 負の数または 3999 よりも大きな数は指定できないようにしました。
- アラビア数字 (整数) への逆変換も作りました。
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.
このクラスを使って次のように変換できます。
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
等の処理をうまくやればもっとスッキリしそうな気もするし、余計にコードが長くなるような気もするし...。
ヴィルト先生の解答 (?)
『系統的プログラミング入門 [第2版 補訂]』の練習問題に答えはなく、ヴィルト先生から模範解答的なものは提示されていないのですが、『J&W』に解答らしきものがありました。次のコードは『J&W (第 2 版)』にあった「ローマ数字とアラビア数字で 2 のべき数の表を書く」というものです。
(* 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 を使って判定回数を減らしてあります。
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。
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。
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 のコードも例示しておきます。
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:
- 標準 Pascal 範囲内での Delphi 入門 (Qiita)
- 『系統的プログラミング入門』 - Wirth 先生の邦訳本を読んでみる (Qiita)
- 『アルゴリズム + データ構造 = プログラム』 - Wirth 先生の邦訳本を読んでみる (Qiita)
- 『データ構造とアルゴリズム』- 培風館の Pascal 関連書籍を読んでみる (Qiita)