{-# LANGUAGE ViewPatterns #-}
--------------------------------------------------------------------------------
-- |
-- Module      : ArrayFire.Features
-- Copyright   : David Johnson (c) 2019-2020
-- License     : BSD 3
-- Maintainer  : David Johnson <djohnson.m@gmail.com>
-- Stability   : Experimental
-- Portability : GHC
--
-- Functions for constructing and querying 'Features'
--
-- @
-- >>> createFeatures 10
-- @
--
--------------------------------------------------------------------------------
module ArrayFire.Features where

import Foreign.Marshal
import Foreign.Storable
import Foreign.ForeignPtr
import System.IO.Unsafe

import ArrayFire.Internal.Features
import ArrayFire.Internal.Types
import ArrayFire.FFI
import ArrayFire.Exception

-- | Construct Features
--
-- >>> features = createFeatures 10
--
createFeatures
  :: Int
  -> Features
createFeatures :: Int -> Features
createFeatures (Int -> DimT
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> DimT
n) =
  IO Features -> Features
forall a. IO a -> a
unsafePerformIO (IO Features -> Features) -> IO Features -> Features
forall a b. (a -> b) -> a -> b
$ do
    AFFeatures
ptr <-
      (Ptr AFFeatures -> IO AFFeatures) -> IO AFFeatures
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFFeatures -> IO AFFeatures) -> IO AFFeatures)
-> (Ptr AFFeatures -> IO AFFeatures) -> IO AFFeatures
forall a b. (a -> b) -> a -> b
$ \Ptr AFFeatures
ptrInput -> do
        AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr AFFeatures
ptrInput Ptr AFFeatures -> DimT -> IO AFErr
`af_create_features` DimT
n
        Ptr AFFeatures -> IO AFFeatures
forall a. Storable a => Ptr a -> IO a
peek Ptr AFFeatures
ptrInput
    ForeignPtr ()
fptr <- FinalizerPtr () -> AFFeatures -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
af_release_features AFFeatures
ptr
    Features -> IO Features
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr () -> Features
Features ForeignPtr ()
fptr)

-- | Retain Features
--
-- >>> features = retainFeatures (createFeatures 10)
--
retainFeatures
  :: Features
  -> Features
retainFeatures :: Features -> Features
retainFeatures = (Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Features
`op1f` Ptr AFFeatures -> AFFeatures -> IO AFErr
af_retain_features)

-- | Get number of Features
--
-- link
--
-- >>> getFeaturesNum (createFeatures 10)
-- 10
--
getFeaturesNum
  :: Features
  -> Int
getFeaturesNum :: Features -> Int
getFeaturesNum = DimT -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DimT -> Int) -> (Features -> DimT) -> Features -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Features -> (Ptr DimT -> AFFeatures -> IO AFErr) -> DimT
forall a.
Storable a =>
Features -> (Ptr a -> AFFeatures -> IO AFErr) -> a
`infoFromFeatures` Ptr DimT -> AFFeatures -> IO AFErr
af_get_features_num)

-- | Get Feature X-position
--
-- >>> getFeaturesXPos (createFeatures 10)
-- ArrayFire Array
-- [10 1 1 1]
--     0.0000
--     1.8750
--     0.0000
--     2.3750
--     0.0000
--     2.5938
--     0.0000
--     2.0000
--     0.0000
--     2.4375
getFeaturesXPos
  :: Features
  -> Array a
getFeaturesXPos :: forall a. Features -> Array a
getFeaturesXPos = (Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
forall a.
Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
`featuresToArray` Ptr AFFeatures -> AFFeatures -> IO AFErr
af_get_features_xpos)

-- | Get Feature Y-position
--
-- >>> getFeaturesYPos (createFeatures 10)
-- ArrayFire Array
-- [10 1 1 1]
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
getFeaturesYPos
  :: Features
  -> Array a
getFeaturesYPos :: forall a. Features -> Array a
getFeaturesYPos = (Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
forall a.
Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
`featuresToArray` Ptr AFFeatures -> AFFeatures -> IO AFErr
af_get_features_ypos)

-- | Get Feature Score
--
-- >>> getFeaturesScore (createFeatures 10)
-- ArrayFire Array
-- [10 1 1 1]
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
getFeaturesScore
  :: Features
  -> Array a
getFeaturesScore :: forall a. Features -> Array a
getFeaturesScore = (Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
forall a.
Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
`featuresToArray` Ptr AFFeatures -> AFFeatures -> IO AFErr
af_get_features_score)

-- | Get Feature orientation
--
-- >>> getFeaturesOrientation (createFeatures 10)
-- ArrayFire Array
-- [10 1 1 1]
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
getFeaturesOrientation
  :: Features
  -> Array a
getFeaturesOrientation :: forall a. Features -> Array a
getFeaturesOrientation = (Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
forall a.
Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
`featuresToArray` Ptr AFFeatures -> AFFeatures -> IO AFErr
af_get_features_orientation)

-- | Get Feature size
--
-- >>> getFeaturesSize (createFeatures 10)
-- ArrayFire Array
-- [10 1 1 1]
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
--        nan
getFeaturesSize
  :: Features
  -> Array a
getFeaturesSize :: forall a. Features -> Array a
getFeaturesSize = (Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
forall a.
Features -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) -> Array a
`featuresToArray` Ptr AFFeatures -> AFFeatures -> IO AFErr
af_get_features_size)