Hello raghuprasad241,

It seems that the values (i.e., the data in columns 1, 2, etc.) are independent of the keys (i.e., the data in column 0). If, in addition, the values are always in order, then the simplest approach may be to (1) read the data in as two arrays, one for keys and one for values; (2) sort the data in the values array; and then (3) print out the contents of each array, one element from each per line. For example:

#! perl
use strict;
use warnings;

my (@keys, @vals);

while (<DATA>)
{
    my ($key, $val) = /^(.*?\S)(\s.*)$/s;
    push @keys, $key;
    push @vals, $val;
}

@vals = sort { mysort() } @vals;

while (@keys)
{
    my $key = shift @keys;
    my $val = shift @vals;
    print $key, $val;
}

sub mysort
{
    my ($aa) = $a =~ /^\s*(\d+)/;
    my ($bb) = $b =~ /^\s*(\d+)/;

    return $aa <=> $bb;
}

__DATA__
1014        1        10 
1015    51      100
1016    11       50
1017        101     -
[download]

Output:

12:53 >perl 1568_SoPW.pl
1014        1        10
1015    11       50
1016    51      100
1017        101     -

12:54 >
[download]

Hope that helps,

Hello,

The solution of @Athanasius will have problems if you switch place bw 50 and 100 at the input data. My solution below is quite ugly but i think it will be more complete

NOTE: This solution requires that the columns of each input data must be aligned by the end character. But you can change my algorithm a little bit to adapt if you want.

Data Example:

Data Not Ok
100     123
1.......1

Data Ok
100     123
1.........1
[download]

Here is my solution:

use strict;
use warnings;
my @row;
while(my $line = <DATA>)
{
      my @arr;
      while(my ($elem) = $line =~ /(\s*\d+)/g)
      {
            push @arr, $elem;
            $line =~ s/(\s*$elem)/' ' x length($1)/e;
      }
      #Data 1014          1       10 
      #becomes 3 element "1014", "              1", "                 
+     10"
      push @row, \@arr;
}
#Sort element with same length, exchange position
foreach my $r1 (0 .. $#row)
{
      #Take 1 row as base, check other rows
      my @remain = grep !/$r1/,(0 .. $#row);
      foreach my $r2 (0..$#remain)
      {
       #Foreach element in row, find element with same length  
       #in different row (mean same column) -> check value and exchang
+e
            foreach my $c1 (0..$#{$row[$r1]})   
            {
                 foreach my $c2 (0..$#{$row[$r2]})
                 {
                     compare_wrap($row[$r1][$c1], $row[$r2][$c2]);    
+                                       
                 }      
            }
       }
}

map {print merge_str(@$_),"\n"} @row;
#SUPPORT FUNCTION
sub compare_wrap
{
    if( length($_[0]) == length($_[1]) && eval($_[0]) < eval($_[1]))  
+   
    {
         @_[0, 1] = @_[1, 0];   
    }
     
} 

sub merge_str
{
      foreach my $i (1 .. $#_)
      { 
            my $temp = ' ' x length($_[$i-1]);
            $_[$i] =~ s/$temp/$_[$i-1]/; 
      }
      $_[-1];
}
__DATA__
1014          1       10
1015    51      100   20
1016    11      101
1017    15  101
[download]

P/S: Update compare_wrap() as suggestion from kcott, sorry for that mis-spelling :]] !

Hope this could help :)

Regards,

ThBo

G'day ThBo,

Here's a tip for you; prompted by this code:

    my $temp = $_[1];
    $_[1] = $_[0];
    $_[0] = $temp;
[download]

You can swap two (or more) array elements using array slices. Your three lines above could've been written, without the need for a temporary variable, as:

    @_[0, 1] = @_[1, 0]
[download]

Here's an example:

$ perl -wE '@_ = 0 .. 3; say "@_"; @_[0, 1] = @_[1, 0]; say "@_"'
0 1 2 3
1 0 2 3
[download]

— Ken

Thanks a bunch for your enlightening reply :)))

Any more optimization or beautification suggestion will really be appreciated!

Nice Weekend!

ThBo

Hello @redbull2012, Thank you for much for teaching me how to loop through each row and columns of the matrix and compare them. I took your code and modified it a little bit as follows. Let me know what you think about this or if you see any problems with the code ? Atleast during my testing it appears to be working fine.

#!/usr/bin/perl
use v5.10;
use strict;
use warnings;

# This script will arrange the rows and columns of a matrix in the sor
+ted order :-)

my @row;

while(my $line = <DATA>)
{
   push @row, [split(/\s+/,$line)];
}

foreach my $r1 (0 .. $#row)
{
    #Take 1 row as base, check other rows
    my @remain = grep !/$r1/,(0 .. $#row);
    foreach my $r2 (0..$#remain)
      {
       # Now loop through the columns of each rows and compare when co
+lumns are same.
       foreach my $c1 (0..$#{$row[$r1]})
          {
                 foreach my $c2 (0..$#{$row[$r2]})
                 {

                    if ($c1==$c2) # Make sure we are swapping values o
+n the same column not across the columns if needed
                       {
                        if ($row[$r1][$c1] < $row[$r2][$c2])
                           {
                            my $temp=$row[$r1][$c1];
                            $row[$r1][$c1]=$row[$r2][$c2];
                            $row[$r2][$c2]=$temp;
                           }
                        }
                 }
            }
      }
}

map {print "@$_\n"} @row;
#SUPPORT FUNCTION

__DATA__
1014    1       10
1015    51      100
1016    11      50
1017    101     999
[download]

Hello raghuprasad241, I have a different approach for you. Previously, due to some hole in your input data that i have to go through all the trouble to make that big code. Now you have a much nicer input so we can make it look like this.

#!/usr/bin/perl
use v5.10;
use strict;
use warnings;
sub tranpose(@);
my @row;
my @sorted;
while(my $line = <DATA>)
{
   push @row, [split(/\s+/,$line)];
}                        

@sorted = map   {
                    my $in = $_;
                    [map {sprintf("%6s",$_)} @$in];
                }                                #Reformat before prin
+t                           
                tranpose                         #tranpose back to ori
+ginal form                    
                map {[sort {$a <=> $b} @$_]}     #sort each column
                tranpose @row;    
                                  
map {print @$_,"\n"} @sorted;
sub tranpose(@)
{
    my @out;
    foreach my $j (0..$#{$_[0]})
    {    
        push @out, [map {$_[$_][$j]} (0..$#_)];     
    }
    @out;
}

__DATA__
1014    1       10
1015    51      100
1016    11      50
1017    101     999
[download]

Output:

  1014     1    10
  1015    11    50
  1016    51   100
  1017   101   999
[download]

Hope this help!