# ---------------------------------------------------------------------------
# 
# File:    GEN_SORT.pm
#
# Copyright (c) Programming Research, 2004.
#
# Version: 1.0
#
# Written: C.Waddingham 20-Jan-05
#
# Purpose: To provide utility functions for sorting.
#
# History  : 
#   Date      Version By   Comment
#   --------  ------- ---- ----------------------------------------------
#
# ---------------------------------------------------------------------------

package GEN_SORT; #==========================================================

require Exporter;
our @ISA = qw( Exporter );

BEGIN
{
   use integer;
   use strict;
}

#---------------------------------------- INDEX_SORT_ARRAY_OF_MIXED_TYPES --

sub INDEX_SORT_ARRAY_OF_MIXED_TYPES
{
   # Usage: @idx = INDEX_SORT_ARRAY_OF_MIXED_TYPES( \@idx_list, \@mixed_type );
   #
   my $ar_idx_list   = shift;
   my $ar_mixed_type = shift;

   my @idx = @$ar_idx_list;

   my $n_elem = scalar( @idx );
   my $m      = int( $n_elem / 2 );

   my $i;
   my $ipm;
   my $t;

   while ( $m > 0 )
   {
      for ( my $j = 0; $j < $n_elem - $m; ++$j )
      {
         $i = $j;

         while ( $i >= 0 )
         {
            $ipm = $i + $m;

            if ( MIXED_TYPE_GT( $$ar_mixed_type[ $idx[ $i ] ], $$ar_mixed_type[ $idx[ $ipm ] ] ) ) 
            {
               $t           = $idx[ $i ];
               $idx[ $i ]   = $idx[ $ipm ];
               $idx[ $ipm ] = $t;
               $i           = $i - $m;
            }
            else
            {
               last;
            }
         }
      }
      $m = int( $m / 2 );
   }
   return @idx;
}

#----------------------------------------------- INDEX_SORT_NUMERIC_ARRAY --

sub INDEX_SORT_NUMERIC_ARRAY
{
   # Usage: @idx = INDEX_SORT_NUMERIC_ARRAY( \@idx, \@num );
   #
   my $ar_idx = shift;
   my $ar_num = shift;

   my $n_elem = scalar( @$ar_idx );
   my $m      = int( $n_elem / 2 );

   my $i;
   my $ipm;
   my $t;

   while ( $m > 0 )
   {
      for ( my $j = 0; $j < $n_elem - $m; ++$j )
      {
         $i = $j;

         while ( $i >= 0 )
         {
            $ipm = $i + $m;

            if ( $$ar_num[ $$ar_idx[ $i ] ] > $$ar_num[ $$ar_idx[ $ipm ] ] ) 
            {
               $t           = $$ar_idx[ $i ];
               $$ar_idx[ $i ]   = $$ar_idx[ $ipm ];
               $$ar_idx[ $ipm ] = $t;
               $i           = $i - $m;
            }
            else
            {
               last;
            }
         }
      }
      $m = int( $m / 2 );
   }
   return @$ar_idx;
}

#------------------------------------------------ INDEX_SORT_STRING_ARRAY --

sub INDEX_SORT_STRING_ARRAY
{
   # Usage: @idx = INDEX_SORT_STRING_ARRAY( \@idx, \@str );
   #
   my $ar_idx = shift;
   my $ar_str = shift;

   my $n_elem = scalar( @$ar_idx );
   my $m      = int( $n_elem / 2 );

   my $i;
   my $ipm;
   my $t;

   while ( $m > 0 )
   {
      for ( my $j = 0; $j < $n_elem - $m; ++$j )
      {
         $i = $j;

         while ( $i >= 0 )
         {
            $ipm = $i + $m;

            if ( $$ar_str[ $$ar_idx[ $i ] ] gt $$ar_str[ $$ar_idx[ $ipm ] ] ) 
            {
               $t           = $$ar_idx[ $i ];
               $$ar_idx[ $i ]   = $$ar_idx[ $ipm ];
               $$ar_idx[ $ipm ] = $t;
               $i           = $i - $m;
            }
            else
            {
               last;
            }
         }
      }
      $m = int( $m / 2 );
   }
   return @$ar_idx;
}

#------------------------------------------------------------------ INPUT --

