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

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

Hi Monks,

I read a png file and want to work with the image data, A set of colors I consider as foreground all others as background. I convert the png data into a string of 0/1s and store them as one string per line (@sw)

I have two slow working versions ....

My first try was to read out every pixel-color:

use GD::Simple; my $png = GD::Image->newFromPng('test.png'); my @sw; my ($width, $height) = $png->getBounds; for my $x ( 0 .. $width-1 ) { for my $y ( 0 .. $height-1 ) { $sw[$y].=getPixel($x,$y); } } sub getPixel { my $p; my ($index) = $png->getPixel($_[0],$_[1]); my ($r,$g,$b) = $png->rgb($index); if ($b>128 || $r>128) {$p=0;} else {$p=1;} return $p; }
But this was really, really slow.

The next try was to use GD::wbmp. It is much faster, but for several foreground-colors this seems far away from optimum.

use GD::Simple; my $png = GD::Image->newFromPng('test.png'); my @sw; my $pdata=''; my ($bx, $by) = $png->getBounds; my @col; # foreground colo +rs for (0..$png->colorsTotal) { my ($r,$g,$b) = $png->rgb($_); push (@col,$_) unless ($b>128 || $r>128); } $pdata |= ~$png->wbmp($_) foreach (@col); our $zlen=int(($bx+7)/8); # number of Bytes + per line my $pos=6; my $y=0; # position after +Header of WBMP while ($pos<length($pdata)) { $sw[$y]=''; for (1..$zlen) {$sw[$y].=sprintf("%08b",ord(substr($pdata,$pos++,1 +))); } # convert binary data into string $y++; }
Do you have a better(faster) idea, to convert the png data to a 0/1 bit stream by using the color definition in @col ?

Thanks for your help !!!

Replies are listed 'Best First'.
Re: working with png data
by vr (Deacon) on Sep 09, 2019 at 16:19 UTC

    Are you sure you need to extract all possible colors into that @col? There can be up to 2**24 of them in a PNG... A couple alternatives to mask areas with both R and B not more than 128 (if I'm reading your code and guessing your intent correctly):

    use strict; use warnings; use feature 'say'; use Data::Dump 'dd'; use PDL; use PDL::NiceSlice; use PDL::IO::Image; #system 'convert rose: -resize 50% rose.png'; my $image = PDL::IO::Image-> new_from_file('rose.png') -> pixels_to_pdl; my $mask = ($image(,,(0)) <= 128) & ($image(,,(2)) <= 128); print $mask; __END__ [ [1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 1 +1] [1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 +1] [1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 +1] [1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 +1] [1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +0] [1 1 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +0] [1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +0] [1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +0] [1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 +0] [1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 +0] [1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 +1] [1 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 +1] [1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 +1] [1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 +1] [1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 +1] [1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 +1] [1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 +1] [1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1] ]

    Or using Imager:

    use strict; use warnings; use feature 'say'; use Data::Dump 'dd'; use Imager; my $i = Imager-> new( file => 'rose.png' ); my $w = $i-> getwidth; my $m = Imager::transform2( { rpnexpr => << 'END' x y getp1 !pix @pix red 128 le @pix blue 128 le and 255 0 if 0 0 rgb END }, $i )-> convert( preset => 'red' ); $m-> write( data => \my $data, type => 'raw' ); $data =~ tr/\0\377/01/; say for unpack "(a$w)*", $data; __END__ 11111111111111000000000011111100111 11111111111111000000000011111110111 11111111111111100000100001111110001 11111111111111110011011001111111111 11111111111110000000010000000110001 11111111111100000000000000000000000 11110001111000000000000000000000000 11110000000000000000000000000000000 11111000000000000000000000000000000 11111100000000000000000000000011100 11111100000000000000000000000010100 11110000000000000000000000000111111 11100000100000000000000000000111111 11100001100000000000000000001101111 11100001100000000000000000011011111 11111111000000000000000000011111111 11111111000000000000000010011111111 11111111100000001011001110011111111 11111100111000000011111110111111111 11111000010000000111111111111111111 11111000000000000111111111111111111 11111000000000000111111111111111111 11111000000000000011111111111111111

    Here RPN DSL (described to compile to very fast code) is used to compute result and put it into red channel, which then is extracted to a one channel image. Last 3 lines are there to produce demo output only.

    Both results match of course, but dump of your @sw is different. Either I misread your code, or it has problems (it emits warnings, by the way), I didn't investigate.

      Thanks for your answer ! Imager and PDL are nice modules. I did not know them up to now. Really worth to invest some time.

      It took me a while to install Imager. The problem was that the libpng was missing ..... But now its running.

      $data =~ tr/\0\377/01/;

      can be removed, if the ascii code is already used in the "if" of transform2:

      49 48 if

      I could not manage to install PDL yet. Prerequisite 'Module::Compile' is not passing for WIN 10 (report). Only one test is failing.(data1_t). Any idea what I could do here ? Force install ?

      I saw also minor differences in the output of my code and yours. I guess that the decoding of the PNG is done minor differently in the different modules. I have to read more about png coding if this idea can be true or compare the color at some dedicated pixels.

        The decoding is more different than I thought:

        use warnings; use strict; use GD::Simple; use Imager; $\="\n"; my @txt; $txt[0]=" GD::Simple <=> Imager"; my ($x1,$x2,$y)=(1375,1395,29); print "Line $y: Pixel $x1->$x2 "; my $png = GD::Image->newFromPng('test.png'); my ($width, $height) = $png->getBounds; print "GD::Simple Image dimensions: height = $height, width = $width"; for my $x ( $x1 .. $x2 ) { my @c=$png->rgb($png->getPixel($x,$y)); push (@txt,sprintf("%4d: [%3d,%3d,%3d]",$x,@c)); } my $i = Imager-> new; $i->read(file => 'test.png') or die "Cannot read: ", $i->errstr; $width = $i->getwidth(); $height = $i->getheight(); print "Imager Image dimensions: height = $height, width = $width\n +"; for my $x ( $x1 .. $x2 ) { my $color = $i->getpixel( x => $x, y => $y ); my ( $r, $g, $b,$a ) = $color->rgba(); $txt[$x-$x1+1].=sprintf(" <=> %4d: [%3d,%3d,%3d]",$x,$r,$g,$b); } print $_ foreach @txt;
        The output for my example is:
        Line 29: Pixel 1375->1395 GD::Simple Image dimensions: height = 2560, width = 1600 Imager Image dimensions: height = 2560, width = 1600 GD::Simple <=> Imager 1375: [ 4, 2, 4] <=> 1375: [ 1, 1, 1] 1376: [ 4, 2, 4] <=> 1376: [ 1, 1, 1] 1377: [ 4, 2, 4] <=> 1377: [ 1, 1, 1] 1378: [ 4, 2, 4] <=> 1378: [ 1, 1, 1] 1379: [ 12, 13, 12] <=> 1379: [ 11, 11, 11] 1380: [ 28, 28, 28] <=> 1380: [ 31, 31, 31] 1381: [ 68, 68, 68] <=> 1381: [ 61, 61, 61] 1382: [100,100,100] <=> 1382: [100,100,100] 1383: [100,100,100] <=> 1383: [102,102,102] 1384: [ 68, 68, 68] <=> 1384: [ 68, 68, 68] 1385: [ 52, 52, 52] <=> 1385: [ 48, 48, 48] 1386: [ 36, 34, 36] <=> 1386: [ 40, 40, 40] 1387: [ 36, 34, 36] <=> 1387: [ 33, 33, 33] 1388: [ 20, 26, 28] <=> 1388: [ 26, 26, 26] 1389: [ 20, 20, 20] <=> 1389: [ 20, 20, 20] 1390: [ 12, 13, 12] <=> 1390: [ 14, 14, 14] 1391: [ 4, 10, 12] <=> 1391: [ 9, 9, 9] 1392: [ 4, 6, 4] <=> 1392: [ 6, 6, 6] 1393: [ 4, 2, 4] <=> 1393: [ 4, 4, 4] 1394: [ 4, 2, 4] <=> 1394: [ 2, 2, 2] 1395: [ 4, 2, 4] <=> 1395: [ 1, 1, 1]

Re: working with png data
by Discipulus (Abbot) on Sep 09, 2019 at 10:23 UTC
    Hello Anonymous Monk,

    sorry only sparse hints here: I see you use GD::Simple did you benchmarked your code using directly GD ? Just to be sure simple is not also slower.

    You are processing a lot of data: you can use more cores to parse it. MCE offers you MCE::Map that sounds a good choice for your case. MCE::Examples shows code to chunk input data preserving the order. If you are able to rearrange one of the example I bet you get a big speed gain.

    Show your progresses, please ;)



    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
      If you dont know where the bottleneck lies.... Throw in threads and hope it speeds up sprintf?
        the time is wasted in :
        $pdata |= ~$png->wbmp($_) foreach (@col);
        the while loop with the sprintf is not the bottleneck. (maybe not optimal, but contribute less)
