このブログを検索

2013/04/29

sedでファイルを更新する

sedで置換などを行う時、対象のファイルを直接更新したいときは -i のオプションをつける。
つけないと、標準出力に表示されるのみで元のファイルは変更されない。
では、元のファイルにリダイレクトすればいいのではないか?
ハイフンi をつけた時と同じ結果になるように思える。
・・・
これも考えても仕方がないのでやってみた。
結果は、「元のファイルにリダイレクトすると中身が全部消える」
であった。
これも衝撃の事実だ。
なんでそうなるのだろう・・・?

# cat x.txt
i love cats.
#
# sed s/cat/dog/ x.txt
i love dogs.
#
#
# sed s/cat/dog/ x.txt > x.txt
#
# cat x.txt
#
#
# vi x.txt
#
# cat x.txt
i love cats.
#
# sed -i s/cat/dog/ x.txt
# cat x.txt
i love dogs.
#

2013/04/28

ハードリンクを削除したらリンク先のファイルは削除されるか?

「消えるにきまってんじゃん。そうじゃなかったらシンボリックリンクとハードリンクの区別がなくなるだろ?」
と思っていた。

しかし、よく考えると、「じゃあ、ハードリンクを作成した後で、リンクだけを削除するにはどうすればよいのか?」
という問いに答えが見つからない。

・・・・

考えても仕方がないので、実際にやってみた。
結果は、「ハードリンクを削除しても、リンク先のファイルは削除されない」となった。
これは衝撃の事実である。
「ハードリンクを削除したらリンク先も削除される」と思っている人は多いはずだ。

# ls txt
a.txt  a2.txt  a3.txt  b.txt  c.txt  ex.txt  logall.txt  p.txt  x.txt  x1.txt  x2.txt
#
# ls
a.tar  bu.pl  logall  logall.gz  main.cgi  txt  unko
#
# ln ./txt/a.txt anohardlink1
# ln ./txt/a.txt anohardlink2
#
# ls
a.tar  anohardlink1  anohardlink2  bu.pl  logall  logall.gz  main.cgi  txt  unko
# ls ./txt/
a.txt  a2.txt  a3.txt  b.txt  c.txt  ex.txt  logall.txt  p.txt  x.txt  x1.txt  x2.txt
#
# rm anohardlink1
rm: remove 通常ファイル `anohardlink1'? y
# ls
a.tar  anohardlink2  bu.pl  logall  logall.gz  main.cgi  txt  unko
# ls ./txt/
a.txt  a2.txt  a3.txt  b.txt  c.txt  ex.txt  logall.txt  p.txt  x.txt  x1.txt  x2.txt
#
#
# rm anohardlink2
rm: remove 通常ファイル `anohardlink2'? y
# ls
a.tar  bu.pl  logall  logall.gz  main.cgi  txt  unko
# ls ./txt/
a.txt  a2.txt  a3.txt  b.txt  c.txt  ex.txt  logall.txt  p.txt  x.txt  x1.txt  x2.txt
#

debianでrunlevelを変更する

LPICの勉強をしていたらapt-getとかdpkgとか聞いたことのないコマンドが出てきたので、debianをインストールした。

そして、telinitでrunlevelを変更できるという事を知ったので試してみたのだが、変更できない。

telinit 3 でテキストログインになるところが、GUIログインのままなのだ。

検索してみると、debianではrunlevel 2~5は同じ扱いになることを知った。

teiinit 2とするとテキストログインになった。しかしシングルモードなので外からsshとかができない。

2013/04/20

2枚交換する(改)

(残した札がペアになる組合せ数)= s1
または
(交換した2枚がペアになる組合せ数)= s2

s1とs2は同時には成立しない。

s1= 3 * COMBIN(3,1) * 46
s2= COMBIN(4,2)*10

2枚交換する組合せ数 b は
b = combin(47,2)

確率は ( s1 + s2 ) / b ≒ 0.438482886


(2020/7/19 追記)
読み返してみるとよくわからないが間違っていそうなので再計算結果を記す。

1. 交換した2枚がペアになる
2. 交換した2枚のうちどちらかあるいは両方が手札とペアになる

1、2については両方同時に成立しうる。
少なくともこれについては、最初に書いたのが間違いである。

交換した2枚がペアになりさらにそれが残した札のどれかとペアになる、
つまりスリーカードができる場合である。

まず、47枚のなかから2枚選ぶ組み合わせは、
Permut(47,2)=2162

「1. 交換した2枚がペアになる」場合の数であるが、
残ったカードは残り3枚のものが5種類(Aグループとする)、4枚のものが8種類(Bグループとする)ある。

Aグループは、Permut(15,2)=210
Bグループは、Permut(32,2)=992
合計 1202

「2.手札とペアになる」
手札とペアになれるカードは、残り3枚の3種類(Cグループとする)で9枚なので
Permut(9,2)=72

「3.スリーカードになる」
スリーカードになれるのはCグループ。

Cグループのうちのある種類のカードについて
C1,C2,C3とすると、これが2枚同じ種類になるのは
(C1,C2), (C1,C3),(C2,C3) とその並びが逆の6パターン
これが3種類あるから、18パターン

よって、2枚交換で少なくともワンペアができるパターンは、

1202 + 72 - 18 = 1202 + 54 = 1256

確率は

1256 / 2162 ≒ 0.580944


1枚交換より2枚交換のほうが断然ワンペアができやすい。

これは3枚、4枚、5枚も再考しないと....










1枚だけ交換する

例によって簡単なところから考えていく。

一番計算しやすいのは、4枚残して1枚交換する場合。

52枚から5枚配ったので残りは47枚。

そこから1枚選ぶのだから選び方の数は47通り。

残した4枚の札は役なし、つまり、すべて違う札であるから、
ワンペアができる札は、3x4=12枚あるので、
ワンペアができる確率は 12/47≒0.2553191

ポーカーで何枚の札を交換するべきか

ポーカーで最初に配られた5枚の札で役が何もなかったとき、何枚交換するのが得だろうか?

たまにポーカーのゲームで遊ぶとき、私は最も大きい札を1枚残して4枚取り替えるようにしている。

