-- | One-dimensional lookup tables
module Geometry.LookupTable.Lookup1 (
      LookupTable1(..)
    , lookupInterpolated
    , lookupBiasLower
) where



import           Control.DeepSeq
import           Data.Ord.Extended
import qualified Data.Vector       as V

import Numerics.Interpolation



-- | Vector-based lookup table. Functions assume that values must increase with
-- vector index, enabling binary search.
newtype LookupTable1 a b = LookupTable1 (V.Vector (a, b))
    deriving (LookupTable1 a b -> LookupTable1 a b -> Bool
(LookupTable1 a b -> LookupTable1 a b -> Bool)
-> (LookupTable1 a b -> LookupTable1 a b -> Bool)
-> Eq (LookupTable1 a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
LookupTable1 a b -> LookupTable1 a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
LookupTable1 a b -> LookupTable1 a b -> Bool
== :: LookupTable1 a b -> LookupTable1 a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
LookupTable1 a b -> LookupTable1 a b -> Bool
/= :: LookupTable1 a b -> LookupTable1 a b -> Bool
Eq, Eq (LookupTable1 a b)
Eq (LookupTable1 a b)
-> (LookupTable1 a b -> LookupTable1 a b -> Ordering)
-> (LookupTable1 a b -> LookupTable1 a b -> Bool)
-> (LookupTable1 a b -> LookupTable1 a b -> Bool)
-> (LookupTable1 a b -> LookupTable1 a b -> Bool)
-> (LookupTable1 a b -> LookupTable1 a b -> Bool)
-> (LookupTable1 a b -> LookupTable1 a b -> LookupTable1 a b)
-> (LookupTable1 a b -> LookupTable1 a b -> LookupTable1 a b)
-> Ord (LookupTable1 a b)
LookupTable1 a b -> LookupTable1 a b -> Bool
LookupTable1 a b -> LookupTable1 a b -> Ordering
LookupTable1 a b -> LookupTable1 a b -> LookupTable1 a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b}. (Ord a, Ord b) => Eq (LookupTable1 a b)
forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> Bool
forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> Ordering
forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> LookupTable1 a b
$ccompare :: forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> Ordering
compare :: LookupTable1 a b -> LookupTable1 a b -> Ordering
$c< :: forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> Bool
< :: LookupTable1 a b -> LookupTable1 a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> Bool
<= :: LookupTable1 a b -> LookupTable1 a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> Bool
> :: LookupTable1 a b -> LookupTable1 a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> Bool
>= :: LookupTable1 a b -> LookupTable1 a b -> Bool
$cmax :: forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> LookupTable1 a b
max :: LookupTable1 a b -> LookupTable1 a b -> LookupTable1 a b
$cmin :: forall a b.
(Ord a, Ord b) =>
LookupTable1 a b -> LookupTable1 a b -> LookupTable1 a b
min :: LookupTable1 a b -> LookupTable1 a b -> LookupTable1 a b
Ord, Int -> LookupTable1 a b -> ShowS
[LookupTable1 a b] -> ShowS
LookupTable1 a b -> String
(Int -> LookupTable1 a b -> ShowS)
-> (LookupTable1 a b -> String)
-> ([LookupTable1 a b] -> ShowS)
-> Show (LookupTable1 a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> LookupTable1 a b -> ShowS
forall a b. (Show a, Show b) => [LookupTable1 a b] -> ShowS
forall a b. (Show a, Show b) => LookupTable1 a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> LookupTable1 a b -> ShowS
showsPrec :: Int -> LookupTable1 a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => LookupTable1 a b -> String
show :: LookupTable1 a b -> String
$cshowList :: forall a b. (Show a, Show b) => [LookupTable1 a b] -> ShowS
showList :: [LookupTable1 a b] -> ShowS
Show)

instance (NFData a, NFData b) => NFData (LookupTable1 a b) where
    rnf :: LookupTable1 a b -> ()
rnf (LookupTable1 Vector (a, b)
vec) = Vector (a, b) -> ()
forall a. NFData a => a -> ()
rnf Vector (a, b)
vec

-- | Look up the index of a value, reducing the search space by binary search until
-- it has size 1.
--
-- If the value is not actually in the LUT but between the LUT’s values, you can
-- use 'interpolate' to get a linear interpolation.
lookupIndex :: Ord a => LookupTable1 a b -> a -> Int
lookupIndex :: forall a b. Ord a => LookupTable1 a b -> a -> Int
lookupIndex (LookupTable1 Vector (a, b)
lut) a
needle = Int -> Int -> Int
search Int
0 (Vector (a, b) -> Int
forall a. Vector a -> Int
V.length Vector (a, b)
lut)
  where
    search :: Int -> Int -> Int
search Int
lo Int
hi
        | Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mid = Int
mid
        | Int
hi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
mid = Int
mid
        | Bool
otherwise
            = let (a
pivotS, b
_) = Vector (a, b)
lut Vector (a, b) -> Int -> (a, b)
forall a. Vector a -> Int -> a
V.! Int
mid
            in case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
pivotS a
needle of
                Ordering
LT -> Int -> Int -> Int
search Int
mid Int
hi
                Ordering
EQ -> Int
mid
                Ordering
GT -> Int -> Int -> Int
search Int
lo Int
mid
        where
        mid :: Int
mid = (Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lo) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

-- | Find a value in the lookup table using binary search, interpolating linearly
-- around the search result. Clips for out-of-range values.
lookupInterpolated :: LookupTable1 Double Double -> Double -> Double
lookupInterpolated :: LookupTable1 Double Double -> Double -> Double
lookupInterpolated LookupTable1 Double Double
lut Double
needle = LookupTable1 Double Double -> Double -> Int -> Double
interpolate LookupTable1 Double Double
lut Double
needle (LookupTable1 Double Double -> Double -> Int
forall a b. Ord a => LookupTable1 a b -> a -> Int
lookupIndex LookupTable1 Double Double
lut Double
needle)

-- | Lookup in the LUT, with bias towards the left, i.e. when searching a value not
-- present in the LUT, return the closest one before.
lookupBiasLower :: Ord a => LookupTable1 a b -> a -> (a, b)
lookupBiasLower :: forall a b. Ord a => LookupTable1 a b -> a -> (a, b)
lookupBiasLower lut :: LookupTable1 a b
lut@(LookupTable1 Vector (a, b)
rawLut) a
needle
  = let ix :: Int
ix = LookupTable1 a b -> a -> Int
forall a b. Ord a => LookupTable1 a b -> a -> Int
lookupIndex LookupTable1 a b
lut a
needle
    in Vector (a, b)
rawLut Vector (a, b) -> Int -> (a, b)
forall a. Vector a -> Int -> a
V.! Int
ix

-- | Look at left/right neighbours. If they’re there and the needle is between it
-- and the found pivot index, then linearly interpolate the result value between
-- them.
interpolate :: LookupTable1 Double Double -> Double -> Int -> Double
interpolate :: LookupTable1 Double Double -> Double -> Int -> Double
interpolate (LookupTable1 Vector (Double, Double)
lut) Double
needle Int
pivotIndex = case (Vector (Double, Double)
lut Vector (Double, Double) -> Int -> Maybe (Double, Double)
forall a. Vector a -> Int -> Maybe a
V.!? (Int
pivotIndexInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), Vector (Double, Double)
lut Vector (Double, Double) -> Int -> (Double, Double)
forall a. Vector a -> Int -> a
V.! Int
pivotIndex, Vector (Double, Double)
lut Vector (Double, Double) -> Int -> Maybe (Double, Double)
forall a. Vector a -> Int -> Maybe a
V.!? (Int
pivotIndexInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) of
    -- Interpolate between pivot and left neighbour?
    (Just (Double
leftS, Double
leftT), (Double
pivotS, Double
pivotT), Maybe (Double, Double)
_)
        | (Double, Double) -> Double -> Bool
forall a. Ord a => (a, a) -> a -> Bool
between (Double
leftS, Double
pivotS) Double
needle -> (Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Double
leftS, Double
pivotS) (Double
leftT, Double
pivotT) Double
needle
    -- Interpolate between pivot and right neighbour?
    (Maybe (Double, Double)
_, (Double
pivotS, Double
pivotT), Just (Double
rightS, Double
rightT))
        | (Double, Double) -> Double -> Bool
forall a. Ord a => (a, a) -> a -> Bool
between (Double
pivotS, Double
rightS) Double
needle -> (Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Double
pivotS, Double
rightS) (Double
pivotT, Double
rightT) Double
needle
    -- Fallback: don’t interpolate
    (Maybe (Double, Double)
_, (Double
_, Double
pivotT), Maybe (Double, Double)
_) -> Double
pivotT