Re: working with png data
by marioroy (Vicar) on Sep 10, 2019 at 13:42 UTC

    Greetings,

    Running parallel is possible for both examples. The latter makes use of relay (for orderly) and gather capabilities in MCE.

    First Example

    use strict; use warnings; use GD::Simple; use MCE::Map; my $png = GD::Image->newFromPng('test.png'); my ($width,$height) = $png->getBounds; MCE::Map->init( max_workers => 4 ); my @sw = mce_map { my ($y,$str) = ($_,''); for my $x (0..$width - 1) { $str .= getPixel($x,$y); } $str; } 0..$height - 1; MCE::Map->finish(); # print $_, "\n" for @sw; sub getPixel { my ($index) = $png->getPixel($_[0],$_[1]); my ($r,$g,$b) = $png->rgb($index); my $p = ($b > 128 || $r > 128) ? 0 : 1; return $p; }

    Second Example

    use strict; use warnings; use GD::Simple; use MCE; my $png = GD::Image->newFromPng('test.png'); my ($bx,$by) = $png->getBounds; my @col; # foreground colors for (0..$png->colorsTotal) { my ($r,$g,$b) = $png->rgb($_); push (@col,$_) unless ($b>128 || $r>128); } my $pdata = ''; MCE->new( max_workers => 4, chunk_size => 1, input_data => \@col, init_relay => 1, # loads MCE::Relay gather => sub { # this runs inside the parent $pdata |= $_[0]; }, user_func => sub { # run parallel my $val = ~$png->wbmp($_); # send the val to the parent process # relay makes it run serially and orderly MCE::relay { MCE->gather($val); }; } )->run(); our $zlen = int(($bx + 7) / 8); # number of Bytes per line my $pos = 6; my $y = 0; # position after Header of WBMP my @sw; while ($pos < length($pdata)) { $sw[$y] = ''; for (1..$zlen) { # convert binary data into string $sw[$y] .= sprintf("%08b",ord(substr($pdata,$pos++,1))); } # print $sw[$y], "\n"; $y++; }

    The examples run well. Output matches the OP's non-parallel demonstrations.

    Regards, Mario

      Thanks. Thats also a cool idea ......
Re: working with png data
by jcb (Chaplain) on Sep 09, 2019 at 16:22 UTC

    Have you tried PDL?