そのたびに、いつも思い出すことがある。

会社で昼休みにポーカーをしていて最初の5枚で役がなくて、いつものように1枚残して4枚交換すると、

横で見ていた先輩が、「2枚残した方がいいんじゃないの?」と言ったことである。

私は確たる根拠があって1枚残しているわけではなかったのだが、

何となく4枚交換するのが少なくともワンペアを作るには一番得策ではないかと、直感的に思っていた。

ちゃんと計算してみよう。

本来であればワンペアより大きい役が出る確率とか、同じ役だったら札が大きい方が強いとか、自分以外のプレイヤーの存在などを考えるべきだが、

まずは、「ワンペアのみができやすいのは1から5枚の何枚を交換したときか」として考えてみる。

ジョーカーは含めないとする。

私は4枚交換が一番できやすいと思う。残す札を増やせば、ワンペアとなる候補が増えるが、その候補を選ぶチャンスも減らすことになる。

もしかしたら2枚残しの方が得かもしれないとも思うが、3枚残し、4枚残しが得であることはないと思う。

これはあくまでも私の直感である。

これからそれを確かめる。

2013/04/14

色対応

できた。
配牌はスペースで区切って指定する。 昨日直したときの修正ミスがあったのでそれもなおす。
use strict;
use warnings;

if($#ARGV < 0){
    print "please specify haipai.\n";
    exit;
}

#my @haipai = sort split / /, shift;
my @haipai = sort @ARGV;

if($#haipai != 12){
    print "please specify 13 pies.\n";
    exit;
}
my @menz;

my %tenpai;

my $menz_count = 0;
my $head_count = 0;
my $tenpai_count = 0;
my $not_menz = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

@menz=();
$not_menz = 0;
$head_count = 0;

&select_menz([@haipai],[@menz],"");

#七対子
&chitoi([@haipai]);

# 結果表示
foreach my $name (sort keys %tenpai){
    $tenpai_count++;
    print "$tenpai_count : $name\n";
}


#アタマを選んだ後、メンツを選ぶ
sub select_head{
    my @haipai = @{ $_[0] };

    my ($i, $j);

    $head_count++;

    for($i=0;$i <= $#haipai - 1;$i++){
        for($j=$i+1;$j <= $#haipai;$j++){
            if(&is_menz($haipai[$i],$haipai[$j])==3){
                my $atama = "<".$haipai[$i].$haipai[$j].">";
#               print $atama."\n";

                my @menz;
#選んだ牌を消す
                my @new_haipai = @haipai;
                $new_haipai[$i]="0";
                $new_haipai[$j]="0";

                @new_haipai = grep { $_ ne "0" } @new_haipai;
#残ったパイからメンツを選ぶ
                &select_menz([@new_haipai], [@menz], $atama);
            }
        }
    }
}


sub select_menz{
    my @haipai = @{ $_[0] };
    my @menz = @{ $_[1] };
    my $atama = $_[2];

    my ($i,$j, $k);

# 牌の残りが2枚以下
    if($#haipai < 2){
# アタマあり
        if($head_count > 0) {
#メンツが3個以上
            if($#menz > 1){
#残りの牌がターツかトイツ
                if(&is_menz(@haipai)>0){
                    my @sorted = sort @menz;
                    my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
                    &tenpai_check($tenpai);
                }
            }
            return;
# アタマなし
        }else{
#メンツが4個以上
            if($#menz > 2){
                my @sorted = sort @menz;
                my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
                &tenpai_check($tenpai);
            }
            return;
        }
    }


    for($i=0;$i<= $#haipai - 2;$i++){
        for($j=$i+1;$j<= $#haipai - 1;$j++){
            for($k=$j+1;$k<= $#haipai;$k++){

                my @new_menz = @menz;

                if(&is_menz($haipai[$i], $haipai[$j], $haipai[$k]) > 0) {
                    push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
                }else{
#メンツにならなかったらカウント
                    $not_menz++;
                }
#アタマありの場合非メンツが2つ、なしの場合1つあれば探索中止

                if(($head_count == 0 && $not_menz > 0) ||
                ($head_count > 0  && $not_menz > 1)) {
                    $not_menz = 0;
                    last;
                }else{
#選んだパイを削除
                    my @new_haipai = @haipai;
                    $new_haipai[$i]="0";
                    $new_haipai[$j]="0";
                    $new_haipai[$k]="0";

                    @new_haipai = grep { $_ ne "0" } @new_haipai;

#再帰呼び出しで残り牌からメンツを選ぶ
                    &select_menz([@new_haipai], [@new_menz], $atama);

                }
            }
        }
    }
}

