Transposing an array of elements - perl

I am trying to transpose an array.
I tried the following code...
#! /usr/bin/perl
use strict;
use warnings;
use autodie;
open my $fh, '<',"op.txt" || die "$!";
open my $wh , '>',"pwl.txt" || die "$!";
select ($wh);
while (my $line = <$fh>) {
my #rows = $line;
my #transposed;
for my $row (#rows) {
for my $column (0 .. $#{$row}) {
push(#{$transposed[$column]}, $row->[$column]);
}
}
for my $new_row (#transposed) {
for my $new_col (#{$new_row}) {
print $new_col, " ";
}
print "\n";
}
}
**********INPUT FILE******
1 2 3
4 5 6
7 8 9
********** EXPECTED OUTPUT FILE *******
1 4 7
2 5 8
3 6 9
******** GENERATED OUTPUT FILE *******
Currently couldn't able print anything. script shows the error
"can't use string ("1 4 7") as an array ref while "strict refs" in use
Reference:
used the following reference...
Transpose in perl
however in this reference example, array input lines are declared manually where as i am trying to process a array which is in a text file
could anybody help me where i did mistake?
Many Thanks

You did have to split input line as #dland suggested. But, there were a few other issues.
Here's the corrected code [please pardon the gratuitous style cleanup]:
#! /usr/bin/perl
use strict;
use warnings;
use autodie;
open my $fh, '<',"op.txt" || die "$!";
open my $wh , '>',"pwl.txt" || die "$!";
my #rows;
while (my $line = <$fh>) {
my #line = split(" ",$line);
push(#rows,\#line);
}
close($fh);
my #transposed;
for my $row (#rows) {
push(#transposed,[]);
}
my $rowidx = -1;
for my $rowptr (#rows) {
++$rowidx;
my $colidx = -1;
for my $rowval (#$rowptr) {
++$colidx;
###printf("R=%d C=%d\n",$rowidx,$colidx);
my $colptr = $transposed[$colidx];
$colptr->[$rowidx] = $rowval;
}
}
for my $new_row (#transposed) {
for my $new_col (#$new_row) {
print $wh $new_col, " ";
}
print $wh "\n";
}
close($wh);
Note: It's slightly harder to transpose a non-square matrix. The above code may need to be extended a bit for that.

You're trying to shove a scalar into an array:
my #row = $line;
I think what you really want is to split on spaces:
my #row = split / /, $line;

adding my #row =map [ split], $line to my initial code is helping to print the data to pwl.txt.
however its not printing side by side.. instead it is printing to new line.
I guess because of this Mr.Borodin didn't include matrix in side while loop!
1
2
3
4
5
6
7
8
9

Here's a simpler way of doing this. It assumes all the rows are of the same length, and that all the lines in the file contain data -- i.e. there are no blank lines
The name of the input file is expected as a parameter on the command line, and the output is sent to STDOUT so it can be redirected on the command line. For instance
perl transpose.pl op.txt > pwl.txt
use strict;
use warnings 'all';
my #matrix = map [ split ], <>;
print "#$_\n" for #matrix;
print "\n";
my #transpose;
for my $i ( 0 .. $#{ $matrix[0] } ) {
$transpose[$i] = [ map { $_->[$i] } #matrix ]
}
print "#$_\n" for #transpose;
print "\n";
output
1 2 3
4 5 6
7 8 9
1 4 7
2 5 8
3 6 9

Related

Join element in an array and separate with space

I want to join the first to 16th word and 17th to 31st, etc in an array with space to one line but do not know why the code does not work. Hope to get help here.Thanks
my #file = <FILE>;
for ( $i=0; $i<=$#file; $i+=16 ){
my $string = join ( " ", #file[$i..$i+15] );
print FILE1 "$string\n";
}
Below is part of my file.
1
2
3
...
What i wan to print is
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
17 18 19 20 21....
I wouldn't do it the way you've done it.
Instead I would:
open ( my $input, '<', "your_file_name" ) or die $!;
chomp ( my #file = <$input> );
print join (" ",splice (#file, 0, 15)),"\n" while #file;
Note - I've used a lexical file handle with a 3 argument open, because that's better style.
splice removes the first 16 elements from #file each iteration, and continues until #file is empty.
Your lines have newlines attached to them. Remove them with chomp. Then loop over the array, remove 16 items and print them.
my #file = <FILE>;
chomp #file;
while (#file) {
my #temp;
INNER: for ( 0 .. 15 ) {
push #temp, shift #file || last INNER; # not or
}
print join( q{ }, #temp ), "\n";
}
This is the long implementation of the splice solution Sobrique suggested in the comments. It's does the same thing, just way more verbose.
This is the old answer before the edit:
If you only want the first 16, this is way more effective.
my $string = join q{ }, map { <FILE>; chomp; $_ } 1 .. 16;
This reads 16 lines and chomp each of them, then joins.
You might also want to use lexical file handles $fh instead of the GLOB FILE.
open my $fh, '<', $path_to_file or die $!;
Suppose if you want to read it from file, don't store the whole file into an array. Instead loop through line by line. And check the line number with $. special variable.
use warnings;
use strict;
open my $fh,"<","input.txt";
my $line;
while (<$fh>)
{
chomp;
$line.= $_." ";
print "$line\n" and $line="" if($. % 16 == 0);
END{ print "$line\n";};
}
Or this also will work
use warnings;
use strict;
open my $wh,"<","input.txt";
my $line;
foreach (;;)
{
my $data = join " ",(map { my $m=<$wh> || ""; chomp($m); $m} (0..15));
last if ($data =~m/^\s+$/);
print $data,"\n";
}
Assuming that you have FILE and FILE1 descriptors open, try:
$.%16?s!\s+! !:1 and print FILE1 $_ while <FILE>;

Issue with nested loop

I got file called numbers.txt which is basically line with 5 numbers:
they look like this:
1 2 3 4 5
What I'm trying to achieve is I want to read those numbers from the line (which already works), then in each iteration I want to add +1 to every number which was read from that file and print them on screen with print, so the final result should look like:
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5 6 7 8 9
.
#!/usr/bin/perl
use strict;
use warnings;
open("handle", 'numbers.txt') or die('unable to open numbers file\n');
$/ = ' ';
OUT: for my $line (<handle>) {
for (my $a = 0; $a < 5; $a++) {
chomp $line;
$line += 1;
print "$line ";
next OUT;
}
}
close("handle");
Haven't done looping in perl for a while now and would be great if someone could provide working example.
Also, it would be great if you could provide more than one working example, just to be future proof ;)
Thanks
You can try this on for size.
#!/usr/bin/perl
use strict;
use warnings;
open("handle", 'numbers.txt') or die('unable to open numbers file\n');
for my $line (<handle>) {
chomp $line;
for my $number (split /\s+/, $line) {
for (my $a = $number; $a < $number+5; $a++) {
print "$a ";
}
print "\n";
}
}
close("handle");
You can dispense with $/=' ' and instead let the outer loop iterate on lines of the file.
For each line you want to iterate for each number which is separated by white space, thus the split /\s+/, $line which gives you a list of numbers for the inner loop.
For your output $a starts at the number read from the file.
This will do what you're after:
use strict;
use warnings;
while(<DATA>) {
chomp;
print "$_\n";
my #split = split;
my $count = 0;
for (1..4){
$count++;
foreach (#split){
my $num = $_ + $count;
print "$num ";
}
print "\n";
}
}
__DATA__
1 2 3 4 5
Here no need to use nested loop it's always program make slower.
#!/usr/bin/perl
use strict;
use warnings;
my #num = split(" ",(<DATA>)[0]);
foreach my $inc (0..$#num)
{
print map{$inc+$_," "}#num; # Add one by one in array element
print "\n";
}
__DATA__
1 2 3 4 5
Update Added another method, this one in line with the posted approach.
Increment each number in the string, changing the string in place. Repeat that. Below are two ways to do that. Yet another method reads individual numbers and prints following integer sequences.
(1) With regular expressions. It also fits in one-liner
echo "1 2 3 4 5" | perl -e '$v = <>; for (1..5) { print $v; $v =~ s/(\d+)/$1+1/eg; }'
This prints the desired output. But better put it in a script
use warnings;
use strict;
my $file = 'numbers.txt';
open my $fh, '<', $file or die "can't open $file: $!";
while (my $line = <$fh>) {
# Add chomp($line) if needed for some other processing.
for (1..5) {
print $line;
$line =~ s/(\d+)/$1+1/eg;
}
}
The /e modifier is crucial for this. It makes the replacement side of the regex be evaluated as code instead of as a double-quoted string. So you can actually execute code there and here we add to the captured number, $1+1, for each matched number as /g moves down the string. This changes the string so the next iteration of the for (1..5) increments those, etc. I match multiple digits, \d+, which isn't necessary in your example but makes far more sense in general.
(2) Via split + map + join, also repeatedly changing the line in place
while (my $line = <$fh>) {
for (1..5) {
print $line;
$line = join ' ', map { $_+1 } split '\s+', $line;
}
}
The split gets the list of numbers from $line and feeds it to map, which increments each, feeding its output list to join. The joined string is assigned back to $line, and this is repeated. I split by \s+ to allow multiple white space but this makes it very 'relaxed' in what input format it accepts, see perlrecharclass. If you know it's one space please change that to ' '.
(3) Take a number at a time and print the integer sequence starting from it.
open my $fh, '<', $file or die "can't open $file: $!";
local $/ = ' ';
while (my $num = <$fh>) {
print "$_ " for $num..$num+4;
print "\n";
}
The magical 4 can be coded by pre-processing the whole line to find the sequence length, say by
my $len = () = $line =~ /(\d+)/g;
or by split-ing into an array and taking its scalar, then using $len-1.
Additional comments.
I recommend the three-argument open, open my $fh, '<', $file
When you check a call print the error, die "Your message: $!", to see the reason for failure. If you decide to quit, if ($bad) { die "Got $bad" }, then you may not need $!. But when an external call fails you don't know the reason so you need the suitable error variable, most often $!.
Your program has a number of problems. Here is what's stopping it working
You are setting the record separator to a single space. Your input file contains "1 2 3 4 5\n", so the while loop will iterate five times setting $line to "1 ", "2 ", "3 ", "4 ", "5\n"
Your for loop is set up to iterate five times. It does chomp $line which removes the space after the number, then increments $line and prints it. Then you jump out of the for loop, having executed it only once, with next OUT. This results in each value in the file being incremented by one and printed, so you get 2 3 4 5 6
Removing the unnecessary next OUT, produces something closer
2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9 6 7 8 9 10
There are now five numbers being printed for each number in the input file
Adding print "\n" after the for loop help separate the lines
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5 6 7 8 9
6 7 8 9 10
Now we need to print the number before it is incremented instead of afterwards. If we swap $line += 1 and print "$line " we get this
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5
6 7 8 9
What is happening here is that the 5 is still followed be a newline, which now appears in the output. The chomp won't remove this because it removes the value of $/ from the end of a string. You've set that to a space, so it will remove only spaces. The fix is to replace chomp with a substitution s/\s+//g which removes *all whitespace from the string. You also need to do that only once so I've put it outside the for loop at the top
Now we get this
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5 6 7 8 9
And this is your code as it ended up
use strict;
use warnings;
open( "handle", 'numbers.txt' ) or die('unable to open numbers file\n');
$/ = ' ';
for my $line (<handle>) {
$line =~ s/\s+//g;
for ( my $a = 0; $a < 5; $a++ ) {
print "$line ";
$line += 1;
}
print "\n";
}
close("handle");
There are a few other best practices that could improve your program
Use use warnings 'all'
Use lexical file handles, and the three-parameter form of open
Use local if you are changing Perl's built-in variables
Put $! into your die string so that you know why the open failed
Avoid the C-style for loop, and iterate over a list instead
Making these fixes as well looks like this. The output is identical to the above
use strict;
use warnings 'all';
open my $fh, '<', 'numbers.txt'
or die qq{Unable to open "numbers.txt" for input: $!};
local $/ = ' ';
for my $line ( <$fh> ) {
$line =~ s/\s+//g;
for my $a ( 0 .. 4 ) {
print "$line ";
++$line;
}
print "\n";
}

Perl: Iterating through large hash, runs out of memory

I have been trying to find values that match between two columns (columns a and column b) of a large file and print the common values, plus the corresponding column d. I have been doing this by interating through hashes, however, because the file is so large, there is not enough memory to produce the output file. Is there any other way to do the same thing using less memory resources.
Any help is much appreciated.
The script I have written thus far is below:
#!usr/bin/perl
use warnings;
use strict;
open (FILE1, "<input.txt") || die "$!\n Couldn't open input.txt\n";
open (Output, ">output.txt")||die "Can't Open output.txt ";
my $hash1={};
my $hash2={};
while (<FILE1>) {
chomp (my $line=$_);
my ($a, $b, $c, $d) = split (/\t/, $line);
if ($a) {
$hash1->{$a}{info1} = "$d"; #original_ID-> YOB
}
if ($b) {
$hash2->{$b}{info2} = "$a"; #original_ID-> sire
}
foreach my $key (keys %$hash2) {
if (exists $hash1{$a}) {
$info1 = $hash1->{$a}->{info1};
print "$a\t$info1\n";
}
}
}
close FILE1;
close Output;
print "Done\n";
To clarify, the input file is a large pedigree file. An example is:
1 2 3 1977
2 4 5 1944
3 4 5 1950
4 5 6 1930
5 7 6 1928
An example of the output file is:
2 1944
4 1950
5 1928
Does the below work for you ?
#!/usr/local/bin/perl
use strict;
use warnings;
use DBM::Deep;
use List::MoreUtils qw(uniq);
my #seen;
my $db = DBM::Deep->new(
file => "foo.db",
autoflush => 1
);
while (<>) {
chomp;
my #fields = split /\s+/;
$$db{$fields[0]} = $fields[3];
push #seen, $fields[1];
}
for (uniq #seen) {
print $_ . " " . $$db{$_} . "\n" if exists $$db{$_};
}

Read specific column in perl

I'm new in perl. I have below text file and from there I want only one Time column and next columns are values. How can I create a text file with my desire output in perl.
Time Value Time Value Time Value
1 0.353366497 1 0.822193251 1 0.780866396
2 0.168834182 2 0.865650713 2 0.42429447
3 0.323540698 3 0.865984245 3 0.856875894
4 0.721728497 4 0.634773162 4 0.563059042
5 0.545131335 5 0.029808531 5 0.645993399
6 0.143720835 6 0.949973296 6 0.14425803
7 0.414601876 7 0.53421424 7 0.826148814
8 0.194818367 8 0.942334356 8 0.837107013
9 0.291448263 9 0.242588271 9 0.939609775
10 0.500159997 10 0.428897293 10 0.41946448
I've tried below code:
use strict;
use warnings;
use IO::File;
my $result;
my #files = (q[1.txt],q[2.txt],q[3.txt]);
my #fhs = ();
foreach my $file (#files) {
my $fh = new IO::File $file, O_RDONLY;
push #fhs, $fh if defined $fh;
}
while(1) {
my #lines = map { $_->getline } #fhs;
last if grep { not defined $_ } #lines[0..(#fhs-1)];
my #result=join(qq[\t], map { s/[\r?\n]+/ /g; $_ } #lines ) . qq[\r\n];
open (MYFILE, '>>Result.txt');
print (MYFILE "#result");
close (MYFILE);
}
I'd go with split.
use warnings;
use strict;
open (my $f, '<', 'your-file.dat') or die;
while (my $line = <$f>) {
my #elems = split ' ', $line;
print join "\t", #elems[0,1,3,5];
print "\n";
}
This is a one-liner; no need to write a script:
$ perl -lanE '$,="\t"; say #F[0,1,3,5]' 1.txt 2.txt 3.txt
If you like, you can shorten it to:
$ perl -lanE '$,="\t"; say #F[0,1,3,5]' [123].txt
Right now, you're just concatenating the lines of the files together. If that doesn't give you the output you like, you need to chop some columns out.
Since your output looks like you have tab delimited files as input, I split the lines coming in by tabs. And since you only wanted the second column, I only take the column at the first offset from the split.
my $line_num = 0;
while(1) {
my #lines = map { $_->getline } #fhs;
last if grep { not defined $_ } #lines[0..$#fhs];
$line_num++;
my #rows = map { [ split /\t/ ] } #lines;
my $time_val = $rows[0][0];
die "Time values are not all equal on line #$line_num!"
if grep { $time_val != $_->[0] } #rows
;
my $result = join( q[\t], $time_val, map { $_->[1] } #rows );
open (MYFILE, '>>Result.txt');
print (MYFILE "$result\n");
close (MYFILE);
}
Of course, there is no reason to do custom coding to split delimited columns:
use Text::CSV;
...
my $csv = Text::CSV->new( { sep_char => "\t" } );
while(1) {
my #rows = map { $csv->getline( $_ ) } #fhs;
last if grep { not defined $_ } #rows[0..$#fhs];
my ( $time_val, #time_vals ) = map { $_->[0] } #rows;
my #values = map { $_->[1] } #rows;
die "Time values are not all equal on line #$line_num!"
if grep { $time_val != $_ } #time_vals
;
my $result = join( q[\t], $time_val, #values );
...
}
use strict;
use warnings;
open(FH,"<","a.txt");
print "=========== A File content =========== \n";
my $a = `cat a.txt`;
print "$a\n";
my #temp = <>;
my (#arr, #entries, #final);
foreach ( #temp ) {
#arr = split ( " ", $_ );
push #entries, #arr;
}
close FH;
my #entries1 = #entries;
for(my $i = 7; $i<=$#entries; $i=$i+2) {
push #final, $entries[$i];
}
my $size = scalar #final;
open FH1, ">", "b.txt";
print FH1 "Time \t Value\n";
for(my $i = 0; $i < $size; $i++) {
my $j = $i+1;
print FH1 "$j \t $final[$i]\n";
}
close FH1;
print "============ B file content ===============\n";
my $b = `cat b.txt`;
print "$b";
O/P:
=========== A File content ===========
Time Value Time Value Time Value
1 0.353366497 1 0.822193251 1 0.780866396
2 0.168834182 2 0.865650713 2 0.42429447
3 0.323540698 3 0.865984245 3 0.856875894
4 0.721728497 4 0.634773162 4 0.563059042
5 0.545131335 5 0.029808531 5 0.645993399
6 0.143720835 6 0.949973296 6 0.14425803
7 0.414601876 7 0.53421424 7 0.826148814
8 0.194818367 8 0.942334356 8 0.837107013
9 0.291448263 9 0.242588271 9 0.939609775
10 0.500159997 10 0.428897293 10 0.41946448
============ B file content ===============
Time Value
1 0.353366497
2 0.822193251
3 0.780866396
4 0.168834182
5 0.865650713
6 0.42429447
7 0.323540698
8 0.865984245
9 0.856875894
10 0.721728497
11 0.634773162
12 0.563059042
13 0.545131335
14 0.029808531
15 0.645993399
16 0.143720835
17 0.949973296
18 0.14425803
19 0.414601876
20 0.53421424
21 0.826148814
22 0.194818367
23 0.942334356
24 0.837107013
25 0.291448263
26 0.242588271
27 0.939609775
28 0.500159997
29 0.428897293
30 0.41946448

Best way to keep track of previous and following line in perl

What is the best/right way, in perl, of keeping the information from the previous and/or following line. For example, with this code:
while (<IN>) {
print;
}
how can it be changed to not print the line only if the previous or the next line in the file match foo, but printing otherwise?
Could you give code examples. Thanks.
Updated: Simplified exposition.
Basically, you need to keep track of two extra lines if you want to print the current lines based on information contained in two other lines. Here is a simple script with everything hard-coded:
#!/usr/bin/env perl
use strict;
use warnings;
my $prev = undef;
my $candidate = scalar <DATA>;
while (defined $candidate) {
my $next = <DATA>;
unless (
(defined($prev) && ($prev =~ /foo/)) ||
(defined($next) && ($next =~ /foo/))
) {
print $candidate;
}
($prev, $candidate) = ($candidate, $next);
}
__DATA__
1
2
foo
3
4
5
foo
6
foo
7
8
9
foo
We can generalize this to a function that takes a filehandle and a test (as a subroutine reference):
#!/usr/bin/env perl
use strict; use warnings;
print_mid_if(\*DATA, sub{ return !(
(defined($_[0]) && ($_[0] =~ /foo/)) ||
(defined($_[1]) && ($_[1] =~ /foo/))
)} );
sub print_mid_if {
my $fh = shift;
my $test = shift;
my $prev = undef;
my $candidate = scalar <$fh>;
while (defined $candidate) {
my $next = <$fh>;
print $candidate if $test->($prev, $next);
($prev, $candidate) = ($candidate, $next);
}
}
__DATA__
1
2
foo
3
4
5
foo
6
foo
7
8
9
foo
You could read your line into an array, and then if you get something that signals you in some way, pop out the last few elements of the array. Once you've finished reading everything in, you could print it:
use strict;
use warnings;
use feature qw(say);
use autodie; #Won't catch attempt to read from an empty file
use constant FILE_NAME => "some_name.txt"
or die qq(Cannot open ) . FILE_NAME . qq(for reading: $!\n);
open my $fh, "<", FILE_NAME;
my #output;
LINE:
while ( my $line = <DATA> ) {
chomp $line;
if ( $line eq "foo" ) {
pop #output; #The line before foo
<DATA>; #The line after foo
next LINE; #Skip line foo. Don't push it into the array
}
push #output, $line;
}
From there, you can print out the array with the values you don't want printed already taken care of.
for my $line ( #output ) {
say $line;
}
The only problem is that this takes memory. If your file is extremely large, you could run out of memory.
One way to get around this is to use a buffer. You store your values in an array, and shift out the last value when you push another in the array. If the value read in is foo, you can reset the array. In this case, the buffer will contain at most one line:
#! /usr/bin/env perl
use strict;
use warnings;
use autodie;
use feature qw(say);
my #buffer;
LINE:
while ( my $line = <DATA> ) {
chomp $line;
if ( $line eq "foo" ) {
#buffer = (); #Empty buffer of previous line
<DATA>; #Get rid of the next line
next LINE; #Foo doesn't get pushed into the buffer
}
push #buffer, $line;
if ( #buffer > 1 ) { #Buffer is "full"
say shift #buffer; #Print out previous line
}
}
#
# Empty out buffer
#
for my $line ( #buffer ) {
say $line;
}
__DATA__
2
3
4
5
6
7
8
9
10
11
12
13
1
2
foo
3
4
5
foo
6
7
8
9
foo
Note that it is very possible that I might attempt to read from an empty file when I skip the next line. This is okay. The <$fh> will return either an empty string or undef, but I can ignore that. I'll catch the error when I go back to the top of my loop.
I didn't see that you had any specific criteria for "best", so I'll give you a solution that may be "best" along a different axis than those presented so far. You could use Tie::File and treat the entire file as an array, then iterate the array using an index. The previous and next lines are just $index-1 and $index+1 respectively. You just have to worry a little about your indices going beyond the bounds of your array. Here's an example:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010; # just for "say"
use Tie::File;
tie my #array, 'Tie::File', "filename" or die;
for my $i (0..$#array) {
if ($i > 0 && $i < $#array) { # ensure $i-1 and $i+1 make sense
next if $array[$i-1] =~ /BEFORE/ &&
$array[$i+1] =~ /AFTER/;
}
say $array[$i];
}
If it's more convenient, you can specify a filehandle instead of a filename and Tie::File also has some parameters to control memory usage or change what it means to be a "line" if you want that. Check the docs for more info.
Anyway, that's another way to do what you want that might be conceptually simpler if you are familiar with arrays and like to think in terms of arrays.
I would read the file into an array, with each line being an array element, then you can do the comparisons. The only real design consideration is the size of the file being read into memory.