kenics.net

Technical notes on perl, python, php, sql, cgi, c/c++, q/kdb+, unix/shell, revision control tools, data structures & algorithms, and their applications into web services and other various forms of software engineering.

sort and search algo – perl implementation

Plain implementation in perl. No rigorous error handling for mal-formatted input, etc. 
 
For the underlying algo logic, complexity analysis, see  http://kenics.net/category/algo 
 
 
####################### 
###   Bubble Sort   ### 
####################### 
 
-------------------------------------------------// bubble.pl 
#!/usr/bin/perl 
 
sub bubbleSort 

    @arr = @_; 
    $len = $#arr + 1; 
    for ($i = 0; $i < $len; $i++){ 
        for ($k = 0; $k < $len-$i-1; $k++){ 
            if($arr[$k] > $arr[$k+1]){ 
                # swap 
                $arr[$k]  = $arr[$k] + $arr[$k+1]; 
                $arr[$k+1]= $arr[$k] - $arr[$k+1]; 
                $arr[$k]  = $arr[$k] - $arr[$k+1]; 
            } 
        } 
    } 
    return @arr; 

 
@arr = (2, 1, 5, 3, 8, 2); 
print bubbleSort(@arr);       # 1 2 2 3 5 8 
 
--------------------------------------------------- 
 
 
############################ 
###    Selection Sort    ### 
############################ 
 
----------------------------------------------// selection.pl 
 
#!/usr/bin/perl 
 
sub SelectSort 

    @arr = @_; 
    $len = $#arr + 1; 
 
    for ($i = 0; $i < $len; $i++){ 
        $smallest = $i; 
        for ($k = $i; $k < $len; $k++){ 
            if($arr[$smallest] > $arr[$k]){ 
                $smallest = $k; 
            } 
        } 
        if($arr[$i] > $arr[$smallest]){  # skip if smallest val is already at the top of the sub array 
            swap( $arr[$i] , $arr[$smallest] ); 
        } 
    } 
    return @arr; 

 