sub chitoi{
    my @haipai = @{ $_[0] };

    my $i = 0;
    my @menz;

    $menz_count = 0;

    while($i<$#haipai){
        if(&is_menz($haipai[$i], $haipai[$i+1]) == 3){
            push @menz,"(".$haipai[$i].$haipai[$i+1].")";
            $menz_count++;
            if($i==$#haipai-2){
                push @menz,"[".$haipai[$#haipai]."]";
            }
            $i+=2;
        }else{
            push @menz,"[".$haipai[$i]."]";
            $i++;
        }
    }

    if($menz_count>5){
        my $tenpai = join("",@menz);
        &tenpai_check($tenpai);
    }
}


#重複した聴牌形をハッシュでチェック
sub tenpai_check{
    my ($tenpai) = @_;
#   print "tenpai check :$tenpai\n";
    $tenpai{$tenpai}++;
}

#余り牌がターツあるいはトイツであるかをチェック
sub amari_check{
    my @haipai = @{ $_[0] };

    if($haipai[0] == $haipai[1]){
        return 1;
    }
    if($haipai[0]+1 == $haipai[1]){
        return 1;
    }
    if($haipai[0]+2 == $haipai[1]){
        return 1;
    }
}

sub is_menz{
    my @pais = @_;

#   print "pais:@pais\n";

    if($#pais == 1){
        if($pais[0] eq $pais[1]){
            return 3;
        } elsif(substr($pais[0],0,1) eq substr($pais[1],0,1) && (substr($pais[0],0,1) ne "x")){
            if(substr($pais[0],1,1)+1 == substr($pais[1],1,1)){
                return 4;
            }elsif(substr($pais[0],1,1)+2 == substr($pais[1],1,1)){
                return 5;
            }else{
                return 0;
            }
        }else{
            return 0;
        }
    }

    if($pais[0] eq $pais[1] && $pais[0] eq $pais[2]){
        return 2;
    }elsif(substr($pais[0],0,1) eq substr($pais[1],0,1) && substr($pais[0],0,1) eq substr($pais[2],0,1) && (substr($pais[0],0,1) ne "x")){
        if(substr($pais[0],1,1)+1 == substr($pais[1],1,1) && substr($pais[0],1,1)+2 == substr($pais[2],1,1)){
            return 1;
        }else{
            return 0;
        }
    }else{
        return 0;
    }
}
実行結果
# perl menx.pl m1 m2 m3 p1 p2 p3 s3 s4 s5 s6 s7 x1 x1
haipai: m1 m2 m3 p1 p2 p3 s3 s4 s5 s6 s7 x1 x1
1 : (m1m2m3)(p1p2p3)(s3s4s5)[s6s7]
2 : (m1m2m3)(p1p2p3)(s5s6s7)[s3s4]

2013/04/13

色対応の検討



麻雀聴牌判定プログラムは、一色限定版である。


だが、一色でできてしまえば、あとは牌が同一あるいは連続であるかを判定するときに色も見ればよい。


簡単そうだが、色をどうやってもたせるべきだろうか?


そもそも私は最初は色つきでやろうとしていたのだが、


調べていくうちに一色限定で判定するというコンテストのようなものを見つけ、


それをまずやってみた。


私が最初にやろうとしたのは、


マンズ: m1, m2 ... m9


ピンズ: p1, p2 ... p9


ソーズ: s1, s2 ... s9


字牌:x1, x2 ... x7


として、比較する時は牌データの1文字目で色を、2文字目で数字を見る、


というものであった。


substr関数を使うとか、正規表現を使うとかすればよいだろう。


クラスを使うのはどうだろうか?


$pai->color で色を、$pai->number で数字にアクセスできれば、


判定がわかりやすく簡単に書けそうだ。


でもこのくらいであれば、上記のフォーマットにして「同じか」「連続しているか」


などをサブルーチンにするだけでよいかもしれない。





2013/04/12

七対子対応



最初は、通常のテンパイ判定を改造して、3つ選ぶのを2枚にして、メンツの数は5つにして・・・とやったのだが、なぜかうまくいかなかった。


配牌はソートしているから隣と同じでなければ即非メンツに判定できることに気づいて、別途作った。


あとはループのさせ方がちょっと変だったのでなおしたら、1秒くらいで判定するようになった。



use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = sort split //, shift;

if($#haipai != 12){
print "please specify 13 pies.\n";
exit;
}
my @menz;

my %tenpai;

my $menz_count = 0;
my $head_count = 0;
my $tenpai_count = 0;
my $not_menz = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

@menz=();
$not_menz = 0;
$head_count = 0;

&select_menz([@haipai],[@menz],"");

#七対子
&chitoi([@haipai]);

# 結果表示
foreach my $name (sort keys %tenpai){
$tenpai_count++;
print "$tenpai_count : $name\n";
}


#アタマを選んだ後、メンツを選ぶ
sub select_head{
my @haipai = @{ $_[0] };

my ($i, $j);

$head_count++;

for($i=0;$i <= $#haipai - 1;$i++){
for($j=$i+1;$j <= $#haipai;$j++){
if($haipai[$i] == $haipai[$j]){
# print "$head_count: <".$haipai[$i].$haipai[$j].">\n";
my $atama = "<".$haipai[$i].$haipai[$j].">";
my @menz;
#選んだ牌を消す
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;
#残ったパイからメンツを選ぶ
&select_menz([@new_haipai], [@menz], $atama);
}
}
}
}


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };
my $atama = $_[2];

my ($i,$j, $k);

# 牌の残りが2枚以下
if($#haipai < 2){
# アタマあり
if($head_count > 0) {
#メンツが3個以上
if($#menz > 1){
#残りの牌がターツかトイツ
if(&amari_check([@haipai])>0){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
&tenpai_check($tenpai);
}
}
return;
# アタマなし
}else{
#メンツが4個以上
if($#menz > 2){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
&tenpai_check($tenpai);
}
return;
}
}


for($i=0;$i<= $#haipai - 2;$i++){
for($j=$i+1;$j<= $#haipai - 1;$j++){
for($k=$j+1;$k<= $#haipai;$k++){

my @new_menz = @menz;

if($haipai[$i]+1 == $haipai[$k]){
$not_menz++;
}elsif(($haipai[$i] == $haipai[$j] && $haipai[$j] == $haipai[$k]) ||
($haipai[$i]+1 == $haipai[$j] && $haipai[$j]+1 == $haipai[$k])){
push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
}else{
#メンツにならなかったらカウント
$not_menz++;
}
#アタマありの場合非メンツが2つ、なしの場合1つあれば探索中止

if(($head_count == 0 && $not_menz > 0) ||
($head_count > 0 && $not_menz > 1)) {
$not_menz = 0;
last;
}else{
#選んだパイを削除
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#再帰呼び出しで残り牌からメンツを選ぶ
&select_menz([@new_haipai], [@new_menz], $atama);

}
}
}
}
}

