jug7.com - rt.cgi ソース

jug7.com
[ home / cgi / juggler / column / diary / bbs / link / welcome ]
source ：平均RT解除プレイ数の計算

#!/usr/bin/perl
# 平均RT解除プレイ数の計算

$cginame  = 'rt.cgi';
$title    = '平均RT解除プレイ数の計算';

print "Content-Type: text/html\n\n";

if ($ENV{'REQUEST_METHOD'} eq 'POST') {
    read (STDIN, $input, $ENV{'CONTENT_LENGTH'});
}

foreach $str (split(/&/,$input) ) {
    ($name,$value) = split(/=/, $str);
    $value =~ s/%0D%0A/\n/g;
    $value =~ s/\+/ /g;
    $value =~ s/%2C/,/g;
    push(@input, $value);
}
($data, $sub, $denom, $start, $sp_rel) = @input;

$start = 0 if !$start;
$sub[0] = 'checked' if $sub==0;
$sub[1] = 'checked' if $sub==1;

# ヘッダとフォームの表示
print <<"__ HTML __";
<!DOCTYPE html PUBLIC '-//W3C//DTD HTML 4.01 Transitional//EN'>
<html lang='ja'>
<head>
<meta http-equiv='Content-Type' content="text/html; charset=shift_jis">
<title>jug7.com - cgi $title</title>
 <style type="text/css"> <!--
   A:hover {color:#ff0000;}
 --></style>
</head>
<body text='#000000' bgcolor='#ffffff' link='#0000ff' alink='#ff0000' vlink='#0000cc'>
<font size=7><b><font face='Times New Roman,Times'>jug</font><font face='Bookman Old Style,arial black,Helvetica Black'>7</font><font face='Times New Roman,Times'>.com</font></b></font>
<hr color='#00aa00'>

<strong>[ <a href='../index.html'>home</a> / <a href='index.html'>cgi</a> / <a href='../jug/index.html'>juggler</a> / <a href='../column.html'>column</a> / <a href='../diary/index.html'>diary</a> / <a href='bbs.cgi'>bbs</a> / <a href='../link.html'>link</a> / <a href='../intro.html'>welcome</a> ]</strong>
<div align='center'><h2>$title</h2></div>
<hr width='70%'>
<div align='right'>[ <a href='rt_memo.html'>memo</a> / <a href='rt.html'>source</a> ]</div>
<center>
<form action='$cginame' method='POST'>
RT テーブル振り分け<br><textarea name='data' rows=8 cols=30 value='$data'></textarea><br><br>
<table border=1 cellspacing=0>
<tr><td><input type='radio' name='sub' value=0 $sub[0]></td><td>　% で記入。</td></tr>
<tr><td><input type='radio' name='sub' value=1 $sub[1]></td><td>分母を <input type='text' name='denom' size=8 maxlength=5 value='$denom'> と<br>した場合の分子を記入。</td></tr>
</table>
<br>
<table border=0><tr><td>
開始プレイ数　カウンタ <input type='text' name='start' size=5 maxlength=4 value='$start'>　から開始。<br>
特定役解除確率 1/ <input type='text' name='sp_rel' size=5 maxlength=6 value='$sp_rel'> （前兆は考慮せず）<br><br>
</td></tr></table>
<input type='submit' value="送信">
</form></center>

<table border=1 cellspacing=0 align='center'>
<caption><b>入力の仕方</b></caption>
<tr valign='top'><td>
入力は全て<font color='red'>半角</font>。<br><br>
<b>RTテーブル振り分けの記入方法</b><br>
<font color='red'><b>128-256 7.813</b></font> のように記入。<br>
上の例なら 128P ～ 256P までの振り分けが<br>7.813 % ということ（桁数は任意）。<br>
<br>
開始プレイ数を記入すると、<br>
そこからの平均RT解除プレイ数を計算する。<br>
<br>
特定役解除確率を記入すると、<br>
毎ゲームにおいて、途中解除を考慮した場合の<br>
平均RT解除プレイ数を計算する。
</td><td>
キングパルサー 設定1　の入力例
<table border=1 cellspacing=0>
<tr valign='top' align='center'><td>
RT振り分けを % で記入。<br>
<table border=1 cellspacing=0>
<caption align='bottom'>% 記載の小数点は任意の桁数</caption>
<tr><td><pre>
1-8 4.297
9-16 10.938
17-24 13.281
25-32 11.719
33-40 6.25
41-48 4.688
49-64 7.813
65-80 5.078
81-96 3.125
97-127 5.078
128 0
129-256 7.813
257-512 5.469
513-768 4.297
769-1024 5.078
1025-1279 5.078</pre>
</td></tr>
</table>

</td><td>
RT振り分けを乱数で記入。<br>
<table border=1 cellspacing=0>
<caption align='bottom'>分母は 256</caption>
<tr><td><pre>
1-8 11
9-16 28
17-24 34
25-32 30
33-40 16
41-48 12
49-64 20
65-80 13
81-96 8
97-127 13
128 0
129-256 20
257-512 14
513-768 11
769-1024 13
1025-1279 13</pre>
</td></tr>
</table>

</td></tr></table>

</td></tr></table>
</center><br><br>
__ HTML __

# エラーチェックとGET送信
if (!$data) { $error = 1; $er_msg = '記入漏れがあります。'; }
if ($data =~ /[^ \d+\.\n,\-]/) { $error = 1; $er_msg = '不適切な文字が入力されています。'; }
if ($sp_rel =~ /[^\d+\.]/) { $error = 1; $er_msg = '不適切な文字が記入されています。'; }
if (grep { /[^\d]/ } ($sub, $denom, $start)) { $error = 1; $er_msg = '不適切な文字が記入されています。'; }
if (( @list = $data=~ /\n/g) >= 200) { $error = 1; $er_msg = '200行以上のデータは受けつけないようにしています。'; }
if ($ENV{'REQUEST_METHOD'} ne 'POST') { $error = 1; $er_msg = 0; }
if ($er_msg) {
    print q{<center><b><font color='red' size=4>*** ERROR !! ***</font><br><br>},"\n";
    print "$er_msg</b></center>\n";
}
if ($error) {
    print '<br><br><br><br><br>';
    print q{<div align='right'>[ <a href='rt_memo.html'>memo</a> / <a href='rt.html'>source</a> ]</div>};
    print q{<strong>[ <a href='../index.html'>home</a> / <a href='index.html'>cgi</a> / <a href='../jug/index.html'>juggler</a> / <a href='../column.html'>column</a> / <a href='../diary/index.html'>diary</a> / <a href='bbs.cgi'>bbs</a> / <a href='../link.html'>link</a> / <a href='../intro.html'>welcome</a> ]</strong>};
    print '</body></html>';
    exit;
}

#-----------
# 計算開始
#-----------

@data =  split(/\n/, $data);
for (@data) {
    ($play, $block) = split(/ /, $_);
    ($st_play, $end_play) = split(/-/, $play);
    push(@st_play, $st_play);
    push(@end_play, $end_play);
    push(@block, $block);
}

# 振り分けを 100 （分母）に調整
$string = ($sub==0) ? 100 : $denom;
for (@block) { $total += $_; }
$control = $string/$total;
for (@block) {
    $_ *= $control;
    if ($sub==1) { $_ = $_/$denom *100; } # % へ変換
    push(@block2, $_);
}

for ($i=0; $i<=$#st_play; $i++) {
    if ($end_play[$i]) { $str[$i] = $block2[$i]/($end_play[$i]-$st_play[$i]+1) * 1/100; }
    else { $str[$i] = $block2[$i] * 1/100; $end_play[$i] = $st_play[$i]; } # RT振り分けの要素が一つのみ

    for ($j=$st_play[$i]; $j<=$end_play[$i]; $j++) {
        push(@list, "$j:$str[$i]");
    }
}

# プレイ数ごとに振り分け確率をまとめて、重複要素を削除する
@list = sort { $a <=> $b } @list;
$i=0;
while ($list[$i]) {
    ($str_play, $str_prob) = split(/:/, $list[$i]);
    for ($j=$i+1; $j<=$#list; $j++) {
        ($str_play2, $str_prob2) = split(/:/, $list[$j]);
        if ($str_play ne $str_play2) { last; } else {
            $str_prob += $str_prob2;
            splice(@list, $j,1); $j--;
        }
    }
    if ($str_prob) { push(@new_list, "$str_play:$str_prob"); }
    $i++;
}

# 開始プレイ数が存在する場合、開始後のみで 100% となるように振り分け確率を調整する
$loss = 0;
for ($i=0; $i<=$#new_list; $i++) {
    ($m_play, $m_prob) = split(/:/, $new_list[$i]);  # $m_play プレイ数, $m_prob 振り分け
    if ($m_play <= $start) { $loss += $m_prob; next; }
}
if ($loss) {
    for ($i=0; $i<=$#new_list; $i++) {
        ($m_play, $m_prob) = split(/:/, $new_list[$i]);
        if ($m_play <= $start) { next; }

        $loss_per = 1/(1-$loss);
        $m_prob  *= $loss_per;
        $str2     = $m_play . ':' . $m_prob;
        push(@new_list2, $str2);
    }
    @table = @new_list2;
} else {
    @table = @new_list;
}

# 平均RT解除プレイ数を計算

# 特定役解除が存在しない場合
if (!$sp_rel) {
    for ($i=0; $i<=$#table; $i++) {
        ($m_play, $m_prob) = split(/:/, $table[$i]);
        if ($m_play <= $start) { next; }

        $ave_play += $m_play * $m_prob;
    }
    $ave_play2 = $ave_play - $start;

} else { # 特定役解除が存在する場合
    $def_sp_rel = $sp_rel;
    $sp_rel = 1/$sp_rel;

    for ($i=0; $i<=$#table; $i++) {
        ($m_play[$i], $m_prob[$i]) = split(/:/, $table[$i]);
    }
    for ($i=0; $i<=$#table; $i++) {
        if ($m_play[$i] <= $start) { next; }

        # 特定役解除を考慮して計算
        $first =  $m_prob[$i] * (1-$sp_rel)**$i;
        $sp2  = 0;
        for ($j=$i+1; $j<=$#table; $j++) {
            $sp[$j] = $m_prob[$j] * (1-$sp_rel)**$i * $sp_rel;
            $sp2   += $sp[$j];
        }
        $play_rel = $m_play[$i] * ($first + $sp2);
        push(@sprel, $play_rel);
    }
    for (@sprel) { $ave_play += $_; }
    $ave_play2 = $ave_play - $start;
}

# 結果の表示
$ave_play  = &point($ave_play, 3);
$ave_play2 = &point($ave_play2,3);

print "<center><b>";
print "***** 計算結果 *****<br><br>";
print "カウンタ <font color='red'>$start P</font> から打ち始めた時の平均RT解除プレイ数は<br><br>";
print "<font size=4 color='red'>$ave_play P ( $ave_play2 P 消化 )";
print "</b></font></center>";


# 入力データの表示
($data2 = $data) =~ s/\n/<br>/g;
print <<"__ DATA __";
<br><br>
<table border=1 cellspacing=0 align='center'>
<caption>入力データ</caption>
<tr><td>
$data2
</td></tr>
</table>
__ DATA __


# 再試行
print <<"__ RE __";
<br><br><br>
<form action='$cginame' method='POST'>
<input type='hidden' name='data' value='$data'>
<input type='hidden' name='sub' value='$sub'>
<input type='hidden' name='denom' value='$denom'>
<center>
開始プレイ数　<input type='text' name='start' size=5 maxlength=4 value='$start'> P<br>
特定役解除確率 1/ <input type='text' name='sp_rel' size=5 maxlength=6 value='$def_sp_rel'><br><br>
<input type='submit' value='再試行'><br>
<font size=2>（RTテーブル振り分けを貼\り付ける必要は無し）</font>
</center>
</form>
__ RE __




# フッタ
print <<"__ HTML __";
<br><br><br>
<div align='right'>[ <a href='rt_memo.html'>memo</a> / <a href='rt.html'>source</a> ]</div>
<strong>[ <a href='../index.html'>home</a> / <a href='index.html'>cgi</a> / <a href='../jug/index.html'>juggler</a> / <a href='../column.html'>column</a> / <a href='../diary/index.html'>diary</a> / <a href='bbs.cgi'>bbs</a> / <a href='../link.html'>link</a> / <a href='../intro.html'>welcome</a> ]</strong>
</body></html>
__ HTML __

exit;

# 少数を四捨五入して指定の桁にする
sub point {
    my($value, $fig, $x);
    ($value, $fig) = @_;

    $value = int($value * (10 ** $fig) + 0.5) / (10 ** $fig);
    if ($value =~ /(\d+)\.(\d+)/) { $x = $2; }
    elsif ($value !~ /\./)        { $x =''; $value .= '.'; }
    $value = $value.'0' x ( $fig - length($x) );
    return $value;
}
[ home / cgi / juggler / column / diary / bbs / link / welcome ]
source ： 平均RT解除プレイ数の計算

source ：平均RT解除プレイ数の計算
