I have a flat array of coordinates and I want to iterate and extract pairs of x and y coordinates. The same logic could apply to triples for RGB colors. This is what I have so far, but it doesn't feel super flexible or elegant.
my #coords = qw(1 5 2 6 3 8 6 12 7 5);
for (my $i = 0; $i < #coords; $i += 2) {
my $x = $coords[$i];
my $y = $coords[$i+1];
print "$x, $y\n";
}
There has to be a better way to do this right?
The module List::MoreUtils has natatime (n-at-a-time)
use List::MoreUtils qw(natatime);
my #ary = 1..12;
my $it = natatime 3, #ary; # iterator
while (my #triplet = $it->()) { say "#triplet" }
splice is a better way
while (my ($x,$y) = splice #coords, 0, 2) {
...
}
Two things to note.
splice consumes the elements of #coords. If you don't want your loop to destroy the contents of your array, use a temporary array.
my #tmp = #coords;
while (my ($x,$y) = splice #tmp,0,2) { ... }
If the input might not contain an even number of elements, you may want to add an additional check to make sure each iteration has access to the right number of elements
while (2 == (my ($x,$y) = splice #coords,0,2)) { ... }
You can use pairs from the core List::Util module to turn an even-number of elements list into a list of two-element array refs:
#!/usr/bin/env perl
use warnings;
use strict;
use List::Util qw/pairs/;
my #coords = qw(1 5 2 6 3 8 6 12 7 5);
for my $pair (pairs #coords) {
my ($x, $y) = #$pair;
# ...
}
An old school aproach to the problem
use strict;
use warnings;
use feature 'say';
my #coords = qw(1 5 2 6 3 8 6 12 7 5);
my($x,$y);
while( ($x,$y,#coords) = #coords ) {
say "$x, $y";
}
Output
1, 5
2, 6
3, 8
6, 12
7, 5
You can use shift in a while loop.
#!/usr/bin/perl
my #coords = qw/1 5 2 6 3 8 6 12 7 5/;
my ($x, $y);
while (#coords) {
$x = shift #coords;
$y = shift #coords;
# another shift to get triples
# Do something with $x, $y, ...
say "$x, $y";
}
The while loop runs until #coords is empty. shift gets the first element out and deletes it from the array.
Avoid undef by giving a default value:
If you try above with triples, you'll get an error because there will be undefined values in the last run. $x will be 5 and then #coords is empty.
So give a default value using //.
#!/usr/bin/perl
my #coords = qw/1 5 2 6 3 8 6 12 7 5/;
my ($x, $y, $z);
while (#coords) {
$x = shift #coords; # is defined!
$y = shift #coords // "<undef>";
$z = shift #coords // "<undef>";
# ...
}
Don't use ||! Because shift #coords || "<undef>"; will be "<undef>" if the current value is evaluated to false (0, "", ...).
I like to use splice without overworking it by passing the result through as the test, and also add a guard condition:
#triples % 3 and die "TRIPLES ARRAY NOT MULTIPLE OF 3 IN LENGTH";
while (#triples){
my ($foo, $bar, $baz) = splice #triples, 0, 3;
...
}
in case you need #triples to survive getting consumed by the ellided code within the loop, make copies, either of the whole array or with offsets while incrementing an index. TMTOWTDI.
I have read all the questions on stack overflow regarding rotating matrices
and none of them address anything other than transposing or rotating by 90 or 180 degrees in either direction of either single layers or the entire matrices.
I have already answered the question as far as accomplishing it but I am looking for fast and/or 'in place' methods, preferably, but any methods
other than the one I have given would be nice to see as well if only for
educational purposes. My example is in Perl 5 but as long as your intentions are clear, most any language should be acceptable.
The matrix used in my example is as follows
# 2D array #arr has 3 layers.
# #arr is
# 0 1 2 3 4 5
# a b c d e f
# 5 4 3 2 1 0
# 9 8 7 6 5 4
# f e d c b a
# 4 5 6 7 8 9
Goal->Rotate middle layer 2 places clockwise to get the following...
Notice how the top left corner of the middle layer, 'b c', has moved 2 places to the right and the '8 4' from the middle left side is now where the 'b c' was.
# Rotated #arr is
# 0 1 2 3 4 5
# a 8 4 b c f
# 5 e 3 2 d 0
# 9 d 7 6 e 4
# f c b 5 1 a
# 4 5 6 7 8 9
Currently I have been doing something along the lines of this, which is admittedly, terribly slow. Especially on many large arrays.
#!/usr/bin/env perl
use strict; use warnings;
# Coordinates are $arr[$row][$col]
my #arr;
$arr[0][0]='0'; $arr[0][1]='1'; $arr[0][2]='2'; $arr[0][3]='3'; $arr[0][4]='4'; $arr[0][5]='5';
$arr[1][0]='a'; $arr[1][1]='b'; $arr[1][2]='c'; $arr[1][3]='d'; $arr[1][4]='e'; $arr[1][5]='f';
$arr[2][0]='5'; $arr[2][1]='4'; $arr[2][2]='3'; $arr[2][3]='2'; $arr[2][4]='1'; $arr[2][5]='0';
$arr[3][0]='9'; $arr[3][1]='8'; $arr[3][2]='7'; $arr[3][3]='6'; $arr[3][4]='5'; $arr[3][5]='4';
$arr[4][0]='f'; $arr[4][1]='e'; $arr[4][2]='d'; $arr[4][3]='c'; $arr[4][4]='b'; $arr[4][5]='a';
$arr[5][0]='4'; $arr[5][1]='5'; $arr[5][2]='6'; $arr[5][3]='7'; $arr[5][4]='8'; $arr[5][5]='9';
# Print matrix
print_matrix(#arr);
# Extract layer 2
my $target_layer=2;
my $layer_two=extract_layer($target_layer,#arr);
# From the top left corner of the layer, it is as follows
# bcde15bcde84
print "\n$layer_two\n";
# Rotate layer 2 clockwise 2 places
$layer_two=rotate_layer_cl($layer_two,2);
# 84bcde15bcde
print "$layer_two\n\n";
# Replace layer 2 in the same way
#arr=replace_layer($target_layer,$layer_two,#arr);
# Print again
print_matrix(#arr);
### Sub functions ###
# Extract layer by walking around it's coordinates like so
# [1,1]-[1,4] Top(left->right)
# [2,4]-[4,4] Right(top->bottom)
# [4,3]-[4,1] Bottom(right->left)
# [3,1]-[2,1] Left(bottom->top)
sub extract_layer {
my ($layer_cnt,#matrix)=#_;
my $width=scalar(#matrix);
my $layer_width=$width-$layer_cnt;
# layer_cnt=2
# width=6
# layer_width=4
my $layer;
for my $col ( $layer_cnt-1..$layer_width ) {
$layer.=$matrix[$layer_cnt-1][$col];
}
for my $row ( $layer_cnt..$layer_width ) {
$layer.=$matrix[$row][$layer_width];
}
my $cnt=$layer_width-1;
while ( $cnt >= $layer_cnt-1 ) {
$layer.=$matrix[$layer_width][$cnt];
$cnt--;
}
$cnt=$layer_width-1;
while ( $cnt >= $layer_cnt ) {
$layer.=$matrix[$cnt][$layer_cnt-1];
$cnt--;
}
return $layer;
}
# Shift input to the right by $n places, wrapping around.
sub rotate_layer_cl {
my $n=$_[1];
my $buf=substr($_[0],length($_[0])-$n,$n);
return $buf.substr($_[0],0,length($_[0])-$n);
}
# Replace each char from the rotated layer.
sub replace_layer {
my ($layer_cnt,$layer,#matrix)=#_;
my $width=scalar(#matrix);
my $layer_width=$width-$layer_cnt;
# layer_cnt=2
# width=6
# layer_width=4
my $slot=0;
for my $col ( $layer_cnt-1..$layer_width ) {
$matrix[$layer_cnt-1][$col]=substr($layer,$slot,1);
$slot++;
}
for my $row ( $layer_cnt..$layer_width ) {
$matrix[$row][$layer_width]=substr($layer,$slot,1);
$slot++;
}
my $cnt=$layer_width-1;
while ( $cnt >= $layer_cnt-1 ) {
$matrix[$layer_width][$cnt]=substr($layer,$slot,1);
$slot++;
$cnt--;
}
$cnt=$layer_width-1;
while ( $cnt >= $layer_cnt ) {
$matrix[$cnt][$layer_cnt-1]=substr($layer,$slot,1);
$slot++;
$cnt--;
}
return #matrix;
}
# Prints given matrix
sub print_matrix {
foreach my $row (#_) {
my $cnt=0;
foreach my $char (#$row) {
print $char; $cnt++;
if ( $cnt == scalar(#_) ) {
print "\n";
} else {
print " ";
}
}
}
}
The above code outputs as follows,
0 1 2 3 4 5
a b c d e f
5 4 3 2 1 0
9 8 7 6 5 4
f e d c b a
4 5 6 7 8 9
bcde15bcde84
84bcde15bcde
0 1 2 3 4 5
a 8 4 b c f
5 e 3 2 d 0
9 d 7 6 e 4
f c b 5 1 a
4 5 6 7 8 9
which shows the array before rotating the middle layer, the middle layer as a string, the middle layer shifted as a string, and the final resulting array after the middle layer has been rotated 2 places to the right.
-----EDIT-----
So far, the fastest method I have found is to not actually use the full 2D array but to put the block in a regular array like...
my #hex_ary=('1234', '5678', '90ab', 'cdef');
Then create the layer string and shift it the same way my original example shows.
However, because they are strings, I only need to "walk" up and down the sides. The top and bottom are simply referenced as...
my $top=substr($hex_ary[0],0,3);
and
my $bot=reverse(substr($hex_ary[3],0,3));
for the outer layer in this small 4x4 array, while the sides are itered through with
my $right_side_char=substr($hex_ary[$top_row-$i],-1);
my $left_side_char=substr($hex_ary[$bot_row+$i],0,1);
Doing so increases performance approx. 100% from the 2D method because the number of slices taken from the array is then half+2.
Maybe someone with a better grasp of C could create something more efficient. I feel like Perl is just only capable of so much sometimes.
The idea of my method is to use a queue (well, I'm using a Perl array here because I couldn't find a suitable module, but it's far from ideal) containing n elements (where n is the number of places you want to rotate your layer by), and to iterate through each elements of the layer, and each time, push its value to the queue, and replace it with the first element of the queue.
This is what the sub rotate_matrix does.
- $i and $j represent the index of the current element of the layer. Their values goes between $target_layer and $max_i/$max_j; the sub next_ij takes care of computing the index of the next element of the layer.
- The interesting stuffs happen inside the while(1) loop (which is actually a do...while; but do while loops are a bit special in Perl): the value of the current element is pushed to the queue, and, if their are more than $n elements in the queue (meaning that we have already pushed $n elements, representing the fact the we want to rotate by $n), we replace its value by the first element of the queue. The continue block takes care of incrementing $i and $j, and stops the loop once we come back to the first element of the layer.
- Once this is loop is done, the first n elements of the layer haven't been updated (because of this next unless #queue > $n), so we need to take care of that: this is the while (#queue) loop).
Complexity-wise, there is no need to copy the array. The memory usage is O(n) (the size of the queue). Time-wise, you loop once over each element of the layer, and each time, you push and shift from you queue (using a better datastructure, like a linked list, this would be O(1), but with a Perl array, it's probably in the lines of O(n); but probably amortized to O(1)), and compute the next index (O(1)). So you end up with a time complexity, you end up with O(size of the layer to rotate).
A few caveats: if $n is greater than the number of elements in the layer, this won't work (but it can be fixed with a simple modulo). If you ask for a layer that isn't present in the matrix (like 4-th layer of a 2x2 matrix), weird stuffs will happen (but once again, it's easy to fix).
#!/usr/bin/perl
use strict;
use warnings;
use v5.14;
my #arr = ( [qw(0 1 2 3 4 5)],
[qw(a b c d e f)],
[qw(5 4 3 2 1 0)],
[qw(9 8 7 6 5 4)],
[qw(f e d c b a)],
[qw(4 5 6 7 8 9)] );
print_matrix(#arr);
rotate_matrix(\#arr, 2, 2);
say "";
print_matrix(#arr);
sub rotate_matrix {
my ($matrix, $target_layer, $n) = #_;
--$target_layer; # I prefer a 0-indexed value
# TODO: check that $target_layer < #$matrix/2
# TODO: do something like $n = $n % (num of elements in layer)
my #queue;
my ($i, $j) = ($target_layer, $target_layer);
my ($max_i, $max_j) = (#{$matrix->[0]}-$target_layer-1, #$matrix-$target_layer-1);
while (1) { # Actually a do...while loop (see 'continue' block)
push #queue, $matrix->[$i][$j];
next unless #queue > $n; # Waiting to reach n-th element
$matrix->[$i][$j] = shift #queue;
} continue {
($i, $j) = next_ij($target_layer,$max_i,$max_j,$i,$j);
# Stopping if we are back at the begining
last if $i == $target_layer && $j == $target_layer;
}
# Emptying queue
while (#queue) {
$matrix->[$i][$j] = shift #queue;
($i, $j) = next_ij($target_layer,$max_i,$max_j,$i,$j);
}
}
# Computes the index of the next element of the layer
sub next_ij {
my ($target_layer, $max_i, $max_j, $i, $j) = #_;
if ($j == $max_j) { # Last column
if ($i == $max_i) { # Last row (bottom right -> going left)
return ($i, $j-1);
} else { # Not last row (somewhere on the right col -> going down)
return ($i+1, $j);
}
} elsif ($j == $target_layer) { # First column
if ($i == $target_layer) { # First row (top left -> going right)
return ($i, $j+1);
} else { # Not top row (somewhere on the left col -> going up)
return ($i-1, $j);
}
} else { # Neither first nor last column
if ($i == $target_layer) { # First row (somewhere on the top row -> going right)
return ($i, $j+1);
} else { # Last row (somewhere on the last row -> going left)
return ($i, $j-1);
}
}
}
# Prints given matrix
sub print_matrix {
foreach my $row (#_) {
my $cnt=0;
foreach my $char (#$row) {
print $char; $cnt++;
if ( $cnt == scalar(#_) ) {
print "\n";
} else {
print " ";
}
}
}
}
The approach in a nutshell:
copy array
calculate list of members (row, column) for the ring
loop over list index
read from member[index] in original array
write to member[(index + shift) % ring length] in copy array
Right shift by N places: shift == N
Left shift by N places: shift == -N
#!/usr/bin/perl
use strict;
use warnings;
sub dump_array($$) {
my($label, $array) = #_;
print "${label}:\n";
foreach my $row (#{ $array }) {
print join(" ", #{ $row }), "\n";
}
print "\n";
}
sub copy_array($) {
my($array) = #_;
my #copy;
foreach my $row (#{ $array }) {
push(#copy, [ #{ $row } ]);
}
return(\#copy);
}
sub ring_index_to_row_col($$$$$) {
my($N, $ring, $total, $length, $index) = #_;
my($row, $col);
if ($index < $length) {
# top row, left to right
$row = 0;
$col = $index;
} elsif ($index < 2 * $length - 2) {
# top to bottom, right row
$row = $index - $length + 1;
$col = $N - 1 - 2 * $ring;
} elsif ($index < 3 * $length - 2) {
# bottom row, right to left
$row = $N - 1 - 2 * $ring;
#$col = $length - 1 - ($index - 2 * $length + 2);
$col = -$index + 3 * $length - 3;
} else {
# bottom to top, left row
#$row = $total - 1 - $index + 1;
$row = $total - $index;
$col = 0;
}
#print "${index}\t of ${total}\t-> ${row}, ${col}\n";
# shift $length x length array to offset ($ring, $ring)
return([$row + $ring, $col + $ring]);
}
sub ring_members($$) {
my($N, $ring) = #_;
my #list;
# #TODO: odd N?
#
# Examples for N == 6
# 0 -> 2*6 + 2*4 = 20
# 1 -> 2*4 + 2*2 = 12
# 2 -> 2*2 + 2*0 = 4
#
# Examples for N == 5
# 0 -> 2*5 + 2*3
# 1 -> 2*3 + 2*1
# 2 -> 1
#
# Examples for N == 4
# 0 -> 2*4 + 2*2 = 12
# 1 -> 2*2 + 2*0 = 4
my $length = $N - 2 * $ring;
my $members = 4 * $N - 8 * $ring - 4;
foreach my $index (0..$members-1) {
push(#list, ring_index_to_row_col($N, $ring, $members, $length, $index));
}
return(\#list);
}
sub rotate_array_ring(\#$$) {
my($source, $ring, $shift) = #_;
# Sanity check. #TODO is the check correct for odd N?
my $N = #{ $source };
die "ERROR: invalid ring '${ring}' for 2D array of size $N!\n"
unless $ring < ($N / 2);
my $copy = copy_array($source);
my $list = ring_members($N, $ring);
my $length = #{ $list };
foreach my $index (0..$length-1) {
my($row, $col) = #{ $list->[ $index ] };
my($s_row, $s_col) = #{ $list->[($index + $shift) % $length ] };
$copy->[$s_row]->[$s_col] = $source->[$row]->[$col];
}
return($copy);
}
my #source;
while (<DATA>) {
chomp;
push(#source, [ split(/\s+/, $_) ]);
}
dump_array('SOURCE', \#source);
dump_array('SHIFT 1 RING 0', rotate_array_ring(#source, 0, 1));
dump_array('SHIFT 1 RING 1', rotate_array_ring(#source, 1, 1));
dump_array('SHIFT 1 RING 2', rotate_array_ring(#source, 2, 1));
dump_array('SHIFT 2 RING 0', rotate_array_ring(#source, 0, 2));
dump_array('SHIFT 2 RING 1', rotate_array_ring(#source, 1, 2));
dump_array('SHIFT 2 RING 2', rotate_array_ring(#source, 2, 2));
exit 0;
__DATA__
0 1 2 3 4 5
a b c d e f
5 4 3 2 1 0
9 8 7 6 5 4
f e d c b a
4 5 6 7 8 9
Example output:
$ perl dummy.pl
SOURCE:
0 1 2 3 4 5
a b c d e f
5 4 3 2 1 0
9 8 7 6 5 4
f e d c b a
4 5 6 7 8 9
SHIFT 1 RING 0:
a 0 1 2 3 4
5 b c d e 5
9 4 3 2 1 f
f 8 7 6 5 0
4 e d c b 4
5 6 7 8 9 a
SHIFT 1 RING 1:
0 1 2 3 4 5
a 4 b c d f
5 8 3 2 e 0
9 e 7 6 1 4
f d c b 5 a
4 5 6 7 8 9
SHIFT 1 RING 2:
0 1 2 3 4 5
a b c d e f
5 4 7 3 1 0
9 8 6 2 5 4
f e d c b a
4 5 6 7 8 9
SHIFT 2 RING 0:
5 a 0 1 2 3
9 b c d e 4
f 4 3 2 1 5
4 8 7 6 5 f
5 e d c b 0
6 7 8 9 a 4
SHIFT 2 RING 1:
0 1 2 3 4 5
a 8 4 b c f
5 e 3 2 d 0
9 d 7 6 e 4
f c b 5 1 a
4 5 6 7 8 9
SHIFT 2 RING 2:
0 1 2 3 4 5
a b c d e f
5 4 6 7 1 0
9 8 2 3 5 4
f e d c b a
4 5 6 7 8 9
OPTIMIZATION: don't copy the whole array, but
use $list to copy out the ring members to a list and then
loop over that list to place them into the shifted position back into the array.
I.e. two loops instead of one:
my $list = ring_members($N, $ring);
my $length = #{ $list };
# in-place approach
my #members;
foreach my $index (0..$length-1) {
my($row, $col) = #{ $list->[ $index ] };
push(#members, $source->[$row]->[$col]);
}
foreach my $index (0..$length-1) {
my($row, $col) = #{ $list->[ ($index + $shift) % $length ] };
$source->[$row]->[$col] = $members[$index];
}
return($source);
OPTIMIZATION 2: if you have a sequence of operations that you need to apply to a set of same-sized 2D arrays, then you could pre-generate them and process them over-and-over using a function:
my $N = 6; # all arrays are of same size
my #rings = (
ring_members($N, 0),
ring_members($N, 1),
ring_members($N, 2),
);
my #operations = (
{ ring => $rings[0], shift => 1 },
{ ring => $rings[1], shift => -1 },
{ ring => $rings[2], shift => 2 },
# ...
)
# apply one operation in-place on array
sub apply_operation($$) {
my($array, $operation) = #_;
my $list = $operation->{ring};
my $shift = $operation->{shift};
my $length = #{ $list };
my #members;
foreach my $index (0..$length-1) {
my($row, $col) = #{ $list->[ $index ] };
push(#members, $array->[$row]->[$col]);
}
foreach my $index (0..$length-1) {
my($row, $col) = #{ $list->[ ($index + $shift) % $length ] };
$array->[$row]->[$col] = $members[$index];
}
}
# apply operation sequence in-place on array
sub apply_operations($$) {
my($array, $operations) = #_;
foreach my $operation (#{ $operations }) {
apply_operation($array, $operation);
}
}
apply_operations(\#array1, \#operations);
apply_operations(\#array2, \#operations);
apply_operations(\#array3, \#operations);
...
OPTIMIZATION 3: don't make a copy of the complete group in the in-place approach, but only of those members which would be overwritten by the roation. I.e. use 3 loops:
copy the first or last $shift members (depending on the rotation direction) to #cache array.
do a straight copy for the other $length - abs($shift) members.
copy #cache members to their rotated places.
OPTIMIZATION 4: don't use a 2D array (AoA) but a 1D array with $N * $N entries. I.e.
instead of ring_index_to_row_col() returning [$row, $col] you would have ring_index_to_array_index() returning $row * $N + $col.
array accesses ->[$row]->[$col] would be replaced with ->[$array_index].
I have a file in Tcl, and I want to read each value alone as the array... I recognize my file like this
PUx(1) 1 2 3 4 5
PUx(2) 1 2 3 4 5
PUx(3) 1 2 3 4 5
PUx(4) 1 2 3 4 5
PUx(5) 1 2 3 4 5
So, I want to get, for example, the value of PUx(1) one by one and add it to the variable.
enter image description here
As Donal pointed out, it all depends on the actual format. But if the example data is representative, this might work for you:
set content {PUx(1) 1 2 3 4 5
PUx(2) 1 2 3 4 5
PUx(3) 1 2 3 4 5
PUx(4) 1 2 3 4 5
PUx(5) 1 2 3 4 5}
foreach line [split $content \n] {
set values [lassign $line varName]
set $varName $values
}
parray PUx
lassign assumes the line-wise data to represent a valid Tcl list. This might or might not be the case for you.
Update
You might want to re-organize your dataset, this would allow you to use a Tcl array idiom to access "rows" and "columns" of data in a straightforward manner, more or less:
set content {PUx(1,1) 1
PUx(1,2) 2
PUx(1,3) 3
PUx(1,4) 4
PUx(1,5) 5
PUx(2,1) 1
PUx(2,2) 2
PUx(2,3) 3
PUx(2,4) 4
PUx(2,5) 5}
foreach line [split $content \n] {
set values [lassign $line varName]
set $varName $values
}
parray PUx
# first column: *,1
foreach {k v} [array get PUx *,1] {
puts $v
}
# first row: 1,*
foreach {k v} [array get PUx 1,*] {
puts $v
}
Provided that your main concern is how to compute the sum over a list of elements, these are three options available to:
proc lsum1 {x} {
set r 0
foreach i $x {
incr r $i
}
return $r
}
proc lsum2 {x} {
expr [join $x " + "]
}
proc lsum3 {x} {
::tcl::mathop::+ {*}$x
}
set x {1 2 3 4 5}
lsum1 $x
lsum2 $x
lsum3 $x
lsum1 and lsum3 are preferable. lsum2 is the literate translation of what you describe as your "problem", at least in my reading. You may also want to check the Tcl wiki. It gives you some background on the details of lsum3.
This can be easily integrated with reading your data, as shown in my first answer:
lsum1 $PUx(1)
lsum3 $PUx(1)
I have an array with many fields in each line spaced by different spacing like:
INDDUMMY drawing2 139 30 1 0 0 0 0 0
RMDUMMY drawing2 69 2 1 0 0 0 0 0
PIMP drawing 7 0 1444 718 437 0 0 0
I'm trying to make sorting for this array by number in 3rd field so the desired output should be:
PIMP drawing 7 0 1444 718 437 0 0 0
RMDUMMY drawing2 69 2 1 0 0 0 0 0
INDDUMMY drawing2 139 30 1 0 0 0 0 0
I tried to make a split using regular expression within the sorting function like:
#sortedListOfLayers = sort {
split(m/\w+\s+(\d+)\s/gm,$a)
cmp
split(m/\w+\s+(\d+)\s/gm,$b)
}#listOfLayers;
but it doesn't work correctly. How I could make that type of sorting?
You need to expand out your sort function a little further. I'm also not sure that split is working the way you think it is. Split turns text into an array based on a delimiter.
I think your problem is that your regular expression - thanks to the gm flags - isn't matching what you think it's matching. I'd perhaps approach it slightly differently though:
#!/usr/bin/perl
use strict;
use warnings;
my #array = <DATA>;
sub sort_third_num {
my $a1 = (split ( ' ', $a ) )[2];
my $b1 = (split ( ' ', $b )) [2];
return $a1 <=> $b1;
}
print sort sort_third_num #array;
__DATA__
NDDUMMY drawing2 139 30 1 0 0 0 0 0
RMDUMMY drawing2 69 2 1 0 0 0 0 0
PIMP drawing 7 0 1444 718 437 0 0 0
This does the trick, for example.
If you're set on doing a regex approach:
sub sort_third_num {
my ($a1) = $a =~ m/\s(\d+)/;
my ($b1) = $b =~ m/\s(\d+)/;
return $a1 <=> $b1;
}
not globally matching means only the first element is returned. And only the first match of 'whitespace-digits' is returned. We also compare numerically, rather than stringwise.
If you want to sort a list and the operation used in the sort block is expensive, an often used Perl idiom is the Schwartzian Transform: you apply the operation once to each list element and store the result alongside the original element, sort, then map back to your original format.
The classic textbook example is sorting files in a directory by size using the expensive -s file test. A naïve approach would be
my #sorted = sort { -s $a <=> -s $b } #unsorted;
which has to perform -s twice for each comparison operation.
Using the Schwartzian Transform, we map the file names into a list of array references, each referencing an array containing the list element and its size (which has to be determined only once per file), then sort by file size, and finally map the array references back to just the file names. This is all done in a single step:
my #sorted =
map $_->[0], # 3. map to file name
sort { a$->[1] <=> b$->[1] } # 2. sort by size
map [ $_, -s $_ ], # 1. evaluate size once for each file
#unsorted;
In your case, the question is how expensive it is to extract the third field of each array element. When in doubt, measure to compare different methods. The speedup in the file size example is dramatic at about a factor 10 for a few dozen files!
The Schwartzian Transform applied to your problem would look something like this:
my #sorted =
map $_->[0], # 3. Map to original array
sort { $a->[1] <=> $b->[1] } # 2. Sort by third column
map [ $_, ( split( ' ', $_ ) )[2] ], # 1. Use Sobrique's idea
#array;
If the operation used is so expensive that you want to avoid performing it more than once per value in case you have identical array elements, you can cache the results as outlined in this question; this is known as the Orcish Maneuver.