[첫화면으로]Perl/알고리즘

마지막으로 [b]

Perl로 각종 알고리즘 구현한 소스

1. binary search
2. Permutation
3. Cartesian Product
4. 기타

1. binary search

binary search1
# $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.
}

2. Permutation

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) );

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

언급된 것들을 전부 모아서 벤치마크: 길어서 숨김

[https://metacpan.org/module/Set::CartesianProduct::Lazy -- A Look at Perl: A Look at Cartesian Products]

4. 기타

이름:  
Homepage:
내용:
 


컴퓨터분류
각주:
1. Mastering Algorithms with Perl, Chapter 01

마지막 편집일: 2012-12-27 9:22 pm (변경사항 [d])
1814 hits | Permalink | 변경내역 보기 [h] | 페이지 소스 보기