sub chitoi{
my @haipai = @{ $_[0] };

my $i = 0;
my @menz;

$menz_count = 0;

while($i<$#haipai){
if($haipai[$i] == $haipai[$i+1]){
push @menz,"(".$haipai[$i].$haipai[$i+1].")";
$menz_count++;
if($i==$#haipai-2){
push @menz,"[".$haipai[$#haipai]."]";
}
$i+=2;
}else{
push @menz,"[".$haipai[$i]."]";
$i++;
}
}

if($menz_count>5){
my $tenpai = join("",@menz);
&tenpai_check($tenpai);
}
}


#重複した聴牌形をハッシュでチェック
sub tenpai_check{
my ($tenpai) = @_;
# print "tenpai check :$tenpai\n";
$tenpai{$tenpai}++;
}

#余り牌がターツあるいはトイツであるかをチェック
sub amari_check{
my @haipai = @{ $_[0] };

if($haipai[0] == $haipai[1]){
return 1;
}
if($haipai[0]+1 == $haipai[1]){
return 1;
}
if($haipai[0]+2 == $haipai[1]){
return 1;
}
}





2013/04/11

テンパイ判定

3秒くらいで結果が出るようになった。

メンツの探索中に非メンツが、アタマありの場合2個、アタマなしの場合1個みつかったら探索を中止する。

本当はこの判断が入っているので最後にメンツの数をチェックする必要はないと思ったのだが、
メンツの数が足りないのに最後まで行く場合がかなりある。

また、中止する場合にlastでループを抜けてよいと思ったのだがそれをやると答えが足りなくなる。


use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = sort split //, shift;

if($#haipai != 12){
print "please specify 13 pies.\n";
exit;
}
my @menz;

my %tenpai;

my $menz_count = 0;
my $head_count = 0;
my $tenpai_count = 0;
my $not_menz = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

$head_count = 0;

&select_menz([@haipai],[@menz],"");

# 結果表示
foreach my $name (sort keys %tenpai){
$tenpai_count++;
print "$tenpai_count : $name\n";
}


#アタマを選んだ後、メンツを選ぶ
sub select_head{
my @haipai = @{ $_[0] };

my ($i, $j) = (0, 1);

$head_count++;

while($i <= $#haipai - 1){
if($haipai[$i] == $haipai[$j]){
# print "$head_count: <".$haipai[$i].$haipai[$j].">\n";
my $atama = "<".$haipai[$i].$haipai[$j].">";

my @menz;

#選んだ牌を消す
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#残ったパイからメンツを選ぶ
&select_menz([@new_haipai], [@menz], $atama);
}

$j++;
if($j>$#haipai){
$i++;
$j=$i+1;
}

}
}


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };
my $atama = $_[2];

my ($i,$j, $k) = (0, 1, 2);

# 牌の残りが2枚以下
if($#haipai < 2){
# アタマあり
if($head_count > 0) {
#メンツが3個以上
if($#menz > 1){
#残りの牌がターツかトイツ
if(&amari_check([@haipai])>0){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
# print "$tenpai\n";
&tenpai_check($tenpai);
}
}
return;
# アタマなし
}else{
#メンツが4個以上
if($#menz > 2){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
# print "$tenpai\n";
&tenpai_check($tenpai);
}
return;
}
}

while($i <= $#haipai - 2){

my @new_menz = @menz;

if($haipai[$i]+1 == $haipai[$k]){
$not_menz++;
}elsif(($haipai[$i] == $haipai[$j] && $haipai[$j] == $haipai[$k]) ||
($haipai[$i]+1 == $haipai[$j] && $haipai[$j]+1 == $haipai[$k])){
push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
}else{
#メンツにならなかったらカウント
$not_menz++;
}
#アタマありの場合非メンツが2つ、なしの場合1つあれば探索中止

if(($head_count == 0 && $not_menz > 0) ||
($head_count > 0 && $not_menz > 1)) {
$not_menz = 0;
}else{
#選んだパイを削除
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#再帰呼び出しで残り牌からメンツを選ぶ
&select_menz([@new_haipai], [@new_menz], $atama);

}

$k++;
if($k>$#haipai){
$j++;
if($j>$#haipai -1){
$i++;
$j=$i+1;
$k=$j+1;
}else{
$k=$j+1;
}
}

}
}

#重複した聴牌形をハッシュでチェック
sub tenpai_check{
my ($tenpai) = @_;
# print "tenpai check :$tenpai\n";
$tenpai{$tenpai}++;
}

#余り牌がターツあるいはトイツであるかをチェック
sub amari_check{
my @haipai = @{ $_[0] };

if($haipai[0] == $haipai[1]){
return 1;
}
if($haipai[0]+1 == $haipai[1]){
return 1;
}
if($haipai[0]+2 == $haipai[1]){
return 1;
}
}

再帰を使って1からnまでの和を求める

さっきのをマネしてunlessを使ってみる。
wa(10000);

sub wa{
my ($num, $sum) = @_; unless($num) { print "$sum\n"; }else{ $sum += $num; $num--; &wa($num, $sum); } }

3枚ずつ区切る

8枚までは多分正しい。9枚以上はダメだ。

ただしこれは(123)(456) と (456)(123)を両方数えている。

combin(8, 3) * combin(5, 3) = 8*7*5*4 = 560通り。


use strict;
use warnings;

my $haipai = shift;

if(!$haipai){print "specify haipai.\n"; exit;};

print "haipai : $haipai\n";

my $max_menz = int(length($haipai) / 3);

print "max_menz : $max_menz\n";

my @haipai = split("", $haipai);
my $level=0;
my $count = 0;

my @found;

my @result;

&select_menz(\@haipai);

$count = 0;
for(@result){
$count++;
print "$count:$_\n";
}

sub select_menz{
my ($array_ref) = @_;

my ($i, $j, $k) = (0, 1, 2);

# print "array:@$array_ref\n";

while($i<$#$array_ref-1){
$count++;
# print "level: $level num of found: $#found - $i $j $k - $count : ".$array_ref->[$i].$array_ref->[$j].$array_ref->[$k]."\n";
# print "found:@found\n";
if($max_menz == 3){
if($#$array_ref > 4 && $#found == 2) {
pop @found;
pop @found;
pop @found;
}
}
if($level == 0 && $#found == $max_menz - 1 ) {
pop @found;
pop @found;
}elsif($level == 1 && $#found == $max_menz - 1 ){
pop @found;
}

push @found, "(".$array_ref->[$i].$array_ref->[$j].$array_ref->[$k].")";

if($#found > $max_menz - 2 ){
push @result, join("", sort @found);
}

my @new_array = @$array_ref;
$new_array[$i]=0;
$new_array[$j]=0;
$new_array[$k]=0;
@new_array = grep{ $_ > 0 } @new_array;

if($#new_array > 1){
$level++;
&select_menz(\@new_array);
}

$k++;
if($k>$#$array_ref){
$j++;
$k=$j+1;
if($j>$#$array_ref-1){
$i++;
$j=$i+1;
$k=$j+1;
}
}
}
$level = 0;
# print "--- end of loop --- $#$array_ref \n";
}





