#!/usr/bin/env perl

## script to practice creating numeric orderings

use strict ;
use warnings ;

## we want to find the POSITION of each value before and after ordering
my @values = ( 14 , 11 , 10 , 13 , 11 ) ; 

## now let's do some ordering!
my %orderings = order( @values ) ;

## 
## print original array and positions after ordering

print "\n      Original Array: " ; 
foreach my $value ( @values ) {
    print sprintf( "% 4d" , $value ) ; 
}

print "\n       New Positions: " ; 
foreach my $ordering ( @{ $orderings{ "new_pos" } } ) {
    print sprintf( "% 4d" , $ordering ) ; 
}
print "\n" ; 

## 
## print ordered array and original positions 

print "\n       Ordered Array: " ; 
foreach my $ordering ( @{ $orderings{ "orig_pos" } } ) {
    print sprintf( "% 4d" , $values[ $ordering ] ) ; 
}

print "\n  Original Positions: " ; 
foreach my $ordering ( @{ $orderings{ "orig_pos" } } ) {
    print sprintf( "% 4d" , $ordering ) ; 
}
print "\n\n" ;


##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  
  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  
##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  ##  

sub order {
    my @inarray = @_ ; 

    ## elements of @inarray MUST be numeric
    foreach my $inval (@inarray) {
	if ( ! is_float( $inval ) ) {
	    die "Fatal error. All elements of the \"order\" subroutine must be numeric." ; 
	}
    }

    ## get the original positions 
    my %pos_orig ; 
    for my $i (0..$#inarray) {
	push( @{ $pos_orig{ $inarray[$i] }} , $i ) ;
    }

    ## put original positions into an array
    my @orig ; 
    foreach my $key ( sort { $a <=> $b } keys %pos_orig ) {
	push( @orig , @{ $pos_orig{ $key }} ) ; 
    }

    
    ## get the new positions 
    my @sorted = sort { $a <=> $b } @inarray ; 
    my %pos_new ; 
    for my $i (0..$#sorted) {
	push( @{ $pos_new{ $sorted[$i] }} , $i ) ;
    }
    
    ## put new positions into an array
    my @new ; 
    foreach my $key ( @inarray ) {
	push( @new , shift( @{ $pos_new{ $key }} )) ; 
    }

    ## return the original and positions -- as hash of arrays
    my %orderings ; 
    @{ $orderings{ "orig_pos" }} = @orig ; 
    @{ $orderings{ "new_pos"  }} = @new ; 

    return %orderings ; 
}


sub is_float {
    my $inval = $_[0] ; 
    defined $inval && $inval =~ /^[+-]?\d+(\.\d+)?$/;
}