logeshwaran has asked for the wisdom of the Perl Monks concerning the following question:

Input:
id|Name|app1|app2
1|abc|234|231|
2|xyz|123|215|
1|abc|265|321|
3|asd|213|235|

In the above input if id gets repeated I am appending app1,app2 . And printing it once . My expected output as follows,
Output:
id|Name|app1|app2
1|abc|234,265|231,321|
2|xyz|123|215|
3|asd|213|235|

My Code:
#! usr/bin/perl
use strict;
use warnings;
my $basedir = 'E:\Perl\Input\\';
my $file ='doctor.txt';
my $counter = 0;
my %RepeatNumber;
my $pos=0;
 
open(OUTFILE, '>', 'E:\Perl\Output\DoctorOpFile.csv') || die $!;
open(FH, '<', join('', $basedir, $file)) || die $!;
my $line = readline(FH);

unless ($counter) {
chomp $line;
         print OUTFILE $line;
         print OUTFILE "\n";
    }
    while ($line = readline(FH)) {
chomp $line;
 my @obj = split('\|',$line);
if($RepeatNumber{$obj[0]}++)
{
my $str1= join("|",$obj[0]);
my $str2=join(",",$obj[2],$obj[3]);
print OUTFILE join("|",$str1,$str2);
print OUTFILE "\n";
}
}

[download]

Replies are listed 'Best First'.
Re: appending values based on criteria
by toolic (Bishop) on Sep 04, 2015 at 12:58 UTC
    Stuff all your data into a hash-of-hashes-of-arrays before printing it: 
    use warnings;
use strict;

my $line = readline(DATA);
print $line;

my %RepeatNumber;
while (<DATA>) {
    chomp;
    my @obj = split /\|/;
    push @{ $RepeatNumber{ $obj[0] }{app1} }, $obj[2];
    push @{ $RepeatNumber{ $obj[0] }{app2} }, $obj[3];
    $RepeatNumber{ $obj[0] }{name} = $obj[1];
}

for my $n (sort {$a <=> $b} keys %RepeatNumber) {
    my $app1 = join ',', @{ $RepeatNumber{$n}{app1} };
    my $app2 = join ',', @{ $RepeatNumber{$n}{app2} };
    print join('|', $n, $RepeatNumber{$n}{name}, $app1, $app2), "\n";
}

__DATA__
id|Name|app1|app2
1|abc|234|231|
2|xyz|123|215|
1|abc|265|321|
3|asd|213|235|

    [download]

    Outputs: 

    id|Name|app1|app2
1|abc|234,265|231,321
2|xyz|123|215
3|asd|213|235

    [download]

    UPDATED: Use numeric sort (thanks AnomalousMonk)

[reply]
[d/l]
[select]
Re: appending values based on criteria
by GotToBTru (Prior) on Sep 04, 2015 at 13:03 UTC

    Use the debugger to step through your code, and I think you will see why it doesn't work. You could replace that entire unless {} with the first print statement inside it.

    You need to remember the $line the first time you see it; storing it in your hash would be a good choice.

    Update: s/until/unless/

    Dum Spiro Spero
[reply]
[d/l]
Re: appending values based on criteria
by Preceptor (Deacon) on Sep 04, 2015 at 14:34 UTC
    Crossposted question deserves a crossposted answer. Here's what I came up with: 
    #!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use 5.14.0;

my %stuff;

#extract the header row.
#use the regex to remove the linefeed, because
#we can't chomp it inline like this. 
#works since perl 5.14
#otherwise we could just chomp (@header) later. 
my ( $id,  @header ) = split( /\|/, <DATA> );
chomp (@header);

while (<DATA>) {
    #turn this row into a hash of key-values.
    my %row;
    ( $id, @row{@header} ) = split(/\|/);
    #diag print
    print Dumper \%row;

    #iterate each key, and insert into $row.
    foreach my $key ( keys %row ) {
        push( @{ $stuff{$id}{$key} }, $row{$key} );
    }
}

#diag print
print Dumper \%stuff;

foreach my $id ( sort keys %stuff ) {

    #join this record by '|'.
    print join('|',
        $id,
        #turn inner arrays into comma separated via map.
        map {
            my %seen;
            #use grep to remove dupes - e.g. "abc,abc" -> "abc"
            join( ",", grep !$seen{$_}++, @$_ )
        } @{ $stuff{$id} }{@header}
        ),
        "\n";
}

__DATA__
id|Name|app1|app2
1|abc|234|231|
2|xyz|123|215|
1|abc|265|321|
3|asd|213|235|

    [download]
    • We iterate each line of the input, and make a hash of arrays, keyed on `id`.
    • Then we iterate the hash of arrays, and use map/join/grep to remove duplicates, collapse the arrays into strings (So we don't end up with an "abc,abc" field)

    As a result it'll generate: 

    id|Name|app1|app2
1|abc|234,265|231,321
2|xyz|123|215
3|asd|213|235

    [download]

    Therefore handles arbitrary fields and arbitrary numbers of 'collisions' neatly.

[reply]
[d/l]
[select]
Re: appending values based on criteria
by stevieb (Canon) on Sep 04, 2015 at 13:06 UTC

    Welcome to the Monastery, logeshwaran!

    When cross-posting a question to multiple sites, it's polite to advise that you've done so, so that people can review your other posts to see if answers have already been provided.

[reply]
Re: appending values based on criteria
by Anonymous Monk on Sep 04, 2015 at 20:11 UTC 
    #!/usr/bin/perl

# http://perlmonks.org/?node_id=1140995

use strict;
use warnings;

$_ = <<END;
id|Name|app1|app2
1|abc|234|231|
2|xyz|123|215|
1|abc|265|321|
3|asd|213|235|
END

1 while s/^(\d+\|\w+\|)\K([\d,|]+\n)(.*)^\1([\d|]+)\n/
  my ($gap, @tmp) = ($3, split m{\|}, $4);
  $2 =~ s#(?=\|)#',' . shift @tmp#ger . $gap /mes;

print;

    [download]

    hehehe :)

[reply]
[d/l]

Back to Seekers of Perl Wisdom