sub swap{ 
    $_[0] = $_[0] + $_[1]; 
    $_[1] = $_[0] - $_[1]; 
    $_[0] = $_[0] - $_[1]; 

 
 
@arr = (2, 1, 5, 3, 8, 2); 
print SelectSort(@arr);      # 1 2 2 3 5 8 
 
---------------------------------------------- 
 
 
########################## 
###   Insertion Sort   ### 
########################## 
 
---------------------------------------------// insertion.pl 
 
#!/usr/bin/perl 
 
sub insertionSort{ 
    @arr = @_; 
    $len = scalar @arr; 
    for ($i = 0; $i < $len ; $i++){ 
        $pivot = $arr[$i]; 
        for ($k = $i - 1; $k > -1 ; $k-- ){ 
            if($arr[$k] > $pivot){ 
                swap($arr[$k],$arr[$k+1]); 
            } 
        } 
    } 

 
sub swap{ 
    $_[0] = $_[0] + $_[1]; 
    $_[1] = $_[0] - $_[1]; 
    $_[0] = $_[0] - $_[1]; 

 
 
@arr = (2, 4, 3, 5, 2, 1, 2); 
 
print @arr,"\n"; 
insertionSort(@arr); 
print @arr;             # 1 2 2 2 3 4 5 
 
 
--------------------------------------------- 
 
 
######################### 
###    Merge Sort     ### 
######################### 
 
this is what the perl built-in func sort() uses, which makes sense considering how it guarantees O(logN) in the worst case. 
but the auxiliary space O(N) is worrying at times. 
 
---------------------------------------// mergeSort.pl 
 
#!/usr/bin/perl 
 
sub mergeSort{ 
    my @arr = @_; 
    my $mid = int( $#arr / 2 ); 
 
    if ($#arr == 0){ 
        return @arr; 
    } 
 
    my @subArrLeft = @arr[0...$mid]; 
    my @subArrRight = @arr[($mid+1)...($#arr)]; 
 
    my @left = mergeSort(@subArrLeft); 
    my @right = mergeSort(@subArrRight); 
 
    my @tmp = ();         # here comes O(n) auxiliary space 
    my $ptr1 = 0; 
    my $ptr2 = 0; 
    my $len = scalar(@left) + scalar(@right); 
    my $leftLen = scalar @left; 
    my $rightLen = scalar @right; 
 
    for ($i = 0; $i < $len ;$i++){      # this loop can be re-written better 
        if ($ptr1 == $leftLen){ 
            push @tmp,$right[$ptr2]; 
            $ptr2++; 
        }elsif($ptr2 == $rightLen){ 
            push @tmp,$left[$ptr1]; 
            $ptr1++; 
        } 
        elsif( $left[$ptr1] > $right[$ptr2] ){ 
            push @tmp,$right[$ptr2]; 
            $ptr2++; 
        }else{ 
            push @tmp,$left[$ptr1]; 
            $ptr1++; 
        } 
    } 
    print "tmp",@tmp,"\n"; 
    return @tmp; 

 
 
@arr = (92,11,8,44,32,81,56,7,22,11,-9); 
 
@output =  mergeSort(@arr); 
 
print "@output";           # -9 7 8 11 11 22 32 44 56 81 92 
 
--------------------------------------- 
 
 
 
########################### 
###     Quick Sort      ### 
########################### 
 
---------------------------------------// quickSort.pl 
 
#!/usr/bin/perl 
 
sub quickSort{ 
    my @arr = @_; 
    if ($#arr == 0){return @arr;} 
    elsif ( $#arr == 1 ){ 
        if( $arr[0] > $arr[1] ){ swap($arr[0],$arr[1]); } 
        return @arr; 
    } 
 
    my $mid = int( $#arr / 2 ); 
    my $lastIdx = $#arr; 
    my $pivot = median(@arr[0], $arr[$mid], $arr[$lastIdx]); 
 
    my $i = 0; 
    my $k = $lastIdx; 
 
    while(1){ 
        while($arr[$i] < $pivot){ $i++; } 
        while($arr[$k] > $pivot){ $k--; } 
        if( $i >= $k ){ last; } 
        swap($arr[$i],$arr[$k]); 
        $i++; $k--; 
    } 
 
    my @left  = (); 
    my @right = (); 
    foreach $i (@arr){ 
        push @left, $i; 
    } 
 
    if( 0 < $i ){ 
        my @subarr0 = @arr[0...($i-1)]; 
        @left = quickSort(@subarr0); 
    } 
    if( $k < $lastIdx ){ 
        if ($i > $k){ $k++; } 
        my @subarr1 = @arr[$k...$lastIdx]; 
        @right = quickSort(@subarr1); 
    } 
 
    return (@left,@right); 

 
sub median{ 
    $x = $_[0]; 
    $y = $_[1]; 
    $z = $_[2]; 
    if(($x >= $y && $y >= $z) || ($x <= $y && $y <= $z)) { return $y; } 
    elsif(($y >= $x && $x >= $z) || ($y <= $x && $x <= $z)){ return $x; } 
    else {return $z}; 
 

 
sub swap{ 
    $_[0] = $_[0] + $_[1]; 
    $_[1] = $_[0] - $_[1]; 
    $_[0] = $_[0] - $_[1]; 

 
 
@arr = (2,4,1,5,9,3,2,3,19,30,-5,16,7); 
 
@output = quickSort(@arr); 
 
print "@output";           # -5 1 2 2 3 3 4 5 7 9 16 19 30 
 
--------------------------------------- 
 
 
########################### 
###    Counting Sort    ### 
########################### 
 
------------------------------------// countingSort.pl 
 
#!/usr/bin/perl 
 
sub countingSort{ 
    @arr = @_; 
    @retArr = (); 
    %h = {}; 
 
    foreach $i (@arr){ 
        $h{$i}++; 
    } 
    foreach $i (sort keys %h){ 
        for ( $k = 0 ; $k < $h{$i}; $k++){ 
            push(@retArr,$i); 
        } 
    } 
    return @retArr; 

 
 
@arr = (2, 1, 5, 3, 8, 2); 
print countingSort(@arr);       # 1 2 2 3 5 8 
 
------------------------------------ 
 
 
############################ 
###    Binary Search     ### 
############################ 
 
given a sorted array, find the target elem in O(logN) 
 
---------------------------------------------// binarySearch.pl 
 
#!/usr/bin/perl 
 
sub binarySearch{   # (@arr,$beginIdx,$endIdx,$elem) 
                    # returns the index pos of the elem if found, otherwise -1 
                    # assume at least one elem in the input array 
    @arr = @{$_[0]}; 
    $begin = ${$_[1]}; 
    $end = ${$_[2]}; 
    $elem = ${$_[3]}; 
    $mid = int( ($begin + $end)/2 ); 
 
    if($arr[$mid] == $elem){return $mid;} 
    elsif( $begin == $end ){return -1;} 
    elsif( $arr[$mid] < $elem ){ 
        return binarySearch(\@arr,\($mid+1),\$end,\$elem); 
    }else{ 
        return binarySearch(\@arr,\$begin,\$mid,\$elem); 
    } 

 
@arr = (2, 4, 5, 3, 3, 1, 7, 2); 
@arr = sort @arr; 
$end = $#arr; 
 
print @arr,"\n";                #  12233457 
 
# passing by reference, to prevent subroutine from combining all input params. 
print binarySearch(\@arr,\0,\$end,\4);       # 5 
print binarySearch(\@arr,\0,\$end,\9);       # -1 
 
--------------------------------------------- 
 
 
################################# 
###   other basic functions   ### 
################################# 
 
sub mean{ 
   my @data = @_; 
   my $n = scalar(@data); 
   return 0 if ($n == 0); 
   my $sum = 0; 
   for (my $i = 0; $i<$n; $i++){ 
      $sum += $data[$i]; 
   } 
   return $sum/$n; 

 
sub variance{ 
   my @data = @_; 
   my $n = scalar(@data); 
   return 0 if ($n == 0); 
   my $mean = &mean(@data); 
   my $sum = 0; 
   for (my $i = 0; $i<$n; $i++){ 
      $sum += (($mean - $data[$i]) ** 2); 
   } 
   return ($sum/$n); 

 
sub stddev{ 
   return sqrt(&variance(@_)); 

 
sub kurtosis{ 
   my @data = @_; 
   my $n = scalar(@data); 
   die "kurtosis requires at least 4 data points. dying...     \n" if ($n < 4); 
   my $mean = &mean(@data); 
   my ($m2,$m4) = (0,0); 
   for (my $i = 0; $i<$n; $i++){ 
      $m2 += (($mean - $data[$i]) ** 2); 
      $m4 += (($mean - $data[$i]) ** 4); 
   } 
   $m2 /= $n; 
   $m4 /= $n; 
   return ($m4/($m2 ** 2)); 

 
sub excess_kurtosis{ 
   return (&kurtosis(@_) - 3); 

 

  1. 2014-12-10 20:17:42 |
  2. Category : perl
  3. Page View:

Google Ads