perlでpermutation

「Perl クックブック」より。

#!/usr/bin/perl

permute([qw(one two three four)],[]);

sub permute {
my @items = @{ $_[0] };
my @perms = @{ $_[1] };

unless (@items) {
print "@perms\n";
}else{
my(@newitems, @newperms, $i);
foreach $i (0 .. $#items) {
@newitems = @items;
@newperms = @perms;
unshift(@newperms, splice(@newitems, $i, 1));
permute([@newitems], [@newperms]);
}
}
}


実行結果

# perl permute.pl
four three two one
three four two one
four two three one
two four three one
three two four one
two three four one
four three one two
three four one two
four one three two
one four three two
three one four two
one three four two
four two one three
two four one three
four one two three
one four two three
two one four three
one two four three
three two one four
two three one four
three one two four
one three two four
two one three four
one two three four


なるほど・・・が、ソースの意味がほとんどわからない・・・。


2013/04/10

6個の中から3個えらぶ



6個のものから3個選ぶ場合の数は、combin(6,3) = 20 である。


たとえば 123456という文字列から3つを取るパターンは、以下の20通りである。


123, 124, 125, 126, 134, 135, 136, 145, 146, 156, 234, 235, 236, 245, 246, 256, 345, 346, 356, 456


ところで、これを「6個の物を二つのグループに分けるパターン」とすると、


123:456, 124:356, ... 146:235, 156:234, 234:156 ... となって、


234:156 以降はすでに選んだパターンと同じである。


6個の場合は数えられるが、これが10個、20個になったときはどうなるか?


6個の場合と同様、combin(6,3) / 2 でいいのだろうか?・・・よくない。


グループ分けした結果のグループの順番を考慮しない場合は、グループ数の階乗で割る。


6個のものを3個ずつわける場合は、 combin(6, 3) / 2! = 20 / 2 = 10


グループ数が3個であれば、abc, acb, bac, bca cab, cba の6個か。


では、7個のものを3個x2+1に分けるパターンはいくつだろうか?


順序が同じ組は3個ずつの2つなのでわるのは二組に分ける場合と同様2の階乗になる。


combin(7, 3) * combin(4, 3) * 1 /2!


9個のものを3個ずつにわけて組の順序を区別しない場合。3の階乗で割る。


combin(9,3) * combin(6,3) * 1 / 3!





・・・こんなこと習ったっけ?全然記憶にない。





ほぼ完成

とりあえず、聴牌形を出すまでできた。ただしチートイツは除く。
チュウレンポウトウの9面待ちで11パターンが出るので合ってるんじゃないかな。
でも、すごく遅い。30秒くらいかかる。
聴牌形を選ぶ時点で重複があることがわかっている。
なので、最後にハッシュに登録してチェックしている。


use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = split //, shift;

my @menz;

my %tenpai;

my $menz_count = 0;
my $head_count = 0;
my $tenpai_count = 0;
my $not_menz = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

$head_count = 0;

&select_menz([@haipai],[@menz],"");

# 結果表示
foreach my $name (sort keys %tenpai){
$tenpai_count++;
print "$tenpai_count : $name\n";
}


#アタマを選んだ後、メンツを選ぶ
sub select_head{
my @haipai = @{ $_[0] };

my ($i, $j) = (0, 1);

while($i <= $#haipai - 1){
if($haipai[$i] == $haipai[$j]){
$head_count++;
# print "$head_count: <".$haipai[$i].$haipai[$j].">\n";
my $atama = "<".$haipai[$i].$haipai[$j].">";

my @menz;

#選んだ牌を消す
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#残ったパイからメンツを選ぶ
&select_menz([@new_haipai], [@menz], $atama);
}

$j++;
if($j>$#haipai){
$i++;
$j=$i+1;
}

}
}


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };
my $atama = $_[2];

my ($i,$j, $k) = (0, 1, 2);

# 牌の残りが2枚以下
if($#haipai < 2){
# アタマあり
if($head_count > 0) {
#メンツが3個以上
if($#menz > 1){
#残りの牌がターツかトイツ
if(&amari_check([@haipai])>0){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
&tenpai_check($tenpai);
}
}
return;
# アタマなし
}else{
#メンツが4個以上
if($#menz > 2){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
&tenpai_check($tenpai);
}
return;
}
}

while($i <= $#haipai - 2){

my @new_menz = @menz;
#コーツ
if(($haipai[$i] == $haipai[$j] && $haipai[$i] == $haipai[$k])
#シュンツ
|| ($haipai[$i]+1 == $haipai[$j] && $haipai[$j]+1 == $haipai[$k])) {
push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
}else{
#メンツにならなかったらカウント
$not_menz++;
}
#非メンツが2個以上になったら探索中止
if($not_menz > 1){
$not_menz = 0;
}else{
#選んだパイを削除
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#再帰呼び出しで残り牌からメンツを選ぶ
&select_menz([@new_haipai], [@new_menz], $atama);
}

$k++;
if($k>$#haipai){
$j++;
if($j>$#haipai -1){
$i++;
$j=$i+1;
$k=$j+1;
}else{
$k=$j+1;
}
}

}
}

#重複した聴牌形をハッシュでチェック
sub tenpai_check{
my ($tenpai) = @_;
# print "tenpai check :$tenpai\n";
$tenpai{$tenpai}++;
}

#余り牌がターツあるいはトイツであるかをチェック
sub amari_check{
my @haipai = @{ $_[0] };

if($haipai[0] == $haipai[1]){
return 1;
}
if($haipai[0]+1 == $haipai[1]){
return 1;
}
if($haipai[0]+2 == $haipai[1]){
return 1;
}
}


実行結果