sub MIXED_TYPE_GT
{
   # Usage: if ( MIXED_TYPE_GT( $mixed_type_lhs, $mixed_type_rhs ) ) 
   #
   my $mixed_type_lhs = shift;
   my $mixed_type_rhs = shift;

   # In order to compare, separate each rule entry into an array
   # of components.  Where the components are numbers or non-numeric.
   # Numeric components are those that contain digits 0-9 only.
   # Non-numeric components are components that have only non 0-9
   # characters.
   #

   my @lhs = SPLIT_MIXED_TYPE( $mixed_type_lhs );
   my @rhs = SPLIT_MIXED_TYPE( $mixed_type_rhs );

   my $len_lhs = scalar( @lhs );
   my $len_rhs = scalar( @rhs );

   my $len_min;

   if ( $len_lhs < $len_rhs )
   {
      $len_min = $len_lhs;
   }
   else
   {
      $len_min = $len_rhs;
   }

   TERM:
   for ( my $i = 0; $i < $len_min; ++$i )
   {
      if ( $lhs[ $i ] =~ /^\d+$/o )
      {
         if ( $rhs[ $i ] =~ /^\d+$/o )
         {
            next TERM if ( $lhs[ $i ] == $rhs[ $i ] );
            return ( $lhs[ $i ] > $rhs[ $i ] );
         }
      }
      next TERM if ( $lhs[ $i ] eq $rhs[ $i ] );
      return ( $lhs[ $i ] gt $rhs[ $i ] );
   }

   if ( $len_lhs == $len_rhs )
   {
      return 0;  # False - @lhs not gt @rhs
   }
   elsif ( $len_lhs > $len_rhs )
   {
      return 1;  # True - @lhs is gt @rhs
   }
   else
   {
      return 0;
   }
}

# --------------------------------------------------------------------------

