Perl 로 각종 알고리즘 구현한 소스
1. binary search
2. Permutation
3. Cartesian Product
4. 기타
1. binary search
sub binary_search {
my ($array , $word ) = @_ ;
my ($low , $high ) = ( 0 , @$array - 1 );
while ( $low <= $high ) {
my $try = int ( ($low +$high )/2 );
$low = $try +1 , next if $array ->[$try ] lt $word ;
$high = $try -1 , next if $array ->[$try ] gt $word ;
return $try ;
}
return ;
}
2. Permutation
sub NextPermute (\@)
{
my ( $vals )= @_ ;
my $last = $
return !1 if $last < 1 ;
my $i = $last -1 ;
$i -- while 0 <= $i && $vals ->[$i ] ge $vals ->[$i +1 ];
if ( -1 == $i ) {
@$vals = reverse @$vals ;
return !1 ;
}
@{$vals }[$i +1. .$last ]= reverse @{$vals }[$i +1. .$last ]
if $vals ->[$i +1 ] gt $vals ->[$last ];
my $j = $i +1 ;
$j ++ while $vals ->[$i ] ge $vals ->[$j ];
@{$vals }[$i ,$j ]= @{$vals }[$j ,$i ];
return 1 ;
}
@ARGV = sort @ARGV ;
do {
print " @ARGV \n " ;
} while ( NextPermute(@ARGV ) );
3. Cartesian Product
출처: [combination - comp.lang.perl.misc | Google 그룹스]
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 " ;
약간 다른 방법, 출처: [how to permute multi arrays with different numbers of element? - comp.lang.perl.misc | Google Groups]
이게 더 좋아 보인다, 인자의 순서를 역으로 주지 않아도 되니까:
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
언급된 것들을 전부 모아서 벤치마크:
길어서 숨김
#!/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 ;
}
sub method2 {
my @result = permute( @arr );
}
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 ;
}
}
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 ;
}
}
sub method4 {
my $result = cartesian_product( @arr );
}
sub cartesian_product {
reduce {
[ map {
my $item = $_ ;
map [ @$_ , $item ], @$a
} @$b ]
} [[]], @_
}
sub method5 {
my @result = permute2( @arr );
}
sub permute2 {
map {
my $d = $_ ;
@_ ? map [$d , @$_ ], permute2( @_ ) : [ $d ];
} @{ +shift };
}
cmpthese(
timethese( -10 ,
{
m1 => \&method1 ,
m2 => \&method2 ,
m3 => \&method3 ,
m3_2 => \&method3_2 ,
m4 => \&method4 ,
m5 => \&method5 ,
}
)
);
[https://metacpan.org/module/Set::CartesianProduct::Lazy -- A Look at Perl: A Look at Cartesian Products]
컴퓨터분류
![[첫화면으로]](/raymundo_logo.jpg){kind=logo}
Perl/알고리즘