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: