CODEWITHSUNDEEP
regexperl
chinmoy khaund
chinmoy khaund

Reputation: 119

Perl program for tabulation

F1.txt

tom
x
a=1 b=2 c=3 d=4 e=5 
y
b=11 r=12
bob

a=6 b=7 c=8 e=10

result

F2.txt

.            X         Y
name  a  b  c  d  e  b   r

tom   1  2  3  4  5  11  12

bob   6  7  8  -  10 -   -

Can you kindly help me in this problem of mine? I have a file F1.txt. My job is to convert that file into a format as shown in example F2.txt. I tried doing this by deleting all string values after Tom and Bob except the numerical values in F1.txt, and then concatenate. Here is the code:

use strict;

open (file100,"< data.txt");
open (file101,">>F3.txt");

my @array = < file100>;

print file101 "name    a    b      c      d     e\n\n";
print file101 "tom @array[1]\n\n";
print file101 "bob @array[3]\n\n";

Here data.txt:

tom

1 2 3 4 5

bob 

6 7 8 10

The output that I am getting with this code is:

F3.txt

name  a  b  c  d  e

tom   1  2  3  4  5

bob   6  7  8  10

The expected output should be like showed in F2.txt but not like F3.txt

Upvotes: 2

Views: 204

Answers (3)

Borodin
Borodin

Reputation: 126742

This will do what you ask

use strict;
use warnings;

my %data;
my @names;

while (<DATA>) {
  next unless /\S/;
  if (/=/) {
    %{ $data{$names[-1]} } = /[^\s=]+/g;
  }
  else {
    push @names, /(\S+)/;
  }
}

my %keys = map %$_, values %data;
my @keys = sort keys %keys;

printf "%-6s %s\n\n", 'name', join '  ', @keys;
printf "%-6s %s\n\n", $_, join '  ', map $_ // '-', @{$data{$_}}{@keys} for @names;

__DATA__
tom

a=1 b=2 c=3 d=4 e=5

bob

a=6 b=7 c=8 e=10

output

name   a  b  c  d  e

tom    1  2  3  4  5

bob    6  7  8  -  10

Update

For older versions (before v5.10) Perl will see the defined-or operator // as a misplaced regular expression match. For these platforms the second printf statement can be written like this

printf "%-6s %s\n\n", $_, join '  ', map { defined $_ ? $_ : '-' } @{$data{$_}}{@keys} for @names;

Upvotes: 3

cdtits
cdtits

Reputation: 1128

#!/usr/bin/env perl

my $pr = "%-12s";
my @headers = qw/name a b c d e/;
my %names;
while (<DATA>) {
    chomp;
    s/^\s+//g;
    s/\s+$//g;
    my $line = <DATA>;
    $line =~ s/^\s+//g;
    $line =~ s/\s+$//g;
    %{$names{$_}} = split /\s*=\s*|\s+/, $line;
}

printf $pr x @headers . "\n", @headers;
for (keys %names) {
    my @ds = ($_);
    for my $k (@headers[1..$#headers])
    {
        my $v = $names{$_}->{$k};
        push @ds, $v ? $v : '-';
    }
    printf $pr x @ds . "\n", @ds;
}

__DATA__
 tom
 a = 10.1 b = 2 c = 300.89 d=4145 e=55
bobby
 a= 60 b = 74.2 c = 8 e = 10.25

output:

name    a       b       c       d       e       
tom     1       2       3       4       5       
bob     6       7       8       -       10

Upvotes: 4

Hameed
Hameed

Reputation: 2277

For your understanding I am taking a long cut with this:

use strict;
use warnings;

my %hash;
my @vals;
my $key;
my $val;
my $name;
my @headings;
my $file100;

open ($file100, "<", "data.txt");


while (<$file100>)
{
        chomp;
        next if (! m/\S/);
        if (m/=/)
        {
            @vals = $_ =~  /(.+)=(.+)\b/g;
            while (@vals)
            {
                $key = shift @vals;
                if (!grep(/^$key$/, @headings))
                {
                    push (@headings, $key);
                }

                $val = shift @vals;
                $hash{$name}{$key} = $val;
            }
        } else {
           $name = $_;
}

print "name\t" . join ("\t", @headings) . "\n\n";
for my $key1 (keys %hash)
{
    print $key1;
    for (@headings)
    {
        if (defined $hash{$key1}{$_})
        {
            print "\t" . $hash{$key1}{$_};
        } else
        {
            print "\t-";
        }
    }
    print "\n\n";
}

You need to pick up a Perl book and study it.

Upvotes: 1

Related Questions