http://www.perlmonks.org?node_id=863979


in reply to Re: Count similar characters in a row
in thread Count similar characters in a row

Thanks Monks,

They all work well. However, except the perl one liners suggested no other scripts does what I wanted which in the end was to count the number ie 3 and print it on the screen!

Also, how do I adapt the scripts to do this for a list (a second file - random.txt) separated by space as shown in the example below:

2 3 2 3 2 1 2 1 3 2 1 3 3 3 1 3 1 2

Notice there is a space in the first line. The numbers are clustered in the manner in which the r's common to all columns should be counted. For example print only the r's in column 2, then print all the r's common in all rows of column 3 and 2, then print the r's common to all rows in column 3 , 2 and 1.

so the printed output for my file my_column_file.txt should below:

0 a b h 1 - r z 3 u - u 4 r x r 5 r t r 6 r r r 7 r r r 8 r r r <p>should be:(the out put with explainations) </p> 4 3 3 (ie for 2 32 321) 4 5 3 (ie for 2 13 213) 5 5 3 (ie for 3 31 312) the out put desired 4 3 3 4 5 3 5 5 3

Replies are listed 'Best First'.
Re^3: Count similar characters in a row
by johngg (Canon) on Oct 07, 2010 at 13:50 UTC

    Addressing your first issue is simple a matter of incrementing a count rather than printing the line.

    $ perl -Mstrict -wE ' > open my $fh, q{<}, \ <<EOD or die $!; > 0 a b h > 1 - r z > 3 u - u > 4 r x r > 5 r t r > 6 r r r > 7 r r r > 8 r r r > EOD > > my $count; > while ( <$fh> ) > { > my( $seq, @cols ) = split; > $count ++ if tr{r}{} == scalar @cols; > } > say $count;' 3 $

    The supplementary question requires a little more jiggery-pokery.

    $ perl -Mstrict -wE ' > open my $rand, q{<}, \ <<EOD or die $!; > 2 32 321 > 2 13 213 > 3 31 312 > EOD > > my @tests = > map [ split ], > <$rand>; > > open my $fh, q{<}, \ <<EOD or die $!; > 0 a b h > 1 - r z > 3 u - u > 4 r x r > 5 r t r > 6 r r r > 7 r r r > 8 r r r > EOD > > my @results; > while ( <$fh> ) > { > my @cols = split; > foreach my $idx ( 0 .. $#tests ) > { > foreach my $subidx ( 0 .. $#{ $tests[ $idx ] } ) > { > my @posns = split m{}, $tests[ $idx ]->[ $subidx ]; > $results[ $idx ]->[ $subidx ] ++ > if scalar @posns == grep { q{r} eq $cols[ $_ ] } @pos +ns; > } > } > } > > say qq{@$_} for @results;' 4 3 3 4 5 3 5 5 3

    I hope this is useful.

    Cheers,

    JohnGG

      Hi JohnGG,

      I tried running the script but this error kept popping up! Note that I modified it to take files:

      my $FILENAME1 = "random.txt"; open(INFILE1, $FILENAME1); my @tests = map [ split ], <INFILE1>; my $FILENAME2 = "my_column_file.txt"; open(INFILE2, $FILENAME2); my @results; while ( <INFILE2> ) { my @cols = split; foreach my $idx ( 0 .. $#tests ) { foreach my $subidx ( 0 .. $#{ $tests[ $idx ] } ) { my @posns = split m{}, $tests[ $idx ]-[ $subidx ]; $results[ $idx ]-[ $subidx ] ++ if scalar @posns == grep { q{r} eq $cols[ $_ ] } @posn +s; } } } say qq{@$_} for @results;

      the error was:

      Can't modify anonymous list ([]) in postincrement (++) at gg.pl line 2 +0, near "] ++" syntax error at gg.pl line 26, near "say qq{@$_}" Execution of Jgg.pl aborted due to compilation errors.

      Line 26 is this one: $results $idx - $subidx ++. Also I notice an error/flag in the last line. Should i change the say to print?

        If you compare the code I gave you and your modified script you will notice that you have lost a couple of very important characters, changing the dereference operator(->) to the subtraction operator (-), i.e.

        my @posns = split m{}, $tests[ $idx ]-[ $subidx ]; $results[ $idx ]-[ $subidx ] ++

        should be

        my @posns = split m{}, $tests[ $idx ]->[ $subidx ]; $results[ $idx ]->[ $subidx ] ++

        With regard to say, it was introduced with Perl 5.10 so use print if your version is earlier. If on 5.10, you have to put use 5.010 in your script to access newer features like say. I've not used Perl 5.12 yet so I'm not sure whether the use is necessary there.

        You have changed the script to use files but I would recommend that you use the three-argument form of open, employ lexical filehandles and also check for success, giving the o/s error on failure. Instead of

        open(INFILE1, $FILENAME1);

        do

        open my $input1FH, q{<}, $FILENAME1 or die qq{open: < $FILENAME1: $!\n};

        I hope this helps you moveforward.

        Cheers,

        JohnGG