Re^5: Imagecat - show color images in a terminal ('Memoization' for PDL)

[Anonymous Monk]

Computations above take noticeable time, as opposed to simple algorithm in OP. If final section is formatted as:

##################################
########### Ready to go
##################################

use Time::HiRes 'time';

my $t = time;

$image   = t_lab-> apply(( !t_srgb )-> apply( $image ));
$palette = t_lab-> apply(( !t_srgb )-> apply( $palette ));

my $indexed = delta_e_2000( 
    $palette, $image-> dummy( 1, $plt_size )
)-> minimum_ind;

print time - $t, "\n";

print @pixels[ @$_ ], "\n" for @{ $indexed-> unpdl };

then time is 4.56991696357727 for, ultimately, a single Perl statement; using e.g. DejaVuSansMono and console/font size approximately as used to produce picture above. Not cheap. For 10 brushes (i.e. glyphs from this font) and all combinations of FG/BG colors (16*16), the palette size upper limit is 2560. It was reduced to 'only' 1854, excluding trivial duplicates. Distorted image size is 142 by 89.

For each of its 12638 pixels, calculate 1854 distances with

https://en.wikipedia.org/wiki/Color_difference#CIEDE2000

and pick the best palette index, i.e. ~23e6 times. Maybe we are lucky we have PDL, and this horrible formula was already implemented in C.

Unfortunately, it's immediately obvious it'll take same long time if image is a flat single color rectangle (or simple logo, etc.), while it must be 12638 times faster!

For our test image, distorted and scaled to 142x89, only half (6265 out of 12638) RGB triplets are unique (Imager::getcolorcount). It follows, run time should be twice as low.

I didn't find anything w.r.t. 'memoization' and PDL, maybe not tried hard enough? Duplication in arrays and expensive computations are inevitable. It only requires to reduce fat data to unique slim set, keeping track how to fatten result to original shape. Not 'memoization' per definition, but in spirit.

##################################
########### Ready to go
##################################

use Time::HiRes 'time';

my $t = time;

my ( undef, $w, $h ) = $image-> dims;

my $fat_rgb     = $image-> clump( 1, 2 );
my $perm_2_sort = $fat_rgb-> qsortveci;
my $sorted      = $fat_rgb-> dice_axis( 1, $perm_2_sort );
my $enumerated  = $sorted-> enumvecg;
my $selector    = $enumerated-> uniqind;
my $slim_rgb    = $sorted-> dice_axis( 1, $selector );

$slim_rgb = t_lab-> apply(( !t_srgb )-> apply( $slim_rgb ));
$palette  = t_lab-> apply(( !t_srgb )-> apply( $palette ));

my $slim_indexed = delta_e_2000( 
    $palette, $slim_rgb-> dummy( 1, $plt_size )
)-> minimum_ind;

my $indexed = $slim_indexed
    -> index( $enumerated )             # fatten
    -> index( $perm_2_sort-> qsorti )   # permute to original
    -> reshape( $w, $h );               # reshape :)

print time - $t, "\n";

print @pixels[ @$_ ], "\n" for @{ $indexed-> unpdl };

And time now is exactly as predicted: 2.25233697891235. (PDL has uniq and uniqind pair. But only uniqvec i.e. no uniqvecind. Hence workaround with vector enumeration)

###############

In fact, RGB (or Lab) points in palette are spaced so very sparsely. If further speed is required, some precision can be sacrificed, and even slimmer dataset fed to expensive formula. With

$fat_rgb-> sever-> inplace-> and2( 0b1111_1110 );

