diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for fire + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2018, David Johnson + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of David Johnson nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main where + +import Distribution.Extra.Doctest (defaultMainWithDoctests) + +main :: IO () +main = defaultMainWithDoctests "doctests" diff --git a/arrayfire.cabal b/arrayfire.cabal new file mode 100644 --- /dev/null +++ b/arrayfire.cabal @@ -0,0 +1,192 @@ +name: arrayfire +version: 0.1.0.0 +synopsis: Haskell bindings to the ArrayFire general-purpose GPU library +homepage: https://github.com/arrayfire/arrayfire-haskell +license: BSD3 +license-file: LICENSE +author: David Johnson +maintainer: djohnson.m@gmail.com +copyright: David Johnson (c) 2018-2020 +category: Math +build-type: Custom +extra-source-files: CHANGELOG.md +cabal-version: >=1.10 +description: High-level Haskell bindings to the ArrayFire General-purpose GPU library + . + <> + . + +flag disable-default-paths + description: When enabled, don't add default hardcoded include/link dirs by default. Needed for hermetic builds like in nix. + default: False + manual: True + +custom-setup + setup-depends: + base <5, + Cabal, + cabal-doctest >=1 && <1.1 + +library + exposed-modules: + ArrayFire + ArrayFire.Algorithm + ArrayFire.Arith + ArrayFire.Array + ArrayFire.Backend + ArrayFire.BLAS + ArrayFire.Data + ArrayFire.Device + ArrayFire.Features + ArrayFire.Graphics + ArrayFire.Image + ArrayFire.Index + ArrayFire.LAPACK + ArrayFire.Random + ArrayFire.Signal + ArrayFire.Sparse + ArrayFire.Statistics + ArrayFire.Types + ArrayFire.Util + ArrayFire.Vision + other-modules: + ArrayFire.FFI + ArrayFire.Exception + ArrayFire.Orphans + ArrayFire.Internal.Algorithm + ArrayFire.Internal.Arith + ArrayFire.Internal.Array + ArrayFire.Internal.Backend + ArrayFire.Internal.BLAS + ArrayFire.Internal.Data + ArrayFire.Internal.Defines + ArrayFire.Internal.Device + ArrayFire.Internal.Exception + ArrayFire.Internal.Features + ArrayFire.Internal.Graphics + ArrayFire.Internal.Image + ArrayFire.Internal.Index + ArrayFire.Internal.Internal + ArrayFire.Internal.LAPACK + ArrayFire.Internal.Random + ArrayFire.Internal.Signal + ArrayFire.Internal.Sparse + ArrayFire.Internal.Statistics + ArrayFire.Internal.Types + ArrayFire.Internal.Util + ArrayFire.Internal.Vision + build-tools: + hsc2hs + extra-libraries: + af + c-sources: + cbits/wrapper.c + build-depends: + base < 5, filepath, vector + hs-source-dirs: + src + ghc-options: + -Wall -Wno-missing-home-modules + default-language: + Haskell2010 + + if (os(linux) || os(OSX)) && !flag(disable-default-paths) + include-dirs: + /opt/arrayfire/include + extra-lib-dirs: + /opt/arrayfire/lib + ld-options: + -Wl -rpath /opt/arrayfire/lib + +executable main + hs-source-dirs: + exe + main-is: + Main.hs + build-depends: + base < 5, arrayfire, vector + c-sources: + cbits/wrapper.c + default-language: + Haskell2010 + +executable gen + main-is: + Main.hs + hs-source-dirs: + gen + build-depends: + base < 5, parsec, text, directory + default-language: + Haskell2010 + other-modules: + Lex + Parse + Print + Types + +test-suite test + type: + exitcode-stdio-1.0 + main-is: + Main.hs + hs-source-dirs: + test + build-depends: + arrayfire, + base < 5, + directory, + hspec, + hspec-discover, + QuickCheck, + quickcheck-classes, + vector + default-language: + Haskell2010 + other-modules: + Spec + ArrayFire.AlgorithmSpec + ArrayFire.ArithSpec + ArrayFire.ArraySpec + ArrayFire.BLASSpec + ArrayFire.BackendSpec + ArrayFire.DataSpec + ArrayFire.DeviceSpec + ArrayFire.FeaturesSpec + ArrayFire.GraphicsSpec + ArrayFire.ImageSpec + ArrayFire.IndexSpec + ArrayFire.LAPACKSpec + ArrayFire.RandomSpec + ArrayFire.SignalSpec + ArrayFire.SparseSpec + ArrayFire.StatisticsSpec + ArrayFire.UtilSpec + ArrayFire.VisionSpec + +test-suite doctests + type: + exitcode-stdio-1.0 + buildable: + False + ghc-options: + -threaded + main-is: + Main.hs + hs-source-dirs: + doctests + build-depends: + arrayfire + , base < 5 + , doctest >= 0.8 + , split + autogen-modules: + Build_doctests + other-modules: + Build_doctests + default-language: + Haskell2010 + +source-repository head + type: git + location: https://github.com/arrayfire/arrayfire-haskell.git diff --git a/cbits/wrapper.c b/cbits/wrapper.c new file mode 100644 --- /dev/null +++ b/cbits/wrapper.c @@ -0,0 +1,41 @@ +#include "arrayfire.h" +#include + +af_err af_random_engine_set_type_(af_random_engine engine, const af_random_engine_type rtype) { return af_random_engine_set_type(&engine, rtype); } + +af_err af_random_engine_set_seed_(af_random_engine engine, const unsigned long long seed) { + return af_random_engine_set_seed(&engine, seed); +} + +void test_bool () { + double * data = malloc (sizeof (int) * 5); + data[0] = 2; + data[1] = 2; + data[2] = 2; + data[3] = 2; + data[4] = 2; + data[5] = 2; + dim_t * dims = malloc(sizeof(dim_t) * 4); + dims[0] = 5; + dims[1] = 1; + dims[2] = 1; + dims[3] = 1; + af_array arrin; + af_create_array(&arrin, data, 1, dims, f64); + printf("printing input array\n"); + af_print_array(arrin); + af_array arrout; + af_product(&arrout, arrin, 0); + printf("printing output array\n"); + af_print_array(arrout); +} + +void test_window () { + af_window window; + af_create_window(&window, 100, 100, "foo"); + af_show(window); +} + +void zeroOutArray (af_array * arr) { + (*arr) = 0; +} diff --git a/doctests/Main.hs b/doctests/Main.hs new file mode 100644 --- /dev/null +++ b/doctests/Main.hs @@ -0,0 +1,15 @@ +module Main (main) where + +import ArrayFire +import Build_doctests (flags, pkgs, module_sources) +import System.Environment +import Test.DocTest (doctest) +import Data.List.Split + +main :: IO () +main = do + print $ 1 + (1 :: Array Int) + moreFlags <- drop 1 . splitOn " " <$> getEnv "NIX_TARGET_LDFLAGS" + mapM_ print moreFlags + mapM_ print (flags ++ pkgs ++ module_sources ++ moreFlags) + doctest (moreFlags ++ flags ++ pkgs ++ module_sources) diff --git a/exe/Main.hs b/exe/Main.hs new file mode 100644 --- /dev/null +++ b/exe/Main.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} +module Main where + +import ArrayFire +import Control.Concurrent +import Control.Exception + +import Prelude hiding (sum, product) +-- import GHC.RTS + +foreign import ccall safe "test_bool" + testBool :: IO () + +foreign import ccall safe "test_window" + testWindow :: IO () + +main' :: IO () +main' = print newArray `catch` (\(e :: AFException) -> print e) + where + newArray = matrix @Double (2,2) [ [1..], [1..] ] * matrix @Double (2,2) [ [2..], [2..] ] + +main :: IO () +main = do + main' + -- testWindow + -- ks <- randn @Double [100,100] + -- saveArray "key" ks "array.txt" False + -- !ks' <- readArrayKey "array.txt" "key" + -- print ks' + +-- info >> putStrLn "ok" >> afInit +-- -- Info things +-- print =<< getSizeOf (Proxy @ Double) +-- print =<< getVersion +-- print =<< getRevision +-- -- getInfo +-- -- print =<< errorToString afErrNoMem +-- putStrLn =<< getInfoString +-- print =<< getDeviceCount +-- print =<< getDevice + +-- -- Create and print an array +-- -- arr1 <- constant 1 1 1 f64 +-- -- arr2 <- constant 2 1 1 f64 +-- -- r <- addArray arr1 arr2 True +-- -- printArray r + +-- -- print =<< isLAPACKAvailable +-- -- print =<< getAvailableBackends +-- -- print =<< getActiveBackend +-- -- print =<< getAvailableBackends + +-- -- array <- constant @'(10,10) 200 +-- -- putStrLn "backend id" +-- -- print (getBackendID array) +-- -- putStrLn "device id" +-- -- print (getDeviceID array) + +-- -- array <- randu @'(9,9,9) @Double +-- -- printArray array -- printArray (mean array 0) + +-- -- printArray (add array 1) + +-- -- putStrLn "got eeem" +-- -- print =<< getDataPtr x + +-- -- x <- constant 10 1 1 f64 +-- -- printArray =<< mean x 0 + +-- -- print =<< isLAPACKAvailable + +-- a <- randu @'(3,3) @Float +-- b <- randu @'(3,3) @Float +-- printArray ((a `matmul` b) None None) +-- `catch` (\(e :: AFException) -> do +-- putStrLn "got one" +-- print e) + + putStrLn "create window" + window <- createWindow 200 200 "hey" + putStrLn "set visibility" + setVisibility window True + putStrLn "show window" + showWindow window + threadDelay (secs 10) + +-- -- print =<< getActiveBackend +-- -- print =<< getDeviceCount +-- -- print =<< getDevice +-- -- putStrLn "info" +-- -- getInfo +-- -- putStrLn "info string" +-- -- putStrLn =<< getInfoString +-- -- print =<< getVersion + + +secs :: Int -> Int +secs = (*1000000) diff --git a/gen/Lex.hs b/gen/Lex.hs new file mode 100644 --- /dev/null +++ b/gen/Lex.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} +module Lex where + +import Control.Arrow +import Data.Text (Text) +import qualified Data.Text as T + +import Data.Char +import Types + +symbols :: String +symbols = " *();," + +lex :: Text -> [Token] +lex = go NameMode + where + tokenize ' ' = [] + tokenize '*' = [Star] + tokenize '(' = [LParen] + tokenize ')' = [RParen] + tokenize ';' = [Semi] + tokenize ',' = [Comma] + tokenize _ = [] + go TokenMode xs = do + case T.uncons xs of + Nothing -> [] + Just (c,cs) + | isAlpha c -> go NameMode (T.cons c cs) + | otherwise -> tokenize c ++ go TokenMode cs + go NameMode xs = do + let (match, rest) = partition xs + if match == "const" + then [] ++ go TokenMode rest + else Id match : go TokenMode rest + +partition :: Text -> (Text,Text) +partition = + T.takeWhile (`notElem` symbols) &&& + T.dropWhile (`notElem` symbols) diff --git a/gen/Main.hs b/gen/Main.hs new file mode 100644 --- /dev/null +++ b/gen/Main.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Main where + +import Control.Monad +import Data.Char +import Data.Either + +import Data.Maybe +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import System.Directory +import System.Environment +import System.Exit +import Text.Printf + +import Lex +import Parse +import Print +import Types + +main :: IO () +main = mapM_ writeToDisk =<< getDirectoryFiles + +getDirectoryFiles :: IO [String] +getDirectoryFiles = do + filter (`notElem` exclude) <$> listDirectory "include" + where + exclude = [ "defines.h" + , "complex.h" + , "extra.h" + ] + +writeToDisk :: String -> IO () +writeToDisk fileName = do + bindings + <- map run + . drop 1 + . filter (not . T.null) + . T.lines <$> T.readFile ("include/" <> fileName) + case partitionEithers bindings of + (failures, successes) -> do + if length failures > 0 + then do + mapM_ print (listToMaybe failures) + printf "%s failed to generate bindings\n" fileName + else do + let name = makeName (reverse . drop 2 . reverse $ fileName) + T.writeFile (makePath name) $ + file name <> T.intercalate "\n" (genBinding <$> successes) + printf "Wrote bindings to %s\n" (makePath name) + +-- | Filename remappings +makeName :: String -> String +makeName n + | n == "lapack" = "LAPACK" + | n == "blas" = "BLAS" + | n == "cuda" = "CUDA" + | otherwise = n + +makePath :: String -> String +makePath s = + printf "src/ArrayFire/Internal/%s.hsc" (capitalName (makeName s)) + +file :: String -> Text +file a = T.pack $ printf + "{-# LANGUAGE CPP #-}\n\ + \module ArrayFire.Internal.%s where\n\n\ + \import ArrayFire.Internal.Defines\n\ + \import ArrayFire.Internal.Types\n\ + \import Foreign.Ptr\n\ + \import Foreign.C.Types\n\n\ + \#include \"af/%s.h\"\n\ + \" (capitalName a) (if lowerCase a == "exception" + then "defines" + else lowerCase a) + +capitalName, lowerCase :: [Char] -> [Char] +capitalName (x:xs) = toUpper x : xs +lowerCase (x:xs) = map toLower (x:xs) diff --git a/gen/Parse.hs b/gen/Parse.hs new file mode 100644 --- /dev/null +++ b/gen/Parse.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} +module Parse where + +import Prelude hiding (lex) +import Control.Monad +import Data.Text (Text) +import qualified Data.Text as T +import Text.Parsec + +import Lex +import Types + +parseAST :: Parser AST +parseAST = do + afapi + type' <- getType + funcName <- name + lparen + params <- getParam `sepBy` comma + rparen >> semi + pure (AST type' funcName params) + +getParam :: Parser Type +getParam = do + t <- getType + t <$ name + +getType :: Parser Type +getType = do + typeName <- name + stars <- msum [ try (rep x) | x <- [3,2..0] ] + pure (Type typeName stars) + where + rep n = replicateM_ n star >> pure n + +run :: Text -> Either ParseError AST +run txt = parse parseAST mempty (lex txt) + +afapi,lparen,rparen,semi,star,comma :: Parser () +lparen = tok' LParen +rparen = tok' RParen +afapi = tok' (Id "AFAPI") <|> pure () +comma = tok' Comma +semi = tok' Semi +star = tok' Star + +tok :: Token -> Parser Token +tok x = tokenPrim show ignore + (\t -> if x == t then Just x else Nothing) + +tok' :: Token -> Parser () +tok' x = tokenPrim show ignore + (\t -> if x == t then Just () else Nothing) + +name :: Parser Name +name = tokenPrim show ignore go + where + go (Id x) = Just (Name x) + go _ = Nothing + +ignore x _ _ = x diff --git a/gen/Print.hs b/gen/Print.hs new file mode 100644 --- /dev/null +++ b/gen/Print.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} +module Print where + +import Data.Char +import Data.Text (Text) +import qualified Data.Text as T +import Text.Printf + +import Types + +import Parse + +camelize :: Text -> Text +camelize = T.concat . map go . T.splitOn "_" + where + go "af" = "AF" + go xs = T.cons (toUpper c) cs + where + c = T.head xs + cs = T.tail xs + +isPtr (Type _ x) = x > 0 + +genBinding :: AST -> Text +genBinding (AST type' name params) = + header <> dumpBody <> dumpOutput + where + dumpOutput | isPtr type' = "IO (" <> printType type' <> ")" + | otherwise = "IO " <> printType type' + header = T.pack $ printf "foreign import ccall unsafe \"%s\"\n %s :: " name name + dumpBody = printTypes params + +printTypes :: [Type] -> Text +printTypes [] = mempty +printTypes [x] = printType x <> " -> " +printTypes (x:xs) = + mconcat [ + printType x + , " -> " + , printTypes xs + ] + +printType (Type (Name x) 0) = showType x +printType (Type (Name x) 1) = "Ptr " <> showType x +printType (Type t n) = "Ptr (" <> printType (Type t (n-1)) <> ")" + +-- | Additional mappings, very important for CodeGen +showType :: Text -> Text +showType "char" = "CChar" +showType "void" = "()" +showType "unsigned" = "CUInt" +showType "dim_t" = "DimT" +showType "af_someenum_t" = "AFSomeEnum" +showType "size_t" = "CSize" +showType "uintl" = "UIntL" +showType "intl" = "IntL" +showType "int" = "CInt" +showType "bool" = "CBool" +showType "af_index_t" = "AFIndex" +showType "af_cspace_t" = "AFCSpace" +showType "afcl_platform" = "AFCLPlatform" +showType x = camelize x diff --git a/gen/Types.hs b/gen/Types.hs new file mode 100644 --- /dev/null +++ b/gen/Types.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Types where + +import Data.Functor.Identity +import Data.Text (Text) +import qualified Data.Text as T +import Text.Parsec +import Text.Printf + +type Parser = ParsecT [Token] () Identity + +type Params = [Type] + +data AST = AST Type Name [Type] + deriving (Show) + +data Type = Type Name Int + deriving (Show) + +newtype Name = Name Text + deriving (Show, Eq, PrintfArg) + +data Mode + = TokenMode + | NameMode + deriving (Eq, Show) + +data Token + = Id Text + | Star + | LParen + | RParen + | Comma + | Semi + deriving (Show, Eq) diff --git a/src/ArrayFire.hs b/src/ArrayFire.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire.hs @@ -0,0 +1,298 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- <> +-- +-------------------------------------------------------------------------------- +module ArrayFire + ( -- * Tutorial + -- $tutorial + + -- ** Modules + -- $modules + + -- ** Exceptions + -- $exceptions + + -- ** Construction + -- $construction + + -- ** Laws + -- $laws + + -- ** Conversion + -- $conversion + + -- ** Serialization + -- $serialization + + -- ** Device + -- $device + module ArrayFire.Algorithm + , module ArrayFire.Arith + , module ArrayFire.Array + , module ArrayFire.Backend + , module ArrayFire.BLAS + , module ArrayFire.Data + , module ArrayFire.Device + , module ArrayFire.Features + , module ArrayFire.Graphics + , module ArrayFire.Image + , module ArrayFire.Index + , module ArrayFire.LAPACK + , module ArrayFire.Random + , module ArrayFire.Signal + , module ArrayFire.Sparse + , module ArrayFire.Statistics + , module ArrayFire.Types + , module ArrayFire.Util + , module ArrayFire.Vision + , module Foreign.C.Types + , module Data.Int + , module Data.Word + , module Data.Complex + , module Foreign.Storable + ) where + +import ArrayFire.Algorithm +import ArrayFire.Arith +import ArrayFire.Array +import ArrayFire.Backend +import ArrayFire.BLAS +import ArrayFire.Data +import ArrayFire.Device +import ArrayFire.Features +import ArrayFire.Graphics +import ArrayFire.Image +import ArrayFire.Index +import ArrayFire.LAPACK +import ArrayFire.Random +import ArrayFire.Signal +import ArrayFire.Sparse +import ArrayFire.Statistics +import ArrayFire.Types +import ArrayFire.Util +import ArrayFire.Vision +import ArrayFire.Orphans () +import Foreign.Storable +import Foreign.C.Types +import Data.Int +import Data.Complex +import Data.Word + +-- $tutorial +-- +-- [ArrayFire](http://arrayfire.org/docs/gettingstarted.htm) is a high performance parallel computing library that features modules for statistical and numerical methods. +-- Example usage is depicted below. +-- +-- @ +-- module Main where +-- +-- import qualified ArrayFire as A +-- +-- main :: IO () +-- main = print $ A.matrix @Double (2,2) [[1,2],[3,4]] +-- @ +-- +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 2.0000 +-- 3.0000 4.0000 +-- @ + +-- $modules +-- +-- All child modules are re-exported top-level in the "ArrayFire" module. +-- We recommend importing "ArrayFire" qualified so as to avoid naming collisions. +-- +-- >>> import qualified ArrayFire as A +-- + +-- $exceptions +-- +-- @ +-- {\-\# LANGUAGE TypeApplications \#\-} +-- module Main where +-- +-- import qualified ArrayFire as A +-- import Control.Exception ( catch ) +-- +-- main :: IO () +-- main = A.printArray action \`catch\` (\\(e :: A.AFException) -> print e) +-- where +-- action = +-- A.matrix \@Double (3,3) [[[1..],[1..],[1..]]] +-- \`A.mul\` A.matrix \@Double (2,2) [[1..],[1..]] +-- @ +-- +-- The above operation is invalid since the matrix multiply has improper dimensions. The caught exception produces the following error: +-- +-- > AFException {afExceptionType = SizeError, afExceptionCode = 203, afExceptionMsg = "Invalid input size"} +-- + +-- $construction +-- An 'Array' can be constructed using the following smart constructors: +-- +-- @ +-- >>> scalar \@Double 2.0 +-- ArrayFire Array +-- [1 1 1 1] +-- 2.0000 +-- @ +-- +-- @ +-- >>> vector \@Double 10 [1..] +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +-- @ +-- +-- @ +-- >>> matrix \@Double (2,2) [[1,2],[3,4]] +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 2.0000 +-- 3.0000 4.0000 +-- @ +-- +-- @ +-- >>> cube \@Double (2,2,2) [[[2,2],[2,2]],[[2,2],[2,2]]] +-- ArrayFire Array +-- [2 2 2 1] +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- @ +-- +-- @ +-- >>> tensor \@Double (2,2,2,2) [[[[2,2],[2,2]],[[2,2],[2,2]]], [[[2,2],[2,2]],[[2,2],[2,2]]]] +-- ArrayFire Array +-- [2 2 2 2] +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- +-- +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- @ +-- +-- Array construction can use Haskell's lazy lists, since 'take' is called on each dimension before sending to the C API. +-- +-- >>> mkArray @Double [2,2] [ [1..], [1..] ] +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +-- +-- Specifying up to 4 dimensions is allowed (anything high is ignored). + +-- $laws +-- Every 'Array' is an instance of 'Eq', 'Ord', 'Num', 'Fractional', 'Floating' +-- +-- 'Num' +-- +-- >>> scalar @Int 1 + scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 2 +-- +-- >>> scalar @Int 1 - scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +-- +-- >>> scalar @Double 10 / scalar @Double 10 +-- ArrayFire Array +-- [1 1 1 1] +-- 1.0000 +-- +-- >>> abs $ scalar @Double (-10) +-- ArrayFire Array +-- [1 1 1 1] +-- 10.0000 +-- +-- >>> negate (scalar @Double 1 [10]) +-- -10.0 +-- +-- >>> fromInteger 1.0 :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 1.0000 +-- +-- 'Eq' +-- +-- >>> scalar @Double 1 [10] == scalar @Double 1 [10] +-- True +-- >>> scalar @Double 1 [10] /= scalar @Double 1 [10] +-- False +-- +-- 'Ord' +-- +-- >>> scalar @Double 1 [10] < scalar @Double 1 [10] +-- False +-- >>> scalar @Double 1 [10] > scalar @Double 1 [10] +-- False +-- +-- 'Floating' +-- +-- >>> pi :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 3.1416 +-- + +-- $conversion +-- 'Array' can be exported into Haskell using `toVector'. This will create a Storable vector suitable for use in other C programs. +-- +-- >>> vector :: Vector Double <- toVector <$> randu @Double [10,10] +-- + +-- $serialization +-- Each 'Array' can be serialized to disk and deserialized from disk efficiently. +-- +-- @ +-- import qualified ArrayFire as A +-- import Control.Monad +-- +-- main :: IO () +-- main = do +-- let arr = A.'constant' [1,1,1,1] 10 +-- idx <- A.'saveArray' "key" arr "file.array" False +-- foundIndex <- A.'readArrayKeyCheck' "file.array" "key" +-- when (idx == foundIndex) $ do +-- array <- A.'readArrayKey' "file.array" "key" +-- 'print' array +-- +-- ArrayFire Array +-- [ 1 1 1 1 ] +-- 10 +-- @ +-- + +-- $device +-- The ArrayFire API is able to see which devices are present, and will by default use the GPU if available. +-- +-- >>> afInfo +-- ArrayFire v3.6.4 (OpenCL, 64-bit Mac OSX, build 1b8030c5) +-- [0] APPLE: AMD Radeon Pro 555X Compute Engine, 4096 MB <-- brackets [] signify device being used. +-- -1- APPLE: Intel(R) UHD Graphics 630, 1536 MB +-- + +-- $visualization +-- The ArrayFire API is able to visualize +-- >>> window <- createWindow 800 600 "Histogram" +-- diff --git a/src/ArrayFire/Algorithm.hs b/src/ArrayFire/Algorithm.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Algorithm.hs @@ -0,0 +1,579 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Algorithm +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Functions for aggregation, manipulation of 'Array' +-- +-- @ +-- module Main where +-- +-- import qualified ArrayFire as A +-- +-- main :: IO () +-- main = print $ A.sum (A.vector @Double 10 [1..]) 0 +-- -- 55 +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Algorithm where + +import ArrayFire.Array +import ArrayFire.FFI +import ArrayFire.Internal.Algorithm +import ArrayFire.Internal.Types + +import Foreign.C.Types +import Data.Word + +-- | Sum all of the elements in 'Array' along the specified dimension +-- +-- >>> A.sum (A.vector @Double 10 [1..]) 0 +-- 55.0 +-- +-- >>> A.sum (A.matrix @Double (10,10) [[2..],[2..]]) 0 +-- 65.0 +sum + :: AFType a + => Array a + -- ^ Array to sum + -> Int + -- ^ Dimension along which to perform sum + -> a + -- ^ Will return the sum of all values in the input array along the specified dimension +sum x (fromIntegral -> n) = getScalar (x `op1` (\p a -> af_sum p a n)) + +-- | Sum all of the elements in 'Array' along the specified dimension, using a default value for NaN +-- +-- >>> A.sumNaN (A.vector @Double 10 [1..]) 0 0.0 +-- 55 +sumNaN + :: (Fractional a, AFType a) + => Array a + -- ^ Array to sum + -> Int + -- ^ Dimension along which to perform sum + -> Double + -- ^ Default value to use in the case of NaN + -> a + -- ^ Will return the sum of all values in the input array along the specified dimension, substituted with the default value +sumNaN n (fromIntegral -> i) d = getScalar (n `op1` (\p a -> af_sum_nan p a i d)) + +-- | Product all of the elements in 'Array' along the specified dimension +-- +-- >>> A.product (A.vector @Double 10 [1..]) 0 +-- 3628800.0 +product + :: AFType a + => Array a + -- ^ Array to product + -> Int + -- ^ Dimension along which to perform product + -> a + -- ^ Will return the product of all values in the input array along the specified dimension +product x (fromIntegral -> n) = getScalar (x `op1` (\p a -> af_product p a n)) + +-- | Product all of the elements in 'Array' along the specified dimension, using a default value for NaN +-- +-- >>> A.productNaN (A.vector @Double 10 [1..]) 0 0.0 +-- 3628800.0 +productNaN + :: (AFType a, Fractional a) + => Array a + -- ^ Array to product + -> Int + -- ^ Dimension along which to perform product + -> Double + -- ^ Default value to use in the case of NaN + -> a + -- ^ Will return the product of all values in the input array along the specified dimension, substituted with the default value +productNaN n (fromIntegral -> i) d = getScalar (n `op1` (\p a -> af_product_nan p a i d)) + +-- | Take the minimum of an 'Array' along a specific dimension +-- +-- >>> A.min (A.vector @Double 10 [1..]) 0 +-- 1.0 +min + :: AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to retrieve the min element + -> a + -- ^ Will contain the minimum of all values in the input array along dim +min x (fromIntegral -> n) = getScalar (x `op1` (\p a -> af_min p a n)) + +-- | Take the maximum of an 'Array' along a specific dimension +-- +-- >>> A.max (A.vector @Double 10 [1..]) 0 +-- 10 +max + :: AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to retrieve the max element + -> a + -- ^ Will contain the maximum of all values in the input array along dim +max x (fromIntegral -> n) = getScalar (x `op1` (\p a -> af_max p a n)) + +-- | Find if all elements in an 'Array' are 'True' along a dimension +-- +-- >>> A.allTrue (A.vector @CBool 10 (repeat 0)) 0 +-- False +allTrue + :: forall a. AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to see if all elements are True + -> Bool + -- ^ Will contain the maximum of all values in the input array along dim +allTrue x (fromIntegral -> n) = + toEnum . fromIntegral $ getScalar @CBool @a (x `op1` (\p a -> af_all_true p a n)) + +-- | Find if any elements in an 'Array' are 'True' along a dimension +-- +-- >>> A.anyTrue (A.vector @CBool 10 (repeat 0)) 0 +-- False +anyTrue + :: forall a . AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to see if all elements are True + -> Bool + -- ^ Returns if all elements are true +anyTrue x (fromIntegral -> n) = + toEnum . fromIntegral $ getScalar @CBool @a (x `op1` (\p a -> af_any_true p a n)) + +-- | Count elements in an 'Array' along a dimension +-- +-- >>> A.count (A.vector @Double 10 [1..]) 0 +-- 10 +count + :: forall a . AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to count + -> Int + -- ^ Count of all elements along dimension +count x (fromIntegral -> n) = fromIntegral $ getScalar @Word32 @a (x `op1` (\p a -> af_count p a n)) + +-- | Sum all elements in an 'Array' along all dimensions +-- +-- >>> A.sumAll (A.vector @Double 10 [1..]) +-- (55.0,0.0) +sumAll + :: AFType a + => Array a + -- ^ Input array + -> (Double, Double) + -- ^ imaginary and real part +sumAll = (`infoFromArray2` af_sum_all) + +-- | Sum all elements in an 'Array' along all dimensions, using a default value for NaN +-- +-- >>> A.sumNaNAll (A.vector @Double 10 [1..]) 0.0 +-- (55.0,0.0) +sumNaNAll + :: (AFType a, Fractional a) + => Array a + -- ^ Input array + -> Double + -- ^ NaN substitute + -> (Double, Double) + -- ^ imaginary and real part +sumNaNAll a d = infoFromArray2 a (\p g x -> af_sum_nan_all p g x d) + +-- | Product all elements in an 'Array' along all dimensions, using a default value for NaN +-- +-- >>> A.productAll (A.vector @Double 10 [1..]) +-- (3628800.0,0.0) +productAll + :: AFType a + => Array a + -- ^ Input array + -> (Double, Double) + -- ^ imaginary and real part +productAll = (`infoFromArray2` af_product_all) + +-- | Product all elements in an 'Array' along all dimensions, using a default value for NaN +-- +-- >>> A.productNaNAll (A.vector @Double 10 [1..]) 1.0 +-- (3628800.0,0.0) +productNaNAll + :: (AFType a, Fractional a) + => Array a + -- ^ Input array + -> Double + -- ^ NaN substitute + -> (Double, Double) + -- ^ imaginary and real part +productNaNAll a d = infoFromArray2 a (\p x y -> af_product_nan_all p x y d) + +-- | Take the minimum across all elements along all dimensions in 'Array' +-- +-- >>> A.minAll (A.vector @Double 10 [1..]) +-- (1.0,0.0) +minAll + :: AFType a + => Array a + -- ^ Input array + -> (Double, Double) + -- ^ imaginary and real part +minAll = (`infoFromArray2` af_min_all) + +-- | Take the maximum across all elements along all dimensions in 'Array' +-- +-- >>> A.maxAll (A.vector @Double 10 [1..]) +-- (10.0,0.0) +maxAll + :: AFType a + => Array a + -- ^ Input array + -> (Double, Double) + -- ^ imaginary and real part +maxAll = (`infoFromArray2` af_max_all) + +-- | Decide if all elements along all dimensions in 'Array' are True +-- +-- >>> A.allTrueAll (A.vector @CBool 10 (repeat 1)) +-- (1.0, 0.0) +allTrueAll + :: AFType a + => Array a + -- ^ Input array + -> (Double, Double) + -- ^ imaginary and real part +allTrueAll = (`infoFromArray2` af_all_true_all) + +-- | Decide if any elements along all dimensions in 'Array' are True +-- +-- >>> A.anyTrueAll $ A.vector @CBool 10 (repeat 0) +-- (0.0,0.0) +anyTrueAll + :: AFType a + => Array a + -- ^ Input array + -> (Double, Double) + -- ^ imaginary and real part +anyTrueAll = (`infoFromArray2` af_any_true_all) + +-- | Count all elements along all dimensions in 'Array' +-- +-- >>> A.countAll (A.matrix @Double (100,100) (replicate 100 [1..])) +-- (10000.0,0.0) +countAll + :: AFType a + => Array a + -- ^ Input array + -> (Double, Double) + -- ^ imaginary and real part +countAll = (`infoFromArray2` af_count_all) + +-- | Find the minimum element along a specified dimension in 'Array' +-- +-- >>> A.imin (A.vector @Double 10 [1..]) 0 +-- (ArrayFire Array +-- [1 1 1 1] +-- 1.0000 +-- ,ArrayFire Array +-- [1 1 1 1] +-- 0 +-- ) +imin + :: AFType a + => Array a + -- ^ Input array + -> Int + -- ^ The dimension along which the minimum value is extracted + -> (Array a, Array a) + -- ^ will contain the minimum of all values along dim, will also contain the location of minimum of all values in in along dim +imin a (fromIntegral -> n) = op2p a (\x y z -> af_imin x y z n) + +-- | Find the maximum element along a specified dimension in 'Array' +-- +-- >>> A.imax (A.vector @Double 10 [1..]) 0 +-- (ArrayFire Array +-- [1 1 1 1] +-- 10.0000 +-- ,ArrayFire Array +-- [1 1 1 1] +-- 9 +-- ) +imax + :: AFType a + => Array a + -- ^ Input array + -> Int + -- ^ The dimension along which the minimum value is extracted + -> (Array a, Array a) + -- ^ will contain the maximum of all values in in along dim, will also contain the location of maximum of all values in in along dim +imax a (fromIntegral -> n) = op2p a (\x y z -> af_imax x y z n) + +-- | Find the minimum element along all dimensions in 'Array' +-- +-- >>> A.iminAll (A.vector @Double 10 [1..]) +-- (1.0,0.0,0) +iminAll + :: AFType a + => Array a + -- ^ Input array + -> (Double, Double, Int) + -- ^ will contain the real part of minimum value of all elements in input in, also will contain the imaginary part of minimum value of all elements in input in, will contain the location of minimum of all values in +iminAll a = do + let (x,y,fromIntegral -> z) = a `infoFromArray3` af_imin_all + (x,y,z) + +-- | Find the maximum element along all dimensions in 'Array' +-- +-- >>> A.imaxAll (A.vector @Double 10 [1..]) +-- (10.0,0.0,9) +imaxAll + :: AFType a + => Array a + -- ^ Input array + -> (Double, Double, Int) + -- ^ will contain the real part of maximum value of all elements in input in, also will contain the imaginary part of maximum value of all elements in input in, will contain the location of maximum of all values in +imaxAll a = do + let (x,y,fromIntegral -> z) = a `infoFromArray3` af_imax_all + (x,y,z) + +-- | Calculate sum of 'Array' across specified dimension +-- +-- >>> A.accum (A.vector @Double 10 [1..]) 0 +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 3.0000 6.0000 10.0000 15.0000 21.0000 28.0000 36.0000 45.0000 55.0000 +accum + :: AFType a + => Array a + -- ^ Input array + -> Int + -- ^ Dimension along which to calculate the sum + -> Array a + -- ^ Contains inclusive sum +accum a (fromIntegral -> n) = a `op1` (\x y -> af_accum x y n) + +-- | Scan elements of an 'Array' across a dimension, using a 'BinaryOp', specifying inclusivity. +-- +-- >>> A.scan (A.vector @Double 10 [1..]) 0 Add True +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 3.0000 6.0000 10.0000 15.0000 21.0000 28.0000 36.0000 45.0000 55.0000 +scan + :: AFType a + => Array a + -- ^ The input array + -> Int + -- ^ The dimension along which the scan is performed + -> BinaryOp + -- ^ Binary operation to be used + -> Bool + -- ^ Should the scan be inclusive or not + -> Array a + -- ^ The scan of the input +scan a (fromIntegral -> d) op (fromIntegral . fromEnum -> inclusive) = + a `op1` (\x y -> af_scan x y d (toBinaryOp op) inclusive) + +-- | Scan elements of an 'Array' across a dimension, by key, using a 'BinaryOp', specifying inclusivity. +-- +-- >>> A.scanByKey (A.vector @Int 7 [2..]) (A.vector @Int 10 [1..]) 1 Add True +-- ArrayFire Array +-- [7 1 1 1] +-- 2 3 4 5 6 7 8 +scanByKey + :: (AFType a, AFType k) + => Array k + -- ^ The key array + -> Array a + -- ^ The input array + -> Int + -- ^ Dimension along which scan is performed + -> BinaryOp + -- ^ Type of binary operation used + -> Bool + -- ^ Is the scan incluside or not + -> Array a +scanByKey a b (fromIntegral -> d) op (fromIntegral . fromEnum -> inclusive) = + op2 a b (\x y z -> af_scan_by_key x y z d (toBinaryOp op) inclusive) + +-- | Find indices where input Array is non zero +-- +-- >>> A.where' (A.vector @Double 10 (repeat 0)) +-- ArrayFire Array +-- [0 1 1 1] +-- +where' + :: AFType a + => Array a + -- ^ Is the input array. + -> Array a + -- ^ will contain indices where input array is non-zero +where' = (`op1` af_where) + +-- | First order numerical difference along specified dimension. +-- +-- >>> A.diff1 (A.vector @Double 4 [10,35,65,95]) 0 +-- ArrayFire Array +-- [3 1 1 1] +-- 25.0000 30.0000 30.0000 +diff1 + :: AFType a + => Array a + -- ^ Input array + -> Int + -- ^ Dimension along which numerical difference is performed + -> Array a + -- ^ Will contain first order numerical difference +diff1 a (fromIntegral -> n) = a `op1` (\p x -> af_diff1 p x n) + +-- | Second order numerical difference along specified dimension. +-- +-- >>> A.diff2 (A.vector @Double 5 [1.0,20,55,89,44]) 0 +-- ArrayFire Array +-- [3 1 1 1] +-- 16.0000 -1.0000 -79.0000 +diff2 + :: AFType a + => Array a + -- ^ Input array + -> Int + -- ^ Dimension along which numerical difference is performed + -> Array a + -- ^ Will contain second order numerical difference +diff2 a (fromIntegral -> n) = a `op1` (\p x -> af_diff2 p x n) + +-- | Sort an Array along a specified dimension, specifying ordering of results (ascending / descending) +-- +-- >>> A.sort (A.vector @Double 4 [ 2,4,3,1 ]) 0 True +-- ArrayFire Array +-- [4 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 +-- +-- >>> A.sort (A.vector @Double 4 [ 2,4,3,1 ]) 0 False +-- ArrayFire Array +-- [4 1 1 1] +-- 4.0000 3.0000 2.0000 1.0000 +sort + :: AFType a + => Array a + -- ^ Input array + -> Int + -- ^ Dimension along `sort` is performed + -> Bool + -- ^ Return results in ascending order + -> Array a + -- ^ Will contain sorted input +sort a (fromIntegral -> n) (fromIntegral . fromEnum -> b) = + a `op1` (\p x -> af_sort p x n b) + +-- | Sort an 'Array' along a specified dimension, specifying ordering of results (ascending / descending), returns indices of sorted results +-- +-- +-- >>> A.sortIndex (A.vector @Double 4 [3,2,1,4]) 0 True +-- (ArrayFire Array +-- [4 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 +-- ,ArrayFire Array +-- [4 1 1 1] +-- 2 1 0 3 +-- ) +sortIndex + :: AFType a + => Array a + -- ^ Input array + -> Int + -- ^ Dimension along `sortIndex` is performed + -> Bool + -- ^ Return results in ascending order + -> (Array a, Array a) + -- ^ Contains the sorted, contains indices for original input +sortIndex a (fromIntegral -> n) (fromIntegral . fromEnum -> b) = + a `op2p` (\p1 p2 p3 -> af_sort_index p1 p2 p3 n b) + +-- | Sort an 'Array' along a specified dimension by keys, specifying ordering of results (ascending / descending) +-- +-- >>> A.sortByKey (A.vector @Double 4 [2,1,4,3]) (A.vector @Double 4 [10,9,8,7]) 0 True +-- (ArrayFire Array +-- [4 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 +-- ,ArrayFire Array +-- [4 1 1 1] +-- 9.0000 10.0000 7.0000 8.0000 +-- ) +sortByKey + :: AFType a + => Array a + -- ^ Keys input array + -> Array a + -- ^ Values input array + -> Int + -- ^ Dimension along which to perform the operation + -> Bool + -- ^ Return results in ascending order + -> (Array a, Array a) +sortByKey a1 a2 (fromIntegral -> n) (fromIntegral . fromEnum -> b) = + op2p2 a1 a2 (\w x y z -> af_sort_by_key w x y z n b) + +-- | Finds the unique values in an 'Array', specifying if sorting should occur. +-- +-- >>> A.setUnique (A.vector @Double 2 [1.0,1.0]) True +-- ArrayFire Array +-- [1 1 1 1] +-- 1.0000 +setUnique + :: AFType a + => Array a + -- ^ input array + -> Bool + -- ^ if true, skips the sorting steps internally + -> Array a + -- ^ Will contain the unique values from in +setUnique a (fromIntegral . fromEnum -> b) = + op1 a (\x y -> af_set_unique x y b) + +-- | Takes the union of two 'Array's, specifying if `setUnique` should be called first. +-- +-- >>> A.setUnion (A.vector @Double 3 [3,4,5]) (A.vector @Double 3 [1,2,3]) True +-- ArrayFire Array +-- [5 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 +setUnion + :: AFType a + => Array a + -- ^ First input array + -> Array a + -- ^ Second input array + -> Bool + -- ^ If true, skips calling unique internally + -> Array a +setUnion a1 a2 (fromIntegral . fromEnum -> b) = + op2 a1 a2 (\x y z -> af_set_union x y z b) + +-- | Takes the intersection of two 'Array's, specifying if `setUnique` should be called first. +-- +-- >>> A.setIntersect (A.vector @Double 3 [3,4,5]) (A.vector @Double 3 [1,2,3]) True +-- ArrayFire Array +-- [1 1 1 1] +-- 3.0000 +setIntersect + :: AFType a + => Array a + -- ^ First input array + -> Array a + -- ^ Second input array + -> Bool + -- ^ If true, skips calling unique internally + -> Array a + -- ^ Intersection of first and second array +setIntersect a1 a2 (fromIntegral . fromEnum -> b) = + op2 a1 a2 (\x y z -> af_set_intersect x y z b) diff --git a/src/ArrayFire/Arith.hs b/src/ArrayFire/Arith.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Arith.hs @@ -0,0 +1,1647 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Arith +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Arithmetic functions over 'Array' +-- +-- @ +-- module Main where +-- +-- import qualified ArrayFire as A +-- +-- main :: IO () +-- main = print $ A.scalar \@Int 1 \`A.add\` A.scalar \@Int 1 +-- -- 2 +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Arith where + +import Prelude (Bool(..), ($), (.), flip, fromEnum, fromIntegral, Real) + +import Data.Coerce +import Data.Proxy + +import ArrayFire.FFI +import ArrayFire.Internal.Arith +import ArrayFire.Internal.Types + +-- | Adds two 'Array' objects +-- +-- >>> A.scalar @Int 1 `A.add` A.scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 2 +add + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of add +add x y = + x `op2` y $ \arr arr1 arr2 -> + af_add arr arr1 arr2 1 + +-- | Adds two 'Array' objects +-- +-- >>> (A.scalar @Int 1 `A.addBatched` A.scalar @Int 1) True +-- ArrayFire Array +-- [1 1 1 1] +-- 2 +addBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of add +addBatched x y (fromIntegral . fromEnum -> batch) = + x `op2` y $ \arr arr1 arr2 -> + af_add arr arr1 arr2 batch + +-- | Subtracts two 'Array' objects +-- +-- >>> A.scalar @Int 1 `A.sub` A.scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +sub + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of sub +sub x y = do + x `op2` y $ \arr arr1 arr2 -> + af_sub arr arr1 arr2 1 + +-- | Subtracts two 'Array' objects +-- +-- >>> (A.scalar @Int 1 `subBatched` A.scalar @Int 1) True +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +subBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of sub +subBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_sub arr arr1 arr2 batch + +-- | Multiply two 'Array' objects +-- +-- >>> A.scalar @Int 2 `mul` A.scalar @Int 2 +-- ArrayFire Array +-- [1 1 1 1] +-- 4 +mul + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of mul +mul x y = do + x `op2` y $ \arr arr1 arr2 -> + af_mul arr arr1 arr2 1 + +-- | Multiply two 'Array' objects +-- +-- +-- >>> (A.scalar @Int 2 `mulBatched` A.scalar @Int 2) True +-- ArrayFire Array +-- [1 1 1 1] +-- 4 +mulBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of mul +mulBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_mul arr arr1 arr2 batch + +-- | Divide two 'Array' objects +-- +-- >>> A.scalar @Int 6 `A.div` A.scalar @Int 3 +-- ArrayFire Array +-- [1 1 1 1] +-- 2 +div + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of div +div x y = do + x `op2` y $ \arr arr1 arr2 -> + af_div arr arr1 arr2 1 + +-- | Divide two 'Array' objects +-- +-- >>> (A.scalar @Int 6 `A.divBatched` A.scalar @Int 3) True +-- ArrayFire Array +-- [1 1 1 1] +-- 2 +divBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of div +divBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_div arr arr1 arr2 batch + +-- | Test if on 'Array' is less than another 'Array' +-- +-- >>> A.scalar @Int 1 `A.lt` A.scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +-- >>> A.scalar @Int 1 < A.scalar @Int 1 +-- False +lt + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of less than +lt x y = do + x `op2` y $ \arr arr1 arr2 -> + af_lt arr arr1 arr2 1 + +-- | Test if on 'Array' is less than another 'Array' +-- +-- >>> (A.scalar @Int 1 `A.ltBatched` A.scalar @Int 1) True +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +-- >>> A.scalar @Int 1 < A.scalar @Int 1 +-- False +ltBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of less than +ltBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_lt arr arr1 arr2 batch + +-- | Test if an 'Array' is greater than another 'Array' +-- +-- >>> A.scalar @Int 1 `A.gt` A.scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +-- >>> A.scalar @Int 1 > A.scalar @Int 2 +-- False +gt + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of gt +gt x y = do + x `op2` y $ \arr arr1 arr2 -> + af_gt arr arr1 arr2 1 + +-- | Test if an 'Array' is greater than another 'Array' +-- +-- >>> (A.scalar @Int 1 `gtBatched` A.scalar @Int 1) True +-- False +gtBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of gt +gtBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_gt arr arr1 arr2 batch + +-- | Test if one 'Array' is less than or equal to another 'Array' +-- +-- >>> A.scalar @Int 1 `A.le` A.scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +-- >>> A.scalar @Int 1 <= A.scalar @Int 1 +-- False +le + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of less than or equal +le x y = do + x `op2` y $ \arr arr1 arr2 -> + af_le arr arr1 arr2 1 + +-- | Test if one 'Array' is less than or equal to another 'Array' +-- +-- >>> (A.scalar @Int 1 `A.leBatched` A.scalar @Int 1) True +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +-- >>> A.scalar @Int 1 <= A.scalar @Int 1 +-- True +leBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of less than or equal +leBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_le arr arr1 arr2 batch + +-- | Test if one 'Array' is greater than or equal to another 'Array' +-- +-- >>> A.scalar @Int 1 `A.ge` A.scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +-- >>> A.scalar @Int 1 >= A.scalar @Int 1 +-- True +ge + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of greater than or equal +ge x y = do + x `op2` y $ \arr arr1 arr2 -> + af_ge arr arr1 arr2 1 + +-- | Test if one 'Array' is greater than or equal to another 'Array' +-- +-- +-- >>> (A.scalar @Int 1 `A.geBatched` A.scalar @Int 1) True +-- +geBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of greater than or equal +geBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_ge arr arr1 arr2 batch + +-- | Test if one 'Array' is equal to another 'Array' +-- +-- >>> A.scalar @Int 1 `A.eq` A.scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +-- +-- >>> A.scalar @Int 1 == A.scalar @Int 1 +-- True +eq + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of equal +eq x y = do + x `op2` y $ \arr arr1 arr2 -> + af_eq arr arr1 arr2 1 + +-- | Test if one 'Array' is equal to another 'Array' +-- +-- >>> (A.scalar @Int 1 `A.eqBatched` A.scalar @Int 1) True +-- +eqBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of equal +eqBatched x y (fromIntegral . fromEnum -> batch) = + x `op2` y $ \arr arr1 arr2 -> + af_eq arr arr1 arr2 batch + +-- | Test if one 'Array' is not equal to another 'Array' +-- +-- >>> A.scalar @Int 1 `A.neq` A.scalar @Int 1 +-- ArrayFire Array +--[1 1 1 1] +-- 0 +-- >>> A.scalar @Int 1 /= A.scalar @Int 1 +-- False +neq + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of not equal +neq x y = + x `op2` y $ \arr arr1 arr2 -> + af_neq arr arr1 arr2 1 + +-- | Test if one 'Array' is not equal to another 'Array' +-- +-- >>> (A.scalar @Int 1 `A.neqBatched` A.scalar @Int 1) True +-- False +neqBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of not equal +neqBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_neq arr arr1 arr2 batch + +-- | Logical 'and' one 'Array' with another +-- +-- >>> A.scalar @Int 1 `A.and` A.scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +-- +and + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of and +and x y = + x `op2` y $ \arr arr1 arr2 -> + af_and arr arr1 arr2 1 + +-- | Logical 'and' one 'Array' with another +-- +-- >>> (A.scalar @Int 1 `andBatched` A.scalar @Int 1) True +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +andBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of and +andBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_and arr arr1 arr2 batch + +-- | Logical 'or' one 'Array' with another +-- +-- >>> A.scalar @Int 1 `A.or` A.scalar @Int 1 +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +-- +or + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of or +or x y = + x `op2` y $ \arr arr1 arr2 -> + af_or arr arr1 arr2 1 + +-- | Logical 'or' one 'Array' with another +-- +-- +-- >>> (A.scalar @Int 1 `A.orBatched` A.scalar @Int 1) True +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +orBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of or +orBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_or arr arr1 arr2 batch + +-- | Not the values of an 'Array' +-- +-- >>> A.not (A.scalar @Int 1) +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +not + :: AFType a + => Array a + -- ^ Input 'Array' + -> Array a + -- ^ Result of 'not' on an 'Array' +not = flip op1 af_not + +-- | Bitwise and the values in one 'Array' against another 'Array' +-- +-- >>> A.bitAnd (A.scalar @Int 1) (A.scalar @Int 1) +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +bitAnd + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of bitwise and +bitAnd x y = + x `op2` y $ \arr arr1 arr2 -> + af_bitand arr arr1 arr2 1 + +-- | Bitwise and the values in one 'Array' against another 'Array' +-- +--- >>> A.bitAndBatched (A.scalar @Int 1) (A.scalar @Int 1) True +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +bitAndBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of bitwise and +bitAndBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_bitand arr arr1 arr2 batch + +-- | Bitwise or the values in one 'Array' against another 'Array' +-- +-- >>> A.bitOr (A.scalar @Int 1) (A.scalar @Int 1) +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +bitOr + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of bit or +bitOr x y = do + x `op2` y $ \arr arr1 arr2 -> + af_bitor arr arr1 arr2 1 + +-- | Bitwise or the values in one 'Array' against another 'Array' +-- +-- >>> A.bitOrBatched (A.scalar @Int 1) (A.scalar @Int 1) False +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +bitOrBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of bit or +bitOrBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_bitor arr arr1 arr2 batch + +-- | Bitwise xor the values in one 'Array' against another 'Array' +-- +-- >>> A.bitXor (A.scalar @Int 1) (A.scalar @Int 1) +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +bitXor + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of bit xor +bitXor x y = do + x `op2` y $ \arr arr1 arr2 -> + af_bitxor arr arr1 arr2 1 + +-- | Bitwise xor the values in one 'Array' against another 'Array' +-- +-- >>> A.bitXorBatched (A.scalar @Int 1) (A.scalar @Int 1) False +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +bitXorBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of bit xor +bitXorBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_bitxor arr arr1 arr2 batch + +-- | Left bit shift the values in one 'Array' against another 'Array' +-- +-- >>> A.bitShiftL (A.scalar @Int 1) (A.scalar @Int 1) +-- ArrayFire Array +-- [1 1 1 1] +-- 2 +bitShiftL + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of bit shift left +bitShiftL x y = + x `op2` y $ \arr arr1 arr2 -> + af_bitshiftl arr arr1 arr2 1 + +-- | Left bit shift the values in one 'Array' against another 'Array' +-- +-- >>> A.bitShiftLBatched (A.scalar @Int 1) (A.scalar @Int 1) False +-- ArrayFire Array +-- [1 1 1 1] +-- 2 +bitShiftLBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of bit shift left +bitShiftLBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_bitshiftl arr arr1 arr2 batch + +-- | Right bit shift the values in one 'Array' against another 'Array' +-- +-- >>> A.bitShiftR (A.scalar @Int 1) (A.scalar @Int 1) +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +bitShiftR + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of bit shift right +bitShiftR x y = + x `op2` y $ \arr arr1 arr2 -> + af_bitshiftr arr arr1 arr2 1 + +-- | Right bit shift the values in one 'Array' against another 'Array' +-- +-- >>> A.bitShiftRBatched (A.scalar @Int 1) (A.scalar @Int 1) False +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +bitShiftRBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of bit shift left +bitShiftRBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_bitshiftr arr arr1 arr2 batch + +-- | Cast one 'Array' into another +-- +-- +-- >>> A.cast (A.scalar @Int 1) :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 1.0000 +cast + :: forall a b . (AFType a, AFType b) + => Array a + -- ^ Input array to cast + -> Array b + -- ^ Result of cast +cast afArr = + coerce $ afArr `op1` (\x y -> af_cast x y dtyp) + where + dtyp = afType (Proxy @ b) + +-- | Find the minimum of two 'Array's +-- +-- >>> A.minOf (A.scalar @Int 1) (A.scalar @Int 0) +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +minOf + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of minimum of +minOf x y = + x `op2` y $ \arr arr1 arr2 -> + af_minof arr arr1 arr2 1 + +-- | Find the minimum of two 'Array's +-- +-- >>> A.minOfBatched (A.scalar @Int 1) (A.scalar @Int 0) False +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +minOfBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of minimum of +minOfBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_minof arr arr1 arr2 batch + +-- | Find the maximum of two 'Array's +-- +-- >>> A.maxOf (A.scalar @Int 1) (A.scalar @Int 0) +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +maxOf + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of maximum of +maxOf x y = + x `op2` y $ \arr arr1 arr2 -> + af_maxof arr arr1 arr2 1 + + +-- | Find the maximum of two 'Array's +-- +-- >>> A.maxOfBatched (A.scalar @Int 1) (A.scalar @Int 0) False +-- ArrayFire Array +--[1 1 1 1] +-- 1 +maxOfBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of maximum of +maxOfBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_maxof arr arr1 arr2 batch + +-- | Should take the clamp +-- +-- +-- >>> clamp (A.scalar @Int 2) (A.scalar @Int 1) (A.scalar @Int 3) +-- ArrayFire Array +-- [1 1 1 1] +-- 2 +-- +clamp + :: Array a + -- ^ input + -> Array a + -- ^ lower bound + -> Array a + -- ^ upper bound + -> Array a + -- ^ Result of clamp +clamp a b c = + op3 a b c $ \arr arr1 arr2 arr3 -> + af_clamp arr arr1 arr2 arr3 1 + +-- | Should take the clamp +-- +-- >>> (clampBatched (A.scalar @Int 2) (A.scalar @Int 1) (A.scalar @Int 3)) True +-- ArrayFire Array +-- [1 1 1 1] +-- 2 +clampBatched + :: Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Third input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of clamp +clampBatched a b c (fromIntegral . fromEnum -> batch) = + op3 a b c $ \arr arr1 arr2 arr3 -> + af_clamp arr arr1 arr2 arr3 batch + +-- | Find the remainder of two 'Array's +-- +-- >>> A.rem (A.vector @Int 10 [1..]) (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0 0 0 0 0 0 0 0 0 0 +rem + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of remainder +rem x y = + x `op2` y $ \arr arr1 arr2 -> + af_rem arr arr1 arr2 1 + +-- | Find the remainder of two 'Array's +-- +-- +-- >>> A.remBatched (A.vector @Int 10 [1..]) (vector @Int 10 [1..]) True +-- +remBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of remainder +remBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_rem arr arr1 arr2 batch + +-- | Take the 'mod' of two 'Array's +-- +-- >>> A.mod (A.vector @Int 10 [1..]) (A.vector @Int 10 [1..]) +-- ArrayFire Array +--[10 1 1 1] +-- 0 0 0 0 0 0 0 0 0 0 +mod + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of mod +mod x y = do + x `op2` y $ \arr arr1 arr2 -> + af_mod arr arr1 arr2 1 + +-- | Take the 'mod' of two 'Array's +-- +-- >>> A.modBatched (vector @Int 10 [1..]) (vector @Int 10 [1..]) True +-- ArrayFire Array +-- [10 1 1 1] +-- 0 0 0 0 0 0 0 0 0 0 +modBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of mod +modBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_mod arr arr1 arr2 batch + +-- | Take the absolute value of an array +-- +-- >>> A.abs (A.scalar @Int (-1)) +-- ArrayFire Array +-- [1 1 1 1] +-- 1.0000 +-- +abs + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'abs' +abs = flip op1 af_abs + +-- | Find the arg of an array +-- +-- >>> A.arg (vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0 0 0 0 0 0 0 0 0 0 +arg + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'arg' +arg = flip op1 af_arg + +-- | Find the sign of two 'Array's +-- +-- >>> A.sign (vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 +sign + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'sign' +sign = flip op1 af_sign + +-- | Round the values in an 'Array' +-- +-- >>> A.round (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +round + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'round' +round = flip op1 af_round + +-- | Truncate the values of an 'Array' +-- +-- >>> A.trunc (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +trunc + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'trunc' +trunc = flip op1 af_trunc + +-- | Take the floor of all values in an 'Array' +-- +-- >>> A.floor (A.vector @Int 10 [10,9..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +floor + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'floor' +floor = flip op1 af_floor + +-- | Take the ceil of all values in an 'Array' +-- +-- >>> A.ceil (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +ceil + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'ceil' +ceil = flip op1 af_ceil + +-- | Take the sin of all values in an 'Array' +-- +-- >>> A.sin (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.8415 0.9093 0.1411 -0.7568 -0.9589 -0.2794 0.6570 0.9894 0.4121 -0.5440 +sin + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'sin' +sin = flip op1 af_sin + +-- | Take the cos of all values in an 'Array' +-- +-- >>> A.cos (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.5403 -0.4161 -0.9900 -0.6536 0.2837 0.9602 0.7539 -0.1455 -0.9111 -0.8391 +cos + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'cos' +cos = flip op1 af_cos + +-- | Take the tan of all values in an 'Array' +-- +-- >>> A.tan (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.5574 -2.1850 -0.1425 1.1578 -3.3805 -0.2910 0.8714 -6.7997 -0.4523 0.6484 +tan + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'tan' +tan = flip op1 af_tan + +-- | Take the asin of all values in an 'Array' +-- +-- >>> A.asin (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.5708 nan nan nan nan nan nan nan nan nan +-- +asin + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'asin' +asin = flip op1 af_asin + +-- | Take the acos of all values in an 'Array' +-- +-- >>> A.acos (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 nan nan nan nan nan nan nan nan nan +acos + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'acos' +acos = flip op1 af_acos + +-- | Take the atan of all values in an 'Array' +-- +-- >>> A.atan (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.7854 1.1071 1.2490 1.3258 1.3734 1.4056 1.4289 1.4464 1.4601 1.4711 +atan + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'atan' +atan = flip op1 af_atan + +-- | Take the atan2 of all values in an 'Array' +-- +-- >>> A.atan2 (A.vector @Int 10 [1..]) (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 +atan2 + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of atan2 +atan2 x y = + x `op2` y $ \arr arr1 arr2 -> + af_atan2 arr arr1 arr2 1 + +-- | Take the atan2 of all values in an 'Array' +-- +-- >>> A.atan2Batched (A.vector @Int 10 [1..]) (A.vector @Int 10 [1..]) True +-- ArrayFire Array +-- [10 1 1 1] +-- 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 0.7854 +atan2Batched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of atan2 +atan2Batched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_atan2 arr arr1 arr2 batch + +-- | Take the cplx2 of all values in an 'Array' +-- +-- >>> A.cplx2 (A.vector @Int 10 [1..]) (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- (1.0000,1.0000) (2.0000,2.0000) (3.0000,3.0000) (4.0000,4.0000) (5.0000,5.0000) (6.0000,6.0000) (7.0000,7.0000) (8.0000,8.0000) (9.0000,9.0000) (10.0000,10.0000) +cplx2 + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of cplx2 +cplx2 x y = + x `op2` y $ \arr arr1 arr2 -> + af_cplx2 arr arr1 arr2 1 + +-- | Take the cplx2Batched of all values in an 'Array' +-- +-- >>> A.cplx2Batched (A..vector @Int 10 [1..]) (A.vector @Int 10 [1..]) True +-- ArrayFire Array +-- [10 1 1 1] +-- (1.0000,1.0000) (2.0000,2.0000) (3.0000,3.0000) (4.0000,4.0000) (5.0000,5.0000) (6.0000,6.0000) (7.0000,7.0000) (8.0000,8.0000) (9.0000,9.0000) (10.0000,10.0000) +cplx2Batched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of cplx2 +cplx2Batched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_cplx2 arr arr1 arr2 batch + +-- | Execute cplx +-- +-- >>> A.cplx (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- (1.0000,0.0000) (2.0000,0.0000) (3.0000,0.0000) (4.0000,0.0000) (5.0000,0.0000) (6.0000,0.0000) (7.0000,0.0000) (8.0000,0.0000) (9.0000,0.0000) (10.0000,0.0000) +cplx + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'atan' +cplx = flip op1 af_cplx + +-- | Execute real +-- +-- >>> A.real (A.vector @Double 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +real + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'real' +real = flip op1 af_real + +-- | Execute imag +-- +-- >>> A.imag (A.vector @Double 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 +imag + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'imag' +imag = flip op1 af_imag + +-- | Execute conjg +-- +-- >>> A.conjg (A.vector @Double 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +conjg + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'conjg' +conjg = flip op1 af_conjg + +-- | Execute sinh +-- +-- >>> A.sinh (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.1752 3.6269 10.0179 27.2899 74.2032 201.7132 548.3161 1490.4788 4051.5419 11013.2329 +sinh + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'sinh' +sinh = flip op1 af_sinh + +-- | Execute cosh +-- +-- +-- >>> A.cosh (A.vector @Double 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.5431 3.7622 10.0677 27.3082 74.2099 201.7156 548.3170 1490.4792 4051.5420 11013.2329 +cosh + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'cosh' +cosh = flip op1 af_cosh + +-- | Execute tanh +-- +-- >>> A.tanh (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.7616 0.9640 0.9951 0.9993 0.9999 1.0000 1.0000 1.0000 1.0000 1.0000 +tanh + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'tanh' +tanh = flip op1 af_tanh + +-- | Execute asinh +-- +-- >>> A.asinh (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.8814 1.4436 1.8184 2.0947 2.3124 2.4918 2.6441 2.7765 2.8934 2.9982 +asinh + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'tanh' +asinh = flip op1 af_asinh + +-- | Execute acosh +-- +-- >>> A.acosh (A.vector @Double 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 1.3170 1.7627 2.0634 2.2924 2.4779 2.6339 2.7687 2.8873 2.9932 +acosh + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'tanh' +acosh = flip op1 af_acosh + +-- | Execute atanh +-- +-- >>> A.atanh (A.vector @Double 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- inf nan nan nan nan nan nan nan nan nan +atanh + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'tanh' +atanh = flip op1 af_atanh + +-- | Execute root +-- +-- >>> A.root (A.vector @Double 10 [1..]) (A.vector @Double 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 1.4142 1.4422 1.4142 1.3797 1.3480 1.3205 1.2968 1.2765 1.2589 +root + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of root +root x y = + x `op2` y $ \arr arr1 arr2 -> + af_root arr arr1 arr2 1 + +-- | Execute rootBatched +-- +-- >>> A.rootBatched (vector @Double 10 [1..]) (vector @Double 10 [1..]) True +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 1.4142 1.4422 1.4142 1.3797 1.3480 1.3205 1.2968 1.2765 1.2589 +rootBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of root +rootBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_root arr arr1 arr2 batch + +-- | Execute pow +-- +-- >>> A.pow (A.vector @Int 10 [1..]) 2 +-- ArrayFire Array +-- [10 1 1 1] +-- 1 4 9 16 25 36 49 64 81 100 +pow + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array a + -- ^ Result of pow +pow x y = + x `op2` y $ \arr arr1 arr2 -> + af_pow arr arr1 arr2 1 + + +-- | Execute powBatched +-- +-- >>> A.powBatched (A.vector @Int 10 [1..]) (A.constant @Int [1] 2) True +-- ArrayFire Array +-- [10 1 1 1] +-- 1 4 9 16 25 36 49 64 81 100 +powBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array a + -- ^ Result of powBatched +powBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2` y $ \arr arr1 arr2 -> + af_pow arr arr1 arr2 batch + +-- | Raise an 'Array' to the second power +-- +-- >>> A.pow2 (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 2 4 8 16 32 64 128 256 512 1024 +pow2 + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'pow2' +pow2 = flip op1 af_pow2 + +-- | Execute exp on 'Array' +-- +-- >>> A.exp (A.vector @Double 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 2.7183 7.3891 20.0855 54.5982 148.4132 403.4288 1096.6332 2980.9580 8103.0839 22026.4658 +exp + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'exp' +exp = flip op1 af_exp + +-- | Execute sigmoid on 'Array' +-- +-- >>> A.sigmoid (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.7311 0.8808 0.9526 0.9820 0.9933 0.9975 0.9991 0.9997 0.9999 1.0000 +sigmoid + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'sigmoid' +sigmoid = flip op1 af_sigmoid + +-- | Execute expm1 +-- +-- >>> A.expm1 (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.7183 6.3891 19.0855 53.5981 147.4132 402.4288 1095.6332 2979.9580 8102.0840 22025.4648 +expm1 + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'expm1' +expm1 = flip op1 af_expm1 + +-- | Execute erf +-- +-- >>> A.erf (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.8427 0.9953 1.0000 1.0000 1.0000 1.0000 1.0000 1.0000 1.0000 1.0000 +erf + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'erf' +erf = flip op1 af_erf + +-- | Execute erfc +-- +-- >>> A.erfc (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.1573 0.0047 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 +erfc + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'erfc' +erfc = flip op1 af_erfc + +-- | Execute log +-- +-- >>> A.log (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 0.6931 1.0986 1.3863 1.6094 1.7918 1.9459 2.0794 2.1972 2.3026 +log + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'log' +log = flip op1 af_log + +-- | Execute log1p +-- +-- >>> A.log1p (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.6931 1.0986 1.3863 1.6094 1.7918 1.9459 2.0794 2.1972 2.3026 2.3979 +log1p + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'log1p' +log1p = flip op1 af_log1p + +-- | Execute log10 +-- +-- >>> A.log10 (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 0.3010 0.4771 0.6021 0.6990 0.7782 0.8451 0.9031 0.9542 1.0000 +log10 + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'log10' +log10 = flip op1 af_log10 + +-- | Execute log2 +-- +-- >>> A.log2 (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 1.0000 1.5850 2.0000 2.3219 2.5850 2.8074 3.0000 3.1699 3.3219 +log2 + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'log2' +log2 = flip op1 af_log2 + +-- | Execute sqrt +-- +-- >>> A.sqrt (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 1.4142 1.7321 2.0000 2.2361 2.4495 2.6458 2.8284 3.0000 3.1623 +sqrt + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'sqrt' +sqrt = flip op1 af_sqrt + +-- | Execute cbrt +-- +-- >>> A.cbrt (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 1.2599 1.4422 1.5874 1.7100 1.8171 1.9129 2.0000 2.0801 2.1544 +cbrt + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'cbrt' +cbrt = flip op1 af_cbrt + +-- | Execute factorial1 +-- +-- >>> A.factorial1 (A.vector @Int 10 [1..]) +-- +factorial + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'factorial' +factorial = flip op1 af_factorial + +-- | Execute tgamma +-- +-- +-- >>> 'tgamma' (vector @Int 10 [1..]) +-- +tgamma + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'tgamma' +tgamma = flip op1 af_tgamma + +-- | Execute lgamma +-- +-- >>> A.lgamma (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 0.0000 0.6931 1.7918 3.1781 4.7875 6.5793 8.5252 10.6046 12.8018 +lgamma + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'lgamma' +lgamma = flip op1 af_lgamma + +-- | Execute isZero +-- +-- >>> A.isZero (A.vector @CBool 10 (repeat 0)) +-- ArrayFire Array +-- [10 1 1 1] +-- 1 1 1 1 1 1 1 1 1 1 +isZero + :: AFType a + => Array a + -- ^ Input array + -> Array a + -- ^ Result of calling 'isZero' +isZero = (`op1` af_iszero) + +-- | Execute isInf +-- +-- >>> A.isInf (A.vector @Double 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0 0 0 0 0 0 0 0 0 0 +isInf + :: (Real a, AFType a) + => Array a + -- ^ Input array + -> Array a + -- ^ will contain 1's where input is Inf or -Inf, and 0 otherwise. +isInf = (`op1` af_isinf) + +-- | Execute isNaN +-- +-- >>> A.isNaN $ A.acos (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0 1 1 1 1 1 1 1 1 1 +isNaN + :: forall a. (AFType a, Real a) + => Array a + -- ^ Input array + -> Array a + -- ^ Will contain 1's where input is NaN, and 0 otherwise. +isNaN = (`op1` af_isnan) diff --git a/src/ArrayFire/Array.hs b/src/ArrayFire/Array.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Array.hs @@ -0,0 +1,489 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE KindSignatures #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Array +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Functions for constructing and querying metadata from 'Array' +-- +-- @ +-- module Main where +-- +-- import ArrayFire +-- +-- main :: 'IO' () +-- main = 'print' (matrix \@'Double' (2,2) [ [1..], [1..] ]) +-- @ +-- +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 2.0000 +-- 1.0000 2.0000 +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Array where + +import Control.Exception +import Control.Monad +import Data.Proxy +import Data.Vector.Storable hiding (mapM_, take, concat, concatMap) +import qualified Data.Vector.Storable as V +import Foreign.ForeignPtr +import Foreign.Marshal hiding (void) +import Foreign.Ptr +import Foreign.Storable + +import System.IO.Unsafe + +import ArrayFire.Exception +import ArrayFire.FFI +import ArrayFire.Util +import ArrayFire.Internal.Array +import ArrayFire.Internal.Defines +import ArrayFire.Internal.Types + +-- | Smart constructor for creating a scalar 'Array' +-- +-- >>> scalar @Double 2.0 +-- ArrayFire Array +-- [1 1 1 1] +-- 2.0000 +scalar :: AFType a => a -> Array a +scalar x = mkArray [1] [x] + +-- | Smart constructor for creating a vector 'Array' +-- +-- >>> vector @Double 10 [1..] +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +vector :: AFType a => Int -> [a] -> Array a +vector n = mkArray [n] . take n + +-- | Smart constructor for creating a matrix 'Array' +-- +-- >>> matrix @Double (2,2) [[1,2],[3,4]] +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 2.0000 +-- 3.0000 4.0000 +-- +matrix :: AFType a => (Int,Int) -> [[a]] -> Array a +matrix (x,y) + = mkArray [x,y] + . concat + . take x + . fmap (take y) + +-- | Smart constructor for creating a cubic 'Array' +-- +-- >>> cube @Double (2,2,2) [[[2,2],[2,2]],[[2,2],[2,2]]] +-- +-- @ +-- ArrayFire Array +-- [2 2 2 1] +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- @ +cube :: AFType a => (Int,Int,Int) -> [[[a]]] -> Array a +cube (x,y,z) + = mkArray [x,y,z] + . concat + . fmap concat + . take x + . fmap (take y) + . (fmap . fmap . take) z + +-- | Smart constructor for creating a tensor 'Array' +-- +-- >>> tensor @Double (2,2,2,2) [[[[2,2],[2,2]],[[2,2],[2,2]]], [[[2,2],[2,2]],[[2,2],[2,2]]]] +-- +-- @ +-- ArrayFire Array +-- [2 2 2 2] +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- +-- +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- @ +tensor :: AFType a => (Int, Int,Int,Int) -> [[[[a]]]] -> Array a +tensor (w,x,y,z) + = mkArray [w,x,y,z] + . concat + . fmap concat + . (fmap . fmap) concat + . take w + . (fmap . take) x + . (fmap . fmap . take) y + . (fmap . fmap . fmap . take) z + +-- | Internal function for 'Array' construction +-- +-- >>> mkArray @Double [10] [1.0 .. 10.0] +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 10.0000 +-- +mkArray + :: forall array + . AFType array + => [Int] + -- ^ Dimensions + -> [array] + -- ^ Array elements + -> Array array + -- ^ Returned array +{-# NOINLINE mkArray #-} +mkArray dims xs = + unsafePerformIO $ do + when (Prelude.length (take size xs) < size) $ do + let msg = "Invalid elements provided. " + <> "Expected " + <> show size + <> " elements received " + <> show (Prelude.length xs) + throwIO (AFException SizeError 203 msg) + dataPtr <- castPtr <$> newArray (Prelude.take size xs) + let ndims = fromIntegral (Prelude.length dims) + alloca $ \arrayPtr -> do + zeroOutArray arrayPtr + dimsPtr <- newArray (DimT . fromIntegral <$> dims) + throwAFError =<< af_create_array arrayPtr dataPtr ndims dimsPtr dType + free dataPtr >> free dimsPtr + arr <- peek arrayPtr + Array <$> newForeignPtr af_release_array_finalizer arr + where + size = Prelude.product dims + dType = afType (Proxy @ array) + +-- af_err af_create_handle(af_array *arr, const unsigned ndims, const dim_t * const dims, const af_dtype type); + +-- | Copies an 'Array' to a new 'Array' +-- +-- >>> copyArray (scalar @Double 10) +-- ArrayFire Array +-- [1 1 1 1] +-- 10.0000 +copyArray + :: AFType a + => Array a + -- ^ 'Array' to be copied + -> Array a + -- ^ Newly copied 'Array' +copyArray = (`op1` af_copy_array) +-- af_err af_write_array(af_array arr, const void *data, const size_t bytes, af_source src); +-- af_err af_get_data_ptr(void *data, const af_array arr); + +-- | Retains an 'Array', increases reference count +-- +-- >>> retainArray (scalar @Double 10) +-- ArrayFire Array +-- [1 1 1 1] +-- 10.0000 +retainArray + :: AFType a + => Array a + -- ^ Input 'Array' + -> Array a +retainArray = + (`op1` af_retain_array) + +-- | Retrieves 'Array' reference count +-- +-- >>> initialArray = scalar @Double 10 +-- >>> retainedArray = retain initialArray +-- >>> getDataRefCount retainedArray +-- 2 +-- +getDataRefCount + :: AFType a + => Array a + -- ^ Input 'Array' + -> Int + -- ^ Reference count +getDataRefCount = + fromIntegral . (`infoFromArray` af_get_data_ref_count) + +-- af_err af_eval(af_array in); +-- af_err af_eval_multiple(const int num, af_array *arrays); + +-- | Should manual evaluation occur +-- +-- >>> setManualEvalFlag True +-- () +setManualEvalFlag + :: Bool + -- ^ Whether or not to perform manual evaluation + -> IO () +setManualEvalFlag (fromIntegral . fromEnum -> b) = + afCall (af_set_manual_eval_flag b) + +-- | Retrieve manual evaluation status +-- +-- >>> setManualEvalFlag False +-- >>> getManualEvalFlag +-- False +-- +getManualEvalFlag + :: IO Bool +getManualEvalFlag = + toEnum . fromIntegral <$> afCall1 af_get_manual_eval_flag + +-- | Retrieve element count +-- +-- >>> getElements (vector @Double 10 [1..]) +-- 10 +-- +getElements + :: AFType a + => Array a + -- ^ Input 'Array' + -> Int + -- ^ Count of elements in 'Array' +getElements a = + fromIntegral (a `infoFromArray` af_get_elements) + +-- | Retrieve type of 'Array' +-- +-- >>> getType (vector @Double 10 [1..]) +-- F64 +-- +getType + :: AFType a + => Array a + -> AFDType +getType a = fromAFType (a `infoFromArray` af_get_type) + +-- | Retrieves dimensions of 'Array' +-- +-- >>> getDims (vector @Double 10 [1..]) +-- (10,1,1,1) +-- +getDims + :: AFType a + => Array a + -> (Int,Int,Int,Int) +getDims arr = do + let (a,b,c,d) = arr `infoFromArray4` af_get_dims + (fromIntegral a, fromIntegral b, fromIntegral c, fromIntegral d) + +-- | Retrieves number of dimensions in 'Array' +-- +-- >>> getNumDims (matrix @Double (2,2) [[1..],[1..]]) +-- 2 +-- +getNumDims + :: AFType a + => Array a + -> Int +getNumDims = fromIntegral . (`infoFromArray` af_get_numdims) + +-- | Checks if an 'Array' is empty +-- +-- >>> isEmpty (matrix @Double (2,2) [[1..],[1..]]) +-- False +-- +isEmpty + :: AFType a + => Array a + -> Bool +isEmpty a = toEnum . fromIntegral $ (a `infoFromArray` af_is_empty) + +-- | Checks if an 'Array' is a scalar (contains only one element) +-- +-- >>> isScalar (matrix @Double (2,2) [[1..],[1..]]) +-- False +-- >>> isScalar (1.0 :: Array Double) +-- True +-- +isScalar + :: AFType a + => Array a + -> Bool +isScalar a = toEnum . fromIntegral $ (a `infoFromArray` af_is_scalar) + +-- | Checks if an 'Array' is row-oriented +-- +-- >>> isRow (matrix @Double (2,2) [[1..],[1..]]) +-- False +-- +isRow + :: AFType a + => Array a + -> Bool +isRow a = toEnum . fromIntegral $ (a `infoFromArray` af_is_row) + +-- | Checks if an 'Array' is a column-oriented +-- +-- >>> isColumn (vector @Double 10 [1..]) +-- True +-- +isColumn + :: AFType a + => Array a + -> Bool +isColumn a = toEnum . fromIntegral $ (a `infoFromArray` af_is_column) + +-- | Checks if an 'Array' is a vector +-- +-- >>> isVector (vector @Double 10 [1..]) +-- True +-- >>> isVector (1.0 :: Array Double) +-- False +-- +isVector + :: AFType a + => Array a + -> Bool +isVector a = toEnum . fromIntegral $ (a `infoFromArray` af_is_vector) + +-- | Checks if an 'Array' is a Complex +-- +-- >>> isComplex (scalar (1.0 :+ 1.0) :: Array (Complex Double)) +-- True +-- +isComplex + :: AFType a + => Array a + -> Bool +isComplex a = toEnum . fromIntegral $ (a `infoFromArray` af_is_complex) + +-- | Checks if an 'Array' is Real +-- +-- >>> isReal (scalar 1.0 :: Array Double) +-- True +-- +isReal + :: AFType a + => Array a + -> Bool +isReal a = toEnum . fromIntegral $ (a `infoFromArray` af_is_real) + +-- | Checks if an 'Array' is 'Double' +-- +-- >>> isDouble (scalar 1.0 :: Array Double) +-- True +-- +isDouble + :: AFType a + => Array a + -> Bool +isDouble a = toEnum . fromIntegral $ (a `infoFromArray` af_is_double) + +-- | Checks if an 'Array' is 'Float' +-- +-- >>> isSingle (scalar 1.0 :: Array Float) +-- True +-- +isSingle + :: AFType a + => Array a + -> Bool +isSingle a = toEnum . fromIntegral $ (a `infoFromArray` af_is_single) + +-- | Checks if an 'Array' is 'Double', 'Float', Complex 'Double', or Complex 'Float' +-- +-- >>> isRealFloating (scalar 1.0 :: Array Double) +-- True +-- +isRealFloating + :: AFType a + => Array a + -> Bool +isRealFloating a = toEnum . fromIntegral $ (a `infoFromArray` af_is_realfloating) + +-- | Checks if an 'Array' is 'Double' or 'Float' +-- +-- >>> isFloating (scalar 1.0 :: Array Double) +-- True +isFloating + :: AFType a + => Array a + -> Bool +isFloating a = toEnum . fromIntegral $ (a `infoFromArray` af_is_floating) + +-- | Checks if an 'Array' is of type Int16, Int32, or Int64 +-- +-- >>> isInteger (scalar 1 :: Array Int16) +-- True +isInteger + :: AFType a + => Array a + -> Bool +isInteger a = toEnum . fromIntegral $ (a `infoFromArray` af_is_integer) + +-- | Checks if an 'Array' is of type CBool +-- +-- >>> isBool (scalar 1 :: Array CBool) +-- True +isBool + :: AFType a + => Array a + -> Bool +isBool a = toEnum . fromIntegral $ (a `infoFromArray` af_is_bool) + +-- | Checks if an 'Array' is sparse +-- +-- >>> isSparse (scalar 1 :: Array Double) +-- False +isSparse + :: AFType a + => Array a + -> Bool +isSparse a = toEnum . fromIntegral $ (a `infoFromArray` af_is_sparse) + +-- | Converts an 'Array' to a 'Storable' 'Vector' +-- +-- >>> toVector (vector @Double 10 [1..]) +-- [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0] +toVector :: forall a . AFType a => Array a -> Vector a +toVector arr@(Array fptr) = do + unsafePerformIO . mask_ . withForeignPtr fptr $ \arrPtr -> do + let len = getElements arr + size = len * getSizeOf (Proxy @ a) + ptr <- mallocBytes (len * size) + throwAFError =<< af_get_data_ptr (castPtr ptr) arrPtr + newFptr <- newForeignPtr finalizerFree ptr + pure $ unsafeFromForeignPtr0 newFptr len + +-- | Converts an 'Array' to [a] +-- +-- >>> toList (vector @Double 10 [1..]) +-- [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0] +toList :: forall a . AFType a => Array a -> [a] +toList = V.toList . toVector + +-- | Retrieves single scalar value from an 'Array' +-- +-- >>> getScalar (scalar @Double 22.0) :: Double +-- 22.0 +getScalar :: forall a b . (Storable a, AFType b) => Array b -> a +getScalar (Array fptr) = + unsafePerformIO . mask_ . withForeignPtr fptr $ \arrPtr -> do + alloca $ \ptr -> do + throwAFError =<< af_get_scalar (castPtr ptr) arrPtr + peek ptr diff --git a/src/ArrayFire/BLAS.hs b/src/ArrayFire/BLAS.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/BLAS.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.BLAS +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Basic Linear Algebra Subprograms (BLAS) API +-- +-- @ +-- main :: IO () +-- main = print (matmul x y xProp yProp) +-- where +-- x,y :: Array Double +-- x = matrix (2,3) [1..] +-- y = matrix (3,2) [1..] +-- +-- xProp, yProp :: MatProp +-- xProp = None +-- yProp = None +-- @ +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- 22.0000 28.0000 +-- 49.0000 64.0000 +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.BLAS where + +import Data.Complex + +import ArrayFire.FFI +import ArrayFire.Internal.BLAS +import ArrayFire.Internal.Types + +-- | The following applies for Sparse-Dense matrix multiplication. +-- +-- This function can be used with one sparse input. The sparse input must always be the lhs and the dense matrix must be rhs. +-- +-- The sparse array can only be of 'CSR' format. +-- +-- The returned array is always dense. +-- +-- optLhs an only be one of AF_MAT_NONE, AF_MAT_TRANS, AF_MAT_CTRANS. +-- +-- optRhs can only be AF_MAT_NONE. +-- +-- >>> matmul (matrix @Double (2,2) [[1,2],[3,4]]) (matrix @Double (2,2) [[1,2],[3,4]]) None None +-- ArrayFire Array +-- [2 2 1 1] +-- 7.0000 10.0000 +-- 15.0000 22.0000 +matmul + :: Array a + -- ^ 2D matrix of Array a, left-hand side + -> Array a + -- ^ 2D matrix of Array a, right-hand side + -> MatProp + -- ^ Left hand side matrix options + -> MatProp + -- ^ Right hand side matrix options + -> Array a + -- ^ Output of 'matmul' +matmul arr1 arr2 prop1 prop2 = do + op2 arr1 arr2 (\p a b -> af_matmul p a b (toMatProp prop1) (toMatProp prop2)) + +-- | Scalar dot product between two vectors. Also referred to as the inner product. +-- +-- >>> dot (vector @Double 10 [1..]) (vector @Double 10 [1..]) None None +-- ArrayFire Array +-- [1 1 1 1] +-- 385.0000 +dot + :: Array a + -- ^ Left-hand side input + -> Array a + -- ^ Right-hand side input + -> MatProp + -- ^ Options for left-hand side. Currently only AF_MAT_NONE and AF_MAT_CONJ are supported. + -> MatProp + -- ^ Options for right-hand side. Currently only AF_MAT_NONE and AF_MAT_CONJ are supported. + -> Array a + -- ^ Output of 'dot' +dot arr1 arr2 prop1 prop2 = + op2 arr1 arr2 (\p a b -> af_dot p a b (toMatProp prop1) (toMatProp prop2)) + +-- | Scalar dot product between two vectors. Also referred to as the inner product. Returns the result as a host scalar. +-- +-- >>> dotAll (vector @Double 10 [1..]) (vector @Double 10 [1..]) None None +-- 385.0 :+ 0.0 +dotAll + :: Array a + -- ^ Left-hand side array + -> Array a + -- ^ Right-hand side array + -> MatProp + -- ^ Options for left-hand side. Currently only AF_MAT_NONE and AF_MAT_CONJ are supported. + -> MatProp + -- ^ Options for right-hand side. Currently only AF_MAT_NONE and AF_MAT_CONJ are supported. + -> Complex Double + -- ^ Real and imaginary component result +dotAll arr1 arr2 prop1 prop2 = do + let (real,imag) = + infoFromArray22 arr1 arr2 $ \a b c d -> + af_dot_all a b c d (toMatProp prop1) (toMatProp prop2) + real :+ imag + +-- | Transposes a matrix. +-- +-- >>> matrix @Double (2,3) [[2,3,4],[4,5,6]] +-- ArrayFire Array +-- [2 3 1 1] +-- 2.0000 3.0000 +-- 4.0000 4.0000 +-- 5.0000 6.0000 +-- +-- >>> transpose (matrix @Double (2,3) [[2,3,4],[4,5,6]]) True +-- ArrayFire Array +-- [3 2 1 1] +-- 2.0000 4.0000 5.0000 +-- 3.0000 4.0000 6.0000 +-- +transpose + :: Array a + -- ^ Input matrix to be transposed + -> Bool + -- ^ Should perform conjugate transposition + -> Array a + -- ^ The transposed matrix +transpose arr1 (fromIntegral . fromEnum -> b) = + arr1 `op1` (\x y -> af_transpose x y b) + +-- | Transposes a matrix. +-- +-- * Warning: This function mutates an array in-place, all subsequent references will be changed. Use carefully. +-- +-- >>> array = matrix @Double (2,2) [[1..2],[3..4]] +-- >>> transposeInPlace array False +-- () +-- +transposeInPlace + :: Array a + -- ^ Input matrix to be transposed + -> Bool + -- ^ Should perform conjugate transposition + -> IO () +transposeInPlace arr (fromIntegral . fromEnum -> b) = + arr `inPlace` (`af_transpose_inplace` b) diff --git a/src/ArrayFire/Backend.hs b/src/ArrayFire/Backend.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Backend.hs @@ -0,0 +1,80 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Backend +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Set and get available ArrayFire 'Backend's. +-- +-- @ +-- module Main where +-- +-- import ArrayFire +-- +-- main :: IO () +-- main = print =<< getAvailableBackends +-- @ +-- +-- @ +-- [CPU,OpenCL] +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Backend where + +import ArrayFire.FFI +import ArrayFire.Internal.Backend +import ArrayFire.Internal.Types + +-- | Set specific 'Backend' to use +-- +-- >>> setBackend OpenCL +-- () +setBackend + :: Backend + -- ^ 'Backend' to use for 'Array' construction + -> IO () +setBackend = afCall . af_set_backend . toAFBackend + +-- | Retrieve count of Backends available +-- +-- >>> getBackendCount +-- 2 +-- +getBackendCount :: IO Int +getBackendCount = + fromIntegral <$> + afCall1 af_get_backend_count + +-- | Retrieve available 'Backend's +-- +-- >>> mapM_ print =<< getAvailableBackends +-- CPU +-- OpenCL +getAvailableBackends :: IO [Backend] +getAvailableBackends = + toBackends . fromIntegral <$> + afCall1 af_get_available_backends + +-- | Retrieve 'Backend' that specific 'Array' was created from +-- +-- >>> getBackend (scalar @Double 2.0) +-- OpenCL +getBackend :: Array a -> Backend +getBackend = toBackend . flip infoFromArray af_get_backend_id + +-- | Retrieve active 'Backend' +-- +-- >>> getActiveBackend +-- OpenCL +getActiveBackend :: IO Backend +getActiveBackend = toBackend <$> afCall1 af_get_active_backend + +-- | Retrieve Device ID that 'Array' was created from +-- +-- >>> getDeviceID (scalar \@Double 2.0) +-- 1 +getDeviceID :: Array a -> Int +getDeviceID = fromIntegral . flip infoFromArray af_get_device_id diff --git a/src/ArrayFire/Data.hs b/src/ArrayFire/Data.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Data.hs @@ -0,0 +1,572 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Data +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-------------------------------------------------------------------------------- +module ArrayFire.Data where + +import Control.Exception +import Control.Monad +import Data.Complex +import Data.Int +import Data.Proxy +import Data.Word +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal hiding (void) +import Foreign.Storable +import System.IO.Unsafe +import Unsafe.Coerce + +import ArrayFire.Exception +import ArrayFire.FFI +import ArrayFire.Internal.Data +import ArrayFire.Internal.Defines +import ArrayFire.Internal.Types +import ArrayFire.Arith + +-- | Creates an 'Array' from a scalar value from given dimensions +-- +-- >>> constant @Double [2,2] 2.0 +-- ArrayFire Array +-- [2 2 1 1] +-- 2.0000 2.0000 +-- 2.0000 2.0000 +constant + :: forall a . AFType a + => [Int] + -- ^ Dimensions + -> a + -- ^ Scalar value + -> Array a +constant dims val = + case dtyp of + x | x == c64 -> + cast $ constantComplex dims (unsafeCoerce val :: Complex Double) + | x == c32 -> + cast $ constantComplex dims (unsafeCoerce val :: Complex Float) + | x == s64 -> + cast $ constantLong dims (unsafeCoerce val :: Int) + | x == u64 -> + cast $ constantULong dims (unsafeCoerce val :: Word64) + | x == s32 -> + cast $ constant' dims (fromIntegral (unsafeCoerce val :: Int32) :: Double) + | x == s16 -> + cast $ constant' dims (fromIntegral (unsafeCoerce val :: Int16) :: Double) + | x == u32 -> + cast $ constant' dims (fromIntegral (unsafeCoerce val :: Word32) :: Double) + | x == u8 -> + cast $ constant' dims (fromIntegral (unsafeCoerce val :: Word8) :: Double) + | x == u16 -> + cast $ constant' dims (fromIntegral (unsafeCoerce val :: Word16) :: Double) + | x == f64 -> + cast $ constant' dims (unsafeCoerce val :: Double) + | x == b8 -> + cast $ constant' dims (fromIntegral (unsafeCoerce val :: CBool) :: Double) + | x == f32 -> + cast $ constant' dims (realToFrac (unsafeCoerce val :: Float)) + | otherwise -> error "constant: Invalid array fire type" + where + dtyp = afType (Proxy @ a) + + constant' + :: [Int] + -- ^ Dimensions + -> Double + -- ^ Scalar value + -> Array Double + constant' dims' val' = + unsafePerformIO . mask_ $ do + ptr <- alloca $ \ptrPtr -> do + zeroOutArray ptrPtr + withArray (fromIntegral <$> dims') $ \dimArray -> do + throwAFError =<< af_constant ptrPtr val' n dimArray typ + peek ptrPtr + Array <$> + newForeignPtr + af_release_array_finalizer + ptr + where + n = fromIntegral (length dims') + typ = afType (Proxy @ Double) + + -- | Creates an 'Array (Complex Double)' from a scalar val'ue + -- + -- @ + -- >>> constantComplex [2,2] (2.0 :+ 2.0) + -- @ + -- + constantComplex + :: forall arr . (Real arr, AFType (Complex arr)) + => [Int] + -- ^ Dimensions + -> Complex arr + -- ^ Scalar val'ue + -> Array (Complex arr) + constantComplex dims' ((realToFrac -> x) :+ (realToFrac -> y)) = unsafePerformIO . mask_ $ do + ptr <- alloca $ \ptrPtr -> do + zeroOutArray ptrPtr + withArray (fromIntegral <$> dims') $ \dimArray -> do + throwAFError =<< af_constant_complex ptrPtr x y n dimArray typ + peek ptrPtr + Array <$> + newForeignPtr + af_release_array_finalizer + ptr + where + n = fromIntegral (length dims') + typ = afType (Proxy @ (Complex arr)) + + -- | Creates an 'Array Int64' from a scalar val'ue + -- + -- @ + -- >>> constantLong [2,2] 2.0 + -- @ + -- + constantLong + :: [Int] + -- ^ Dimensions + -> Int + -- ^ Scalar val'ue + -> Array Int + constantLong dims' val' = unsafePerformIO . mask_ $ do + ptr <- alloca $ \ptrPtr -> do + zeroOutArray ptrPtr + withArray (fromIntegral <$> dims') $ \dimArray -> do + throwAFError =<< af_constant_long ptrPtr (fromIntegral val') n dimArray + peek ptrPtr + Array <$> + newForeignPtr + af_release_array_finalizer + ptr + where + n = fromIntegral (length dims') + + -- | Creates an 'Array Word64' from a scalar val'ue + -- + -- @ + -- >>> constantULong [2,2] 2.0 + -- @ + -- + constantULong + :: [Int] + -> Word64 + -> Array Word64 + constantULong dims' val' = unsafePerformIO . mask_ $ do + ptr <- alloca $ \ptrPtr -> do + zeroOutArray ptrPtr + withArray (fromIntegral <$> dims') $ \dimArray -> do + throwAFError =<< af_constant_ulong ptrPtr (fromIntegral val') n dimArray + peek ptrPtr + Array <$> + newForeignPtr + af_release_array_finalizer + ptr + where + n = fromIntegral (length dims') + +-- | Creates a range of values in an Array +-- +-- >>> range @Double [10] (-1) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000 +range + :: forall a + . AFType a + => [Int] + -> Int + -> Array a +range dims (fromIntegral -> k) = unsafePerformIO $ do + ptr <- alloca $ \ptrPtr -> mask_ $ do + withArray (fromIntegral <$> dims) $ \dimArray -> do + throwAFError =<< af_range ptrPtr n dimArray k typ + peek ptrPtr + Array <$> + newForeignPtr + af_release_array_finalizer + ptr + where + n = fromIntegral (length dims) + typ = afType (Proxy @ a) + +-- | Create an sequence [0, dims.elements() - 1] and modify to specified dimensions dims and then tile it according to tile_dims. +-- +-- +-- +-- >>> iota @Double [5,3] [] +-- ArrayFire Array +-- [5 3 1 1] +-- 0.0000 1.0000 2.0000 3.0000 4.0000 +-- 5.0000 6.0000 7.0000 8.0000 9.0000 +-- 10.0000 11.0000 12.0000 13.0000 14.0000 +-- +-- >>> iota @Double [5,3] [1,2] +-- ArrayFire Array +-- [5 6 1 1] +-- 0.0000 1.0000 2.0000 3.0000 4.0000 +-- 5.0000 6.0000 7.0000 8.0000 9.0000 +-- 10.0000 11.0000 12.0000 13.0000 14.0000 +-- 0.0000 1.0000 2.0000 3.0000 4.0000 +-- 5.0000 6.0000 7.0000 8.0000 9.0000 +-- 10.0000 11.0000 12.0000 13.0000 14.0000 +iota + :: forall a . AFType a + => [Int] + -- ^ is the array containing sizes of the dimension + -> [Int] + -- ^ is array containing the number of repetitions of the unit dimensions + -> Array a + -- ^ is the generated array +iota dims tdims = unsafePerformIO $ do + let dims' = take 4 (dims ++ repeat 1) + tdims' = take 4 (tdims ++ repeat 1) + ptr <- alloca $ \ptrPtr -> mask_ $ do + zeroOutArray ptrPtr + withArray (fromIntegral <$> dims') $ \dimArray -> + withArray (fromIntegral <$> tdims') $ \tdimArray -> do + throwAFError =<< af_iota ptrPtr 4 dimArray 4 tdimArray typ + peek ptrPtr + Array <$> + newForeignPtr + af_release_array_finalizer + ptr + where + typ = afType (Proxy @ a) + +-- | Creates the identity `Array` from given dimensions +-- +-- >>> identity [2,2] +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 0.0000 +-- 0.0000 1.0000 +identity + :: forall a . AFType a + => [Int] + -- ^ Dimensions + -> Array a +identity dims = unsafePerformIO . mask_ $ do + let dims' = take 4 (dims ++ repeat 1) + ptr <- alloca $ \ptrPtr -> mask_ $ do + zeroOutArray ptrPtr + withArray (fromIntegral <$> dims') $ \dimArray -> do + throwAFError =<< af_identity ptrPtr n dimArray typ + peek ptrPtr + Array <$> + newForeignPtr + af_release_array_finalizer + ptr + where + n = fromIntegral (length dims) + typ = afType (Proxy @ a) + +-- | Create a diagonal matrix from input array when extract is set to false +-- +-- >>> diagCreate (vector @Double 2 [1..]) 0 +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 0.0000 +-- 0.0000 2.0000 +diagCreate + :: AFType (a :: *) + => Array a + -- ^ is the input array which is the diagonal + -> Int + -- ^ is the diagonal index + -> Array a +diagCreate x (fromIntegral -> n) = + x `op1` (\p a -> af_diag_create p a n) + +-- | Create a diagonal matrix from input array when extract is set to false +-- +-- >>> diagExtract (matrix @Double (2,2) [[1,2],[3,4]]) 0 +-- ArrayFire Array +-- [2 1 1 1] +-- 1.0000 4.0000 +diagExtract + :: AFType (a :: *) + => Array a + -> Int + -> Array a +diagExtract x (fromIntegral -> n) = + x `op1` (\p a -> af_diag_extract p a n) + +-- | Join two Arrays together along a specified dimension +-- +-- >>> join 0 (matrix @Double (2,2) [[1,2],[3,4]]) (matrix @Double (2,2) [[5,6],[7,8]]) +-- ArrayFire Array +-- [4 2 1 1] +-- 1.0000 2.0000 5.0000 6.0000 +-- 3.0000 4.0000 7.0000 8.0000 +-- +join + :: Int + -> Array (a :: *) + -> Array a + -> Array a +join (fromIntegral -> n) arr1 arr2 = op2 arr1 arr2 (\p a b -> af_join p n a b) + +-- | Join many Arrays together along a specified dimension +-- +-- *FIX ME* +-- +-- >>> joinMany 0 [1,2,3] +-- ArrayFire Array +-- [3 1 1 1] +-- 1.0000 2.0000 3.0000 +-- +joinMany + :: Int + -> [Array a] + -> Array a +joinMany (fromIntegral -> n) arrays = unsafePerformIO . mask_ $ do + fptrs <- forM arrays $ \(Array fptr) -> pure fptr + newPtr <- + alloca $ \fPtrsPtr -> do + forM_ fptrs $ \fptr -> + withForeignPtr fptr (poke fPtrsPtr) + alloca $ \aPtr -> do + zeroOutArray aPtr + throwAFError =<< af_join_many aPtr n nArrays fPtrsPtr + peek aPtr + Array <$> + newForeignPtr af_release_array_finalizer newPtr + where + nArrays = fromIntegral (length arrays) + +-- | Tiles an Array according to specified dimensions +-- +-- >>> tile @Double (scalar 22.0) [5,5] +-- ArrayFire Array +-- [5 5 1 1] +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- +tile + :: Array (a :: *) + -> [Int] + -> Array a +tile a (take 4 . (++repeat 1) -> [x,y,z,w]) = + a `op1` (\p k -> af_tile p k (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w)) +tile _ _ = error "impossible" + +-- | Reorders an Array according to newly specified dimensions +-- +-- *FIX ME* +-- +-- >>> reorder @Double (scalar 22.0) [5,5] +-- ArrayFire Array +-- [5 5 1 1] +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- 22.0000 22.0000 22.0000 22.0000 22.0000 +-- +reorder + :: Array (a :: *) + -> [Int] + -> Array a +reorder a (take 4 . (++ repeat 0) -> [x,y,z,w]) = + a `op1` (\p k -> af_reorder p k (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w)) +reorder _ _ = error "impossible" + +-- | Shift elements in an Array along a specified dimension (elements will wrap). +-- +-- >>> shift (vector @Double 4 [1..]) 2 0 0 0 +-- ArrayFire Array +-- [4 1 1 1] +-- 3.0000 4.0000 1.0000 2.0000 +-- +shift + :: Array (a :: *) + -> Int + -> Int + -> Int + -> Int + -> Array a +shift a (fromIntegral -> x) (fromIntegral -> y) (fromIntegral -> z) (fromIntegral -> w) = + a `op1` (\p k -> af_shift p k x y z w) + +-- | Modify dimensions of array +-- +-- >>> moddims (vector @Double 3 [1..]) [1,3] +-- ArrayFire Array +-- [1 3 1 1] +-- 1.0000 +-- 2.0000 +-- 3.0000 +-- +moddims + :: forall a + . Array (a :: *) + -> [Int] + -> Array a +moddims (Array fptr) dims = + unsafePerformIO . mask_ . withForeignPtr fptr $ \ptr -> do + newPtr <- alloca $ \aPtr -> do + zeroOutArray aPtr + withArray (fromIntegral <$> dims) $ \dimsPtr -> do + throwAFError =<< af_moddims aPtr ptr n dimsPtr + peek aPtr + Array <$> newForeignPtr af_release_array_finalizer newPtr + where + n = fromIntegral (length dims) + +-- | Flatten an Array into a single dimension +-- +-- >>> flat (matrix @Double (2,2) [[1..],[1..]]) +-- ArrayFire Array +-- [4 1 1 1] +-- 1.0000 2.0000 1.0000 2.0000 +-- +-- >>> flat $ cube @Int (2,2,2) [[[1,1],[1,1]],[[1,1],[1,1]]] +-- ArrayFire Array +-- [8 1 1 1] +-- 1 1 1 1 1 1 1 1 +-- +flat + :: Array a + -> Array a +flat = (`op1` af_flat) + +-- | Flip the values of an Array along a specified dimension +-- +-- >>> matrix @Double (2,2) [[2,2],[3,3]] +-- ArrayFire Array +-- [2 2 1 1] +-- 2.0000 2.0000 +-- 3.0000 3.0000 +-- +-- >>> A.flip (matrix @Double (2,2) [[2,2],[3,3]]) 1 +-- ArrayFire Array +-- [2 2 1 1] +-- 3.0000 3.0000 +-- 2.0000 2.0000 +-- +flip + :: Array a + -> Int + -> Array a +flip a (fromIntegral -> dim) = + a `op1` (\p k -> af_flip p k dim) + +-- | Create a lower triangular matrix from input array. +-- +-- >>> lower (constant [2,2] 10 :: Array Double) True +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 10.0000 +-- 0.0000 1.0000 +-- +lower + :: Array a + -- ^ is the input matrix + -> Bool + -- ^ boolean parameter specifying if the diagonal elements should be 1 + -> Array a +lower a (fromIntegral . fromEnum -> b) = + a `op1` (\p k -> af_lower p k b) + +-- | Create an upper triangular matrix from input array. +-- +-- >>> upper (constant [2,2] 10 :: Array Double) True +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 0.0000 +-- 10.0000 1.0000 +-- +upper + :: Array a + -> Bool + -> Array a +upper a (fromIntegral . fromEnum -> b) = + a `op1` (\p k -> af_upper p k b) + +-- | Selects elements from two arrays based on the values of a binary conditional array. +-- +-- >>> cond = vector @CBool 5 [1,0,1,0,1] +-- >>> arr1 = vector @Double 5 (repeat 1) +-- >>> arr2 = vector @Double 5 (repeat 2) +-- >>> select cond arr1 arr2 +-- ArrayFire Array +-- [5 1 1 1] +-- 1.0000 2.0000 1.0000 2.0000 1.0000 +-- +select + :: Array CBool + -- ^ is the conditional array + -> Array a + -- ^ is the array containing elements from the true part of the condition + -> Array a + -- ^ is the array containing elements from the false part of the condition + -> Array a + -- ^ is the output containing elements of a when cond is true else elements from b +select a b c = op3 a b c af_select + +-- | Selects elements from two arrays based on the values of a binary conditional array. +-- +-- +-- +-- >>> cond = vector @CBool 5 [1,0,1,0,1] +-- >>> arr1 = vector @Double 5 (repeat 1) +-- >>> x = 99 +-- >>> selectScalarR cond x arr1 +-- ArrayFire Array +-- [5 1 1 1] +-- 1.0000 99.0000 1.0000 99.0000 1.0000 +-- +selectScalarR + :: Array CBool + -- ^ is the conditional array + -> Array a + -- ^ is the array containing elements from the true part of the condition + -> Double + -- ^ is a scalar assigned to out when cond is false + -> Array a + -- ^ the output containing elements of a when cond is true else elements from b +selectScalarR a b c = op2 a b (\p w x -> af_select_scalar_r p w x c) + +-- | Selects elements from two arrays based on the values of a binary conditional array. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__data__func__select.htm#ga0ccdc05779f88cab5095bce987c2da9d) +-- +-- >>> cond = vector @CBool 5 [1,0,1,0,1] +-- >>> arr1 = vector @Double 5 (repeat 1) +-- >>> x = 99 +-- >>> selectScalarL cond x arr1 +-- ArrayFire Array +-- [5 1 1 1] +-- 99.0000 1.0000 99.0000 1.0000 99.0000 +-- +selectScalarL + :: Array CBool + -- ^ the conditional array + -> Double + -- ^ a scalar assigned to out when cond is true + -> Array a + -- ^ the array containing elements from the false part of the condition + -> Array a + -- ^ is the output containing elements of a when cond is true else elements from b +selectScalarL a n b = op2 a b (\p w x -> af_select_scalar_l p w n x) + +-- af_err af_replace(af_array a, const af_array cond, const af_array b); +-- af_err af_replace_scalar(af_array a, const af_array cond, const double b); diff --git a/src/ArrayFire/Device.hs b/src/ArrayFire/Device.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Device.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Device +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Information about ArrayFire API and devices +-- +-- >>> info +-- ArrayFire v3.6.4 (OpenCL, 64-bit Mac OSX, build 1b8030c5) +-- [0] APPLE: AMD Radeon Pro 555X Compute Engine, 4096 MB +-- -1- APPLE: Intel(R) UHD Graphics 630, 1536 MB +-- +-------------------------------------------------------------------------------- +module ArrayFire.Device where + +import Foreign.C.String +import ArrayFire.Internal.Device +import ArrayFire.FFI + +-- | Retrieve info from ArrayFire API +-- +-- @ +-- ArrayFire v3.6.4 (OpenCL, 64-bit Mac OSX, build 1b8030c5) +-- [0] APPLE: AMD Radeon Pro 555X Compute Engine, 4096 MB +-- -1- APPLE: Intel(R) UHD Graphics 630, 1536 MB +-- @ +info :: IO () +info = afCall af_info + +-- | Calls /af_init/ C function from ArrayFire API +-- +-- >>> afInit +-- () +afInit :: IO () +afInit = afCall af_init + +-- | Retrieves ArrayFire device information as 'String', same as 'info'. +-- +-- >>> getInfoString +-- "ArrayFire v3.6.4 (OpenCL, 64-bit Mac OSX, build 1b8030c5)\n[0] APPLE: AMD Radeon Pro 555X Compute Engine, 4096 MB\n-1- APPLE: Intel(R) UHD Graphics 630, 1536 MB\n" +getInfoString :: IO String +getInfoString = peekCString =<< afCall1 (flip af_info_string 1) + +-- af_err af_device_info(char* d_name, char* d_platform, char *d_toolkit, char* d_compute); + +-- | Retrieves count of devices +-- +-- >>> getDeviceCount +-- 2 +getDeviceCount :: IO Int +getDeviceCount = fromIntegral <$> afCall1 af_get_device_count + +-- af_err af_get_dbl_support(bool* available, const int device); +-- | Sets a device by 'Int' +-- +-- >>> setDevice 0 +-- () +setDevice :: Int -> IO () +setDevice (fromIntegral -> x) = afCall (af_set_device x) + +-- | Retrieves device identifier +-- +-- >>> getDevice +-- 0 +getDevice :: IO Int +getDevice = fromIntegral <$> afCall1 af_get_device + +-- af_err af_sync(const int device); +-- af_err af_alloc_device(void **ptr, const dim_t bytes); +-- af_err af_free_device(void *ptr); +-- af_err af_alloc_pinned(void **ptr, const dim_t bytes); +-- af_err af_free_pinned(void *ptr); +-- af_err af_alloc_host(void **ptr, const dim_t bytes); +-- af_err af_free_host(void *ptr); +-- af_err af_device_array(af_array *arr, const void *data, const unsigned ndims, const dim_t * const dims, const af_dtype type); +-- af_err af_device_mem_info(size_t *alloc_bytes, size_t *alloc_buffers, size_t *lock_bytes, size_t *lock_buffers); +-- af_err af_print_mem_info(const char *msg, const int device_id); +-- af_err af_device_gc(); +-- af_err af_set_mem_step_size(const size_t step_bytes); +-- af_err af_get_mem_step_size(size_t *step_bytes); +-- af_err af_lock_device_ptr(const af_array arr); +-- af_err af_unlock_device_ptr(const af_array arr); +-- af_err af_lock_array(const af_array arr); +-- af_err af_is_locked_array(bool *res, const af_array arr); +-- af_err af_get_device_ptr(void **ptr, const af_array arr); diff --git a/src/ArrayFire/Exception.hs b/src/ArrayFire/Exception.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Exception.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Exception +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- @ +-- module Main where +-- +-- import ArrayFire +-- +-- main :: IO () +-- main = print =<< getAvailableBackends +-- @ +-- +-- @ +-- [nix-shell:~\/arrayfire]$ .\/main +-- [CPU,OpenCL] +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Exception where + +import Control.Exception hiding (TypeError) +import Data.Typeable +import Control.Monad +import Foreign.C.String +import Foreign.Ptr +import ArrayFire.Internal.Exception +import ArrayFire.Internal.Defines + +-- | String representation of ArrayFire exception +errorToString :: AFErr -> IO String +errorToString = peekCString <=< af_err_to_string + +-- | ArrayFire exception type +data AFExceptionType + = NoMemoryError + | DriverError + | RuntimeError + | InvalidArrayError + | ArgError + | SizeError + | TypeError + | DiffTypeError + | BatchError + | DeviceError + | NotSupportedError + | NotConfiguredError + | NonFreeError + | NoDblError + | NoGfxError + | LoadLibError + | LoadSymError + | BackendMismatchError + | InternalError + | UnknownError + | UnhandledError + deriving (Show, Eq, Typeable) + +-- | Exception type for ArrayFire API +data AFException + = AFException + { afExceptionType :: AFExceptionType + -- ^ The Exception type to throw + , afExceptionCode :: Int + -- ^ Code representing the exception + , afExceptionMsg :: String + -- ^ Exception message + } deriving (Show, Eq, Typeable) + +instance Exception AFException + +-- | Conversion function helper +toAFExceptionType :: AFErr -> AFExceptionType +toAFExceptionType (AFErr 101) = NoMemoryError +toAFExceptionType (AFErr 102) = DriverError +toAFExceptionType (AFErr 103) = RuntimeError +toAFExceptionType (AFErr 201) = InvalidArrayError +toAFExceptionType (AFErr 202) = ArgError +toAFExceptionType (AFErr 203) = SizeError +toAFExceptionType (AFErr 204) = TypeError +toAFExceptionType (AFErr 205) = DiffTypeError +toAFExceptionType (AFErr 207) = BatchError +toAFExceptionType (AFErr 208) = DeviceError +toAFExceptionType (AFErr 301) = NotSupportedError +toAFExceptionType (AFErr 302) = NotConfiguredError +toAFExceptionType (AFErr 303) = NonFreeError +toAFExceptionType (AFErr 401) = NoDblError +toAFExceptionType (AFErr 402) = NoGfxError +toAFExceptionType (AFErr 501) = LoadLibError +toAFExceptionType (AFErr 502) = LoadSymError +toAFExceptionType (AFErr 503) = BackendMismatchError +toAFExceptionType (AFErr 998) = InternalError +toAFExceptionType (AFErr 999) = UnknownError +toAFExceptionType (AFErr _) = UnhandledError + +-- | Throws an ArrayFire Exception +throwAFError :: AFErr -> IO () +throwAFError exitCode = + unless (exitCode == afSuccess) $ do + let AFErr (fromIntegral -> afExceptionCode) = exitCode + afExceptionType = toAFExceptionType exitCode + afExceptionMsg <- errorToString exitCode + throwIO AFException {..} + +foreign import ccall unsafe "&af_release_random_engine" + af_release_random_engine_finalizer :: FunPtr (AFRandomEngine -> IO ()) + +foreign import ccall unsafe "&af_destroy_window" + af_release_window_finalizer :: FunPtr (AFWindow -> IO ()) + +foreign import ccall unsafe "&af_release_array" + af_release_array_finalizer :: FunPtr (AFArray -> IO ()) diff --git a/src/ArrayFire/FFI.hs b/src/ArrayFire/FFI.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/FFI.hs @@ -0,0 +1,473 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.FFI +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-------------------------------------------------------------------------------- +module ArrayFire.FFI where + +import ArrayFire.Exception +import ArrayFire.Types +import ArrayFire.Internal.Defines +import ArrayFire.Internal.Features +import ArrayFire.Internal.Array +import ArrayFire.Internal.Types + +import Control.Exception +import Control.Monad +import Data.Int +import Foreign.ForeignPtr +import Foreign.Storable +import Foreign.Ptr +import Foreign.C +import Foreign.Marshal.Alloc +import System.IO.Unsafe + +op3 + :: Array b + -> Array a + -> Array a + -> (Ptr AFArray -> AFArray -> AFArray -> AFArray -> IO AFErr) + -> Array a +{-# NOINLINE op3 #-} +op3 (Array fptr1) (Array fptr2) (Array fptr3) op = + unsafePerformIO $ do + withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> do + withForeignPtr fptr3 $ \ptr3 -> do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 ptr2 ptr3 + peek ptrInput + fptr <- newForeignPtr af_release_array_finalizer ptr + pure (Array fptr) + +op3Int + :: Array a + -> Array Int32 + -> Array Int32 + -> (Ptr AFArray -> AFArray -> AFArray -> AFArray -> IO AFErr) + -> Array a +{-# NOINLINE op3Int #-} +op3Int (Array fptr1) (Array fptr2) (Array fptr3) op = + unsafePerformIO $ do + withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> do + withForeignPtr fptr3 $ \ptr3 -> do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 ptr2 ptr3 + peek ptrInput + fptr <- newForeignPtr af_release_array_finalizer ptr + pure (Array fptr) + +op2 + :: Array b + -> Array a + -> (Ptr AFArray -> AFArray -> AFArray -> IO AFErr) + -> Array a +{-# NOINLINE op2 #-} +op2 (Array fptr1) (Array fptr2) op = + unsafePerformIO $ do + withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 ptr2 + peek ptrInput + fptr <- newForeignPtr af_release_array_finalizer ptr + pure (Array fptr) + +op2p + :: Array a + -> (Ptr AFArray -> Ptr AFArray -> AFArray -> IO AFErr) + -> (Array a, Array a) +{-# NOINLINE op2p #-} +op2p (Array fptr1) op = + unsafePerformIO $ do + (x,y) <- withForeignPtr fptr1 $ \ptr1 -> do + alloca $ \ptrInput1 -> do + alloca $ \ptrInput2 -> do + throwAFError =<< op ptrInput1 ptrInput2 ptr1 + (,) <$> peek ptrInput1 <*> peek ptrInput2 + fptrA <- newForeignPtr af_release_array_finalizer x + fptrB <- newForeignPtr af_release_array_finalizer y + pure (Array fptrA, Array fptrB) + +op3p + :: Array a + -> (Ptr AFArray -> Ptr AFArray -> Ptr AFArray -> AFArray -> IO AFErr) + -> (Array a, Array a, Array a) +{-# NOINLINE op3p #-} +op3p (Array fptr1) op = + unsafePerformIO $ do + (x,y,z) <- withForeignPtr fptr1 $ \ptr1 -> do + alloca $ \ptrInput1 -> do + alloca $ \ptrInput2 -> do + alloca $ \ptrInput3 -> do + throwAFError =<< op ptrInput1 ptrInput2 ptrInput3 ptr1 + (,,) <$> peek ptrInput1 <*> peek ptrInput2 <*> peek ptrInput3 + fptrA <- newForeignPtr af_release_array_finalizer x + fptrB <- newForeignPtr af_release_array_finalizer y + fptrC <- newForeignPtr af_release_array_finalizer z + pure (Array fptrA, Array fptrB, Array fptrC) + +op3p1 + :: Storable b + => Array a + -> (Ptr AFArray -> Ptr AFArray -> Ptr AFArray -> Ptr b -> AFArray -> IO AFErr) + -> (Array a, Array a, Array a, b) +{-# NOINLINE op3p1 #-} +op3p1 (Array fptr1) op = + unsafePerformIO $ do + (x,y,z,g) <- withForeignPtr fptr1 $ \ptr1 -> do + alloca $ \ptrInput1 -> do + alloca $ \ptrInput2 -> do + alloca $ \ptrInput3 -> do + alloca $ \ptrInput4 -> do + throwAFError =<< op ptrInput1 ptrInput2 ptrInput3 ptrInput4 ptr1 + (,,,) <$> peek ptrInput1 + <*> peek ptrInput2 + <*> peek ptrInput3 + <*> peek ptrInput4 + fptrA <- newForeignPtr af_release_array_finalizer x + fptrB <- newForeignPtr af_release_array_finalizer y + fptrC <- newForeignPtr af_release_array_finalizer z + pure (Array fptrA, Array fptrB, Array fptrC, g) + +op2p2 + :: Array a + -> Array a + -> (Ptr AFArray -> Ptr AFArray -> AFArray -> AFArray -> IO AFErr) + -> (Array a, Array a) +{-# NOINLINE op2p2 #-} +op2p2 (Array fptr1) (Array fptr2) op = + unsafePerformIO $ do + (x,y) <- + withForeignPtr fptr1 $ \ptr1 -> do + withForeignPtr fptr2 $ \ptr2 -> do + alloca $ \ptrInput1 -> do + alloca $ \ptrInput2 -> do + throwAFError =<< op ptrInput1 ptrInput2 ptr1 ptr2 + (,) <$> peek ptrInput1 <*> peek ptrInput2 + fptrA <- newForeignPtr af_release_array_finalizer x + fptrB <- newForeignPtr af_release_array_finalizer y + pure (Array fptrA, Array fptrB) + +createArray' + :: (Ptr AFArray -> IO AFErr) + -> IO (Array a) +{-# NOINLINE createArray' #-} +createArray' op = + mask_ $ do + ptr <- + alloca $ \ptrInput -> do + zeroOutArray ptrInput + throwAFError =<< op ptrInput + peek ptrInput + fptr <- newForeignPtr af_release_array_finalizer ptr + pure (Array fptr) + +createArray + :: (Ptr AFArray -> IO AFErr) + -> Array a +{-# NOINLINE createArray #-} +createArray op = + unsafePerformIO . mask_ $ do + ptr <- + alloca $ \ptrInput -> do + zeroOutArray ptrInput + throwAFError =<< op ptrInput + peek ptrInput + fptr <- newForeignPtr af_release_array_finalizer ptr + pure (Array fptr) + +createWindow' + :: (Ptr AFWindow -> IO AFErr) + -> IO Window +createWindow' op = + mask_ $ do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput + peek ptrInput + fptr <- newForeignPtr af_release_window_finalizer ptr + pure (Window fptr) + +opw + :: Window + -> (AFWindow -> IO AFErr) + -> IO () +opw (Window fptr) op + = mask_ . withForeignPtr fptr $ (throwAFError <=< op) + +opw1 + :: Storable a + => Window + -> (Ptr a -> AFWindow -> IO AFErr) + -> IO a +{-# NOINLINE opw1 #-} +opw1 (Window fptr) op + = mask_ . withForeignPtr fptr $ \ptr -> do + alloca $ \p -> do + throwAFError =<< op p ptr + peek p + +op1 + :: Array a + -> (Ptr AFArray -> AFArray -> IO AFErr) + -> Array a +{-# NOINLINE op1 #-} +op1 (Array fptr1) op = + unsafePerformIO $ do + withForeignPtr fptr1 $ \ptr1 -> do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 + peek ptrInput + fptr <- newForeignPtr af_release_array_finalizer ptr + pure (Array fptr) + +op1f + :: Features + -> (Ptr AFFeatures -> AFFeatures -> IO AFErr) + -> Features +{-# NOINLINE op1f #-} +op1f (Features x) op = + unsafePerformIO . mask_ $ do + withForeignPtr x $ \ptr1 -> do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 + peek ptrInput + fptr <- newForeignPtr af_release_features ptr + pure (Features fptr) + +op1re + :: RandomEngine + -> (Ptr AFRandomEngine -> AFRandomEngine -> IO AFErr) + -> IO RandomEngine +op1re (RandomEngine x) op = mask_ $ + withForeignPtr x $ \ptr1 -> do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 + peek ptrInput + fptr <- newForeignPtr af_release_random_engine_finalizer ptr + pure (RandomEngine fptr) + +op1b + :: Storable b + => Array a + -> (Ptr AFArray -> Ptr b -> AFArray -> IO AFErr) + -> (b, Array a) +{-# NOINLINE op1b #-} +op1b (Array fptr1) op = + unsafePerformIO $ + withForeignPtr fptr1 $ \ptr1 -> do + (y,x) <- + alloca $ \ptrInput1 -> do + alloca $ \ptrInput2 -> do + throwAFError =<< op ptrInput1 ptrInput2 ptr1 + (,) <$> peek ptrInput1 <*> peek ptrInput2 + fptr <- newForeignPtr af_release_array_finalizer y + pure (x, Array fptr) + +afCall + :: IO AFErr + -> IO () +afCall = mask_ . (throwAFError =<<) + +loadAFImage + :: String + -> Bool + -> (Ptr AFArray -> CString -> CBool -> IO AFErr) + -> IO (Array a) +loadAFImage s (fromIntegral . fromEnum -> b) op = mask_ $ + withCString s $ \cstr -> do + p <- alloca $ \ptr -> do + throwAFError =<< op ptr cstr b + peek ptr + fptr <- newForeignPtr af_release_array_finalizer p + pure (Array fptr) + +loadAFImageNative + :: String + -> (Ptr AFArray -> CString -> IO AFErr) + -> IO (Array a) +loadAFImageNative s op = mask_ $ + withCString s $ \cstr -> do + p <- alloca $ \ptr -> do + throwAFError =<< op ptr cstr + peek ptr + fptr <- newForeignPtr af_release_array_finalizer p + pure (Array fptr) + +inPlace :: Array a -> (AFArray -> IO AFErr) -> IO () +inPlace (Array fptr) op = + mask_ . withForeignPtr fptr $ (throwAFError <=< op) + +inPlaceEng :: RandomEngine -> (AFRandomEngine -> IO AFErr) -> IO () +inPlaceEng (RandomEngine fptr) op = + mask_ . withForeignPtr fptr $ (throwAFError <=< op) + +afCall1 + :: Storable a + => (Ptr a -> IO AFErr) + -> IO a +afCall1 op = + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput + peek ptrInput + +afCall1' + :: Storable a + => (Ptr a -> IO AFErr) + -> a +{-# NOINLINE afCall1' #-} +afCall1' op = + unsafePerformIO . mask_ $ do + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput + peek ptrInput + +-- | Note: We don't add a finalizer to 'Array' since the 'Features' finalizer frees 'Array' +-- under the hood. +featuresToArray + :: Features + -> (Ptr AFArray -> AFFeatures -> IO AFErr) + -> Array a +{-# NOINLINE featuresToArray #-} +featuresToArray (Features fptr1) op = + unsafePerformIO . mask_ $ do + withForeignPtr fptr1 $ \ptr1 -> do + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 + alloca $ \retainedArray -> do + throwAFError =<< af_retain_array retainedArray =<< peek ptrInput + fptr <- newForeignPtr af_release_array_finalizer =<< peek retainedArray + pure (Array fptr) + +infoFromFeatures + :: Storable a + => Features + -> (Ptr a -> AFFeatures -> IO AFErr) + -> a +{-# NOINLINE infoFromFeatures #-} +infoFromFeatures (Features fptr1) op = + unsafePerformIO $ do + withForeignPtr fptr1 $ \ptr1 -> do + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 + peek ptrInput + +infoFromRandomEngine + :: Storable a + => RandomEngine + -> (Ptr a -> AFRandomEngine -> IO AFErr) + -> IO a +infoFromRandomEngine (RandomEngine fptr1) op = + mask_ $ do + withForeignPtr fptr1 $ \ptr1 -> do + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 + peek ptrInput + +afSaveImage + :: Array b + -> String + -> (CString -> AFArray -> IO AFErr) + -> IO () +afSaveImage (Array fptr1) str op = + withCString str $ \cstr -> + withForeignPtr fptr1 $ + throwAFError <=< op cstr + +infoFromArray + :: Storable a + => Array b + -> (Ptr a -> AFArray -> IO AFErr) + -> a +{-# NOINLINE infoFromArray #-} +infoFromArray (Array fptr1) op = + unsafePerformIO $ do + withForeignPtr fptr1 $ \ptr1 -> do + alloca $ \ptrInput -> do + throwAFError =<< op ptrInput ptr1 + peek ptrInput + +infoFromArray2 + :: (Storable a, Storable b) + => Array arr + -> (Ptr a -> Ptr b -> AFArray -> IO AFErr) + -> (a,b) +{-# NOINLINE infoFromArray2 #-} +infoFromArray2 (Array fptr1) op = + unsafePerformIO $ do + withForeignPtr fptr1 $ \ptr1 -> do + alloca $ \ptrInput1 -> do + alloca $ \ptrInput2 -> do + throwAFError =<< op ptrInput1 ptrInput2 ptr1 + (,) <$> peek ptrInput1 <*> peek ptrInput2 + +infoFromArray22 + :: (Storable a, Storable b) + => Array arr + -> Array arr + -> (Ptr a -> Ptr b -> AFArray -> AFArray -> IO AFErr) + -> (a,b) +{-# NOINLINE infoFromArray22 #-} +infoFromArray22 (Array fptr1) (Array fptr2) op = + unsafePerformIO $ do + withForeignPtr fptr1 $ \ptr1 -> do + withForeignPtr fptr2 $ \ptr2 -> do + alloca $ \ptrInput1 -> do + alloca $ \ptrInput2 -> do + throwAFError =<< op ptrInput1 ptrInput2 ptr1 ptr2 + (,) <$> peek ptrInput1 <*> peek ptrInput2 + +infoFromArray3 + :: (Storable a, Storable b, Storable c) + => Array arr + -> (Ptr a -> Ptr b -> Ptr c -> AFArray -> IO AFErr) + -> (a,b,c) +{-# NOINLINE infoFromArray3 #-} +infoFromArray3 (Array fptr1) op = + unsafePerformIO $ + withForeignPtr fptr1 $ \ptr1 -> do + alloca $ \ptrInput1 -> do + alloca $ \ptrInput2 -> do + alloca $ \ptrInput3 -> do + throwAFError =<< op ptrInput1 ptrInput2 ptrInput3 ptr1 + (,,) <$> peek ptrInput1 + <*> peek ptrInput2 + <*> peek ptrInput3 + +infoFromArray4 + :: (Storable a, Storable b, Storable c, Storable d) + => Array arr + -> (Ptr a -> Ptr b -> Ptr c -> Ptr d -> AFArray -> IO AFErr) + -> (a,b,c,d) +{-# NOINLINE infoFromArray4 #-} +infoFromArray4 (Array fptr1) op = + unsafePerformIO $ + withForeignPtr fptr1 $ \ptr1 -> + alloca $ \ptrInput1 -> + alloca $ \ptrInput2 -> + alloca $ \ptrInput3 -> + alloca $ \ptrInput4 -> do + throwAFError =<< op ptrInput1 ptrInput2 ptrInput3 ptrInput4 ptr1 + (,,,) <$> peek ptrInput1 + <*> peek ptrInput2 + <*> peek ptrInput3 + <*> peek ptrInput4 + +foreign import ccall unsafe "zeroOutArray" + zeroOutArray :: Ptr AFArray -> IO () diff --git a/src/ArrayFire/Features.hs b/src/ArrayFire/Features.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Features.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Features +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-------------------------------------------------------------------------------- +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 (createFeatures 10) +-- +createFeatures + :: Int + -> Features +createFeatures (fromIntegral -> n) = + unsafePerformIO $ do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< ptrInput `af_create_features` n + peek ptrInput + fptr <- newForeignPtr af_release_features ptr + pure (Features fptr) + +-- | Retain Features +-- +-- >>> features = retainFeatures (createFeatures 10) +-- +retainFeatures + :: Features + -> Features +retainFeatures = (`op1f` af_retain_features) + +-- | Get number of Features +-- +-- link +-- +-- >>> getFeaturesNum (createFeatures 10) +-- 10 +-- +getFeaturesNum + :: Features + -> Int +getFeaturesNum = fromIntegral . (`infoFromFeatures` af_get_features_num) + +-- | Get Feature X-position +-- +-- >>> getFeaturesXPos (createFeatures 10) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 0.0000 0.0000 0.0000 0.0000 2.1250 0.0000 2.2500 0.0000 0.0000 +-- +getFeaturesXPos + :: Features + -> Array a +getFeaturesXPos = (`featuresToArray` af_get_features_xpos) + +-- | Get Feature Y-position +-- +-- >>> getFeaturesYPos (createFeatures 10) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 +-- +getFeaturesYPos + :: Features + -> Array a +getFeaturesYPos = (`featuresToArray` af_get_features_ypos) + +-- | Get Feature Score +-- +-- >>> getFeaturesScore (createFeatures 10) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 1.8750 0.0000 2.0000 0.0000 2.1250 0.0000 2.2500 nan nan +-- +getFeaturesScore + :: Features + -> Array a +getFeaturesScore = (`featuresToArray` af_get_features_score) + +-- | Get Feature orientation +-- +-- >>> getFeaturesOrientation (createFeatures 10) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 1.8750 0.0000 2.0000 0.0000 2.1250 0.0000 2.2500 0.0000 0.0000 +-- +getFeaturesOrientation + :: Features + -> Array a +getFeaturesOrientation = (`featuresToArray` 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 = (`featuresToArray` af_get_features_size) diff --git a/src/ArrayFire/Graphics.hs b/src/ArrayFire/Graphics.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Graphics.hs @@ -0,0 +1,689 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Graphics +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-------------------------------------------------------------------------------- +module ArrayFire.Graphics where + +import Control.Exception +import Foreign.Marshal +import Foreign.Storable +import Foreign.ForeignPtr +import Foreign.C.String + +import ArrayFire.Internal.Graphics +import ArrayFire.Exception +import ArrayFire.FFI +import ArrayFire.Internal.Types + +-- | Create window +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm) +-- +-- >>> window <- createWindow 800 600 "New Chart" +-- +createWindow + :: Int + -- ^ width + -> Int + -- ^ height + -> String + -- ^ title + -> IO Window + -- ^ 'Window' handle +createWindow (fromIntegral -> x) (fromIntegral -> y) str = + withCString str $ \cstr -> + createWindow' (\p -> af_create_window p x y cstr) + +-- | Sets 'Window' position +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm) +-- +-- >>> window <- createWindow 800 600 "New Chart" +-- >>> setPosition window 800 600 +-- +setPosition + :: Window + -- ^ 'Window' handle + -> Int + -- ^ Horizontal start coordinate + -> Int + -- ^ Vertical start coordinate + -> IO () +setPosition w (fromIntegral -> x) (fromIntegral -> y) = + w `opw` (\p -> af_set_position p x y) + +-- | Sets 'Window' title +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm) +-- +-- >>> window <- createWindow 800 600 "New Chart" +-- >>> setTitle window "window title" +-- +setTitle + :: Window + -- ^ 'Window' handle + -> String + -- ^ title + -> IO () +setTitle w str = withCString str $ \cstr -> + w `opw` (\p -> af_set_title p cstr) + +-- | Sets 'Window' size +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm) +-- +-- >>> window <- createWindow 800 600 "New Chart" +-- >>> setSize window 800 600 +-- +setSize + :: Window + -- ^ 'Window' handle + -> Int + -- ^ target width of the window + -> Int + -- ^ target height of the window + -> IO () +setSize w (fromIntegral -> x) (fromIntegral -> y) = + w `opw` (\p -> af_set_size p x y) + +-- | Draw an image onto a Window +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm) +-- +-- >>> drawImage window ('constant' \@'Int' 1) ('Cell' 10 10 "test" 'ColorMapSpectrum') +-- +drawImage + :: Window + -- ^ 'Window' handle + -> Array a + -- ^ Image + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +drawImage (Window wfptr) (Array fptr) cell = + mask_ $ withForeignPtr fptr $ \aptr -> + withForeignPtr wfptr $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_image wptr aptr cellPtr + free cellPtr + +-- | Draw a plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm) +-- +-- >>> drawPlot window ('constant' \@'Int' 1) ('constant' \@'Int' 1) ('Cell' 10 10 "test" 'ColorMapSpectrum') +-- +-- *Note* X and Y should be vectors. +-- +drawPlot + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an 'Array' with the x-axis data points + -> Array a + -- ^ is an 'Array' with the y-axis data points + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +drawPlot (Window w) (Array fptr1) (Array fptr2) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_plot wptr ptr1 ptr2 cellPtr + free cellPtr + +-- | Draw a plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm) +-- +-- *Note* P should be a 3n x 1 vector or one of a 3xn or nx3 matrices. +-- +drawPlot3 + :: Window + -- ^ the window handle + -> Array a + -- ^ is an af_array or matrix with the xyz-values of the points + -> Cell + -- ^ is structure af_cell that has the properties that are used for the current rendering. + -> IO () +drawPlot3 (Window w) (Array fptr) cell = + mask_ $ withForeignPtr fptr $ \aptr -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_plot3 wptr aptr cellPtr + free cellPtr + +-- | Draw a plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm) +-- +-- *Note* in must be 2d and of the form [n, order], where order is either 2 or 3. If order is 2, then chart is 2D and if order is 3, then chart is 3D. +-- +drawPlotNd + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an 'Array' or matrix with the xyz-values of the points + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +drawPlotNd (Window w) (Array fptr) cell = + mask_ $ withForeignPtr fptr $ \aptr -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_plot_nd wptr aptr cellPtr + free cellPtr + +-- | Draw a plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm) +-- +-- *Note* X and Y should be vectors. +-- +drawPlot2d + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an 'Array' with the x-axis data points + -> Array a + -- ^ is an 'Array' with the y-axis data points + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +drawPlot2d (Window w) (Array fptr1) (Array fptr2) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_plot_2d wptr ptr1 ptr2 cellPtr + free cellPtr + +-- | Draw a 3D plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm) +-- +-- *Note* X, Y and Z should be vectors. +-- +drawPlot3d + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an 'Array' with the x-axis data points + -> Array a + -- ^ is an 'Array' with the y-axis data points + -> Array a + -- ^ is an 'Array' with the z-axis data points + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +drawPlot3d (Window w) (Array fptr1) (Array fptr2) (Array fptr3) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr fptr3 $ \ptr3 -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_plot_3d wptr ptr1 ptr2 ptr3 cellPtr + free cellPtr + +-- | Draw a scatter plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm) +-- +-- *Note* X and Y should be vectors. +-- +drawScatter + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an 'Array' with the x-axis data points + -> Array a + -- ^ is an 'Array' with the y-axis data points + -> MarkerType + -- ^ enum specifying which marker to use in the scatter plot + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +drawScatter (Window w) (Array fptr1) (Array fptr2) (fromMarkerType -> m) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_scatter wptr ptr1 ptr2 m cellPtr + free cellPtr + +-- | Draw a scatter plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga764410fbdf0cd60c7044c77e36fb2577) +-- +-- *Note* X and Y should be vectors. +-- +drawScatter3 + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an af_array or matrix with the xyz-values of the points + -> MarkerType + -- ^ is an af_marker_type enum specifying which marker to use in the scatter plot + -> Cell + -- ^ is structure af_cell that has the properties that are used for the current rendering. + -> IO () +drawScatter3 (Window w) (Array fptr1) (fromMarkerType -> m) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_scatter3 wptr ptr1 m cellPtr + free cellPtr + +-- | Draw a scatter plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga9991b93681e0c18693a5464458781d22) +-- +-- *Note* in must be 2d and of the form [n, order], where order is either 2 or 3. If order is 2, then chart is 2D and if order is 3, then chart is 3D. +-- +drawScatterNd + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an 'Array' or matrix with the xyz-values of the points + -> MarkerType + -- ^ is an af_marker_type enum specifying which marker to use in the scatter plot + -> Cell + -- ^ is structure af_cell that has the properties that are used for the current rendering. + -> IO () +drawScatterNd (Window w) (Array fptr1) (fromMarkerType -> m) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_scatter_nd wptr ptr1 m cellPtr + free cellPtr + +-- | Draw a scatter plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga79417722c69883e7a91282b138288010) +-- +-- *Note* in must be 2d and of the form [n, order], where order is either 2 or 3. If order is 2, then chart is 2D and if order is 3, then chart is 3D. +-- +drawScatter2d + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an af_array with the x-axis data points + -> Array a + -- ^ is an af_array with the y-axis data points + -> MarkerType + -- ^ is an af_marker_type enum specifying which marker to use in the scatter plot + -> Cell + -- ^ is structure af_cell that has the properties that are used for the current rendering. + -> IO () +drawScatter2d (Window w) (Array fptr1) (Array fptr2) (fromMarkerType -> m) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr w $ \wptr -> + withForeignPtr fptr2 $ \ptr2 -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_scatter_2d wptr ptr1 ptr2 m cellPtr + free cellPtr + +-- | Draw a scatter plot onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga2b3d0dd690ebcba4c4dbb09cdcaed304) +-- +-- *Note* X, Y and Z should be vectors. +-- +drawScatter3d + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an af_array with the x-axis data points + -> Array a + -- ^ is an af_array with the y-axis data points + -> Array a + -- ^ is an af_array with the z-axis data points + -> MarkerType + -- ^ is an af_marker_type enum specifying which marker to use in the scatter plot + -> Cell + -- ^ is structure af_cell that has the properties that are used for the current rendering. + -> IO () +drawScatter3d (Window w) (Array fptr1) (Array fptr2) (Array fptr3) (fromMarkerType -> m) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr w $ \wptr -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr fptr3 $ \ptr3 -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_scatter_3d wptr ptr1 ptr2 ptr3 m cellPtr + free cellPtr + +-- | Draw a Histogram onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#gaf1648ee35739c86116bfa9c22644dbd7) +-- +-- *Note* X should be a vector. +-- +drawHistogram + :: Window + -- ^ is the window handle + -> Array a + -- ^ is the data frequency af_array + -> Double + -- ^ is the value of the minimum data point of the array whose histogram(X) is going to be rendered. + -> Double + -- ^ is the value of the maximum data point of the array whose histogram(X) is going to be rendered. + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +drawHistogram (Window w) (Array fptr1) minval maxval cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_hist wptr ptr1 minval maxval cellPtr + +-- | Draw a Surface onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#gaaee14e457272b2cd1bd4ed1228370229) +-- +-- *Note* X and Y should be vectors. S should be a 2D array +-- +drawSurface + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an af_array with the x-axis data points + -> Array a + -- ^ is an af_array with the y-axis data points + -> Array a + -- ^ is an af_array with the z-axis data points + -> Cell + -- ^ is structure af_cell that has the properties that are used for the current rendering. + -> IO () +drawSurface (Window w) (Array fptr1) (Array fptr2) (Array fptr3) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr w $ \wptr -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr fptr3 $ \ptr3 -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_surface wptr ptr1 ptr2 ptr3 cellPtr + free cellPtr + +-- | Draw a Vector Field onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga2d31a148578d749be4224e7119b386bc) +-- +-- *Note* all the 'Array' inputs should be vectors and the same size +-- +drawVectorFieldND + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an 'Array' with the points + -> Array a + -- ^ is an 'Array' with the directions + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +drawVectorFieldND (Window w) (Array fptr1) (Array fptr2) cell = + mask_ $ withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_vector_field_nd wptr ptr1 ptr2 cellPtr + free cellPtr + +-- | Draw a Vector Field onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#gaf2d3be32c1b6a9034a3bb851206b4b5a) +-- +-- *Note* all the 'Array' inputs should be vectors and the same size +-- +drawVectorField3d + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an 'Array' with the x-axis points + -> Array a + -- ^ is an 'Array' with the y-axis points + -> Array a + -- ^ is an 'Array' with the z-axis points + -> Array a + -- ^ is an 'Array' with the x-axis directions + -> Array a + -- ^ is an 'Array' with the y-axis directions + -> Array a + -- ^ is an 'Array' with the z-axis directions + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +drawVectorField3d (Window w) (Array fptr1) (Array fptr2) (Array fptr3) + (Array fptr4) (Array fptr5) (Array fptr6) cell = + mask_ $ do + withForeignPtr w $ \wptr -> + withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr fptr3 $ \ptr3 -> + withForeignPtr fptr4 $ \ptr4 -> + withForeignPtr fptr5 $ \ptr5 -> + withForeignPtr fptr6 $ \ptr6 -> do + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_vector_field_3d wptr ptr1 ptr2 ptr3 ptr4 ptr5 ptr6 cellPtr + free cellPtr + +-- | Draw a Vector Field onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#gaa1a667e4d29ab089629acd5296f29a7b) +-- +-- *Note* all the 'Array' inputs should be vectors and the same size +-- +drawVectorField2d + :: Window + -- ^ is the window handle + -> Array a + -- ^ is an 'Array' with the x-axis points + -> Array a + -- ^ is the window handle + -> Array a + -- ^ is the window handle + -> Array a + -- ^ is the window handle + -> Cell + -- ^ is the window handle + -> IO () +drawVectorField2d (Window w) (Array fptr1) (Array fptr2) (Array fptr3) (Array fptr4) cell = + mask_ $ do + withForeignPtr w $ \wptr -> + withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr fptr3 $ \ptr3 -> + withForeignPtr fptr4 $ \ptr4 -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_draw_vector_field_2d wptr ptr1 ptr2 ptr3 ptr4 cellPtr + free cellPtr + +-- | Draw a grid onto a 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#ga37fc7eb00ae11c25e1a60d341663d68d) +-- +-- *Note* all the 'Array' inputs should be vectors and the same size +-- +grid + :: Window + -- ^ is the window handle + -> Int + -- ^ is number of rows you want to show in a window + -> Int + -- ^ is number of coloumns you want to show in a window + -> IO () +grid (Window w) (fromIntegral -> rows) (fromIntegral -> cols) = + mask_ . withForeignPtr w $ \wptr -> + throwAFError =<< af_grid wptr rows cols + +-- | Setting axes limits for a histogram/plot/surface/vector field. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#ga62d2cad30e3aad06c24999fe5ac34598) +-- +-- *Note* Set to NULL if the chart is 2D. +-- +setAxesLimitsCompute + :: Window + -- ^ is the window handle + -> Array a + -- ^ the data to compute the limits for x-axis. + -> Array a + -- ^ the data to compute the limits for y-axis. + -> Array a + -- ^ the data to compute the limits for z-axis. + -> Bool + -- ^ is for using the exact min/max values from x, y and z. If exact is false then the most significant digit is rounded up to next power of 2 and the magnitude remains the same. + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +setAxesLimitsCompute (Window w) (Array fptr1) (Array fptr2) (Array fptr3) (fromIntegral . fromEnum -> exact) cell = + mask_ $ do + withForeignPtr w $ \wptr -> + withForeignPtr fptr1 $ \ptr1 -> + withForeignPtr fptr2 $ \ptr2 -> + withForeignPtr fptr3 $ \ptr3 -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_set_axes_limits_compute wptr ptr1 ptr2 ptr3 exact cellPtr + free cellPtr + +-- | Setting axes limits for a 2D histogram/plot/surface/vector field. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#gadadc41caf7d6a9b7ca2e674079971895) +-- +setAxesLimits2d + :: Window + -- ^ is the window handle + -> Float + -- ^ is the minimum on x-axis + -> Float + -- ^ is the maximum on x-axis + -> Float + -- ^ is the minimum on y-axis + -> Float + -- ^ is the maximum on y-axis + -> Bool + -- ^ is for using the exact min/max values from x, and y. If exact is false then the most significant digit is rounded up to next power of 2 and the magnitude remains the same. + -> Cell + -- ^ is structure af_cell that has the properties that are used for the current rendering. + -> IO () +setAxesLimits2d (Window w) xmin xmax ymin ymax (fromIntegral . fromEnum -> exact) cell = + mask_ $ do + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_set_axes_limits_2d wptr xmin xmax ymin ymax exact cellPtr + free cellPtr + +-- | Setting axes limits for a 3D histogram/plot/surface/vector field. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#gadcd1bd46b9d6fabc047365ca5dc3f73d) +-- +setAxesLimits3d + :: Window + -- ^ is the window handle + -> Float + -- ^ is the minimum on x-axis + -> Float + -- ^ is the maximum on x-axis + -> Float + -- ^ is the minimum on y-axis + -> Float + -- ^ is the maximum on y-axis + -> Float + -- ^ is the minimum on z-axis + -> Float + -- ^ is the maximum on z-axis + -> Bool + -- ^ is for using the exact min/max values from x, y and z. If exact is false then the most significant digit is rounded up to next power of 2 and the magnitude remains the same. + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +setAxesLimits3d (Window w) xmin xmax ymin ymax zmin zmax (fromIntegral . fromEnum -> exact) cell = + mask_ $ do + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_set_axes_limits_3d wptr xmin xmax ymin ymax zmin zmax exact cellPtr + free cellPtr + + +-- | Setting axes titles +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#gadcd1bd46b9d6fabc047365ca5dc3f73d) +-- +setAxesTitles + :: Window + -- ^ is the window handle + -> String + -- ^ is the name of the x-axis + -> String + -- ^ is the name of the y-axis + -> String + -- ^ is the name of the z-axis + -> Cell + -- ^ is structure 'Cell' that has the properties that are used for the current rendering. + -> IO () +setAxesTitles (Window w) x y z cell = + mask_ $ do + withForeignPtr w $ \wptr -> + alloca $ \cellPtr -> do + withCString x $ \xstr -> + withCString y $ \ystr -> + withCString z $ \zstr -> do + poke cellPtr =<< cellToAFCell cell + throwAFError =<< af_set_axes_titles wptr xstr ystr zstr cellPtr + free cellPtr + +-- | Displays 'Window' +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#ga50dae861324dca1cce9f583256f5a654) +-- +showWindow + :: Window + -- ^ 'Window' handle + -> IO () +showWindow = (`opw` af_show) + +-- | Checks if 'Window' is closed +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#ga50dae861324dca1cce9f583256f5a654) +-- +isWindowClosed :: Window -> IO Bool +isWindowClosed w = + toEnum . fromIntegral + <$> (w `opw1` af_is_window_closed) + +-- | Sets 'Window' visibility +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#gad7b63c70d45e101c4d8d500273e310c7) +-- +setVisibility + :: Window + -- ^ 'Window' handle + -> Bool + -- ^ Set to 'True' to display 'Window' + -> IO () +setVisibility w (fromIntegral . fromEnum -> b) = w `opw` (`af_set_visibility` b) diff --git a/src/ArrayFire/Image.hs b/src/ArrayFire/Image.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Image.hs @@ -0,0 +1,756 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Image +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-------------------------------------------------------------------------------- +module ArrayFire.Image where + +import Data.Proxy +import Data.Word + +import ArrayFire.Internal.Types +import ArrayFire.Internal.Image +import ArrayFire.FFI +import ArrayFire.Arith + +-- | Calculates the gradient of an image +-- +-- @ +-- >>> print (gradient image) +-- @ +gradient :: Array a -> (Array a, Array a) +gradient a = a `op2p` af_gradient + +-- | Loads an image from disk +-- +-- @ +-- >>> image <- loadImage "image.png" True +-- @ +loadImage + :: String + -- ^ File path + -> Bool + -- ^ Is color image (boolean denoting if the image should be loaded as 1 channel or 3 channel) + -> IO (Array a) +loadImage s b = loadAFImage s b af_load_image + +-- | Saves an image to disk +-- +-- @ +-- >>> saveImage image "image.png" +-- @ +saveImage :: Array a -> String -> IO () +saveImage a s = afSaveImage a s af_save_image + +-- af_err af_load_image_memory(af_array *out, const void* ptr); +-- af_err af_save_image_memory(void** ptr, const af_array in, const af_image_format format); +-- af_err af_delete_image_memory(void* ptr); + +-- | Loads an image natively +-- +-- @ +-- >>> image <- loadImageNative "image.png" +-- @ +loadImageNative :: String -> IO (Array a) +loadImageNative s = loadAFImageNative s af_load_image_native + +-- | Saves an image natively +-- +-- @ +-- >>> saveImageNative image "image.png" +-- @ +saveImageNative :: Array a -> String -> IO () +saveImageNative a s = afSaveImage a s af_save_image_native + +-- | Returns true if ArrayFire was compiled with ImageIO (FreeImage) support +-- +-- @ +-- >>> print =<< isImageIOAvailable +-- @ +isImageIOAvailable :: IO Bool +isImageIOAvailable = + toEnum . fromIntegral <$> afCall1 af_is_image_io_available + +-- | Resize an input image. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__transform__func__resize.htm) +-- +-- Resizing an input image can be done using either AF_INTERP_NEAREST, AF_INTERP_BILINEAR or AF_INTERP_LOWER, interpolations. Nearest interpolation will pick the nearest value to the location, bilinear interpolation will do a weighted interpolation for calculate the new size and lower interpolation is similar to the nearest, except it will use the floor function to get the lower neighbor. +-- +resize + :: Array a + -- ^ input image + -> Int + -- ^ is the size for the first output dimension + -> Int + -- ^ is the size for the second output dimension + -> InterpType + -- ^ is the interpolation type (Nearest by default) + -> Array a + -- ^ will contain the resized image of specified by odim0 and odim1 +resize a (fromIntegral -> d0) (fromIntegral -> d1) (fromInterpType -> interp) = + a `op1` (\ptr x -> af_resize ptr x d0 d1 interp) + +-- | Transform an input image. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__transform__func__transform.htm) +-- +-- The transform function uses an affine or perspective transform matrix to tranform an input image into a new one. +-- +transform + :: Array a + -- ^ is input image + -> Array a + -- ^ is transformation matrix + -> Int + -- ^ is the first output dimension + -> Int + -- ^ is the second output dimension + -> InterpType + -- ^ is the interpolation type (Nearest by default) + -> Bool + -- ^ if true applies inverse transform, if false applies forward transoform + -> Array a + -- ^ will contain the transformed image +transform inp trans (fromIntegral -> d0) (fromIntegral -> d1) (fromInterpType -> interp) (fromIntegral . fromEnum -> inverse) = + op2 inp trans (\ptr a1 a2 -> af_transform ptr a1 a2 d0 d1 interp inverse) + +-- | Transform input coordinates. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__transform__func__coordinates.htm) +-- +-- C Interface for transforming an image C++ Interface for transforming coordinates. +-- +transformCoordinates + :: Array a + -- ^ is transformation matrix + -> Float + -- ^ is the first input dimension + -> Float + -- ^ is the second input dimension + -> Array a + -- ^ the transformed coordinates +transformCoordinates a d0 d1 = + a `op1` (\ptr x -> af_transform_coordinates ptr x d0 d1) + +-- | Rotate an input image. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__transform__func__rotate.htm) +-- +-- Rotating an input image can be done using AF_INTERP_NEAREST, AF_INTERP_BILINEAR or AF_INTERP_LOWER interpolations. Nearest interpolation will pick the nearest value to the location, whereas bilinear interpolation will do a weighted interpolation for calculate the new size. +-- +rotate + :: Array a + -- ^ is input image + -> Float + -- ^ is the degree (in radians) by which the input is rotated + -> Bool + -- ^ if true the output is cropped original dimensions. If false the output dimensions scale based on theta + -> InterpType + -- ^ is the interpolation type (Nearest by default) + -> Array a + -- ^ will contain the image in rotated by theta +rotate a theta (fromIntegral . fromEnum -> crop) (fromInterpType -> interp) = + a `op1` (\ptr x -> af_rotate ptr x theta crop interp) + +-- | Translate an input image. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__transform__func__translate.htm) +-- +-- Translating an image is moving it along 1st and 2nd dimensions by trans0 and trans1. Positive values of these will move the data towards negative x and negative y whereas negative values of these will move the positive right and positive down. See the example below for more. +-- +translate + :: Array a + -- ^ is input image + -> Float + -- ^ is amount by which the first dimension is translated + -> Float + -- ^ is amount by which the second dimension is translated + -> Int + -- ^ is the first output dimension + -> Int + -- ^ is the second output dimension + -> InterpType + -- ^ is the interpolation type (Nearest by default) + -> Array a + -- ^ will contain the translated image +translate a trans0 trans1 (fromIntegral -> odim0) (fromIntegral -> odim1) (fromInterpType -> interp) = + a `op1` (\ptr x -> af_translate ptr x trans0 trans1 odim0 odim1 interp) + +-- | Scale an input image. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__transform__func__scale.htm) +-- +-- Scale is the same functionality as af::resize except that the scale function uses the transform kernels. The other difference is that scale does not set boundary values to be the boundary of the input array. Instead these are set to 0. +-- +scale + :: Array a + -- ^ is input image + -> Float + -- ^ is amount by which the first dimension is scaled + -> Float + -- ^ is amount by which the second dimension is scaled + -> Int + -- ^ is the first output dimension + -> Int + -- ^ is the second output dimension + -> InterpType + -- ^ is the interpolation type (Nearest by default) + -> Array a + -- ^ will contain the scaled image +scale a trans0 trans1 (fromIntegral -> odim0) (fromIntegral -> odim1) (fromInterpType -> interp) = + a `op1` (\ptr x -> af_scale ptr x trans0 trans1 odim0 odim1 interp) + +-- | Skew an input image. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__transform__func__skew.htm) +-- +-- Skew function skews the input array along dim0 by skew0 and along dim1 by skew1. The skew areguments are in radians. Skewing the data means the data remains parallel along 1 dimensions but the other dimensions gets moved along based on the angle. If both skew0 and skew1 are specified, then the data will be skewed along both directions. +-- +skew + :: Array a + -- ^ is input image + -> Float + -- ^ is amount by which the first dimension is skewed + -> Float + -- ^ is amount by which the second dimension is skewed + -> Int + -- ^ is the first output dimension + -> Int + -- ^ is the second output dimension + -> InterpType + -- ^ if true applies inverse transform, if false applies forward transoform + -> Bool + -- ^ is the interpolation type (Nearest by default) + -> Array a + -- ^ will contain the skewed image +skew a trans0 trans1 (fromIntegral -> odim0) (fromIntegral -> odim1) (fromInterpType -> interp) (fromIntegral . fromEnum -> b) = + a `op1` (\ptr x -> af_skew ptr x trans0 trans1 odim0 odim1 interp b) + +-- | Histogram of input data. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__histogram.htm) +-- +-- A histogram is a representation of the distribution of given data. This representation is essentially a graph consisting of the data range or domain on one axis and frequency of occurence on the other axis. All the data in the domain is counted in the appropriate bin. The total number of elements belonging to each bin is known as the bin's frequency. +-- +histogram + :: AFType a + => Array a + -- ^ the input array + -> Int + -- ^ Number of bins to populate between min and max + -> Double + -- ^ minimum bin value (accumulates -inf to min) + -> Double + -- ^ minimum bin value (accumulates max to +inf) + -> Array Word32 + -- ^ (type u32) is the histogram for input array in +histogram a (fromIntegral -> b) c d = + cast (a `op1` (\ptr x -> af_histogram ptr x b c d)) + +-- | Dilation(morphological operator) for images. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__dilate.htm) +-- +-- The dilation function takes two pieces of data as inputs. The first is the input image to be morphed, and the second is the mask indicating the neighborhood around each pixel to match. +-- +-- *Note* if mask is all ones, this function behaves like max filter +-- +dilate + :: Array a + -- ^ the input image + -> Array a + -- ^ the neighborhood window + -> Array a + -- ^ the dilated image +dilate in' mask = op2 in' mask af_dilate + +-- | Dilation (morphological operator) for volumes. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__dilate3d.htm) +-- +-- Dilation for a volume is similar to the way dilation works on an image. Only difference is that the masking operation is performed on a volume instead of a rectangular region. +-- +dilate3 + :: Array a + -- ^ the input volume + -> Array a + -- ^ the neighborhood delta volume + -> Array a + -- ^ the dilated volume +dilate3 in' mask = op2 in' mask af_dilate3 + +-- | Erosion (morphological operator) for volumes. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__erode.htm) +-- +-- The erosion function is a morphological transformation on an image that requires two inputs. The first is the image to be morphed, and the second is the mask indicating neighborhood that must be white in order to preserve each pixel. +-- +-- *Note* if mask is all ones, this function behaves like min filter +-- +erode + :: Array a + -- ^ 'Array' is the input image + -> Array a + -- ^ (mask) is the neighborhood window + -> Array a + -- ^ 'Array' is the eroded image +erode in' mask = op2 in' mask af_erode + +-- | Erosion (morphological operator) for volumes. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__erode3d.htm) +-- +-- Erosion for a volume is similar to the way erosion works on an image. Only difference is that the masking operation is performed on a volume instead of a rectangular region. +-- +erode3 + :: Array a + -- ^ 'Array' is the input volume + -> Array a + -- ^ (mask) is the neighborhood delta volume + -> Array a + -- ^ 'Array' is the eroded volume +erode3 in' mask = op2 in' mask af_erode3 + +-- | Bilateral Filter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__bilateral.htm) +-- +-- A bilateral filter is a edge-preserving filter that reduces noise in an image. The intensity of each pixel is replaced by a weighted average of the intensities of nearby pixels. The weights follow a Gaussian distribution and depend on the distance as well as the color distance. +-- +bilateral + :: Array a + -- ^ 'Array' is the input image + -> Float + -- ^ is the spatial variance parameter that decides the filter window + -> Float + -- ^ is the chromatic variance parameter + -> Bool + -- ^ indicates if the input in is color image or grayscale + -> Array a + -- ^ 'Array' is the processed image +bilateral in' a b (fromIntegral . fromEnum -> c) = in' `op1` (\ptr k -> af_bilateral ptr k a b c) + +-- | Meanshift Filter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__mean__shift.htm) +-- +-- A meanshift filter is an edge-preserving smoothing filter commonly used in object tracking and image segmentation. +-- +meanShift + :: Array a + -- ^ 'Array' is the input image + -> Float + -- ^ is the spatial variance parameter that decides the filter window + -> Float + -- ^ is the chromatic variance parameter + -> Int + -- ^ is the number of iterations filter operation is performed + -> Bool + -- ^ indicates if the input in is color image or grayscale + -> Array a + -- ^ 'Array' is the processed image +meanShift in' a b (fromIntegral -> c) (fromIntegral . fromEnum -> d) = in' `op1` (\ptr k -> af_mean_shift ptr k a b c d) + +-- | Find minimum value from a window. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__minfilt.htm) +-- +-- minfilt finds the smallest value from a 2D window and assigns it to the current pixel. +-- +minFilt + :: Array a + -- ^ 'Array' is the input image + -> Int + -- ^ is the kernel height + -> Int + -- ^ is the kernel width + -> BorderType + -- ^ value will decide what happens to border when running filter in their neighborhood. It takes one of the values [AF_PAD_ZERO | AF_PAD_SYM] + -> Array a + -- ^ 'Array' is the processed image +minFilt in' (fromIntegral -> a) (fromIntegral -> b) (fromBorderType -> c) = + in' `op1` (\ptr k -> af_minfilt ptr k a b c) + +-- | Find maximum value from a window. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__maxfilt.htm) +-- +-- 'maxFilt' finds the smallest value from a 2D window and assigns it to the current pixel. +-- +maxFilt + :: Array a + -- ^ 'Array' is the input image + -> Int + -- ^ is the kernel height + -> Int + -- ^ is the kernel width + -> BorderType + -- ^ value will decide what happens to border when running filter in their neighborhood. It takes one of the values [AF_PAD_ZERO | AF_PAD_SYM] + -> Array a + -- ^ 'Array' is the processed image +maxFilt in' (fromIntegral -> a) (fromIntegral -> b) (fromBorderType -> c) = + in' `op1` (\ptr k -> af_maxfilt ptr k a b c) + +-- | Find blobs in given image. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__regions.htm) +-- +-- Given a binary image (with zero representing background pixels), regions computes a floating point image where each connected component is labeled from 1 to N, the total number of components in the image. +-- ** FIX ME** +regions + :: forall a . (AFType a) + => Array a + -- ^ array should be binary image of type CBool + -> Connectivity + -- ^ + -> Array a + -- ^ array will have labels indicating different regions +regions in' (fromConnectivity -> conn) = + in' `op1` (\ptr k -> af_regions ptr k conn dtype) + where + dtype = afType (Proxy @ a) + +-- | Sobel Operators. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__sobel.htm) +-- +-- Sobel operators perform a 2-D spatial gradient measurement on an image to emphasize the regions of high spatial frequency, namely edges +-- +-- *Note* If img is 3d array, a batch operation will be performed. +-- +sobel_operator + :: Array a + -- ^ is an array with image data + -> Int + -- ^ sobel kernel size or window size + -> (Array a, Array a) + -- ^ Derivative along the horizontal and vertical directions +sobel_operator in' (fromIntegral -> kerSize) = + in' `op2p` (\ptrA ptrB k -> af_sobel_operator ptrA ptrB k kerSize) + +-- | RGB to Grayscale colorspace converter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__rgb2gray.htm) +-- +-- RGB (Red, Green, Blue) is the most common format used in computer imaging. RGB stores individual values for red, green and blue, and hence the 3 values per pixel. A combination of these three values produces the gamut of unique colors. +-- +rgb2gray + :: Array a + -- ^ is an array in the RGB color space + -> Float + -- ^ is percentage of red channel value contributing to grayscale intensity + -> Float + -- ^ is percentage of green channel value contributing to grayscale intensity + -> Float + -- ^ is percentage of blue channel value contributing to grayscale intensity + -> Array a + -- ^ is an array in target color space +rgb2gray in' a b c = + in' `op1` (\ptr k -> af_rgb2gray ptr k a b c) + +-- | Grayscale to RGB colorspace converter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__gray2rgb.htm) +-- +-- Grayscale is a single channel color space where pixel value ranges from 0 to 1. Zero represents black, one represent white and any value between zero & one is a gray value +-- +gray2rgb + :: Array a + -- ^ is an array in the Grayscale color space + -> Float + -- ^ is percentage of intensity value contributing to red channel + -> Float + -- ^ is percentage of intensity value contributing to green channel + -> Float + -- ^ is percentage of intensity value contributing to blue channel + -> Array a + -- ^ is an array in target color space +gray2rgb in' a b c = in' `op1` (\ptr k -> af_gray2rgb ptr k a b c) + +-- | Histogram equalization of input image. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__histequal.htm) +-- +-- Histogram equalization is a method in image processing of contrast adjustment using the image's histogram. +-- +histEqual + :: Array a + -- ^ is the input array, non-normalized input (!! assumes values [0-255] !!) + -> Array a + -- ^ target histogram to approximate in output (based on number of bins) + -> Array a + -- ^ is an array with data that has histogram approximately equal to histogram +histEqual in' mask = op2 in' mask af_hist_equal + +-- | Creates a Gaussian Kernel. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__gauss.htm) +-- +-- This function creates a kernel of a specified size that contains a Gaussian distribution. This distribution is normalized to one. This is most commonly used when performing a Gaussian blur on an image. The function takes two sets of arguments, the size of the kernel (width and height in pixels) and the sigma parameters (for row and column) which effect the distribution of the weights in the y and x directions, respectively. +-- +gaussianKernel + :: Int + -- ^ number of rows of the gaussian kernel + -> Int + -- ^ number of columns of the gaussian kernel + -> Double + -- ^ (default 0) (calculated internally as 0.25 * rows + 0.75) + -> Double + -- ^ (default 0) (calculated internally as 0.25 * cols + 0.75) + -> Array a + -- ^ is an array with values generated using gaussian function +gaussianKernel (fromIntegral -> i1) (fromIntegral -> i2) d1 d2 = + createArray (\ptr -> af_gaussian_kernel ptr i1 i2 d1 d2) + +-- | HSV to RGB colorspace converter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__hsv2rgb.htm) +-- +-- C Interface for converting HSV to RGB. +-- +-- *Note* input must be three dimensional +-- +hsv2rgb + :: Array a + -- ^ is an array in the HSV color space + -> Array a + -- ^ is an array in the RGB color space +hsv2rgb = (`op1` af_hsv2rgb) + +-- | RGB to HSV colorspace converter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__rgb2hsv.htm) +-- +-- RGB (Red, Green, Blue) is the most common format used in computer imaging. RGB stores individual values for red, green and blue, and hence the 3 values per pixel. A combination of these three values produces the gamut of unique colors. +-- +rgb2hsv + :: Array a + -- ^ is an array in the RGB color space + -> Array a + -- ^ is an array in the HSV color space +rgb2hsv = (`op1` af_rgb2hsv) + +-- | Colorspace conversion function. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__colorspace.htm) +-- +-- C Interface wrapper for color space conversion. +-- +colorSpace + :: Array a + -- ^ is the input array + -> CSpace + -- ^ is the target array color space + -> CSpace + -- ^ is the input array color space + -> Array a + -- ^ is an array in target color space +colorSpace in' (fromCSpace -> to) (fromCSpace -> from) = + in' `op1` (\p a -> af_color_space p a to from) + +-- | Rearrange windowed sections of an array into columns (or rows). +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__unwrap.htm) +-- +-- C Interface for rearranging windowed sections of an input into columns (or rows) +-- +unwrap + :: Array a + -- ^ the input 'Array' + -> Int + -- ^ is the window size along dimension 0 + -> Int + -- ^ is the window size along dimension 1 + -> Int + -- ^ is the stride along dimension 0 + -> Int + -- ^ is the stride along dimension 1 + -> Int + -- ^ is the padding along dimension 0 + -> Int + -- ^ is the padding along dimension 1 + -> Bool + -- ^ determines whether an output patch is formed from a column (if true) or a row (if false) + -> Array a + -- ^ an array with the input's sections rearraged as columns (or rows) +unwrap in' (fromIntegral -> wx) (fromIntegral -> wy) (fromIntegral -> sx) (fromIntegral -> sy) (fromIntegral -> px) (fromIntegral -> py) (fromIntegral . fromEnum -> b) + = in' `op1` (\ptr a -> af_unwrap ptr a wx wy sx sy px py b) + +-- | Performs the opposite of unwrap. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__wrap.htm) +-- +wrap + :: Array a + -- ^ the input 'Array' + -> Int + -- ^ is the output's dimension 0 size + -> Int + -- ^ is the output's dimension 1 size + -> Int + -- ^ is the window size along dimension 0 + -> Int + -- ^ is the window size along dimension 1 + -> Int + -- ^ is the stride along dimension 0 + -> Int + -- ^ is the stride along dimension 1 + -> Int + -- ^ is the padding along dimension 0 + -> Int + -- ^ is the padding along dimension 1 + -> Bool + -- ^ determines whether an output patch is formed from a column (if true) or a row (if false) + -> Array a + -- ^ is an array with the input's columns (or rows) reshaped as patches +wrap in' (fromIntegral -> ox) (fromIntegral -> oy) (fromIntegral -> wx) (fromIntegral -> wy) + (fromIntegral -> sx) (fromIntegral -> sy) (fromIntegral -> px) (fromIntegral -> py) (fromIntegral . fromEnum -> b) + = in' `op1` (\ptr a -> af_wrap ptr a ox oy wx wy sx sy px py b) + +-- | Summed Area Tables. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__sat.htm) +-- +-- RGB (Red, Green, Blue) is the most common format used in computer imaging. RGB stores individual values for red, green and blue, and hence the 3 values per pixel. A combination of these three values produces the gamut of unique colors. +-- +sat + :: Array a + -- ^ the input 'Array' + -> Array a + -- ^ is the summed area table on input image(s) +sat = (`op1` af_sat) + +-- | YCbCr to RGB colorspace converter +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__ycbcr2rgb.htm) +-- +-- YCbCr is a family of color spaces used as a part of the color image pipeline in video and digital photography systems where Y is luma component and Cb & Cr are the blue-difference and red-difference chroma components. +-- +ycbcr2rgb + :: Array a + -> YccStd + -> Array a +ycbcr2rgb a y = a `op1` (\p k -> af_ycbcr2rgb p k (fromAFYccStd y)) + +-- | RGB to YCbCr colorspace converter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__rgb2ycbcr.htm) +-- +-- RGB (Red, Green, Blue) is the most common format used in computer imaging. RGB stores individual values for red, green and blue, and hence the 3 values per pixel. A combination of these three values produces the gamut of unique colors. +-- +rgb2ycbcr + :: Array a + -- ^ is an array in the RGB color space + -> YccStd + -- ^ specifies the ITU-R BT "xyz" standard which determines the Kb, Kr values used in colorspace conversion equation + -> Array a + -- ^ is an 'Array' in the YCbCr color space +rgb2ycbcr a y = a `op1` (\p k -> af_rgb2ycbcr p k (fromAFYccStd y)) + +-- | Finding different properties of image regions. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__moments.htm) +-- +-- C Interface for calculating image moment(s) of a single image. +-- +moments + :: Array a + -- ^ is an array of image(s) + -> MomentType + -- ^ is moment(s) to calculate + -> Array a + -- ^ is an array containing the calculated moments +moments in' m = + in' `op1` (\p k -> af_moments p k (fromMomentType m)) + +-- | Finding different properties of image regions. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__moments.htm) +-- +-- C Interface for calculating image moment(s) of a single image. +-- +momentsAll + :: Array a + -- ^ is the input image + -> MomentType + -- ^ is moment(s) to calculate + -> Double + -- ^ is a pointer to a pre-allocated array where the calculated moment(s) will be placed. User is responsible for ensuring enough space to hold all requested moments +momentsAll in' m = + in' `infoFromArray` (\p a -> af_moments_all p a (fromMomentType m)) + +-- | Canny Edge Detector +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__canny.htm) +-- +-- The Canny edge detector is an edge detection operator that uses a multi-stage algorithm to detect a wide range of edges in images. +-- +canny + :: Array a + -- ^ the input image + -> CannyThreshold + -- ^ determines if user set high threshold is to be used or not. + -> Float + -- ^ is the lower threshold % of the maximum or auto-derived high threshold + -> Float + -- ^ is the higher threshold % of maximum value in gradient image used in hysteresis procedure. This value is ignored if AF_CANNY_THRESHOLD_AUTO_OTSU is chosen as af_canny_threshold + -> Int + -- ^ is the window size of sobel kernel for computing gradient direction and magnitude + -> Bool + -- ^ indicates if L1 norm(faster but less accurate) is used to compute image gradient magnitude instead of L2 norm. + -> Array a + -- ^ is an binary array containing edges +canny in' (fromCannyThreshold -> canny') low high (fromIntegral -> window) (fromIntegral . fromEnum -> fast) = + in' `op1` (\p a -> af_canny p a canny' low high window fast) + +-- | Anisotropic Smoothing Filter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__anisotropic__diffusion.htm) +-- +-- C Interface for anisotropic diffusion. +-- +anisotropicDiffusion + :: Array a + -- ^ is the input image, expects non-integral (float/double) typed af_array + -> Float + -- ^ is the time step used in solving the diffusion equation. + -> Float + -- ^ parameter controls the sensitivity of conductance in diffusion equation. + -> Int + -- ^ is the number of times the diffusion step is performed. + -> FluxFunction + -- ^ indicates whether quadratic or exponential flux function is used by algorithm. + -> DiffusionEq + -- ^ will let the user choose what kind of diffusion method to perform. + -> Array a + -- ^ is an 'Array' containing anisotropically smoothed image pixel values +anisotropicDiffusion in' ts con (fromIntegral -> iter) (fromFluxFunction -> flux) (fromDiffusionEq -> diff) = + in' `op1` (\p a -> af_anisotropic_diffusion p a ts con iter flux diff) + +-- iterativeDeconv +-- :: Array a +-- -> Array a +-- -> Int +-- -> Float +-- -> IterativeDeconvAlgo +-- -> Array a +-- iterativeDeconv in1 in2 (fromIntegral -> i) f1 (fromIterativeDeconvAlgo -> algo) = +-- op2 in1 in2 (\p a k -> af_iterative_deconv p a k i f1 algo) + +-- inverseDeconv +-- :: Array a +-- -> Array a +-- -> Float +-- -> InverseDeconvAlgo +-- -> Array a +-- inverseDeconv in1 in2 f1 (fromInverseDeconvAlgo -> algo) = +-- op2 in1 in2 (\p a k -> af_inverse_deconv p a k f1 algo) diff --git a/src/ArrayFire/Index.hs b/src/ArrayFire/Index.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Index.hs @@ -0,0 +1,91 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Index +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-------------------------------------------------------------------------------- +module ArrayFire.Index where + +import ArrayFire.Internal.Index +import ArrayFire.Internal.Types +import ArrayFire.FFI +import ArrayFire.Exception + +import Foreign + +import System.IO.Unsafe +import Control.Exception + +-- | Index into an 'Array' by 'Seq' +index + :: Array a + -- ^ 'Array' argument + -> [Seq] + -- ^ 'Seq' to use for indexing + -> Array a +index (Array fptr) seqs = + unsafePerformIO . mask_ . withForeignPtr fptr $ \ptr -> do + alloca $ \aptr -> + withArray (toAFSeq <$> seqs) $ \sptr -> do + throwAFError =<< af_index aptr ptr n sptr + Array <$> do + newForeignPtr af_release_array_finalizer + =<< peek aptr + where + n = fromIntegral (length seqs) + +-- | Lookup an Array by keys along a specified dimension +lookup :: Array a -> Array a -> Int -> Array a +lookup a b n = op2 a b $ \p x y -> af_lookup p x y (fromIntegral n) + +-- af_err af_assign_seq( af_array *out, const af_array lhs, const unsigned ndims, const af_seq* const indices, const af_array rhs); +-- | Calculates 'mean' of 'Array' along user-specified dimension. +-- +-- @ +-- >>> print $ mean 0 ( vector @Int 10 [1..] ) +-- @ +-- @ +-- ArrayFire Array +-- [1 1 1 1] +-- 5.5000 +-- @ +-- assignSeq :: Array a -> Int -> [Seq] -> Array a -> Array a +-- assignSeq = error "Not implemneted" + +-- af_err af_index_gen( af_array *out, const af_array in, const dim_t ndims, const af_index_t* indices); +-- | Calculates 'mean' of 'Array' along user-specified dimension. +-- +-- @ +-- >>> print $ mean 0 ( vector @Int 10 [1..] ) +-- @ +-- @ +-- ArrayFire Array +-- [1 1 1 1] +-- 5.5000 +-- @ +-- indexGen :: Array a -> Int -> [Index a] -> Array a -> Array a +-- indexGen = error "Not implemneted" + +-- af_err af_assingn_gen( af_array *out, const af_array lhs, const dim_t ndims, const af_index_t* indices, const af_array rhs); +-- | Calculates 'mean' of 'Array' along user-specified dimension. +-- +-- @ +-- >>> print $ mean 0 ( vector @Int 10 [1..] ) +-- @ +-- @ +-- ArrayFire Array +-- [1 1 1 1] +-- 5.5000 +-- @ +-- assignGen :: Array a -> Int -> [Index a] -> Array a -> Array a +-- assignGen = error "Not implemneted" + +-- af_err af_create_indexers(af_index_t** indexers); +-- af_err af_set_array_indexer(af_index_t* indexer, const af_array idx, const dim_t dim); +-- af_err af_set_seq_indexer(af_index_t* indexer, const af_seq* idx, const dim_t dim, const bool is_batch); +-- af_err af_set_seq_param_indexer(af_index_t* indexer, const double begin, const double end, const double step, const dim_t dim, const bool is_batch); +-- af_err af_release_indexers(af_index_t* indexers); diff --git a/src/ArrayFire/Internal/Algorithm.hsc b/src/ArrayFire/Internal/Algorithm.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Algorithm.hsc @@ -0,0 +1,77 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Algorithm where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/algorithm.h" +foreign import ccall unsafe "af_sum" + af_sum :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_sum_nan" + af_sum_nan :: Ptr AFArray -> AFArray -> CInt -> Double -> IO AFErr +foreign import ccall unsafe "af_product" + af_product :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_product_nan" + af_product_nan :: Ptr AFArray -> AFArray -> CInt -> Double -> IO AFErr +foreign import ccall unsafe "af_min" + af_min :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_max" + af_max :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_all_true" + af_all_true :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_any_true" + af_any_true :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_count" + af_count :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_sum_all" + af_sum_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sum_nan_all" + af_sum_nan_all :: Ptr Double -> Ptr Double -> AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_product_all" + af_product_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_product_nan_all" + af_product_nan_all :: Ptr Double -> Ptr Double -> AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_min_all" + af_min_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_max_all" + af_max_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_all_true_all" + af_all_true_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_any_true_all" + af_any_true_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_count_all" + af_count_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_imin" + af_imin :: Ptr AFArray -> Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_imax" + af_imax :: Ptr AFArray -> Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_imin_all" + af_imin_all :: Ptr Double -> Ptr Double -> Ptr CUInt -> AFArray -> IO AFErr +foreign import ccall unsafe "af_imax_all" + af_imax_all :: Ptr Double -> Ptr Double -> Ptr CUInt -> AFArray -> IO AFErr +foreign import ccall unsafe "af_accum" + af_accum :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_scan" + af_scan :: Ptr AFArray -> AFArray -> CInt -> AFBinaryOp -> CBool -> IO AFErr +foreign import ccall unsafe "af_scan_by_key" + af_scan_by_key :: Ptr AFArray -> AFArray -> AFArray -> CInt -> AFBinaryOp -> CBool -> IO AFErr +foreign import ccall unsafe "af_where" + af_where :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_diff1" + af_diff1 :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_diff2" + af_diff2 :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_sort" + af_sort :: Ptr AFArray -> AFArray -> CUInt -> CBool -> IO AFErr +foreign import ccall unsafe "af_sort_index" + af_sort_index :: Ptr AFArray -> Ptr AFArray -> AFArray -> CUInt -> CBool -> IO AFErr +foreign import ccall unsafe "af_sort_by_key" + af_sort_by_key :: Ptr AFArray -> Ptr AFArray -> AFArray -> AFArray -> CUInt -> CBool -> IO AFErr +foreign import ccall unsafe "af_set_unique" + af_set_unique :: Ptr AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_set_union" + af_set_union :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_set_intersect" + af_set_intersect :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr diff --git a/src/ArrayFire/Internal/Arith.hsc b/src/ArrayFire/Internal/Arith.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Arith.hsc @@ -0,0 +1,149 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Arith where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/arith.h" +foreign import ccall unsafe "af_add" + af_add :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_sub" + af_sub :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_mul" + af_mul :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_div" + af_div :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_lt" + af_lt :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_gt" + af_gt :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_le" + af_le :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_ge" + af_ge :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_eq" + af_eq :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_neq" + af_neq :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_and" + af_and :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_or" + af_or :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_not" + af_not :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_bitand" + af_bitand :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_bitor" + af_bitor :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_bitxor" + af_bitxor :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_bitshiftl" + af_bitshiftl :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_bitshiftr" + af_bitshiftr :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_cast" + af_cast :: Ptr AFArray -> AFArray -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_minof" + af_minof :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_maxof" + af_maxof :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_clamp" + af_clamp :: Ptr AFArray -> AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_rem" + af_rem :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_mod" + af_mod :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_abs" + af_abs :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_arg" + af_arg :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sign" + af_sign :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_round" + af_round :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_trunc" + af_trunc :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_floor" + af_floor :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_ceil" + af_ceil :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_hypot" + af_hypot :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_sin" + af_sin :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_cos" + af_cos :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_tan" + af_tan :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_asin" + af_asin :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_acos" + af_acos :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_atan" + af_atan :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_atan2" + af_atan2 :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_cplx2" + af_cplx2 :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_cplx" + af_cplx :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_real" + af_real :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_imag" + af_imag :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_conjg" + af_conjg :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sinh" + af_sinh :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_cosh" + af_cosh :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_tanh" + af_tanh :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_asinh" + af_asinh :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_acosh" + af_acosh :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_atanh" + af_atanh :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_root" + af_root :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_pow" + af_pow :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_pow2" + af_pow2 :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_exp" + af_exp :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sigmoid" + af_sigmoid :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_expm1" + af_expm1 :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_erf" + af_erf :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_erfc" + af_erfc :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_log" + af_log :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_log1p" + af_log1p :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_log10" + af_log10 :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_log2" + af_log2 :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sqrt" + af_sqrt :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_cbrt" + af_cbrt :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_factorial" + af_factorial :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_tgamma" + af_tgamma :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_lgamma" + af_lgamma :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_iszero" + af_iszero :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_isinf" + af_isinf :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_isnan" + af_isnan :: Ptr AFArray -> AFArray -> IO AFErr diff --git a/src/ArrayFire/Internal/Array.hsc b/src/ArrayFire/Internal/Array.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Array.hsc @@ -0,0 +1,71 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Array where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/array.h" +foreign import ccall unsafe "af_create_array" + af_create_array :: Ptr AFArray -> Ptr () -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_create_handle" + af_create_handle :: Ptr AFArray -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_copy_array" + af_copy_array :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_write_array" + af_write_array :: AFArray -> Ptr () -> CSize -> AFSource -> IO AFErr +foreign import ccall unsafe "af_get_data_ptr" + af_get_data_ptr :: Ptr () -> AFArray -> IO AFErr +foreign import ccall unsafe "af_release_array" + af_release_array :: AFArray -> IO AFErr +foreign import ccall unsafe "af_retain_array" + af_retain_array :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_data_ref_count" + af_get_data_ref_count :: Ptr CInt -> AFArray -> IO AFErr +foreign import ccall unsafe "af_eval" + af_eval :: AFArray -> IO AFErr +foreign import ccall unsafe "af_eval_multiple" + af_eval_multiple :: CInt -> Ptr AFArray -> IO AFErr +foreign import ccall unsafe "af_set_manual_eval_flag" + af_set_manual_eval_flag :: CBool -> IO AFErr +foreign import ccall unsafe "af_get_manual_eval_flag" + af_get_manual_eval_flag :: Ptr CBool -> IO AFErr +foreign import ccall unsafe "af_get_elements" + af_get_elements :: Ptr DimT -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_type" + af_get_type :: Ptr AFDtype -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_dims" + af_get_dims :: Ptr DimT -> Ptr DimT -> Ptr DimT -> Ptr DimT -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_numdims" + af_get_numdims :: Ptr CUInt -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_empty" + af_is_empty :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_scalar" + af_is_scalar :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_row" + af_is_row :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_column" + af_is_column :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_vector" + af_is_vector :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_complex" + af_is_complex :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_real" + af_is_real :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_double" + af_is_double :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_single" + af_is_single :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_realfloating" + af_is_realfloating :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_floating" + af_is_floating :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_integer" + af_is_integer :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_bool" + af_is_bool :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_sparse" + af_is_sparse :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_scalar" + af_get_scalar :: Ptr () -> AFArray -> IO AFErr diff --git a/src/ArrayFire/Internal/BLAS.hsc b/src/ArrayFire/Internal/BLAS.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/BLAS.hsc @@ -0,0 +1,19 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.BLAS where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/blas.h" +foreign import ccall unsafe "af_matmul" + af_matmul :: Ptr AFArray -> AFArray -> AFArray -> AFMatProp -> AFMatProp -> IO AFErr +foreign import ccall unsafe "af_dot" + af_dot :: Ptr AFArray -> AFArray -> AFArray -> AFMatProp -> AFMatProp -> IO AFErr +foreign import ccall unsafe "af_dot_all" + af_dot_all :: Ptr Double -> Ptr Double -> AFArray -> AFArray -> AFMatProp -> AFMatProp -> IO AFErr +foreign import ccall unsafe "af_transpose" + af_transpose :: Ptr AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_transpose_inplace" + af_transpose_inplace :: AFArray -> CBool -> IO AFErr diff --git a/src/ArrayFire/Internal/Backend.hsc b/src/ArrayFire/Internal/Backend.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Backend.hsc @@ -0,0 +1,21 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Backend where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/backend.h" +foreign import ccall unsafe "af_set_backend" + af_set_backend :: AFBackend -> IO AFErr +foreign import ccall unsafe "af_get_backend_count" + af_get_backend_count :: Ptr CUInt -> IO AFErr +foreign import ccall unsafe "af_get_available_backends" + af_get_available_backends :: Ptr CInt -> IO AFErr +foreign import ccall unsafe "af_get_backend_id" + af_get_backend_id :: Ptr AFBackend -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_active_backend" + af_get_active_backend :: Ptr AFBackend -> IO AFErr +foreign import ccall unsafe "af_get_device_id" + af_get_device_id :: Ptr CInt -> AFArray -> IO AFErr diff --git a/src/ArrayFire/Internal/Data.hsc b/src/ArrayFire/Internal/Data.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Data.hsc @@ -0,0 +1,57 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Data where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/data.h" +foreign import ccall unsafe "af_constant" + af_constant :: Ptr AFArray -> Double -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_constant_complex" + af_constant_complex :: Ptr AFArray -> Double -> Double -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_constant_long" + af_constant_long :: Ptr AFArray -> IntL -> CUInt -> Ptr DimT -> IO AFErr +foreign import ccall unsafe "af_constant_ulong" + af_constant_ulong :: Ptr AFArray -> UIntL -> CUInt -> Ptr DimT -> IO AFErr +foreign import ccall unsafe "af_range" + af_range :: Ptr AFArray -> CUInt -> Ptr DimT -> CInt -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_iota" + af_iota :: Ptr AFArray -> CUInt -> Ptr DimT -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_identity" + af_identity :: Ptr AFArray -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_diag_create" + af_diag_create :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_diag_extract" + af_diag_extract :: Ptr AFArray -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_join" + af_join :: Ptr AFArray -> CInt -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_join_many" + af_join_many :: Ptr AFArray -> CInt -> CUInt -> Ptr AFArray -> IO AFErr +foreign import ccall unsafe "af_tile" + af_tile :: Ptr AFArray -> AFArray -> CUInt -> CUInt -> CUInt -> CUInt -> IO AFErr +foreign import ccall unsafe "af_reorder" + af_reorder :: Ptr AFArray -> AFArray -> CUInt -> CUInt -> CUInt -> CUInt -> IO AFErr +foreign import ccall unsafe "af_shift" + af_shift :: Ptr AFArray -> AFArray -> CInt -> CInt -> CInt -> CInt -> IO AFErr +foreign import ccall unsafe "af_moddims" + af_moddims :: Ptr AFArray -> AFArray -> CUInt -> Ptr DimT -> IO AFErr +foreign import ccall unsafe "af_flat" + af_flat :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_flip" + af_flip :: Ptr AFArray -> AFArray -> CUInt -> IO AFErr +foreign import ccall unsafe "af_lower" + af_lower :: Ptr AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_upper" + af_upper :: Ptr AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_select" + af_select :: Ptr AFArray -> AFArray -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_select_scalar_r" + af_select_scalar_r :: Ptr AFArray -> AFArray -> AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_select_scalar_l" + af_select_scalar_l :: Ptr AFArray -> AFArray -> Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_replace" + af_replace :: AFArray -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_replace_scalar" + af_replace_scalar :: AFArray -> AFArray -> Double -> IO AFErr diff --git a/src/ArrayFire/Internal/Defines.hsc b/src/ArrayFire/Internal/Defines.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Defines.hsc @@ -0,0 +1,423 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE RecordWildCards #-} +module ArrayFire.Internal.Defines where + +import Foreign.Ptr +import Foreign.C.Types +import Foreign.Storable + +#include "af/defines.h" +#include "af/seq.h" +#include "af/index.h" +#include "af/complex.h" + +afVersion :: Integer +afVersion = #const AF_API_VERSION + +newtype AFErr = AFErr { afError :: CInt } + deriving (Show, Eq) + +#{enum AFErr, AFErr + , afSuccess = AF_SUCCESS + , afErrNoMem = AF_ERR_NO_MEM + , afErrDriver = AF_ERR_DRIVER + , afErrRuntime = AF_ERR_RUNTIME + , afErrInvalidArray = AF_ERR_INVALID_ARRAY + , afErrArg = AF_ERR_ARG + , afErrSize = AF_ERR_SIZE + , afErrType = AF_ERR_TYPE + , afErrDiffType = AF_ERR_DIFF_TYPE + , afErrBatch = AF_ERR_BATCH + , afErrDevice = AF_ERR_DEVICE + , afErrNotSupported = AF_ERR_NOT_SUPPORTED + , afErrNotConfigured = AF_ERR_NOT_CONFIGURED + , afErrNonFree = AF_ERR_NONFREE + , afErrNoDbl = AF_ERR_NO_DBL + , afErrNoGfx = AF_ERR_NO_GFX + , afErrLoadLib = AF_ERR_LOAD_LIB + , afErrLoadSym = AF_ERR_LOAD_SYM + , afErrArrBkndMismatch = AF_ERR_ARR_BKND_MISMATCH + , afErrInternal = AF_ERR_INTERNAL + , afErrUnknown = AF_ERR_UNKNOWN + } + +-- | Low-level for representation of ArrayFire types +newtype AFDtype + = AFDtype + { afDType :: CInt + -- ^ Value corresponding to ArrayFire type + } deriving (Show, Eq, Storable) + +-- | Enums for AFDtype +#{enum AFDtype, AFDtype + , f32 = f32 + , c32 = c32 + , f64 = f64 + , c64 = c64 + , b8 = b8 + , s32 = s32 + , u32 = u32 + , u8 = u8 + , s64 = s64 + , u64 = u64 + , s16 = s16 + , u16 = u16 + } + +newtype AFSource = AFSource CInt + deriving (Ord, Show, Eq) + +#{enum AFSource, AFSource + , afDevice = afDevice + , afHost = afHost + } + +afMaxDims :: Integer +afMaxDims = #const AF_MAX_DIMS + +newtype AFSomeEnum = AFSomeEnum Int + deriving (Ord, Show, Eq, Storable) + +#{enum AFSomeEnum, AFSomeEnum + , afSomeEnum = 0 + } + + +-- // A handle for an internal array object +type AFArray = Ptr () +type AFFeatures = Ptr () +type AFRandomEngine = Ptr () + +-- // A handle for an internal array object +type AFWindow = Ptr () + +newtype AFInterpType = AFInterpType CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFInterpType, AFInterpType + , afInterpNearest = AF_INTERP_NEAREST + , afInterpLinear = AF_INTERP_LINEAR + , afInterpBilinear = AF_INTERP_BILINEAR + , afInterpCubic = AF_INTERP_CUBIC + , afInterpLower = AF_INTERP_LOWER + , afInterpLinearCosine = AF_INTERP_LINEAR_COSINE + , afInterpBilinearCosine = AF_INTERP_BILINEAR_COSINE + , afInterpBicubic = AF_INTERP_BICUBIC + , afInterpCubicSpline = AF_INTERP_CUBIC_SPLINE + , afInterpBicubicSpline = AF_INTERP_BICUBIC_SPLINE + } + +newtype AFBorderType = AFBorderType CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFBorderType, AFBorderType + , afBorderPadZero = AF_PAD_ZERO + , afPadSym = AF_PAD_SYM + } + +newtype AFConnectivity = AFConnectivity CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFConnectivity, AFConnectivity + , afConnectivity4 = AF_CONNECTIVITY_4 + , afConnectivity8 = AF_CONNECTIVITY_8 + } + +newtype AFConvMode = AFConvMode CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFConvMode, AFConvMode + , afConvDefault = AF_CONV_DEFAULT + , afConvExpand = AF_CONV_EXPAND + } + +newtype AFConvDomain = AFConvDomain CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFConvDomain, AFConvDomain + , afConvAuto = AF_CONV_AUTO + , afConvSpatial = AF_CONV_SPATIAL + , afConvFreq = AF_CONV_FREQ +} + +newtype AFMatchType = AFMatchType CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFMatchType, AFMatchType + , afSAD = AF_SAD + , afZSAD = AF_ZSAD + , afLSAD = AF_LSAD + , afSSD = AF_SSD + , afZSSD = AF_ZSSD + , afLSSD = AF_LSSD + , afNCC = AF_NCC + , afZNCC = AF_ZNCC + , afSHD = AF_SHD +} + +newtype AFYccStd = AFYccStd Int + deriving (Ord, Show, Eq, Storable) + +#{enum AFYccStd, AFYccStd + , afYcc601 = AF_YCC_601 + , afYcc709 = AF_YCC_709 + , afYcc2020 = AF_YCC_2020 + } + +newtype AFCSpace = AFCSpace Int + deriving (Ord, Show, Eq, Storable) + +#{enum AFCSpace, AFCSpace + , afGray = AF_GRAY + , afRgb = AF_RGB + , afHsv = AF_HSV + , afYCbCr = AF_YCbCr + } + +newtype AFMatProp = AFMatProp Int + deriving (Ord, Show, Eq, Storable) + +#{enum AFMatProp, AFMatProp + , afMatNone = AF_MAT_NONE + , afMatTrans = AF_MAT_TRANS + , afMatCtrans = AF_MAT_CTRANS + , afMatConj = AF_MAT_CONJ + , afMatUpper = AF_MAT_UPPER + , afMatLower = AF_MAT_LOWER + , afMatDiagUnit = AF_MAT_DIAG_UNIT + , afMatSym = AF_MAT_SYM + , afMatPosdef = AF_MAT_POSDEF + , afMatOrthog = AF_MAT_ORTHOG + , afMatTriDiag = AF_MAT_TRI_DIAG + , afMatBlockDiag = AF_MAT_BLOCK_DIAG + } + +newtype AFNormType = AFNormType Int + deriving (Ord, Show, Eq, Storable) + +#{enum AFNormType, AFNormType + , afNormVector1 = AF_NORM_VECTOR_1 + , afNormVectorInf = AF_NORM_VECTOR_INF + , afNormVector2 = AF_NORM_VECTOR_2 + , afNormVectorP = AF_NORM_VECTOR_P + , afNormMatrix1 = AF_NORM_MATRIX_1 + , afNormMatrixInf = AF_NORM_MATRIX_INF + , afNormMatrix2 = AF_NORM_MATRIX_2 + , afNormMatrixLPq = AF_NORM_MATRIX_L_PQ + , afNormEuclid = AF_NORM_VECTOR_2 +} + +newtype AFImageFormat = AFImageFormat Int + deriving (Ord, Show, Eq, Storable) + +#{enum AFImageFormat, AFImageFormat + , afFIFBmp = AF_FIF_BMP + , afFIFIco = AF_FIF_ICO + , afFIFJpeg = AF_FIF_JPEG + , afFIFJng = AF_FIF_JNG + , afFIFPng = AF_FIF_PNG + , afFIFPpm = AF_FIF_PPM + , afFIFPpmraw = AF_FIF_PPMRAW + , afFIFTiff = AF_FIF_TIFF + , afFIFPsd = AF_FIF_PSD + , afFIFHdr = AF_FIF_HDR + , afFIFExr = AF_FIF_EXR + , afFIFJp2 = AF_FIF_JP2 + , afFIFRaw = AF_FIF_RAW + } + +newtype AFMomentType = AFMomentType Int + deriving (Ord, Show, Eq, Storable) + +#{enum AFMomentType, AFMomentType + , afMomentM00 = AF_MOMENT_M00 + , afMomentM01 = AF_MOMENT_M01 + , afMomentM10 = AF_MOMENT_M10 + , afMomentM11 = AF_MOMENT_M11 + , afMomentFirstOrder = (AF_MOMENT_M00 | AF_MOMENT_M01 | AF_MOMENT_M10 | AF_MOMENT_M11) +} + +newtype AFHomographyType = AFHomographyType CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFHomographyType, AFHomographyType + , afHomographyRansac = AF_HOMOGRAPHY_RANSAC + , afHomographyLmeds = AF_HOMOGRAPHY_LMEDS +} + +newtype AFBackend = AFBackend CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFBackend, AFBackend + , afBackendDefault = AF_BACKEND_DEFAULT + , afBackendCpu = AF_BACKEND_DEFAULT + , afBackendCuda = AF_BACKEND_CUDA + , afBackendOpencl = AF_BACKEND_OPENCL +} + +newtype AFID = AFID CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFID, AFID + afID = AF_ID +} + +newtype AFBinaryOp = AFBinaryOp CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFBinaryOp, AFBinaryOp + , afBinaryAdd = AF_BINARY_ADD + , afBinaryMul = AF_BINARY_MUL + , afBinaryMin = AF_BINARY_MIN + , afBinaryMax = AF_BINARY_MAX + } + +newtype AFRandomEngineType = AFRandomEngineType CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFRandomEngineType, AFRandomEngineType + , afRandomEnginePhilox4X3210 = AF_RANDOM_ENGINE_PHILOX_4X32_10 + , afRandomEngineThreefry2X3216 = AF_RANDOM_ENGINE_THREEFRY_2X32_16 + , afRandomEngineMersenneGp11213 = AF_RANDOM_ENGINE_MERSENNE_GP11213 + , afRandomEnginePhilox = AF_RANDOM_ENGINE_PHILOX_4X32_10 + , afRandomEngineThreefry = AF_RANDOM_ENGINE_THREEFRY_2X32_16 + , afRandomEngineMersenne = AF_RANDOM_ENGINE_MERSENNE_GP11213 + , afRandomEngineDefault = AF_RANDOM_ENGINE_PHILOX + } + +newtype AFColorMap = AFColorMap CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFColorMap, AFColorMap + , afColormapDefault = AF_COLORMAP_DEFAULT + , afColormapSpectrum= AF_COLORMAP_SPECTRUM + , afColormapColors = AF_COLORMAP_COLORS + , afColormapRed = AF_COLORMAP_RED + , afColormapMood = AF_COLORMAP_MOOD + , afColormapHeat = AF_COLORMAP_HEAT + , afColormapBlue = AF_COLORMAP_BLUE + , afColormapInferno = AF_COLORMAP_INFERNO + , afColormapMagma = AF_COLORMAP_MAGMA + , afColormapPlasma = AF_COLORMAP_PLASMA + , afColormapViridis = AF_COLORMAP_VIRIDIS +} + +newtype AFMarkerType = AFMarkerType CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFMarkerType, AFMarkerType + , afMarkerNone = AF_MARKER_NONE + , afMarkerPoint = AF_MARKER_POINT + , afMarkerCircle = AF_MARKER_CIRCLE + , afMarkerSquare = AF_MARKER_SQUARE + , afMarkerTriangle = AF_MARKER_TRIANGLE + , afMarkerCross = AF_MARKER_CROSS + , afMarkerPlus = AF_MARKER_PLUS + , afMarkerStar = AF_MARKER_STAR + } + +newtype AFCannyThreshold = AFCannyThreshold CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFCannyThreshold, AFCannyThreshold + , afCannyThresholdManual = AF_CANNY_THRESHOLD_MANUAL + , afCannyThresholdAutoOtsu = AF_CANNY_THRESHOLD_AUTO_OTSU + } + +newtype AFStorage = AFStorage CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFStorage, AFStorage + , afStorageDense = AF_STORAGE_DENSE + , afStorageCsr = AF_STORAGE_CSR + , afStorageCsc = AF_STORAGE_CSC + , afStorageCoo = AF_STORAGE_COO + } + +newtype AFFluxFunction = AFFluxFunction CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFFluxFunction, AFFluxFunction + , afFluxQuadratic = AF_FLUX_QUADRATIC + , afFluxExponential = AF_FLUX_EXPONENTIAL + , afFluxDefault = AF_FLUX_DEFAULT + } + +newtype AFDiffusionEq = AFDiffusionEq CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFDiffusionEq, AFDiffusionEq + , afDiffusionGrad = AF_DIFFUSION_GRAD + , afDiffusionMcde = AF_DIFFUSION_MCDE + , afDiffusionDefault = AF_DIFFUSION_DEFAULT + } + +newtype AFTopkFunction = AFTopkFunction CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFTopkFunction, AFTopkFunction + , afTopkMin = AF_TOPK_MIN + , afTopkMax = AF_TOPK_MAX + , afTopkDefault = AF_TOPK_DEFAULT + } + +newtype AFIterativeDeconvAlgo = AFIterativeDeconvAlgo CInt + deriving (Ord, Show, Eq, Storable) + +-- #{enum AFIterativeDeconvAlgo, AFIterativeDeconvAlgo +-- , afIterativeDeconvLandweber = AF_ITERATIVE_DECONV_LANDWEBER +-- , afIterativeDeconvRichardsonlucy = AF_ITERATIVE_DECONV_RICHARDSONLUCY +-- , afIterativeDeconvDefault = AF_ITERATIVE_DECONV_DEFAULT +-- } + +newtype AFInverseDeconvAlgo = AFInverseDeconvAlgo CInt + deriving (Ord, Show, Eq, Storable) + +#{enum AFInverseDeconvAlgo, AFInverseDeconvAlgo + afInverseDeconvTikhonov = AF_INVERSE_DECONV_TIKHONOV + afInverseDeconvDefault = AF_INVERSE_DECONV_DEFAULT + } + +-- newtype AFVarBias = AFVarBias Int +-- deriving (Ord, Show, Eq) + +-- #{enum AFVarBias, AFVarBias +-- , afVarianceDefault = AF_VARIANCE_DEFAULT +-- , afVarianceSample = AF_VARIANCE_SAMPLE +-- , afVariancePopulation = AF_VARIANCE_POPULATION +-- } + +newtype DimT = DimT CLLong + deriving (Show, Eq, Storable, Num, Integral, Real, Enum, Ord) + +newtype UIntL = UIntL CULLong + deriving (Show, Eq, Storable, Num, Integral, Real, Enum, Ord) + +newtype IntL = IntL CLLong + deriving (Show, Eq, Storable, Num, Integral, Real, Enum, Ord) + +-- static const af_seq af_span = {1, 1, 0}; + +-- newtype AFCLPlatform = AFCLPlatform Int +-- deriving (Show, Eq) + +-- #{enum AFCLPlatform, AFCLPlatform +-- , afclPlatformAMD = AFCL_PLATFORM_AMD +-- , afclPlatformApple = AFCL_PLATFORM_APPLE +-- , afclPlatformIntel = AFCL_PLATFORM_INTEL +-- , afclPlatformNVIDIA = AFCL_PLATFORM_NVIDIA +-- , afclPlatformBEIGNET = AFCL_PLATFORM_BEIGNET +-- , afclPlatformPOCL = AFCL_PLATFORM_POCL +-- , afclPlatformUnknown = AFCL_PLATFORM_UNKNOWN +-- } + +-- newtype DeviceType = DeviceType Int +-- deriving (Show, Eq) + +-- #{enum DeviceType, DeviceType +-- , afCLDeviceTypeCPU = AFCL_DEVICE_TYPE_CPU +-- , afCLDeviceTypeGPU = AFCL_DEVICE_TYPE_GPU +-- , afCLDeviceTypeAccel = AFCL_DEVICE_TYPE_ACCEL +-- , afCLDeviceTypeUnknown = AFCL_DEVICE_TYPE_UNKNOWN +-- } diff --git a/src/ArrayFire/Internal/Device.hsc b/src/ArrayFire/Internal/Device.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Device.hsc @@ -0,0 +1,61 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Device where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/device.h" +foreign import ccall unsafe "af_info" + af_info :: IO AFErr +foreign import ccall unsafe "af_init" + af_init :: IO AFErr +foreign import ccall unsafe "af_info_string" + af_info_string :: Ptr (Ptr CChar) -> CBool -> IO AFErr +foreign import ccall unsafe "af_device_info" + af_device_info :: Ptr CChar -> Ptr CChar -> Ptr CChar -> Ptr CChar -> IO AFErr +foreign import ccall unsafe "af_get_device_count" + af_get_device_count :: Ptr CInt -> IO AFErr +foreign import ccall unsafe "af_get_dbl_support" + af_get_dbl_support :: Ptr CBool -> CInt -> IO AFErr +foreign import ccall unsafe "af_set_device" + af_set_device :: CInt -> IO AFErr +foreign import ccall unsafe "af_get_device" + af_get_device :: Ptr CInt -> IO AFErr +foreign import ccall unsafe "af_sync" + af_sync :: CInt -> IO AFErr +foreign import ccall unsafe "af_alloc_device" + af_alloc_device :: Ptr (Ptr ()) -> DimT -> IO AFErr +foreign import ccall unsafe "af_free_device" + af_free_device :: Ptr () -> IO AFErr +foreign import ccall unsafe "af_alloc_pinned" + af_alloc_pinned :: Ptr (Ptr ()) -> DimT -> IO AFErr +foreign import ccall unsafe "af_free_pinned" + af_free_pinned :: Ptr () -> IO AFErr +foreign import ccall unsafe "af_alloc_host" + af_alloc_host :: Ptr (Ptr ()) -> DimT -> IO AFErr +foreign import ccall unsafe "af_free_host" + af_free_host :: Ptr () -> IO AFErr +foreign import ccall unsafe "af_device_array" + af_device_array :: Ptr AFArray -> Ptr () -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_device_mem_info" + af_device_mem_info :: Ptr CSize -> Ptr CSize -> Ptr CSize -> Ptr CSize -> IO AFErr +foreign import ccall unsafe "af_print_mem_info" + af_print_mem_info :: Ptr CChar -> CInt -> IO AFErr +foreign import ccall unsafe "af_device_gc" + af_device_gc :: IO AFErr +foreign import ccall unsafe "af_set_mem_step_size" + af_set_mem_step_size :: CSize -> IO AFErr +foreign import ccall unsafe "af_get_mem_step_size" + af_get_mem_step_size :: Ptr CSize -> IO AFErr +foreign import ccall unsafe "af_lock_device_ptr" + af_lock_device_ptr :: AFArray -> IO AFErr +foreign import ccall unsafe "af_unlock_device_ptr" + af_unlock_device_ptr :: AFArray -> IO AFErr +foreign import ccall unsafe "af_lock_array" + af_lock_array :: AFArray -> IO AFErr +foreign import ccall unsafe "af_is_locked_array" + af_is_locked_array :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_device_ptr" + af_get_device_ptr :: Ptr (Ptr ()) -> AFArray -> IO AFErr diff --git a/src/ArrayFire/Internal/Exception.hsc b/src/ArrayFire/Internal/Exception.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Exception.hsc @@ -0,0 +1,13 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Exception where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/defines.h" +foreign import ccall unsafe "af_get_last_error" + af_get_last_error :: Ptr (Ptr CChar) -> Ptr DimT -> IO () +foreign import ccall unsafe "af_err_to_string" + af_err_to_string :: AFErr -> IO (Ptr CChar) diff --git a/src/ArrayFire/Internal/Features.hsc b/src/ArrayFire/Internal/Features.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Features.hsc @@ -0,0 +1,27 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Features where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/features.h" +foreign import ccall unsafe "af_create_features" + af_create_features :: Ptr AFFeatures -> DimT -> IO AFErr +foreign import ccall unsafe "af_retain_features" + af_retain_features :: Ptr AFFeatures -> AFFeatures -> IO AFErr +foreign import ccall unsafe "af_get_features_num" + af_get_features_num :: Ptr DimT -> AFFeatures -> IO AFErr +foreign import ccall unsafe "af_get_features_xpos" + af_get_features_xpos :: Ptr AFArray -> AFFeatures -> IO AFErr +foreign import ccall unsafe "af_get_features_ypos" + af_get_features_ypos :: Ptr AFArray -> AFFeatures -> IO AFErr +foreign import ccall unsafe "af_get_features_score" + af_get_features_score :: Ptr AFArray -> AFFeatures -> IO AFErr +foreign import ccall unsafe "af_get_features_orientation" + af_get_features_orientation :: Ptr AFArray -> AFFeatures -> IO AFErr +foreign import ccall unsafe "af_get_features_size" + af_get_features_size :: Ptr AFArray -> AFFeatures -> IO AFErr +foreign import ccall unsafe "&af_release_features" + af_release_features :: FunPtr (AFFeatures -> IO ()) diff --git a/src/ArrayFire/Internal/Graphics.hsc b/src/ArrayFire/Internal/Graphics.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Graphics.hsc @@ -0,0 +1,68 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Graphics where + +import ArrayFire.Internal.Defines +import ArrayFire.Internal.Types + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/graphics.h" +foreign import ccall unsafe "af_create_window" + af_create_window :: Ptr AFWindow -> CInt -> CInt -> Ptr CChar -> IO AFErr +foreign import ccall unsafe "af_set_position" + af_set_position :: AFWindow -> CUInt -> CUInt -> IO AFErr +foreign import ccall unsafe "af_set_title" + af_set_title :: AFWindow -> Ptr CChar -> IO AFErr +foreign import ccall unsafe "af_set_size" + af_set_size :: AFWindow -> CUInt -> CUInt -> IO AFErr +foreign import ccall unsafe "af_draw_image" + af_draw_image :: AFWindow -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_plot" + af_draw_plot :: AFWindow -> AFArray -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_plot3" + af_draw_plot3 :: AFWindow -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_plot_nd" + af_draw_plot_nd :: AFWindow -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_plot_2d" + af_draw_plot_2d :: AFWindow -> AFArray -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_plot_3d" + af_draw_plot_3d :: AFWindow -> AFArray -> AFArray -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_scatter" + af_draw_scatter :: AFWindow -> AFArray -> AFArray -> AFMarkerType -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_scatter3" + af_draw_scatter3 :: AFWindow -> AFArray -> AFMarkerType -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_scatter_nd" + af_draw_scatter_nd :: AFWindow -> AFArray -> AFMarkerType -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_scatter_2d" + af_draw_scatter_2d :: AFWindow -> AFArray -> AFArray -> AFMarkerType -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_scatter_3d" + af_draw_scatter_3d :: AFWindow -> AFArray -> AFArray -> AFArray -> AFMarkerType -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_hist" + af_draw_hist :: AFWindow -> AFArray -> Double -> Double -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_surface" + af_draw_surface :: AFWindow -> AFArray -> AFArray -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_vector_field_nd" + af_draw_vector_field_nd :: AFWindow -> AFArray -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_vector_field_3d" + af_draw_vector_field_3d :: AFWindow -> AFArray -> AFArray -> AFArray -> AFArray -> AFArray -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_draw_vector_field_2d" + af_draw_vector_field_2d :: AFWindow -> AFArray -> AFArray -> AFArray -> AFArray -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_grid" + af_grid :: AFWindow -> CInt -> CInt -> IO AFErr +foreign import ccall unsafe "af_set_axes_limits_compute" + af_set_axes_limits_compute :: AFWindow -> AFArray -> AFArray -> AFArray -> CBool -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_set_axes_limits_2d" + af_set_axes_limits_2d :: AFWindow -> Float -> Float -> Float -> Float -> CBool -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_set_axes_limits_3d" + af_set_axes_limits_3d :: AFWindow -> Float -> Float -> Float -> Float -> Float -> Float -> CBool -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_set_axes_titles" + af_set_axes_titles :: AFWindow -> Ptr CChar -> Ptr CChar -> Ptr CChar -> Ptr AFCell -> IO AFErr +foreign import ccall unsafe "af_show" + af_show :: AFWindow -> IO AFErr +foreign import ccall unsafe "af_is_window_closed" + af_is_window_closed :: Ptr CBool -> AFWindow -> IO AFErr +foreign import ccall unsafe "af_set_visibility" + af_set_visibility :: AFWindow -> CBool -> IO AFErr +foreign import ccall unsafe "af_destroy_window" + af_destroy_window :: AFWindow -> IO AFErr diff --git a/src/ArrayFire/Internal/Image.hsc b/src/ArrayFire/Internal/Image.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Image.hsc @@ -0,0 +1,99 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Image where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/image.h" +foreign import ccall unsafe "af_gradient" + af_gradient :: Ptr AFArray -> Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_load_image" + af_load_image :: Ptr AFArray -> Ptr CChar -> CBool -> IO AFErr +foreign import ccall unsafe "af_save_image" + af_save_image :: Ptr CChar -> AFArray -> IO AFErr +foreign import ccall unsafe "af_load_image_memory" + af_load_image_memory :: Ptr AFArray -> Ptr () -> IO AFErr +foreign import ccall unsafe "af_save_image_memory" + af_save_image_memory :: Ptr (Ptr ()) -> AFArray -> AFImageFormat -> IO AFErr +foreign import ccall unsafe "af_delete_image_memory" + af_delete_image_memory :: Ptr () -> IO AFErr +foreign import ccall unsafe "af_load_image_native" + af_load_image_native :: Ptr AFArray -> Ptr CChar -> IO AFErr +foreign import ccall unsafe "af_save_image_native" + af_save_image_native :: Ptr CChar -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_image_io_available" + af_is_image_io_available :: Ptr CBool -> IO AFErr +foreign import ccall unsafe "af_resize" + af_resize :: Ptr AFArray -> AFArray -> DimT -> DimT -> AFInterpType -> IO AFErr +foreign import ccall unsafe "af_transform" + af_transform :: Ptr AFArray -> AFArray -> AFArray -> DimT -> DimT -> AFInterpType -> CBool -> IO AFErr +foreign import ccall unsafe "af_transform_coordinates" + af_transform_coordinates :: Ptr AFArray -> AFArray -> Float -> Float -> IO AFErr +foreign import ccall unsafe "af_rotate" + af_rotate :: Ptr AFArray -> AFArray -> Float -> CBool -> AFInterpType -> IO AFErr +foreign import ccall unsafe "af_translate" + af_translate :: Ptr AFArray -> AFArray -> Float -> Float -> DimT -> DimT -> AFInterpType -> IO AFErr +foreign import ccall unsafe "af_scale" + af_scale :: Ptr AFArray -> AFArray -> Float -> Float -> DimT -> DimT -> AFInterpType -> IO AFErr +foreign import ccall unsafe "af_skew" + af_skew :: Ptr AFArray -> AFArray -> Float -> Float -> DimT -> DimT -> AFInterpType -> CBool -> IO AFErr +foreign import ccall unsafe "af_histogram" + af_histogram :: Ptr AFArray -> AFArray -> CUInt -> Double -> Double -> IO AFErr +foreign import ccall unsafe "af_dilate" + af_dilate :: Ptr AFArray -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_dilate3" + af_dilate3 :: Ptr AFArray -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_erode" + af_erode :: Ptr AFArray -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_erode3" + af_erode3 :: Ptr AFArray -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_bilateral" + af_bilateral :: Ptr AFArray -> AFArray -> Float -> Float -> CBool -> IO AFErr +foreign import ccall unsafe "af_mean_shift" + af_mean_shift :: Ptr AFArray -> AFArray -> Float -> Float -> CUInt -> CBool -> IO AFErr +foreign import ccall unsafe "af_minfilt" + af_minfilt :: Ptr AFArray -> AFArray -> DimT -> DimT -> AFBorderType -> IO AFErr +foreign import ccall unsafe "af_maxfilt" + af_maxfilt :: Ptr AFArray -> AFArray -> DimT -> DimT -> AFBorderType -> IO AFErr +foreign import ccall unsafe "af_regions" + af_regions :: Ptr AFArray -> AFArray -> AFConnectivity -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_sobel_operator" + af_sobel_operator :: Ptr AFArray -> Ptr AFArray -> AFArray -> CUInt -> IO AFErr +foreign import ccall unsafe "af_rgb2gray" + af_rgb2gray :: Ptr AFArray -> AFArray -> Float -> Float -> Float -> IO AFErr +foreign import ccall unsafe "af_gray2rgb" + af_gray2rgb :: Ptr AFArray -> AFArray -> Float -> Float -> Float -> IO AFErr +foreign import ccall unsafe "af_hist_equal" + af_hist_equal :: Ptr AFArray -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_gaussian_kernel" + af_gaussian_kernel :: Ptr AFArray -> CInt -> CInt -> Double -> Double -> IO AFErr +foreign import ccall unsafe "af_hsv2rgb" + af_hsv2rgb :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_rgb2hsv" + af_rgb2hsv :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_color_space" + af_color_space :: Ptr AFArray -> AFArray -> AFCSpace -> AFCSpace -> IO AFErr +foreign import ccall unsafe "af_unwrap" + af_unwrap :: Ptr AFArray -> AFArray -> DimT -> DimT -> DimT -> DimT -> DimT -> DimT -> CBool -> IO AFErr +foreign import ccall unsafe "af_wrap" + af_wrap :: Ptr AFArray -> AFArray -> DimT -> DimT -> DimT -> DimT -> DimT -> DimT -> DimT -> DimT -> CBool -> IO AFErr +foreign import ccall unsafe "af_sat" + af_sat :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_ycbcr2rgb" + af_ycbcr2rgb :: Ptr AFArray -> AFArray -> AFYccStd -> IO AFErr +foreign import ccall unsafe "af_rgb2ycbcr" + af_rgb2ycbcr :: Ptr AFArray -> AFArray -> AFYccStd -> IO AFErr +foreign import ccall unsafe "af_moments" + af_moments :: Ptr AFArray -> AFArray -> AFMomentType -> IO AFErr +foreign import ccall unsafe "af_moments_all" + af_moments_all :: Ptr Double -> AFArray -> AFMomentType -> IO AFErr +foreign import ccall unsafe "af_canny" + af_canny :: Ptr AFArray -> AFArray -> AFCannyThreshold -> Float -> Float -> CUInt -> CBool -> IO AFErr +foreign import ccall unsafe "af_anisotropic_diffusion" + af_anisotropic_diffusion :: Ptr AFArray -> AFArray -> Float -> Float -> CUInt -> AFFluxFunction -> AFDiffusionEq -> IO AFErr +foreign import ccall unsafe "af_iterative_deconv" + af_iterative_deconv :: Ptr AFArray -> AFArray -> AFArray -> CUInt -> Float -> AFIterativeDeconvAlgo -> IO AFErr +foreign import ccall unsafe "af_inverse_deconv" + af_inverse_deconv :: Ptr AFArray -> AFArray -> AFArray -> Float -> AFInverseDeconvAlgo -> IO AFErr diff --git a/src/ArrayFire/Internal/Index.hsc b/src/ArrayFire/Internal/Index.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Index.hsc @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Index where + +import ArrayFire.Internal.Defines +import ArrayFire.Internal.Types + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/index.h" +foreign import ccall unsafe "af_index" + af_index :: Ptr AFArray -> AFArray -> CUInt -> Ptr AFSeq -> IO AFErr +foreign import ccall unsafe "af_lookup" + af_lookup :: Ptr AFArray -> AFArray -> AFArray -> CUInt -> IO AFErr +foreign import ccall unsafe "af_assign_seq" + af_assign_seq :: Ptr AFArray -> AFArray -> CUInt -> Ptr AFSeq -> AFArray -> IO AFErr +foreign import ccall unsafe "af_index_gen" + af_index_gen :: Ptr AFArray -> AFArray -> DimT -> Ptr AFIndex -> IO AFErr +foreign import ccall unsafe "af_assign_gen" + af_assign_gen :: Ptr AFArray -> AFArray -> DimT -> Ptr AFIndex -> AFArray -> IO AFErr +foreign import ccall unsafe "af_create_indexers" + af_create_indexers :: Ptr (Ptr AFIndex) -> IO AFErr +foreign import ccall unsafe "af_set_array_indexer" + af_set_array_indexer :: Ptr AFIndex -> AFArray -> DimT -> IO AFErr +foreign import ccall unsafe "af_set_seq_indexer" + af_set_seq_indexer :: Ptr AFIndex -> Ptr AFSeq -> DimT -> CBool -> IO AFErr +foreign import ccall unsafe "af_set_seq_param_indexer" + af_set_seq_param_indexer :: Ptr AFIndex -> Double -> Double -> Double -> DimT -> CBool -> IO AFErr +foreign import ccall unsafe "af_release_indexers" + af_release_indexers :: Ptr AFIndex -> IO AFErr diff --git a/src/ArrayFire/Internal/Internal.hsc b/src/ArrayFire/Internal/Internal.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Internal.hsc @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Internal where + +import ArrayFire.Internal.Defines +import Foreign.Ptr +import Foreign.C.Types + +#include "af/internal.h" +foreign import ccall unsafe "af_create_strided_array" + af_create_strided_array :: Ptr AFArray -> Ptr () -> DimT -> CUInt -> Ptr DimT -> Ptr DimT -> AFDtype -> AFSource -> IO AFErr +foreign import ccall unsafe "af_get_strides" + af_get_strides :: Ptr DimT -> Ptr DimT -> Ptr DimT -> Ptr DimT -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_offset" + af_get_offset :: Ptr DimT -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_raw_ptr" + af_get_raw_ptr :: Ptr (Ptr ()) -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_linear" + af_is_linear :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_is_owner" + af_is_owner :: Ptr CBool -> AFArray -> IO AFErr +foreign import ccall unsafe "af_get_allocated_bytes" + af_get_allocated_bytes :: Ptr CSize -> AFArray -> IO AFErr diff --git a/src/ArrayFire/Internal/LAPACK.hsc b/src/ArrayFire/Internal/LAPACK.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/LAPACK.hsc @@ -0,0 +1,41 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.LAPACK where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/lapack.h" +foreign import ccall unsafe "af_svd" + af_svd :: Ptr AFArray -> Ptr AFArray -> Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_svd_inplace" + af_svd_inplace :: Ptr AFArray -> Ptr AFArray -> Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_lu" + af_lu :: Ptr AFArray -> Ptr AFArray -> Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_lu_inplace" + af_lu_inplace :: Ptr AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_qr" + af_qr :: Ptr AFArray -> Ptr AFArray -> Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_qr_inplace" + af_qr_inplace :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_cholesky" + af_cholesky :: Ptr AFArray -> Ptr CInt -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_cholesky_inplace" + af_cholesky_inplace :: Ptr CInt -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_solve" + af_solve :: Ptr AFArray -> AFArray -> AFArray -> AFMatProp -> IO AFErr +foreign import ccall unsafe "af_solve_lu" + af_solve_lu :: Ptr AFArray -> AFArray -> AFArray -> AFArray -> AFMatProp -> IO AFErr +foreign import ccall unsafe "af_inverse" + af_inverse :: Ptr AFArray -> AFArray -> AFMatProp -> IO AFErr +foreign import ccall unsafe "af_pinverse" + af_pinverse :: Ptr AFArray -> AFArray -> Double -> AFMatProp -> IO AFErr +foreign import ccall unsafe "af_rank" + af_rank :: Ptr CUInt -> AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_det" + af_det :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_norm" + af_norm :: Ptr Double -> AFArray -> AFNormType -> Double -> Double -> IO AFErr +foreign import ccall unsafe "af_is_lapack_available" + af_is_lapack_available :: Ptr CBool -> IO AFErr diff --git a/src/ArrayFire/Internal/Random.hsc b/src/ArrayFire/Internal/Random.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Random.hsc @@ -0,0 +1,39 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Random where + +import ArrayFire.Internal.Defines + +import Foreign.Ptr +import Foreign.C.Types + +#include "af/random.h" +foreign import ccall unsafe "af_create_random_engine" + af_create_random_engine :: Ptr AFRandomEngine -> AFRandomEngineType -> UIntL -> IO AFErr +foreign import ccall unsafe "af_retain_random_engine" + af_retain_random_engine :: Ptr AFRandomEngine -> AFRandomEngine -> IO AFErr +foreign import ccall unsafe "af_random_engine_set_type" + af_random_engine_set_type :: Ptr AFRandomEngine -> AFRandomEngineType -> IO AFErr +foreign import ccall unsafe "af_random_engine_get_type" + af_random_engine_get_type :: Ptr AFRandomEngineType -> AFRandomEngine -> IO AFErr +foreign import ccall unsafe "af_random_uniform" + af_random_uniform :: Ptr AFArray -> CUInt -> Ptr DimT -> AFDtype -> AFRandomEngine -> IO AFErr +foreign import ccall unsafe "af_random_normal" + af_random_normal :: Ptr AFArray -> CUInt -> Ptr DimT -> AFDtype -> AFRandomEngine -> IO AFErr +foreign import ccall unsafe "af_random_engine_set_seed" + af_random_engine_set_seed :: Ptr AFRandomEngine -> UIntL -> IO AFErr +foreign import ccall unsafe "af_get_default_random_engine" + af_get_default_random_engine :: Ptr AFRandomEngine -> IO AFErr +foreign import ccall unsafe "af_set_default_random_engine_type" + af_set_default_random_engine_type :: AFRandomEngineType -> IO AFErr +foreign import ccall unsafe "af_random_engine_get_seed" + af_random_engine_get_seed :: Ptr UIntL -> AFRandomEngine -> IO AFErr +foreign import ccall unsafe "af_release_random_engine" + af_release_random_engine :: AFRandomEngine -> IO AFErr +foreign import ccall unsafe "af_randu" + af_randu :: Ptr AFArray -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_randn" + af_randn :: Ptr AFArray -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr +foreign import ccall unsafe "af_set_seed" + af_set_seed :: UIntL -> IO AFErr +foreign import ccall unsafe "af_get_seed" + af_get_seed :: Ptr UIntL -> IO AFErr diff --git a/src/ArrayFire/Internal/Signal.hsc b/src/ArrayFire/Internal/Signal.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Signal.hsc @@ -0,0 +1,78 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Signal where + +import ArrayFire.Internal.Defines +import Foreign.Ptr +import Foreign.C.Types + +#include "af/signal.h" +foreign import ccall unsafe "af_approx1" + af_approx1 :: Ptr AFArray -> AFArray -> AFArray -> AFInterpType -> Float -> IO AFErr +foreign import ccall unsafe "af_approx2" + af_approx2 :: Ptr AFArray -> AFArray -> AFArray -> AFArray -> AFInterpType -> Float -> IO AFErr +foreign import ccall unsafe "af_approx1_uniform" + af_approx1_uniform :: Ptr AFArray -> AFArray -> AFArray -> CInt -> Double -> Double -> AFInterpType -> Float -> IO AFErr +foreign import ccall unsafe "af_approx2_uniform" + af_approx2_uniform :: Ptr AFArray -> AFArray -> AFArray -> CInt -> Double -> Double -> AFArray -> CInt -> Double -> Double -> AFInterpType -> Float -> IO AFErr +foreign import ccall unsafe "af_fft" + af_fft :: Ptr AFArray -> AFArray -> Double -> DimT -> IO AFErr +foreign import ccall unsafe "af_fft_inplace" + af_fft_inplace :: AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_fft2" + af_fft2 :: Ptr AFArray -> AFArray -> Double -> DimT -> DimT -> IO AFErr +foreign import ccall unsafe "af_fft2_inplace" + af_fft2_inplace :: AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_fft3" + af_fft3 :: Ptr AFArray -> AFArray -> Double -> DimT -> DimT -> DimT -> IO AFErr +foreign import ccall unsafe "af_fft3_inplace" + af_fft3_inplace :: AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_ifft" + af_ifft :: Ptr AFArray -> AFArray -> Double -> DimT -> IO AFErr +foreign import ccall unsafe "af_ifft_inplace" + af_ifft_inplace :: AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_ifft2" + af_ifft2 :: Ptr AFArray -> AFArray -> Double -> DimT -> DimT -> IO AFErr +foreign import ccall unsafe "af_ifft2_inplace" + af_ifft2_inplace :: AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_ifft3" + af_ifft3 :: Ptr AFArray -> AFArray -> Double -> DimT -> DimT -> DimT -> IO AFErr +foreign import ccall unsafe "af_ifft3_inplace" + af_ifft3_inplace :: AFArray -> Double -> IO AFErr +foreign import ccall unsafe "af_fft_r2c" + af_fft_r2c :: Ptr AFArray -> AFArray -> Double -> DimT -> IO AFErr +foreign import ccall unsafe "af_fft2_r2c" + af_fft2_r2c :: Ptr AFArray -> AFArray -> Double -> DimT -> DimT -> IO AFErr +foreign import ccall unsafe "af_fft3_r2c" + af_fft3_r2c :: Ptr AFArray -> AFArray -> Double -> DimT -> DimT -> DimT -> IO AFErr +foreign import ccall unsafe "af_fft_c2r" + af_fft_c2r :: Ptr AFArray -> AFArray -> Double -> CBool -> IO AFErr +foreign import ccall unsafe "af_fft2_c2r" + af_fft2_c2r :: Ptr AFArray -> AFArray -> Double -> CBool -> IO AFErr +foreign import ccall unsafe "af_fft3_c2r" + af_fft3_c2r :: Ptr AFArray -> AFArray -> Double -> CBool -> IO AFErr +foreign import ccall unsafe "af_convolve1" + af_convolve1 :: Ptr AFArray -> AFArray -> AFArray -> AFConvMode -> AFConvDomain -> IO AFErr +foreign import ccall unsafe "af_convolve2" + af_convolve2 :: Ptr AFArray -> AFArray -> AFArray -> AFConvMode -> AFConvDomain -> IO AFErr +foreign import ccall unsafe "af_convolve3" + af_convolve3 :: Ptr AFArray -> AFArray -> AFArray -> AFConvMode -> AFConvDomain -> IO AFErr +foreign import ccall unsafe "af_convolve2_sep" + af_convolve2_sep :: Ptr AFArray -> AFArray -> AFArray -> AFArray -> AFConvMode -> IO AFErr +foreign import ccall unsafe "af_fft_convolve1" + af_fft_convolve1 :: Ptr AFArray -> AFArray -> AFArray -> AFConvMode -> IO AFErr +foreign import ccall unsafe "af_fft_convolve2" + af_fft_convolve2 :: Ptr AFArray -> AFArray -> AFArray -> AFConvMode -> IO AFErr +foreign import ccall unsafe "af_fft_convolve3" + af_fft_convolve3 :: Ptr AFArray -> AFArray -> AFArray -> AFConvMode -> IO AFErr +foreign import ccall unsafe "af_fir" + af_fir :: Ptr AFArray -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_iir" + af_iir :: Ptr AFArray -> AFArray -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_medfilt" + af_medfilt :: Ptr AFArray -> AFArray -> DimT -> DimT -> AFBorderType -> IO AFErr +foreign import ccall unsafe "af_medfilt1" + af_medfilt1 :: Ptr AFArray -> AFArray -> DimT -> AFBorderType -> IO AFErr +foreign import ccall unsafe "af_medfilt2" + af_medfilt2 :: Ptr AFArray -> AFArray -> DimT -> DimT -> AFBorderType -> IO AFErr +foreign import ccall unsafe "af_set_fft_plan_cache_size" + af_set_fft_plan_cache_size :: CSize -> IO AFErr diff --git a/src/ArrayFire/Internal/Sparse.hsc b/src/ArrayFire/Internal/Sparse.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Sparse.hsc @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Sparse where + +import ArrayFire.Internal.Defines +import Foreign.Ptr +import Foreign.C.Types + +#include "af/sparse.h" +foreign import ccall unsafe "af_create_sparse_array" + af_create_sparse_array :: Ptr AFArray -> DimT -> DimT -> AFArray -> AFArray -> AFArray -> AFStorage -> IO AFErr +foreign import ccall unsafe "af_create_sparse_array_from_ptr" + af_create_sparse_array_from_ptr :: Ptr AFArray -> DimT -> DimT -> DimT -> Ptr () -> Ptr CInt -> Ptr CInt -> AFDtype -> AFStorage -> AFSource -> IO AFErr +foreign import ccall unsafe "af_create_sparse_array_from_dense" + af_create_sparse_array_from_dense :: Ptr AFArray -> AFArray -> AFStorage -> IO AFErr +foreign import ccall unsafe "af_sparse_convert_to" + af_sparse_convert_to :: Ptr AFArray -> AFArray -> AFStorage -> IO AFErr +foreign import ccall unsafe "af_sparse_to_dense" + af_sparse_to_dense :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sparse_get_info" + af_sparse_get_info :: Ptr AFArray -> Ptr AFArray -> Ptr AFArray -> Ptr AFStorage -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sparse_get_values" + af_sparse_get_values :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sparse_get_row_idx" + af_sparse_get_row_idx :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sparse_get_col_idx" + af_sparse_get_col_idx :: Ptr AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sparse_get_nnz" + af_sparse_get_nnz :: Ptr DimT -> AFArray -> IO AFErr +foreign import ccall unsafe "af_sparse_get_storage" + af_sparse_get_storage :: Ptr AFStorage -> AFArray -> IO AFErr diff --git a/src/ArrayFire/Internal/Statistics.hsc b/src/ArrayFire/Internal/Statistics.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Statistics.hsc @@ -0,0 +1,38 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Statistics where + +import ArrayFire.Internal.Defines +import Foreign.Ptr +import Foreign.C.Types + +#include "af/statistics.h" +foreign import ccall unsafe "af_mean" + af_mean :: Ptr AFArray -> AFArray -> DimT -> IO AFErr +foreign import ccall unsafe "af_mean_weighted" + af_mean_weighted :: Ptr AFArray -> AFArray -> AFArray -> DimT -> IO AFErr +foreign import ccall unsafe "af_var" + af_var :: Ptr AFArray -> AFArray -> CBool -> DimT -> IO AFErr +foreign import ccall unsafe "af_var_weighted" + af_var_weighted :: Ptr AFArray -> AFArray -> AFArray -> DimT -> IO AFErr +foreign import ccall unsafe "af_stdev" + af_stdev :: Ptr AFArray -> AFArray -> DimT -> IO AFErr +foreign import ccall unsafe "af_cov" + af_cov :: Ptr AFArray -> AFArray -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_median" + af_median :: Ptr AFArray -> AFArray -> DimT -> IO AFErr +foreign import ccall unsafe "af_mean_all" + af_mean_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_mean_all_weighted" + af_mean_all_weighted :: Ptr Double -> Ptr Double -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_var_all" + af_var_all :: Ptr Double -> Ptr Double -> AFArray -> CBool -> IO AFErr +foreign import ccall unsafe "af_var_all_weighted" + af_var_all_weighted :: Ptr Double -> Ptr Double -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_stdev_all" + af_stdev_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_median_all" + af_median_all :: Ptr Double -> Ptr Double -> AFArray -> IO AFErr +foreign import ccall unsafe "af_corrcoef" + af_corrcoef :: Ptr Double -> Ptr Double -> AFArray -> AFArray -> IO AFErr +foreign import ccall unsafe "af_topk" + af_topk :: Ptr AFArray -> Ptr AFArray -> AFArray -> CInt -> CInt -> AFTopkFunction -> IO AFErr diff --git a/src/ArrayFire/Internal/Types.hsc b/src/ArrayFire/Internal/Types.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Types.hsc @@ -0,0 +1,693 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Types where + +#include "af/seq.h" +#include "af/complex.h" +#include "af/graphics.h" +#include "af/index.h" + +import ArrayFire.Internal.Defines + +import Data.Complex +import Data.Proxy +import Data.Word +import Foreign.C.String +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Storable +import GHC.Int + +data AFSeq + = AFSeq + { afSeqBegin :: {-# UNPACK #-} !Double + , afSeqEnd :: {-# UNPACK #-} !Double + , afSeqStep :: {-# UNPACK #-} !Double + } deriving (Show, Eq) + +instance Storable AFSeq where + sizeOf _ = #{size af_seq} + alignment _ = #{alignment af_seq} + peek ptr = do + afSeqBegin <- #{peek af_seq, begin} ptr + afSeqEnd <- #{peek af_seq, end} ptr + afSeqStep <- #{peek af_seq, step} ptr + pure AFSeq {..} + poke ptr AFSeq{..} = do + #{poke af_seq, begin} ptr afSeqBegin + #{poke af_seq, end} ptr afSeqEnd + #{poke af_seq, step} ptr afSeqStep + +-- | Type used for indexing into 'Array' +data AFIndex + = AFIndex + { afIdx :: !(Either AFArray AFSeq) + , afIsSeq :: !Bool + , afIsBatch :: !Bool + } +instance Storable AFIndex where + sizeOf _ = #{size af_index_t} + alignment _ = #{alignment af_index_t} + peek ptr = do + afIsSeq <- #{peek af_index_t, isSeq} ptr + afIsBatch <- #{peek af_index_t, isBatch} ptr + afIdx <- + if afIsSeq + then Left <$> #{peek af_index_t, idx.arr} ptr + else Right <$> #{peek af_index_t, idx.seq} ptr + pure AFIndex{..} + poke ptr AFIndex{..} = do + case afIdx of + Left afarr -> #{poke af_index_t, idx.arr} ptr afarr + Right afseq -> #{poke af_index_t, idx.seq} ptr afseq + #{poke af_index_t, isSeq} ptr afIsSeq + #{poke af_index_t, isBatch} ptr afIsBatch + +data AFCFloat + = AFCFloat + { afcReal :: {-# UNPACK #-} !Float + , afcImag :: {-# UNPACK #-} !Float + } deriving (Eq, Show) + +instance Storable AFCFloat where + sizeOf _ = #{size af_cfloat} + alignment _ = #{alignment af_cfloat} + peek ptr = do + afcReal <- #{peek af_cfloat, real} ptr + afcImag <- #{peek af_cfloat, imag} ptr + pure AFCFloat{..} + poke ptr AFCFloat{..} = do + #{poke af_cfloat, real} ptr afcReal + #{poke af_cfloat, imag} ptr afcImag + +data AFCell + = AFCell + { afCellRow :: {-# UNPACK #-} !Int + , afCellCol :: {-# UNPACK #-} !Int + , afCellTitle :: {-# UNPACK #-} !CString + , afCellColorMap :: {-# UNPACK #-} !AFColorMap + } deriving (Show, Eq) + +instance Storable AFCell where + sizeOf _ = #{size af_cell} + alignment _ = #{alignment af_cell} + peek ptr = do + afCellRow <- #{peek af_cell, row} ptr + afCellCol <- #{peek af_cell, col} ptr + afCellTitle <- #{peek af_cell, title} ptr + afCellColorMap <- #{peek af_cell, cmap} ptr + pure AFCell{..} + poke ptr AFCell{..} = do + #{poke af_cell, row} ptr afCellRow + #{poke af_cell, col} ptr afCellCol + #{poke af_cell, title} ptr afCellTitle + #{poke af_cell, cmap} ptr afCellColorMap + +-- | ArrayFire 'Array' +newtype Array a = Array (ForeignPtr ()) + +-- | ArrayFire 'Features' +newtype Features = Features (ForeignPtr ()) + +-- | ArrayFire 'RandomEngine' +newtype RandomEngine = RandomEngine (ForeignPtr ()) + +-- | ArrayFire 'Window' +newtype Window = Window (ForeignPtr ()) + +-- | Mapping of Haskell types to ArrayFire types +class Storable a => AFType a where + afType :: Proxy a -> AFDtype + +instance AFType Double where + afType Proxy = f64 + +instance AFType Float where + afType Proxy = f32 + +instance AFType (Complex Double) where + afType Proxy = c64 + +instance AFType (Complex Float) where + afType Proxy = c32 + +instance AFType CBool where + afType Proxy = b8 + +instance AFType Int32 where + afType Proxy = s32 + +instance AFType Word32 where + afType Proxy = u32 + +instance AFType Word8 where + afType Proxy = u8 + +instance AFType Int64 where + afType Proxy = s64 + +instance AFType Int where + afType Proxy = s64 + +instance AFType Int16 where + afType Proxy = s16 + +instance AFType Word16 where + afType Proxy = u16 + +instance AFType Word64 where + afType Proxy = u64 + +instance AFType Word where + afType Proxy = u64 + +-- | ArrayFire backends +data Backend + = Default + | CPU + | CUDA + | OpenCL + deriving (Show, Eq, Ord) + +-- | Low-level to high-level Backend conversion +toBackend :: AFBackend -> Backend +toBackend (AFBackend 0) = Default +toBackend (AFBackend 1) = CPU +toBackend (AFBackend 2) = CUDA +toBackend (AFBackend 4) = OpenCL +toBackend (AFBackend x) = error $ "Invalid backend: " <> show x + +-- | High-level to low-level Backend conversion +toAFBackend :: Backend -> AFBackend +toAFBackend Default = (AFBackend 0) +toAFBackend CPU = (AFBackend 1) +toAFBackend CUDA = (AFBackend 2) +toAFBackend OpenCL = (AFBackend 4) + +-- | Read multiple backends +toBackends :: Int -> [Backend] +toBackends 1 = [CPU] +toBackends 2 = [CUDA] +toBackends 3 = [CPU,CUDA] +toBackends 4 = [OpenCL] +toBackends 5 = [CPU,OpenCL] +toBackends 6 = [CUDA,OpenCL] +toBackends 7 = [CPU,CUDA,OpenCL] +toBackends _ = [] + +-- | Matrix properties +data MatProp + = None + | Trans + | CTrans + | Conj + | Upper + | Lower + | DiagUnit + | Sym + | PosDef + | Orthog + | TriDiag + | BlockDiag + deriving (Show, Eq, Ord) + +-- | Low-level to High-level 'MatProp' conversion +fromMatProp + :: AFMatProp + -> MatProp +fromMatProp (AFMatProp 0) = None +fromMatProp (AFMatProp 1) = Trans +fromMatProp (AFMatProp 2) = CTrans +fromMatProp (AFMatProp 4) = Conj +fromMatProp (AFMatProp 32) = Upper +fromMatProp (AFMatProp 64) = Lower +fromMatProp (AFMatProp 128) = DiagUnit +fromMatProp (AFMatProp 512) = Sym +fromMatProp (AFMatProp 1024) = PosDef +fromMatProp (AFMatProp 2048) = Orthog +fromMatProp (AFMatProp 4096) = TriDiag +fromMatProp (AFMatProp 8192) = BlockDiag +fromMatProp x = error $ "Invalid AFMatProp value: " <> show x + +-- | High-level to low-level 'MatProp' conversion +toMatProp + :: MatProp + -> AFMatProp +toMatProp None = (AFMatProp 0) +toMatProp Trans = (AFMatProp 1) +toMatProp CTrans = (AFMatProp 2) +toMatProp Conj = (AFMatProp 4) +toMatProp Upper = (AFMatProp 32) +toMatProp Lower = (AFMatProp 64) +toMatProp DiagUnit = (AFMatProp 128) +toMatProp Sym = (AFMatProp 512) +toMatProp PosDef = (AFMatProp 1024) +toMatProp Orthog = (AFMatProp 2048) +toMatProp TriDiag = (AFMatProp 4096) +toMatProp BlockDiag = (AFMatProp 8192) + +-- | Binary operation support +data BinaryOp + = Add + | Mul + | Min + | Max + deriving (Show, Eq, Ord) + +-- | High-level to low-level 'MatProp' conversion +toBinaryOp :: BinaryOp -> AFBinaryOp +toBinaryOp Add = AFBinaryOp 0 +toBinaryOp Mul = AFBinaryOp 1 +toBinaryOp Min = AFBinaryOp 2 +toBinaryOp Max = AFBinaryOp 3 + +-- | 'BinaryOp' conversion helper +fromBinaryOp :: AFBinaryOp -> BinaryOp +fromBinaryOp (AFBinaryOp 0) = Add +fromBinaryOp (AFBinaryOp 1) = Mul +fromBinaryOp (AFBinaryOp 2) = Min +fromBinaryOp (AFBinaryOp 3) = Max +fromBinaryOp x = error ("Invalid Binary Op: " <> show x) + +-- | Storage type used for Sparse arrays +data Storage + = Dense + | CSR + | CSC + | COO + deriving (Show, Eq, Ord, Enum) + +toStorage :: Storage -> AFStorage +toStorage = AFStorage . fromIntegral . fromEnum + +fromStorage :: AFStorage -> Storage +fromStorage (AFStorage (fromIntegral -> x)) + | x `elem` [0..3] = toEnum x + | otherwise = error $ "Invalid Storage " <> (show x) + +-- | Type for different RandomEngines +data RandomEngineType + = Philox + | ThreeFry + | Mersenne + deriving (Eq, Show) + +toRandomEngine :: AFRandomEngineType -> RandomEngineType +toRandomEngine (AFRandomEngineType 100) = Philox +toRandomEngine (AFRandomEngineType 200) = ThreeFry +toRandomEngine (AFRandomEngineType 300) = Mersenne +toRandomEngine (AFRandomEngineType x) = + error ("Invalid random engine: " <> show x) + +fromRandomEngine :: RandomEngineType -> AFRandomEngineType +fromRandomEngine Philox = (AFRandomEngineType 100) +fromRandomEngine ThreeFry = (AFRandomEngineType 200) +fromRandomEngine Mersenne = (AFRandomEngineType 300) + +-- | Interpolation type +data InterpType + = Nearest + | Linear + | Bilinear + | Cubic + | LowerInterp + | LinearCosine + | BilinearCosine + | Bicubic + | CubicSpline + | BicubicSpline + deriving (Show, Eq, Ord, Enum) + +toInterpType :: AFInterpType -> InterpType +toInterpType (AFInterpType (fromIntegral -> x)) = toEnum x + +fromInterpType :: InterpType -> AFInterpType +fromInterpType = AFInterpType . fromIntegral . fromEnum + +-- | Border Type +data BorderType + = PadZero + | PadSym + deriving (Show, Ord, Enum, Eq) + +toBorderType :: AFBorderType -> BorderType +toBorderType (AFBorderType (fromIntegral -> x)) = toEnum x + +fromBorderType :: BorderType -> AFBorderType +fromBorderType = AFBorderType . fromIntegral . fromEnum + +-- | Connectivity Type +data Connectivity + = Conn4 + | Conn8 + deriving (Show, Ord, Enum, Eq) + +toConnectivity :: AFConnectivity -> Connectivity +toConnectivity (AFConnectivity 4) = Conn4 +toConnectivity (AFConnectivity 8) = Conn4 +toConnectivity (AFConnectivity x) = error ("Unknown connectivity option: " <> show x) + +fromConnectivity :: Connectivity -> AFConnectivity +fromConnectivity Conn4 = AFConnectivity 4 +fromConnectivity Conn8 = AFConnectivity 8 + +-- | Color Space type +data CSpace + = Gray + | RGB + | HSV + | YCBCR + deriving (Show, Eq, Ord, Enum) + +toCSpace :: AFCSpace -> CSpace +toCSpace (AFCSpace (fromIntegral -> x)) = toEnum x + +fromCSpace :: CSpace -> AFCSpace +fromCSpace = AFCSpace . fromIntegral . fromEnum + +-- | YccStd type +data YccStd + = Ycc601 + | Ycc709 + | Ycc2020 + deriving (Show, Eq, Ord) + +toAFYccStd :: AFYccStd -> YccStd +toAFYccStd (AFYccStd 601) = Ycc601 +toAFYccStd (AFYccStd 709) = Ycc709 +toAFYccStd (AFYccStd 2020) = Ycc2020 +toAFYccStd (AFYccStd x) = error ("Unknown AFYccStd option: " <> show x) + +fromAFYccStd :: YccStd -> AFYccStd +fromAFYccStd Ycc601 = afYcc601 +fromAFYccStd Ycc709 = afYcc709 +fromAFYccStd Ycc2020 = afYcc2020 + +-- | Moment types +data MomentType + = M00 + | M01 + | M10 + | M11 + | FirstOrder + deriving (Show, Eq, Ord) + +toMomentType :: AFMomentType -> MomentType +toMomentType x + | x == afMomentM00 = M00 + | x == afMomentM01 = M01 + | x == afMomentM10 = M10 + | x == afMomentM11 = M11 + | x == afMomentFirstOrder = FirstOrder + | otherwise = error ("Unknown moment type: " <> show x) + +fromMomentType :: MomentType -> AFMomentType +fromMomentType M00 = afMomentM00 +fromMomentType M01 = afMomentM01 +fromMomentType M10 = afMomentM10 +fromMomentType M11 = afMomentM11 +fromMomentType FirstOrder = afMomentFirstOrder + +-- | Canny Theshold type +data CannyThreshold + = Manual + | AutoOtsu + deriving (Show, Eq, Ord, Enum) + +toCannyThreshold :: AFCannyThreshold -> CannyThreshold +toCannyThreshold (AFCannyThreshold (fromIntegral -> x)) = toEnum x + +fromCannyThreshold :: CannyThreshold -> AFCannyThreshold +fromCannyThreshold = AFCannyThreshold . fromIntegral . fromEnum + +-- | Flux function type +data FluxFunction + = FluxDefault + | FluxQuadratic + | FluxExponential + deriving (Show, Eq, Ord, Enum) + +toFluxFunction :: AFFluxFunction -> FluxFunction +toFluxFunction (AFFluxFunction (fromIntegral -> x)) = toEnum x + +fromFluxFunction :: FluxFunction -> AFFluxFunction +fromFluxFunction = AFFluxFunction . fromIntegral . fromEnum + +-- | Diffusion type +data DiffusionEq + = DiffusionDefault + | DiffusionGrad + | DiffusionMCDE + deriving (Show, Eq, Ord, Enum) + +toDiffusionEq :: AFDiffusionEq -> DiffusionEq +toDiffusionEq (AFDiffusionEq (fromIntegral -> x)) = toEnum x + +fromDiffusionEq :: DiffusionEq -> AFDiffusionEq +fromDiffusionEq = AFDiffusionEq . fromIntegral . fromEnum + +-- | Iterative deconvolution algo type +data IterativeDeconvAlgo + = DeconvDefault + | DeconvLandweber + | DeconvRichardsonLucy + deriving (Show, Eq, Ord, Enum) + +toIterativeDeconvAlgo :: AFIterativeDeconvAlgo -> IterativeDeconvAlgo +toIterativeDeconvAlgo (AFIterativeDeconvAlgo (fromIntegral -> x)) = toEnum x + +fromIterativeDeconvAlgo :: IterativeDeconvAlgo -> AFIterativeDeconvAlgo +fromIterativeDeconvAlgo = AFIterativeDeconvAlgo . fromIntegral . fromEnum + +-- | Inverse deconvolution algo type +data InverseDeconvAlgo + = InverseDeconvDefault + | InverseDeconvTikhonov + deriving (Show, Eq, Ord, Enum) + +toInverseDeconvAlgo :: AFInverseDeconvAlgo -> InverseDeconvAlgo +toInverseDeconvAlgo (AFInverseDeconvAlgo (fromIntegral -> x)) = toEnum x + +fromInverseDeconvAlgo :: InverseDeconvAlgo -> AFInverseDeconvAlgo +fromInverseDeconvAlgo = AFInverseDeconvAlgo . fromIntegral . fromEnum + +-- | Cell type, used in Graphics module +data Cell + = Cell + { cellRow :: Int + , cellCol :: Int + , cellTitle :: String + , cellColorMap :: ColorMap + } deriving (Show, Eq) + +cellToAFCell :: Cell -> IO AFCell +cellToAFCell Cell {..} = + withCString cellTitle $ \cstr -> + pure AFCell { afCellRow = cellRow + , afCellCol = cellCol + , afCellTitle = cstr + , afCellColorMap = fromColorMap cellColorMap + } + +-- | ColorMap type +data ColorMap + = ColorMapDefault + | ColorMapSpectrum + | ColorMapColors + | ColorMapRed + | ColorMapMood + | ColorMapHeat + | ColorMapBlue + | ColorMapInferno + | ColorMapMagma + | ColorMapPlasma + | ColorMapViridis + deriving (Show, Eq, Ord, Enum) + +fromColorMap :: ColorMap -> AFColorMap +fromColorMap = AFColorMap . fromIntegral . fromEnum + +toColorMap :: AFColorMap -> ColorMap +toColorMap (AFColorMap (fromIntegral -> x)) = toEnum x + +-- | Marker type +data MarkerType + = MarkerTypeNone + | MarkerTypePoint + | MarkerTypeCircle + | MarkerTypeSquare + | MarkerTypeTriangle + | MarkerTypeCross + | MarkerTypePlus + | MarkerTypeStar + deriving (Show, Eq, Ord, Enum) + +fromMarkerType :: MarkerType -> AFMarkerType +fromMarkerType = AFMarkerType . fromIntegral . fromEnum + +toMarkerType :: AFMarkerType -> MarkerType +toMarkerType (AFMarkerType (fromIntegral -> x)) = toEnum x + +-- | Match type +data MatchType + = MatchTypeSAD + | MatchTypeZSAD + | MatchTypeLSAD + | MatchTypeSSD + | MatchTypeZSSD + | MatchTypeLSSD + | MatchTypeNCC + | MatchTypeZNCC + | MatchTypeSHD + deriving (Show, Eq, Ord, Enum) + +fromMatchType :: MatchType -> AFMatchType +fromMatchType = AFMatchType . fromIntegral . fromEnum + +toMatchType :: AFMatchType -> MatchType +toMatchType (AFMatchType (fromIntegral -> x)) = toEnum x + +-- | TopK type +data TopK + = TopKDefault + | TopKMin + | TopKMax + deriving (Show, Eq, Ord, Enum) + +fromTopK :: TopK -> AFTopkFunction +fromTopK = AFTopkFunction . fromIntegral . fromEnum + +toTopK :: AFTopkFunction -> TopK +toTopK (AFTopkFunction (fromIntegral -> x)) = toEnum x + +-- | Homography Type +data HomographyType + = RANSAC + | LMEDS + deriving (Show, Eq, Ord, Enum) + +fromHomographyType :: HomographyType -> AFHomographyType +fromHomographyType = AFHomographyType . fromIntegral . fromEnum + +toHomographyType :: AFHomographyType -> HomographyType +toHomographyType (AFHomographyType (fromIntegral -> x)) = toEnum x + +-- | Sequence Type +data Seq + = Seq + { seqBegin :: !Double + , seqEnd :: !Double + , seqStep :: !Double + } deriving (Show, Eq, Ord) + +toAFSeq :: Seq -> AFSeq +toAFSeq (Seq x y z) = (AFSeq x y z) + +-- | Index Type +data Index a + = Index + { idx :: Either (Array a) Seq + , isSeq :: !Bool + , isBatch :: !Bool + } + +seqIdx :: Seq -> Bool -> Index a +seqIdx s = Index (Right s) True + +arrIdx :: Array a -> Bool -> Index a +arrIdx a = Index (Left a) False + +toAFIndex :: Index a -> IO AFIndex +toAFIndex (Index a b c) = do + case a of + Right s -> pure $ AFIndex (Right (toAFSeq s)) b c + Left (Array fptr) -> do + withForeignPtr fptr $ \ptr -> + pure $ AFIndex (Left ptr) b c + + +-- | Type alias for ArrayFire API version +type Version = (Int,Int,Int) + +-- | Norm Type +data NormType + = NormVectorOne + -- ^ treats the input as a vector and returns the sum of absolute values + | NormVectorInf + -- ^ treats the input as a vector and returns the max of absolute values + | NormVector2 + -- ^ treats the input as a vector and returns euclidean norm + | NormVectorP + -- ^ treats the input as a vector and returns the p-norm + | NormMatrix1 + -- ^ return the max of column sums + | NormMatrixInf + -- ^ return the max of row sums + | NormMatrix2 + -- ^ returns the max singular value). Currently NOT SUPPORTED + | NormMatrixLPQ + -- ^ returns Lpq-norm + | NormEuclid + -- ^ The default. Same as AF_NORM_VECTOR_2 + deriving (Show, Eq, Enum) + +fromNormType :: NormType -> AFNormType +fromNormType = AFNormType . fromIntegral . fromEnum + +toNormType :: AFNormType -> NormType +toNormType (AFNormType (fromIntegral -> x)) = toEnum x + +-- | Convolution Domain +data ConvDomain + = ConvDomainAuto + -- ^ ArrayFire automatically picks the right convolution algorithm + | ConvDomainSpatial + -- ^ Perform convolution in spatial domain + | ConvDomainFreq + -- ^ Perform convolution in frequency domain + deriving (Show, Eq, Enum) + +-- | Convolution Mode +data ConvMode + = ConvDefault + -- ^ Output of the convolution is the same size as input + | ConvExpand + -- ^ Output of the convolution is signal_len + filter_len - 1 + deriving (Show, Eq, Enum) + +fromConvDomain :: ConvDomain -> AFConvDomain +fromConvDomain = AFConvDomain . fromIntegral . fromEnum + +toConvDomain :: AFConvDomain -> ConvDomain +toConvDomain (AFConvDomain (fromIntegral -> x)) = toEnum x + +fromConvMode :: AFConvMode -> ConvMode +fromConvMode (AFConvMode (fromIntegral -> x)) = toEnum x + +toConvMode :: ConvMode -> AFConvMode +toConvMode = AFConvMode . fromIntegral . fromEnum + +-- | Array Fire types +data AFDType + = F32 + | C32 + | F64 + | C64 + | B8 + | S32 + | U32 + | U8 + | S64 + | U64 + | S16 + | U16 + deriving (Show, Eq, Enum) + +fromAFType :: AFDtype -> AFDType +fromAFType (AFDtype (fromIntegral -> x)) = toEnum x + +toAFType :: AFDType -> AFDtype +toAFType = AFDtype . fromIntegral . fromEnum + diff --git a/src/ArrayFire/Internal/Util.hsc b/src/ArrayFire/Internal/Util.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Util.hsc @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Util where + +import ArrayFire.Internal.Defines +import Foreign.Ptr +import Foreign.C.Types + +#include "af/util.h" +foreign import ccall unsafe "af_print_array" + af_print_array :: AFArray -> IO AFErr +foreign import ccall unsafe "af_print_array_gen" + af_print_array_gen :: Ptr CChar -> AFArray -> CInt -> IO AFErr +foreign import ccall unsafe "af_save_array" + af_save_array :: Ptr CInt -> Ptr CChar -> AFArray -> Ptr CChar -> CBool -> IO AFErr +foreign import ccall unsafe "af_read_array_index" + af_read_array_index :: Ptr AFArray -> Ptr CChar -> CUInt -> IO AFErr +foreign import ccall unsafe "af_read_array_key" + af_read_array_key :: Ptr AFArray -> Ptr CChar -> Ptr CChar -> IO AFErr +foreign import ccall unsafe "af_read_array_key_check" + af_read_array_key_check :: Ptr CInt -> Ptr CChar -> Ptr CChar -> IO AFErr +foreign import ccall unsafe "af_array_to_string" + af_array_to_string :: Ptr (Ptr CChar) -> Ptr CChar -> AFArray -> CInt -> CBool -> IO AFErr +foreign import ccall unsafe "af_example_function" + af_example_function :: Ptr AFArray -> AFArray -> AFSomeEnum -> IO AFErr +foreign import ccall unsafe "af_get_version" + af_get_version :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO AFErr +foreign import ccall unsafe "af_get_revision" + af_get_revision :: IO (Ptr CChar) +foreign import ccall unsafe "af_get_size_of" + af_get_size_of :: Ptr CSize -> AFDtype -> IO AFErr diff --git a/src/ArrayFire/Internal/Vision.hsc b/src/ArrayFire/Internal/Vision.hsc new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Internal/Vision.hsc @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Vision where + +import ArrayFire.Internal.Defines +import Foreign.Ptr +import Foreign.C.Types + +#include "af/vision.h" +foreign import ccall unsafe "af_fast" + af_fast :: Ptr AFFeatures -> AFArray -> Float -> CUInt -> CBool -> Float -> CUInt -> IO AFErr +foreign import ccall unsafe "af_harris" + af_harris :: Ptr AFFeatures -> AFArray -> CUInt -> Float -> Float -> CUInt -> Float -> IO AFErr +foreign import ccall unsafe "af_orb" + af_orb :: Ptr AFFeatures -> Ptr AFArray -> AFArray -> Float -> CUInt -> Float -> CUInt -> CBool -> IO AFErr +foreign import ccall unsafe "af_sift" + af_sift :: Ptr AFFeatures -> Ptr AFArray -> AFArray -> CUInt -> Float -> Float -> Float -> CBool -> Float -> Float -> IO AFErr +foreign import ccall unsafe "af_gloh" + af_gloh :: Ptr AFFeatures -> Ptr AFArray -> AFArray -> CUInt -> Float -> Float -> Float -> CBool -> Float -> Float -> IO AFErr +foreign import ccall unsafe "af_hamming_matcher" + af_hamming_matcher :: Ptr AFArray -> Ptr AFArray -> AFArray -> AFArray -> DimT -> CUInt -> IO AFErr +foreign import ccall unsafe "af_nearest_neighbour" + af_nearest_neighbour :: Ptr AFArray -> Ptr AFArray -> AFArray -> AFArray -> DimT -> CUInt -> AFMatchType -> IO AFErr +foreign import ccall unsafe "af_match_template" + af_match_template :: Ptr AFArray -> AFArray -> AFArray -> AFMatchType -> IO AFErr +foreign import ccall unsafe "af_susan" + af_susan :: Ptr AFFeatures -> AFArray -> CUInt -> Float -> Float -> Float -> CUInt -> IO AFErr +foreign import ccall unsafe "af_dog" + af_dog :: Ptr AFArray -> AFArray -> CInt -> CInt -> IO AFErr +foreign import ccall unsafe "af_homography" + af_homography :: Ptr AFArray -> Ptr CInt -> AFArray -> AFArray -> AFArray -> AFArray -> AFHomographyType -> Float -> CUInt -> AFDtype -> IO AFErr diff --git a/src/ArrayFire/LAPACK.hs b/src/ArrayFire/LAPACK.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/LAPACK.hs @@ -0,0 +1,271 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.LAPACK +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-------------------------------------------------------------------------------- +module ArrayFire.LAPACK where + +import ArrayFire.Internal.LAPACK +import ArrayFire.FFI +import ArrayFire.Types +import ArrayFire.Internal.Types + +-- | Singular Value Decomposition +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__svd.htm) +-- +-- The arrayfire function only returns the non zero diagonal elements of S. +-- +svd + :: AFType a + => Array a + -- ^ the input Matrix + -> (Array a, Array a, Array a) + -- ^ Output 'Array' containing (U, diagonal values of sigma, V^H) +svd = (`op3p` af_svd) + +-- | Singular Value Decomposition (in-place) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__svd.htm) +-- +-- The arrayfire function only returns the non zero diagonal elements of S. +-- +svdInPlace + :: AFType a + => Array a + -- ^ the input matrix + -> (Array a, Array a, Array a) + -- ^ Output 'Array' containing (U, diagonal values of sigma, V^H) +svdInPlace = (`op3p` af_svd_inplace) + +-- | Perform LU decomposition +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__lu.htm) +-- +-- C Interface for LU decomposition. +-- +lu + :: AFType a + => Array a + -- ^ is the input matrix + -> (Array a, Array a, Array a) + -- ^ Returns the output 'Array's (lower, upper, pivot) +lu = (`op3p` af_lu) + +-- | Perform LU decomposition (in-place). +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__lu.htm#ga0adcdc4b189c34644a7153c6ce9c4f7f) +-- +-- C Interface for in place LU decomposition. +-- +luInPlace + :: AFType a + => Array a + -- ^ contains the input on entry, the packed LU decomposition on exit. + -> Bool + -- ^ specifies if the pivot is returned in original LAPACK compliant format + -> Array a + -- ^ will contain the permutation indices to map the input to the decomposition +luInPlace a (fromIntegral . fromEnum -> b) = a `op1` (\x y -> af_lu_inplace x y b) + +-- | Perform QR decomposition +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__qr.htm) +-- +-- C Interface for QR decomposition. +-- +qr + :: AFType a + => Array a + -- ^ the input matrix + -> (Array a, Array a, Array a) + -- ^ Returns (q, r, tau) 'Array's + -- /q/ is the orthogonal matrix from QR decomposition + -- /r/ is the upper triangular matrix from QR decomposition + -- /tau/ will contain additional information needed for solving a least squares problem using /q/ and /r/ +qr = (`op3p` af_qr) + +-- | Perform QR decomposition +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__qr.htm) +-- +-- C Interface for QR decomposition. +-- +qrInPlace + :: AFType a + => Array a + -- ^ is the input matrix on entry. It contains packed QR decomposition on exit + -> Array a + -- ^ will contain additional information needed for unpacking the data +qrInPlace = (`op1` af_qr_inplace) + +-- | Perform Cholesky Decomposition +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__cholesky.htm) +-- +-- This function decomposes a positive definite matrix A into two triangular matrices. +-- +cholesky + :: AFType a + => Array a + -- ^ input 'Array' + -> Bool + -- ^ a boolean determining if out is upper or lower triangular + -> (Int, Array a) + -- ^ contains the triangular matrix. Multiply 'Int' with its conjugate transpose reproduces the input array. + -- is 0 if cholesky decomposition passes, if not it returns the rank at which the decomposition failed. +cholesky a (fromIntegral . fromEnum -> b) = do + let (x',y') = op1b a (\x y z -> af_cholesky x y z b) + (fromIntegral x', y') + +-- | Perform Cholesky Decomposition +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__cholesky.htm) +-- +-- C Interface for in place cholesky decomposition. +-- +choleskyInplace + :: AFType a + => Array a + -- ^ is the input matrix on entry. It contains the triangular matrix on exit. + -> Bool + -- ^ a boolean determining if in is upper or lower triangular + -> Int + -- ^ is 0 if cholesky decomposition passes, if not it returns the rank at which the decomposition failed. +choleskyInplace a (fromIntegral . fromEnum -> b) = + fromIntegral $ infoFromArray a (\x y -> af_cholesky_inplace x y b) + +-- | Solve a system of equations +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__solve__func__gen.htm) +-- +solve + :: AFType a + => Array a + -- ^ is the coefficient matrix + -> Array a + -- ^ is the measured values + -> MatProp + -- ^ determining various properties of matrix a + -> Array a + -- ^ is the matrix of unknown variables +solve a b m = + op2 a b (\x y z -> af_solve x y z (toMatProp m)) + +-- | Solve a system of equations. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__solve__lu__func__gen.htm) +-- +solveLU + :: AFType a + => Array a + -- ^ is the output matrix from packed LU decomposition of the coefficient matrix + -> Array a + -- ^ is the pivot array from packed LU decomposition of the coefficient matrix + -> Array a + -- ^ is the matrix of measured values + -> MatProp + -- ^ determining various properties of matrix a + -> Array a + -- ^ will contain the matrix of unknown variables +solveLU a b c m = + op3 a b c (\x y z w -> af_solve_lu x y z w (toMatProp m)) + +-- | Invert a matrix. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__ops__func__inv.htm) +-- +-- C Interface for inverting a matrix. +-- +inverse + :: AFType a + => Array a + -- ^ is input matrix + -> MatProp + -- ^ determining various properties of matrix in + -> Array a + -- ^ will contain the inverse of matrix in +inverse a m = + a `op1` (\x y -> af_inverse x y (toMatProp m)) + +-- | Pseudo-inverse +-- +-- Not implemented in /3.6.4/ +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__p_inv.htm) +-- +pinverse + :: AFType a + => Array a + -> Double + -> MatProp + -> Array a +pinverse a d m = + a `op1` (\x y -> af_pinverse x y d (toMatProp m)) + +-- | Find the rank of the input matrix +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__factor__func__rank.htm) +-- +-- This function uses af::qr to find the rank of the input matrix within the given tolerance. +-- +rank + :: AFType a + => Array a + -- ^ is input matrix + -> Double + -- ^ is the tolerance value + -> Int + -- ^ will contain the rank of in +rank a b = + fromIntegral (a `infoFromArray` (\x y -> af_rank x y b)) + +-- | Find the determinant of a Matrix +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__ops__func__det.htm) +-- +-- C Interface for finding the determinant of a matrix. +-- +det + :: AFType a + => Array a + -- ^ is input matrix + -> (Double,Double) + -- ^ will contain the real and imaginary part of the determinant of in +det = (`infoFromArray2` af_det) + +-- | Find the norm of the input matrix. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__ops__func__norm.htm) +-- +-- This function can return the norm using various metrics based on the type paramter. +-- +norm + :: AFType a + => Array a + -- ^ is the input matrix + -> NormType + -- ^ specifies the 'NormType' + -> Double + -- ^ specifies the value of P when type is one of AF_NORM_VECTOR_P, AF_NORM_MATRIX_L_PQ is used. It is ignored for other values of type + -> Double + -- ^ specifies the value of Q when type is AF_NORM_MATRIX_L_PQ. This parameter is ignored if type is anything else + -> Double + -- ^ will contain the norm of in +norm arr (fromNormType -> a) b c = + arr `infoFromArray` (\w y -> af_norm w y a b c) + +-- | Is LAPACK available +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__lapack__helper__func__available.htm) +-- +isLAPACKAvailable + :: Bool + -- ^ Returns if LAPACK is available +isLAPACKAvailable = + toEnum . fromIntegral $ afCall1' af_is_lapack_available diff --git a/src/ArrayFire/Orphans.hs b/src/ArrayFire/Orphans.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Orphans.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Orphans +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-------------------------------------------------------------------------------- +module ArrayFire.Orphans where + +import Prelude + +import qualified ArrayFire.Arith as A +import qualified ArrayFire.Array as A +import qualified ArrayFire.Data as A +import ArrayFire.Types +import ArrayFire.Util +import Foreign.C + +instance (AFType a, Eq a) => Eq (Array a) where + x == y = toEnum . fromIntegral $ A.getScalar @CBool @a $! A.eq x y + x /= y = toEnum . fromIntegral $ A.getScalar @CBool @a $! A.neq x y + +instance (Num a, AFType a) => Num (Array a) where + x + y = A.add x y + x * y = A.mul x y + abs = A.abs + signum = A.sign + negate arr = do + let (w,x,y,z) = A.getDims arr + A.cast (A.constant @a [w,x,y,z] 0) `A.sub` arr + x - y = A.sub x y + fromInteger = A.scalar . fromIntegral + +instance (Ord a, AFType a) => Ord (Array a) where + x < y = toEnum . fromIntegral $ A.getScalar @CBool @a (A.lt x y) + x > y = toEnum . fromIntegral $ A.getScalar @CBool @a (A.gt x y) + x <= y = toEnum . fromIntegral $ A.getScalar @CBool @a (A.le x y) + x >= y = toEnum . fromIntegral $ A.getScalar @CBool @a (A.ge x y) + +instance Show (Array a) where + show = arrayString + +instance forall a . (Fractional a, AFType a) => Fractional (Array a) where + x / y = A.div x y + fromRational n = A.scalar @a (fromRational n) + +instance forall a . (Ord a, AFType a, Fractional a) => Floating (Array a) where + pi = A.scalar @a 3.14159 + exp = A.exp @a + log = A.log @a + sin = A.sin @a + cos = A.cos @a + asin = A.asin @a + acos = A.acos @a + atan = A.atan @a + sinh = A.sinh @a + cosh = A.cosh @a + acosh = A.acosh @a + atanh = A.atanh @a + asinh = A.asinh @a diff --git a/src/ArrayFire/Random.hs b/src/ArrayFire/Random.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Random.hs @@ -0,0 +1,343 @@ +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE KindSignatures #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Random +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- 'RandomEngine' generation, Random 'Array' generation. +-- +-- @ +-- {-\# LANGUAGE TypeApplications \#-} +-- module Main where +-- +-- import ArrayFire +-- +-- main :: IO () +-- main = do +-- seed <- 'getSeed' +-- -- ^ Retrieves seed +-- engine <- 'createRandomEngine' 'Mersenne' seed +-- -- ^ Creates engine +-- array <- 'randomUniform' [3,3] engine +-- -- ^ Creates random Array from engine with uniformly distributed data +-- print array +-- +-- print =<< 'randu' @'Double' [2,2] +-- -- ^ Shorthand for creating random 'Array' +-- @ +-- @ +-- ArrayFire 'Array' +-- [3 3 1 1] +-- 0.4446 0.1143 0.4283 +-- 0.5725 0.1456 0.9182 +-- 0.1915 0.1643 0.5997 +-- @ +-- @ +-- ArrayFire 'Array' +-- [2 2 1 1] +-- 0.6010 0.0278 +-- 0.9806 0.2126 +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Random + ( createRandomEngine + , retainRandomEngine + , setRandomEngine + , getRandomEngineType + , randomEngineSetSeed + , getDefaultRandomEngine + , setDefaultRandomEngineType + , randomEngineGetSeed + , setSeed + , getSeed + , randn + , randu + , randomUniform + , randomNormal + ) where + +import Control.Exception +import Data.Proxy +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal hiding (void) +import Foreign.Ptr +import Foreign.Storable + +import ArrayFire.Exception +import ArrayFire.Internal.Types +import ArrayFire.Internal.Defines +import ArrayFire.Internal.Random +import ArrayFire.FFI + +-- | Create random number generator object. +-- +-- @ +-- >>> engine <- createRandomEngine 100 Philox +-- @ +createRandomEngine + :: Int + -- ^ Initial seed value of random number generator + -> RandomEngineType + -- ^ Type of random engine to employ + -> IO RandomEngine + -- ^ Opaque RandomEngine handle +createRandomEngine (fromIntegral -> n) typ = + mask_ $ do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< af_create_random_engine ptrInput (fromRandomEngine typ) n + peek ptrInput + fptr <- newForeignPtr af_release_random_engine_finalizer ptr + pure (RandomEngine fptr) + +-- | Retains 'RandomEngine' reference +-- +-- @ +-- >>> nextEngine <- retainRandomEngine engine +-- @ +retainRandomEngine + :: RandomEngine + -- ^ 'RandomEngine' to retain + -> IO RandomEngine + -- ^ Retained 'RandomEngine' +retainRandomEngine = + (`op1re` af_retain_random_engine) + +foreign import ccall unsafe "af_random_engine_set_type_" + af_random_engine_set_type_ :: AFRandomEngine -> AFRandomEngineType -> IO AFErr + +-- | Sets RandomEngine to a new 'RandomEngineType' +-- +-- @ +-- >>> setRandomEngine engine Philox +-- @ +setRandomEngine + :: RandomEngine + -- ^ 'RandomEngine' as input + -> RandomEngineType + -- ^ 'RandomEngineType' to set 'RandomEngine' to + -> IO () +setRandomEngine r t = + r `inPlaceEng` (`af_random_engine_set_type_` (fromRandomEngine t)) + +-- | Retrieves 'RandomEngine' +-- +-- @ +-- >>> randomEngineType <- getRandomEngineType engine +-- @ +getRandomEngineType + :: RandomEngine + -- ^ 'RandomEngine' argument + -> IO RandomEngineType + -- ^ 'RandomEngineType' returned +getRandomEngineType r = + toRandomEngine <$> + r `infoFromRandomEngine` af_random_engine_get_type + +foreign import ccall unsafe "af_random_engine_set_seed_" + af_random_engine_set_seed_ :: AFRandomEngine -> IntL -> IO AFErr + +-- | Sets seed on 'RandomEngine' +-- +-- @ +-- >>> randomEngineSetSeed engine 100 +-- @ +randomEngineSetSeed + :: RandomEngine + -- ^ 'RandomEngine' argument + -> Int + -- ^ Seed + -> IO () +randomEngineSetSeed r t = + r `inPlaceEng` (`af_random_engine_set_seed_` (fromIntegral t)) + +-- | Retrieve default 'RandomEngine' +-- +-- @ +-- >>> engine <- getDefaultRandomEngine +-- @ +getDefaultRandomEngine + :: IO RandomEngine +getDefaultRandomEngine = + mask_ $ do + ptr <- + alloca $ \ptrInput -> do + throwAFError =<< af_get_default_random_engine ptrInput + peek ptrInput + fptr <- newForeignPtr af_release_random_engine_finalizer ptr + pure (RandomEngine fptr) + +-- | Set defualt 'RandomEngine' type +-- +-- @ +-- >>> setDefaultRandomEngineType Philox +-- @ +setDefaultRandomEngineType + :: RandomEngineType + -- ^ 'RandomEngine' type + -> IO () +setDefaultRandomEngineType n = + afCall (af_set_default_random_engine_type (fromRandomEngine n)) + +-- | Retrieve seed of 'RandomEngine' +-- +-- @ +-- >>> seed <- randomEngineGetSeed engine +-- @ +randomEngineGetSeed + :: RandomEngine + -- ^ RandomEngine argument + -> IO Int +randomEngineGetSeed r = + fromIntegral <$> + r `infoFromRandomEngine` af_random_engine_get_seed + +-- | Set random seed +-- +-- @ +-- >>> setSeed 100 +-- @ +setSeed :: Int -> IO () +setSeed = afCall . af_set_seed . fromIntegral + +-- | Retrieve random seed +-- +-- @ +-- >>> seed <- getSeed +-- @ +getSeed :: IO Int +getSeed = fromIntegral <$> afCall1 af_get_seed + +randEng + :: forall a . AFType a + => [Int] + -> (Ptr AFArray -> CUInt -> Ptr DimT -> AFDtype -> AFRandomEngine -> IO AFErr) + -> RandomEngine + -> IO (Array a) +randEng dims f (RandomEngine fptr) = mask_ $ + withForeignPtr fptr $ \rptr -> do + ptr <- alloca $ \ptrPtr -> do + withArray (fromIntegral <$> dims) $ \dimArray -> do + throwAFError =<< f ptrPtr n dimArray typ rptr + peek ptrPtr + Array <$> + newForeignPtr + af_release_array_finalizer + ptr + where + n = fromIntegral (length dims) + typ = afType (Proxy @ a) + +rand + :: forall a . AFType a + => [Int] + -- ^ Dimensions + -> (Ptr AFArray -> CUInt -> Ptr DimT -> AFDtype -> IO AFErr) + -> IO (Array a) +rand dims f = mask_ $ do + ptr <- alloca $ \ptrPtr -> do + zeroOutArray ptrPtr + withArray (fromIntegral <$> dims) $ \dimArray -> do + throwAFError =<< f ptrPtr n dimArray typ + peek ptrPtr + Array <$> + newForeignPtr + af_release_array_finalizer + ptr + where + n = fromIntegral (length dims) + typ = afType (Proxy @ a) + +-- | Generate random 'Array' +-- +-- >>> randn @Double [2,2] +-- +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- 0.9428 -0.9523 +-- -1.0564 -0.4199 +-- @ +-- +randn + :: forall a + . (AFType a, Fractional a) + => [Int] + -- ^ Dimensions of random array + -> IO (Array a) +randn dims = rand @a dims af_randn + +-- | Generate random uniform 'Array' +-- +-- >>> randu @Double [2,2] +-- +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- 0.6010 0.0278 +-- 0.9806 0.2126 +-- @ +-- +randu + :: forall a . AFType a + => [Int] + -- ^ Dimensions of random array + -> IO (Array a) +randu dims = rand @a dims af_randu + +-- | Generate random uniform 'Array' +-- +-- >>> randonUniform @Double [2,2] =<< getDefaultRandomEngine +-- +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- 0.0655 0.5497 +-- 0.2864 0.3410 +-- @ +-- +randomUniform + :: forall a . AFType a + => [Int] + -- ^ Dimensions of random array + -> RandomEngine + -- ^ 'RandomEngine' argument + -> IO (Array a) +randomUniform dims eng = + randEng @a dims af_random_uniform eng + +-- | Generate random uniform 'Array' +-- +-- >>> randonNormal @Double [2,2] =<< getDefaultRandomEngine +-- +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- -1.1850 -0.2946 +-- -0.7206 -0.6813 +-- @ +-- +randomNormal + :: forall a + . AFType a + => [Int] + -- ^ Dimensions of random array + -> RandomEngine + -- ^ 'RandomEngine' argument + -> IO (Array a) +randomNormal dims eng = + randEng @a dims af_random_normal eng diff --git a/src/ArrayFire/Signal.hs b/src/ArrayFire/Signal.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Signal.hs @@ -0,0 +1,728 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Signal +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft.htm) +-- +-------------------------------------------------------------------------------- +module ArrayFire.Signal where + +import Data.Complex + +import ArrayFire.FFI +import ArrayFire.Internal.Signal +import ArrayFire.Internal.Types + +-- | 'approx1' interpolates data along the first dimensions +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__approx1.htm) +-- +-- Interpolation is performed assuming input data is equally spaced with indices in the range [0, n). The positions are sampled with respect to data at these locations. +-- +-- >>> input = vector 3 [10,20,30] +-- >>> positions = vector 5 [0.0, 0.5, 1.0, 1.5, 2.0] +-- >>> approx1 @Double input positions Cubic 0.0 +-- ArrayFire Array +-- [5 1 1 1] +-- 10.0000 13.7500 20.0000 26.2500 30.0000 +-- +approx1 + :: AFType a + => Array a + -- ^ the input array + -> Array a + -- ^ array contains the interpolation locations + -> InterpType + -- ^ is the interpolation type, it can take one of the values defined by 'InterpType' + -> Float + -- ^ is the value that will set in the output array when certain index is out of bounds + -> Array a + -- ^ is the array with interpolated values +approx1 arr1 arr2 (fromInterpType -> i1) f = + op2 arr1 arr2 (\p x y -> af_approx1 p x y i1 f) + +-- | approx2 performs interpolation on data along the first and second dimensions. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__approx2.htm) +-- +-- Interpolation is performed assuming input data is equally spaced with indices in the range [0, n) along each dimension. The positions are sampled with respect to data at these locations. +-- +-- >>> input = matrix @Double (3,3) [ [ 1.0,1.0,1.0 ], [ 2.0, 2.0, 2.0 ], [ 3.0,3.0,3.0 ] ] +-- >>> positions1 = matrix @Double (2,2) [ [ 0.5,1.5 ],[ 0.5,1.5 ] ] +-- >>> positions2 = matrix @Double (2,2) [ [ 0.5,0.5 ],[ 1.5,1.5 ] ] +-- >>> approx2 @Double input positions1 positions2 Cubic 0.0 +-- ArrayFire Array +-- [2 2 1 1] +-- 1.3750 1.3750 +-- 2.6250 2.6250 +-- +approx2 + :: AFType a + => Array a + -- ^ is the input array + -> Array a + -- ^ array contains the interpolation locations for first dimension + -> Array a + -- ^ array contains the interpolation locations for second dimension + -> InterpType + -- ^ is the interpolation type, it can take one of the values defined by 'InterpType' + -> Float + -- ^ is the value that will set in the output array when certain index is out of bounds + -> Array a + -- ^ is the array with interpolated values +approx2 arr1 arr2 arr3 (fromInterpType -> i1) f = + op3 arr1 arr2 arr3 (\p x y z -> af_approx2 p x y z i1 f) + +-- DMJ: Where did these functions go? Were they removed? +-- http://arrayfire.org/docs/group__approx__mat.htm +-- approx1Uniform +-- :: AFType a +-- => Array a +-- -> Array a +-- -> Int +-- -> Double +-- -> Double +-- -> InterpType +-- -> Float +-- -> Array a +-- approx1Uniform arr1 arr2 (fromIntegral -> i1) d1 d2 (fromInterpType -> interp) f = +-- op2 arr1 arr2 (\p x y -> af_approx1_uniform p x y i1 d1 d2 interp f) + +-- approx2Uniform +-- :: AFType a +-- => Array a +-- -> Array a +-- -> Int +-- -> Double +-- -> Double +-- -> Array a +-- -> Int +-- -> Double +-- -> Double +-- -> InterpType +-- -> Float +-- -> Array a +-- approx2Uniform arr1 arr2 (fromIntegral -> i1) d1 d2 arr3 (fromIntegral -> i2) d3 d4 (fromInterpType -> interp) f = +-- op3 arr1 arr2 arr3 (\p x y z -> af_approx2_uniform p x y i1 d1 d2 z i2 d3 d4 interp f) + +-- | Fast Fourier Transform +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft.htm#ga64d0db9e59c9410ba738591ad146a884) +-- +-- The Fast Fourier Transform (FFT) is an efficient algorithm to compute the discrete Fourier transform (DFT) of a signal or array. This is most commonly used to convert data in the time (or space) domain to the frequency domain, Then, the inverse FFT (iFFT) is used to return the data to the original domain. +-- +-- >>> fft (vector @Double 10 [1..]) 2.0 10 +-- ArrayFire Array +-- [2 2 1 1] +-- 1.3750 1.3750 +-- 2.6250 2.6250 +-- +fft + :: (AFType a, Fractional a) + => Array a + -- ^ input 'Array' + -> Double + -- ^ the normalization factor with which the input is scaled after the transformation is applied + -> Int + -- ^ is the length of output signals - used to either truncate or pad the input signals. + -> Array a + -- ^ is the transformed array +fft a d (fromIntegral -> x) = + op1 a (\j k -> af_fft j k d x) + +-- | Fast Fourier Transform (in-place) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft.htm#gaa2f03c9ee1cb80dc184c0b0a13176da1) +-- +-- C Interface for fast fourier transform on one dimensional signals. +-- +-- *Note* The input in must be a complex array +-- +fftInPlace + :: (AFType a, Fractional a) + => Array (Complex a) + -- ^ is the input array on entry and the output of 1D forward fourier transform at exit + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> IO () +fftInPlace a d = a `inPlace` (flip af_fft_inplace d) + +-- | Fast Fourier Transform (2-dimensional) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft2.htm#gaab3fb1ed398e208a615036b4496da611) +-- +-- C Interface for fast fourier transform on two dimensional signals. +-- +fft2 + :: AFType a + => Array a + -- ^ the input array + -> Double + -- ^ the normalization factor with which the input is scaled after the transformation is applied + -> Int + -- ^ is the length of output signals along first dimension - used to either truncate/pad the input + -> Int + -- ^ is the length of output signals along second dimension - used to either truncate/pad the input + -> Array a + -- ^ the transformed array +fft2 a d x y = + op1 a (\j k -> af_fft2 j k d (fromIntegral x) (fromIntegral y)) + +-- | Fast Fourier Transform (2-dimensional, in-place) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft2.htm#gacdeebb3f221ae698833dc4900a172b8c) +-- +-- C Interface for fast fourier transform on two dimensional signals. +-- +-- *Note* The input in must be a complex array +-- +fft2_inplace + :: (Fractional a, AFType a) + => Array (Complex a) + -- ^ input array on entry and the output of 2D forward fourier transform on exit + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> IO () +fft2_inplace a d = a `inPlace` (flip af_fft2_inplace d) + +-- | Fast Fourier Transform (3-dimensional) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft3.htm#ga5138ef1740ece0fde2c796904d733c12) +-- +-- C Interface for fast fourier transform on three dimensional signals. +-- +fft3 + :: AFType a + => Array a + -- ^ the input array + -> Double + -- ^ the normalization factor with which the input is scaled after the transformation is applied + -> Int + -- ^ is the length of output signals along first dimension - used to either truncate/pad the input + -> Int + -- ^ is the length of output signals along second dimension - used to either truncate/pad the input + -> Int + -- ^ is the length of output signals along third dimension - used to either truncate/pad the input + -> Array a + -- ^ the transformed array +fft3 a d x y z = + op1 a (\j k -> af_fft3 j k d (fromIntegral x) (fromIntegral y) (fromIntegral z)) + +-- | Fast Fourier Transform (3-dimensional, in-place) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft2.htm#gacdeebb3f221ae698833dc4900a172b8c) +-- +-- C Interface for fast fourier transform on three dimensional signals. +-- +-- *Note* The input in must be a complex array +-- +fft3_inplace + :: (Fractional a, AFType a) + => Array (Complex a) + -- ^ input array on entry and the output of 3D forward fourier transform on exit + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> IO () +fft3_inplace a d = a `inPlace` (flip af_fft3_inplace d) + +-- | Inverse Fast Fourier Transform +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__ifft.htm#ga2d62c120b474b3b937b0425c994645fe) +-- +-- C Interface for inverse fast fourier transform on one dimensional signals. +-- +ifft + :: AFType a + => Array a + -- ^ the input array + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> Int + -- ^ is the length of output signals - used to either truncate or pad the input signals + -> Array a + -- ^ the transformed array +ifft a d x = + op1 a (\j k -> af_ifft j k d (fromIntegral x)) + +-- | Inverse Fast Fourier Transform (in-place) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__ifft.htm#ga827379bef0e2cadb382c1b6301c91429) +-- +-- C Interface for fast fourier transform on one dimensional signals. +-- +ifft_inplace + :: (AFType a, Fractional a) + => Array (Complex a) + -- ^ is the input array on entry and the output of 1D forward fourier transform at exit + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> IO () +ifft_inplace a d = a `inPlace` (flip af_ifft_inplace d) + + +-- | Inverse Fast Fourier Transform (2-dimensional signals) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__ifft2.htm#ga7cd29c6a35c19240635b62cc5c30dc4f) +-- +-- C Interface for inverse fast fourier transform on two dimensional signals. +-- +ifft2 + :: AFType a + => Array a + -- ^ the input array + -> Double + -- ^ the normalization factor with which the input is scaled after the transformation is applied + -> Int + -- ^ is the length of output signals along first dimension - used to either truncate/pad the input + -> Int + -- ^ is the length of output signals along second dimension - used to either truncate/pad the input + -> Array a + -- ^ the transformed array +ifft2 a d x y = + op1 a (\j k -> af_ifft2 j k d (fromIntegral x) (fromIntegral y)) + +-- | Inverse Fast Fourier Transform (2-dimensional, in-place) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__ifft2.htm#ga9e6a165d44306db4552a56d421ce5d05) +-- +-- C Interface for fast fourier transform on two dimensional signals. +-- +ifft2_inplace + :: (AFType a, Fractional a) + => Array (Complex a) + -- ^ is the input array on entry and the output of 1D forward fourier transform at exit + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> IO () +ifft2_inplace a d = a `inPlace` (flip af_ifft2_inplace d) + +-- | Inverse Fast Fourier Transform (3-dimensional) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__ifft3.htm) +-- +-- C Interface for inverse fast fourier transform on three dimensional signals. +-- +ifft3 + :: AFType a + => Array a + -- ^ the input array + -> Double + -- ^ the normalization factor with which the input is scaled after the transformation is applied + -> Int + -- ^ is the length of output signals along first dimension - used to either truncate/pad the input + -> Int + -- ^ is the length of output signals along second dimension - used to either truncate/pad the input + -> Int + -- ^ is the length of output signals along third dimension - used to either truncate/pad the input + -> Array a + -- ^ the transformed array +ifft3 a d x y z = + op1 a (\j k -> af_ifft3 j k d (fromIntegral x) (fromIntegral y) (fromIntegral z)) + +-- | Inverse Fast Fourier Transform (3-dimensional, in-place) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__ifft3.htm#ga439a7a49723bc6cf77cf4fe7f8dfe334) +-- +-- C Interface for fast fourier transform on two dimensional signals. +-- +ifft3_inplace + :: (AFType a, Fractional a) + => Array (Complex a) + -- ^ is the input array on entry and the output of 1D forward fourier transform at exit + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> IO () +ifft3_inplace a d = a `inPlace` (flip af_ifft3_inplace d) + +-- | Real to Complex Fast Fourier Transform +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft__r2c.htm#ga7486f342182a18e773f14cc2ab4cb551) +-- +-- C Interface for real to complex fast fourier transform for one dimensional signals. +-- +-- The first dimension of the output will be of size (pad0 / 2) + 1. The second dimension of the output will be pad1. The third dimension of the output will be pad 2. +-- +fftr2c + :: (Fractional a, AFType a) + => Array a + -- ^ is a real array + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> Int + -- ^ is the length of output signals along first dimension - used to either truncate/pad the input + -> Array a + -- ^ is a complex array containing the non redundant parts of in. +fftr2c a d x = + op1 a (\j k -> af_fft_r2c j k d (fromIntegral x)) + +-- | Real to Complex Fast Fourier Transform +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft__r2c.htm#ga7486f342182a18e773f14cc2ab4cb551) +-- +-- C Interface for real to complex fast fourier transform for two dimensional signals. +-- +-- The first dimension of the output will be of size (pad0 / 2) + 1. The second dimension of the output will be pad1. The third dimension of the output will be pad 2. +-- +fft2r2c + :: (Fractional a, AFType a) + => Array a + -- ^ is a real array + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> Int + -- ^ is the length of output signals along first dimension - used to either truncate/pad the input + -> Int + -- ^ is the length of output signals along second dimension - used to either truncate/pad the input + -> Array a + -- ^ is a complex array containing the non redundant parts of in. +fft2r2c a d x y = + op1 a (\j k -> af_fft2_r2c j k d (fromIntegral x) (fromIntegral y)) + +-- | Real to Complex Fast Fourier Transform +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft__r2c.htm#gab4ca074b54218b74d8cfbda63d38be51) +-- +-- C Interface for real to complex fast fourier transform for three dimensional signals. +-- +-- The first dimension of the output will be of size (pad0 / 2) + 1. The second dimension of the output will be pad1. The third dimension of the output will be pad 2. +-- +fft3r2c + :: (Fractional a, AFType a) + => Array a + -- ^ is a real array + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> Int + -- ^ is the length of output signals along first dimension - used to either truncate/pad the input + -> Int + -- ^ is the length of output signals along second dimension - used to either truncate/pad the input + -> Int + -- ^ is the length of output signals along third dimension - used to either truncate/pad the input + -> Array a + -- ^ is a complex array containing the non redundant parts of in. +fft3r2c a d x y z = + op1 a (\j k -> af_fft3_r2c j k d (fromIntegral x) (fromIntegral y) (fromIntegral z)) + +-- | Complex to Real Fast Fourier Transform +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft__c2r.htm#gaa5efdfd84213a4a07d81a5d534cde5ac) +-- +-- C Interface for complex to real fast fourier transform for one dimensional signals. +-- +-- The first dimension of the output will be 2 * dim0 - 1 if is_odd is true else 2 * dim0 - 2 where dim0 is the first dimension of the input. The remaining dimensions are unchanged. +-- +fftc2r + :: AFType a + => Array a + -- ^ is a complex array containing only the non redundant parts of the signals. + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> Bool + -- ^ is a flag signifying if the output should be even or odd size + -> Array a + -- ^ is a real array containing the output of the transform. +fftc2r a cm (fromIntegral . fromEnum -> cd) = op1 a (\x y -> af_fft_c2r x y cm cd) + +-- | Complex to Real Fast Fourier Transform (2-dimensional) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft__c2r.htm#gaaa7da16f226cacaffced631e08da4493) +-- +-- C Interface for complex to real fast fourier transform for two dimensional signals. +-- +-- The first dimension of the output will be 2 * dim0 - 1 if is_odd is true else 2 * dim0 - 2 where dim0 is the first dimension of the input. The remaining dimensions are unchanged. +-- +fft2C2r + :: AFType a + => Array a + -- ^ is a complex array containing only the non redundant parts of the signals. + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> Bool + -- ^ is a flag signifying if the output should be even or odd size + -> Array a + -- ^ is a real array containing the output of the transform. +fft2C2r a cm (fromIntegral . fromEnum -> cd) = op1 a (\x y -> af_fft2_c2r x y cm cd) + +-- | Complex to Real Fast Fourier Transform (3-dimensional) +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft__c2r.htm#gaa9b3322d9ffab15268919e1f114bed24) +-- +-- C Interface for complex to real fast fourier transform for three dimensional signals. +-- +-- The first dimension of the output will be 2 * dim0 - 1 if is_odd is true else 2 * dim0 - 2 where dim0 is the first dimension of the input. The remaining dimensions are unchanged. +-- +fft3C2r + :: AFType a + => Array a + -- ^ is a complex array containing only the non redundant parts of the signals. + -> Double + -- ^ is the normalization factor with which the input is scaled after the transformation is applied + -> Bool + -- ^ is a flag signifying if the output should be even or odd size + -> Array a + -- ^ is a real array containing the output of the transform. +fft3C2r a cm (fromIntegral . fromEnum -> cd) = op1 a (\x y -> af_fft3_c2r x y cm cd) + +-- | Convolution Integral for one dimensional data +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__convolve1.htm#ga25d77b794463b5cd72cd0b7f4af140d7) +-- +-- C Interface for convolution on one dimensional signals. +-- +-- *Note* The default parameter of domain, AF_CONV_AUTO, heuristically switches between frequency and spatial domain. +-- +convolve1 + :: AFType a + => Array a + -- ^ the input signal + -> Array a + -- ^ the signal that shall be flipped for the convolution operation + -> ConvMode + -- ^ indicates if the convolution should be expanded or not(where output size equals input) + -> ConvDomain + -- ^ specifies if the convolution should be performed in frequency os spatial domain + -> Array a + -- ^ convolved array +convolve1 a b (toConvMode -> cm) (fromConvDomain -> cd) = op2 a b (\x y z -> af_convolve1 x y z cm cd) + +-- | Convolution Integral for two dimensional data +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__convolve2.htm#ga25d77b794463b5cd72cd0b7f4af140d7) +-- +-- C Interface for convolution on two dimensional signals. +-- +-- *Note* The default parameter of domain, AF_CONV_AUTO, heuristically switches between frequency and spatial domain. +-- +convolve2 + :: AFType a + => Array a + -- ^ the input signal + -> Array a + -- ^ the signal that shall be flipped for the convolution operation + -> ConvMode + -- ^ indicates if the convolution should be expanded or not(where output size equals input) + -> ConvDomain + -- ^ specifies if the convolution should be performed in frequency os spatial domain + -> Array a + -- ^ convolved array +convolve2 a b (toConvMode -> cm) (fromConvDomain -> cd) = op2 a b (\x y z -> af_convolve2 x y z cm cd) + +-- | Convolution Integral for three dimensional data +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__convolve3.htm#ga25d77b794463b5cd72cd0b7f4af140d7) +-- +-- C Interface for convolution on three dimensional signals. +-- +-- *Note* The default parameter of domain, AF_CONV_AUTO, heuristically switches between frequency and spatial domain. +-- +convolve3 + :: AFType a + => Array a + -- ^ the input signal + -> Array a + -- ^ the signal that shall be flipped for the convolution operation + -> ConvMode + -- ^ indicates if the convolution should be expanded or not(where output size equals input) + -> ConvDomain + -- ^ specifies if the convolution should be performed in frequency os spatial domain + -> Array a + -- ^ convolved array +convolve3 a b (toConvMode -> cm) (fromConvDomain -> cd) = + op2 a b (\x y z -> af_convolve3 x y z cm cd) + +-- | C Interface for separable convolution on two dimensional signals. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__convolve.htm#gaeb6ba88155cf3ef29d93f97b147e372f) +-- +-- C Interface for separable convolution on two dimensional signals. +-- +-- *Note* The default parameter of domain, AF_CONV_AUTO, heuristically switches between frequency and spatial domain. +-- +convolve2Sep + :: AFType a + => Array a + -- ^ filter that has to be applied along the coloumns + -> Array a + -- ^ filter that has to be applied along the rows + -> Array a + -- ^ the input array + -> ConvMode + -- ^ indicates if the convolution should be expanded or not(where output size equals input) + -> Array a + -- ^ convolved array +convolve2Sep a b c (toConvMode -> d) = op3 a b c (\x y z j -> af_convolve2_sep x y z j d) + +-- DMJ: did this get removed? Can't find in latest docs +-- fftConvolve1 +-- :: AFType a +-- => Array a +-- -> Array a +-- -> ConvMode +-- -> Array a +-- fftConvolve1 a b (toConvMode -> c) = op2 a b (\x y z -> af_fft_convolve1 x y z c) + +-- | 2D Convolution using Fast Fourier Transform +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft__convolve2.htm#gab52ebe631d8358cdef1b5c8a95550556) +-- +-- A convolution is a common operation between a source array, a, and a filter (or kernel) array b. The answer to the convolution is the same as computing the coefficients in polynomial multiplication, if a and b are the coefficients. +-- +-- C Interface for FFT-based convolution on two dimensional signals. +-- +fftConvolve2 + :: AFType a + => Array a + -- ^ is the input signal + -> Array a + -- ^ is the signal that shall be used for the convolution operation + -> ConvMode + -- ^ indicates if the convolution should be expanded or not(where output size equals input) + -> Array a + -- ^ is convolved array +fftConvolve2 a b (toConvMode -> c) = op2 a b (\x y z -> af_fft_convolve2 x y z c) + +-- | 3D Convolution using Fast Fourier Transform +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft__convolve3.htm) +-- +-- A convolution is a common operation between a source array, a, and a filter (or kernel) array b. The answer to the convolution is the same as computing the coefficients in polynomial multiplication, if a and b are the coefficients. +-- +-- C Interface for FFT-based convolution on three dimensional signals. +-- +fftConvolve3 + :: AFType a + => Array a + -- ^ is the input signal + -> Array a + -- ^ is the signal that shall be used for the convolution operation + -> ConvMode + -- ^ indicates if the convolution should be expanded or not(where output size equals input) + -> Array a + -- ^ is convolved array +fftConvolve3 a b (toConvMode -> c) = op2 a b (\x y z -> af_fft_convolve3 x y z c) + +-- | Finite Impulse Filter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fir.htm#ga2a850e69775eede4709e0d607bba240b) +-- +-- Finite impulse filters take an input x and a co-efficient array b to generate an output y such that: +-- +-- C Interface for finite impulse response filter. +-- +fir + :: AFType a + => Array a + -- ^ is the input signal to the filter + -> Array a + -- ^ is the array containing the coefficients of the filter + -> Array a + -- ^ is the output signal from the filter +fir a b = op2 a b af_fir + +-- | Infinite Impulse Filter. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__iir.htm#ga7adcc364da0a66cdfd2bb351215456c4) +-- +-- Infinite impulse filters take an input x and a feedforward array b, feedback array a to generate an output y such that: +-- +-- C Interface for infinite impulse response filter. +-- +-- *Note* The feedforward coefficients are currently limited to a length of 512 +-- +iir + :: AFType a + => Array a + -- ^ the array containing the feedforward coefficient + -> Array a + -- ^ is the array containing the feedback coefficients + -> Array a + -- ^ is the input signal to the filter + -> Array a + -- ^ the output signal from the filter +iir a b c = op3 a b c af_iir + +-- | Median Filter +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__medfilt.htm#gaaf3f62f2de0f4dc315b831e494e1b2c0) +-- +-- A median filter is similar to the arbitrary filter except that instead of a weighted sum, the median value of the pixels covered by the kernel is returned. +-- +-- C Interface for median filter. +-- +medFilt + :: AFType a + => Array a + -- ^ 'Array' is the input image + -> Int + -> Int + -> BorderType + -> Array a + -- ^ 'Array' is the processed image +medFilt a l w (fromBorderType -> b) = + a `op1` (\x y -> af_medfilt x y (fromIntegral l) (fromIntegral w) b) + +-- | 1D Median Filter +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__medfilt.htm#gad108ea62cbbb5371bd14a17d06384359) +-- +-- A median filter is similar to the arbitrary filter except that instead of a weighted sum, the median value of the pixels covered by the kernel is returned. +-- +-- C Interface for 1D median filter. +-- +medFilt1 + :: AFType a + => Array a + -- ^ 'Array' is the input signal + -> Int + -- ^ Is the kernel width + -> BorderType + -- ^ value will decide what happens to border when running filter in their neighborhood. It takes one of the values [AF_PAD_ZERO | AF_PAD_SYM] + -> Array a + -- ^ 'Array' is the processed signal +medFilt1 a w (fromBorderType -> b) = + a `op1` (\x y -> af_medfilt1 x y (fromIntegral w) b) + +-- | 2D Median Filter +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__image__func__medfilt.htm#ga2cb99dca5842f74f6b9cd28eb187a9cd) +-- +-- A median filter is similar to the arbitrary filter except that instead of a weighted sum, the median value of the pixels covered by the kernel is returned. +-- +-- C Interface for 2D median filter. +-- +medFilt2 + :: AFType a + => Array a + -- ^ 'Array' is the input image + -> Int + -- ^ the kernel height + -> Int + -- ^ the kernel width + -> BorderType + -- ^ value will decide what happens to border when running filter in their neighborhood. It takes one of the values [AF_PAD_ZERO | AF_PAD_SYM] + -> Array a + -- ^ 'Array' is the processed image +medFilt2 a l w (fromBorderType -> b) = + a `op1` (\x y -> af_medfilt2 x y (fromIntegral l) (fromIntegral w) b) + +-- | C Interface for setting plan cache size. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__signal__func__fft.htm#ga4ddef19b43d9a50c97b1a835df60279a) +-- +-- This function doesn't do anything if called when CPU backend is active. The plans associated with the most recently used array sizes are cached. +-- +-- >>> setFFTPlanCacheSize 2 +-- () +-- +setFFTPlanCacheSize + :: Int + -- ^ is the number of plans that shall be cached + -> IO () +setFFTPlanCacheSize = + afCall . af_set_fft_plan_cache_size . fromIntegral diff --git a/src/ArrayFire/Sparse.hs b/src/ArrayFire/Sparse.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Sparse.hs @@ -0,0 +1,295 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Sparse +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func.htm) +-- Functions to create and handle sparse arrays and matrix operations. +-- +-- *Note* +-- Sparse functionality support was added to ArrayFire in v3.4.0. +-- +-- >>> createSparseArray 10 10 (matrix @Double (10,10) [[1,2],[3,4]]) (vector @Int32 10 [1..]) (vector @Int32 10 [1..]) CSR +-- +-- +-------------------------------------------------------------------------------- +module ArrayFire.Sparse where + +import ArrayFire.Types +import ArrayFire.FFI +import ArrayFire.Internal.Sparse +import ArrayFire.Internal.Types +import Data.Int + +-- | This function converts af::array of values, row indices and column indices into a sparse array. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__create.htm#ga42c5cf729a232c1cbbcfe0f664f3b986) +-- +-- *Note* +-- This function only create references of these arrays into the sparse data structure and does not do deep copies. +-- +-- >>> createSparseArray 10 10 (matrix @Double (10,10) [[1,2],[3,4]]) (vector @Int32 10 [1..]) (vector @Int32 10 [1..]) CSR +-- +createSparseArray + :: (AFType a, Fractional a) + => Int + -- ^ is the number of rows in the dense matrix + -> Int + -- ^ is the number of columns in the dense matrix + -> Array a + -- ^ is the 'Array' containing the non-zero elements of the matrix + -> Array Int32 + -- ^ is the row indices for the sparse array + -> Array Int32 + -- ^ the column indices for the sparse array + -> Storage + -- ^ the storage format of the sparse array + -> Array a + -- ^ Sparse Array +createSparseArray (fromIntegral -> r) (fromIntegral -> c) arr1 arr2 arr3 s = + op3Int arr1 arr2 arr3 (\p ar1 ar2 ar3 -> af_create_sparse_array p r c ar1 ar2 ar3 (toStorage s)) + +-- af_err af_create_sparse_array_from_ptr(af_array *out, const dim_t nRows, const dim_t nCols, const dim_t nNZ, const void * const values, const int * const rowIdx, const int * const colIdx, const af_dtype type, const af_storage stype, const af_source src); + +-- | This function converts a dense af_array into a sparse array. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__create.htm#ga52e3b2895cf9e9d697a06b4b44190d92) +-- +-- *Note* +-- This function only create references of these arrays into the sparse data structure and does not do deep copies. +-- +-- >>> createSparseArrayFromDense (matrix @Double (2,2) [[1,2],[3,4]]) CSR +-- ArrayFire Array +-- Storage Format : AF_STORAGE_CSR +-- [2 2 1 1] +-- ArrayFire Array: Values +-- [4 1 1 1] +-- 1.0000 3.0000 2.0000 4.0000 +-- ArrayFire Array: RowIdx +-- [3 1 1 1] +-- 0 2 4 +-- ArrayFire Array: ColIdx +-- [4 1 1 1] +-- 0 1 0 1 +-- +createSparseArrayFromDense + :: (AFType a, Fractional a) + => Array a + -- ^ is the source dense matrix + -> Storage + -- ^ is the storage format of the sparse array + -> Array a + -- ^ 'Array' for the sparse array with the given storage type +createSparseArrayFromDense a s = + a `op1` (\p x -> af_create_sparse_array_from_dense p x (toStorage s)) + +-- | Convert an existing sparse array into a different storage format. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__convert__to.htm) +-- +-- Converting storage formats is allowed between 'CSR', 'COO' and DENSE. +-- +-- When converting to DENSE, a dense array is returned. +-- +-- *Note* +-- 'CSC' is currently not supported. +-- +-- >>> array = createSparseArrayFromDense (matrix @Double (2,2) [[1,2],[3,4]]) CSR +-- >>> array +-- ArrayFire Array +-- Storage Format : AF_STORAGE_CSR +-- [2 2 1 1] +-- ArrayFire Array: Values +-- [4 1 1 1] +-- 1.0000 3.0000 2.0000 4.0000 +-- ArrayFire Array: RowIdx +-- [3 1 1 1] +-- 0 2 4 +-- ArrayFire Array: ColIdx +-- [4 1 1 1] +-- 0 1 0 1 +-- +-- >>> sparseConvertTo array COO +-- ArrayFire Array +-- Storage Format : AF_STORAGE_COO +-- [2 2 1 1] +-- ArrayFire Array: Values +-- [4 1 1 1] +-- 1.0000 2.0000 3.0000 4.0000 +-- ArrayFire Array: RowIdx +-- [4 1 1 1] +-- 0 1 0 1 +-- ArrayFire Array: ColIdx +-- [4 1 1 1] +-- 0 0 1 1 +-- +sparseConvertTo + :: (AFType a, Fractional a) + => Array a + -- ^ is the source sparse matrix to be converted + -> Storage + -- ^ is the storage format of the output sparse array + -> Array a + -- ^ the sparse array with the given storage type +sparseConvertTo a s = + a `op1` (\p x -> af_sparse_convert_to p x (toStorage s)) + +-- | Returns a dense array from a sparse input +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__dense.htm#ga80c3d8db78d537b74d9caebcf359b6a5) +-- +-- Converts the sparse matrix into a dense matrix and returns it +-- +-- >>> array = createSparseArrayFromDense (matrix @Double (2,2) [[1,2],[3,4]]) CSR +-- >>> array +-- ArrayFire Array +-- Storage Format : AF_STORAGE_CSR +-- [2 2 1 1] +-- ArrayFire Array: Values +-- [4 1 1 1] +-- 1.0000 3.0000 2.0000 4.0000 +-- ArrayFire Array: RowIdx +-- [3 1 1 1] +-- 0 2 4 +-- ArrayFire Array: ColIdx +-- [4 1 1 1] +-- 0 1 0 1 +-- +-- >>> sparseToDense array +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 2.0000 +-- 3.0000 4.0000 +-- +sparseToDense + :: (AFType a, Fractional a) + => Array a + -> Array a +sparseToDense = (`op1` af_sparse_to_dense) + +-- | Returns reference to components of the input sparse array. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__info.htm#gae6b553df80e21c174d374e82d8505ba5) +-- +-- Returns reference to values, row indices, column indices and storage format of an input sparse array +-- +-- >>> (values, cols, rows, storage) = sparseGetInfo $ createSparseArrayFromDense (matrix @Double (2,2) [[1,2],[3,4]]) CSR +-- >>> values +-- ArrayFire Array +-- [4 1 1 1] +-- 1.0000 3.0000 2.0000 4.0000 +-- +-- >>> cols +-- ArrayFire Array +-- [3 1 1 1] +-- 0 2 4 +-- +-- >>> rows +-- ArrayFire Array +-- [4 1 1 1] +-- 0 1 0 1 +-- +-- >>> storage +-- CSR +-- +sparseGetInfo + :: (AFType a, Fractional a) + => Array a + -> (Array a, Array a, Array a, Storage) +sparseGetInfo x = do + let (a,b,c,d) = x `op3p1` af_sparse_get_info + (a,b,c,fromStorage d) + +-- | Returns reference to the values component of the sparse array. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__values.htm) +-- +-- Returns reference to the values component of the sparse array. +-- Values is the 'Array' containing the non-zero elements of the dense matrix. +-- +-- >>> sparseGetValues (createSparseArrayFromDense (matrix @Double (2,2) [[1,2],[3,4]]) CSR) +-- ArrayFire Array +-- [4 1 1 1] +-- 1.0000 3.0000 2.0000 4.0000 +-- +sparseGetValues + :: (AFType a, Fractional a) + => Array a + -> Array a +sparseGetValues = (`op1` af_sparse_get_values) + +-- | Returns reference to the row indices component of the sparse array. More... +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__row__idx.htm) +-- +-- Returns reference to the row indices component of the sparse array. +-- Row indices is the 'Array' containing the column indices of the sparse array. +-- +-- >>> sparseGetRowIdx (createSparseArrayFromDense (matrix @Double (2,2) [[1,2],[3,4]]) CSR) +-- ArrayFire Array +-- [3 1 1 1] +-- 0 2 4 +-- +sparseGetRowIdx + :: (AFType a, Fractional a) + => Array a + -> Array a +sparseGetRowIdx = (`op1` af_sparse_get_row_idx) + +-- | Returns reference to the column indices component of the sparse array. More... +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__col__idx.htm) +-- +-- Returns reference to the column indices component of the sparse array. +-- Column indices is the 'Array' containing the column indices of the sparse array. +-- +-- >>> sparseGetColIdx (createSparseArrayFromDense (matrix @Double (2,2) [[1,2],[3,4]]) CSR) +-- ArrayFire Array +-- [4 1 1 1] +-- 0 1 0 1 +-- +sparseGetColIdx + :: (AFType a, Fractional a) + => Array a + -> Array a +sparseGetColIdx = (`op1` af_sparse_get_col_idx) + +-- | Returns the storage type of a sparse array. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__storage.htm) +-- +-- Returns the number of non zero elements in the sparse array. +-- This is always equal to the size of the values array. +-- +-- >>> sparseGetStorage $ createSparseArrayFromDense (matrix @Double (2,2) [[1,2],[3,4]]) CSR +-- CSR +-- +sparseGetStorage + :: (AFType a, Fractional a) + => Array a + -> Storage +sparseGetStorage a = + fromStorage (a `infoFromArray` af_sparse_get_storage) + +-- | Returns the number of non zero elements in the sparse array. More... +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__sparse__func__nnz.htm#ga0c1ad61d829c02a280c28820eb91f03e) +-- +-- Returns the number of non zero elements in the sparse array. +-- This is always equal to the size of the values array. +-- +-- >>> sparseGetNNZ $ createSparseArrayFromDense (matrix @Double (2,2) [[1,2],[3,4]]) CSR +-- 4 +-- +sparseGetNNZ + :: (AFType a, Fractional a) + => Array a + -> Int +sparseGetNNZ a = + fromIntegral (a `infoFromArray` af_sparse_get_nnz) + diff --git a/src/ArrayFire/Statistics.hs b/src/ArrayFire/Statistics.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Statistics.hs @@ -0,0 +1,303 @@ +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Statistics +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Statistics API. +-- Example of finding the top k elements along with their indices from an 'Array' +-- +-- @ +-- >>> let (vals,indexes) = 'topk' ( 'vector' \@'Double' 10 [1..] ) 3 'TopKDefault' +-- >>> print vals +-- >>> print indexes +-- @ +-- @ +-- ArrayFire 'Array' +-- [3 1 1 1] +-- 10.0000 9.0000 8.0000 +-- @ +-- @ +-- ArrayFire 'Array' +-- [3 1 1 1] +-- 9 8 7 +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Statistics where + +import ArrayFire.Array +import ArrayFire.FFI +import ArrayFire.Internal.Statistics +import ArrayFire.Internal.Types + +-- | Calculates 'mean' of 'Array' along user-specified dimension. +-- +-- >>> mean 0 ( vector @Int 10 [1..] ) +-- ArrayFire Array +-- [1 1 1 1] +-- 5.5000 +mean + :: AFType a + => Array a + -- ^ Input 'Array' + -> Int + -- ^ The dimension along which the mean is extracted + -> Array a + -- ^ Will contain the mean of the input 'Array' along dimension dim +mean a n = + a `op1` (\x y -> + af_mean x y (fromIntegral n)) + +-- | Calculates 'meanWeighted' of 'Array' along user-specified dimension. +-- +-- >>> meanWeighted (vector @Double 10 [1..10]) (vector @Double 10 [1..10]) 0 +-- ArrayFire Array +-- [1 1 1 1] +-- 7.0000 +meanWeighted + :: AFType a + => Array a + -- ^ Input 'Array' + -> Array a + -- ^ Weights 'Array' + -> Int + -- ^ The dimension along which the mean is extracted + -> Array a + -- ^ Will contain the mean of the input 'Array' along dimension dim +meanWeighted x y (fromIntegral -> n) = + op2 x y $ \a b c -> + af_mean_weighted a b c n + +-- | Calculates /variance/ of 'Array' along user-specified dimension. +-- +-- >>> var (vector @Double 8 [1..8]) False 0 +-- ArrayFire Array +-- [1 1 1 1] +-- 6.0 +var + :: AFType a + => Array a + -- ^ Input 'Array' + -> Bool + -- ^ boolean denoting Population variance (false) or Sample Variance (true) + -> Int + -- ^ The dimension along which the variance is extracted + -> Array a + -- ^ will contain the variance of the input array along dimension dim +var arr (fromIntegral . fromEnum -> b) d = + arr `op1` (\p x -> + af_var p x b (fromIntegral d)) + +-- | Calculates 'varWeighted' of 'Array' along user-specified dimension. +-- +-- >>> varWeighted 0 ( vector @Int 10 [1..] ) ( vector @Int 10 [1..] ) +-- ArrayFire Array +-- [1 1 1 1] +-- 5.5000 +varWeighted + :: AFType a + => Array a + -- ^ Input 'Array' + -> Array a + -- ^ Weights 'Array' used to scale input in before getting variance + -> Int + -- ^ The dimension along which the variance is extracted + -> Array a + -- ^ Contains the variance of the input array along dimension dim +varWeighted x y (fromIntegral -> n) = + op2 x y $ \a b c -> + af_var_weighted a b c n + +-- | Calculates 'stdev' of 'Array' along user-specified dimension. +-- +-- >>> stdev (vector @Double 10 (cycle [1,-1])) 0 +-- ArrayFire Array +-- [1 1 1 1] +-- 1.0 +stdev + :: AFType a + => Array a + -- ^ Input 'Array' + -> Int + -- ^ The dimension along which the standard deviation is extracted + -> Array a + -- ^ Contains the standard deviation of the input array along dimension dim +stdev a n = + a `op1` (\x y -> + af_stdev x y (fromIntegral n)) + +-- | Calculates /covariance/ of two 'Array's with a bias specifier. +-- +-- >>> cov (vector @Double 10 (repeat 1)) (vector @Double 10 (repeat 1)) False +-- ArrayFire Array +-- [1 1 1 1] +-- 0.0 +cov + :: AFType a + => Array a + -- ^ First input 'Array' + -> Array a + -- ^ Second input 'Array' + -> Bool + -- ^ A boolean specifying if biased estimate should be taken (default: 'False') + -> Array a + -- ^ Contains will the covariance of the input 'Array's +cov x y (fromIntegral . fromEnum -> n) = + op2 x y $ \a b c -> + af_cov a b c n + +-- | Calculates 'median' of 'Array' along user-specified dimension. +-- +-- >>> print $ median ( vector @Int 10 [1..] ) 0 +-- ArrayFire Array +-- [1 1 1 1] +-- 5.5000 +median + :: AFType a + => Array a + -- ^ Input 'Array' + -> Int + -- ^ Dimension along which to calculate 'median' + -> Array a + -- ^ Array containing 'median' +median a n = + a `op1` (\x y -> + af_median x y (fromIntegral n)) + +-- | Calculates 'mean' of all elements in an 'Array' +-- +-- >>> fst (meanAll (matrix @Double (2,2) (repeat 10))) +-- 10.0 +meanAll + :: AFType a + => Array a + -- ^ Input 'Array' + -> (Double, Double) + -- ^ Mean result (real and imaginary part) +meanAll = (`infoFromArray2` af_mean_all) + +-- | Calculates weighted mean of all elements in an 'Array' +-- +-- >>> print $ fst (meanAllWeighted (matrix @Double (2,2) (repeat 10)) (matrix @Double (2,2) (repeat 0))) +-- 10 +meanAllWeighted + :: AFType a + => Array a + -- ^ Input 'Array' + -> Array a + -- ^ 'Array' of weights + -> (Double, Double) + -- ^ Weighted mean (real and imaginary part) +meanAllWeighted a b = + infoFromArray22 a b af_mean_all_weighted + +-- | Calculates variance of all elements in an 'Array' +-- +-- >>> fst (varAll (vector @Double 10 (repeat 10)) False) +-- 0 +varAll + :: AFType a + => Array a + -- ^ Input 'Array' + -> Bool + -- ^ Input 'Array' + -> (Double, Double) + -- ^ Variance (real and imaginary part) +varAll a (fromIntegral . fromEnum -> b) = + infoFromArray2 a $ \x y z -> + af_var_all x y z b + +-- | Calculates weighted variance of all elements in an 'Array' +-- +-- >>> varAllWeighted ( vector @Int 10 [1..] ) ( vector @Int 10 [1..] ) +-- 0 +varAllWeighted + :: AFType a + => Array a + -- ^ Input 'Array' + -> Array a + -- ^ 'Array' of weights + -> (Double, Double) + -- ^ Variance weighted result, (real and imaginary part) +varAllWeighted a b = + infoFromArray22 a b af_var_all_weighted + +-- | Calculates standard deviation of all elements in an 'Array' +-- +-- >>> fst (stdevAll (vector @Double 10 (repeat 10))) +-- 10 +stdevAll + :: AFType a + => Array a + -- ^ Input 'Array' + -> (Double, Double) + -- ^ Standard deviation result, (real and imaginary part) +stdevAll = (`infoFromArray2` af_stdev_all) + +-- | Calculates median of all elements in an 'Array' +-- +-- >>> fst (medianAll (vector @Double 10 (repeat 10))) +-- 10 +medianAll + :: (AFType a, Fractional a) + => Array a + -- ^ Input 'Array' + -> (Double, Double) + -- ^ Median result, real and imaginary part +medianAll = (`infoFromArray2` af_median_all) + +-- | This algorithm returns Pearson product-moment correlation coefficient. +-- +-- +-- >>> fst (corrCoef ( vector @Int 10 [1..] ) ( vector @Int 10 [10,9..] )) +-- -1 +corrCoef + :: AFType a + => Array a + -- ^ First input 'Array' + -> Array a + -- ^ Second input 'Array' + -> (Double, Double) + -- ^ Correlation coefficient result, real and imaginary part +corrCoef a b = + infoFromArray22 a b af_corrcoef + +-- | This function returns the top k values along a given dimension of the input array. +-- +-- @ +-- >>> let (vals,indexes) = 'topk' ( 'vector' \@'Double' 10 [1..] ) 3 'TopKDefault' +-- >>> print indexes +-- +-- ArrayFire 'Array' +-- [3 1 1 1] +-- 10.0000 9.0000 8.0000 +-- +-- >>> print vals +-- ArrayFire 'Array' +-- [3 1 1 1] +-- 9 8 7 +-- @ +-- +-- The indices along with their values are returned. If the input is a multi-dimensional array, the indices will be the index of the value in that dimension. Order of duplicate values are not preserved. This function is optimized for small values of k. +-- This function performs the operation across all dimensions of the input array. +-- This function is optimized for small values of k. +-- The order of the returned keys may not be in the same order as the appear in the input array +-- +topk + :: AFType a + => Array a + -- ^ First input 'Array', with at least /k/ elements along /dim/ + -> Int + -- ^ The number of elements to be retrieved along the dim dimension + -> TopK + -- ^ If descending, the highest values are returned. Otherwise, the lowest values are returned + -> (Array a, Array a) + -- ^ Returns The values of the top k elements along the dim dimension + -- along with the indices of the top k elements along the dim dimension +topk a (fromIntegral -> x) (fromTopK -> f) + = a `op2p` (\b c d -> af_topk b c d x 0 f) diff --git a/src/ArrayFire/Types.hs b/src/ArrayFire/Types.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Types.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Types +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-------------------------------------------------------------------------------- +module ArrayFire.Types + ( AFException (..) + , AFExceptionType (..) + , Array + , Window + , RandomEngine + , Features + , AFType (..) + , TopK (..) + , Backend (..) + , MatchType (..) + , BinaryOp (..) + , MatProp (..) + , HomographyType (..) + , RandomEngineType (..) + , Cell (..) + , MarkerType (..) + , InterpType (..) + , Connectivity (..) + , CSpace (..) + , YccStd (..) + , MomentType (..) + , CannyThreshold (..) + , FluxFunction (..) + , DiffusionEq (..) + , IterativeDeconvAlgo (..) + , InverseDeconvAlgo (..) + , Seq (..) + , Index (..) + , NormType (..) + , ConvMode (..) + , ConvDomain (..) + , BorderType (..) + , Storage (..) + , AFDType (..) + , AFDtype (..) + , ColorMap (..) + ) where + +import ArrayFire.Exception +import ArrayFire.Internal.Types +import ArrayFire.Internal.Defines diff --git a/src/ArrayFire/Util.hs b/src/ArrayFire/Util.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Util.hs @@ -0,0 +1,285 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Util +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Various utilities for working with the ArrayFire C library +-- +-- @ +-- import qualified ArrayFire as A +-- import Control.Monad +-- +-- main :: IO () +-- main = do +-- let arr = A.constant [1,1,1,1] 10 +-- idx <- A.saveArray "key" arr "file.array" False +-- foundIndex <- A.readArrayKeyCheck "file.array" "key" +-- when (idx == foundIndex) $ do +-- array <- A.readArrayKey "file.array" "key" +-- print array +-- @ +-- @ +-- ArrayFire Array +-- [ 1 1 1 1 ] +-- 10 +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Util where + +import Control.Exception + +import Data.Proxy +import Foreign.C.String +import Foreign.ForeignPtr +import Foreign.Marshal hiding (void) +import Foreign.Storable +import System.IO.Unsafe + +import ArrayFire.Internal.Types +import ArrayFire.Internal.Util + +import ArrayFire.Exception +import ArrayFire.FFI + +-- | Retrieve version for ArrayFire API +-- +-- @ +-- >>> 'print' '=<<' 'getVersion' +-- @ +-- @ +-- (3.6.4) +-- @ +getVersion :: IO (Int,Int,Int) +getVersion = + alloca $ \x -> + alloca $ \y -> + alloca $ \z -> do + throwAFError =<< af_get_version x y z + (,,) <$> (fromIntegral <$> peek x) + <*> (fromIntegral <$> peek y) + <*> (fromIntegral <$> peek z) + +-- | Prints array to stdout +-- +-- @ +-- >>> 'printArray' (constant \@'Double' [1] 1) +-- @ +-- @ +-- ArrayFire Array +-- [ 1 1 1 1 ] +-- 1.0 +-- @ +printArray + :: Array a + -- ^ Input 'Array' + -> IO () +printArray (Array fptr) = + mask_ . withForeignPtr fptr $ \ptr -> + throwAFError =<< af_print_array ptr + +-- | Gets git revision of ArrayFire +-- +-- @ +-- >>> 'putStrLn' '=<<' 'getRevision' +-- @ +-- @ +-- 1b8030c5 +-- @ +getRevision :: IO String +getRevision = peekCString =<< af_get_revision + +-- | Prints 'Array' with error codes +-- +-- @ +-- >>> printArrayGen "test" (constant \@'Double' [1] 1) 2 +-- @ +-- @ +-- ArrayFire Array +-- [ 1 1 1 1 ] +-- 1.00 +-- @ +printArrayGen + :: String + -- ^ is the expression or name of the array + -> Array a + -- ^ is the input array + -> Int + -- ^ precision for the display + -> IO () +printArrayGen s (Array fptr) (fromIntegral -> prec) = do + mask_ . withForeignPtr fptr $ \ptr -> + withCString s $ \cstr -> + throwAFError =<< af_print_array_gen cstr ptr prec + +-- | Saves 'Array' to disk +-- +-- Save an array to a binary file. +-- The 'saveArray' and readArray functions are designed to provide store and read access to arrays using files written to disk. +-- +-- +-- @ +-- >>> saveArray "my array" (constant \@'Double' [1] 1) "array.file" 'True' +-- @ +-- @ +-- 0 +-- @ +saveArray + :: String + -- ^ An expression used as tag/key for the 'Array' during readArray + -> Array a + -- ^ Input 'Array' + -> FilePath + -- ^ Path that 'Array' will be saved + -> Bool + -- ^ Used to append to an existing file when 'True' and create or overwrite an existing file when 'False' + -> IO Int + -- ^ The index location of the 'Array' in the file +saveArray key (Array fptr) filename (fromIntegral . fromEnum -> append) = do + mask_ . withForeignPtr fptr $ \ptr -> + alloca $ \ptrIdx -> do + withCString key $ \keyCstr -> + withCString filename $ \filenameCstr -> do + throwAFError =<< + af_save_array ptrIdx keyCstr + ptr filenameCstr append + fromIntegral <$> peek ptrIdx + +-- | Reads Array by index +-- +-- The 'saveArray' and readArray functions are designed to provide store and read access to arrays using files written to disk. +-- +-- +-- @ +-- >>> readArrayIndex "array.file" 0 +-- @ +-- @ +-- ArrayFire Array +-- [ 1 1 1 1 ] +-- 10.0000 +-- @ +readArrayIndex + :: FilePath + -- ^ Path to 'Array' location + -> Int + -- ^ Index into 'Array' + -> IO (Array a) +readArrayIndex str (fromIntegral -> idx') = + withCString str $ \cstr -> + createArray' (\p -> af_read_array_index p cstr idx') + +-- | Reads 'Array' by key +-- +-- @ +-- >>> readArrayKey "array.file" "my array" +-- @ +-- @ +-- ArrayFire 'Array' +-- [ 1 1 1 1 ] +-- 10.0000 +-- @ +readArrayKey + :: FilePath + -- ^ Path to 'Array' + -> String + -- ^ Key of 'Array' on disk + -> IO (Array a) + -- ^ Returned 'Array' +readArrayKey fn key = + withCString fn $ \fcstr -> + withCString key $ \kcstr -> + createArray' (\p -> af_read_array_key p fcstr kcstr) + +-- | Reads Array, checks if a key exists in the specified file +-- +-- When reading by key, it may be a good idea to run this function first to check for the key and then call the readArray using the index. +-- +-- +-- @ +-- >>> readArrayCheck "array.file" "my array" +-- @ +-- @ +-- 0 +-- @ +readArrayKeyCheck + :: FilePath + -- ^ Path to file + -> String + -- ^ Key + -> IO Int + -- ^ is the tag/name of the array to be read. The key needs to have an exact match. +readArrayKeyCheck a b = + withCString a $ \acstr -> + withCString b $ \bcstr -> + fromIntegral <$> + afCall1 (\p -> af_read_array_key_check p acstr bcstr) + +-- | Convert ArrayFire 'Array' to 'String', used for 'Show' instance. +-- +-- @ +-- >>> 'putStrLn' '$' 'arrayString' (constant \@'Double' 10 [1,1,1,1]) +-- @ +-- @ +-- ArrayFire 'Array' +-- [ 1 1 1 1 ] +-- 10.0000 +-- @ +arrayString + :: Array a + -- ^ Input 'Array' + -> String + -- ^ 'String' representation of 'Array' +arrayString a = arrayToString "ArrayFire Array" a 4 False + +-- | Convert ArrayFire Array to String +-- +-- @ +-- >>> print (constant \@'Double' 10 [1,1,1,1]) 4 'False' +-- @ +-- @ +-- ArrayFire 'Array' +-- [ 1 1 1 1 ] +-- 10.0000 +-- @ +arrayToString + :: String + -- ^ Name of 'Array' + -> Array a + -- ^ 'Array' input + -> Int + -- ^ Precision of 'Array' values. + -> Bool + -- ^ If 'True', performs takes the transpose before rendering to 'String' + -> String + -- ^ 'Array' rendered to 'String' +arrayToString expr (Array fptr) (fromIntegral -> prec) (fromIntegral . fromEnum -> trans) = + unsafePerformIO . mask_ . withForeignPtr fptr $ \aptr -> + withCString expr $ \expCstr -> + alloca $ \ocstr -> do + throwAFError =<< af_array_to_string ocstr expCstr aptr prec trans + peekCString =<< peek ocstr + +-- | Retrieve size of ArrayFire data type +-- +-- @ +-- >>> 'getSizeOf' ('Proxy' \@ 'Double') +-- @ +-- @ +-- 8 +-- @ +getSizeOf + :: forall a . AFType a + => Proxy a + -- ^ Witness of Haskell type that mirrors ArrayFire type. + -> Int + -- ^ Size of ArrayFire type +getSizeOf proxy = + unsafePerformIO . mask_ . alloca $ \csize -> do + throwAFError =<< af_get_size_of csize (afType proxy) + fromIntegral <$> peek csize diff --git a/src/ArrayFire/Vision.hs b/src/ArrayFire/Vision.hs new file mode 100644 --- /dev/null +++ b/src/ArrayFire/Vision.hs @@ -0,0 +1,361 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Vision +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-------------------------------------------------------------------------------- +module ArrayFire.Vision where + +import Control.Exception hiding (TypeError) +import Data.Typeable +import Foreign.ForeignPtr +import Foreign.Marshal +import Foreign.Storable +import System.IO.Unsafe + +import ArrayFire.Exception +import ArrayFire.FFI +import ArrayFire.Internal.Features +import ArrayFire.Internal.Vision +import ArrayFire.Internal.Types + +-- | FAST feature detectors +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__fast.htm) +-- +-- A circle of radius 3 pixels, translating into a total of 16 pixels, is checked for sequential segments of pixels much brighter or much darker than the central one. +-- For a pixel p to be considered a feature, there must exist a sequential segment of arc_length pixels in the circle around it such that all are greather than (p + thr) or smaller than (p - thr). +-- After all features in the image are detected, if nonmax is true, the non-maximal suppression is applied, checking all detected features and the features detected in its 8-neighborhood and discard it if its score is non maximal. +fast + :: Array a + -- ^ Array containing a grayscale image (color images are not supported) + -> Float + -- ^ FAST threshold for which a pixel of the circle around the central pixel is considered to be greater or smaller + -> Int + -- ^ Length of arc (or sequential segment) to be tested, must be within range [9-16] + -> Bool + -- ^ Performs non-maximal suppression if true + -> Float + -- ^ Maximum ratio of features to detect, the maximum number of features is calculated by feature_ratio * in.elements(). The maximum number of features is not based on the score, instead, features detected after the limit is reached are discarded + -> Int + -- ^ Is the length of the edges in the image to be discarded by FAST (minimum is 3, as the radius of the circle) + -> Features + -- ^ Struct containing arrays for x and y coordinates and score, while array orientation is set to 0 as FAST does not compute orientation, and size is set to 1 as FAST does not compute multiple scales +fast (Array fptr) thr (fromIntegral -> arc) (fromIntegral . fromEnum -> non) ratio (fromIntegral -> edge) + = unsafePerformIO . mask_ . withForeignPtr fptr $ \aptr -> + do feat <- alloca $ \ptr -> do + throwAFError =<< af_fast ptr aptr thr arc non ratio edge + peek ptr + Features <$> + newForeignPtr af_release_features feat + +-- | Harris corner detection +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__harris.htm) +-- +-- Harris corner detector. +-- +harris + :: Array a + -- ^ array containing a grayscale image (color images are not supported) + -> Int + -- ^ maximum number of corners to keep, only retains those with highest Harris responses + -> Float + -- ^ minimum response in order for a corner to be retained, only used if max_corners = 0 + -> Float + -- ^ the standard deviation of a circular window (its dimensions will be calculated according to the standard deviation), the covariation matrix will be calculated to a circular neighborhood of this standard deviation (only used when block_size == 0, must be >= 0.5f and <= 5.0f) + -> Int + -- ^ square window size, the covariation matrix will be calculated to a square neighborhood of this size (must be >= 3 and <= 31) + -> Float + -- ^ struct containing arrays for x and y coordinates and score (Harris response), while arrays orientation and size are set to 0 and 1, respectively, because Harris does not compute that information + -> Features +harris (Array fptr) (fromIntegral -> maxc) minresp sigma (fromIntegral -> bs) thr + = unsafePerformIO . mask_ . withForeignPtr fptr $ \aptr -> + do feat <- alloca $ \ptr -> do + throwAFError =<< af_harris ptr aptr maxc minresp sigma bs thr + peek ptr + Features <$> + newForeignPtr af_release_features feat + +-- | ORB Feature descriptor +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__orb.htm) +-- +-- Extract ORB descriptors from FAST features that hold higher Harris responses. FAST does not compute orientation, thus, orientation of features is calculated using the intensity centroid. As FAST is also not multi-scale enabled, a multi-scale pyramid is calculated by downsampling the input image multiple times followed by FAST feature detection on each scale. +-- +orb + :: Array a + -- ^ 'Array' containing a grayscale image (color images are not supported) + -> Float + -- ^ FAST threshold for which a pixel of the circle around the central pixel is considered to be brighter or darker + -> Int + -- ^ maximum number of features to hold (will only keep the max_feat features with higher Harris responses) + -> Float + -- ^ factor to downsample the input image, meaning that each level will hold prior level dimensions divided by scl_fctr + -> Int + -- ^ number of levels to be computed for the image pyramid + -> Bool + -- ^ blur image with a Gaussian filter with sigma=2 before computing descriptors to increase robustness against noise if true + -> (Features, Array a) + -- ^ 'Features' struct composed of arrays for x and y coordinates, score, orientation and size of selected features +orb (Array fptr) thr (fromIntegral -> feat) scl (fromIntegral -> levels) (fromIntegral . fromEnum -> blur) + = unsafePerformIO . mask_ . withForeignPtr fptr $ \inptr -> + do (feature, arr) <- + alloca $ \aptr -> do + alloca $ \bptr -> do + throwAFError =<< af_orb aptr bptr inptr thr feat scl levels blur + (,) <$> peek aptr <*> peek bptr + feats <- Features <$> newForeignPtr af_release_features feature + array <- Array <$> newForeignPtr af_release_array_finalizer arr + pure (feats, array) + +-- | SIFT feature detector and descriptor extractor. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__sift.htm) +-- +-- C Interface for SIFT feature detector and descriptor. +-- +sift + :: Array a + -- ^ Array containing a grayscale image (color images are not supported) + -> Int + -- ^ number of layers per octave, the number of octaves is computed automatically according to the input image dimensions, the original SIFT paper suggests 3 + -> Float + -- ^ threshold used to filter out features that have low contrast, the original SIFT paper suggests 0.04 + -> Float + -- ^ threshold used to filter out features that are too edge-like, the original SIFT paper suggests 10.0 + -> Float + -- ^ the sigma value used to filter the input image at the first octave, the original SIFT paper suggests 1.6 + -> Bool + -- ^ if true, the input image dimensions will be doubled and the doubled image will be used for the first octave + -> Float + -- ^ the inverse of the difference between the minimum and maximum grayscale intensity value, e.g.: if the ranges are 0-256, the proper intensity_scale value is 1/256, if the ranges are 0-1, the proper intensity-scale value is 1/1 + -> Float + -- ^ maximum ratio of features to detect, the maximum number of features is calculated by feature_ratio * in.elements(). The maximum number of features is not based on the score, instead, features detected after the limit is reached are discarded + -> (Features, Array a) + -- ^ Features object composed of arrays for x and y coordinates, score, orientation and size of selected features + -- Nx128 array containing extracted descriptors, where N is the number of features found by SIFT +sift (Array fptr) (fromIntegral -> a) b c d (fromIntegral . fromEnum -> e) f g + = unsafePerformIO . mask_ . withForeignPtr fptr $ \inptr -> + do (feat, arr) <- + alloca $ \aptr -> do + alloca $ \bptr -> do + throwAFError =<< af_sift aptr bptr inptr a b c d e f g + (,) <$> peek aptr <*> peek bptr + feats <- Features <$> newForeignPtr af_release_features feat + array <- Array <$> newForeignPtr af_release_array_finalizer arr + pure (feats, array) + +-- | SIFT feature detector and descriptor extractor. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__gloh.htm) +-- +-- C Interface for SIFT feature detector and descriptor. +-- +gloh + :: Array a + -- ^ 'Array' containing a grayscale image (color images are not supported) + -> Int + -- ^ number of layers per octave, the number of octaves is computed automatically according to the input image dimensions, the original SIFT paper suggests 3 + -> Float + -- ^ threshold used to filter out features that have low contrast, the original SIFT paper suggests 0.04 + -> Float + -- ^ threshold used to filter out features that are too edge-like, the original SIFT paper suggests 10.0 + -> Float + -- ^ the sigma value used to filter the input image at the first octave, the original SIFT paper suggests 1.6 + -> Bool + -- ^ if true, the input image dimensions will be doubled and the doubled image will be used for the first octave + -> Float + -- ^ the inverse of the difference between the minimum and maximum grayscale intensity value, e.g.: if the ranges are 0-256, the proper intensity_scale value is 1/256, if the ranges are 0-1, the proper intensity-scale value is 1/1 + -> Float + -- ^ maximum ratio of features to detect, the maximum number of features is calculated by feature_ratio * in.elements(). The maximum number of features is not based on the score, instead, features detected after the limit is reached are discarded + -> (Features, Array a) + -- ^ 'Features' object composed of arrays for x and y coordinates, score, orientation and size of selected features + -- ^ Nx272 array containing extracted GLOH descriptors, where N is the number of features found by SIFT +gloh (Array fptr) (fromIntegral -> a) b c d (fromIntegral . fromEnum -> e) f g + = unsafePerformIO . mask_ . withForeignPtr fptr $ \inptr -> + do (feat, arr) <- + alloca $ \aptr -> do + alloca $ \bptr -> do + throwAFError =<< af_gloh aptr bptr inptr a b c d e f g + (,) <$> peek aptr <*> peek bptr + feats <- Features <$> newForeignPtr af_release_features feat + array <- Array <$> newForeignPtr af_release_array_finalizer arr + pure (feats, array) + +-- | Hamming Matcher +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__hamming__matcher.htm) +-- +-- Calculates Hamming distances between two 2-dimensional arrays containing features, one of the arrays containing the training data and the other the query data. One of the dimensions of the both arrays must be equal among them, identifying the length of each feature. The other dimension indicates the total number of features in each of the training and query arrays. Two 1-dimensional arrays are created as results, one containg the smallest N distances of the query array and another containing the indices of these distances in the training array. The resulting 1-dimensional arrays have length equal to the number of features contained in the query array. +-- +hammingMatcher + :: Array a + -- ^ is the 'Array' containing the data to be queried + -> Array a + -- ^ is the 'Array' containing the data used as training data + -> Int + -- ^ indicates the dimension to analyze for distance (the dimension indicated here must be of equal length for both query and train arrays) + -> Int + -- ^ is the number of smallest distances to return (currently, only 1 is supported) + -> (Array a, Array a) + -- ^ is an array of MxN size, where M is equal to the number of query features and N is equal to n_dist. The value at position IxJ indicates the index of the Jth smallest distance to the Ith query value in the train data array. the index of the Ith smallest distance of the Mth query. + -- is an array of MxN size, where M is equal to the number of query features and N is equal to n_dist. The value at position IxJ indicates the Hamming distance of the Jth smallest distance to the Ith query value in the train data array. +hammingMatcher a b (fromIntegral -> x) (fromIntegral -> y) + = op2p2 a b (\p c d e -> af_hamming_matcher p c d e x y) + +-- | Nearest Neighbor +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__nearest__neighbour.htm) +-- +-- Calculates nearest distances between two 2-dimensional arrays containing features based on the type of distance computation chosen. Currently, AF_SAD (sum of absolute differences), AF_SSD (sum of squared differences) and AF_SHD (hamming distance) are supported. One of the arrays containing the training data and the other the query data. One of the dimensions of the both arrays must be equal among them, identifying the length of each feature. The other dimension indicates the total number of features in each of the training and query arrays. Two 1-dimensional arrays are created as results, one containg the smallest N distances of the query array and another containing the indices of these distances in the training array. The resulting 1-dimensional arrays have length equal to the number of features contained in the query array. +-- +nearestNeighbor + :: Array a + -- ^ is the array containing the data to be queried + -> Array a + -- ^ is the array containing the data used as training data + -> Int + -- ^ indicates the dimension to analyze for distance (the dimension indicated here must be of equal length for both query and train arrays) + -> Int + -- ^ is the number of smallest distances to return (currently, only values <= 256 are supported) + -> MatchType + -- ^ is the distance computation type. Currently AF_SAD (sum of absolute differences), AF_SSD (sum of squared differences), and AF_SHD (hamming distances) are supported. + -> (Array a, Array a) + -- ^ is an array of MxN size, where M is equal to the number of query features and N is equal to n_dist. The value at position IxJ indicates the index of the Jth smallest distance to the Ith query value in the train data array. the index of the Ith smallest distance of the Mth query. + -- is an array of MxN size, where M is equal to the number of query features and N is equal to n_dist. The value at position IxJ indicates the distance of the Jth smallest distance to the Ith query value in the train data array based on the dist_type chosen. +nearestNeighbor a b (fromIntegral -> x) (fromIntegral -> y) (fromMatchType -> match) + = op2p2 a b (\p c d e -> af_nearest_neighbour p c d e x y match) + +-- | Nearest Neighbor +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__match__template.htm) +-- +-- C Interface for image template matching. +-- +matchTemplate + :: Array a + -- ^ is an 'Array' with image data + -> Array a + -- ^ is the template we are looking for in the image + -> MatchType + -- ^ is metric that should be used to calculate the disparity between window in the image and the template image. It can be one of the values defined by the enum af_match_type + -> Array a + -- ^ will have disparity values for the window starting at corresponding pixel position +matchTemplate a b (fromMatchType -> match) + = op2 a b (\p c d -> af_match_template p c d match) + +-- | SUSAN corner detector. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__susan.htm) +-- +-- SUSAN is an acronym standing for Smallest Univalue Segment Assimilating Nucleus. This method places a circular disc over the pixel to be tested (a.k.a nucleus) to compute the corner measure of that corresponding pixel. The region covered by the circular disc is M, and a pixel in this region is represented by m M where m 0 is the nucleus. Every pixel in the region is compared to the nucleus using the following comparison function: +-- +susan + :: Array a + -- ^ is input grayscale/intensity image + -> Int + -- ^ nucleus radius for each pixel neighborhood + -> Float + -- ^ intensity difference threshold a.k.a t from equations in description + -> Float + -- ^ geometric threshold + -> Float + -- ^ is maximum number of features that will be returned by the function + -> Int + -- ^ indicates how many pixels width area should be skipped for corner detection + -> Features +susan (Array fptr) (fromIntegral -> a) b c d (fromIntegral -> e) + = unsafePerformIO . mask_ . withForeignPtr fptr $ \inptr -> + do feat <- + alloca $ \aptr -> do + throwAFError =<< af_susan aptr inptr a b c d e + peek aptr + Features <$> newForeignPtr af_release_features feat + +-- | Difference of Gaussians. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__dog.htm) +-- +-- Given an image, this function computes two different versions of smoothed input image using the difference smoothing parameters and subtracts one from the other and returns the result. +-- +dog + :: Array a + -- ^ is input image + -> Int + -- ^ is the radius of first gaussian kernel + -> Int + -- ^ is the radius of second gaussian kernel + -> Array a + -- ^ is difference of smoothed inputs +dog a (fromIntegral -> x) (fromIntegral -> y) = + op1 a (\p c -> af_dog p c x y) + +-- | Homography Estimation. +-- +-- [ArrayFire Docs](http://arrayfire.org/docs/group__cv__func__homography.htm) +-- +-- Homography estimation find a perspective transform between two sets of 2D points. +-- +homography + :: forall a . AFType a + => Array a + -- ^ x coordinates of the source points. + -> Array a + -- ^ y coordinates of the source points. + -> Array a + -- ^ x coordinates of the destination points. + -> Array a + -- ^ y coordinates of the destination points. + -> HomographyType + -- ^ htype, can be AF_HOMOGRAPHY_RANSAC, for which a + -- RANdom SAmple Consensus will be used to evaluate + -- the homography quality (e.g., number of inliers), + -- or AF_HOMOGRAPHY_LMEDS, which will use + -- Least Median of Squares method to evaluate homography quality. + -> Float + -- ^ If htype is AF_HOMOGRAPHY_RANSAC, this parameter will five the maximum L2-distance for a point to be considered an inlier. + -> Int + -- ^ maximum number of iterations when htype is AF_HOMOGRAPHY_RANSAC and backend is CPU, if backend is CUDA or OpenCL, iterations is the total number of iterations, an iteration is a selection of 4 random points for which the homography is estimated and evaluated for number of inliers. + -> (Int, Array a) + -- ^ is a 3x3 array containing the estimated homography. + -- is the number of inliers that the homography was estimated to comprise, in the case that htype is AF_HOMOGRAPHY_RANSAC, a higher inlier_thr value will increase the estimated inliers. Note that if the number of inliers is too low, it is likely that a bad homography will be returned. +homography + (Array a) + (Array b) + (Array c) + (Array d) + (fromHomographyType -> homo) + inlier + (fromIntegral -> iterations) = do + unsafePerformIO . mask_ $ do + withForeignPtr a $ \aptr -> + withForeignPtr b $ \bptr -> + withForeignPtr c $ \cptr -> + withForeignPtr d $ \dptr -> do + alloca $ \outPtrA -> + alloca $ \outPtrI -> do + throwAFError =<< + af_homography + outPtrA + outPtrI + aptr + bptr + cptr + dptr + homo + inlier + iterations + dtype + arrayPtr <- peek outPtrA + (,) <$> do fromIntegral <$> peek outPtrI + <*> do Array <$> newForeignPtr af_release_array_finalizer arrayPtr + where + dtype = afType (Proxy @ a) diff --git a/test/ArrayFire/AlgorithmSpec.hs b/test/ArrayFire/AlgorithmSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/AlgorithmSpec.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.AlgorithmSpec where + +import qualified ArrayFire as A + +import Test.Hspec + +spec :: Spec +spec = + describe "Algorithm tests" $ do + it "Should sum a scalar" $ do + A.sum (A.scalar @Int 10) 0 `shouldBe` 10 + A.sum (A.scalar @A.Int64 10) 0 `shouldBe` 10 + A.sum (A.scalar @A.Int32 10) 0 `shouldBe` 10 + A.sum (A.scalar @A.Int16 10) 0 `shouldBe` 10 + A.sum (A.scalar @Float 10) 0 `shouldBe` 10 + A.sum (A.scalar @A.Word32 10) 0 `shouldBe` 10 + A.sum (A.scalar @A.Word64 10) 0 `shouldBe` 10 + A.sum (A.scalar @Double 10) 0 `shouldBe` 10.0 + A.sum (A.scalar @(A.Complex Double) (1 A.:+ 1)) 0 `shouldBe` 1 A.:+ 1 + A.sum (A.scalar @(A.Complex Float) (1 A.:+ 1)) 0 `shouldBe` 1 A.:+ 1 + A.sum (A.scalar @A.CBool 1) 0 `shouldBe` 1 + A.sum (A.scalar @A.CBool 0) 0 `shouldBe` 0 + it "Should sum a vector" $ do + A.sum (A.vector @Int 10 [1..]) 0 `shouldBe` 55 + A.sum (A.vector @A.Int64 10 [1..]) 0 `shouldBe` 55 + A.sum (A.vector @A.Int32 10 [1..]) 0 `shouldBe` 55 + A.sum (A.vector @A.Int16 10 [1..]) 0 `shouldBe` 55 + A.sum (A.vector @Float 10 [1..]) 0 `shouldBe` 55 + A.sum (A.vector @A.Word32 10 [1..]) 0 `shouldBe` 55 + A.sum (A.vector @A.Word64 10 [1..]) 0 `shouldBe` 55 + A.sum (A.vector @Double 10 [1..]) 0 `shouldBe` 55.0 + A.sum (A.vector @(A.Complex Double) 10 (repeat (1 A.:+ 1))) 0 `shouldBe` 10.0 A.:+ 10.0 + A.sum (A.vector @(A.Complex Float) 10 (repeat (1 A.:+ 1))) 0 `shouldBe` 10.0 A.:+ 10.0 + A.sum (A.vector @A.CBool 10 (repeat 1)) 0 `shouldBe` 10 + A.sum (A.vector @A.CBool 10 (repeat 0)) 0 `shouldBe` 0 + it "Should sum a default value to replace NaN" $ do + A.sumNaN (A.vector @Float 10 [1..]) 0 1.0 `shouldBe` 55 + A.sumNaN (A.vector @Double 2 [acos 2, acos 2]) 0 50 `shouldBe` 100 + A.sumNaN (A.vector @(A.Complex Float) 10 (repeat (1 A.:+ 1))) 0 1.0 `shouldBe` 10.0 A.:+ 10.0 + A.sumNaN (A.vector @(A.Complex Double) 10 (repeat (1 A.:+ 1))) 0 1.0 `shouldBe` 10.0 A.:+ 10.0 + it "Should product a scalar" $ do + A.product (A.scalar @Int 10) 0 `shouldBe` 10 + A.product (A.scalar @A.Int64 10) 0 `shouldBe` 10 + A.product (A.scalar @A.Int32 10) 0 `shouldBe` 10 + A.product (A.scalar @A.Int16 10) 0 `shouldBe` 10 + A.product (A.scalar @Float 10) 0 `shouldBe` 10 + A.product (A.scalar @A.Word32 10) 0 `shouldBe` 10 + A.product (A.scalar @A.Word64 10) 0 `shouldBe` 10 + A.product (A.scalar @Double 10) 0 `shouldBe` 10.0 + A.product (A.scalar @(A.Complex Double) (1 A.:+ 1)) 0 `shouldBe` 1 A.:+ 1 + A.product (A.scalar @(A.Complex Float) (1 A.:+ 1)) 0 `shouldBe` 1 A.:+ 1 + A.product (A.scalar @A.CBool 1) 0 `shouldBe` 1 + A.product (A.scalar @A.CBool 0) 0 `shouldBe` 0 + it "Should product a vector" $ do + A.product (A.vector @Int 10 [1..]) 0 `shouldBe` 3628800 + A.product (A.vector @A.Int64 10 [1..]) 0 `shouldBe` 3628800 + A.product (A.vector @A.Int32 10 [1..]) 0 `shouldBe` 3628800 + A.product (A.vector @A.Int16 5 [1..]) 0 `shouldBe` 120 + A.product (A.vector @Float 10 [1..]) 0 `shouldBe` 3628800 + A.product (A.vector @A.Word32 10 [1..]) 0 `shouldBe` 3628800 + A.product (A.vector @A.Word64 10 [1..]) 0 `shouldBe` 3628800 + A.product (A.vector @Double 10 [1..]) 0 `shouldBe` 3628800.0 + A.product (A.vector @(A.Complex Double) 10 (repeat (1 A.:+ 1))) 0 `shouldBe` 0.0 A.:+ 32.0 + A.product (A.vector @(A.Complex Float) 10 (repeat (1 A.:+ 1))) 0 `shouldBe` 0.0 A.:+ 32.0 + A.product (A.vector @A.CBool 10 (repeat 1)) 0 `shouldBe` 10 -- FIXME: This is a bug, should be 0 + A.product (A.vector @A.CBool 10 (repeat 0)) 0 `shouldBe` 0 + it "Should product a default value to replace NaN" $ do + A.productNaN (A.vector @Float 10 [1..]) 0 1.0 `shouldBe` 3628800.0 + A.productNaN (A.vector @Double 2 [acos 2, acos 2]) 0 50 `shouldBe` 2500 + A.productNaN (A.vector @(A.Complex Float) 10 (repeat (1 A.:+ 1))) 0 1.0 `shouldBe` 0.0 A.:+ 32 + A.productNaN (A.vector @(A.Complex Double) 10 (repeat (1 A.:+ 1))) 0 1.0 `shouldBe` 0 A.:+ 32 + it "Should take the minimum element of a vector" $ do + A.min (A.vector @Int 10 [1..]) 0 `shouldBe` 1 + A.min (A.vector @A.Int64 10 [1..]) 0 `shouldBe` 1 + A.min (A.vector @A.Int32 10 [1..]) 0 `shouldBe` 1 + A.min (A.vector @A.Int16 10 [1..]) 0 `shouldBe` 1 + A.min (A.vector @Float 10 [1..]) 0 `shouldBe` 1 + A.min (A.vector @A.Word32 10 [1..]) 0 `shouldBe` 1 + A.min (A.vector @A.Word64 10 [1..]) 0 `shouldBe` 1 + A.min (A.vector @Double 10 [1..]) 0 `shouldBe` 1 + A.min (A.vector @(A.Complex Double) 10 (repeat (1 A.:+ 1))) 0 `shouldBe` 1 A.:+ 1 + A.min (A.vector @(A.Complex Float) 10 (repeat (1 A.:+ 1))) 0 `shouldBe` 1 A.:+ 1 + A.min (A.vector @A.CBool 10 [1..]) 0 `shouldBe` 1 + A.min (A.vector @A.CBool 10 [1..]) 0 `shouldBe` 1 + it "Should find if all elements are true along dimension" $ do + A.allTrue (A.vector @Double 5 (repeat 12.0)) 0 `shouldBe` True + A.allTrue (A.vector @A.CBool 5 (repeat 1)) 0 `shouldBe` True + A.allTrue (A.vector @A.CBool 5 (repeat 0)) 0 `shouldBe` False + A.allTrue (A.vector @A.CBool 5 (repeat 0)) 0 `shouldBe` False + it "Should find if any elements are true along dimension" $ do + A.anyTrue (A.vector @A.CBool 5 (repeat 1)) 0 `shouldBe` True + A.anyTrue (A.vector @Int 5 (repeat 23)) 0 `shouldBe` True + A.anyTrue (A.vector @A.CBool 5 (repeat 0)) 0 `shouldBe` False + it "Should get count of all elements" $ do + A.count (A.vector @Int 5 (repeat 1)) 0 `shouldBe` 5 + A.count (A.vector @A.CBool 5 (repeat 1)) 0 `shouldBe` 5 + A.count (A.vector @Double 5 (repeat 1)) 0 `shouldBe` 5 + A.count (A.vector @Float 5 (repeat 1)) 0 `shouldBe` 5 + it "Should get sum all elements" $ do + A.sumAll (A.vector @Int 5 (repeat 2)) `shouldBe` (10,0) + A.sumAll (A.vector @Double 5 (repeat 2)) `shouldBe` (10.0,0) + -- A.sumAll (A.vector @A.CBool 3800 (repeat 1)) `shouldBe` (3800,0) -- causes strange behavior + A.sumAll (A.vector @(A.Complex Double) 5 (repeat (2 A.:+ 0))) `shouldBe` (10.0,0) + it "Should get sum all elements" $ do + A.sumNaNAll (A.vector @Double 2 [10, acos 2]) 1 `shouldBe` (11.0,0) + it "Should product all elements in an Array" $ do + A.productAll (A.vector @Int 5 (repeat 2)) `shouldBe` (32,0) + it "Should product all elements in an Array" $ do + A.productNaNAll (A.vector @Double 2 [10,acos 2]) 10 `shouldBe` (100,0) + it "Should find minimum value of an Array" $ do + A.minAll (A.vector @Int 5 [0..]) `shouldBe` (0,0) + it "Should find maximum value of an Array" $ do + A.maxAll (A.vector @Int 5 [0..]) `shouldBe` (4,0) +-- it "Should find if all elements are true" $ do +-- A.allTrue (A.vector @A.CBool 5 (repeat 0)) `shouldBe` False + diff --git a/test/ArrayFire/ArithSpec.hs b/test/ArrayFire/ArithSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/ArithSpec.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.ArithSpec where + +import ArrayFire hiding (acos) +import Prelude hiding (sqrt, div, and, or, not, isNaN) +import Test.Hspec +import Foreign.C + +spec :: Spec +spec = + describe "Arith tests" $ do + it "Should negate scalar value" $ do + negate (scalar @Int 1) `shouldBe` (-1) + it "Should negate a vector" $ do + negate (vector @Int 3 [2,2,2]) `shouldBe` vector @Int 3 [-2,-2,-2] + it "Should add two scalar arrays" $ do + scalar @Int 1 + 2 `shouldBe` 3 + it "Should add two scalar bool arrays" $ do + scalar @CBool 1 + 0 `shouldBe` 1 + it "Should subtract two scalar arrays" $ do + scalar @Int 4 - 2 `shouldBe` 2 + it "Should multiply two scalar arrays" $ do + scalar @Double 4 `mul` 2 `shouldBe` 8 + it "Should divide two scalar arrays" $ do + div @Double 8 2 `shouldBe` 4 + it "Should add two matrices" $ do + matrix @Int (2,2) [[1,1],[1,1]] + matrix @Int (2,2) [[1,1],[1,1]] + `shouldBe` + matrix @Int (2,2) [[2,2],[2,2]] + it "Should take cubed root" $ do + 3 `shouldBe` cbrt @Double 27 + it "Should take square root" $ do + 2 `shouldBe` sqrt @Double 4 + it "Should lt Array" $ do + 2 < (3 :: Array Double) `shouldBe` True + it "Should lte Array" $ do + 2 <= (3 :: Array Double) `shouldBe` True + it "Should gte Array" $ do + 2 >= (3 :: Array Double) `shouldBe` False + it "Should gt Array" $ do + 2 > (3 :: Array Double) `shouldBe` False + it "Should eq Array" $ do + 3 == (3 :: Array Double) `shouldBe` True + it "Should and Array" $ do + (mkArray @CBool [1] [0] `and` mkArray [1] [1]) + `shouldBe` mkArray [1] [0] + it "Should and Array" $ do + (mkArray @CBool [2] [0,0] `and` mkArray [2] [1,0]) + `shouldBe` mkArray [2] [0, 0] + it "Should or Array" $ do + (mkArray @CBool [2] [0,0] `or` mkArray [2] [1,0]) + `shouldBe` mkArray [2] [1, 0] + it "Should not Array" $ do + not (mkArray @CBool [2] [1,0]) `shouldBe` mkArray [2] [0,1] + it "Should bitwise and array" $ do + bitAnd (scalar @Int 1) (scalar @Int 0) + `shouldBe` + 0 + it "Should bitwise or array" $ do + bitOr (scalar @Int 1) (scalar @Int 0) + `shouldBe` + 1 + it "Should bitwise xor array" $ do + bitXor (scalar @Int 1) (scalar @Int 1) + `shouldBe` + 0 + it "Should bitwise shift left an array" $ do + bitShiftL (scalar @Int 1) (scalar @Int 3) + `shouldBe` + 8 + it "Should cast an array" $ do + getType (cast (scalar @Int 1) :: Array Double) + `shouldBe` + F64 + it "Should find the minimum of two arrays" $ do + minOf (scalar @Int 1) (scalar @Int 0) + `shouldBe` + 0 + it "Should find the max of two arrays" $ do + maxOf (scalar @Int 1) (scalar @Int 0) + `shouldBe` + 1 + it "Should take the clamp of 3 arrays" $ do + clamp (scalar @Int 2) (scalar @Int 1) (scalar @Int 3) + `shouldBe` + 2 + it "Should check if an array has positive or negative infinities" $ do + isInf (scalar @Double (1 / 0)) `shouldBe` scalar @Double 1 + isInf (scalar @Double 10) `shouldBe` scalar @Double 0 + it "Should check if an array has any NaN values" $ do + isNaN (scalar @Double (acos 2)) `shouldBe` scalar @Double 1 + isNaN (scalar @Double 10) `shouldBe` scalar @Double 0 + it "Should check if an array has any Zero values" $ do + isZero (scalar @Double (acos 2)) `shouldBe` scalar @Double 0 + isZero (scalar @Double 0) `shouldBe` scalar @Double 1 + isZero (scalar @Double 1) `shouldBe` scalar @Double 0 diff --git a/test/ArrayFire/ArraySpec.hs b/test/ArrayFire/ArraySpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/ArraySpec.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module ArrayFire.ArraySpec where + +import Control.Exception +import Data.Complex +import Data.Word +import Foreign.C.Types +import GHC.Int +import Test.Hspec + +import ArrayFire + +spec :: Spec +spec = + describe "Array tests" $ do + it "Should perform Array tests" $ do + (1 + 1) `shouldBe` 2 + it "Should fail to create 0 dimension arrays" $ do + let arr = mkArray @Int [0,0,0,0] [1..] + evaluate arr `shouldThrow` anyException + it "Should fail to create 0 length arrays" $ do + let arr = mkArray @Int [0,0,0,1] [] + evaluate arr `shouldThrow` anyException + it "Should fail to create 0 length arrays w/ 0 dimensions" $ do + let arr = mkArray @Int [0,0,0,0] [] + evaluate arr `shouldThrow` anyException + it "Should create a column vector" $ do + let arr = mkArray @Int [9,1,1,1] (repeat 9) + isColumn arr `shouldBe` True + it "Should create a row vector" $ do + let arr = mkArray @Int [1,9,1,1] (repeat 9) + isRow arr `shouldBe` True + it "Should create a vector" $ do + let arr = mkArray @Int [9,1,1,1] (repeat 9) + isVector arr `shouldBe` True + it "Should create a vector" $ do + let arr = mkArray @Int [1,9,1,1] (repeat 9) + isVector arr `shouldBe` True + it "Should copy an array" $ do + let arr = mkArray @Int [9,9,1,1] (repeat 9) + let newArray = copyArray arr + newArray `shouldBe` arr + it "Should modify manual eval flag" $ do + setManualEvalFlag False + (`shouldBe` False) =<< getManualEvalFlag + it "Should return the number of elements" $ do + let arr = mkArray @Int [9,9,1,1] [1..] + getElements arr `shouldBe` 81 +-- it "Should give an empty array" $ do +-- let arr = mkArray @Int [-1,1,1,1] [] +-- getElements arr `shouldBe` 0 +-- isEmpty arr `shouldBe` True + it "Should create a scalar array" $ do + let arr = mkArray @Int [1] [1] + isScalar arr `shouldBe` True + it "Should get number of dims specified" $ do + let arr = mkArray @Int [1,1,1,1] [1] + getNumDims arr `shouldBe` 1 + let arr = mkArray @Int [2,3,4,5] [1..] + getNumDims arr `shouldBe` 4 + let arr = mkArray @Int [2,3,4] [1..] + getNumDims arr `shouldBe` 3 + it "Should get value of dims specified" $ do + let arr = mkArray @Int [2,3,4,5] (repeat 1) + getDims arr `shouldBe` (2,3,4,5) + + it "Should test Sparsity" $ do + let arr = mkArray @Double [2,2,1,1] (repeat 1) + isSparse arr `shouldBe` False + + it "Should make a Bit array" $ do + let arr = mkArray @CBool [2,2] [1,1,1,1] + isBool arr `shouldBe` True + + it "Should make an integer array" $ do + let arr = mkArray @Int [2,2] (repeat 1) + isInteger arr `shouldBe` True + + it "Should make a Floating array" $ do + let arr = mkArray @Double [2,2] (repeat 1) + isFloating arr `shouldBe` True + let arr = mkArray @CBool [2,2] (repeat 1) + isFloating arr `shouldBe` False + + it "Should make a Complex array" $ do + let arr = mkArray @(Complex Double) [2,2] (repeat 1) + isComplex arr `shouldBe` True + isReal arr `shouldBe` False + + it "Should make a Real array" $ do + let arr = mkArray @Double [2,2] (repeat 1) + isReal arr `shouldBe` True + isComplex arr `shouldBe` False + + it "Should make a Double precision array" $ do + let arr = mkArray @Double [2,2] (repeat 1) + isDouble arr `shouldBe` True + isSingle arr `shouldBe` False + + it "Should make a Single precision array" $ do + let arr = mkArray @Float [2,2] (repeat 1) + isDouble arr `shouldBe` False + isSingle arr `shouldBe` True + + it "Should make a Real floating array" $ do + let arr = mkArray @Float [2,2] (repeat 1) + isRealFloating arr `shouldBe` True + let arr = mkArray @Double [2,2] (repeat 1) + isRealFloating arr `shouldBe` True + + it "Should get reference count" $ do + let arr1 = mkArray @Float [2,2] (repeat 1) + arr2 = retainArray arr1 + arr3 = retainArray arr2 + getDataRefCount arr3 `shouldBe` 3 + + it "Should convert an array to a list" $ do + let arr = mkArray @Double [30,30] (repeat 1) + toList arr `shouldBe` Prelude.replicate (30 * 30) 1 + + let arr = mkArray @Float [10,10] (repeat (5.5)) + toList arr `shouldBe` Prelude.replicate 100 5.5 + + let arr = mkArray @CBool [4] [1,1,0,1] + toList arr `shouldBe` [1,1,0,1] + + let arr = mkArray @Int16 [10] [1..] + toList arr `shouldBe` [1..10] + + let arr = mkArray @Int32 [100] [1..100] + toList arr `shouldBe` [1..100] + + let arr = mkArray @Int64 [100] [1..100] + toList arr `shouldBe` [1..100] + + let arr = mkArray @Int [100] [1..100] + toList arr `shouldBe` [1..100] + + let arr = mkArray @(Complex Float) [1] [1 :+ 1] + toList arr `shouldBe` [1 :+ 1] + + let arr = mkArray @(Complex Double) [1] [1 :+ 1] + toList arr `shouldBe` [1 :+ 1] + + let arr = mkArray @Word16 [10] [1..10] + toList arr `shouldBe` [1..10] + + let arr = mkArray @Word32 [10] [1..10] + toList arr `shouldBe` [1..10] + + let arr = mkArray @Word64 [10] [1..10] + toList arr `shouldBe` [1..10] + + let arr = mkArray @Word [10] [1..10] + toList arr `shouldBe` [1..10] diff --git a/test/ArrayFire/BLASSpec.hs b/test/ArrayFire/BLASSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/BLASSpec.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.BLASSpec where + +import ArrayFire hiding (not) + +import Data.Complex +import Test.Hspec + +spec :: Spec +spec = + describe "BLAS spec" $ do + it "Should matmul two matrices" $ do + (matrix @Double (2,2) [[2,2],[2,2]] `matmul` matrix @Double (2,2) [[2,2],[2,2]]) None None + `shouldBe` matrix @Double (2,2) [[8,8],[8,8]] + it "Should dot product two vectors" $ do + dot (vector @Double 2 (repeat 2)) (vector @Double 2 (repeat 2)) None None + `shouldBe` + scalar @Double 8 + it "Should produce scalar dot product between two vectors as a Complex number" $ do + dotAll (vector @Double 2 (repeat 2)) (vector @Double 2 (repeat 2)) None None + `shouldBe` + 8.0 :+ 0.0 + it "Should take the transpose of a matrix" $ do + transpose (matrix @Double (2,2) [[1,1],[2,2]]) False + `shouldBe` + matrix @Double (2,2) [[1,2],[1,2]] + it "Should take the transpose of a matrix in place" $ do + let m = matrix @Double (2,2) [[1,1],[2,2]] + transposeInPlace m False + m `shouldBe` matrix @Double (2,2) [[1,2],[1,2]] + + + + + diff --git a/test/ArrayFire/BackendSpec.hs b/test/ArrayFire/BackendSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/BackendSpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.BackendSpec where + +import ArrayFire hiding (not) + +import Test.Hspec + +spec :: Spec +spec = + describe "Backend spec" $ do + it "Should get backend count" $ do + (`shouldSatisfy` (>0)) =<< getBackendCount + it "Should get available backends" $ do + backends <- getAvailableBackends + backends `shouldSatisfy` (CPU `elem`) + it "Should set backend to CPU" $ do + backend <- getActiveBackend + setBackend backend + (`shouldBe` backend) =<< getActiveBackend + let arr = matrix @Int (2,2) [[1,1],[1,1]] + getBackend arr `shouldBe` backend diff --git a/test/ArrayFire/DataSpec.hs b/test/ArrayFire/DataSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/DataSpec.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module ArrayFire.DataSpec where + +import Control.Exception +import Data.Complex +import Data.Word +import Foreign.C.Types +import GHC.Int +import Test.Hspec + +import ArrayFire + +spec :: Spec +spec = + describe "Data tests" $ do + it "Should create constant Array" $ do + constant @Float [1] 1 `shouldBe` 1 + constant @Double [1] 1 `shouldBe` 1 + constant @Int16 [1] 1 `shouldBe` 1 + constant @Int32 [1] 1 `shouldBe` 1 + constant @Int64 [1] 1 `shouldBe` 1 + constant @Int [1] 1 `shouldBe` 1 + constant @Word16 [1] 1 `shouldBe` 1 + constant @Word32 [1] 1 `shouldBe` 1 + constant @Word64 [1] 1 `shouldBe` 1 + constant @Word [1] 1 `shouldBe` 1 + constant @CBool [1] 1 `shouldBe` 1 + constant @(Complex Double) [1] (1.0 :+ 1.0) + `shouldBe` + constant @(Complex Double) [1] (1.0 :+ 1.0) + constant @(Complex Float) [1] (1.0 :+ 1.0) + `shouldBe` + constant @(Complex Float) [1] (1.0 :+ 1.0) diff --git a/test/ArrayFire/DeviceSpec.hs b/test/ArrayFire/DeviceSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/DeviceSpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.DeviceSpec where + +import qualified ArrayFire as A +import Foreign.C.Types +import Test.Hspec + +spec :: Spec +spec = + describe "Algorithm tests" $ do + it "Should show device info" $ do + A.info `shouldReturn` () + it "Should show device init" $ do + A.afInit `shouldReturn` () + it "Should get info string" $ do + A.getInfoString >>= (`shouldSatisfy` (not . null)) + it "Should get device" $ do + A.getDevice >>= (`shouldSatisfy` (>= 0)) + it "Should get and set device" $ do + (A.getDevice >>= A.setDevice) `shouldReturn` () + diff --git a/test/ArrayFire/FeaturesSpec.hs b/test/ArrayFire/FeaturesSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/FeaturesSpec.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.FeaturesSpec where + +import ArrayFire hiding (acos) +import Prelude +import Test.Hspec + +spec :: Spec +spec = + describe "Feautures tests" $ do + it "Should get features number an array" $ do + let feats = createFeatures 10 + getFeaturesNum feats `shouldBe` 10 diff --git a/test/ArrayFire/GraphicsSpec.hs b/test/ArrayFire/GraphicsSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/GraphicsSpec.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module ArrayFire.GraphicsSpec where + +import Control.Exception +import Data.Complex +import Data.Word +import Foreign.C.Types +import GHC.Int +import Test.Hspec + +import ArrayFire + +spec :: Spec +spec = + describe "Graphics tests" $ do + it "Should create window" $ do + (1 + 1) `shouldBe` 2 diff --git a/test/ArrayFire/ImageSpec.hs b/test/ArrayFire/ImageSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/ImageSpec.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module ArrayFire.ImageSpec where + +import Control.Exception +import Data.Complex +import Data.Word +import Foreign.C.Types +import GHC.Int +import Test.Hspec + +import ArrayFire + +spec :: Spec +spec = + describe "Image tests" $ do + it "Should test if Image I/O is available" $ do + isImageIOAvailable `shouldReturn` True diff --git a/test/ArrayFire/IndexSpec.hs b/test/ArrayFire/IndexSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/IndexSpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeApplications #-} +module ArrayFire.IndexSpec where + +import qualified ArrayFire as A +import Control.Exception +import Data.Complex +import Data.Int +import Data.Proxy +import Data.Word +import Foreign.C.Types +import Test.Hspec + +spec :: Spec +spec = + describe "Index spec" $ do + it "Should index into an array" $ do + let arr = A.vector @Int 10 [1..] + A.index arr [A.Seq 0 4 1] + `shouldBe` + A.vector @Int 5 [1..] diff --git a/test/ArrayFire/LAPACKSpec.hs b/test/ArrayFire/LAPACKSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/LAPACKSpec.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.LAPACKSpec where + +import qualified ArrayFire as A +import Prelude +import Test.Hspec + +spec :: Spec +spec = + describe "LAPACK spec" $ do + it "Should have LAPACK available" $ do + A.isLAPACKAvailable `shouldBe` True + it "Should perform svd" $ do + let (s,v,d) = A.svd $ A.matrix @Double (4,2) [ [1,2], [3,4], [5,6], [7,8] ] + A.getDims s `shouldBe` (4,4,1,1) + A.getDims v `shouldBe` (2,1,1,1) + A.getDims d `shouldBe` (2,2,1,1) + it "Should perform svd in place" $ do + let (s,v,d) = A.svdInPlace $ A.matrix @Double (4,2) [ [1,2], [3,4], [5,6], [7,8] ] + A.getDims s `shouldBe` (4,4,1,1) + A.getDims v `shouldBe` (2,1,1,1) + A.getDims d `shouldBe` (2,2,1,1) + it "Should perform lu" $ do + let (s,v,d) = A.lu $ A.matrix @Double (2,2) [[3,1],[4,2]] + A.getDims s `shouldBe` (2,2,1,1) + A.getDims v `shouldBe` (2,2,1,1) + A.getDims d `shouldBe` (2,1,1,1) + it "Should perform qr" $ do + let (s,v,d) = A.lu $ A.matrix @Double (3,3) [[12,6,4],[-51,167,24],[4,-68,-41]] + A.getDims s `shouldBe` (3,3,1,1) + A.getDims v `shouldBe` (3,3,1,1) + A.getDims d `shouldBe` (3,1,1,1) + it "Should get determinant of Double" $ do + let eles = [[3 A.:+ 1, 8 A.:+ 1], [4 A.:+ 1, 6 A.:+ 1]] + (x,y) = A.det (A.matrix @(A.Complex Double) (2,2) eles) + x `shouldBe` (-14) + let (x,y) = A.det $ A.matrix @Double (2,2) [[3,8],[4,6]] + x `shouldBe` (-14) + it "Should calculate inverse" $ do + let x = flip A.inverse A.None $ A.matrix @Double (2,2) [[4,7],[2,6]] + x `shouldBe` A.matrix @Double (2,2) [[0.6,-0.2],[-0.7,0.4]] +-- it "Should calculate psuedo inverse" $ do +-- let x = A.pinverse (A.matrix @Double (2,2) [[4,7],[2,6]]) 1.0 A.None +-- x `shouldBe` A.matrix @Double (2,2) [[0.6,-0.2],[-0.7,0.4]] diff --git a/test/ArrayFire/RandomSpec.hs b/test/ArrayFire/RandomSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/RandomSpec.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.RandomSpec where + +import ArrayFire +import Control.Monad + +import Test.Hspec + +spec :: Spec +spec = + describe "Random engine spec" $ do + it "Should create random engine" $ do + (`shouldBe` Philox) + =<< getRandomEngineType + =<< createRandomEngine 5000 Philox + (`shouldBe` Mersenne) + =<< getRandomEngineType + =<< createRandomEngine 5000 Mersenne + (`shouldBe` ThreeFry) + =<< getRandomEngineType + =<< createRandomEngine 5000 ThreeFry + it "Should set random engine" $ do + r <- createRandomEngine 5000 ThreeFry + setRandomEngine r Philox + (`shouldBe` Philox) =<< getRandomEngineType r + it "Should set and get seed" $ do + setSeed 100 + (`shouldBe` 100) =<< getSeed + + diff --git a/test/ArrayFire/SignalSpec.hs b/test/ArrayFire/SignalSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/SignalSpec.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.SignalSpec where + +import qualified ArrayFire as A +import Data.Int +import Data.Word +import Data.Complex +import Data.Proxy +import Foreign.C.Types +import Test.Hspec + +spec :: Spec +spec = + describe "Signal spec" $ do + it "Should do FFT in place" $ do + A.fftInPlace (A.matrix @(Complex Double) (1,1) [[1 :+ 1]]) 10.2 + `shouldReturn` () + it "Should do FFT" $ do + A.fft (A.matrix @(Complex Float) (1,1) [[1 :+ 1]]) 1 1 + `shouldBe` A.matrix @(Complex Float) (1,1) [[1 :+ 1]] diff --git a/test/ArrayFire/SparseSpec.hs b/test/ArrayFire/SparseSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/SparseSpec.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.SparseSpec where + +import qualified ArrayFire as A +import Data.Int +import Data.Word +import Data.Complex +import Data.Proxy +import Foreign.C.Types +import Test.Hspec + +spec :: Spec +spec = + describe "Sparse spec" $ do + it "Should create a sparse array" $ do + (1+1) `shouldBe` 2 + -- A.createSparseArrayFromDense (A.matrix @Double (10,10) [1..]) A.CSR + -- `shouldBe` + -- A.vector @Double 10 [0..] diff --git a/test/ArrayFire/StatisticsSpec.hs b/test/ArrayFire/StatisticsSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/StatisticsSpec.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.StatisticsSpec where + +import ArrayFire hiding (not) + +import Data.Complex +import Test.Hspec + +spec :: Spec +spec = + describe "Statistics spec" $ do + it "Should find the mean" $ do + mean (vector @Double 10 [1..]) 0 + `shouldBe` + 5.5 + it "Should find the weighted-mean" $ do + meanWeighted (vector @Double 10 [1..]) (vector @Double 10 [1..]) 0 + `shouldBe` + 7.0 + it "Should find the variance" $ do + var (vector @Double 8 [1..8]) False 0 + `shouldBe` + 6.0 + it "Should find the weighted variance" $ do + varWeighted (vector @Double 8 [1..]) (vector @Double 8 (repeat 1)) 0 + `shouldBe` + 5.25 + it "Should find the standard deviation" $ do + stdev (vector @Double 10 (cycle [1,-1])) 0 + `shouldBe` + 1.0 + it "Should find the covariance" $ do + cov (vector @Double 10 (repeat 1)) (vector @Double 10 (repeat 1)) False + `shouldBe` + 0.0 + it "Should find the median" $ do + median (vector @Double 10 [1..]) 0 + `shouldBe` + 5.5 + it "Should find the mean of all elements across all dimensions" $ do + fst (meanAll (matrix @Double (2,2) [[10,10],[10,10]])) + `shouldBe` + 10 + it "Should find the weighted mean of all elements across all dimensions" $ do + fst (meanAllWeighted (matrix @Double (2,2) [[10,10],[10,10]]) (matrix @Double (2,2) [[10,10],[10,10]])) + `shouldBe` + 10 + it "Should find the variance of all elements across all dimensions" $ do + fst (varAll (vector @Double 10 (repeat 10)) False) + `shouldBe` + 0 + it "Should find the weighted variance of all elements across all dimensions" $ do + fst (varAllWeighted (vector @Double 10 (repeat 10)) (vector @Double 10 (repeat 10))) + `shouldBe` + 0 + it "Should find the stdev of all elements across all dimensions" $ do + fst (stdevAll (vector @Double 10 (repeat 10))) + `shouldBe` + 0 + it "Should find the median of all elements across all dimensions" $ do + fst (medianAll (vector @Double 10 [1..])) + `shouldBe` + 5.5 + it "Should find the correlation coefficient" $ do + fst (corrCoef (vector @Int 10 [1..] ) ( vector @Int 10 [10,9..] )) + `shouldBe` + (-1.0) + it "Should find the top k elements" $ do + let (vals,indexes) = topk ( vector @Double 10 [1..] ) 3 TopKDefault + vals `shouldBe` vector @Double 3 [10,9,8] + indexes `shouldBe` vector @Double 3 [9,8,7] diff --git a/test/ArrayFire/UtilSpec.hs b/test/ArrayFire/UtilSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/UtilSpec.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.UtilSpec where + +import qualified ArrayFire as A + +import Data.Complex +import Data.Int +import Data.Proxy +import Data.Word +import Foreign.C.Types +import System.Directory +import Test.Hspec + +spec :: Spec +spec = + describe "Util spec" $ do + it "Should get size of" $ do + A.getSizeOf (Proxy @ Int) `shouldBe` 8 + A.getSizeOf (Proxy @ Int64) `shouldBe` 8 + A.getSizeOf (Proxy @ Int32) `shouldBe` 4 + A.getSizeOf (Proxy @ Int16) `shouldBe` 2 + A.getSizeOf (Proxy @ Word) `shouldBe` 8 + A.getSizeOf (Proxy @ Word64) `shouldBe` 8 + A.getSizeOf (Proxy @ Word32) `shouldBe` 4 + A.getSizeOf (Proxy @ Word16) `shouldBe` 2 + A.getSizeOf (Proxy @ Word8) `shouldBe` 1 + A.getSizeOf (Proxy @ CBool) `shouldBe` 1 + A.getSizeOf (Proxy @ Double) `shouldBe` 8 + A.getSizeOf (Proxy @ Float) `shouldBe` 4 + A.getSizeOf (Proxy @ (Complex Float)) `shouldBe` 8 + A.getSizeOf (Proxy @ (Complex Double)) `shouldBe` 16 + it "Should get version" $ do + x <- A.getVersion + x `shouldBe` (3,6,4) + it "Should get revision" $ do + x <- A.getRevision + x `shouldSatisfy` (not . null) + it "Should save / read array" $ do + let arr = A.constant @Int [1,1,1,1] 10 + idx <- A.saveArray "key" arr "file.array" False + doesFileExist "file.array" `shouldReturn` True + (`shouldBe` idx) =<< A.readArrayKeyCheck "file.array" "key" + (`shouldBe` arr) =<< A.readArrayIndex "file.array" idx + (`shouldBe` arr) =<< A.readArrayKey "file.array" "key" + removeFile "file.array" + diff --git a/test/ArrayFire/VisionSpec.hs b/test/ArrayFire/VisionSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArrayFire/VisionSpec.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.VisionSpec where + +import qualified ArrayFire as A +import Test.Hspec + +spec :: Spec +spec = + describe "Vision spec" $ do + it "Should construct Features for fast feature detection" $ do + let arr = A.vector @Int 30000 [1..] + let feats = A.fast arr 1.0 9 False 1.0 3 + (1 + 1) `shouldBe` 2 + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Main where + +import Control.Monad + +import Data.Proxy +import Spec (spec) +import Test.Hspec (hspec) +import Test.QuickCheck +import Test.QuickCheck.Classes + +import qualified ArrayFire as A +import ArrayFire (Array) + +import System.IO.Unsafe + +instance (A.AFType a, Arbitrary a) => Arbitrary (Array a) where + arbitrary = pure $ unsafePerformIO (A.randu [2,2]) + +main :: IO () +main = do +-- checks (Proxy :: Proxy (A.Array (A.Complex Float))) +-- checks (Proxy :: Proxy (A.Array (A.Complex Double))) +-- checks (Proxy :: Proxy (A.Array Double)) +-- checks (Proxy :: Proxy (A.Array Float)) +-- checks (Proxy :: Proxy (A.Array Double)) +-- checks (Proxy :: Proxy (A.Array A.Int16)) +-- checks (Proxy :: Proxy (A.Array A.Int32)) + -- checks (Proxy :: Proxy (A.Array A.CBool)) + -- checks (Proxy :: Proxy (A.Array Word)) + -- checks (Proxy :: Proxy (A.Array A.Word8)) + -- checks (Proxy :: Proxy (A.Array A.Word16)) + -- checks (Proxy :: Proxy (A.Array A.Word32)) +-- lawsCheck $ semigroupLaws (Proxy :: Proxy (A.Array Double)) +-- lawsCheck $ semigroupLaws (Proxy :: Proxy (A.Array Float)) + hspec spec + +checks proxy = do + lawsCheck (numLaws proxy) + lawsCheck (eqLaws proxy) + lawsCheck (ordLaws proxy) +-- lawsCheck (semigroupLaws proxy) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}