# perl menz.pl 1112345678999
haipai: 1 1 1 2 3 4 5 6 7 8 9 9 9
1 : (111)(234)(567)(999)[8]
2 : (111)(234)(678)(999)[5]
3 : (111)(345)(678)(999)[2]
4 : <11>(123)(456)(789)[99]
5 : <11>(123)(456)(999)[78]
6 : <11>(123)(678)(999)[45]
7 : <11>(345)(678)(999)[12]
8 : <99>(111)(234)(567)[89]
9 : <99>(111)(234)(789)[56]
10 : <99>(111)(456)(789)[23]
11 : <99>(123)(456)(789)[11]





サブルーチンに複数の配列を渡す



リファレンスを使わない方法。さっきのpermutationがこれを使っている。

ミソは配列を[]で囲むことだ。


my @fruits = qw /apple banana orange strawberry/;
my @animals = qw /dog cat cow horse/;

&menz([@fruits],[@animals]);

sub menz{
my @array1 = @{ $_[0] };
my @array2 = @{ $_[1] };

print "array1:@array1\n";
print "array2:@array2\n";
}





アタマも選ぶ



アタマも選ぶようにした。これも、同じ牌であるかはまだ見ていない。

パターン数は

COMBIN(13,2) * COMBIN(11,3) * COMBIN(8,3) * COMBIN(5,3) = 7207200





use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = split //, shift;

my @menz;

my $menz_count = 0;
my $head_count = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

#&select_menz([@haipai],[@menz]);

sub select_head{
my @haipai = @{ $_[0] };
use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = split //, shift;

my @menz;

my $menz_count = 0;
my $head_count = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

#&select_menz([@haipai],[@menz]);

sub select_head{
my @haipai = @{ $_[0] };

my ($i, $j) = (0, 1);

while($i <= $#haipai - 1){
$head_count++;
# print "$head_count: <".$haipai[$i].$haipai[$j].">\n";
my $atama = "<".$haipai[$i].$haipai[$j].">";

my @menz;
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;
&select_menz([@new_haipai], [@menz], $atama);


$j++;
if($j>$#haipai){
$i++;
$j=$i+1;
}

}
}


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };
my $atama = $_[2];

my ($i,$j, $k) = (0, 1, 2);

if($#haipai < 2){
$menz_count++;
print "$menz_count: $atama @menz amari:@haipai\n";
return;
}

while($i <= $#haipai - 2){

my @new_menz = @menz;

push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;
&select_menz([@new_haipai], [@new_menz], $atama);

$k++;
if($k>$#haipai){
$j++;
if($j>$#haipai -1){
$i++;
$j=$i+1;
$k=$j+1;
}else{
$k=$j+1;
}
}

}
}





メンツ選択



今度こそできたと思う。

キモは取り出したメンツの配列を再帰呼び出しするサブルーチンに渡したことだ。

まだ、メンツになっているかどうかを問わず、3つずつに分けただけである。


use strict;1
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = split //, shift;

my @menz;

my $count = 0;

print "haipai: @haipai\n";

&select_menz([@haipai],[@menz]);


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };

my ($i,$j, $k) = (0, 1, 2);

if($#haipai < 2){
$count++;
print "$count: menz:@menz\n";
return;
}

while($i <= $#haipai - 2){

my @new_menz = @menz;

push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;
&select_menz([@new_haipai], [@new_menz]);

$k++;
if($k>$#haipai){
$j++;
if($j>$#haipai -1){
$i++;
$j=$i+1;
$k=$j+1;
}else{
$k=$j+1;
}
}

}
}


チュウレンの9面待ちに対してこれを実行すると、最後は以下のようになる。

同じならびが3つ続いているが、これは1が3枚あって、その3枚のうち2枚を選ぶパターンが3つあるためである。

4804800 = combin(13,3) * combin(10,3) * combin(7,3) * combin(4,3)

である。


4804793: menz:(999) (678) (245) (111)
4804794: menz:(999) (678) (245) (113)
4804795: menz:(999) (678) (245) (113)
4804796: menz:(999) (678) (245) (113)
4804797: menz:(999) (678) (345) (111)
4804798: menz:(999) (678) (345) (112)
4804799: menz:(999) (678) (345) (112)
4804800: menz:(999) (678) (345) (112)





2013/04/09

麻雀メンツ検索プログラム



直した。ただし、配牌から3個ずつの牌を選ぶパターンを洗い出すのみ。


刻子や順子になっているかは判定していない。


配牌は5枚から13枚まで試して、パターン数が正しいことだけ確かめた。


たとえば10枚の時は combin(10,3) * combin(7,3) * combin(4,3) = 16800。


だが、すでにこの時点ですごく遅い。とてもじゃないが麻雀ゲームには使えない。


デバッグ用のprint文がたくさん入っているがそれだけの問題ではないだろう・・・


と思ったら、パターン数が正しいだけで同じものが大量に出力されているので削除。





どうにもならないので、簡単なものから徐々に作っていく。


まずは、与えられた文字列から3文字ずつ選ぶパターンを網羅するもの。



use strict;
use warnings;

my $haipai = shift;

if(length($haipai)<0){print "specify haipai.\n"; exit;};

print "haipai : $haipai\n";

my $max_menz = int(length($haipai) / 3);

print "max_menz : $max_menz\n";

my @haipai = split("", $haipai);

my $count = 0;

&select_menz(\@haipai);

sub select_menz{
my ($array_ref) = @_;

my ($i, $j, $k) = (0, 1, 2);

while($i<$#$array_ref-1){
$count++;
print "$count : ".$array_ref->[$i].$array_ref->[$j].$array_ref->[$k]."\n";
$k++;
if($k>$#$array_ref){
$j++;
$k=$j+1;
if($j>$#$array_ref-1){
$i++;
$j=$i+1;
$k=$j+1;
}
}
}
}


これは間違いないと思う。


ここからが問題だ。


配列のリファレンスを与えて、その配列から3個の要素を選択するパターンを網羅することはできた。


それなら、各パターンについて、選択済みの要素を削除した配列を、再度このサブルーチンに渡せば、のこった要素の中から3個を選ぶパターンが網羅され、


それを要素が3個になるまで繰り返せばよい、と思う。


だが、問題がある。


まず、「配列から選択済みの要素を削除する」をどうするかだ。


たとえば「12345」という文字列から最初に選択する3文字のパターンは「123」である。


これを削除した配列は「45」である。


