Perl/알고리즘 페이지의 소스 보기

내용출력
로그인[l]
수정할 수 없습니다: Perl/알고리즘 는 읽기 전용 페이지입니다.
[[Perl]]로 각종 알고리즘 구현한 소스

<toc>

== # binary search ==
binary search<footnote(Mastering Algorithms with Perl, Chapter 01)>
{{{#!vim perl
# $index = binary_search( \@array, $word )
#   @array is a list of lowercase strings in alphabetical order.
#   $word is the target word that might be in the list.
#   binary_search() returns the array index such that $array[$index]
#   is $word.

sub binary_search {
    my ($array, $word) = @_;
    my ($low, $high) = ( 0, @$array - 1 );

    while ( $low <= $high ) {              # While the window is open
        my $try = int( ($low+$high)/2 );      # Try the middle element
        $low  = $try+1, next if $array->[$try] lt $word; # Raise bottom
        $high = $try-1, next if $array->[$try] gt $word; # Lower top

        return $try;     # We've found the word!
    }
    return;              # The word isn't there.
}
}}}


== # Permutation ==
* http://www.perlmonks.org/?node_id=29374
* Cpan:Algorithm::Loops

{{{#!vim perl
sub NextPermute(\@)
{
    my( $vals )= @_;
    my $last= $#{$vals};
    return !1   if  $last < 1;
    # Find last item not in reverse-sorted order:
    my $i= $last-1;
    $i--   while  0 <= $i  &&  $vals->[$i] ge $vals->[$i+1];
    # If complete reverse sort, we are done!
    if(  -1 == $i  ) {
        # Reset to starting/sorted order:
        @$vals= reverse @$vals;
        return !1;
    }
    # Re-sort the reversely-sorted tail of the list:
    @{$vals}[$i+1..$last]= reverse @{$vals}[$i+1..$last]
        if  $vals->[$i+1] gt $vals->[$last];
    # Find next item that will make us "greater":
    my $j= $i+1;
    $j++  while  $vals->[$i] ge $vals->[$j];
    # Swap:
    @{$vals}[$i,$j]= @{$vals}[$j,$i];
    return 1;
}

#Sample use:
@ARGV= sort @ARGV;
do {
    print "@ARGV\n";
} while( NextPermute(@ARGV) );
}}}


== # Cartesian Product ==