i.e. RGB in image reduced to 7 bits (if GD always does it (to alpha), why can't we?), time becomes 1.3685450553894. With 2 bits zeroed, it's 0.765566825866699; and result is practically the same if observer was not warned. With reduction to 5 bits (again 2x faster) the picture is beginning to feel slightly uncomfortable compared to 'lossless' result.

###############

W.r.t. need to sever above, I'm confused if clump creates dataflow. But what follows looks like plain bugs:

pdl> $x = zeroes 3,2,2; $y = $x-> clump( 1,2 )
pdl> $x .= 3
pdl> p $x, $y, $y-> uniqvec

[
 [
  [3 3 3]
  [3 3 3]
 ]
 [
  [3 3 3]
  [3 3 3]
 ]
]

[
 [3 3 3]
 [3 3 3]
 [3 3 3]
 [3 3 3]
]

[
 [3 3 3]
]

pdl> $x = zeroes 3,2,2; $y = $x-> clump( 1,2 )
pdl> $y .= 3
pdl> p $x, $y, $y-> uniqvec

[
 [
  [3 3 3]
  [3 3 3]
 ]
 [
  [3 3 3]
  [3 3 3]
 ]
]

[
 [3 3 3]
 [3 3 3]
 [3 3 3]
 [3 3 3]
]

[
 [0 0 0]
]

So far, only uniqvec looks weird. But:

pdl> $x = zeroes 3,2,2; $y = $x-> clump( 1,2 )
pdl> p $y

[
 [0 0 0]
 [0 0 0]
 [0 0 0]
 [0 0 0]
]

pdl> $x .= 3
pdl> p $x, $y, $y-> uniqvec

[
 [
  [3 3 3]
  [3 3 3]
 ]
 [
  [3 3 3]
  [3 3 3]
 ]
]

[
 [0 0 0]
 [0 0 0]
 [0 0 0]
 [0 0 0]
]

[
 [0 0 0]
]

What?! But I only printed the $y, compared to 1st demo.

[etj]

Yes, clump definitely creates dataflow. The doc however doesn't say so, but should! It now does on git master.

[etj]

Further investigation of what I agree are bugs. I was already aware of issues with dataflow and clump, thanks to the progenitor of PDL, the mighty Karl Glazebrook himself. See https://sourceforge.net/p/pdl/mailman/message/58730063/ for my initial thoughts, though since that email, I've made decent progress in tracking that down, and am just about at the stage where I think I've fixed the 3rd point in my list there (deliberately doing it in that order). That's involved finding subtle behaviours that downstream modules, especially Data::Frame, rely on, but weren't in the main-PDL tests (they are now).

Here is the test I've constructed from your cases above. Interestingly, only the [0,1] case (don't physicalise the clump-ee, and mutate the clump-ee rather than the original) works perfectly, as you note above. Also interestingly, my first go at this using $pdl->flat->unpdl produced different results from $pdl->unpdl.

for ([0,0], [0,1], [1,0], [1,1]) {
  my ($phys_clump, $mutate_orig) = @$_;
  my $orig = zeroes 3,2,1;
  my $clump = $orig->clump(1,2);
  $clump->make_physvaffine if $phys_clump;
  ($mutate_orig ? $orig : $clump) .= 3;
  my $got = $orig->unpdl;
  is_deeply $got, [[[(3)x3],[(3)x3]]], "phys_clump=$phys_clump mutate_
+orig=$mutate_orig orig" or diag explain $got;
  $got = $clump->unpdl;
  is_deeply $got, [[(3)x3],[(3)x3]], "phys_clump=$phys_clump mutate_or
+ig=$mutate_orig clump" or diag explain $got;
  $got = $clump->uniqvec->unpdl;
  is_deeply $got, [[(3)x3]], "phys_clump=$phys_clump mutate_orig=$muta
+te_orig uniqvec" or diag explain $got;
}

[etj]

This was in fact a genuine bug, which almost certainly appeared in 2.078 (Apr 2022). It is (I believe) fixed in the just-made dev-release of PDL, 2.085_01. Please try it and see if you agree.

Interestingly enough, this bug got reported independently by different people as a GitHub issue, on here, and on the mailing-list, in the last month or so, despite having existed for nearly 2 years.