From d924d61d3cc62080907a56791592a83bb18d768a Mon Sep 17 00:00:00 2001 From: dmjio Date: Mon, 8 Jun 2026 19:57:51 +0000 Subject: [PATCH 1/3] deploy: 751279eace162a44eab999a996ed4d628d1d8bc4 --- .ghci | 7 + .gitignore | 9 + .nojekyll | 0 CHANGELOG.md | 5 + LICENSE | 30 + README.md | 99 ++ Setup.hs | 6 + arrayfire.cabal | 212 +++ cabal.project | 6 + cbits/wrapper.c | 41 + default.nix | 8 + doctests/Main.hs | 15 + exe/Main.hs | 101 ++ flake.lock | 77 + flake.nix | 243 +++ gen/Lex.hs | 39 + gen/Main.hs | 83 + gen/Parse.hs | 61 + gen/Print.hs | 62 + gen/Types.hs | 35 + include/algorithm.h | 36 + include/arith.h | 72 + include/array.h | 33 + include/backend.h | 8 + include/blas.h | 7 + include/cuda.h | 5 + include/data.h | 26 + include/defines.h | 469 ++++++ include/device.h | 28 + include/exception.h | 5 + include/features.h | 11 + include/graphics.h | 31 + include/image.h | 45 + include/index.h | 12 + include/internal.h | 9 + include/lapack.h | 17 + include/openCL.h | 11 + include/random.h | 17 + include/seq.h | 3 + include/signal.h | 35 + include/sparse.h | 13 + include/statistics.h | 17 + include/util.h | 13 + include/vision.h | 13 + nix/default.nix | 79 + nix/no-download.patch | 28 + pkg.nix | 16 + shell.nix | 40 + src/ArrayFire.hs | 340 ++++ src/ArrayFire/Algorithm.hs | 659 ++++++++ src/ArrayFire/Arith.hs | 2094 +++++++++++++++++++++++++ src/ArrayFire/Array.hs | 507 ++++++ src/ArrayFire/BLAS.hs | 169 ++ src/ArrayFire/Backend.hs | 80 + src/ArrayFire/Data.hs | 619 ++++++++ src/ArrayFire/Device.hs | 90 ++ src/ArrayFire/Exception.hs | 118 ++ src/ArrayFire/FFI.hs | 507 ++++++ src/ArrayFire/Features.hs | 165 ++ src/ArrayFire/Graphics.hs | 676 ++++++++ src/ArrayFire/Image.hs | 762 +++++++++ src/ArrayFire/Index.hs | 105 ++ src/ArrayFire/Internal/Algorithm.hsc | 77 + src/ArrayFire/Internal/Arith.hsc | 149 ++ src/ArrayFire/Internal/Array.hsc | 71 + src/ArrayFire/Internal/BLAS.hsc | 19 + src/ArrayFire/Internal/Backend.hsc | 21 + src/ArrayFire/Internal/CUDA.hsc | 17 + src/ArrayFire/Internal/Data.hsc | 57 + src/ArrayFire/Internal/Defines.hsc | 425 +++++ src/ArrayFire/Internal/Device.hsc | 61 + src/ArrayFire/Internal/Exception.hsc | 13 + src/ArrayFire/Internal/Features.hsc | 27 + src/ArrayFire/Internal/Graphics.hsc | 68 + src/ArrayFire/Internal/Image.hsc | 95 ++ src/ArrayFire/Internal/Index.hsc | 30 + src/ArrayFire/Internal/Internal.hsc | 22 + src/ArrayFire/Internal/LAPACK.hsc | 39 + src/ArrayFire/Internal/OpenCL.hsc | 29 + src/ArrayFire/Internal/Random.hsc | 39 + src/ArrayFire/Internal/Seq.hsc | 13 + src/ArrayFire/Internal/Signal.hsc | 74 + src/ArrayFire/Internal/Sparse.hsc | 30 + src/ArrayFire/Internal/Statistics.hsc | 38 + src/ArrayFire/Internal/Types.hsc | 693 ++++++++ src/ArrayFire/Internal/Util.hsc | 30 + src/ArrayFire/Internal/Vision.hsc | 30 + src/ArrayFire/LAPACK.hs | 283 ++++ src/ArrayFire/Orphans.hs | 66 + src/ArrayFire/Random.hs | 343 ++++ src/ArrayFire/Signal.hs | 751 +++++++++ src/ArrayFire/Sparse.hs | 335 ++++ src/ArrayFire/Statistics.hs | 310 ++++ src/ArrayFire/Types.hs | 67 + src/ArrayFire/Util.hs | 285 ++++ src/ArrayFire/Vision.hs | 363 +++++ stack.yaml | 5 + stack.yaml.lock | 13 + test/ArrayFire/AlgorithmSpec.hs | 117 ++ test/ArrayFire/ArithSpec.hs | 168 ++ test/ArrayFire/ArraySpec.hs | 156 ++ test/ArrayFire/BLASSpec.hs | 35 + test/ArrayFire/BackendSpec.hs | 21 + test/ArrayFire/DataSpec.hs | 39 + test/ArrayFire/DeviceSpec.hs | 21 + test/ArrayFire/FeaturesSpec.hs | 13 + test/ArrayFire/GraphicsSpec.hs | 18 + test/ArrayFire/ImageSpec.hs | 18 + test/ArrayFire/IndexSpec.hs | 21 + test/ArrayFire/LAPACKSpec.hs | 45 + test/ArrayFire/RandomSpec.hs | 30 + test/ArrayFire/SignalSpec.hs | 20 + test/ArrayFire/SparseSpec.hs | 19 + test/ArrayFire/StatisticsSpec.hs | 72 + test/ArrayFire/UtilSpec.hs | 48 + test/ArrayFire/VisionSpec.hs | 14 + test/Main.hs | 44 + test/Spec.hs | 1 + test/Test/Hspec/ApproxExpect.hs | 19 + 119 files changed, 15056 insertions(+) create mode 100644 .ghci create mode 100644 .gitignore create mode 100644 .nojekyll create mode 100644 CHANGELOG.md create mode 100644 LICENSE create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 arrayfire.cabal create mode 100644 cabal.project create mode 100644 cbits/wrapper.c create mode 100644 default.nix create mode 100644 doctests/Main.hs create mode 100644 exe/Main.hs create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 gen/Lex.hs create mode 100644 gen/Main.hs create mode 100644 gen/Parse.hs create mode 100644 gen/Print.hs create mode 100644 gen/Types.hs create mode 100644 include/algorithm.h create mode 100644 include/arith.h create mode 100644 include/array.h create mode 100644 include/backend.h create mode 100644 include/blas.h create mode 100644 include/cuda.h create mode 100644 include/data.h create mode 100644 include/defines.h create mode 100644 include/device.h create mode 100644 include/exception.h create mode 100644 include/features.h create mode 100644 include/graphics.h create mode 100644 include/image.h create mode 100644 include/index.h create mode 100644 include/internal.h create mode 100644 include/lapack.h create mode 100644 include/openCL.h create mode 100644 include/random.h create mode 100644 include/seq.h create mode 100644 include/signal.h create mode 100644 include/sparse.h create mode 100644 include/statistics.h create mode 100644 include/util.h create mode 100644 include/vision.h create mode 100644 nix/default.nix create mode 100644 nix/no-download.patch create mode 100644 pkg.nix create mode 100644 shell.nix create mode 100644 src/ArrayFire.hs create mode 100644 src/ArrayFire/Algorithm.hs create mode 100644 src/ArrayFire/Arith.hs create mode 100644 src/ArrayFire/Array.hs create mode 100644 src/ArrayFire/BLAS.hs create mode 100644 src/ArrayFire/Backend.hs create mode 100644 src/ArrayFire/Data.hs create mode 100644 src/ArrayFire/Device.hs create mode 100644 src/ArrayFire/Exception.hs create mode 100644 src/ArrayFire/FFI.hs create mode 100644 src/ArrayFire/Features.hs create mode 100644 src/ArrayFire/Graphics.hs create mode 100644 src/ArrayFire/Image.hs create mode 100644 src/ArrayFire/Index.hs create mode 100644 src/ArrayFire/Internal/Algorithm.hsc create mode 100644 src/ArrayFire/Internal/Arith.hsc create mode 100644 src/ArrayFire/Internal/Array.hsc create mode 100644 src/ArrayFire/Internal/BLAS.hsc create mode 100644 src/ArrayFire/Internal/Backend.hsc create mode 100644 src/ArrayFire/Internal/CUDA.hsc create mode 100644 src/ArrayFire/Internal/Data.hsc create mode 100644 src/ArrayFire/Internal/Defines.hsc create mode 100644 src/ArrayFire/Internal/Device.hsc create mode 100644 src/ArrayFire/Internal/Exception.hsc create mode 100644 src/ArrayFire/Internal/Features.hsc create mode 100644 src/ArrayFire/Internal/Graphics.hsc create mode 100644 src/ArrayFire/Internal/Image.hsc create mode 100644 src/ArrayFire/Internal/Index.hsc create mode 100644 src/ArrayFire/Internal/Internal.hsc create mode 100644 src/ArrayFire/Internal/LAPACK.hsc create mode 100644 src/ArrayFire/Internal/OpenCL.hsc create mode 100644 src/ArrayFire/Internal/Random.hsc create mode 100644 src/ArrayFire/Internal/Seq.hsc create mode 100644 src/ArrayFire/Internal/Signal.hsc create mode 100644 src/ArrayFire/Internal/Sparse.hsc create mode 100644 src/ArrayFire/Internal/Statistics.hsc create mode 100644 src/ArrayFire/Internal/Types.hsc create mode 100644 src/ArrayFire/Internal/Util.hsc create mode 100644 src/ArrayFire/Internal/Vision.hsc create mode 100644 src/ArrayFire/LAPACK.hs create mode 100644 src/ArrayFire/Orphans.hs create mode 100644 src/ArrayFire/Random.hs create mode 100644 src/ArrayFire/Signal.hs create mode 100644 src/ArrayFire/Sparse.hs create mode 100644 src/ArrayFire/Statistics.hs create mode 100644 src/ArrayFire/Types.hs create mode 100644 src/ArrayFire/Util.hs create mode 100644 src/ArrayFire/Vision.hs create mode 100644 stack.yaml create mode 100644 stack.yaml.lock create mode 100644 test/ArrayFire/AlgorithmSpec.hs create mode 100644 test/ArrayFire/ArithSpec.hs create mode 100644 test/ArrayFire/ArraySpec.hs create mode 100644 test/ArrayFire/BLASSpec.hs create mode 100644 test/ArrayFire/BackendSpec.hs create mode 100644 test/ArrayFire/DataSpec.hs create mode 100644 test/ArrayFire/DeviceSpec.hs create mode 100644 test/ArrayFire/FeaturesSpec.hs create mode 100644 test/ArrayFire/GraphicsSpec.hs create mode 100644 test/ArrayFire/ImageSpec.hs create mode 100644 test/ArrayFire/IndexSpec.hs create mode 100644 test/ArrayFire/LAPACKSpec.hs create mode 100644 test/ArrayFire/RandomSpec.hs create mode 100644 test/ArrayFire/SignalSpec.hs create mode 100644 test/ArrayFire/SparseSpec.hs create mode 100644 test/ArrayFire/StatisticsSpec.hs create mode 100644 test/ArrayFire/UtilSpec.hs create mode 100644 test/ArrayFire/VisionSpec.hs create mode 100644 test/Main.hs create mode 100644 test/Spec.hs create mode 100644 test/Test/Hspec/ApproxExpect.hs diff --git a/.ghci b/.ghci new file mode 100644 index 0000000..4ef1af0 --- /dev/null +++ b/.ghci @@ -0,0 +1,7 @@ +:set prompt "\x03BB> " +:seti -XTypeApplications +:load ArrayFire +:m - ArrayFire +import qualified ArrayFire as A +:set -laf +:set -isrc:test diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..aee1772 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +dist* +result/ +/TAGS +/result +*~ +/ctags +cabal.project.local +tags +/.stack-work/ diff --git a/.nojekyll b/.nojekyll new file mode 100644 index 0000000..e69de29 diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..b6c2465 --- /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 index 0000000..3541bad --- /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/README.md b/README.md new file mode 100644 index 0000000..7e2e104 --- /dev/null +++ b/README.md @@ -0,0 +1,99 @@ +## + +[![CI](https://github.com/arrayfire/arrayfire-haskell/actions/workflows/ci.yml/badge.svg)](https://github.com/arrayfire/arrayfire-haskell/actions/workflows/ci.yml) +[![Hackage](https://img.shields.io/hackage/v/arrayfire.svg)](https://hackage.haskell.org/package/arrayfire) + +`ArrayFire` is a general-purpose library that simplifies the process of developing software that targets parallel and massively-parallel architectures including CPUs, GPUs, and other hardware acceleration devices. + +`arrayfire-haskell` is a [Haskell](https://haskell.org) binding to [ArrayFire](https://arrayfire.com). + +## Table of Contents + - [Installation](#Installation) + - [Haskell Installation](#haskell-installation) + - [Documentation](#Documentation) + - [Hacking](#Hacking) + - [Example](#Example) + + +## Installation +Install `ArrayFire` via the download page. + - https://arrayfire.com/download/ + +`ArrayFire` can also be fetched from [nixpkgs](https://github.com/nixos/nixpkgs) `master`. + +### Haskell Installation + +`arrayfire` can be installed w/ `cabal`, `stack` or `nix`. + +``` +cabal install arrayfire +``` + +``` +stack install arrayfire +``` + + +Also note, if you plan on using ArrayFire's visualization features, you must install `fontconfig` and `glfw` on OSX or Linux. + +## Documentation + - [Hackage](http://hackage.haskell.org/package/arrayfire) + - [ArrayFire](http://arrayfire.org/docs/gettingstarted.htm) + +## Hacking +To hack on this library locally, complete the installation step above. We recommend installing the [nix](https://nixos.org/nix/download.html) package manager to facilitate development. + +After the above tools are installed, clone the source from Github. + +```bash +git clone git@github.com:arrayfire/arrayfire-haskell.git +cd arrayfire-haskell +``` + +To build and run all tests in response to file changes + +```bash +nix-shell --run test-runner +``` + +To perform interactive development w/ `ghcid` + +```bash +nix-shell --run ghcid +``` + +To interactively evaluate code in the `repl` + +```bash +nix-shell --run repl +``` + +To produce the haddocks and open them in a browser + +```bash +nix-shell --run docs +``` + + +## Example +```haskell +{-# LANGUAGE TypeApplications, ScopedTypeVariables #-} +module Main where + +import qualified ArrayFire as A +import Control.Exception (catch) + +main :: IO () +main = print newArray `catch` (\(e :: A.AFException) -> print e) + where + newArray = A.matrix @Double (2,2) [ [1..], [1..] ] * A.matrix @Double (2,2) [ [2..], [2..] ] + +{-| + +ArrayFire Array +[2 2 1 1] + 2.0000 6.0000 + 2.0000 6.0000 + +-} +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..c0bc21b --- /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 index 0000000..d7474af --- /dev/null +++ b/arrayfire.cabal @@ -0,0 +1,212 @@ +cabal-version: 3.0 +name: arrayfire +version: 0.7.1.0 +synopsis: Haskell bindings to the ArrayFire general-purpose GPU library +homepage: https://github.com/arrayfire/arrayfire-haskell +license: BSD-3-Clause +license-file: LICENSE +author: David Johnson +maintainer: code@dmj.io +copyright: David Johnson (c) 2018-2026 +category: Math +build-type: Custom +extra-source-files: CHANGELOG.md +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 + +flag disable-build-tool-depends + description: When enabled, don't add build-tool-depends fields to the Cabal file. Needed for working inside @nix develop@. + default: False + manual: True + +custom-setup + setup-depends: + base <5, + Cabal < 3.17, + 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 + if !flag(disable-build-tool-depends) + build-tool-depends: + hsc2hs:hsc2hs + extra-libraries: + af + c-sources: + cbits/wrapper.c + build-depends: + base < 5, deepseq, filepath, vector + hs-source-dirs: + src + ghc-options: + -Wall -Wno-missing-home-modules + default-language: + Haskell2010 + + if os(linux) && !flag(disable-default-paths) + include-dirs: + /opt/arrayfire/include + extra-lib-dirs: + /opt/arrayfire/lib64 + ld-options: + -Wl,-rpath /opt/arrayfire/lib64 + + if 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 + other-modules: + Test.Hspec.ApproxExpect + hs-source-dirs: + test + build-depends: + arrayfire, + base < 5, + directory, + hspec, + HUnit, + QuickCheck, + quickcheck-classes, + vector, + call-stack >=0.4 && <0.5 + if !flag(disable-build-tool-depends) + build-tool-depends: + hspec-discover:hspec-discover + 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/cabal.project b/cabal.project new file mode 100644 index 0000000..e5c6ff0 --- /dev/null +++ b/cabal.project @@ -0,0 +1,6 @@ +packages: . +ignore-project: False +write-ghc-environment-files: always +tests: True +test-options: "--color" +test-show-details: streaming diff --git a/cbits/wrapper.c b/cbits/wrapper.c new file mode 100644 index 0000000..1b101a6 --- /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/default.nix b/default.nix new file mode 100644 index 0000000..dc282d7 --- /dev/null +++ b/default.nix @@ -0,0 +1,8 @@ +{ pkgs ? import { config.allowUnfree = true; } }: +# Latest arrayfire is not yet procured w/ nix. +let + pkg = pkgs.haskellPackages.callCabal2nix "arrayfire" ./. { + af = null; + }; +in + pkg diff --git a/doctests/Main.hs b/doctests/Main.hs new file mode 100644 index 0000000..da8596b --- /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 index 0000000..80f26ca --- /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/flake.lock b/flake.lock new file mode 100644 index 0000000..c767330 --- /dev/null +++ b/flake.lock @@ -0,0 +1,77 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1692792214, + "narHash": "sha256-voZDQOvqHsaReipVd3zTKSBwN7LZcUwi3/ThMxRZToU=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "1721b3e7c882f75f2301b00d48a2884af8c448ae", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nix-filter": { + "locked": { + "lastModified": 1687178632, + "narHash": "sha256-HS7YR5erss0JCaUijPeyg2XrisEb959FIct3n2TMGbE=", + "owner": "numtide", + "repo": "nix-filter", + "rev": "d90c75e8319d0dd9be67d933d8eb9d0894ec9174", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "nix-filter", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1692638711, + "narHash": "sha256-J0LgSFgJVGCC1+j5R2QndadWI1oumusg6hCtYAzLID4=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "91a22f76cd1716f9d0149e8a5c68424bb691de15", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nix-filter": "nix-filter", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..c8c3c30 --- /dev/null +++ b/flake.nix @@ -0,0 +1,243 @@ +{ + description = "arrayfire/arrayfire-haskell: ArrayFire Haskell bindings"; + + inputs = { + nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable"; + flake-utils.url = "github:numtide/flake-utils"; + nix-filter.url = "github:numtide/nix-filter"; + }; + + outputs = inputs: + let + src = inputs.nix-filter.lib { + root = ./.; + include = [ + "cbits" + "exe" + "gen" + "include" + "src" + "test" + "arrayfire.cabal" + "README.md" + "CHANGELOG.md" + "LICENSE" + ]; + }; + + # Build ArrayFire from the official Linux binary installer; avoids freeimage entirely. + mkArrayfireLinux = pkgs: pkgs.stdenv.mkDerivation rec { + pname = "arrayfire"; + version = "3.10.0"; + src = pkgs.fetchurl { + url = "https://arrayfire.s3.amazonaws.com/${version}/ArrayFire-v${version}_Linux_x86_64.sh"; + hash = "sha256-8SibCWnRxts79S6WEHb3skF2TIDl1QnjY6EiohmoIog="; + }; + nativeBuildInputs = [ pkgs.autoPatchelfHook ]; + # GPU/visualization libs (CUDA, OpenGL, GLFW, FreeImage, Intel OpenCL) are + # optional ArrayFire backends not available in headless CI environments. + autoPatchelfIgnoreMissingDeps = true; + buildInputs = with pkgs; [ + stdenv.cc.cc.lib + fftw + fftwFloat + openblas + ocl-icd + boost.out + ]; + unpackPhase = "true"; + installPhase = '' + mkdir -p $out + bash $src --exclude-subdir --prefix=$out + ''; + # autoPatchelfIgnoreMissingDeps silences missing-dep errors at build time, + # but a genuinely-absent dep of libafcpu.so would still make its runtime + # dlopen fail with LoadLibError. Fail the build loudly if the CPU backend + # has any unresolved (=> not just intentionally-ignored GPU) dependencies. + doInstallCheck = true; + installCheckPhase = '' + libdir=$out/lib64 + [ -d "$libdir" ] || libdir=$out/lib + cpu=$(echo "$libdir"/libafcpu.so* | tr ' ' '\n' | head -n1) + echo "Checking runtime deps of $cpu" + if ldd "$cpu" | grep -i 'not found'; then + echo "ERROR: libafcpu.so has unresolved dependencies" >&2 + exit 1 + fi + ''; + meta = { + description = "A general-purpose library for parallel and massively-parallel architectures"; + platforms = [ "x86_64-linux" ]; + }; + }; + + # Build ArrayFire on macOS from the official .pkg installer. ArrayFire has not + # shipped a macOS binary since 3.8.2 (x86_64 only), so darwin pins that version. + # The .pkg is a xar archive of component sub-packages, each carrying a + # gzip+cpio Payload that installs under opt/arrayfire/{include,lib}. + mkArrayfireDarwin = pkgs: pkgs.stdenv.mkDerivation rec { + pname = "arrayfire"; + version = "3.8.2"; + src = pkgs.fetchurl { + url = "https://arrayfire.s3.amazonaws.com/${version}/ArrayFire-${version}_OSX_x86_64.pkg"; + hash = "sha256-MDqpDONbzl+PNu2VS1UTaYL10fpzpt0pv10oxNwgm+k="; + }; + nativeBuildInputs = with pkgs; [ xar cpio fixDarwinDylibNames ]; + # Never strip the prebuilt vendor dylibs: the default strip phase corrupts + # them (it silently truncated libmkl_core.dylib to 0 bytes, which then made + # MKL fail to load its computational layer at runtime). + dontStrip = true; + unpackPhase = '' + runHook preUnpack + xar -xf $src + runHook postUnpack + ''; + # Extract every component Payload (except the heavy CUDA/OpenCL/examples ones + # we don't ship) into a staging tree, then install only the unified + CPU + # backends and their bundled runtime deps (MKL, TBB, forge). + installPhase = '' + runHook preInstall + mkdir -p stage + for comp in ArrayFire-${version}-Darwin-*.pkg; do + case "$comp" in + *cuda*|*opencl*|*examples*|*documentation*) continue ;; + esac + [ -f "$comp/Payload" ] || continue + ( cd stage && gzip -dc "../$comp/Payload" | cpio -id --quiet ) + done + + mkdir -p $out/lib + cp -R stage/opt/arrayfire/include $out/include + for pat in 'libaf.*' 'libafcpu.*' 'libforge.*' 'libmkl_*.dylib' \ + 'libtbb*.dylib' 'libiomp*.dylib'; do + cp -P stage/opt/arrayfire/lib/$pat $out/lib/ 2>/dev/null || true + done + runHook postInstall + ''; + # fixDarwinDylibNames (run in fixupPhase) rewrites the @rpath install ids + # and matching inter-library references to absolute store paths. It only + # rewrites references whose leaf matches a sibling's *original* id, so it + # misses cases where the ids differ, e.g. libafcpu -> @rpath/libmkl_rt and + # libmkl_tbb_thread -> @rpath/libtbb (the latter is dlopen'd by MKL's + # libmkl_rt and would otherwise fail to load at runtime). Re-point any + # remaining @rpath/ dep at $out/lib/ so everything is hermetic. + postFixup = '' + for dylib in $out/lib/*.dylib; do + for dep in $(otool -L "$dylib" | awk 'NR>1{print $1}' | grep '^@rpath/' || true); do + leaf=''${dep#@rpath/} + if [ -e "$out/lib/$leaf" ]; then + install_name_tool -change "$dep" "$out/lib/$leaf" "$dylib" + fi + done + done + ''; + meta = { + description = "A general-purpose library for parallel and massively-parallel architectures"; + platforms = [ "x86_64-darwin" ]; + }; + }; + + mkArrayfire = pkgs: + if pkgs.stdenv.isDarwin + then mkArrayfireDarwin pkgs + else mkArrayfireLinux pkgs; + + arrayfire-overlay = self: super: { + arrayfire = mkArrayfire self; + }; + + # An overlay that lets us test arrayfire-haskell with different GHC versions + arrayfire-haskell-overlay = self: super: { + haskell = super.haskell // { + packageOverrides = inputs.nixpkgs.lib.composeExtensions super.haskell.packageOverrides + (hself: hsuper: { + arrayfire = + let + pkg = self.haskell.lib.appendConfigureFlags + (hself.callCabal2nix "arrayfire" src { + af = self.arrayfire; + }) + [ "-f disable-default-paths" ]; + in + # On macOS ArrayFire's bundled MKL dlopens its threading layer + # (libmkl_tbb_thread.dylib) by bare leaf name, which dyld only + # resolves via DYLD_LIBRARY_PATH. Point it at the arrayfire libs + # so the test suite (and doctests) can run. Runtime consumers of + # this package need the same DYLD_LIBRARY_PATH. + if self.stdenv.isDarwin + then pkg.overrideAttrs (old: { + preCheck = (old.preCheck or "") + '' + export DYLD_LIBRARY_PATH="${self.arrayfire}/lib''${DYLD_LIBRARY_PATH:+:$DYLD_LIBRARY_PATH}" + ''; + }) + # On Linux we link against the unified backend (libaf), which is + # just a dispatcher that dlopens the real backend impl + # (libafcpu.so) at runtime. The sandboxed check phase has no + # LD_LIBRARY_PATH/AF_PATH, so that dlopen finds nothing and every + # test throws AFException LoadLibError (501). Point the loader at + # the arrayfire libs so the backend can be found. + else pkg.overrideAttrs (old: { + preCheck = (old.preCheck or "") + '' + export AF_PATH="${self.arrayfire}" + export LD_LIBRARY_PATH="${self.arrayfire}/lib:${self.arrayfire}/lib64''${LD_LIBRARY_PATH:+:$LD_LIBRARY_PATH}" + ''; + }); + }); + }; + }; + + devShell-for = pkgs: + let + ps = pkgs.haskellPackages; + isLinux = pkgs.stdenv.isLinux; + isDarwin = pkgs.stdenv.isDarwin; + # ArrayFire only ships an x86_64 macOS binary, so it's unavailable on + # Apple Silicon; fall back to a plain shell there. + hasArrayfire = isLinux || pkgs.stdenv.hostPlatform.system == "x86_64-darwin"; + in + ps.shellFor { + packages = ps: if hasArrayfire then [ ps.arrayfire ] else [ ]; + withHoogle = true; + buildInputs = with pkgs; (if isLinux then [ ocl-icd ] else [ darwin.apple_sdk.frameworks.Security ]); + nativeBuildInputs = with pkgs; with ps; [ + # Building and testing + cabal-install + doctest + hsc2hs + # hspec-discover + nil + # Formatters + nixpkgs-fmt + ]; + shellHook = + if isLinux then ''export LD_LIBRARY_PATH="${pkgs.arrayfire}/lib:$LD_LIBRARY_PATH"'' + else if hasArrayfire then ''export DYLD_LIBRARY_PATH="${pkgs.arrayfire}/lib:$DYLD_LIBRARY_PATH"'' + else ""; + }; + + pkgs-for = system: import inputs.nixpkgs { + inherit system; + overlays = [ + arrayfire-overlay + arrayfire-haskell-overlay + ]; + }; + in + { + packages = inputs.flake-utils.lib.eachDefaultSystemMap (system: + let + pkgs = pkgs-for system; + # ArrayFire only provides binaries for x86_64-linux and x86_64-darwin + # (no Apple Silicon / aarch64), so only expose the package there. + hasArrayfire = pkgs.stdenv.isLinux || system == "x86_64-darwin"; + in inputs.nixpkgs.lib.optionalAttrs hasArrayfire { + default = pkgs.haskellPackages.arrayfire; + }); + + devShells = inputs.flake-utils.lib.eachDefaultSystemMap (system: { + default = devShell-for (pkgs-for system); + }); + + overlays.default = arrayfire-haskell-overlay; + }; +} diff --git a/gen/Lex.hs b/gen/Lex.hs new file mode 100644 index 0000000..25367ae --- /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 index 0000000..6764baa --- /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 index 0000000..dfa693f --- /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 index 0000000..7a26160 --- /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 index 0000000..a81e717 --- /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/include/algorithm.h b/include/algorithm.h new file mode 100644 index 0000000..8894a73 --- /dev/null +++ b/include/algorithm.h @@ -0,0 +1,36 @@ +#include "defines.h" + +af_err af_sum(af_array *out, const af_array in, const int dim); +af_err af_sum_nan(af_array *out, const af_array in, const int dim, const double nanval); +af_err af_product(af_array *out, const af_array in, const int dim); +af_err af_product_nan(af_array *out, const af_array in, const int dim, const double nanval); +af_err af_min(af_array *out, const af_array in, const int dim); +af_err af_max(af_array *out, const af_array in, const int dim); +af_err af_all_true(af_array *out, const af_array in, const int dim); +af_err af_any_true(af_array *out, const af_array in, const int dim); +af_err af_count(af_array *out, const af_array in, const int dim); +af_err af_sum_all(double *real, double *imag, const af_array in); +af_err af_sum_nan_all(double *real, double *imag, const af_array in, const double nanval); +af_err af_product_all(double *real, double *imag, const af_array in); +af_err af_product_nan_all(double *real, double *imag, const af_array in, const double nanval); +af_err af_min_all(double *real, double *imag, const af_array in); +af_err af_max_all(double *real, double *imag, const af_array in); +af_err af_all_true_all(double *real, double *imag, const af_array in); +af_err af_any_true_all(double *real, double *imag, const af_array in); +af_err af_count_all(double *real, double *imag, const af_array in); +af_err af_imin(af_array *out, af_array *idx, const af_array in, const int dim); +af_err af_imax(af_array *out, af_array *idx, const af_array in, const int dim); +af_err af_imin_all(double *real, double *imag, unsigned *idx, const af_array in); +af_err af_imax_all(double *real, double *imag, unsigned *idx, const af_array in); +af_err af_accum(af_array *out, const af_array in, const int dim); +af_err af_scan(af_array *out, const af_array in, const int dim, af_binary_op op, bool inclusive_scan); +af_err af_scan_by_key(af_array *out, const af_array key, const af_array in, const int dim, af_binary_op op, bool inclusive_scan); +af_err af_where(af_array *idx, const af_array in); +af_err af_diff1(af_array *out, const af_array in, const int dim); +af_err af_diff2(af_array *out, const af_array in, const int dim); +af_err af_sort(af_array *out, const af_array in, const unsigned dim, const bool isAscending); +af_err af_sort_index(af_array *out, af_array *indices, const af_array in, const unsigned dim, const bool isAscending); +af_err af_sort_by_key(af_array *out_keys, af_array *out_values, const af_array keys, const af_array values, const unsigned dim, const bool isAscending); +af_err af_set_unique(af_array *out, const af_array in, const bool is_sorted); +af_err af_set_union(af_array *out, const af_array first, const af_array second, const bool is_unique); +af_err af_set_intersect(af_array *out, const af_array first, const af_array second, const bool is_unique); diff --git a/include/arith.h b/include/arith.h new file mode 100644 index 0000000..2a72c68 --- /dev/null +++ b/include/arith.h @@ -0,0 +1,72 @@ +#include "defines.h" + +af_err af_add (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_sub (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_mul (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_div (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_lt (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_gt (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_le (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_ge (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_eq (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_neq (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_and (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_or (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_not (af_array *out, const af_array in); +af_err af_bitand (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_bitor (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_bitxor (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_bitshiftl(af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_bitshiftr(af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_cast (af_array *out, const af_array in, const af_dtype type); +af_err af_minof (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_maxof (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_clamp(af_array *out, const af_array in, const af_array lo, const af_array hi, const bool batch); +af_err af_rem (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_mod (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_abs (af_array *out, const af_array in); +af_err af_arg (af_array *out, const af_array in); +af_err af_sign (af_array *out, const af_array in); +af_err af_round (af_array *out, const af_array in); +af_err af_trunc (af_array *out, const af_array in); +af_err af_floor (af_array *out, const af_array in); +af_err af_ceil (af_array *out, const af_array in); +af_err af_hypot (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_sin (af_array *out, const af_array in); +af_err af_cos (af_array *out, const af_array in); +af_err af_tan (af_array *out, const af_array in); +af_err af_asin (af_array *out, const af_array in); +af_err af_acos (af_array *out, const af_array in); +af_err af_atan (af_array *out, const af_array in); +af_err af_atan2 (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_cplx2 (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_cplx (af_array *out, const af_array in); +af_err af_real (af_array *out, const af_array in); +af_err af_imag (af_array *out, const af_array in); +af_err af_conjg (af_array *out, const af_array in); +af_err af_sinh (af_array *out, const af_array in); +af_err af_cosh (af_array *out, const af_array in); +af_err af_tanh (af_array *out, const af_array in); +af_err af_asinh (af_array *out, const af_array in); +af_err af_acosh (af_array *out, const af_array in); +af_err af_atanh (af_array *out, const af_array in); +af_err af_root (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_pow (af_array *out, const af_array lhs, const af_array rhs, const bool batch); +af_err af_pow2 (af_array *out, const af_array in); +af_err af_exp (af_array *out, const af_array in); +af_err af_sigmoid (af_array *out, const af_array in); +af_err af_expm1 (af_array *out, const af_array in); +af_err af_erf (af_array *out, const af_array in); +af_err af_erfc (af_array *out, const af_array in); +af_err af_log (af_array *out, const af_array in); +af_err af_log1p (af_array *out, const af_array in); +af_err af_log10 (af_array *out, const af_array in); +af_err af_log2 (af_array *out, const af_array in); +af_err af_sqrt (af_array *out, const af_array in); +af_err af_cbrt (af_array *out, const af_array in); +af_err af_factorial (af_array *out, const af_array in); +af_err af_tgamma (af_array *out, const af_array in); +af_err af_lgamma (af_array *out, const af_array in); +af_err af_iszero (af_array *out, const af_array in); +af_err af_isinf (af_array *out, const af_array in); +af_err af_isnan (af_array *out, const af_array in); diff --git a/include/array.h b/include/array.h new file mode 100644 index 0000000..c689be7 --- /dev/null +++ b/include/array.h @@ -0,0 +1,33 @@ +#include "defines.h" + +af_err af_create_array(af_array *arr, const void * const data, const unsigned ndims, const dim_t * const dims, const af_dtype type); +af_err af_create_handle(af_array *arr, const unsigned ndims, const dim_t * const dims, const af_dtype type); +af_err af_copy_array(af_array *arr, const af_array in); +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); +af_err af_release_array(af_array arr); +af_err af_retain_array(af_array *out, const af_array in); +af_err af_get_data_ref_count(int *use_count, const af_array in); +af_err af_eval(af_array in); +af_err af_eval_multiple(const int num, af_array *arrays); +af_err af_set_manual_eval_flag(bool flag); +af_err af_get_manual_eval_flag(bool *flag); +af_err af_get_elements(dim_t *elems, const af_array arr); +af_err af_get_type(af_dtype *type, const af_array arr); +af_err af_get_dims(dim_t *d0, dim_t *d1, dim_t *d2, dim_t *d3, const af_array arr); +af_err af_get_numdims(unsigned *result, const af_array arr); +af_err af_is_empty (bool *result, const af_array arr); +af_err af_is_scalar (bool *result, const af_array arr); +af_err af_is_row (bool *result, const af_array arr); +af_err af_is_column (bool *result, const af_array arr); +af_err af_is_vector (bool *result, const af_array arr); +af_err af_is_complex (bool *result, const af_array arr); +af_err af_is_real (bool *result, const af_array arr); +af_err af_is_double (bool *result, const af_array arr); +af_err af_is_single (bool *result, const af_array arr); +af_err af_is_realfloating (bool *result, const af_array arr); +af_err af_is_floating (bool *result, const af_array arr); +af_err af_is_integer (bool *result, const af_array arr); +af_err af_is_bool (bool *result, const af_array arr); +af_err af_is_sparse (bool *result, const af_array arr); +af_err af_get_scalar(void* output_value, const af_array arr); diff --git a/include/backend.h b/include/backend.h new file mode 100644 index 0000000..61bdceb --- /dev/null +++ b/include/backend.h @@ -0,0 +1,8 @@ +#include "defines.h" + +af_err af_set_backend(const af_backend bknd); +af_err af_get_backend_count(unsigned* num_backends); +af_err af_get_available_backends(int* backends); +af_err af_get_backend_id(af_backend *backend, const af_array in); +af_err af_get_active_backend(af_backend *backend); +af_err af_get_device_id(int *device, const af_array in); diff --git a/include/blas.h b/include/blas.h new file mode 100644 index 0000000..d872069 --- /dev/null +++ b/include/blas.h @@ -0,0 +1,7 @@ +#include "defines.h" + +af_err af_matmul( af_array *out ,const af_array lhs, const af_array rhs, const af_mat_prop optLhs, const af_mat_prop optRhs); +af_err af_dot(af_array *out, const af_array lhs, const af_array rhs, const af_mat_prop optLhs, const af_mat_prop optRhs); +af_err af_dot_all(double *real, double *imag, const af_array lhs, const af_array rhs, const af_mat_prop optLhs, const af_mat_prop optRhs); +af_err af_transpose(af_array *out, af_array in, const bool conjugate); +af_err af_transpose_inplace(af_array in, const bool conjugate); diff --git a/include/cuda.h b/include/cuda.h new file mode 100644 index 0000000..d274446 --- /dev/null +++ b/include/cuda.h @@ -0,0 +1,5 @@ +#include "defines.h" + +af_err afcu_get_stream(cudaStream_t* stream, int id); +af_err afcu_get_native_id(int* nativeid, int id); +af_err afcu_set_native_id(int nativeid); diff --git a/include/data.h b/include/data.h new file mode 100644 index 0000000..b7e236f --- /dev/null +++ b/include/data.h @@ -0,0 +1,26 @@ +#include "defines.h" + +af_err af_constant(af_array *arr, const double val, const unsigned ndims, const dim_t * const dims, const af_dtype type); +af_err af_constant_complex(af_array *arr, const double real, const double imag, const unsigned ndims, const dim_t * const dims, const af_dtype type); +af_err af_constant_long (af_array *arr, const intl val, const unsigned ndims, const dim_t * const dims); +af_err af_constant_ulong(af_array *arr, const uintl val, const unsigned ndims, const dim_t * const dims); +af_err af_range(af_array *out, const unsigned ndims, const dim_t * const dims, const int seq_dim, const af_dtype type); +af_err af_iota(af_array *out, const unsigned ndims, const dim_t * const dims, const unsigned t_ndims, const dim_t * const tdims, const af_dtype type); +af_err af_identity(af_array *out, const unsigned ndims, const dim_t * const dims, const af_dtype type); +af_err af_diag_create(af_array *out, const af_array in, const int num); +af_err af_diag_extract(af_array *out, const af_array in, const int num); +af_err af_join(af_array *out, const int dim, const af_array first, const af_array second); +af_err af_join_many(af_array *out, const int dim, const unsigned n_arrays, const af_array *inputs); +af_err af_tile(af_array *out, const af_array in, const unsigned x, const unsigned y, const unsigned z, const unsigned w); +af_err af_reorder(af_array *out, const af_array in, const unsigned x, const unsigned y, const unsigned z, const unsigned w); +af_err af_shift(af_array *out, const af_array in, const int x, const int y, const int z, const int w); +af_err af_moddims(af_array *out, const af_array in, const unsigned ndims, const dim_t * const dims); +af_err af_flat(af_array *out, const af_array in); +af_err af_flip(af_array *out, const af_array in, const unsigned dim); +af_err af_lower(af_array *out, const af_array in, bool is_unit_diag); +af_err af_upper(af_array *out, const af_array in, bool is_unit_diag); +af_err af_select(af_array *out, const af_array cond, const af_array a, const af_array b); +af_err af_select_scalar_r(af_array *out, const af_array cond, const af_array a, const double b); +af_err af_select_scalar_l(af_array *out, const af_array cond, const double a, const af_array b); +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/include/defines.h b/include/defines.h new file mode 100644 index 0000000..f16a600 --- /dev/null +++ b/include/defines.h @@ -0,0 +1,469 @@ +#define AF_API_VERSION 1.0 +#define bool unsigned char + +typedef long long intl; +typedef unsigned long long uintl; +typedef long long dim_t; +typedef void * af_features; +typedef void * af_window; + +typedef enum { + f32, ///< 32-bit floating point values + c32, ///< 32-bit complex floating point values + f64, ///< 64-bit complex floating point values + c64, ///< 64-bit complex floating point values + b8 , ///< 8-bit boolean values + s32, ///< 32-bit signed integral values + u32, ///< 32-bit unsigned integral values + u8 , ///< 8-bit unsigned integral values + s64, ///< 64-bit signed integral values + u64, ///< 64-bit unsigned integral values + s16, ///< 16-bit signed integral values + u16, ///< 16-bit unsigned integral values +} af_dtype; + +typedef enum { + /// + /// The function returned successfully + /// + AF_SUCCESS = 0, + + // 100-199 Errors in environment + + /// + /// The system or device ran out of memory + /// + AF_ERR_NO_MEM = 101, + + /// + /// There was an error in the device driver + /// + AF_ERR_DRIVER = 102, + + /// + /// There was an error with the runtime environment + /// + AF_ERR_RUNTIME = 103, + + // 200-299 Errors in input parameters + + /// + /// The input array is not a valid af_array object + /// + AF_ERR_INVALID_ARRAY = 201, + + /// + /// One of the function arguments is incorrect + /// + AF_ERR_ARG = 202, + + /// + /// The size is incorrect + /// + AF_ERR_SIZE = 203, + + /// + /// The type is not suppported by this function + /// + AF_ERR_TYPE = 204, + + /// + /// The type of the input arrays are not compatible + /// + AF_ERR_DIFF_TYPE = 205, + + /// + /// Function does not support GFOR / batch mode + /// + AF_ERR_BATCH = 207, + + /// + /// Input does not belong to the current device. + /// + AF_ERR_DEVICE = 208, + + // 300-399 Errors for missing software features + + /// + /// The option is not supported + /// + AF_ERR_NOT_SUPPORTED = 301, + + /// + /// This build of ArrayFire does not support this feature + /// + AF_ERR_NOT_CONFIGURED = 302, + + /// + /// This build of ArrayFire is not compiled with "nonfree" algorithms + /// + AF_ERR_NONFREE = 303, + + // 400-499 Errors for missing hardware features + + /// + /// This device does not support double + /// + AF_ERR_NO_DBL = 401, + + /// + /// This build of ArrayFire was not built with graphics or this device does + /// not support graphics + /// + AF_ERR_NO_GFX = 402, + + // 500-599 Errors specific to heterogenous API + + /// + /// There was an error when loading the libraries + /// + AF_ERR_LOAD_LIB = 501, + + /// + /// There was an error when loading the symbols + /// + AF_ERR_LOAD_SYM = 502, + + /// + /// There was a mismatch between the input array and the active backend + /// + AF_ERR_ARR_BKND_MISMATCH = 503, + + // 900-999 Errors from upstream libraries and runtimes + + /// + /// There was an internal error either in ArrayFire or in a project + /// upstream + /// + AF_ERR_INTERNAL = 998, + + /// + /// Unknown Error + /// + AF_ERR_UNKNOWN = 999 +} af_err; + +typedef enum { + afDevice, ///< Device pointer + afHost, ///< Host pointer +} af_source; + +#define AF_MAX_DIMS 4 + +typedef enum { + AF_INTERP_NEAREST, ///< Nearest Interpolation + AF_INTERP_LINEAR, ///< Linear Interpolation + AF_INTERP_BILINEAR, ///< Bilinear Interpolation + AF_INTERP_CUBIC, ///< Cubic Interpolation + AF_INTERP_LOWER, ///< Floor Indexed + AF_INTERP_LINEAR_COSINE, ///< Linear Interpolation with cosine smoothing + AF_INTERP_BILINEAR_COSINE, ///< Bilinear Interpolation with cosine smoothing + AF_INTERP_BICUBIC, ///< Bicubic Interpolation + AF_INTERP_CUBIC_SPLINE, ///< Cubic Interpolation with Catmull-Rom splines + AF_INTERP_BICUBIC_SPLINE, ///< Bicubic Interpolation with Catmull-Rom splines + +} af_interp_type; + +typedef enum { + /// + /// Out of bound values are 0 + /// + AF_PAD_ZERO = 0, + + /// + /// Out of bound values are symmetric over the edge + /// + AF_PAD_SYM, + + /// + /// Out of bound values are clamped to the edge + /// + AF_PAD_CLAMP_TO_EDGE, +} af_border_type; + +typedef enum { + /// + /// Connectivity includes neighbors, North, East, South and West of current pixel + /// + AF_CONNECTIVITY_4 = 4, + + /// + /// Connectivity includes 4-connectivity neigbors and also those on Northeast, Northwest, Southeast and Southwest + /// + AF_CONNECTIVITY_8 = 8 +} af_connectivity; + +typedef enum { + + /// + /// Output of the convolution is the same size as input + /// + AF_CONV_DEFAULT, + + /// + /// Output of the convolution is signal_len + filter_len - 1 + /// + AF_CONV_EXPAND, +} af_conv_mode; + +typedef enum { + AF_CONV_AUTO, ///< ArrayFire automatically picks the right convolution algorithm + AF_CONV_SPATIAL, ///< Perform convolution in spatial domain + AF_CONV_FREQ, ///< Perform convolution in frequency domain +} af_conv_domain; + + +typedef enum { + AF_SAD = 0, ///< Match based on Sum of Absolute Differences (SAD) + AF_ZSAD, ///< Match based on Zero mean SAD + AF_LSAD, ///< Match based on Locally scaled SAD + AF_SSD, ///< Match based on Sum of Squared Differences (SSD) + AF_ZSSD, ///< Match based on Zero mean SSD + AF_LSSD, ///< Match based on Locally scaled SSD + AF_NCC, ///< Match based on Normalized Cross Correlation (NCC) + AF_ZNCC, ///< Match based on Zero mean NCC + AF_SHD ///< Match based on Sum of Hamming Distances (SHD) +} af_match_type; + +typedef enum { + AF_YCC_601 = 601, ///< ITU-R BT.601 (formerly CCIR 601) standard + AF_YCC_709 = 709, ///< ITU-R BT.709 standard + AF_YCC_2020 = 2020 ///< ITU-R BT.2020 standard +} af_ycc_std; + +typedef enum { + AF_GRAY = 0, ///< Grayscale + AF_RGB, ///< 3-channel RGB + AF_HSV, ///< 3-channel HSV + AF_YCbCr ///< 3-channel YCbCr +} af_cspace_t; + +typedef enum { + AF_MAT_NONE = 0, ///< Default + AF_MAT_TRANS = 1, ///< Data needs to be transposed + AF_MAT_CTRANS = 2, ///< Data needs to be conjugate tansposed + AF_MAT_CONJ = 4, ///< Data needs to be conjugate + AF_MAT_UPPER = 32, ///< Matrix is upper triangular + AF_MAT_LOWER = 64, ///< Matrix is lower triangular + AF_MAT_DIAG_UNIT = 128, ///< Matrix diagonal contains unitary values + AF_MAT_SYM = 512, ///< Matrix is symmetric + AF_MAT_POSDEF = 1024, ///< Matrix is positive definite + AF_MAT_ORTHOG = 2048, ///< Matrix is orthogonal + AF_MAT_TRI_DIAG = 4096, ///< Matrix is tri diagonal + AF_MAT_BLOCK_DIAG = 8192 ///< Matrix is block diagonal +} af_mat_prop; + +typedef enum { + AF_NORM_VECTOR_1, ///< treats the input as a vector and returns the sum of absolute values + AF_NORM_VECTOR_INF, ///< treats the input as a vector and returns the max of absolute values + AF_NORM_VECTOR_2, ///< treats the input as a vector and returns euclidean norm + AF_NORM_VECTOR_P, ///< treats the input as a vector and returns the p-norm + AF_NORM_MATRIX_1, ///< return the max of column sums + AF_NORM_MATRIX_INF, ///< return the max of row sums + AF_NORM_MATRIX_2, ///< returns the max singular value). Currently NOT SUPPORTED + AF_NORM_MATRIX_L_PQ, ///< returns Lpq-norm + AF_NORM_EUCLID = AF_NORM_VECTOR_2, ///< The default. Same as AF_NORM_VECTOR_2 +} af_norm_type; + +typedef enum { + AF_FIF_BMP = 0, ///< FreeImage Enum for Bitmap File + AF_FIF_ICO = 1, ///< FreeImage Enum for Windows Icon File + AF_FIF_JPEG = 2, ///< FreeImage Enum for JPEG File + AF_FIF_JNG = 3, ///< FreeImage Enum for JPEG Network Graphics File + AF_FIF_PNG = 13, ///< FreeImage Enum for Portable Network Graphics File + AF_FIF_PPM = 14, ///< FreeImage Enum for Portable Pixelmap (ASCII) File + AF_FIF_PPMRAW = 15, ///< FreeImage Enum for Portable Pixelmap (Binary) File + AF_FIF_TIFF = 18, ///< FreeImage Enum for Tagged Image File Format File + AF_FIF_PSD = 20, ///< FreeImage Enum for Adobe Photoshop File + AF_FIF_HDR = 26, ///< FreeImage Enum for High Dynamic Range File + AF_FIF_EXR = 29, ///< FreeImage Enum for ILM OpenEXR File + AF_FIF_JP2 = 31, ///< FreeImage Enum for JPEG-2000 File + AF_FIF_RAW = 34 ///< FreeImage Enum for RAW Camera Image File +} af_image_format; + +typedef enum { + AF_MOMENT_M00 = 1, + AF_MOMENT_M01 = 2, + AF_MOMENT_M10 = 4, + AF_MOMENT_M11 = 8, + AF_MOMENT_FIRST_ORDER = AF_MOMENT_M00 | AF_MOMENT_M01 | AF_MOMENT_M10 | AF_MOMENT_M11 +} af_moment_type; + +typedef enum { + AF_HOMOGRAPHY_RANSAC = 0, ///< Computes homography using RANSAC + AF_HOMOGRAPHY_LMEDS = 1 ///< Computes homography using Least Median of Squares +} af_homography_type; + +typedef enum { + AF_BACKEND_DEFAULT = 0, ///< Default backend order: OpenCL -> CUDA -> CPU + AF_BACKEND_CPU = 1, ///< CPU a.k.a sequential algorithms + AF_BACKEND_CUDA = 2, ///< CUDA Compute Backend + AF_BACKEND_OPENCL = 4, ///< OpenCL Compute Backend +} af_backend; + +// Below enum is purely added for example purposes +// it doesn't and shoudn't be used anywhere in the +// code. No Guarantee's provided if it is used. +typedef enum { + AF_ID = 0 +} af_someenum_t; + +typedef enum { + AF_BINARY_ADD = 0, + AF_BINARY_MUL = 1, + AF_BINARY_MIN = 2, + AF_BINARY_MAX = 3 +} af_binary_op; + +typedef enum { + AF_RANDOM_ENGINE_PHILOX_4X32_10 = 100, //Philox variant with N = 4, W = 32 and Rounds = 10 + AF_RANDOM_ENGINE_THREEFRY_2X32_16 = 200, //Threefry variant with N = 2, W = 32 and Rounds = 16 + AF_RANDOM_ENGINE_MERSENNE_GP11213 = 300, //Mersenne variant with MEXP = 11213 + AF_RANDOM_ENGINE_PHILOX = AF_RANDOM_ENGINE_PHILOX_4X32_10, //Resolves to Philox 4x32_10 + AF_RANDOM_ENGINE_THREEFRY = AF_RANDOM_ENGINE_THREEFRY_2X32_16, //Resolves to Threefry 2X32_16 + AF_RANDOM_ENGINE_MERSENNE = AF_RANDOM_ENGINE_MERSENNE_GP11213, //Resolves to Mersenne GP 11213 + AF_RANDOM_ENGINE_DEFAULT = AF_RANDOM_ENGINE_PHILOX //Resolves to Philox +} af_random_engine_type; + +/* //////////////////////////////////////////////////////////////////////////////// */ +/* // FORGE / Graphics Related Enums */ +/* // These enums have values corresponsding to Forge enums in forge defines.h */ +/* //////////////////////////////////////////////////////////////////////////////// */ +typedef enum { + AF_COLORMAP_DEFAULT = 0, ///< Default grayscale map + AF_COLORMAP_SPECTRUM= 1, ///< Spectrum map (390nm-830nm, in sRGB colorspace) + AF_COLORMAP_COLORS = 2, ///< Colors, aka. Rainbow + AF_COLORMAP_RED = 3, ///< Red hue map + AF_COLORMAP_MOOD = 4, ///< Mood map + AF_COLORMAP_HEAT = 5, ///< Heat map + AF_COLORMAP_BLUE = 6, ///< Blue hue map + AF_COLORMAP_INFERNO = 7, ///< Perceptually uniform shades of black-red-yellow + AF_COLORMAP_MAGMA = 8, ///< Perceptually uniform shades of black-red-white + AF_COLORMAP_PLASMA = 9, ///< Perceptually uniform shades of blue-red-yellow + AF_COLORMAP_VIRIDIS = 10 ///< Perceptually uniform shades of blue-green-yellow +} af_colormap; + + +typedef enum { + AF_MARKER_NONE = 0, + AF_MARKER_POINT = 1, + AF_MARKER_CIRCLE = 2, + AF_MARKER_SQUARE = 3, + AF_MARKER_TRIANGLE = 4, + AF_MARKER_CROSS = 5, + AF_MARKER_PLUS = 6, + AF_MARKER_STAR = 7 +} af_marker_type; + +/* //////////////////////////////////////////////////////////////////////////////// */ + +typedef void * af_array; + + +/* #if AF_API_VERSION >= 35 */ +typedef enum { + AF_CANNY_THRESHOLD_MANUAL = 0, ///< User has to define canny thresholds manually + AF_CANNY_THRESHOLD_AUTO_OTSU = 1, ///< Determine canny algorithm thresholds using Otsu algorithm +} af_canny_threshold; + + +/* #if AF_API_VERSION >= 34 */ +typedef enum { + AF_STORAGE_DENSE = 0, ///< Storage type is dense + AF_STORAGE_CSR = 1, ///< Storage type is CSR + AF_STORAGE_CSC = 2, ///< Storage type is CSC + AF_STORAGE_COO = 3, ///< Storage type is COO +} af_storage; + +typedef enum { + AF_FLUX_QUADRATIC = 1, ///< Quadratic flux function + AF_FLUX_EXPONENTIAL = 2, ///< Exponential flux function + AF_FLUX_DEFAULT = 0 ///< Default flux function is exponential +} af_flux_function; + +typedef enum { + AF_DIFFUSION_GRAD = 1, ///< Gradient diffusion equation + AF_DIFFUSION_MCDE = 2, ///< Modified curvature diffusion equation + AF_DIFFUSION_DEFAULT = 0 ///< Default option is same as AF_DIFFUSION_GRAD +} af_diffusion_eq; + +typedef enum { + AF_TOPK_MIN = 1, ///< Top k min values + AF_TOPK_MAX = 2, ///< Top k max values + AF_TOPK_DEFAULT = 0 ///< Default option (max) +} af_topk_function; + +typedef enum { + AF_ITERATIVE_DECONV_LANDWEBER = 1, ///< Landweber Deconvolution + AF_ITERATIVE_DECONV_RICHARDSONLUCY = 2, ///< Richardson-Lucy Deconvolution + AF_ITERATIVE_DECONV_DEFAULT = 0, ///< Default is Landweber deconvolution +} af_iterative_deconv_algo; + +typedef enum { + AF_INVERSE_DECONV_TIKHONOV = 1, ///< Tikhonov Inverse deconvolution + AF_INVERSE_DECONV_DEFAULT = 0, ///< Default is Tikhonov deconvolution +} af_inverse_deconv_algo; + +/* #endif */ + + +typedef enum { + AF_VARIANCE_DEFAULT = 0, ///< Default (Population) variance + AF_VARIANCE_SAMPLE = 1, ///< Sample variance + AF_VARIANCE_POPULATION = 2, ///< Population variance +} af_var_bias; + +/* #include "opencl.h" -- need this for below */ + +/* +typedef enum +{ + AFCL_DEVICE_TYPE_CPU = CL_DEVICE_TYPE_CPU, + AFCL_DEVICE_TYPE_GPU = CL_DEVICE_TYPE_GPU, + AFCL_DEVICE_TYPE_ACC = CL_DEVICE_TYPE_ACCELERATOR, + AFCL_DEVICE_TYPE_UNKNOWN = -1 +} afcl_device_type; +*/ + +typedef enum +{ + AFCL_DEVICE_TYPE_CPU = 0, + AFCL_DEVICE_TYPE_GPU = 1, + AFCL_DEVICE_TYPE_ACC = 2, + AFCL_DEVICE_TYPE_UNKNOWN = -1 +} afcl_device_type; + +typedef enum +{ + AFCL_PLATFORM_AMD = 0, + AFCL_PLATFORM_APPLE = 1, + AFCL_PLATFORM_INTEL = 2, + AFCL_PLATFORM_NVIDIA = 3, + AFCL_PLATFORM_BEIGNET = 4, + AFCL_PLATFORM_POCL = 5, + AFCL_PLATFORM_UNKNOWN = -1 +} afcl_platform; + +typedef struct af_seq { + double begin; + double end; + double step; +} af_seq; + +typedef struct { + int row; + int col; + const char* title; + af_colormap cmap; + } af_cell; + +typedef struct af_index_t { + union { + af_array arr; + af_seq seq; + } idx; + bool isSeq; + bool isBatch; + } af_index_t; + +typedef void * af_random_engine; diff --git a/include/device.h b/include/device.h new file mode 100644 index 0000000..d0890b5 --- /dev/null +++ b/include/device.h @@ -0,0 +1,28 @@ +#include "defines.h" + +af_err af_info(); +af_err af_init(); +af_err af_info_string(char** str, const bool verbose); +af_err af_device_info(char* d_name, char* d_platform, char *d_toolkit, char* d_compute); +af_err af_get_device_count(int *num_of_devices); +af_err af_get_dbl_support(bool* available, const int device); +af_err af_set_device(const int device); +af_err af_get_device(int *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/include/exception.h b/include/exception.h new file mode 100644 index 0000000..7a2e0c4 --- /dev/null +++ b/include/exception.h @@ -0,0 +1,5 @@ +#include "defines.h" + +void af_get_last_error(char **msg, dim_t *len); +const char *af_err_to_string(const af_err err); + diff --git a/include/features.h b/include/features.h new file mode 100644 index 0000000..7b00bb7 --- /dev/null +++ b/include/features.h @@ -0,0 +1,11 @@ +#include "defines.h" + +af_err af_create_features(af_features *feat, dim_t num); +af_err af_retain_features(af_features *out, const af_features feat); +af_err af_get_features_num(dim_t *num, const af_features feat); +af_err af_get_features_xpos(af_array *out, const af_features feat); +af_err af_get_features_ypos(af_array *out, const af_features feat); +af_err af_get_features_score(af_array *score, const af_features feat); +af_err af_get_features_orientation(af_array *orientation, const af_features feat); +af_err af_get_features_size(af_array *size, const af_features feat); +af_err af_release_features(af_features feat); diff --git a/include/graphics.h b/include/graphics.h new file mode 100644 index 0000000..fac8949 --- /dev/null +++ b/include/graphics.h @@ -0,0 +1,31 @@ +#include "defines.h" + +af_err af_create_window(af_window *out, const int width, const int height, const char* const title); +af_err af_set_position(const af_window wind, const unsigned x, const unsigned y); +af_err af_set_title(const af_window wind, const char* const title); +af_err af_set_size(const af_window wind, const unsigned w, const unsigned h); +af_err af_draw_image(const af_window wind, const af_array in, const af_cell* const props); +af_err af_draw_plot(const af_window wind, const af_array X, const af_array Y, const af_cell* const props); +af_err af_draw_plot3(const af_window wind, const af_array P, const af_cell* const props); +af_err af_draw_plot_nd(const af_window wind, const af_array P, const af_cell* const props); +af_err af_draw_plot_2d(const af_window wind, const af_array X, const af_array Y,const af_cell* const props); +af_err af_draw_plot_3d(const af_window wind,const af_array X, const af_array Y, const af_array Z,const af_cell* const props); +af_err af_draw_scatter(const af_window wind, const af_array X, const af_array Y, const af_marker_type marker, const af_cell* const props); +af_err af_draw_scatter3(const af_window wind, const af_array P, const af_marker_type marker, const af_cell* const props); +af_err af_draw_scatter_nd(const af_window wind, const af_array P, const af_marker_type marker, const af_cell* const props); +af_err af_draw_scatter_2d(const af_window wind, const af_array X, const af_array Y,const af_marker_type marker, const af_cell* const props); +af_err af_draw_scatter_3d(const af_window wind, const af_array X, const af_array Y, const af_array Z, const af_marker_type marker, const af_cell* const props); +af_err af_draw_hist(const af_window wind, const af_array X, const double minval, const double maxval, const af_cell* const props); +af_err af_draw_surface(const af_window wind, const af_array xVals, const af_array yVals, const af_array S, const af_cell* const props); +af_err af_draw_vector_field_nd(const af_window wind, const af_array points, const af_array directions, const af_cell* const props); +af_err af_draw_vector_field_3d(const af_window wind, const af_array xPoints, const af_array yPoints, const af_array zPoints, const af_array xDirs, const af_array yDirs, const af_array zDirs, const af_cell* const props); +af_err af_draw_vector_field_2d(const af_window wind,const af_array xPoints, const af_array yPoints,const af_array xDirs, const af_array yDirs,const af_cell* const props); +af_err af_grid(const af_window wind, const int rows, const int cols); +af_err af_set_axes_limits_compute(const af_window wind, const af_array x, const af_array y, const af_array z,const bool exact, const af_cell* const props); +af_err af_set_axes_limits_2d(const af_window wind, const float xmin, const float xmax, const float ymin, const float ymax, const bool exact, const af_cell* const props); +af_err af_set_axes_limits_3d(const af_window wind, const float xmin, const float xmax, const float ymin, const float ymax, const float zmin, const float zmax, const bool exact, const af_cell* const props); +af_err af_set_axes_titles(const af_window wind, const char * const xtitle, const char * const ytitle, const char * const ztitle, const af_cell* const props); +af_err af_show(const af_window wind); +af_err af_is_window_closed(bool *out, const af_window wind); +af_err af_set_visibility(const af_window wind, const bool is_visible); +af_err af_destroy_window(const af_window wind); diff --git a/include/image.h b/include/image.h new file mode 100644 index 0000000..6c86961 --- /dev/null +++ b/include/image.h @@ -0,0 +1,45 @@ +#include "defines.h" + +af_err af_gradient(af_array *dx, af_array *dy, const af_array in); +af_err af_load_image(af_array *out, const char* filename, const bool isColor); +af_err af_save_image(const char* filename, const af_array in); +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); +af_err af_load_image_native(af_array *out, const char* filename); +af_err af_save_image_native(const char* filename, const af_array in); +af_err af_is_image_io_available(bool *out); +af_err af_resize(af_array *out, const af_array in, const dim_t odim0, const dim_t odim1, const af_interp_type method); +af_err af_transform(af_array *out, const af_array in, const af_array transform, const dim_t odim0, const dim_t odim1, const af_interp_type method, const bool inverse); +af_err af_transform_coordinates(af_array *out, const af_array tf, const float d0, const float d1); +af_err af_rotate(af_array *out, const af_array in, const float theta, const bool crop, const af_interp_type method); +af_err af_translate(af_array *out, const af_array in, const float trans0, const float trans1, const dim_t odim0, const dim_t odim1, const af_interp_type method); +af_err af_scale(af_array *out, const af_array in, const float scale0, const float scale1, const dim_t odim0, const dim_t odim1, const af_interp_type method); +af_err af_skew(af_array *out, const af_array in, const float skew0, const float skew1, const dim_t odim0, const dim_t odim1, const af_interp_type method, const bool inverse); +af_err af_histogram(af_array *out, const af_array in, const unsigned nbins, const double minval, const double maxval); +af_err af_dilate(af_array *out, const af_array in, const af_array mask); +af_err af_dilate3(af_array *out, const af_array in, const af_array mask); +af_err af_erode(af_array *out, const af_array in, const af_array mask); +af_err af_erode3(af_array *out, const af_array in, const af_array mask); +af_err af_bilateral(af_array *out, const af_array in, const float spatial_sigma, const float chromatic_sigma, const bool isColor); +af_err af_mean_shift(af_array *out, const af_array in, const float spatial_sigma, const float chromatic_sigma, const unsigned iter, const bool is_color); +af_err af_minfilt(af_array *out, const af_array in, const dim_t wind_length, const dim_t wind_width, const af_border_type edge_pad); +af_err af_maxfilt(af_array *out, const af_array in, const dim_t wind_length, const dim_t wind_width, const af_border_type edge_pad); +af_err af_regions(af_array *out, const af_array in, const af_connectivity connectivity, const af_dtype ty); +af_err af_sobel_operator(af_array *dx, af_array *dy, const af_array img, const unsigned ker_size); +af_err af_rgb2gray(af_array* out, const af_array in, const float rPercent, const float gPercent, const float bPercent); +af_err af_gray2rgb(af_array* out, const af_array in, const float rFactor, const float gFactor, const float bFactor); +af_err af_hist_equal(af_array *out, const af_array in, const af_array hist); +af_err af_gaussian_kernel(af_array *out, const int rows, const int cols, const double sigma_r, const double sigma_c); +af_err af_hsv2rgb(af_array* out, const af_array in); +af_err af_rgb2hsv(af_array* out, const af_array in); +af_err af_color_space(af_array *out, const af_array image, const af_cspace_t to, const af_cspace_t from); +af_err af_unwrap(af_array *out, const af_array in, const dim_t wx, const dim_t wy, const dim_t sx, const dim_t sy, const dim_t px, const dim_t py, const bool is_column); +af_err af_wrap(af_array *out, const af_array in, const dim_t ox, const dim_t oy, const dim_t wx, const dim_t wy, const dim_t sx, const dim_t sy, const dim_t px, const dim_t py, const bool is_column); +af_err af_sat(af_array *out, const af_array in); +af_err af_ycbcr2rgb(af_array* out, const af_array in, const af_ycc_std standard); +af_err af_rgb2ycbcr(af_array* out, const af_array in, const af_ycc_std standard); +af_err af_moments(af_array *out, const af_array in, const af_moment_type moment); +af_err af_moments_all(double* out, const af_array in, const af_moment_type moment); +af_err af_canny(af_array* out, const af_array in, const af_canny_threshold threshold_type, const float low_threshold_ratio, const float high_threshold_ratio, const unsigned sobel_window, const bool is_fast); +af_err af_anisotropic_diffusion(af_array* out, const af_array in, const float timestep, const float conductance, const unsigned iterations, const af_flux_function fftype,const af_diffusion_eq diffusion_kind); diff --git a/include/index.h b/include/index.h new file mode 100644 index 0000000..13cbca1 --- /dev/null +++ b/include/index.h @@ -0,0 +1,12 @@ +#include "defines.h" + +af_err af_index( af_array *out, const af_array in, const unsigned ndims, const af_seq* const index); +af_err af_lookup( af_array *out, const af_array in, const af_array indices, const unsigned dim); +af_err af_assign_seq( af_array *out, const af_array lhs, const unsigned ndims, const af_seq* const indices, const af_array rhs); +af_err af_index_gen( af_array *out, const af_array in, const dim_t ndims, const af_index_t* indices); +af_err af_assign_gen( af_array *out, const af_array lhs, const dim_t ndims, const af_index_t* indices, const af_array rhs); +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/include/internal.h b/include/internal.h new file mode 100644 index 0000000..d20c049 --- /dev/null +++ b/include/internal.h @@ -0,0 +1,9 @@ +#include "defines.h" + +af_err af_create_strided_array(af_array *arr, const void *data, const dim_t offset, const unsigned ndims, const dim_t *const dims, const dim_t *const strides, const af_dtype ty, const af_source location); +af_err af_get_strides(dim_t *s0, dim_t *s1, dim_t *s2, dim_t *s3, const af_array arr); +af_err af_get_offset(dim_t *offset, const af_array arr); +af_err af_get_raw_ptr(void **ptr, const af_array arr); +af_err af_is_linear(bool *result, const af_array arr); +af_err af_is_owner(bool *result, const af_array arr); +af_err af_get_allocated_bytes(size_t *bytes, const af_array arr); diff --git a/include/lapack.h b/include/lapack.h new file mode 100644 index 0000000..7e8e6be --- /dev/null +++ b/include/lapack.h @@ -0,0 +1,17 @@ +#include "defines.h" + +af_err af_svd(af_array *u, af_array *s, af_array *vt, const af_array in); +af_err af_svd_inplace(af_array *u, af_array *s, af_array *vt, af_array in); +af_err af_lu(af_array *lower, af_array *upper, af_array *pivot, const af_array in); +af_err af_lu_inplace(af_array *pivot, af_array in, const bool is_lapack_piv); +af_err af_qr(af_array *q, af_array *r, af_array *tau, const af_array in); +af_err af_qr_inplace(af_array *tau, af_array in); +af_err af_cholesky(af_array *out, int *info, const af_array in, const bool is_upper); +af_err af_cholesky_inplace(int *info, af_array in, const bool is_upper); +af_err af_solve(af_array *x, const af_array a, const af_array b, const af_mat_prop options); +af_err af_solve_lu(af_array *x, const af_array a, const af_array piv, const af_array b, const af_mat_prop options); +af_err af_inverse(af_array *out, const af_array in, const af_mat_prop options); +af_err af_rank(unsigned *rank, const af_array in, const double tol); +af_err af_det(double *det_real, double *det_imag, const af_array in); +af_err af_norm(double *out, const af_array in, const af_norm_type type, const double p, const double q); +af_err af_is_lapack_available(bool *out); diff --git a/include/openCL.h b/include/openCL.h new file mode 100644 index 0000000..d057f22 --- /dev/null +++ b/include/openCL.h @@ -0,0 +1,11 @@ +#include "defines.h" + +af_err afcl_get_context(cl_context *ctx, const bool retain); +af_err afcl_get_queue(cl_command_queue *queue, const bool retain); +af_err afcl_get_device_id(cl_device_id *id); +af_err afcl_set_device_id(cl_device_id id); +af_err afcl_add_device_context(cl_device_id dev, cl_context ctx, cl_command_queue que); +af_err afcl_set_device_context(cl_device_id dev, cl_context ctx); +af_err afcl_delete_device_context(cl_device_id dev, cl_context ctx); +af_err afcl_get_device_type(afcl_device_type *res); +af_err afcl_get_platform(afcl_platform *res); diff --git a/include/random.h b/include/random.h new file mode 100644 index 0000000..3ff163a --- /dev/null +++ b/include/random.h @@ -0,0 +1,17 @@ +#include "defines.h" + +af_err af_create_random_engine(af_random_engine *engine, af_random_engine_type rtype, uintl seed); +af_err af_retain_random_engine(af_random_engine *out, const af_random_engine engine); +af_err af_random_engine_set_type(af_random_engine *engine, const af_random_engine_type rtype); +af_err af_random_engine_get_type(af_random_engine_type *rtype, const af_random_engine engine); +af_err af_random_uniform(af_array *out, const unsigned ndims, const dim_t * const dims, const af_dtype type, af_random_engine engine); +af_err af_random_normal(af_array *out, const unsigned ndims, const dim_t * const dims, const af_dtype type, af_random_engine engine); +af_err af_random_engine_set_seed(af_random_engine *engine, const uintl seed); +af_err af_get_default_random_engine(af_random_engine *engine); +af_err af_set_default_random_engine_type(const af_random_engine_type rtype); +af_err af_random_engine_get_seed(uintl * const seed, af_random_engine engine); +af_err af_release_random_engine(af_random_engine engine); +af_err af_randu(af_array *out, const unsigned ndims, const dim_t * const dims, const af_dtype type); +af_err af_randn(af_array *out, const unsigned ndims, const dim_t * const dims, const af_dtype type); +af_err af_set_seed(const uintl seed); +af_err af_get_seed(uintl *seed); diff --git a/include/seq.h b/include/seq.h new file mode 100644 index 0000000..c7965e0 --- /dev/null +++ b/include/seq.h @@ -0,0 +1,3 @@ +#include "defines.h" + +af_seq af_make_seq(double begin, double end, double step); diff --git a/include/signal.h b/include/signal.h new file mode 100644 index 0000000..eb4ed3d --- /dev/null +++ b/include/signal.h @@ -0,0 +1,35 @@ +#include "defines.h" + +af_err af_approx1(af_array *out, const af_array in, const af_array pos, const af_interp_type method, const float off_grid); +af_err af_approx2(af_array *out, const af_array in, const af_array pos0, const af_array pos1, const af_interp_type method, const float off_grid); +af_err af_fft(af_array *out, const af_array in, const double norm_factor, const dim_t odim0); +af_err af_fft_inplace(af_array in, const double norm_factor); +af_err af_fft2(af_array *out, const af_array in, const double norm_factor, const dim_t odim0, const dim_t odim1); +af_err af_fft2_inplace(af_array in, const double norm_factor); +af_err af_fft3(af_array *out, const af_array in, const double norm_factor, const dim_t odim0, const dim_t odim1, const dim_t odim2); +af_err af_fft3_inplace(af_array in, const double norm_factor); +af_err af_ifft(af_array *out, const af_array in, const double norm_factor, const dim_t odim0); +af_err af_ifft_inplace(af_array in, const double norm_factor); +af_err af_ifft2(af_array *out, const af_array in, const double norm_factor, const dim_t odim0, const dim_t odim1); +af_err af_ifft2_inplace(af_array in, const double norm_factor); +af_err af_ifft3(af_array *out, const af_array in, const double norm_factor, const dim_t odim0, const dim_t odim1, const dim_t odim2); +af_err af_ifft3_inplace(af_array in, const double norm_factor); +af_err af_fft_r2c (af_array *out, const af_array in, const double norm_factor, const dim_t pad0); +af_err af_fft2_r2c(af_array *out, const af_array in, const double norm_factor, const dim_t pad0, const dim_t pad1); +af_err af_fft3_r2c(af_array *out, const af_array in, const double norm_factor, const dim_t pad0, const dim_t pad1, const dim_t pad2); +af_err af_fft_c2r (af_array *out, const af_array in, const double norm_factor, const bool is_odd); +af_err af_fft2_c2r(af_array *out, const af_array in, const double norm_factor, const bool is_odd); +af_err af_fft3_c2r(af_array *out, const af_array in, const double norm_factor, const bool is_odd); +af_err af_convolve1(af_array *out, const af_array signal, const af_array filter, const af_conv_mode mode, af_conv_domain domain); +af_err af_convolve2(af_array *out, const af_array signal, const af_array filter, const af_conv_mode mode, af_conv_domain domain); +af_err af_convolve3(af_array *out, const af_array signal, const af_array filter, const af_conv_mode mode, af_conv_domain domain); +af_err af_convolve2_sep(af_array *out, const af_array col_filter, const af_array row_filter, const af_array signal, const af_conv_mode mode); +af_err af_fft_convolve1(af_array *out, const af_array signal, const af_array filter, const af_conv_mode mode); +af_err af_fft_convolve2(af_array *out, const af_array signal, const af_array filter, const af_conv_mode mode); +af_err af_fft_convolve3(af_array *out, const af_array signal, const af_array filter, const af_conv_mode mode); +af_err af_fir(af_array *y, const af_array b, const af_array x); +af_err af_iir(af_array *y, const af_array b, const af_array a, const af_array x); +af_err af_medfilt(af_array *out, const af_array in, const dim_t wind_length, const dim_t wind_width, const af_border_type edge_pad); +af_err af_medfilt1(af_array *out, const af_array in, const dim_t wind_width, const af_border_type edge_pad); +af_err af_medfilt2(af_array *out, const af_array in, const dim_t wind_length, const dim_t wind_width, const af_border_type edge_pad); +af_err af_set_fft_plan_cache_size(size_t cache_size); diff --git a/include/sparse.h b/include/sparse.h new file mode 100644 index 0000000..d544345 --- /dev/null +++ b/include/sparse.h @@ -0,0 +1,13 @@ +#include "defines.h" + +af_err af_create_sparse_array(af_array *out, const dim_t nRows, const dim_t nCols, const af_array values, const af_array rowIdx, const af_array colIdx, const af_storage stype); +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); +af_err af_create_sparse_array_from_dense(af_array *out, const af_array dense, const af_storage stype); +af_err af_sparse_convert_to(af_array *out, const af_array in, const af_storage destStorage); +af_err af_sparse_to_dense(af_array *out, const af_array sparse); +af_err af_sparse_get_info(af_array *values, af_array *rowIdx, af_array *colIdx, af_storage *stype, const af_array in); +af_err af_sparse_get_values(af_array *out, const af_array in); +af_err af_sparse_get_row_idx(af_array *out, const af_array in); +af_err af_sparse_get_col_idx(af_array *out, const af_array in); +af_err af_sparse_get_nnz(dim_t *out, const af_array in); +af_err af_sparse_get_storage(af_storage *out, const af_array in); diff --git a/include/statistics.h b/include/statistics.h new file mode 100644 index 0000000..c3ddd9b --- /dev/null +++ b/include/statistics.h @@ -0,0 +1,17 @@ +#include "defines.h" + +af_err af_mean(af_array *out, const af_array in, const dim_t dim); +af_err af_mean_weighted(af_array *out, const af_array in, const af_array weights, const dim_t dim); +af_err af_var(af_array *out, const af_array in, const bool isbiased, const dim_t dim); +af_err af_var_weighted(af_array *out, const af_array in, const af_array weights, const dim_t dim); +af_err af_stdev(af_array *out, const af_array in, const dim_t dim); +af_err af_cov(af_array* out, const af_array X, const af_array Y, const bool isbiased); +af_err af_median(af_array* out, const af_array in, const dim_t dim); +af_err af_mean_all(double *real, double *imag, const af_array in); +af_err af_mean_all_weighted(double *real, double *imag, const af_array in, const af_array weights); +af_err af_var_all(double *realVal, double *imagVal, const af_array in, const bool isbiased); +af_err af_var_all_weighted(double *realVal, double *imagVal, const af_array in, const af_array weights); +af_err af_stdev_all(double *real, double *imag, const af_array in); +af_err af_median_all(double *realVal, double *imagVal, const af_array in); +af_err af_corrcoef(double *realVal, double *imagVal, const af_array X, const af_array Y); +af_err af_topk(af_array *values, af_array *indices, const af_array in, const int k, const int dim, const af_topk_function order); diff --git a/include/util.h b/include/util.h new file mode 100644 index 0000000..5d35b8c --- /dev/null +++ b/include/util.h @@ -0,0 +1,13 @@ +#include "defines.h" + +af_err af_print_array(af_array arr); +af_err af_print_array_gen(const char *exp, const af_array arr, const int precision); +af_err af_save_array(int *index, const char* key, const af_array arr, const char *filename, const bool append); +af_err af_read_array_index(af_array *out, const char *filename, const unsigned index); +af_err af_read_array_key(af_array *out, const char *filename, const char* key); +af_err af_read_array_key_check(int *index, const char *filename, const char* key); +af_err af_array_to_string(char **output, const char *exp, const af_array arr, const int precision, const bool transpose); +af_err af_example_function(af_array* out, const af_array in, const af_someenum_t param); +af_err af_get_version(int *major, int *minor, int *patch); +const char *af_get_revision(); +af_err af_get_size_of(size_t *size, af_dtype type); diff --git a/include/vision.h b/include/vision.h new file mode 100644 index 0000000..3b17fd0 --- /dev/null +++ b/include/vision.h @@ -0,0 +1,13 @@ +#include "defines.h" + +af_err af_fast(af_features *out, const af_array in, const float thr, const unsigned arc_length, const bool non_max, const float feature_ratio, const unsigned edge); +af_err af_harris(af_features *out, const af_array in, const unsigned max_corners, const float min_response, const float sigma, const unsigned block_size, const float k_thr); +af_err af_orb(af_features *feat, af_array *desc, const af_array in, const float fast_thr, const unsigned max_feat, const float scl_fctr, const unsigned levels, const bool blur_img); +af_err af_sift(af_features *feat, af_array *desc, const af_array in, const unsigned n_layers, const float contrast_thr, const float edge_thr, const float init_sigma, const bool double_input, const float intensity_scale, const float feature_ratio); +af_err af_gloh(af_features *feat, af_array *desc, const af_array in, const unsigned n_layers, const float contrast_thr, const float edge_thr, const float init_sigma, const bool double_input, const float intensity_scale, const float feature_ratio); +af_err af_hamming_matcher(af_array* idx, af_array* dist, const af_array query, const af_array train, const dim_t dist_dim, const unsigned n_dist); +af_err af_nearest_neighbour(af_array* idx, af_array* dist, const af_array query, const af_array train, const dim_t dist_dim, const unsigned n_dist, const af_match_type dist_type); +af_err af_match_template(af_array *out, const af_array search_img, const af_array template_img, const af_match_type m_type); +af_err af_susan(af_features* out, const af_array in, const unsigned radius, const float diff_thr, const float geom_thr, const float feature_ratio, const unsigned edge); +af_err af_dog(af_array *out, const af_array in, const int radius1, const int radius2); +af_err af_homography(af_array *H, int *inliers, const af_array x_src, const af_array y_src, const af_array x_dst, const af_array y_dst, const af_homography_type htype, const float inlier_thr, const unsigned iterations, const af_dtype otype); diff --git a/nix/default.nix b/nix/default.nix new file mode 100644 index 0000000..8d06f35 --- /dev/null +++ b/nix/default.nix @@ -0,0 +1,79 @@ +{ stdenv, fetchurl, fetchFromGitHub, cmake, pkgconfig +, cudatoolkit, opencl-clhpp, ocl-icd, fftw, fftwFloat, mkl +, blas, openblas, boost, mesa_noglu, libGLU_combined +, freeimage, python, lib +}: + +let + version = "3.6.4"; + + clfftSource = fetchFromGitHub { + owner = "arrayfire"; + repo = "clFFT"; + rev = "16925fb93338b3cac66490b5cf764953d6a5dac7"; + sha256 = "0y35nrdz7w4n1l17myhkni3hwm37z775xn6f76xmf1ph7dbkslsc"; + fetchSubmodules = true; + }; + + clblasSource = fetchFromGitHub { + owner = "arrayfire"; + repo = "clBLAS"; + rev = "1f3de2ae5582972f665c685b18ef0df43c1792bb"; + sha256 = "154mz52r5hm0jrp5fqrirzzbki14c1jkacj75flplnykbl36ibjs"; + fetchSubmodules = true; + }; + + cl2hppSource = fetchurl { + url = "https://github.com/KhronosGroup/OpenCL-CLHPP/releases/download/v2.0.10/cl2.hpp"; + sha256 = "1v4q0g6b6mwwsi0kn7kbjn749j3qafb9r4ld3zdq1163ln9cwnvw"; + }; + +in stdenv.mkDerivation { + pname = "arrayfire"; + inherit version; + + src = fetchurl { + url = "http://arrayfire.com/arrayfire_source/arrayfire-full-${version}.tar.bz2"; + sha256 = "1fin7a9rliyqic3z83agkpb8zlq663q6gdxsnm156cs8s7f7rc9h"; + }; + + cmakeFlags = [ + "-DAF_BUILD_OPENCL=OFF" + "-DAF_BUILD_EXAMPLES=OFF" + "-DBUILD_TESTING=OFF" + ] ++ (lib.optional stdenv.isLinux ["-DCMAKE_LIBRARY_PATH=${cudatoolkit}/lib/stubs"]); + + patches = [ ./no-download.patch ]; + + postPatch = '' + mkdir -p ./build/third_party/clFFT/src + cp -R --no-preserve=mode,ownership ${clfftSource}/ ./build/third_party/clFFT/src/clFFT-ext/ + mkdir -p ./build/third_party/clBLAS/src + cp -R --no-preserve=mode,ownership ${clblasSource}/ ./build/third_party/clBLAS/src/clBLAS-ext/ + mkdir -p ./build/include/CL + cp -R --no-preserve=mode,ownership ${cl2hppSource} ./build/include/CL/cl2.hpp + ''; + + preBuild = lib.optionalString stdenv.isLinux '' + export CUDA_PATH="${cudatoolkit}"' + ''; + + enableParallelBuilding = true; + + buildInputs = [ + cmake pkgconfig + opencl-clhpp fftw fftwFloat + mkl openblas + libGLU_combined + mesa_noglu freeimage + boost.out boost.dev python + ] ++ (lib.optional stdenv.isLinux [ cudatoolkit ocl-icd ]); + + meta = with stdenv.lib; { + description = "A general-purpose library that simplifies the process of developing software that targets parallel and massively-parallel architectures including CPUs, GPUs, and other hardware acceleration devices"; + license = licenses.bsd3; + homepage = https://arrayfire.com/ ; + maintainers = with stdenv.lib.maintainers; [ chessai ]; + inherit version; + }; +} diff --git a/nix/no-download.patch b/nix/no-download.patch new file mode 100644 index 0000000..2b3ac49 --- /dev/null +++ b/nix/no-download.patch @@ -0,0 +1,28 @@ +diff --git a/CMakeModules/build_clBLAS.cmake b/CMakeModules/build_clBLAS.cmake +index 8de529e8..6361b613 100644 +--- a/CMakeModules/build_clBLAS.cmake ++++ b/CMakeModules/build_clBLAS.cmake +@@ -14,8 +14,7 @@ find_package(OpenCL) + + ExternalProject_Add( + clBLAS-ext +- GIT_REPOSITORY https://github.com/arrayfire/clBLAS.git +- GIT_TAG arrayfire-release ++ DOWNLOAD_COMMAND true + BUILD_BYPRODUCTS ${clBLAS_location} + PREFIX "${prefix}" + INSTALL_DIR "${prefix}" +diff --git a/CMakeModules/build_clFFT.cmake b/CMakeModules/build_clFFT.cmake +index 28be38a3..85e3915e 100644 +--- a/CMakeModules/build_clFFT.cmake ++++ b/CMakeModules/build_clFFT.cmake +@@ -20,8 +20,7 @@ ENDIF() + + ExternalProject_Add( + clFFT-ext +- GIT_REPOSITORY https://github.com/arrayfire/clFFT.git +- GIT_TAG arrayfire-release ++ DOWNLOAD_COMMAND true + PREFIX "${prefix}" + INSTALL_DIR "${prefix}" + UPDATE_COMMAND "" diff --git a/pkg.nix b/pkg.nix new file mode 100644 index 0000000..5e093f7 --- /dev/null +++ b/pkg.nix @@ -0,0 +1,16 @@ +{ mkDerivation, base, directory, parsec, stdenv, text, vector +, hspec, hspec-discover +}: +mkDerivation { + pname = "arrayfire"; + version = "0.6.0.0" + src = ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ base vector ]; + executableHaskellDepends = [ base directory parsec text ]; + testHaskellDepends = [ hspec hspec-discover ]; + homepage = "https://github.com/arrayfire/arrayfire-haskell"; + description = "Haskell bindings to ArrayFire"; + license = stdenv.lib.licenses.bsd3; +} diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..94b11d9 --- /dev/null +++ b/shell.nix @@ -0,0 +1,40 @@ +{ pkgs ? import {} }: +let + pkg = (import ./default.nix {}).env; +in + pkgs.lib.overrideDerivation pkg (drv: { + shellHook = '' + export AF_PRINT_ERRORS=1 + export PATH=$PATH:${pkgs.haskellPackages.doctest}/bin + export PATH=$PATH:${pkgs.haskellPackages.cabal-install}/bin + function ghcid () { + ${pkgs.haskellPackages.ghcid.bin}/bin/ghcid -c 'cabal v1-repl lib:arrayfire' + }; + function test-runner () { + ${pkgs.silver-searcher}/bin/ag -l | \ + ${pkgs.entr}/bin/entr sh -c \ + 'cabal v1-configure --enable-tests && \ + cabal v1-build test && dist/build/test/test' + } + function doctest-runner () { + ${pkgs.silver-searcher}/bin/ag -l | \ + ${pkgs.entr}/bin/entr sh -c \ + 'cabal v1-configure --enable-tests && \ + cabal v1-build doctests && dist/build/doctests/doctests src/ArrayFire/Algorithm.hs' + } + function exe () { + cabal run main + } + function repl () { + cabal v1-repl lib:arrayfire + } + function docs () { + cabal haddock + open ./dist-newstyle/*/*/*/*/doc/html/arrayfire/index.html + } + function upload-docs () { + cabal haddock --haddock-for-hackage + cabal upload -d dist-newstyle/arrayfire-*.*.*.*-docs.tar.gz --publish + } + ''; + }) diff --git a/src/ArrayFire.hs b/src/ArrayFire.hs new file mode 100644 index 0000000..f5cf814 --- /dev/null +++ b/src/ArrayFire.hs @@ -0,0 +1,340 @@ +-------------------------------------------------------------------------------- +-- | +-- 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 (3,2) [[1,2,3],[4,5,6]] +-- @ +-- +-- Each 'Array' is constructed and displayed in column-major order. +-- +-- @ +-- ArrayFire Array +-- [3 2 1 1] +-- 1.0000 4.0000 +-- 2.0000 5.0000 +-- 3.0000 6.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: +-- +-- /Note/: All smart constructors (and ArrayFire internally) assume column-major order. +-- +-- @ +-- >>> 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 3.0000 +-- 2.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 [5,3] [1..] +-- ArrayFire Array +-- [5 3 1 1] +-- 1.0000 6.0000 11.0000 +-- 2.0000 7.0000 12.0000 +-- 3.0000 8.0000 13.0000 +-- 4.0000 9.0000 14.0000 +-- 5.0000 10.0000 15.0000 +-- +-- Specifying up to 4 dimensions is allowed (anything higher is ignored). + +-- $laws +-- Every 'Array' has an instance of 'Eq', 'Num', 'Fractional', 'Floating' and 'Show' +-- +-- 'Num' +-- +-- >>> 2.0 :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 2.0000 +-- +-- >>> 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 10) +-- ArrayFire Array +-- [1 1 1 1] +-- -10.0000 +-- +-- >>> 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 +-- +-- 'Floating' +-- +-- >>> pi :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 3.1416 +-- +-- >>> A.sqrt pi :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 1.7725 +-- +-- 'Fractional' +-- +-- >>> (pi :: Array Double) / pi +-- ArrayFire Array +-- [1 1 1 1] +-- 1.000 +-- +-- >>> recip 0.5 :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 2.000 +-- +-- 'Show' +-- +-- >>> 0.0 :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 0.000 +-- + +-- $conversion +-- Any '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 display visualizations using the Forge library +-- >>> window <- createWindow 800 600 "Histogram" +-- diff --git a/src/ArrayFire/Algorithm.hs b/src/ArrayFire/Algorithm.hs new file mode 100644 index 0000000..b7fccba --- /dev/null +++ b/src/ArrayFire/Algorithm.hs @@ -0,0 +1,659 @@ +{-# 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 +-- -- ArrayFire Array +-- -- [1 1 1 1] +-- -- 55.0000 +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Algorithm where + +import ArrayFire.FFI +import ArrayFire.Internal.Algorithm +import ArrayFire.Internal.Types + +-- | Sum all of the elements in 'Array' along the specified dimension +-- +-- >>> A.sum (A.vector @Double 10 [1..]) 0 +-- ArrayFire Array +-- [1 1 1 1] +-- 55.0000 +-- +-- >>> A.sum (A.matrix @Double (10,10) $ replicate 10 [1..]) 1 +-- ArrayFire Array +-- [10 1 1 1] +-- 10.0000 +-- 20.0000 +-- 30.0000 +-- 40.0000 +-- 50.0000 +-- 60.0000 +-- 70.0000 +-- 80.0000 +-- 90.0000 +-- 100.0000 +-- +sum + :: AFType a + => Array a + -- ^ Array to sum + -> Int + -- ^ 0-based Dimension along which to perform sum + -> Array a + -- ^ Will return the sum of all values in the input array along the specified dimension +sum x (fromIntegral -> n) = (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 +-- ArrayFire Array +-- [1 1 1 1] +-- 55.0000 +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 + -> Array 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 = (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 +-- ArrayFire Array +-- [1 1 1 1] +-- 3628800.0000 +product + :: AFType a + => Array a + -- ^ Array to product + -> Int + -- ^ Dimension along which to perform product + -> Array a + -- ^ Will return the product of all values in the input array along the specified dimension +product x (fromIntegral -> n) = (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 +-- ArrayFire Array +-- [1 1 1 1] +-- 3628800.0000 +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 + -> Array 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 = 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 +-- ArrayFire Array +-- [1 1 1 1] +-- 1.0000 +min + :: AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to retrieve the min element + -> Array a + -- ^ Will contain the minimum of all values in the input array along dim +min x (fromIntegral -> n) = 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 +-- ArrayFire Array +-- [1 1 1 1] +-- 10.0000 +max + :: AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to retrieve the max element + -> Array a + -- ^ Will contain the maximum of all values in the input array along dim +max x (fromIntegral -> n) = 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 +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +allTrue + :: forall a. AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to see if all elements are True + -> Array a + -- ^ Will contain the maximum of all values in the input array along dim +allTrue x (fromIntegral -> n) = + 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 +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +anyTrue + :: forall a . AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to see if all elements are True + -> Array a + -- ^ Returns if all elements are true +anyTrue x (fromIntegral -> n) = + (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 +-- ArrayFire Array +-- [1 1 1 1] +-- 10 +count + :: forall a . AFType a + => Array a + -- ^ Array input + -> Int + -- ^ Dimension along which to count + -> Array Int + -- ^ Count of all elements along dimension +count x (fromIntegral -> n) = x `op1d` (\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 +-- [10 1 1 1] +-- 1 +-- 2 +-- 3 +-- 4 +-- 5 +-- 6 +-- 7 +-- 8 +-- 9 +-- 10 +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 index 0000000..ec2cc25 --- /dev/null +++ b/src/ArrayFire/Arith.hs @@ -0,0 +1,2094 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} +{-# 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 +-- +-- -- ArrayFire Array +-- -- [1 1 1 1] +-- -- 2 +-- @ +-------------------------------------------------------------------------------- +module ArrayFire.Arith where + +import Prelude (Bool(..), ($), (.), flip, fromEnum, fromIntegral, Real, RealFrac) + +import Data.Coerce +import Data.Proxy +import Data.Complex + +import ArrayFire.FFI +import ArrayFire.Internal.Arith +import ArrayFire.Internal.Types + +import Foreign.C.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 +lt + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array CBool + -- ^ Result of less than +lt x y = do + x `op2bool` 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 +ltBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array CBool + -- ^ Result of less than +ltBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 +gt + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array CBool + -- ^ Result of gt +gt x y = do + x `op2bool` 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 +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +gtBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array CBool + -- ^ Result of gt +gtBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 +le + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array CBool + -- ^ Result of less than or equal +le x y = do + x `op2bool` 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 +leBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array CBool + -- ^ Result of less than or equal +leBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 +ge + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array CBool + -- ^ Result of greater than or equal +ge x y = do + x `op2bool` 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 +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +-- +geBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array CBool + -- ^ Result of greater than or equal +geBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 +eq + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array CBool + -- ^ Result of equal +eq x y = do + x `op2bool` 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 +-- ArrayFire Array +-- [1 1 1 1] +-- 1 +-- +eqBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array CBool + -- ^ Result of equal +eqBatched x y (fromIntegral . fromEnum -> batch) = + x `op2bool` 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 +neq + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Array CBool + -- ^ Result of not equal +neq x y = + x `op2bool` 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 +-- ArrayFire Array +-- [1 1 1 1] +-- 0 +neqBatched + :: AFType a + => Array a + -- ^ First input + -> Array a + -- ^ Second input + -> Bool + -- ^ Use batch + -> Array CBool + -- ^ Result of not equal +neqBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 CBool + -- ^ Result of and +and x y = + x `op2bool` 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 CBool + -- ^ Result of and +andBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 CBool + -- ^ Result of or +or x y = + x `op2bool` 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 CBool + -- ^ Result of or +orBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 CBool + -- ^ Result of 'not' on an 'Array' +not = flip op1d 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 CBool + -- ^ Result of bitwise and +bitAnd x y = + x `op2bool` 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 CBool + -- ^ Result of bitwise and +bitAndBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 CBool + -- ^ Result of bit or +bitOr x y = do + x `op2bool` 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 CBool + -- ^ Result of bit or +bitOrBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 CBool + -- ^ Result of bit xor +bitXor x y = do + x `op2bool` 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 CBool + -- ^ Result of bit xor +bitXorBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 CBool + -- ^ Result of bit shift left +bitShiftL x y = + x `op2bool` 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 CBool + -- ^ Result of bit shift left +bitShiftLBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 CBool + -- ^ Result of bit shift right +bitShiftR x y = + x `op2bool` 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 CBool + -- ^ Result of bit shift left +bitShiftRBatched x y (fromIntegral . fromEnum -> batch) = do + x `op2bool` 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 [2..]) True +-- ArrayFire Array +-- [10 1 1 1] +-- 1 +-- 2 +-- 3 +-- 4 +-- 5 +-- 6 +-- 7 +-- 8 +-- 9 +-- 10 +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 @Double 10 [1.4,1.5..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.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 @Double 10 [0.9,1.0..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.0000 +-- 1.0000 +-- 1.0000 +-- 1.0000 +-- 1.0000 +-- 1.0000 +-- 1.0000 +-- 1.0000 +-- 1.0000 +-- 1.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 @Double 10 [11.0,10.9..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 11.0000 +-- 10.0000 +-- 10.0000 +-- 10.0000 +-- 10.0000 +-- 10.0000 +-- 10.0000 +-- 10.0000 +-- 10.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 @Double 10 [0.9,1.0..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 +-- 1.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.0000 +-- 2.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 @Double 10 [1..]) (A.vector @Double 10 [2..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 0.4636 +-- 0.5880 +-- 0.6435 +-- 0.6747 +-- 0.6947 +-- 0.7086 +-- 0.7188 +-- 0.7266 +-- 0.7328 +-- 0.7378 +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 @Double 10 [1..]) (A.vector @Double 10 [2..]) True +-- ArrayFire Array +-- [10 1 1 1] +-- 0.4636 +-- 0.5880 +-- 0.6435 +-- 0.6747 +-- 0.6947 +-- 0.7086 +-- 0.7188 +-- 0.7266 +-- 0.7328 +-- 0.7378 +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.scalar @(Complex Double) (10 :+ 11)) :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 10.0000 +real + :: (AFType a, AFType (Complex b), RealFrac a, RealFrac b) + => Array (Complex b) + -- ^ Input array + -> Array a + -- ^ Result of calling 'real' +real = flip op1d af_real + +-- | Execute imag +-- +-- >>> A.imag (A.scalar @(Complex Double) (10 :+ 11)) :: Array Double +-- ArrayFire Array +-- [1 1 1 1] +-- 11.0000 +imag + :: (AFType a, AFType (Complex b), RealFrac a, RealFrac b) + => Array (Complex b) + -- ^ Input array + -> Array a + -- ^ Result of calling 'imag' +imag = flip op1d 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.4789 +-- 4051.5420 +-- 11013.2324 +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 factorial +-- +-- >>> A.factorial (A.vector @Int 10 [1..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 +-- 2.0000 +-- 6.0000 +-- 24.0000 +-- 120.0000 +-- 720.0001 +-- 5040.0020 +-- 40319.9961 +-- 362880.0000 +-- 3628801.7500 +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..]) +-- ArrayFire Array +-- [10 1 1 1] +-- 1.0000 +-- 1.0000 +-- 2.0000 +-- 6.0000 +-- 24.0000 +-- 120.0000 +-- 720.0001 +-- 5040.0020 +-- 40319.9961 +-- 362880.0000 +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 index 0000000..b0abc01 --- /dev/null +++ b/src/ArrayFire/Array.hs @@ -0,0 +1,507 @@ +{-# 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 1.0000 +-- 2.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' +-- +-- >>> A.matrix @Double (3,2) [[1,2,3],[4,5,6]] +-- ArrayFire Array +-- [3 2 1 1] +-- 1.0000 4.0000 +-- 2.0000 5.0000 +-- 3.0000 6.0000 +-- +matrix :: AFType a => (Int,Int) -> [[a]] -> Array a +matrix (x,y) + = mkArray [x,y] + . concat + . take y + . fmap (take x) + +-- | 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 z + . fmap (take y) + . (fmap . fmap . take) x + +-- | 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 z + . (fmap . take) y + . (fmap . fmap . take) x + . (fmap . fmap . fmap . take) w + +-- | 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 index 0000000..321980a --- /dev/null +++ b/src/ArrayFire/BLAS.hs @@ -0,0 +1,169 @@ +{-# 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,2],[3,4],[5,6]] +-- y = matrix (3,2) [[1,2,3],[4,5,6]] +-- +-- xProp, yProp :: MatProp +-- xProp = None +-- yProp = None +-- @ +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- 22.0000 49.0000 +-- 28.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 15.0000 +-- 10.0000 22.0000 +matmul + :: AFType a + => 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 + :: AFType a + => 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 + :: AFType a + => 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. +-- +-- >>> array = matrix @Double (2,3) [[2,3],[3,4],[5,6]] +-- >>> array +-- ArrayFire Array +-- [2 3 1 1] +-- 2.0000 3.0000 5.0000 +-- 3.0000 4.0000 6.0000 +-- +-- >>> transpose array True +-- ArrayFire Array +-- [3 2 1 1] +-- 2.0000 3.0000 +-- 3.0000 4.0000 +-- 5.0000 6.0000 +-- +transpose + :: AFType a + => 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]] +-- >>> array +-- ArrayFire Array +-- [3 2 1 1] +-- 1.0000 4.0000 +-- 2.0000 5.0000 +-- 3.0000 6.0000 +-- +-- >>> transposeInPlace array False +-- >>> array +-- ArrayFire Array +-- [2 2 1 1] +-- 1.0000 2.0000 +-- 3.0000 4.0000 +-- +transposeInPlace + :: AFType a + => 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 index 0000000..7b9b14f --- /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 index 0000000..8bcfe54 --- /dev/null +++ b/src/ArrayFire/Data.hs @@ -0,0 +1,619 @@ +{-# 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 +-- +-- Functions for populating 'Array' with Data. +-- +-- @ +-- >>> constant @Double [2,2] 2.0 +-- ArrayFire Array +-- [2 2 1 1] +-- 2.0000 2.0000 +-- 2.0000 2.0000 +-- @ +-- +-------------------------------------------------------------------------------- +module ArrayFire.Data where + +import Control.Exception +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.Ptr (Ptr) +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 5.0000 10.0000 +-- 1.0000 6.0000 11.0000 +-- 2.0000 7.0000 12.0000 +-- 3.0000 8.0000 13.0000 +-- 4.0000 9.0000 14.0000 +-- +-- >>> iota @Double [5,3] [1,2] +-- ArrayFire Array +-- [5 6 1 1] +-- 0.0000 5.0000 10.0000 0.0000 5.0000 10.0000 +-- 1.0000 6.0000 11.0000 1.0000 6.0000 11.0000 +-- 2.0000 7.0000 12.0000 2.0000 7.0000 12.0000 +-- 3.0000 8.0000 13.0000 3.0000 8.0000 13.0000 +-- 4.0000 9.0000 14.0000 4.0000 9.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 3.0000 +-- 2.0000 4.0000 +-- 5.0000 7.0000 +-- 6.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) (fmap (\(Array fp) -> fp) -> arrays) = unsafePerformIO . mask_ $ do + newPtr <- alloca $ \aPtr -> do + zeroOutArray aPtr + (throwAFError =<<) $ + withManyForeignPtr arrays $ \(fromIntegral -> nArrays) fPtrsPtr -> + af_join_many aPtr n nArrays fPtrsPtr + peek aPtr + Array <$> + newForeignPtr af_release_array_finalizer newPtr + +withManyForeignPtr :: [ForeignPtr a] -> (Int -> Ptr (Ptr a) -> IO b) -> IO b +withManyForeignPtr fptrs action = go [] fptrs + where + go ptrs [] = withArrayLen (reverse ptrs) action + go ptrs (fptr:others) = withForeignPtr fptr $ \ptr -> go (ptr : ptrs) others + +-- | 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 3.0000 +-- 2.0000 3.0000 +-- +-- >>> A.flip (matrix @Double (2,2) [[2,2],[3,3]]) 1 +-- ArrayFire Array +-- [2 2 1 1] +-- 3.0000 2.0000 +-- 3.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 0.0000 +-- 10.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 10.0000 +-- 0.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 arr1 x +-- 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 index 0000000..29a9e63 --- /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 index 0000000..bc8a12d --- /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 index 0000000..e776ace --- /dev/null +++ b/src/ArrayFire/FFI.hs @@ -0,0 +1,507 @@ +{-# 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 c +{-# 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) + +op2bool + :: Array b + -> Array a + -> (Ptr AFArray -> AFArray -> AFArray -> IO AFErr) + -> Array CBool +{-# NOINLINE op2bool #-} +op2bool (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 + +op1d + :: Array a + -> (Ptr AFArray -> AFArray -> IO AFErr) + -> Array b +{-# NOINLINE op1d #-} +op1d (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) + + +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 index 0000000..a84f58d --- /dev/null +++ b/src/ArrayFire/Features.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Features +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Functions for constructing and querying 'Features' +-- +-- @ +-- >>> createFeatures 10 +-- @ +-- +-------------------------------------------------------------------------------- +module ArrayFire.Features where + +import Foreign.Marshal +import Foreign.Storable +import Foreign.ForeignPtr +import System.IO.Unsafe + +import ArrayFire.Internal.Features +import ArrayFire.Internal.Types +import ArrayFire.FFI +import ArrayFire.Exception + +-- | Construct Features +-- +-- >>> features = createFeatures 10 +-- +createFeatures + :: Int + -> Features +createFeatures (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 +-- 1.8750 +-- 0.0000 +-- 2.3750 +-- 0.0000 +-- 2.5938 +-- 0.0000 +-- 2.0000 +-- 0.0000 +-- 2.4375 +getFeaturesXPos + :: Features + -> Array a +getFeaturesXPos = (`featuresToArray` af_get_features_xpos) + +-- | Get Feature Y-position +-- +-- >>> getFeaturesYPos (createFeatures 10) +-- ArrayFire Array +-- [10 1 1 1] +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +getFeaturesYPos + :: Features + -> Array a +getFeaturesYPos = (`featuresToArray` af_get_features_ypos) + +-- | Get Feature Score +-- +-- >>> getFeaturesScore (createFeatures 10) +-- ArrayFire Array +-- [10 1 1 1] +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +getFeaturesScore + :: Features + -> Array a +getFeaturesScore = (`featuresToArray` af_get_features_score) + +-- | Get Feature orientation +-- +-- >>> getFeaturesOrientation (createFeatures 10) +-- ArrayFire Array +-- [10 1 1 1] +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +-- nan +getFeaturesOrientation + :: Features + -> Array a +getFeaturesOrientation = (`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 index 0000000..e657625 --- /dev/null +++ b/src/ArrayFire/Graphics.hs @@ -0,0 +1,676 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Graphics +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Functions for displaying 'Array' graphically. +-- +-- @ +-- >>> window <- createWindow 800 600 "New Chart" +-- @ +-- +-------------------------------------------------------------------------------- +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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + + +-- | 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 + +-- | 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 index 0000000..9ae11d8 --- /dev/null +++ b/src/ArrayFire/Image.hs @@ -0,0 +1,762 @@ +{-# 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 +-- +-- Functions for loading and manipulating images with 'Array' +-- +-- @ +-- >>> image <- 'loadImage' "image.png" True +-- @ +-- +-------------------------------------------------------------------------------- +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 index 0000000..ae1eaa4 --- /dev/null +++ b/src/ArrayFire/Index.hs @@ -0,0 +1,105 @@ +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.Index +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- Functions for indexing into an 'Array' +-- +-------------------------------------------------------------------------------- +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 + -- ^ Input Array + -> Array Int + -- ^ Indices + -> Int + -- ^ Dimension + -> Array a +lookup a b n = op2 a b $ \p x y -> af_lookup p x y (fromIntegral n) + +-- | A special value representing the entire axis of an 'Array'. +span :: Seq +span = Seq 1 1 0 -- From include/af/seq.h + -- Hard-coded here because FFI cannot import static const values. + +-- 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 index 0000000..c683a0d --- /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 index 0000000..f6f27eb --- /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 index 0000000..6501f41 --- /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 index 0000000..b3b1788 --- /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 index 0000000..12d61b3 --- /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/CUDA.hsc b/src/ArrayFire/Internal/CUDA.hsc new file mode 100644 index 0000000..79aa46d --- /dev/null +++ b/src/ArrayFire/Internal/CUDA.hsc @@ -0,0 +1,17 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.CUDA where + +import ArrayFire.Internal.Defines +import ArrayFire.Internal.Types +import Data.Word +import Data.Int +import Foreign.Ptr +import Foreign.C.Types + +#include "af/cuda.h" +foreign import ccall unsafe "afcu_get_stream" + afcu_get_stream :: Ptr CudaStreamT -> CInt -> IO AFErr +foreign import ccall unsafe "afcu_get_native_id" + afcu_get_native_id :: Ptr CInt -> CInt -> IO AFErr +foreign import ccall unsafe "afcu_set_native_id" + afcu_set_native_id :: CInt -> IO AFErr \ No newline at end of file diff --git a/src/ArrayFire/Internal/Data.hsc b/src/ArrayFire/Internal/Data.hsc new file mode 100644 index 0000000..c1420e8 --- /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 index 0000000..9de5f06 --- /dev/null +++ b/src/ArrayFire/Internal/Defines.hsc @@ -0,0 +1,425 @@ +{-# 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 + +-- | AFDType +-- Newtype over ArrayFire's internal type tag +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 index 0000000..3ce659e --- /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 index 0000000..05dc880 --- /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 index 0000000..37715b5 --- /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 index 0000000..8b519a4 --- /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 index 0000000..0401448 --- /dev/null +++ b/src/ArrayFire/Internal/Image.hsc @@ -0,0 +1,95 @@ +{-# 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 diff --git a/src/ArrayFire/Internal/Index.hsc b/src/ArrayFire/Internal/Index.hsc new file mode 100644 index 0000000..a03c473 --- /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 index 0000000..63cc612 --- /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 index 0000000..52ca518 --- /dev/null +++ b/src/ArrayFire/Internal/LAPACK.hsc @@ -0,0 +1,39 @@ +{-# 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_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/OpenCL.hsc b/src/ArrayFire/Internal/OpenCL.hsc new file mode 100644 index 0000000..4b9089f --- /dev/null +++ b/src/ArrayFire/Internal/OpenCL.hsc @@ -0,0 +1,29 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.OpenCL where + +import ArrayFire.Internal.Defines +import ArrayFire.Internal.Types +import Data.Word +import Data.Int +import Foreign.Ptr +import Foreign.C.Types + +#include "af/opencl.h" +foreign import ccall unsafe "afcl_get_context" + afcl_get_context :: Ptr ClContext -> CBool -> IO AFErr +foreign import ccall unsafe "afcl_get_queue" + afcl_get_queue :: Ptr ClCommandQueue -> CBool -> IO AFErr +foreign import ccall unsafe "afcl_get_device_id" + afcl_get_device_id :: Ptr ClDeviceId -> IO AFErr +foreign import ccall unsafe "afcl_set_device_id" + afcl_set_device_id :: ClDeviceId -> IO AFErr +foreign import ccall unsafe "afcl_add_device_context" + afcl_add_device_context :: ClDeviceId -> ClContext -> ClCommandQueue -> IO AFErr +foreign import ccall unsafe "afcl_set_device_context" + afcl_set_device_context :: ClDeviceId -> ClContext -> IO AFErr +foreign import ccall unsafe "afcl_delete_device_context" + afcl_delete_device_context :: ClDeviceId -> ClContext -> IO AFErr +foreign import ccall unsafe "afcl_get_device_type" + afcl_get_device_type :: Ptr AfclDeviceType -> IO AFErr +foreign import ccall unsafe "afcl_get_platform" + afcl_get_platform :: Ptr AFCLPlatform -> IO AFErr \ No newline at end of file diff --git a/src/ArrayFire/Internal/Random.hsc b/src/ArrayFire/Internal/Random.hsc new file mode 100644 index 0000000..e3fa88d --- /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/Seq.hsc b/src/ArrayFire/Internal/Seq.hsc new file mode 100644 index 0000000..67835b5 --- /dev/null +++ b/src/ArrayFire/Internal/Seq.hsc @@ -0,0 +1,13 @@ +{-# LANGUAGE CPP #-} +module ArrayFire.Internal.Seq where + +import ArrayFire.Internal.Defines +import ArrayFire.Internal.Types +import Data.Word +import Data.Int +import Foreign.Ptr +import Foreign.C.Types + +#include "af/seq.h" +foreign import ccall unsafe "af_make_seq" + af_make_seq :: Double -> Double -> Double -> IO AFSeq \ No newline at end of file diff --git a/src/ArrayFire/Internal/Signal.hsc b/src/ArrayFire/Internal/Signal.hsc new file mode 100644 index 0000000..1740ebf --- /dev/null +++ b/src/ArrayFire/Internal/Signal.hsc @@ -0,0 +1,74 @@ +{-# 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_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 index 0000000..1685e9d --- /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 index 0000000..744e7b1 --- /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 index 0000000..3198d79 --- /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 index 0000000..fa8b8e7 --- /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 index 0000000..77addfe --- /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 index 0000000..d30e98f --- /dev/null +++ b/src/ArrayFire/LAPACK.hs @@ -0,0 +1,283 @@ +{-# LANGUAGE ViewPatterns #-} +-------------------------------------------------------------------------------- +-- | +-- Module : ArrayFire.LAPACK +-- Copyright : David Johnson (c) 2019-2020 +-- License : BSD 3 +-- Maintainer : David Johnson +-- Stability : Experimental +-- Portability : GHC +-- +-- LAPACK — Linear Algebra PACKage +-- +-- @ +-- >>> (u,e,d) = svd (constant @Double [3,3] 10) +-- >>> u +-- ArrayFire Array +-- [3 3 1 1] +-- -0.5774 0.8165 -0.0000 +-- -0.5774 -0.4082 -0.7071 +-- -0.5774 -0.4082 0.7071 +-- +-- >>> e +-- ArrayFire Array +-- [3 1 1 1] +-- 30.0000 +-- 0.0000 +-- 0.0000 +-- +-- >>> d +-- ArrayFire Array +-- [3 3 1 1] +-- -0.5774 -0.5774 -0.5774 +-- -0.8165 0.4082 0.4082 +-- -0.0000 0.7071 -0.7071 +-- +-- @ +-------------------------------------------------------------------------------- +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)) + +-- | 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 index 0000000..0d9383a --- /dev/null +++ b/src/ArrayFire/Orphans.hs @@ -0,0 +1,66 @@ +{-# 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.Algorithm as A +import qualified ArrayFire.Data as A +import ArrayFire.Types +import ArrayFire.Util + +instance (AFType a, Eq a) => Eq (Array a) where + x == y = A.allTrueAll (A.eqBatched x y False) == (1.0,0.0) + x /= y = A.allTrueAll (A.neqBatched x y False) == (0.0,0.0) + +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 x = A.sign (-x) - A.sign x + 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 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 + sqrt = A.sqrt @a + (**) = A.pow @a + sin = A.sin @a + cos = A.cos @a + tan = A.tan @a + tanh = A.tanh @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 index 0000000..0f0c31f --- /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' +-- +-- >>> randomUniform @Double [2,2] =<< getDefaultRandomEngine +-- +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- 0.6010 0.9806 +-- 0.0278 0.2126 +-- @ +-- +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' +-- +-- >>> randomNormal @Double [2,2] =<< getDefaultRandomEngine +-- +-- @ +-- ArrayFire Array +-- [2 2 1 1] +-- -1.4394 0.1952 +-- 0.7982 -0.9783 +-- @ +-- +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 index 0000000..4ddae65 --- /dev/null +++ b/src/ArrayFire/Signal.hs @@ -0,0 +1,751 @@ +{-# 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) +-- +-- Functions performing signal processing on 'Array' +-- +-- >>> 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 +-- +-------------------------------------------------------------------------------- +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 2.6250 +-- 1.3750 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 +-- [10 1 1 1] +-- (110.0000,0.0000) +-- (-10.0000,30.7768) +-- (-10.0000,13.7638) +-- (-10.0000,7.2654) +-- (-10.0000,3.2492) +-- (-10.0000,0.0000) +-- (-10.0000,-3.2492) +-- (-10.0000,-7.2654) +-- (-10.0000,-13.7638) +-- (-10.0000,-30.7768) +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 index 0000000..1b35026 --- /dev/null +++ b/src/ArrayFire/Sparse.hs @@ -0,0 +1,335 @@ +{-# 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 + :: (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 index 0000000..8a3db79 --- /dev/null +++ b/src/ArrayFire/Statistics.hs @@ -0,0 +1,310 @@ +{-# 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' +-- >>> vals +-- +-- ArrayFire Array +-- [3 1 1 1] +-- 10.0000 +-- 9.0000 +-- 8.0000 +-- +-- >>> indexes +-- +-- 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 ( vector @Int 10 [1..] ) 0 +-- 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.0000 +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 ( vector @Double 10 [1..] ) ( vector @Double 10 [1..] ) 0 +-- ArrayFire Array +-- [1 1 1 1] +-- 6.0000 +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.0000 +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.0000 +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. +-- +-- >>> median ( vector @Double 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' +-- +-- >>> meanAll $ matrix @Double (2,2) [[1,2],[4,5]] +-- (3.0,2.232709401e-314) +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' +-- +-- >>> meanAllWeighted (matrix @Double (2,2) [[1,2],[3,4]]) (matrix @Double (2,2) [[1,2],[3,4]]) +-- (3.0,1.400743288453e-312) +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' +-- +-- >>> varAll (vector @Double 10 (repeat 10)) False +-- (0.0,1.4013073623e-312) +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 @Double 10 [1..] ) ( vector @Double 10 [1..] ) +-- (6.0,2.1941097984e-314) +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' +-- +-- >>> stdevAll (vector @Double 10 (repeat 10)) +-- (0.0,2.190573324e-314) +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' +-- +-- >>> medianAll (vector @Double 10 (repeat 10)) +-- (10.0,2.1961564713e-314) +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. +-- +-- +-- >>> corrCoef ( vector @Int 10 [1..] ) ( vector @Int 10 [10,9..] ) +-- (-1.0,2.1904819737e-314) +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' +-- >>> indexes +-- +-- ArrayFire Array +-- [3 1 1 1] +-- 9 +-- 8 +-- 7 +-- +-- >>> vals +-- ArrayFire Array +-- [3 1 1 1] +-- 10.0000 +-- 9.0000 +-- 8.0000 +-- @ +-- +-- 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 index 0000000..e63f6c9 --- /dev/null +++ b/src/ArrayFire/Types.hs @@ -0,0 +1,67 @@ +{-# 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 +-- +-- Various Types related to the ArrayFire API +-- +-------------------------------------------------------------------------------- +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 index 0000000..d8ba69b --- /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 True + +-- | 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 index 0000000..71f3bd7 --- /dev/null +++ b/src/ArrayFire/Vision.hs @@ -0,0 +1,363 @@ +{-# 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 +-- +-- Functions pertaining to Computer Vision. +-- +-------------------------------------------------------------------------------- +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/stack.yaml b/stack.yaml new file mode 100644 index 0000000..65dfe28 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,5 @@ +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/25.yaml + +packages: +- . diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..fd29b3e --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,13 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 619403 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/25.yaml + sha256: 1ecad1f0bd2c27de88dbff6572446cfdf647c615d58a7e2e2085c6b7dfc04176 + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/25.yaml diff --git a/test/ArrayFire/AlgorithmSpec.hs b/test/ArrayFire/AlgorithmSpec.hs new file mode 100644 index 0000000..6e5b4d6 --- /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` A.scalar (1 A.:+ 1) + A.sum (A.scalar @(A.Complex Float) (1 A.:+ 1)) 0 `shouldBe` A.scalar (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` A.scalar (10.0 A.:+ 10.0) + A.sum (A.vector @(A.Complex Float) 10 (repeat (1 A.:+ 1))) 0 `shouldBe` A.scalar (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` A.scalar (10.0 A.:+ 10.0) + A.sumNaN (A.vector @(A.Complex Double) 10 (repeat (1 A.:+ 1))) 0 1.0 `shouldBe` A.scalar (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` A.scalar (1 A.:+ 1) + A.product (A.scalar @(A.Complex Float) (1 A.:+ 1)) 0 `shouldBe` A.scalar (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` A.scalar (0.0 A.:+ 32.0) + A.product (A.vector @(A.Complex Float) 10 (repeat (1 A.:+ 1))) 0 `shouldBe` A.scalar (0.0 A.:+ 32.0) + A.product (A.vector @A.CBool 10 (repeat 1)) 0 `shouldBe` 1 -- FIXED in 3.8.2, vector product along 0-axis is 1 for vector size 10 of all 1's. + 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` A.scalar (0.0 A.:+ 32) + A.productNaN (A.vector @(A.Complex Double) 10 (repeat (1 A.:+ 1))) 0 1.0 `shouldBe` A.scalar (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` A.scalar (1 A.:+ 1) + A.min (A.vector @(A.Complex Float) 10 (repeat (1 A.:+ 1))) 0 `shouldBe` A.scalar (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` 1 + A.allTrue (A.vector @A.CBool 5 (repeat 1)) 0 `shouldBe` 1 + A.allTrue (A.vector @A.CBool 5 (repeat 0)) 0 `shouldBe` 0 + A.allTrue (A.vector @A.CBool 5 (repeat 0)) 0 `shouldBe` 0 + it "Should find if any elements are true along dimension" $ do + A.anyTrue (A.vector @A.CBool 5 (repeat 1)) 0 `shouldBe` 1 + A.anyTrue (A.vector @Int 5 (repeat 23)) 0 `shouldBe` 1 + A.anyTrue (A.vector @A.CBool 5 (repeat 0)) 0 `shouldBe` 0 + 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) + 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 index 0000000..623726f --- /dev/null +++ b/test/ArrayFire/ArithSpec.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module ArrayFire.ArithSpec where + +import ArrayFire (AFType, Array, cast, clamp, getType, isInf, isZero, matrix, maxOf, minOf, mkArray, scalar, vector) +import qualified ArrayFire +import Control.Exception (throwIO) +import Control.Monad (unless, when) +import Foreign.C +import GHC.Exts (IsList (..)) +import GHC.Stack +import Test.HUnit.Lang (FailureReason (..), HUnitFailure (..)) +import Test.Hspec +import Test.Hspec.QuickCheck +import Prelude hiding (div) + +compareWith :: (HasCallStack, Show a) => (a -> a -> Bool) -> a -> a -> Expectation +compareWith comparator result expected = + unless (comparator result expected) $ do + throwIO (HUnitFailure location $ ExpectedButGot Nothing expectedMsg actualMsg) + where + expectedMsg = show expected + actualMsg = show result + location = case reverse (toList callStack) of + (_, loc) : _ -> Just loc + [] -> Nothing + +class (Num a) => HasEpsilon a where + eps :: a + +instance HasEpsilon Float where + eps = 1.1920929e-7 + +instance HasEpsilon Double where + eps = 2.220446049250313e-16 + +approxWith :: (Ord a, Num a) => a -> a -> a -> a -> Bool +approxWith rtol atol a b = abs (a - b) <= Prelude.max atol (rtol * Prelude.max (abs a) (abs b)) + +approx :: (Ord a, HasEpsilon a) => a -> a -> Bool +approx a b = approxWith (2 * eps * Prelude.max (abs a) (abs b)) (4 * eps) a b + +shouldBeApprox :: (Ord a, HasEpsilon a, Show a) => a -> a -> Expectation +shouldBeApprox = compareWith approx + +evalf :: (AFType a) => Array a -> a +evalf = ArrayFire.getScalar + +shouldMatchBuiltin :: + (AFType a, Ord a, RealFloat a, HasEpsilon a, Show a) => + (Array a -> Array a) -> + (a -> a) -> + a -> + Expectation +shouldMatchBuiltin f f' x + | isInfinite y && isInfinite y' = pure () + | Prelude.isNaN y && Prelude.isNaN y' = pure () + | otherwise = y `shouldBeApprox` y' + where + y = evalf (f (scalar x)) + y' = f' x + +shouldMatchBuiltin2 :: + (AFType a, Ord a, RealFloat a, HasEpsilon a, Show a) => + (Array a -> Array a -> Array a) -> + (a -> a -> a) -> + a -> + a -> + Expectation +shouldMatchBuiltin2 f f' a = shouldMatchBuiltin (f (scalar a)) (f' a) + +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 `ArrayFire.mul` 2 `shouldBe` 8 + it "Should divide two scalar arrays" $ do + ArrayFire.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]] + prop "Should take cubed root" $ \(x :: Double) -> + evalf (ArrayFire.cbrt (scalar (x * x * x))) `shouldBeApprox` x + + it "Should lte Array" $ do + 2 `ArrayFire.le` (3 :: Array Double) `shouldBe` 1 + it "Should gte Array" $ do + 2 `ArrayFire.ge` (3 :: Array Double) `shouldBe` 0 + it "Should gt Array" $ do + 2 `ArrayFire.gt` (3 :: Array Double) `shouldBe` 0 + it "Should lt Array" $ do + 2 `ArrayFire.le` (3 :: Array Double) `shouldBe` 1 + it "Should eq Array" $ do + 3 == (3 :: Array Double) `shouldBe` True + it "Should and Array" $ do + (mkArray @CBool [1] [0] `ArrayFire.and` mkArray [1] [1]) + `shouldBe` mkArray [1] [0] + it "Should and Array" $ do + (mkArray @CBool [2] [0, 0] `ArrayFire.and` mkArray [2] [1, 0]) + `shouldBe` mkArray [2] [0, 0] + it "Should or Array" $ do + (mkArray @CBool [2] [0, 0] `ArrayFire.or` mkArray [2] [1, 0]) + `shouldBe` mkArray [2] [1, 0] + it "Should not Array" $ do + ArrayFire.not (mkArray @CBool [2] [1, 0]) `shouldBe` mkArray [2] [0, 1] + it "Should bitwise and array" $ do + ArrayFire.bitAnd (scalar @Int 1) (scalar @Int 0) + `shouldBe` 0 + it "Should bitwise or array" $ do + ArrayFire.bitOr (scalar @Int 1) (scalar @Int 0) + `shouldBe` 1 + it "Should bitwise xor array" $ do + ArrayFire.bitXor (scalar @Int 1) (scalar @Int 1) + `shouldBe` 0 + it "Should bitwise shift left an array" $ do + ArrayFire.bitShiftL (scalar @Int 1) (scalar @Int 3) + `shouldBe` 8 + it "Should cast an array" $ do + getType (cast (scalar @Int 1) :: Array Double) + `shouldBe` ArrayFire.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 + ArrayFire.isNaN (scalar @Double (acos 2)) `shouldBe` scalar @Double 1 + ArrayFire.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 + + prop "Floating @Float (exp)" $ \(x :: Float) -> exp `shouldMatchBuiltin` exp $ x + prop "Floating @Float (log)" $ \(x :: Float) -> log `shouldMatchBuiltin` log $ x + prop "Floating @Float (sqrt)" $ \(x :: Float) -> sqrt `shouldMatchBuiltin` sqrt $ x + prop "Floating @Float (**)" $ \(x :: Float) (y :: Float) -> ((**) `shouldMatchBuiltin2` (**)) x y + prop "Floating @Float (sin)" $ \(x :: Float) -> sin `shouldMatchBuiltin` sin $ x + prop "Floating @Float (cos)" $ \(x :: Float) -> cos `shouldMatchBuiltin` cos $ x + prop "Floating @Float (tan)" $ \(x :: Float) -> tan `shouldMatchBuiltin` tan $ x + prop "Floating @Float (asin)" $ \(x :: Float) -> asin `shouldMatchBuiltin` asin $ x + prop "Floating @Float (acos)" $ \(x :: Float) -> acos `shouldMatchBuiltin` acos $ x + prop "Floating @Float (atan)" $ \(x :: Float) -> atan `shouldMatchBuiltin` atan $ x + prop "Floating @Float (sinh)" $ \(x :: Float) -> sinh `shouldMatchBuiltin` sinh $ x + prop "Floating @Float (cosh)" $ \(x :: Float) -> cosh `shouldMatchBuiltin` cosh $ x + prop "Floating @Float (tanh)" $ \(x :: Float) -> tanh `shouldMatchBuiltin` tanh $ x + prop "Floating @Float (asinh)" $ \(x :: Float) -> asinh `shouldMatchBuiltin` asinh $ x + prop "Floating @Float (acosh)" $ \(x :: Float) -> acosh `shouldMatchBuiltin` acosh $ x + prop "Floating @Float (atanh)" $ \(x :: Float) -> atanh `shouldMatchBuiltin` atanh $ x diff --git a/test/ArrayFire/ArraySpec.hs b/test/ArrayFire/ArraySpec.hs new file mode 100644 index 0000000..1452a00 --- /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 index 0000000..40cbbec --- /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 index 0000000..e75d883 --- /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 index 0000000..fcbd53f --- /dev/null +++ b/test/ArrayFire/DataSpec.hs @@ -0,0 +1,39 @@ +{-# 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) + it "Should join Arrays along the specified dimension" $ do + join 0 (constant @Int [1, 3] 1) (constant @Int [1, 3] 2) `shouldBe` mkArray @Int [2, 3] [1, 2, 1, 2, 1, 2] + join 1 (constant @Int [1, 2] 1) (constant @Int [1, 2] 2) `shouldBe` mkArray @Int [1, 4] [1, 1, 2, 2] + joinMany 0 [constant @Int [1, 3] 1, constant @Int [1, 3] 2] `shouldBe` mkArray @Int [2, 3] [1, 2, 1, 2, 1, 2] + joinMany 1 [constant @Int [1, 2] 1, constant @Int [1, 1] 2, constant @Int [1, 3] 3] `shouldBe` mkArray @Int [1, 6] [1, 1, 2, 3, 3, 3] diff --git a/test/ArrayFire/DeviceSpec.hs b/test/ArrayFire/DeviceSpec.hs new file mode 100644 index 0000000..3f2eceb --- /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 index 0000000..0d2405e --- /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 index 0000000..3e98667 --- /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 index 0000000..1824429 --- /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 index 0000000..d709317 --- /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 index 0000000..5c225c7 --- /dev/null +++ b/test/ArrayFire/LAPACKSpec.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.LAPACKSpec where + +import qualified ArrayFire as A +import Prelude +import Test.Hspec +import Test.Hspec.ApproxExpect + +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 `shouldBeApprox` (-14) + let (x,y) = A.det $ A.matrix @Double (2,2) [[3,8],[4,6]] + x `shouldBeApprox` (-14) +-- it "Should calculate inverse" $ do +-- let x = flip A.inverse A.None $ A.matrix @Double (2,2) [[4.0,7.0],[2.0,6.0]] +-- x `shouldBe` A.matrix (2,2) [[0.6,-0.7],[-0.2,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 index 0000000..926a9cf --- /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 index 0000000..06b890e --- /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 index 0000000..b90c931 --- /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 index 0000000..c8c6314 --- /dev/null +++ b/test/ArrayFire/StatisticsSpec.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE TypeApplications #-} +module ArrayFire.StatisticsSpec where + +import ArrayFire hiding (not) + +import Data.Complex +import Test.Hspec +import Test.Hspec.ApproxExpect + +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 + `shouldBeApprox` + 7.0 + it "Should find the variance" $ do + var (vector @Double 8 [1..8]) False 0 + `shouldBe` + 5.25 + 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 index 0000000..3539bc2 --- /dev/null +++ b/test/ArrayFire/UtilSpec.hs @@ -0,0 +1,48 @@ +{-# 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 + (major, minor, patch) <- A.getVersion + major `shouldBe` 3 + minor `shouldSatisfy` (>= 8) + patch `shouldSatisfy` (>= 0) + 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 index 0000000..82bddc1 --- /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 index 0000000..c949527 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,44 @@ +{-# 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 + A.setBackend A.CPU +-- 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 index 0000000..5416ef6 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} diff --git a/test/Test/Hspec/ApproxExpect.hs b/test/Test/Hspec/ApproxExpect.hs new file mode 100644 index 0000000..3e9d66b --- /dev/null +++ b/test/Test/Hspec/ApproxExpect.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Test.Hspec.ApproxExpect where + +import Data.CallStack (HasCallStack) + +import Test.Hspec (shouldSatisfy, Expectation) + +infix 1 `shouldBeApprox` + +shouldBeApprox :: (HasCallStack, Show a, Fractional a, Eq a) + => a -> a -> Expectation +shouldBeApprox actual tgt + -- This is a hackish way of checking, without requiring a specific + -- type or an 'Ord' instance, whether two floating-point values + -- are only some epsilons apart: when the difference is small enough + -- so scaling it down some more makes it a no-op for addition. + = actual `shouldSatisfy` \x -> (x-tgt) * 1e-4 + tgt == tgt + From fc8e1379f05d11177221e9239966d4f91183e419 Mon Sep 17 00:00:00 2001 From: dmjio Date: Mon, 8 Jun 2026 21:53:33 +0000 Subject: [PATCH 2/3] deploy: aa2667304f2eef36e8b4035558f2e17fb25339f7 --- flake.lock | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/flake.lock b/flake.lock index c767330..5e2dfa0 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1692792214, - "narHash": "sha256-voZDQOvqHsaReipVd3zTKSBwN7LZcUwi3/ThMxRZToU=", + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", "owner": "numtide", "repo": "flake-utils", - "rev": "1721b3e7c882f75f2301b00d48a2884af8c448ae", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", "type": "github" }, "original": { @@ -20,11 +20,11 @@ }, "nix-filter": { "locked": { - "lastModified": 1687178632, - "narHash": "sha256-HS7YR5erss0JCaUijPeyg2XrisEb959FIct3n2TMGbE=", + "lastModified": 1757882181, + "narHash": "sha256-+cCxYIh2UNalTz364p+QYmWHs0P+6wDhiWR4jDIKQIU=", "owner": "numtide", "repo": "nix-filter", - "rev": "d90c75e8319d0dd9be67d933d8eb9d0894ec9174", + "rev": "59c44d1909c72441144b93cf0f054be7fe764de5", "type": "github" }, "original": { @@ -35,11 +35,11 @@ }, "nixpkgs": { "locked": { - "lastModified": 1692638711, - "narHash": "sha256-J0LgSFgJVGCC1+j5R2QndadWI1oumusg6hCtYAzLID4=", + "lastModified": 1780749050, + "narHash": "sha256-3av0pIjlOWQ6rDbNOmpUSvbNnJkGORQKKjb4LtCZsIY=", "owner": "nixos", "repo": "nixpkgs", - "rev": "91a22f76cd1716f9d0149e8a5c68424bb691de15", + "rev": "a799d3e3886da994fa307f817a6bc705ae538eeb", "type": "github" }, "original": { From 330514347d6d59bde1f75a0ccdb407169afdc716 Mon Sep 17 00:00:00 2001 From: dmjio Date: Mon, 8 Jun 2026 22:29:20 +0000 Subject: [PATCH 3/3] deploy: 5bee13dafa051160dfeb019ea7644659510a7da5 --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index 7e2e104..6d6faf6 100644 --- a/README.md +++ b/README.md @@ -3,6 +3,8 @@ [![CI](https://github.com/arrayfire/arrayfire-haskell/actions/workflows/ci.yml/badge.svg)](https://github.com/arrayfire/arrayfire-haskell/actions/workflows/ci.yml) [![Hackage](https://img.shields.io/hackage/v/arrayfire.svg)](https://hackage.haskell.org/package/arrayfire) +See hosted [Haddock documentation](https://dmjio.github.io/arrayfire-haddocks/). + `ArrayFire` is a general-purpose library that simplifies the process of developing software that targets parallel and massively-parallel architectures including CPUs, GPUs, and other hardware acceleration devices. `arrayfire-haskell` is a [Haskell](https://haskell.org) binding to [ArrayFire](https://arrayfire.com).