天鳳の牌譜形式を解析する(1) - koba::blog、天鳳の牌譜形式を解析する(2) - koba::blog の続き。天鳳の牌譜形式のXML要素を1つ1つ電脳麻将の牌譜形式に変換していく。
mjloggm
if ($elem eq 'mjloggm') { warn "*** Unknown version $attr{ver}\n" if ($attr{ver} ne '2.3'); }
属性 ver が 2.3 以外の場合は形式が変更されているので警告を出す(処理は続行)。
GO
elsif ($elem eq 'GO') { $paipu->{title} = type($attr{type}); die "+++ Not Majiang log\n" if ($type{sanma}); }
前回説明した関数 type()
を使って属性 type を解析し、解析結果の文字列('四特東喰赤速'
など)を牌譜の title に設定する。三麻の牌譜の場合は変換できない*1ので異常終了する。
UN
elsif ($elem eq 'UN' && ! $paipu->{player}) { $paipu->{player} = player(%attr); }
関数 player()
を呼出して属性を対局者名に変換する。既に変換済みの場合は無視する*2。関数 player()
は以下の通り。
my @dan_name = ( '新人','9級','8級','7級','6級','5級','4級','3級','2級','1級', '初段','二段','三段','四段','五段','六段','七段','八段','九段','十段', '天鳳位' ); sub url_decode { my ($str) = @_; $str =~ s/%([\da-fA-F]{2})/pack('H2', $1)/ge; return $str; } sub player { my %attr = @_; my @name = map { url_decode($attr{$_}) } ('n0','n1','n2','n3'); my @dan = map { $dan_name[$_] } split(',', $attr{dan}); my @rate = map { int($_) } split(',', $attr{rate}); my @player = map { "$name[$_] ($dan[$_] R$rate[$_])" } (0..3); return \@player; }
対局者名は 天鳳名 (段位 Rレート数) の形式とした。天鳳名はURLエンコードされているのでデコードする。段位は 0〜20 の数値で表されているのでこれを 新人〜天鳳位 にマッピングする。レート数は小数点以下を切り捨てる。
TAIKYOKU
elsif ($elem eq 'TAIKYOKU') { $paipu->{qijia} = $attr{oya} + 0; $paipu->{log} = []; }
属性 oya は起家を表すのでこれを牌譜の qijia に設定する。さらに牌譜の log の配列を初期化する。
INIT
elsif ($elem eq 'INIT') { @fulou = ( [], [], [], [] ); $oya = $attr{oya}; $log = [ qipai(%attr) ]; push(@{$paipu->{log}}, $log); }
天鳳の牌譜は流局時の牌姿に副露牌が含まれないためこれを記憶しておく必要がある。このための変数 @fulou
を初期化する。また天鳳の牌譜では常に起家から順に 0〜3 で表すが、電脳麻将の牌譜ではその局の親から順に 0〜3 とするためこの局の親を変数 $oya
に設定する。関数 qipai()
を呼出して属性を配牌の情報に変換し、その局の摸打情報の第一要素に設定する。最後に牌譜の log にその局の摸打情報を追加する。
関数 qipai()
は以下の通り。
sub qipai { my %attr = @_; my @seed = split(',', $attr{seed}); my @ten = map { $_ * 100 } split(',', $attr{ten}); my @hai = map { pai(split(',', $attr{"hai$_"})) } (0..3); push(@ten, splice(@ten, 0, $attr{oya})); push(@hai, splice(@hai, 0, $attr{oya})); my %qipai = ( zhuangfeng => int($seed[0] / 4), jushu => $seed[0] % 4, changbang => $seed[1] + 0, lizhibang => $seed[2] + 0, defen => \@ten, baopai => pai($seed[5]), shoupai => \@hai ); return { qipai => \%qipai }; }
属性 seed を分解して場風、局数、積み棒、供託リーチ棒の数、ドラ表示牌を取得する。属性 ten からは局開始時の持ち点、属性 hai0〜hai3 からは配牌を取得するが、その局の親からの順に並べ替えている。また、ドラ表示牌、配牌は「牌番号」で表現されているので前回説明した関数 pai()
を使って電脳麻将の形式に変換する。
(T|U|V|W)(0〜135)
elsif ($elem =~ /^([TUVW])(\d+)$/) { my $l = (ord($1) - ord('T') + 4 - $oya) % 4; my $p = pai($2); if ($gang) { push(@$log, { gangzimo => { l => $l, p => $p} }); } else { push(@$log, { zimo => { l => $l, p => $p} }); } $zimo = $2; undef $gang; }
要素名の先頭の T〜W は起家からの順なので変数 $oya を使って現在の局の親からの順に変換する。自摸した牌は「牌番号」で表されているので pai()
で変換する。天鳳の牌譜では通常の自摸、槓自摸を区別しないが電脳麻将では区別するので変数 $gang
で判別している。またツモ切り判定のために自摸した牌を変数 $zimo
に保存する。
(D|E|F|G)(0〜135)
elsif ($elem =~ /^([DEFG])(\d+)$/) { my $l = (ord($1) - ord('D') + 4 - $oya) % 4; my $p = pai($2); $p .= '_' if ($2 eq $zimo); $p .= '*' if ($lizhi); push(@$log, { dapai => { l => $l, p => $p} }); undef $lizhi; }
自摸の場合と同様に手番の変換、牌番号の変換を行う。ツモ切りの際は '_'
を付加し、リーチ宣言の際はさらに '*'
を付加する。
N
elsif ($elem eq 'N') { my $l = ($attr{who} + 4 - $oya) % 4; my $m = mianzi($attr{m}); if ($m =~ /^[mpsz]\d{4}$/ || $m =~ /^[mpsz]\d{3}[\-\+\=]\d$/) { push(@$log, { gang => { l => $l, m => $m } }); $gang = 1; } else { push(@$log, { fulou => { l => $l, m => $m } }); if ($m =~ /^[mpsz]\d{4}[\-\+\=]$/) { $gang = 1 } else { $zimo = '' } } push(@{$fulou[$attr{who}]}, $m); }
属性 who と変数 $oya
から手番を決定し、属性 m の「面子コード」を前回説明した関数 mianzi()
で変換する。電脳麻将の牌譜では暗槓、加槓は副露扱いではないのでパターンマッチングで判定している。暗槓、加槓に加えて大明槓の場合も変数 $gang
に真を設定し、直後の自摸は槓自摸と解釈する。
DORA
elsif ($elem eq 'DORA') { push(@$log, { kaigang => { baopai => pai($attr{hai}) } }); }
属性 hai の槓ドラの「牌番号」を pai()
で変換する。
REACH
elsif ($elem eq 'REACH' && $attr{step} == 1) { $lizhi = 1; }
属性 step が 1 の場合はリーチ宣言なので、変数 $lizhi
に真を設定し、直後の打牌はリーチ宣言牌と解釈する。
AGARI
elsif ($elem eq 'AGARI') { push(@$log, hule(%attr)); }
関数 hule()
を呼出して属性から和了情報を得る。関数 hule()
は以下の通り。
my @hupai_name = ( '門前清自摸和', '立直', '一発', '槍槓', '嶺上開花', '海底摸月', '河底撈魚', '平和', '断幺九', '一盃口', '自風 東', '自風 南', '自風 西', '自風 北', '場風 東', '場風 南', '場風 西', '場風 北', '役牌 白', '役牌 發', '役牌 中', '両立直', '七対子', '混全帯幺九', '一気通貫', '三色同順', '三色同刻', '三槓子', '対々和', '三暗刻', '小三元', '混老頭', '二盃口', '純全帯幺九', '混一色', '清一色', '', '天和', '地和', '大三元', '四暗刻', '四暗刻単騎', '字一色', '緑一色', '清老頭', '九蓮宝燈', '純正九蓮宝燈', '国士無双', '国士無双13面', '大四喜', '小四喜', '四槓子', 'ドラ', '裏ドラ', '赤ドラ', ); sub hule { my %attr = @_; $attr{m} .= ''; $attr{yaku} .= ''; $attr{yakuman} .= ''; my @ten = split(',', $attr{ten}); my @sc = map { $_ * 100 } (split(',', $attr{sc}))[1,3,5,7]; my @yaku = split(',', $attr{yaku}); my @yakuman = split(',', $attr{yakuman}); push(@sc, splice(@sc, 0, $oya)); my (@hupai, $fanshu); if (@yakuman) { for (@yakuman) { push(@hupai, { name => $hupai_name[$_], fanshu => '*' }); } } else { for (my $i = 0; $i < @yaku; $i += 2) { push(@hupai, { name => $hupai_name[$yaku[$i]], fanshu => $yaku[$i+1] + 0 }); $fanshu += $yaku[$i+1]; } } my %hule = ( l => ($attr{who} + 4 - $oya) % 4, shoupai => join(',', pai(grep { $_ ne $attr{machi} } split(',', $attr{hai})) . pai($attr{machi}), reverse map { mianzi($_) } split(',', $attr{m})), baojia => ($attr{who} ne $attr{fromWho}) ? ($attr{fromWho} + 4 - $oya) % 4 : undef, fubaopai => (defined $attr{doraHaiUra}) ? [ map { pai($_) } split(',', $attr{doraHaiUra}) ] : undef, defen => $ten[1] + 0, hupai => \@hupai, fenpei => \@sc ); if (@yakuman) { $hule{damanguan} = @yakuman; } else { $hule{fu} = $ten[0] + 0; $hule{fanshu} = $fanshu; } return { hule => \%hule }; }
- l
- 属性 who と変数
$oya
から和了者を設定する。 - shoupai
- 属性 hai、machi、m から手牌を設定する。hai には machi が重複して含まれているので取り除く必要がある。牌番号、面子コードの変換には
pai()
、mianzi()
を使用する。 - baojia
- 属性 fromWho と変数
$oya
から放銃者を設定する。fromWho が和了者自身のときはツモ和了を表すので null を設定する。 - fubaopai
- 属性 doraHaiUra から裏ドラを設定する。
- defen
- 属性 ten から和了打点を設定する。
- hupai
- 属性 yaku、yakuman から和了役、翻数のリストを設定する。yaku、yakuman では和了役は番号で表現されているので
@hupai_name
で定義した役名に置き換える*3。 - fenpei
- 属性 sc から局収支を設定する。
- damanguan
- 属性 yakuman が設定されている場合、役満の複合数を設定する。
- fu
- 属性 yakuman が設定されていない場合、属性 ten から符を設定する。
- fanshu
- 属性 yakuman が設定されていない場合、属性 yaku から総翻数を設定する。
RYUUKYOKU
elsif ($elem eq 'RYUUKYOKU') { push(@$log, pingju(%attr)); }
関数 pingju()
を呼出して属性から流局情報を得る。関数 pingju()
は以下の通り。
my %pingju_name = ( nm => '流し満貫', yao9 => '九種九牌', kaze4 => '四風連打', reach4 => '四家立直', ron3 => '三家和了', kan4 => '四槓散了', ); sub pingju { my %attr = @_; my @sc = map { $_ * 100 } (split(',', $attr{sc}))[1,3,5,7]; my @hai = map { (defined $attr{"hai$_"}) && join(',', pai(split(',', $attr{"hai$_"})), @{$fulou[$_]}) } (0..3); push(@sc, splice(@sc, 0, $oya)); push(@hai, splice(@hai, 0, $oya)); my %pingju = ( name => defined $attr{type} ? $pingju_name{$attr{type}} : '流局', shoupai => \@hai, fenpei => \@sc ); return { pingju => \%pingju }; }
終局情報
if ($attr{owari}) { my @owari = split(',', $attr{owari}); $paipu->{defen} = [ map { $_ * 100 } @owari[0,2,4,6] ]; $paipu->{point} = [ @owari[1,3,5,7] ]; my @rank = (0, 0, 0, 0); for (my $i = 0; $i < 4; $i++) { for (my $j = 0; $j < 4; $j++) { if ($j <= $i) { $rank[($paipu->{qijia} + $i) % 4]++ if ($paipu->{defen}[($paipu->{qijia} + $j) % 4] >= $paipu->{defen}[($paipu->{qijia} + $i) % 4]); } else { $rank[($paipu->{qijia} + $i) % 4]++ if ($paipu->{defen}[($paipu->{qijia} + $j) % 4] > $paipu->{defen}[($paipu->{qijia} + $i) % 4]); } } } $paipu->{rank} = \@rank; }
AGARI もしくは RYUUKYOKU の属性 owari から終局時の持ち点、ウマを含めたポイント数を取得し、牌譜の defen、point にそれぞれ設定する。最終順位は終局時の持ち点から判断し、rank に設定する。
全体のコード
#!/usr/bin/perl -T use strict; use warnings; use JSON qw(to_json); my %type; sub type { my ($type) = @_; $type{demo} = ! (0x0001 & $type); $type{hongpai} = ! (0x0002 & $type); $type{ariari} = ! (0x0004 & $type); $type{dongfeng} = ! (0x0008 & $type); $type{sanma} = (0x0010 & $type); $type{soku} = (0x0040 & $type); $type{level} = (0x0020 & $type) >> 4 | (0x0080 & $type) >> 7; return ($type{sanma} ? '三' : '四') . ('般','上','特','鳳')[$type{level}] . ($type{dongfang} ? '東' : '南') . ($type{ariari} ? '喰' : '') . ($type{hongpai} ? '赤' : '') . ($type{soku} ? '速' : ''); } my @dan_name = ( '新人','9級','8級','7級','6級','5級','4級','3級','2級','1級', '初段','二段','三段','四段','五段','六段','七段','八段','九段','十段', '天鳳位' ); sub url_decode { my ($str) = @_; $str =~ s/%([\da-fA-F]{2})/pack('H2', $1)/ge; return $str; } sub player { my %attr = @_; my @name = map { url_decode($attr{$_}) } ('n0','n1','n2','n3'); my @dan = map { $dan_name[$_] } split(',', $attr{dan}); my @rate = map { int($_) } split(',', $attr{rate}); my @player = map { "$name[$_] ($dan[$_] R$rate[$_])" } (0..3); return \@player; } sub pai { my $pai = ''; my $suit = ''; for (sort {$a<=>$b} @_) { my $s = ('m','p','s','z')[$_/36]; $pai .= $s if ($s ne $suit); $suit = $s; my $n = int($_ % 36 / 4) + 1; $n = 0 if ($type{hongpai} && $s ne 'z' && $n == 5 && $_ % 4 == 0); $pai .= $n; } return $pai; } sub mianzi { my ($m) = @_; my $d = ('','+','=','-')[$m & 0x0003]; if ($m & 0x0004) { my $p = ($m & 0xFC00)>>10; my $r = $p % 3; $p = int($p / 3); my $s = ('m','p','s')[$p/7]; my $n = $p % 7 + 1; my @n = ($n, $n+1, $n+2); my @p = ($m & 0x0018, $m & 0x0060, $m & 0x0180); for (my $i = 0; $i < @n; $i++) { $n[$i] = 0 if ($type{hongpai} && $n[$i] == 5 && $p[$i] == 0); $n[$i] .= $d if ($i == $r); } return $s.join('', @n); } elsif ($m & 0x0018) { my $p = ($m & 0xFE00)>>9; my $r = $p % 3; $p = int($p / 3); my $s = ('m','p','s','z')[$p/9]; my $n = $p % 9 + 1; my @n = ($n, $n, $n, $n); if ($type{hongpai} && $s ne 'z' && $n == 5) { if (($m & 0x0060) == 0) { $n[3] = 0 } elsif ($r == 0) { $n[2] = 0 } else { $n[1] = 0 } } return ($m & 0x0010) ? $s.join('', @n[0,1,2]).$d.$n[3] : $s.join('', @n[0,1,2]).$d; } else { my $p = ($m & 0xFF00)>>8; my $r = $p % 4; $p = int($p / 4); my $s = ('m','p','s','z')[$p / 9]; my $n = $p % 9 + 1; my @n = ($n, $n, $n, $n); if ($type{hongpai} && $s ne 'z' && $n == 5) { if ($d eq '') { $n[3] = 0 } elsif ($r == 0) { $n[3] = 0 } else { $n[2] = 0 } } return $s.join('', @n).$d; } } sub qipai { my %attr = @_; my @seed = split(',', $attr{seed}); my @ten = map { $_ * 100 } split(',', $attr{ten}); my @hai = map { pai(split(',', $attr{"hai$_"})) } (0..3); push(@ten, splice(@ten, 0, $attr{oya})); push(@hai, splice(@hai, 0, $attr{oya})); my %qipai = ( zhuangfeng => int($seed[0] / 4), jushu => $seed[0] % 4, changbang => $seed[1] + 0, lizhibang => $seed[2] + 0, defen => \@ten, baopai => pai($seed[5]), shoupai => \@hai ); return { qipai => \%qipai }; } my $oya; my @hupai_name = ( '門前清自摸和', '立直', '一発', '槍槓', '嶺上開花', '海底摸月', '河底撈魚', '平和', '断幺九', '一盃口', '自風 東', '自風 南', '自風 西', '自風 北', '場風 東', '場風 南', '場風 西', '場風 北', '役牌 白', '役牌 發', '役牌 中', '両立直', '七対子', '混全帯幺九', '一気通貫', '三色同順', '三色同刻', '三槓子', '対々和', '三暗刻', '小三元', '混老頭', '二盃口', '純全帯幺九', '混一色', '清一色', '', '天和', '地和', '大三元', '四暗刻', '四暗刻単騎', '字一色', '緑一色', '清老頭', '九蓮宝燈', '純正九蓮宝燈', '国士無双', '国士無双13面', '大四喜', '小四喜', '四槓子', 'ドラ', '裏ドラ', '赤ドラ', ); sub hule { my %attr = @_; $attr{m} .= ''; $attr{yaku} .= ''; $attr{yakuman} .= ''; my @ten = split(',', $attr{ten}); my @sc = map { $_ * 100 } (split(',', $attr{sc}))[1,3,5,7]; my @yaku = split(',', $attr{yaku}); my @yakuman = split(',', $attr{yakuman}); push(@sc, splice(@sc, 0, $oya)); my (@hupai, $fanshu); if (@yakuman) { for (@yakuman) { push(@hupai, { name => $hupai_name[$_], fanshu => '*' }); } } else { for (my $i = 0; $i < @yaku; $i += 2) { push(@hupai, { name => $hupai_name[$yaku[$i]], fanshu => $yaku[$i+1] + 0 }); $fanshu += $yaku[$i+1]; } } my %hule = ( l => ($attr{who} + 4 - $oya) % 4, shoupai => join(',', pai(grep { $_ ne $attr{machi} } split(',', $attr{hai})) . pai($attr{machi}), reverse map { mianzi($_) } split(',', $attr{m})), baojia => ($attr{who} ne $attr{fromWho}) ? ($attr{fromWho} + 4 - $oya) % 4 : undef, fubaopai => (defined $attr{doraHaiUra}) ? [ map { pai($_) } split(',', $attr{doraHaiUra}) ] : undef, defen => $ten[1] + 0, hupai => \@hupai, fenpei => \@sc ); if (@yakuman) { $hule{damanguan} = @yakuman; } else { $hule{fu} = $ten[0] + 0; $hule{fanshu} = $fanshu; } return { hule => \%hule }; } my @fulou; my %pingju_name = ( nm => '流し満貫', yao9 => '九種九牌', kaze4 => '四風連打', reach4 => '四家立直', ron3 => '三家和了', kan4 => '四槓散了', ); sub pingju { my %attr = @_; my @sc = map { $_ * 100 } (split(',', $attr{sc}))[1,3,5,7]; my @hai = map { (defined $attr{"hai$_"}) && join(',', pai(split(',', $attr{"hai$_"})), @{$fulou[$_]}) } (0..3); push(@sc, splice(@sc, 0, $oya)); push(@hai, splice(@hai, 0, $oya)); my %pingju = ( name => defined $attr{type} ? $pingju_name{$attr{type}} : '流局', shoupai => \@hai, fenpei => \@sc ); return { pingju => \%pingju }; } my $paipu = {}; my $log; my $zimo; my $gang; my $lizhi; for (join('', <>) =~ /<.*?>/g) { my ($elem, $attr) = /^<(\/?\w+)(.*?)\/?>$/; my %attr = $attr ? ($attr =~ /\s+(\w+)="(.*?)"/g) : (); if ($elem eq 'mjloggm') { warn "*** Unknown version $attr{ver}\n" if ($attr{ver} ne '2.3'); } elsif ($elem eq 'GO') { $paipu->{title} = type($attr{type}); die "+++ Not Majiang log\n" if ($type{sanma}); } elsif ($elem eq 'UN' && ! $paipu->{player}) { $paipu->{player} = player(%attr); } elsif ($elem eq 'TAIKYOKU') { $paipu->{qijia} = $attr{oya} + 0; $paipu->{log} = []; } elsif ($elem eq 'INIT') { @fulou = ( [], [], [], [] ); $oya = $attr{oya}; $log = [ qipai(%attr) ]; push(@{$paipu->{log}}, $log); } elsif ($elem =~ /^([TUVW])(\d+)$/) { my $l = (ord($1) - ord('T') + 4 - $oya) % 4; my $p = pai($2); if ($gang) { push(@$log, { gangzimo => { l => $l, p => $p} }); } else { push(@$log, { zimo => { l => $l, p => $p} }); } $zimo = $2; undef $gang; } elsif ($elem =~ /^([DEFG])(\d+)$/) { my $l = (ord($1) - ord('D') + 4 - $oya) % 4; my $p = pai($2); $p .= '_' if ($2 eq $zimo); $p .= '*' if ($lizhi); push(@$log, { dapai => { l => $l, p => $p} }); undef $lizhi; } elsif ($elem eq 'N') { my $l = ($attr{who} + 4 - $oya) % 4; my $m = mianzi($attr{m}); if ($m =~ /^[mpsz]\d{4}$/ || $m =~ /^[mpsz]\d{3}[\-\+\=]\d$/) { push(@$log, { gang => { l => $l, m => $m } }); $gang = 1; } else { push(@$log, { fulou => { l => $l, m => $m } }); if ($m =~ /^[mpsz]\d{4}[\-\+\=]$/) { $gang = 1 } else { $zimo = '' } } push(@{$fulou[$attr{who}]}, $m); } elsif ($elem eq 'DORA') { push(@$log, { kaigang => { baopai => pai($attr{hai}) } }); } elsif ($elem eq 'REACH' && $attr{step} == 1) { $lizhi = 1; } elsif ($elem eq 'AGARI') { push(@$log, hule(%attr)); } elsif ($elem eq 'RYUUKYOKU') { push(@$log, pingju(%attr)); } if ($attr{owari}) { my @owari = split(',', $attr{owari}); $paipu->{defen} = [ map { $_ * 100 } @owari[0,2,4,6] ]; $paipu->{point} = [ @owari[1,3,5,7] ]; my @rank = (0, 0, 0, 0); for (my $i = 0; $i < 4; $i++) { for (my $j = 0; $j < 4; $j++) { if ($j <= $i) { $rank[($paipu->{qijia} + $i) % 4]++ if ($paipu->{defen}[($paipu->{qijia} + $j) % 4] >= $paipu->{defen}[($paipu->{qijia} + $i) % 4]); } else { $rank[($paipu->{qijia} + $i) % 4]++ if ($paipu->{defen}[($paipu->{qijia} + $j) % 4] > $paipu->{defen}[($paipu->{qijia} + $i) % 4]); } } } $paipu->{rank} = \@rank; } } print to_json($paipu);