• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 234
  • Last Modified:

Condense this code, perhaps with the map function?

I'm trying to condense some code, hopefully by using fancy one-liners.

The whole idea is to take two columns at a time from
@AoA, starting with $startcol (a column index).  From those two
columns, create a map so that 1 is assigned to the lowest value,
2 to the next lowest, and so on.  The columns do not need to be
considered distinct.  They could be combined into a single array.

For example, a snapshot of 2 columns would be:

2 4
1 4
2 3
6 3
6 2
...

The map created for these two columns would be:

# orig value => assigned value
1 => 1
2 => 2
3 => 3
4 => 4
6 => 5
...

I would like to have this condensed by using some "one-liners", or more elegant code.
For example, perhaps the perl map function could be involved.  I definitely want
to eliminate redundancy, which you can see in the code below when it walks
over each array of AoA multiple times.

Basically, the entire portion of code I want to condense is:

#
# Start of code
#

use strict;

my @AoA = (); # Array of arrays;
my @printarray = ();
my $startcol = 5;  # column index of the start column
my $outfile = "temp.out";

# Read in the data file
while (<>) {
  chomp;
  push @AoA, [ split ];
}

# Walk over every other item starting with $startcol.
# Each row has the same number of columns.
for ( $cursor = $startcol; $cursor < $#{ $AoA[0] }; $cursor +=2 ) {

  my %hash = ();
  my %map = ();

  my $a1index = $cursor;
  my $a2index = $cursor + 1;

  # I don't need to know the number of occurrences but this counts them anyway.
  for my $i ( 0 .. $#AoA ) {
     $hash{$AoA[$i][$a1index]}++; # a1
     $hash{$AoA[$i][$a2index]}++; # a2
  }

  my $index = 1;
  foreach my $key ( sort {$a <=> $b} keys %hash ) {
     $map{$key} = $index;
     $index++;
  }

  for my $i ( 0 .. $#AoA ) {
     my $a1 = $AoA[$i][$a1index];
     my $a2 = $AoA[$i][$a2index];

     if ( exists $map{$a1} ) {
        $a1 = $map{$a1};
     }
     else {
        print "Error:  A mapped value was not found for $a1\n";
        exit;
     }

     if ( exists $map{$a2} ) {
        $a2 = $map{$a2};
     }
     else {
        print "Error:  A mapped value was not found for $a2\n";
        exit;
     }

     push @{ $printarray[$i] }, "$a1", "$a2";
  }
}

open( OUTFILE, ">$outfile" );
foreach my $i ( 0 .. $#AoA ) {
   # Print the columns before the start column
   foreach my $j ( 0 .. $startcol-1 ) {
      print OUTFILE "$AoA[$i][$j] ";
   }
   # Print the mapped values
   print OUTFILE "@{$printarray[$i]}\n";
}
close( OUTFILE );
print "The file $outfile has been created.\n";

#
# End of code
#
0
mock5c
Asked:
mock5c
  • 2
2 Solutions
 
ozoCommented:
@hash{(split)[$cursor,$cursor+1]}=() while <>;
@map{sort{$a<=>$b}keys %hash}=1..keys %hash;

0
 
wlfsCommented:
ozo is showing ingenuity as usual.
The problem is, that reading in the first two columns under consideration consumes the entire file already. And the replacement of the values in the printarray can be condensed as well.

I prepared the following code, which does the same job as the code in the question. Not quite as ingenious as ozo I'm afraid, but condensed at least :)

my @AoA;
my $startcol = 2;  # column index of the start column
my $outfile = "temp.out";

chomp, push @AoA, [ split ] while (<>);

for (my $col = $startcol; $col < $#{ $AoA[0] }; $col +=2 ) {
  my (%seen, %map);
  @map{sort {$a<=>$b} grep {!$seen{$_}++} map @{$_}[$col..$col+1], @AoA} = 1..2*@AoA;
  @{$_}[$col..$col+1] = @map{@{$_}[$col..$col+1]} foreach @AoA;
}

open(OUTFILE, ">$outfile");
print OUTFILE join(" ", @$_), "\n" foreach @AoA;
close(OUTFILE);
0
 
ozoCommented:
use strict;

my @AoA = (); # Array of arrays;
my @printarray = ();
my $startcol = 5;  # column index of the start column
my $outfile = "temp.out";

chomp, push @AoA, [ split ] while <>;

for( my $col = $startcol; $col < $#{ $AoA[0] }; $col +=2 ){
  my (%seen, %map);
  @seen{map @{$_}[$col..$col+1], @AoA}=();
  @map{sort{$a<=>$b}keys %seen} = 1..keys %seen;
  for( @AoA ){ $_ = $map{$_} for @{$_}[$col..$col+1] }
}

open(OUTFILE, ">$outfile");
print OUTFILE "@$_\n" for @AoA;
close(OUTFILE);
0
 
mock5cAuthor Commented:
Exactly the kind of elegant code I was looking for.  Both answers taught me a bit about what Perl is capable of doing.
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now