Re: Loop, but print once.

One way to do it is to create state variables to remember previous lines. This gets you half the way there ... but, you get the idea.

#!/usr/bin/env perl
use warnings;
use strict;

my $prev_first  = 0;
my $prev_second = 0;    # you need to make use of this too
while (<DATA>) {
    chomp;
    my ($first, $second, @data) = split /\t/;
    if ($first == $prev_first) {
        print "    $second @data\n";
    }
    else {
        print "$first - $second @data\n";
        $prev_first = $first;
    }
}

__DATA__
1    300    1_a    30    1_b    20
1    300    2_a    22    2_b    12
1    320    1_a    10    1_b    30
1    320    2_a    32    2_b    22
2    312    1_a    30    1_b    20
2    312    2_a    22    2_b    12
2    310    1_a    31    1_b    20
2    310    2_a    21    2_b    12
[download]

This prints:

1 - 300 1_a 30 1_b 20
    300 2_a 22 2_b 12
    320 1_a 10 1_b 30
    320 2_a 32 2_b 22
2 - 312 1_a 30 1_b 20
    312 2_a 22 2_b 12
    310 1_a 31 1_b 20
    310 2_a 21 2_b 12
[download]

I used actual tab characters in the __DATA__, not "\" followed by "t".

Comment on Re: Loop, but print once. Select or Download Code

Replies are listed 'Best First'.
Re^2: Loop, but print once. by Narveson (Chaplain) on Mar 04, 2008 at 20:00 UTC
Can we get the rest of the way there? Of course we can. Can we do it without array subscripts? Why, yes. We can always do it without array subscripts. my $SPACE = q{ }; my $PRINTF = '%3s %3s %s %s %s %s'; # remember cells from previous row my @prev_cells = ( $SPACE ) x 6; while (<DATA>) { # append a dash to the first column substr($_, 1, 0, ' -'); my @cells = split /\t/, $_; # suppress display if same as above my @display_cells = map { $_ eq shift @prev_cells ? $SPACE : $_ } @cells; printf $PRINTF, @display_cells; @prev_cells = @cells; } __DATA__ 1 300 1_a 30 1_b 20 1 300 2_a 22 2_b 12 1 320 1_a 10 1_b 30 1 320 2_a 32 2_b 22 2 312 1_a 30 1_b 20 2 312 2_a 22 2_b 12 2 310 1_a 31 1_b 20 2 310 2_a 21 2_b 12 [download] prints `1 - 300 1_a 30 1_b 20 2_a 22 2_b 12 320 1_a 10 1_b 30 2_a 32 2_b 22 2 - 312 1_a 30 1_b 20 2_a 22 2_b 12 310 1_a 31 1_b 20 2_a 21 2_b 12` [download]	[reply] [d/l] [select]
Re^3: Loop, but print once. by ikegami (Patriarch) on Mar 05, 2008 at 07:30 UTC
I don't think you get the intended result for `1 300 1_a 30 1_b 20 1 300 2_a 22 2_b 12 1 320 1_a 10 1_b 30 1 320 2_a 32 2_b 22 2 320 1_a 31 1_b 20 2 320 2_a 21 2_b 12` [download] It gives `2 - 1_a 31 1_b 20` where I'd expect `2 - 320 1_a 31 1_b 20` Also, there's usually a desire to only omit repeated header fields, yet your solution can omit any number of fields, even all of them. Fix: use strict; use warnings; my $PRINTF = '%3s %3s %s %s %s %s'; my $HEADERS = 2; my @prev_cells; while (<DATA>) { # Input data. my @cells = split /\t/, $_; # Format the data for printing. $cells[0] .= ' -'; # Remove redundant headers. my @display_cells = @cells; if (@prev_cells) { for (@display_cells[ 0 .. $HEADERS-1 ]) { last if $_ ne shift @prev_cells; $_ = ''; } } @prev_cells = @cells; # Output data. printf $PRINTF, @display_cells; } __DATA__ 1 300 1_a 30 1_b 20 1 300 2_a 22 2_b 12 1 320 1_a 10 1_b 30 1 320 2_a 32 2_b 22 2 320 1_a 31 1_b 20 2 320 2_a 21 2_b 12 2 320 2_a 33 2_b 44 [download] `1 - 300 1_a 30 1_b 20 2_a 22 2_b 12 320 1_a 10 1_b 30 2_a 32 2_b 22 2 - 320 1_a 31 1_b 20 2_a 21 2_b 12 2_a 33 2_b 44` [download]	[reply] [d/l] [select]
Re^4: Loop, but print once. by Narveson (Chaplain) on Mar 07, 2008 at 06:24 UTC
You're right. Thanks. I feel honored to have my submission reviewed so thoroughly. The one change I fail to see the motive for is the decision not to initialize `@prev_cells` when it is declared, but instead to test for its existence on every pass through the loop.	[reply] [d/l]
Re^5: Loop, but print once. by ikegami (Patriarch) on Mar 07, 2008 at 06:47 UTC