Perlで二分探索

ねむいです。

#!/usr/bin/env perl
use strict;
use warnings;

my @array = qw/1 3 5 11 12 13 17 22 25 28/;
print bs($_, \@array), "\n" for qw/25 4 29/;

if(@ARGV){
    print "search for ", join(', ', @array), "\n";
    for my $n (@ARGV){
        printf "%d is %s.\n", $n, bs($n, \@array) ? 'found' : 'not found';
    }
}

sub bs {
    my ($search_number, $list) = @_;
    my ($start, $end) = (0, $#{$list});
    return 0 if $search_number < $list->[$start];
    return 0 if $search_number > $list->[$end];
    while(1){
        my $center = ($start + $end) >> 1;
        if($list->[$center] == $search_number){
            return 1; #found
        }
        $start = $center + 1 if $list->[$center] < $search_number;
        $end   = $center - 1 if $list->[$center] > $search_number;
        last if $start > $end;
        last if $end < $start;
    }
    return 0;
}

Perlでエラトステネスの篩

wikipediaの説明を元に書いてみた。

#!/usr/bin/env perl
use strict;
use warnings;
my $x = 100;
my @numbers = (2 .. $x);
my @prime_numbers;
while(1){
    if($numbers[0] > sqrt $x){
        push @prime_numbers, @numbers;
        last;
    }
    my $number = shift @numbers;
    push @prime_numbers, $number;
    @numbers = grep { $_ % $number != 0 } @numbers;
}
print join ',', @prime_numbers, "\n";

Perlでユークリッドの互除法

簡単そうだったんで、wikipediaの最初の説明だけみて実装。

#!/usr/bin/env perl
use strict;
use warnings;

my ($x, $y) = (1071, 1029);
print euclidean($x, $y), "\n";

sub euclidean {
    my ($x, $y) = @_;
    my $r = $x % $y;
    return $y if $r == 0;
    return euclidean($y, $r);
}

いかんいかん。再帰なんかいらないじゃないか。

sub euclidean {
    my ($x, $y) = @_;
    while(my $r = $x % $y){
        ($x, $y) = ($y, $r);
    }
    return $y;
}

Perlでマージソート

wikipediarubyの例をPerlにしただけ。最初にリストを分割するのに再帰をしているところとか、もうちょっといい感じにしてみたいと思ったり。

#!/usr/bin/env perl
use strict;
use warnings;

my @a = (3, 2, 0, 5, 8, 3, 4, 1, 3, 2);
mergesort(@a);

sub mergesort {
    my (@list) = @_;
    return _mergesort(@list);
}

sub _mergesort {
    my (@list) = @_;
    return \@list if @list <= 1;
    my @list2 = splice @list, scalar @list >> 1;
    my @result = merge(_mergesort(@list), _mergesort(@list2));
    return \@result;
}


sub merge {
    my ($list1, $list2) = @_;
    my ($len1, $len2) = (scalar @$list1, scalar @$list2);
    my @result;
    my ($a, $b) = ($list1->[0], $list2->[0]);
    my ($i, $j, $k) = (0, 0, 0);
    while(1){
        if($a <= $b){
            $result[$i] = $a;
            $i += 1; $j += 1;
            last unless $j < $len1;
            $a = $list1->[$j];
        }else{
            $result[$i] = $b;
            $i += 1; $k += 1;
            last unless $k < $len2;
            $b = $list2->[$k];
        }
    }
    while($j < $len1){
        $result[$i] = $list1->[$j];
        $i += 1; $j += 1;
    }
    while($k < $len2){
        $result[$i] = $list2->[$k];
        $i += 1; $k += 1;
    }
    return @result;
}

Perlでクイックソート

wikipediaのCのサンプルをPerlに起こした感じのやつ。
無駄に再帰回数が多い気がしなくもない。
どっか間違ったかも。

#!/usr/bin/env perl
use strict;
use warnings;

my @a = (3, 2, 0, 5, 8, 3, 4, 1, 3, 2);
my @b = @a;
qs(\@b, 0, $#b);

print @a, "\n";
print @b, "\n";

sub qs {
    my ($a, $left, $right) = @_;
    my ($i, $j) = ($left, $right);
    my $pivot = $a->[$i];
    while(1){
        while($a->[$i] < $pivot){ $i++ }
        while($a->[$j] > $pivot){ $j-- }
        last if $i >= $j;
        ($a->[$i], $a->[$j]) = ($a->[$j], $a->[$i]);
        $i++; $j--;
    }
    return if $left >= $right;
    qs($a, $left, $i - 1);
    qs($a, $j + 1, $right);
}

配列リファレンス渡しじゃなくて、結果の配列を連結してみた。
再帰は少ないけど上のより遅い。 あとメモリも食いそう。

#!/usr/bin/env perl
use strict;
use warnings;

my @a = (3, 2, 0, 5, 8, 3, 4, 1, 3, 2);
my @b = @a;

@b  = qs(@b);

sub qs {
    my $t = $_[0];
    my (@same, @high, @low);
    for(@_){
        push @same, $_ if $_ == $t;
        push @high, $_ if $_ > $t;
        push @low, $_ if $_ < $t;
    }
    @high = qs(@high) if @high > 1;
    @low = qs(@low) if @low > 1;
    return map { $_ if defined } @low, @same, @high;
}