Count and print in perl

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

Replies are listed 'Best First'.
Re: Count and print in perl by Corion (Patriarch) on Apr 17, 2017 at 09:53 UTC
Maybe you can show us what code you have already written and where you are stuck? It's hard to give good advice when we don't know where you are actually encountering problems. Is your problem in reading the file? Is your problem in splitting up the parts of the file? Is your problem in printing out the parts of the file?	[reply]
Re^2: Count and print in perl by kanikas16 (Initiate) on Apr 17, 2017 at 11:25 UTC
my problem is how to split the file and how to print in defined format. I have tried this <$str_len = length($line1); if($str_len > 72){ my @split_line = unpack("(A32)*" , $line1); > But it is not solving my problem.because after 11 count one character is incrementing so not printing aligned format.	[reply]
Re^3: Count and print in perl by 1nickt (Canon) on Apr 17, 2017 at 11:35 UTC
... because after 11 count one character is incrementing so not printing aligned format ... See sprintf. `perl -Mstrict -Mwarnings -E ' my @x = qw/ 123 1234567890 12345678901 /; say sprintf("%-11s length %s", $_, length $_) for @x; '` [download] Output: `123 length 3 1234567890 length 10 12345678901 length 11` [download] Hope this helps! The way forward always starts with a minimal test.	[reply] [d/l] [select]
Re: Count and print in perl by johngg (Canon) on Apr 17, 2017 at 13:28 UTC
It is not clear what you mean by "binary" file. Do you have a file like the one I've constructed here? johngg@shiraz:~/perl/Monks > perl -Mstrict -Mwarnings -E ' open my $inFH, q{<}, \ <<EOF or die $!; 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 +1 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 4 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 + 1 0 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 6 1 1 0 0 0 0 0 1 1 0 0 0 1 +0 0 0 1 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 8 1 1 0 0 0 0 0 1 1 0 0 0 + 1 0 0 0 1 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 10 1 1 0 0 0 0 0 1 1 0 + 0 0 1 0 0 0 1 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 12 1 1 0 0 0 0 0 +1 1 0 0 0 1 0 0 0 1 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 EOF chomp( my $text = <$inFH> ); close $inFH or die $!; my $packed = pack q{C*}, map { 0 + $_ } split m{\s+}, $text; print $packed;' > spw1188105.dat johngg@shiraz:~/perl/Monks > hexdump -C spw1188105.dat 00000000 01 01 00 00 00 00 00 00 00 00 01 00 00 00 00 00 \|......... +.......\| 00000010 00 00 02 01 01 00 00 00 00 00 01 01 00 00 00 01 \|......... +.......\| 00000020 00 00 00 01 03 01 01 01 00 00 00 00 00 00 01 00 \|......... +.......\| 00000030 00 00 00 00 00 00 04 01 01 01 00 00 00 00 00 00 \|......... +.......\| 00000040 01 00 00 00 00 00 01 00 05 01 01 00 00 00 00 00 \|......... +.......\| 00000050 01 01 00 00 00 01 00 00 00 01 06 01 01 00 00 00 \|......... +.......\| 00000060 00 00 01 01 00 00 00 01 00 00 00 01 07 01 01 00 \|......... +.......\| 00000070 01 00 00 00 00 00 01 00 00 00 00 00 00 00 08 01 \|......... +.......\| 00000080 01 00 00 00 00 00 01 01 00 00 00 01 00 00 00 01 \|......... +.......\| 00000090 09 01 01 00 00 01 00 00 00 00 01 00 00 00 00 00 \|......... +.......\| 000000a0 00 00 0a 01 01 00 00 00 00 00 01 01 00 00 00 01 \|......... +.......\| 000000b0 00 00 00 01 0b 01 01 00 00 00 01 00 00 00 01 00 \|......... +.......\| 000000c0 00 00 00 00 00 00 0c 01 01 00 00 00 00 00 01 01 \|......... +.......\| 000000d0 00 00 00 01 00 00 00 01 0d 01 01 00 00 00 00 01 \|......... +.......\| 000000e0 01 01 01 00 00 00 00 00 00 00 \|......... +.\| 000000ea [download] Or something else? Please clarify. Cheers, JohnGG	[reply] [d/l]
Re^2: Count and print in perl by Anonymous Monk on Apr 17, 2017 at 16:50 UTC
print pack 'C*', map 0 + $_, split /\s+/, <DATA>; __DATA__ 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 +1 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 4 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 + 1 0 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 6 1 1 0 0 0 0 0 1 1 0 0 0 1 +0 0 0 1 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 8 1 1 0 0 0 0 0 1 1 0 0 0 + 1 0 0 0 1 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 10 1 1 0 0 0 0 0 1 1 0 + 0 0 1 0 0 0 1 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 12 1 1 0 0 0 0 0 +1 1 0 0 0 1 0 0 0 1 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 [download]	[reply] [d/l]
Re^3: Count and print in perl by johngg (Canon) on Apr 17, 2017 at 21:51 UTC
Assuming Anonymonk is actually kanikas16 who forgot to log in I'll take that as a yes, in which case something along these lines:- johngg@shiraz:~/perl/Monks > perl -Mstrict -Mwarnings -E ' my $inFile = q{spw1188105.dat}; open my $inFH, q{<}, $inFile or die qq{open: < $inFile: $!\n}; while ( my $bytesRead = read $inFH, my $record, 18 ) { printf q{%-3d} x 18 . qq{%s\n}, map( ord, split m{}, $record ), q{x} x 35; } close $inFH or die qq{close: < $inFile: $!\n};' 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 4 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 6 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 8 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 10 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 12 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxx +xxxxxxxxxxxxxxxxxxx [download] I hope this is heading in the right direction. Cheers, JohnGG	[reply] [d/l]
Re^4: Count and print in perl by kanikas16 (Initiate) on Apr 18, 2017 at 10:36 UTC
Re^5: Count and print in perl by johngg (Canon) on Apr 18, 2017 at 12:55 UTC
Re^4: Count and print in perl by Anonymous Monk on Apr 18, 2017 at 17:07 UTC
Re^2: Count and print in perl by kanikas16 (Initiate) on Apr 18, 2017 at 07:32 UTC
Hi, i Have one text file in which binary data is available where from 1 to 25 is the iteration of binary no. 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 +1 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 4 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 + 1 0 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 6 1 1 0 0 0 0 0 1 1 0 0 0 1 +0 0 0 1 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 8 1 1 0 0 0 0 0 1 1 0 0 0 + 1 0 0 0 1 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 10 1 1 0 0 0 0 0 1 1 0 + 0 0 1 0 0 0 1 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 12 1 1 0 0 0 0 0 +1 1 0 0 0 1 0 0 0 1 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 14 1 1 0 0 0 + 0 0 1 1 0 0 0 1 0 0 0 1 15 1 1 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 16 1 1 +0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 17 1 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 18 + 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 19 1 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 + 0 20 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 21 1 1 0 0 0 0 0 0 0 1 0 0 0 +1 1 0 0 22 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 23 1 1 0 0 0 0 0 0 0 1 0 + 0 0 0 0 0 0 24 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 25 0 1 0 0 0 0 0 1 +1 1 0 0 0 0 0 0 0 [download] ----------------------------------------------------------------------------------------------------------------------------------- and i want to split this file in aligned format like this ----------------------------------------------------------------------------------------------------------------------------------- 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 4 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 6 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 8 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 10 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 12 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 14 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 15 1 1 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 16 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 17 1 1 0 0 0 0 0 0 0 1 1 1 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 18 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 19 1 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 20 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 21 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 22 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 23 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 24 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 25 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [download] ----------------------------------------------------------------------------------------------------------------------------------- my final output file should be like format.xxxxx is space between lines.	[reply] [d/l] [select]
Re: Count and print in perl by BillKSmith (Monsignor) on Apr 17, 2017 at 13:49 UTC
If you wish to use unpack, you need one template for lines 1-9 and another for lines 10-99. use strict; use warnings; use List::MoreUtils qw(natatime); my $string = '1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 ' . '2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 ' . '3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 ' . '4 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 ' . '5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 ' . '6 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 ' . '7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 ' . '8 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 ' . '9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 ' . '10 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 ' . '11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 ' . '12 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 ' . '13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0' ; my $template1 = 'A2' x 18; my $template10 = 'A3' . 'A2' x 17; my $it = natatime 18, unpack( $template1 x 9 . "($template10)".'*' , $ +string); while (my @vals = $it->()) { printf '%2d' x 18 . "\n", @vals } OUTPUT: 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 4 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 6 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 8 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 10 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 12 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 [download] Bill	[reply] [d/l]
Re^2: Count and print in perl by kanikas16 (Initiate) on Apr 20, 2017 at 06:49 UTC
Hi, This is working for me but what if i change no of bits to (13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0). i removed two bits ,then <my $template1 = 'A2' x 18; my $template10 = 'A3' . 'A2' x 17; my $it = natatime 18, unpack( $template1 x 9 . "($template10)".'*' , $ > ,then its no working for me . i need generlised code which work for every input given whatever it is 18 bits or 19 bits or 20 bits .it will produce Table in aligned format from 1 to 13 iteration.	[reply]
Re^3: Count and print in perl by BillKSmith (Monsignor) on Apr 21, 2017 at 17:20 UTC
Given only what you have told us so far, that task is impossible! We need a specification (not just an example) of your input 'file' format. Your original post implied that your file is an ASCII (not 'binary') file of fixed length records without separators. The only way to tell the end of a line was by its length. That is definitely a job for unpack. Note: I intentionally wrote the input in my example in a way that made every character (especially whitespace) explicit. If your lines are separated by an INPUT_RECORD_SEPARATOR (e.g. newline) unpack is probably overkill. Without a specification, we have to guess how to parse your file. That has not been going well for you. Bill	[reply]
Re: Count and print in perl by AnomalousMonk (Archbishop) on Apr 18, 2017 at 18:37 UTC
Rather that trying to shoehorn pack into a solution, it seems simpler to me to regex it (caution: needs Perl version 5.10+ for `\K` operator): c:\@Work\Perl\monks\kanikas16>perl -wMstrict -le "use 5.010; ;; my $s = '(1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 ' . '2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 ' . '3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 ' . '10 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 ' . '11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 ' . '987 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0)' ; print qq{<<$s>> \n}; ;; my $bar = qq{\n} . 'x' x 35 . qq{\n}; $s =~ s{ \A \( \K }{\n}xms; $s =~ s{ \d+ \s+ (?: [01] \s+){17} \K }{$bar}xmsg; print qq{<<$s>>}; " <<(1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 + 0 1 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 10 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 11 + 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 987 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0)>> <<( 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 10 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 987 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0)>> [download] This is based on the updated version of kanikas16's OP and (almost!) exactly produces the desired output. The only thing I can't get simply via substitutions is the use of a 36-`'x'` separator after row 8 (per the OP) rather than the 35-`'x'` separator used everywhere else. I'm assuming (and hoping!) this is just a typo; it would be possible to accommodate something like this with a substitution, but messy! (Note: This solution needs Perl 5.10+ for the `\K` operator, but a non-`\K` solution is fairly painless; let me know if it's needed.) Give a man a fish: `<%-{-{-{-<`	[reply] [d/l] [select]
Re^2: Count and print in perl by kanikas16 (Initiate) on Apr 20, 2017 at 06:52 UTC
Hi, This is working for me but what if i change no of bits to (13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0). i removed two bits ,then `$s =~ s{ \d+ \s+ (?: [01] \s+){17} \K }{$bar}xmsg;` [download] then its no working for me . i need generlised code which work for every input given whatever it is 18 bits or 19 bits or 20 bits .it will produce Table in aligned format from 1 to 13 iteration.	[reply] [d/l]
Re^3: Count and print in perl by AnomalousMonk (Archbishop) on Apr 20, 2017 at 14:54 UTC
Note: Perl version 5.10+ is now needed for both the `\K` operator and the `++` possessive quantifier: c:\@Work\Perl\monks\kanikas16>perl -wMstrict -le "use 5.010; ;; my $s = join(' ', map { $_, map { int rand 2 } 1 .. (10 + rand 10) } 1 .. 1 +3) ; $s = qq{($s)}; print qq{'$s' wrap-around! \n}; ;; my $bar = qq{\n} . 'x' x 35 . qq{\n}; ;; $s =~ s{ \A [(] \K }{\n}xms; $s =~ s{ (?: \G \| (?<= \n)) \d+ (?: \s+ [01] \b)++ \K \s+ }{$bar}xmsg +; print qq{'$s'}; " '(1 0 0 1 1 0 1 1 1 1 0 0 2 0 0 1 0 1 0 1 0 0 1 1 3 0 0 1 1 1 1 1 1 1 +0 0 0 0 1 1 4 0 0 0 0 1 1 0 1 1 1 0 1 5 1 1 1 0 0 0 0 0 0 1 6 1 0 0 1 1 0 0 1 0 +1 1 0 1 0 7 0 1 0 1 1 1 1 1 1 1 0 0 1 0 0 8 1 1 0 0 0 1 1 0 1 1 1 0 1 1 0 0 1 1 +9 1 0 1 0 0 1 0 0 1 1 10 1 0 0 1 1 0 1 0 0 1 1 0 11 1 1 0 0 0 0 0 1 0 1 12 0 1 0 + 0 1 1 0 0 0 1 0 1 0 1 0 1 1 1 13 1 0 1 1 1 0 1 0 1 0 0 0 1 0)' wrap-around! '( 1 0 0 1 1 0 1 1 1 1 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 2 0 0 1 0 1 0 1 0 0 1 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 3 0 0 1 1 1 1 1 1 1 0 0 0 0 1 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 4 0 0 0 0 1 1 0 1 1 1 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 5 1 1 1 0 0 0 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 6 1 0 0 1 1 0 0 1 0 1 1 0 1 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 7 0 1 0 1 1 1 1 1 1 1 0 0 1 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 8 1 1 0 0 0 1 1 0 1 1 1 0 1 1 0 0 1 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 9 1 0 1 0 0 1 0 0 1 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 10 1 0 0 1 1 0 1 0 0 1 1 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 11 1 1 0 0 0 0 0 1 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 12 0 1 0 0 1 1 0 0 0 1 0 1 0 1 0 1 1 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 13 1 0 1 1 1 0 1 0 1 0 0 0 1 0)' [download] Update: If the number of 0/1s in each numbered group cannot be known before processing, a regex approach might actually be best. If this number is known, one of the other approaches in this thread might be better. This is especially true if the pesky `( )` parentheses can be clipped off of the string before processing and added back, if necessary, afterward. I'm attracted to regexes as solutions for problems like this because of their puzzle-like nature. Update 2: The Anonymous Monk's `\b (?= \d) (?! [01] \b)` here is simpler, with the same effect. Nice. Give a man a fish: `<%-{-{-{-<`	[reply] [d/l] [select]
Re: Count and print in perl by ww (Archbishop) on Apr 18, 2017 at 16:32 UTC
TIMTOWTDI -- without resorting to `sprintf` or `pack` ... and with humble bows to johngg for explicitly questioning OP's use of "binary file" (which the example ain't) and to BillKSmith for addressing the need for multiple templates, depending on how many digits occur in the LineNumers! #!/usr/bin/perl -w use strict; # 1188105 my @data = qw(1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 1 1 0 0 0 0 0 1 1 +0 0 0 1 0 0 0 1 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 4 1 1 1 0 0 0 0 0 + 0 1 0 0 0 0 0 1 0 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 6 1 1 0 0 0 0 +0 1 1 0 0 0 1 0 0 0 1 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 8 1 1 0 0 0 + 0 0 1 1 0 0 0 1 0 0 0 1 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 10 1 1 0 + 0 0 0 0 1 1 0 0 0 1 0 0 0 1 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 12 +1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 +0); my $linemarker = " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; my $item; my $seen = '0'; print "\n(\n"; # op wants to start (& end) the printout with a par +en, # but -- in practice -- if the array is read fro +m # a "binary file," AS STATED, there won't be any pa +rens # in the array for $item(@data) { if ( $item !~ /\d+/ ) { $item = ord($item); # xlate char to num } elsif ( ($item == 1) && ($seen =~ /0/) ) { # first array eleme +nt? # Then it's a linen +umber (LN) print "$item "; # so print LN with +spacing $seen = "seen"; # set flag so future number 1s won't +be taken for LNs next; # and move on to next array element } elsif ( (10 > $item) && ($item > 1) && ($seen =~ /seen/) ) { # HACK to line up t +he elements print "\n$linemarker\n$item "; next; } elsif ( (100 > $item) && ($item > 9) && ($seen =~ /seen/) ) { print "\n$linemarker\n$item "; # if LN > 9 and < 9 +9, # print fewer space +s -- end HACK } else { print "$item "; } } print "\n)\n"; [download] OUTPUT of 1188105.pl ( 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 4 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 6 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 8 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 10 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 12 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 ) [download] Update: Missed credit to 1nickt for `sprintf` templating. My bad! ++ to each. *Questions containing the words "doesn't work" (or their moral equivalent) will usually get a downvote from me unless accompanied by:* code verbatim error and/or warning messages *a coherent explanation of what "doesn't work* actually means.**	[reply] [d/l] [select]
Re: Count and print in perl by kcott (Archbishop) on Apr 20, 2017 at 02:10 UTC
G'day kanikas16, Welcome to the Monastery. I expect you just need split and splice: #!/usr/bin/env perl -l use strict; use warnings; my $data = '1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 2 1 1 0 0 0 0 0 1 1 0 +0 0 1 0 0 0 1 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 4 1 1 1 0 0 0 0 0 0 + 1 0 0 0 0 0 1 0 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 6 1 1 0 0 0 0 0 +1 1 0 0 0 1 0 0 0 1 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 8 1 1 0 0 0 0 + 0 1 1 0 0 0 1 0 0 0 1 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 10 1 1 0 0 + 0 0 0 1 1 0 0 0 1 0 0 0 1 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 12 1 +1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0' +; my $sep = 'x' x 35; my @bits = split / /, $data; print "@{[ splice @bits, 0, 18 ]}\n$sep" while @bits; [download] Output: 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 2 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 3 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 4 1 1 1 0 0 0 0 0 0 1 0 0 0 0 0 1 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 5 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 6 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 7 1 1 0 1 0 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 8 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 9 1 1 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 10 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 11 1 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 12 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 0 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 13 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx [download] [Note: I saw your original post but ignored it because the data formats couldn't be accurately discerned (no `<code>...</code>` tags). I've now replied, days later, as the formatting has been fixed. Follow the guidelines in "How do I post a question effectively?" to get faster and better responses.] — Ken	[reply] [d/l] [select]
A reply falls below the community's threshold of quality. You may see it by logging in.
Re: Count and print in perl by Anonymous Monk on Apr 17, 2017 at 09:46 UTC
please suggest something . Read perlintro, begin	[reply]
Re: Count and print in perl by Anonymous Monk on Apr 18, 2017 at 19:36 UTC
Regex to break before numbers except 0 and 1: `s/\b(?=\d)(?![01]\b)/\nxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n/g; s/^\(\K/\n/;` [download]	[reply] [d/l]