{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
module Numeric.EMD.Unsized (
emd
, emdTrace
, emd'
, EMD(..)
, E.EMDOpts(..), E.defaultEO, E.SiftCondition(..), E.defaultSC, E.SplineEnd(..)
, sift, SiftResult(..)
) where
import Control.Monad.IO.Class
import Data.Proxy
import Data.Type.Equality
import GHC.TypeLits.Compare
import GHC.TypeNats
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Sized as SVG
import qualified Numeric.EMD as E
data EMD v a = EMD { emdIMFs :: ![v a]
, emdResidual :: !(v a)
}
deriving Show
data SiftResult v a = SRResidual !(v a)
| SRIMF !(v a) !Int
emd :: (VG.Vector v a, Fractional a, Ord a)
=> E.EMDOpts a
-> v a
-> Maybe (EMD v a)
emd eo v = SVG.withSized v $ \(v' :: SVG.Vector v n a) -> do
Refl <- Proxy @1 `isLE` Proxy @n
pure . convertEMD $ E.emd @_ @_ @(n - 1) eo v'
emdTrace
:: (VG.Vector v a, Fractional a, Ord a, MonadIO m)
=> E.EMDOpts a
-> v a
-> m (Maybe (EMD v a))
emdTrace eo v = SVG.withSized v $ \(v' :: SVG.Vector v n a) ->
case Proxy @1 `isLE` Proxy @n of
Nothing -> pure Nothing
Just Refl -> Just . convertEMD <$> E.emdTrace @_ @_ @(n - 1) eo v'
emd'
:: (VG.Vector v a, Ord a, Fractional a, Applicative m)
=> (SiftResult v a -> m r)
-> E.EMDOpts a
-> v a
-> m (Maybe (EMD v a))
emd' cb eo v = SVG.withSized v $ \(v' :: SVG.Vector v n a) ->
case Proxy @1 `isLE` Proxy @n of
Nothing -> pure Nothing
Just Refl -> Just . convertEMD <$> E.emd' @_ @_ @(n - 1) (cb . convertSR) eo v'
sift
:: (VG.Vector v a, Fractional a, Ord a)
=> E.EMDOpts a
-> v a
-> Maybe (SiftResult v a)
sift eo v = SVG.withSized v $ \(v' :: SVG.Vector v n a) -> do
Refl <- Proxy @1 `isLE` Proxy @n
pure $ convertSR . E.sift @_ @_ @(n - 1) eo $ v'
convertSR :: E.SiftResult v n a -> SiftResult v a
convertSR = \case
E.SRResidual v -> SRResidual $ SVG.fromSized v
E.SRIMF v i -> SRIMF (SVG.fromSized v) i
convertEMD :: E.EMD v n a -> EMD v a
convertEMD (E.EMD is r) = EMD (SVG.fromSized <$> is) (SVG.fromSized r)