@array = (1,2,3,4,5)


だったとすると、


$array[0], $array[1], $array[2] を削除すればよい。


しかし・・・





2013/04/07

3メンツの抜き出し



13枚の配牌から3つのメンツを選ぶところまで、やっとできた。

イーペーコー形も判定できる。

アタマを選ぶとか、テンパイしているかの判定までは、まだ。

(2013/04/09 だいぶボロがある。今修正中)

my @array = qw /1 1 2 3 3 4 5 6 7 7 8 9 9/;

my @found;
my %found;
my $count = 0;

print "haipai:@array\n";

&moura(\@array);

foreach $key(sort keys(%found)){
    print "$key\n";
}



sub moura{
    my ($array_ref) = @_;
    my ($i,$j,$k);

    my @temp = ();
    for(@$array_ref){
        if($_>0){
            push @temp,$_;
        }
    }
    @$array_ref = @temp;

    if($count > 2){
        if($#found > 1) {
            $found{join("", sort @found)}++;
        }
        @found = ();
        $count = 0;
    }

    for ($i=0;$i<=$#$array_ref;$i++){
        for ($j=$i+1;$j<=$#$array_ref;$j++){
            for ($k=$j+1;$k<=$#$array_ref;$k++){
                if($array_ref->[$i] + 1 == $array_ref->[$j] && $array_ref->[$i] + 2 == $array_ref->[$k]){
                    push @found, $array_ref->[$i].$array_ref->[$j].$array_ref->[$k];
                }elsif($array_ref->[$i] == $array_ref->[$j] && $array_ref->[$i] == $array_ref->[$k]){
                    push @found, $array_ref->[$i].$array_ref->[$j].$array_ref->[$k];
                }
                $count++;
                @array2 = @$array_ref;
                $array2[$i] = 0;
                $array2[$j] = 0;
                $array2[$k] = 0;
                &moura(\@array2);
            }
         }
    }

}

再帰

ほとんどつかったことがない。


$num = 10;

print &factorial($num);

sub factorial {
my ($num) = @_;
if ($num < 2) {
return 1;
}else{
return ($num * &factorial($num-1));
}
}





2013/04/06

麻雀の聴牌判定プログラム



を書いてみようと思った。


牌はマンズがm1, m2, ... m9


ピンズが pn, ソーズがsn、字牌を x1, x2 ... x9(東南西北白發中)


とし、136枚のなかから13枚をランダムに選び、配列に格納してソートする。


まず、刻子、順子、対子をさがすプログラムを作った。


ソートした配牌を最初から順に探し、隣り合った牌が同じか連続しているものを選んでいく。


そこまでは難しくない。


まず困ったのは、112233 というようなイーペーコーの形のときだ。


これは並んだ順に探していくと3つのトイツになってしまう。


それから、77789 というような形は77 789でトイツと順子になるが、777 89という刻子とターツの場合がある。


このようなパターンをもれなくあげるにはどうすればよいのか。


チートイツや国士は特別なので後回しにする。





13枚の牌から3枚選ぶパターンは combin(13,3) 通りある。


combin(13,3)通りを列挙する。それらすべての組み合わせのなかからメンツになるものを探していく。メンツになったら、その3枚を配牌からとりのぞく。残り10枚のなかからcombin(10,3)通りを列挙する。その中からメンツになるものを探す。・・・これを残り一枚になるまで繰り返す。


そのパターン数は、combin(13,3) * combin(10,3) * combin(7,3) * combin(4*3) である。


これがタンキ待ちの場合。


アタマがある場合。アタマ候補を列挙する。combin(13,2)。


アタマを除いた11枚から3個ずつメンツ候補を列挙していく。


combin(13,2) * combin(11,3) * combin(8,3) * combin(5, 3)


残った2枚がトイツかターツ(カンチャンかペンチャンかリャンメン)であるかを調べる。





2013/04/05

素数判定

1億より小さい素数は5761455個あり、それをすべて表示するのにかかった時間は約3時間16分だった。

「エラトステネスのふるい」方式の改良版。

1千万までで1分かからなくなった。

これで1億までやってみる。

VPSでやろうとしたら Out of memoryになったので、10GBのメモリがあるWindows7でやる。

use strict;

use warnings;

my @array =();

my @new_array =();

my $max = shift || 1000;

open my $result, '>', 'result.txt' or die;

my $start_time = localtime();

my $count=0;

for(0..$max-1){

push @array, $count;

$count++;

}

$array[1] = 0;

for(my $i=2;$i

for(my $j=$i*2;$j<=$#array;$j=$j+$i){

$array[$j] = 0;

}

}

$count = 0;

for(@array){

if($_>0){

$count++;

print $result "$_\t";

}

}

print $result "\nTo $max count : $count \n";

my $end_time = localtime();

print $result "$start_time - $end_time\n";

close $result;

6分弱で終わった。5761455個。1億より小さい最大の素数は 99999989 である。

あるページのこの表をあんまり頻繁にみるので自分のところに書く。

範囲 素数の個数

10以下 4

100以下 25

1000以下 168

1万以下 1229

10万以下 9592

100万以下 78498

1000万以下 664579

1億以下 5761455

10億以下 50847534

100億以下 455052511

1000億以下 4118054813

1兆以下 37607912018

10兆以下 346065536839

10億までやろうとしたらパソコンがハンブアップした。ctrl+alt+deleteも効かないので電源を切った。

2013/04/04

bigint、素数判定

というものがあることを知った。cpanからインストールして

use bigint;

を書くと1023乗より大きい数を計算できた。

2のベキ乗を計算させると

1.28421286658896e+207

という表示ではなく、全桁表示する。

たとえば2の1247乗

2423285551989543969259886147306320615721694717012975552426444448158985017722789267546553034738712987127346362442309271495645764807314487385596126924659433020959638410571315406303196994043324038030803068668509323897700215957022383545283810557899591580902307500436706661372076856211818662627186819885605667216486349283517459646495626188985295134800963771933733229691796170211328





ちなみにこんなのもある。

なんでこれで判定できるのかさっぱりわからない。

perl -le 'print "PRIME" if (1 x shift) !~ /^(11+)\1+$/' 19


