Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

How to use a pdl as an index into another pdl

by Barrabas (Novice)
on Apr 10, 2020 at 18:56 UTC ( #11115346=perlquestion: print w/replies, xml ) Need Help??

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

Oh great and venerable ones...

I am trying to create a PDL color "Cube" array of the counts of each color in an image.

The image is a PDL of dimension(width,height,3) of RGB values:

> my $Image = PDL::IO::Image->new_from_file("SomeImage.jpg"); > my $Pixels = $Image->pixels_to_pdl; > print $Pixels->info; PDL: Byte D [1920,1920,3]

The color count is a pdl cube of dimension 256,256,256:

> my $Colors = zeroes(long,256,256,256);

I would like to iterate over the pixels in the image, incrementing the element in the $Colors cube indexed by the RGB value of each pixel.

> my $P2 = $Pixels->clump(2); # Collapses $Pixels to [3686400,3] > my $P3 = $P2->mv(0,1); # Reverses $Pixels to [3,3686400] > $Colors->indexND($P3)++; # Thread over $P3 2nd dimension, index +into $Colors, and increment > print $Colors->at(0,0,0); # Print count of black pixels 1

There are many black pixels in the image, so the count at RGB(0,0,0) should be fairly large. Looking through the $Color pdl, it *appears* that colors are being set to 1, but not incremented. IOW, the cube is sprinkled with 1 values where I would expect it to be sprinkled with color counts.

My two questions are:

1) What is my mistake, and

2) Is there a straightforward PDL way to do this? (Ie - thread one PDL as an index into another for incrementing)

Replies are listed 'Best First'.
Re: How to use a pdl as an index into another pdl
by vr (Curate) on Apr 11, 2020 at 00:07 UTC

    It's histogram you are looking for, not index. Actually, indexND example pretty clear shows that it does something else. In your case, some selected elements from all-zeroes piddle became incremented from 0 to 1, that's all. Rather (demo output looks correct to me):

    use strict; use warnings; use feature 'say'; use PDL; use PDL::IO::Image; use open IO => 'raw'; my $data = `convert -size 5x5 radial-gradient:red-green bmp:-`; my $im = PDL::IO::Image-> new_from_file( \$data ) -> pixels_to_pdl -> long; my $flat = $im-> copy; $flat-> slice( [],[],2 )-> inplace-> shiftleft( 16, 0 ); $flat-> slice( [],[],1 )-> inplace-> shiftleft( 8, 0 ); my $cube = $flat-> mv( 2, 0 ) -> sumover -> flat -> hist( 0, 0x1000000, 1 ) -> reshape( 256, 256, 256 ); ### Demo say $im; say my $uniq_reds = $im-> slice( [],[],0 )-> uniq; say my $uniq_greens = $im-> slice( [],[],1 )-> uniq; say $cube-> dice( $uniq_reds, $uniq_greens, 0 ); __END__ [ [ [ 0 0 0 0 0] [ 0 75 128 75 0] [ 0 128 255 128 0] [ 0 75 128 75 0] [ 0 0 0 0 0] ] [ [128 128 128 128 128] [128 91 64 91 128] [128 64 0 64 128] [128 91 64 91 128] [128 128 128 128 128] ] [ [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 75 128 255] [0 64 91 128] [ [ [ 0 0 0 1] [ 0 0 4 0] [ 0 4 0 0] [16 0 0 0] ] ]

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11115346]
Approved by LanX
Front-paged by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (5)
As of 2021-10-15 20:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (68 votes). Check out past polls.

    Notices?