출처: [http://groups.google.com/group/comp.lang.perl.misc/browse_thread/thread/637e63b8fb3aeb83/99be35f0786f32bc?lnk=gst&q=Combination#99be35f0786f32bc combination - comp.lang.perl.misc | Google 그룹스]

{{{#!vim perl
my @one = qw(blue green yellow);
my @two = qw(john nancy);
my @three = qw(north south east west);

my @out = (""); 
foreach ([@three], [@two], [@one]) { 
    @out =
        map {
            my $new = $_;
            map {
                length () ? "$new, $_" : $new;
            } @out
        } @$_; 
}

print join("\n", @out), "\n";
}}}


약간 다른 방법, 출처: [http://groups.google.com/group/comp.lang.perl.misc/msg/c5f81b37484487ac how to permute multi arrays with different numbers of element? - comp.lang.perl.misc | Google Groups]

이게 더 좋아 보인다, 인자의 순서를 역으로 주지 않아도 되니까:

{{{#!vim perl
    my @digits = ( 
        [1, 2, 3], 
        [4, 5, 6], 
        [7, 8], 
    ); 


    sub permute { 
        map { 
            my $d = $_; 
            @_ ? map "$d$_", permute(@_) : $d; 
        } @{ +shift }; 
    } 


    say for permute @digits;
}}}


여기에도 여러 구현: http://stackoverflow.com/questions/2457096/in-perl-how-can-i-get-the-cartesian-product-of-multiple-sets

언급된 것들을 전부 모아서 벤치마크:
<memo(길어서 숨김)>
{{{#!vim perl
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use Math::Cartesian::Product;
use Data::Dumper;
use List::Util qw/reduce/;
use Benchmark qw/:all/;

my @arr = (
            [ qw/big tiny small/ ],
            [ qw/red yellow green/ ],
            [ qw/apple pear banana/ ],
        );

sub method1 {
    my @result;
    cartesian { push @result, [@_] } @arr;
#     print Dumper(\@result);
}

sub method2 {
    my @result = permute( @arr );
#     print Dumper(\@result);
}

sub permute {
    my $last = pop @_;

    unless(@_) {
        return map([$_], @$last);
    }

    return map {
                  my $left = $_;
                  map([@$left, $_], @$last)
               }
               permute(@_);
}

sub method3 {
    my @result = ( [] );

    foreach my $words ( @arr ) {
        my @temp = ();
        foreach my $current ( @result ) {
            foreach my $word ( @$words ) {
                push @temp, [ @$current, $word ];
            }
        }
        @result = @temp;
    }
#     print Dumper(\@result);
}

sub method3_2 {
    my $result = [ [] ];

    foreach my $words ( @arr ) {
        my @temp = ();
        foreach my $current ( @$result ) {
            foreach my $word ( @$words ) {
                push @temp, [ @$current, $word ];
            }
        }
        $result = \@temp;
    }
#     print Dumper($result);
}

sub method4 {
    my $result = cartesian_product( @arr );
#     print Dumper($result);
}


# 조합 순서가 바뀜
sub cartesian_product {
    reduce {
        [ map {
            my $item = $_;
            map [ @$_, $item ], @$a
        } @$b ]
    } [[]], @_
}

sub method5 {
    my @result = permute2( @arr );
#     print Dumper(\@result);
}

sub permute2 {
    map {
        my $d = $_;
        @_ ? map [$d, @$_], permute2( @_ ) : [ $d ];
    } @{ +shift };
}

# method1();
# method2();
# method3();
# method3_2();
# method4();
# method5();
# exit;

cmpthese(
    timethese( -10,
        {
            m1  => \&method1,
            m2  => \&method2,
            m3  => \&method3,
            m3_2 => \&method3_2,
            m4  => \&method4,
            m5  => \&method5,
        }
    )
);

__END__
Benchmark: running m1, m2, m3, m3_2, m4, m5 for at least 10 CPU seconds...
        m1: 10 wallclock secs (10.31 usr +  0.22 sys = 10.53 CPU) @ 4430.16/s (n=46654)
        m2: 11 wallclock secs (10.55 usr +  0.00 sys = 10.55 CPU) @ 12729.59/s (n=134259)
        m3: 10 wallclock secs (10.50 usr +  0.00 sys = 10.50 CPU) @ 10957.05/s (n=115049)
      m3_2: 11 wallclock secs (10.61 usr +  0.00 sys = 10.61 CPU) @ 11157.32/s (n=118368)
        m4: 10 wallclock secs (10.47 usr +  0.00 sys = 10.47 CPU) @ 12557.41/s (n=131451)
        m5: 11 wallclock secs (10.56 usr +  0.00 sys = 10.56 CPU) @ 6977.28/s (n=73701)
        Rate   m1   m5   m3 m3_2   m4   m2
m1    4430/s   -- -37% -60% -60% -65% -65%
m5    6977/s  57%   -- -36% -37% -44% -45%
m3   10957/s 147%  57%   --  -2% -13% -14%
m3_2 11157/s 152%  60%   2%   -- -11% -12%
m4   12557/s 183%  80%  15%  13%   --  -1%
m2   12730/s 187%  82%  16%  14%   1%   --
}}}
</memo>

[http://lookatperl.blogspot.kr/2012/12/a-look-at-cartesian-products.html https://metacpan.org/module/Set::CartesianProduct::Lazy -- A Look at Perl: A Look at Cartesian Products]

== # 기타 ==

<div class="comments">
<longcomments(100)>
----

</div>
----
[[컴퓨터분류]]
Perl/알고리즘 페이지로 돌아가기 | 다른 수정본 보기