How can I optimize this haskell function

Question

I need to find the closest color in a palette ps to a given color p. How do I make the function nearestColor as fast as possible, without changing the type of Pixel8 or PixelRGB8. So far I have tried inlining.

import qualified Data.Vector as V

type Pixel8 = Word8    

data PixelRGB8 = PixelRGB8 {-# UNPACK #-} !Pixel8 -- Red
                           {-# UNPACK #-} !Pixel8 -- Green
                           {-# UNPACK #-} !Pixel8 -- Blue
           deriving (Eq, Ord, Show)

nearestColor :: PixelRGB8 -> Vector PixelRGB8 -> PixelRGB8
nearestColor p ps = snd $ V.minimumBy comp ds
  where
    ds = V.map (\px -> (dist2Px px p, px)) ps
    comp a b = fst a `compare` fst b

dist2Px :: PixelRGB8 -> PixelRGB8 -> Int
dist2Px (PixelRGB8 r1 g1 b1) (PixelRGB8 r2 g2 b2) = dr*dr + dg*dg + db*db
  where
    (dr, dg, db) =
      ( fromIntegral r1 - fromIntegral r2
      , fromIntegral g1 - fromIntegral g2
      , fromIntegral b1 - fromIntegral b2 )

What have you tried so far? You could try profiling it, you could inline those local functions ds and comp, you could compile to core and search for bottlenecks, then compile to assembly and make sure that you have tight loops. — bheklilr
– bheklilr, Commented Jan 13, 2014 at 15:54
I suspect building a vector with only the distances, and using minIndex to lookup the result in the original vector could be faster: ps ! V.minIndex (V.map (\px -> dist2Px px p) ps) — Tarmil
– Tarmil, Commented Jan 13, 2014 at 17:07
What exactly do you want to optimise: time for a single function call, or average for a whole lot of calls for different colours but the same palette? — leftaroundabout
– leftaroundabout, Commented Jan 13, 2014 at 17:42

leftaroundabout · Accepted Answer · 2014-01-13 20:15:16Z

6

If you want to use a single palette and request different colours, I'd first flip your signature:

type Palette = V.Vector PixelRGB8
nearestColor :: Palette -> PixelRGB8 -> PixelRGB8

That facilitates partial application, and allows the palette configuration to be memoised.

Next, you want to do that: re-store the palette in a data structure suitable for fast lookup. Since you're basically interested in Euclidean distance in ℝ³ (BTW not really ideal for colour comparison), this is a very common problem. A classic structure is the k-d tree, which has long been used for such a nearest-neighbour search. There's sure enough a Haskell library available, which quite a convenient interface for you:

import qualified Data.Trees.KdTree a s KD

instance KD.Point PixelRGB where
  dimension _ = 3
  coord 0 (PixelRGB r _ _) = fromIntegral r
  coord 1 (PixelRGB _ g _) = fromIntegral g
  coord 2 (PixelRGB _ _ b) = fromIntegral b
  dist2 = fromIntegral . dist2Px

Then we can transform a palette into such a tree:

type FastPalette = KD.KdTree PixelRGB8
accelPalette :: Palette -> FastPalette
accelPalette = KD.fromList . V.toList

And finally just use the library-provided next neighbour search:

nearestColor palette = fromJust . KD.nearestNeighbor fpal
 where fpal = accelPalette palette

edited Jan 13, 2014 at 20:15

answered Jan 13, 2014 at 18:06

leftaroundabout

121k6 gold badges185 silver badges337 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Yofe Over a year ago

I up voted, because this is a great answer. Unfortunately, I'm restricted to only use packages in the Haskell Platform. btw there are some types coord1 ... = fromIntegral g, etc

leftaroundabout Over a year ago

Well, you can of course also re-implement the k-d tree yourself, it's not that difficult.

Collectives™ on Stack Overflow

How can I optimize this haskell function

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related