漢数字電卓 - file-glob こと k.daibaの日記

某所で必要だったので，漢数字電卓用のモジュールを作っていました．漢数字をアラビア数字に変換したり，アラビア数字を漢数字に変換するものです．そろそろできあがったかな，と思っていたら弾さんがLingua-JA-Numbers-0.05 - Converts numeric values into their Japanese string equivalents and vice versa - metacpan.orgというモジュールを作られたので，さっそくお蔵入りになりました．(T^T) このまま捨ててしまうのももったいないので，ここにさらします．

漢数字の表現は，一二三四五六七八九十百千万億兆京垓禾予穣溝澗正載極恒河沙阿僧祇那由多不可思議無量大数を使っています．万から極までは万進(10^4)，恒河沙から無量大数までは万万進(10^8)です．

package JANumbers;
use base qw(Exporter);
use encoding 'shiftjis';
use bignum;
use strict;

our @EXPORT = qw(arabic2chinese chinese2arabic);

## 構造定義
#

my ($tag1, $tag2, $tag3, $digit, @num1, @num2, @num3, @num4, %table);

$tag1  = q{(?:千|百|十|\b)};
$tag2  = q{(?:載|正|澗|溝|穣|禾予|垓|京|兆|億|万|\b)};
$tag3  = q{(?:無量大数|不可思議|那由多|阿僧祇|恒河沙|極|\b)};
$digit = q{(?:一|二|三|四|五|六|七|八|九)};

@num1 = qw(一 二 三 四 五 六 七 八 九);
@num2 = qw(十 百 千);
@num3 = qw(万 億 兆 京 垓 予禾 穣 溝 澗 正 載); # 禾予を逆にしている
@num4 = qw(極 恒河沙 阿僧祇 那由多 不可思議 無量大数);

unshift @num1, '';
unshift @num2, '';
unshift @num3, '';

%table = (
	'一' => 1, '二' => 2, '三' => 3, '四' => 4,
	'五' => 5, '六' => 6, '七' => 7, '八' => 8, '九' => 9,
	'十' => 10, '百' => 10**2, '千' => 10**3,
	'万' => 10**4, '億' => 10**8, '兆' => 10**12,
	'京' => 10**16, '垓' => 10**20, '禾予' => 10**24,
	'穣' => 10**28, '溝' => 10**32, '澗' => 10**36,
	'正' => 10**40, '載' => 10**44,
	'極' => 10**48, '恒河沙' => 10**56,
	'阿僧祇' => 10**64, '那由多' => 10**72,
	'不可思議' => 10**80, '無量大数' => 10**88,
);

## _fourchar($)
#	万進の数字処理
#	文字列 $str を渡すと数字を返す
#
sub _fourchar($)
{
	my $str = shift;
	my $ret;

	while ($str =~ /($digit)?($tag1)/g){
		my $block = $table{$1};       # 二千だったら 二
		my $unit  = $table{$2};       # 二千だったら 千

		## 桁表記があるのに漢数字がない
		#     1 x 10^n の時
		#
		$block = 1 if (!$block && $unit);

		## 漢数字があるのに桁表記がない
		#     n x 1 の時
		#
		$unit  = 1 if ($block && !$unit);
		$ret += $block * $unit;
	}
	return $ret;
}

## _eightchar($)
#	万万進の数字処理
#	文字列 $str を渡すと数字を返す
#
sub _eightchar($)
{
	my $str = shift;
	my $ret;

	while ($str =~ /([^$tag2]+)($tag2)/g){
		my $block = _fourchar($1);
		my $unit  = $table{$2} || 1;
		$ret += $block * $unit;
	}
	return $ret;
}

## chinese2arabic($)
#	漢数字をアラビア数字に変換
#	文字列 $str を渡すと数字を返す
#
sub chinese2arabic($)
{
	my $str = shift;
	my $ret;

	while ($str =~ /([^$tag3]+)($tag3)/g){
		my $block = _eightchar($1);
		my $unit  = $table{$2} || 1;
		$ret += $block * $unit;
	}
	return $ret;
}

## _expo($$)
#	数字 $num と桁 $pos を渡すと文字列を返す
#
sub _expo($$)
{
	my $num = shift;
	my $pos = shift;
	my $ret;
	return '' if ($num == 0);
	return '一' if (($num == 1) && ($pos == 0));
	return $num2[$pos] if (($num == 1) && ($pos > 0));
	return $num2[$pos] . $num1[$num];
}

## _fourdigit($)
#	万進の漢数字処理
#	数字 $num を渡すと文字列を返す
#
sub _fourdigit($)
{
	my $num = shift;
	my ($pos1, $ret);
	map{
		my $pos2;
		$ret .= $num3[$pos1++];
		s/(\d)/_expo($1, $pos2++)/eg;
		$ret .= $_;
	}(reverse($num) =~ /\d{1,4}/g);
	return $ret = reverse($ret);
}

## _eightdigit($)
#	万万進の漢数字処理
#	数字 $num を渡すと文字列を返す
#
sub _eightdigit($)
{
	my $num = shift;
	my ($pos1, $ret);
	map{
		$ret = _fourdigit(reverse($_)) . $num4[$pos1++] . $ret;
	}(reverse($num) =~ /\d{1,8}/g);
	return $ret;
}

## arabic2chinese($)
#	アラビア数字を漢数字に変換
#	数字 $num を渡すと文字列を返す
sub arabic2chinese($)
{
	my $num = shift;
	my ($fourdigit, $eightdigit);
	$num =~ /(\d{0,48}?)$/;
	return _eightdigit($`) . _fourdigit($1);
}
1;

解説がいるかな？と思いつつ，このブログを見てるひとはそんなにいないだろうから，放置．あ，WinXP + Activestate上で作っていたので，文字コードにshiftjisを指定しています．