http://www.drdobbs.com/web-development/tpj-one-liners/184416234




「フェルマー小定理」方式C言語版

判定できる最大の素数は 16381である。

#include <stdio.h>
#include <math.h>

long double gojo(long double a, long double b);

int main(int argc, char *argv[]){
long double d;
long double  a, m, p, x;
int count, max;

count = 0;
a = 2;

if(argc > 1) {
    max = atoi(argv[1]);
}else{
    printf("please specify max number.\n");
    return 1;
}

printf("start\n");

for(p=3;p<max;p++){
    x = gojo(p, 2L);
    if(x == 1){
        d = powl(a, p-1);
        m = fmodl(d, p);
        if(m == 1){
            printf ("%.1Lf is PRIME\n", p);
            count++;
        }
    }
}

printf("end\n");
printf("count:%d\n", count);
}

long double gojo(long double a, long double b){
    long double c;

    while(b>0) {
        c = fmodl(a, b);
        a = b;
        b = c;
    }
    return a;
}





素数判定

youtubeのおすすめ動画に、NHKスペシャルの「リーマン予想」が出てきたので見てみた。

「リーマン予想」で検索してみると、専門家から言わせるとこの番組にはいろいろボロがあるようであるが、リーマン予想というのは、素数の出現に関する規則性のようなものだということはわかった。素数の並びそのものではなく、ゼータ関数と呼ばれる数式のある値に関する規則性だそうである。

この規則性については、正しい値が多数存在することは証明されても、その例外がみつかっていないのでほぼ正しいだろうとは考えられているものの、正しいという証明がいまだにされておらず、100万ドルの懸賞金までかかっているそうである。

私からすると、素数というものになぜ数学者が魅了されるのかわからない。そんなものに規則性なんかあるわけがないというのが私の直感的な考えであるが、どうやら規則性があるようなのである。

というわけで、とりあえず素数判定プログラムを書いてみようと思った。

use strict;
use warnings;

my $end = shift || 10000;
my $count = 0;

my $starttime = localtime();

for (2..$end) {
    if(isprime($_) == 0){
        $count++;
        print $_;
        print "\t";
    }
}

print "\ncount: $count\n";

my $endtime = localtime();

print $starttime." - ".$endtime;

sub isprime {
    my ($num) = @_;

    for (my $i=2;$i<$num;$i++){
        if(($num % $i) == 0){
            return 1;
        }
    }
    return 0;
}

これだと100000以下の素数を列挙するのに1分半くらいかかる。

2から順に割っているのだが、判定対象の数-1まで割るのはムダである。たとえば1600が800で割れるというのは、20で割ったときにわかる。では、いくつまで割ればいいのか?

これは昔数学の授業で習った記憶がある。最初、「1/2かな」と思って、やってみると素数の個数からして正しく判定できたようだ。

時間は20秒くらい短くなった。だが、なぜ1/2かと言われると説明できない。

高校の数学Bの教科書を開いてみた。

「自然数Nが合成数ならば、必ず√N以下の約数をもつ」

ということであった。だから、100なら10まで、10000なら100まで試し割をすればよいことになる。

for (my $i=2;$i<=(sqrt $num);$i++){

このように修正すると、3秒くらいになった。

「エラトステネスのふるい」方式。

(2013/04/04修正)

use strict;
use warnings;

my @array =();
my @new_array =();

my $max = shift || 1000;


my $start_time = localtime();

my $count=0;

for(0..$max-1){
    push @array, $count;
    $count++;
}

$array[1] = 0;

for(my $i=2;$i0){
        $count++;
        print;
        print "\t";
    }
}

print "\n $count \n";


my $end_time = localtime();

print "$start_time - $end_time\n";

「倍数をふるいにかける」ところを、mod (%)でやっているのはちょっとずるいかな。 (後記:ずるいというかムダ。$jを$iずつ増分した値を無条件に消していけばよい)

あと、「ふるいにかける」は、配列の要素を削除してやりたかったのだが、 spliceを使ったり別の配列にpushしたりしてみたがうまくできず、 値をゼロにして表示するときはゼロを飛ばすという方法にした。 100000まででやると、20秒かかる。試し割り方式より遅い。 (後記:修正後は約1秒になった)

さらに、素数判定では「フェルマーの小定理」を使うのが一番速いそうだ。 その定理とは「pを素数とし、aをpの倍数でない整数とするときにaのp-1乗をpで割った余りは1となる(wikipediaより)」 である。

実際に確認してみようか。

p=5とする。aは・・・3にしようか。

3^(5-1) / 5 の余りが 1になるということだね。

3^4 = 81

5でわると16...1だね。

p=23, a=17でやってみよう。

17^22 = 1174562876521148458974062689

1174562876521148458974062689 mod 23 は、電卓で計算したら1になった。

aとpの二つの数字が必要で、どちらかが判定対象だとして、もう1個の数字は互いに素になればなんでもいいのか?

p=100, a=3

3^99 を100でわった余りは67、だから素数でない。 これをプログラムする場合、判定対象をpとし、それと互いに素となるaを選ばねばならない。 a=2 としておいて、それが対象と互いに素でなければその時点で素数ではない。

プログラミングすると・・・

$b = 2;
$max = shift;

print "2\t";
$count = 1;

for($p=3;$p<$max;$p++){
    if (&gojo($p, $b) ==1){
        if($b**($p-1) % $p == 1){
            print "$p\t";
            $count++;
        }
    }
    $b = 2;
}
print "\ncount: $count\n";

sub gojo{
    my ($a,$b) =@_;

    while ($b>0) {
        $c = ($a % $b);
        $a = $b;
        $b = $c;
    }
    return $a;
}

100までは正しく判定できているようだ。 1000までにすると3個、余計に素数と判定したものが混じる。

誤判定した数字は、341, 561, 645。 電卓で計算すると、2^(p-1) mod p は皆1になる。 561は「カーマイケル数」だが、あとの二つは違う。 645は5で割れる。341は11で割れる。561も11で割れる。

これらはa=2とした場合に誤判定される数値のようだ。 1021までしか判定できないのだが、2のべき乗を計算すると1023乗までしかできない。