sub REMOVE_DUPLICATES
{
   # Usage: @unique_array = REMOVE_DUPLICATES( @array );
   #
   my @array = @_;
   
   if ( scalar( @array ) == 0 )
   {
      return ();
   }

   my $prev_item = $array[ 0 ];
   my @result    = ( $prev_item );

   for ( my $cursor = 1; $cursor <= $#array; ++$cursor )
   {
      if ( $array[ $cursor ] ne $prev_item )
      {
         push @result, $array[ $cursor ];
         $prev_item = $array[ $cursor ];
      }
   }

   return @result;
}
    
# --------------------------------------------------------------------------

sub SEARCH
{
   # Usage: $index = SEARCH( $ar_list, $value );
   #
   # Search array $ar_list for first element that matches $value
   # by string equality comparison and return the index of that element.
   # If not found return -1.
   #
   my $ar_list = shift;
   my $value   = shift;

   LOOP:
   for ( my $index = 0; $index <= $#$ar_list; ++$index )
   {
      if ( $$ar_list[ $index ] eq $value )
      {
         return $index;
      }
   }
  
   return -1;
}

#----------------------------------------------- SHELL_SORT_NUMERIC_ARRAY --

sub SHELL_SORT_NUMERIC_ARRAY
{
   # Usage: @sorted = SHELL_SORT_NUMERIC_ARRAY( @array );
   #
   my @array = @_;

   my $n_elem = scalar( @array );
   my $m      = int( $n_elem / 2 );

   my $i;
   my $ipm;
   my $t;

   while ( $m > 0 )
   {
      for ( my $j = 0; $j < $n_elem - $m; ++$j )
      {
         $i = $j;

         while ( $i >= 0 )
         {
            $ipm = $i + $m;

            if ( $array[ $i ] > $array[ $ipm ] ) 
            {
               $t             = $array[ $i ];
               $array[ $i ]   = $array[ $ipm ];
               $array[ $ipm ] = $t;
               $i             = $i - $m;
            }
            else
            {
               last;
            }
         }
      }
      $m = int( $m / 2 );
   }
   return @array;
}

#------------------------------------ SHELL_SORT_NUMERIC_ARRAY_DESCENDING --

sub SHELL_SORT_NUMERIC_ARRAY_DESCENDING
{
   # Usage: @sorted = SHELL_SORT_NUMERIC_ARRAY_DESCENDING( @array );
   #
   my @array = @_;

   my $n_elem = scalar( @array );
   my $m      = int( $n_elem / 2 );

   my $i;
   my $ipm;
   my $t;

   while ( $m > 0 )
   {
      for ( my $j = 0; $j < $n_elem - $m; ++$j )
      {
         $i = $j;

         while ( $i >= 0 )
         {
            $ipm = $i + $m;

            if ( $array[ $i ] < $array[ $ipm ] ) 
            {
               $t             = $array[ $i ];
               $array[ $i ]   = $array[ $ipm ];
               $array[ $ipm ] = $t;
               $i             = $i - $m;
            }
            else
            {
               last;
            }
         }
      }
      $m = int( $m / 2 );
   }
   return @array;
}

#--------------------------------- CASE_SENSITIVE_SHELL_SORT_STRING_ARRAY --

sub CASE_SENSITIVE_SHELL_SORT_STRING_ARRAY
{
   # Usage: @sorted = CASE_SENSITIVE_SHELL_SORT_STRING_ARRAY( @array );
   #
   my @array = @_;

   my $n_elem = scalar( @array );
   my $m      = int( $n_elem / 2 );

   my $i;
   my $ipm;
   my $t;

   while ( $m > 0 )
   {
      for ( my $j = 0; $j < $n_elem - $m; ++$j )
      {
         $i = $j;

         while ( $i >= 0 )
         {
            $ipm = $i + $m;

            if ( $array[ $i ] gt $array[ $ipm ] )
            {
               $t             = $array[ $i ];
               $array[ $i ]   = $array[ $ipm ];
               $array[ $ipm ] = $t;
               $i             = $i - $m;
            }
            else
            {
               last;
            }
         }
      }
      $m = int( $m / 2 );
   }
   return @array;
}

#------------------------------- CASE_INSENSITIVE_SHELL_SORT_STRING_ARRAY --

sub CASE_INSENSITIVE_SHELL_SORT_STRING_ARRAY
{
   # Usage: @sorted = CASE_INSENSITIVE_SHELL_SORT_STRING_ARRAY( @array );
   #
   my @array = @_;

   my $n_elem = scalar( @array );
   my $m      = int( $n_elem / 2 );

   my $i;
   my $ipm;
   my $t;

   while ( $m > 0 )
   {
      for ( my $j = 0; $j < $n_elem - $m; ++$j )
      {
         $i = $j;

         while ( $i >= 0 )
         {
            $ipm = $i + $m;

            if ( lc( $array[ $i ] ) gt lc( $array[ $ipm ] ) )
            {
               $t             = $array[ $i ];
               $array[ $i ]   = $array[ $ipm ];
               $array[ $ipm ] = $t;
               $i             = $i - $m;
            }
            else
            {
               last;
            }
         }
      }
      $m = int( $m / 2 );
   }
   return @array;
}

#---------------------------------------------- SORT_ARRAY_OF_MIXED_TYPES --

sub SORT_ARRAY_OF_MIXED_TYPES
{
   # Usage: @sorted_mixed_types = SORT_ARRAY_OF_MIXED_TYPES( @mixed_types );
   #
   my @mixed_types = @_;

   my @idx = ();

   for ( my $i = 0; $i <= $#mixed_types; ++$i )
   {
      push @idx, $i;
   }

   @idx = INDEX_SORT_ARRAY_OF_MIXED_TYPES( \@idx, \@mixed_types );

   my @result = ();

   for ( my $i=0; $i <= $#idx; ++$i )
   {
      push @result, $mixed_types[ $idx[ $i ] ];
   }
   
   return @result;
}

# --------------------------------------------------------------------------

sub SPLIT_MIXED_TYPE
{
   # Usage: @lhs = SPLIT_MIXED_TYPE( $mixed_type );
   #
   # Separates $mixed_type into array of numeric and non-numeric tokens.
   #
   my $mixed_type = shift;
 
   my @result = ();
   my $current = "";
   my $current_is_numeric = 1;  # True

   foreach my $ch ( split( //, $mixed_type ) )
   {
      if ( $ch =~ /\d/ )
      {
         # Here with numeric character.  Is it the first of the current sequence?
         #
         if ( $current_is_numeric )
         {
            $current .= $ch;
         }
         else
         {
            # Previous was alpha, so save it and start new numeric
            #
            push @result, $current;
            $current = $ch;
            $current_is_numeric = 1;  # True
         }
      }
      else
      {
         # Here with alpha character
         #
         if ( $current_is_numeric )
         {
            # Previous was numeric, so save it and start new alpha
            #
            push @result, $current;
            $current = $ch;
            $current_is_numeric = 0;  # False
         }
         else
         {
            $current .= $ch;
         }
      }
   }
   
   if ( $current ne "" )
   {
      push @result, $current;
   }

   return @result;
}
    
#-- eof GEN_SORT.pm --------------------------------------------------------
