neural-network-blashs-0.1.0.0: Yet Another High Performance and Extendable Neural Network in Haskell

Copyright(c) 2016 Jiasen Wu
LicenseBSD-style (see the file LICENSE)
MaintainerJiasen Wu <jiasenwu@hotmail.com>
Stabilityexperimental
Portabilityportable
Safe HaskellNone
LanguageHaskell2010

Data.NeuralNetwork.Backend.BLASHS

Description

This module supplies a backend for the neural-network-base package. This backend is implemented on top of the blas-hs package and optimised with SIMD.

Synopsis

Documentation

newtype DenseVector a Source #

mutable vector type

Constructors

DenseVector (IOVector a) 

Instances

(Numeric a, Storable a, SIMDable a) => AssignTo DenseVector a Source # 

Methods

(<<=) :: DenseVector a -> Op DenseVector a -> IO () Source #

(<<+) :: DenseVector a -> Op DenseVector a -> IO () Source #

Storable a => Size (DenseVector a) Source # 

Associated Types

type Dim (DenseVector a) :: * Source #

Methods

size :: DenseVector a -> Dim (DenseVector a) Source #

type Dim (DenseVector a) Source # 
type Dim (DenseVector a) = Int

data DenseMatrix a Source #

mutable matrix type (row-major)

Constructors

DenseMatrix !Int !Int !(IOVector a) 

Instances

(Numeric a, Storable a, SIMDable a) => AssignTo DenseMatrix a Source # 

Methods

(<<=) :: DenseMatrix a -> Op DenseMatrix a -> IO () Source #

(<<+) :: DenseMatrix a -> Op DenseMatrix a -> IO () Source #

Storable a => Size (DenseMatrix a) Source # 

Associated Types

type Dim (DenseMatrix a) :: * Source #

Methods

size :: DenseMatrix a -> Dim (DenseMatrix a) Source #

type Dim (DenseMatrix a) Source # 
type Dim (DenseMatrix a) = (Int, Int)

data DenseMatrixArray a Source #

array of DenseMatrix, which are identical in size.

Constructors

DenseMatrixArray !Int !Int !Int !(IOVector a) 

newDenseVectorCopy :: Storable a => DenseVector a -> IO (DenseVector a) Source #

create a copy DenseVector from another

newDenseVectorConst :: Storable a => Int -> a -> IO (DenseVector a) Source #

create a new DenseVector of some constant

newDenseVectorByGen :: Storable a => IO a -> Int -> IO (DenseVector a) Source #

create a new DenseVector by a random generator

newDenseMatrix Source #

Arguments

:: Storable a 
=> Int

number of rows

-> Int

number of columns

-> IO (DenseMatrix a) 

create a new DenseMatrix

newDenseMatrixConst :: Storable a => Int -> Int -> a -> IO (DenseMatrix a) Source #

create a new DenseMatrix of some constant

newDenseMatrixCopy :: Storable a => DenseMatrix a -> IO (DenseMatrix a) Source #

create a copy DenseMatrix from another

newDenseMatrixArray Source #

Arguments

:: Storable a 
=> Int

number of DenseMatrix

-> Int

number of rows

-> Int

number of columns

-> IO (DenseMatrixArray a) 

create a new DenseMatrixArray

class Size a where Source #

The Size class provides a interface to tell the dimension of a dense-vector, dense-matrix, or dense-matrix-array.

Minimal complete definition

size

Associated Types

type Dim a Source #

Methods

size :: a -> Dim a Source #

Instances

Storable a => Size (DenseMatrixArray a) Source # 

Associated Types

type Dim (DenseMatrixArray a) :: * Source #

Storable a => Size (DenseMatrix a) Source # 

Associated Types

type Dim (DenseMatrix a) :: * Source #

Methods

size :: DenseMatrix a -> Dim (DenseMatrix a) Source #

Storable a => Size (DenseVector a) Source # 

Associated Types

type Dim (DenseVector a) :: * Source #

Methods

size :: DenseVector a -> Dim (DenseVector a) Source #

denseVectorToVector :: Storable a => DenseVector a -> IO (Vector a) Source #

convert a DenseVector to a vector of elements

denseVectorConcat :: Storable a => Vector (DenseVector a) -> IO (DenseVector a) Source #

concatenate a vector of DenseVectors. If all the dense-vectors are orignally placed consecutively in storage, the result is simply a type-cast. Otherwise, a new storage is obtained, and dense-vectors are copied.

denseVectorSplit :: Storable a => Int -> Int -> DenseVector a -> Vector (DenseVector a) Source #

split a DenseVector into a vector of DenseVectors.

denseMatrixArrayFromVector :: Storable a => Vector (DenseMatrix a) -> IO (DenseMatrixArray a) Source #

convert a vector of DenseMatrix to DenseMatrixArray If all the matrices are orignally placed consecutively in storage, the result is simply a type-cast. Otherwise, a new storage is obtained, and matrices are copied.

v2m :: Int -> Int -> DenseVector a -> DenseMatrix a Source #

type cast from DenseVector to DenseMatrix

data Op :: (* -> *) -> * -> * where Source #

Operations that abstract the low-level details of blas-hs

Constructors

(:<#) :: DenseVector a -> DenseMatrix a -> Op DenseVector a infix 4

vector (as-row) and matrix production

(:#>) :: DenseMatrix a -> DenseVector a -> Op DenseVector a infix 4

matrix and vector (as-column) product

(:<>) :: DenseMatrix a -> DenseMatrix a -> Op DenseMatrix a infix 4

matrix and matrix product. This is a specially customized matrix matrix product, for the sake of quick convolution. The 1st matrix is transposed before multiplication, and the result matrix is stored in column-major mode.

(:##) :: DenseVector a -> DenseVector a -> Op DenseMatrix a infix 4

vector and vector outer-product

(:.*) :: c a -> c a -> Op c a infix 4

pairwise product of vector or matrix

(:.+) :: c a -> c a -> Op c a infix 4

pairwise sum of vector or matrix

Scale :: a -> Op c a

scale of vector or matrix

Apply :: (SIMDPACK a -> SIMDPACK a) -> Op c a

apply a SIMD-enabled function

ZipWith :: (SIMDPACK a -> SIMDPACK a -> SIMDPACK a) -> c a -> c a -> Op c a

zip with a SIMD-enabled function

Scale' :: a -> Op c a -> Op c a

scale the result of some op. It is possible to combine scale and many other operations in a single BLAS call.

UnsafeM2MA :: Op DenseMatrix a -> Op DenseMatrixArray a

interpret an op to matrix as an op to matrixarray, where each row becomes a matrix. This Op is only used internally inside this module

class AssignTo c a where Source #

Perform an operation

Minimal complete definition

(<<=), (<<+)

Methods

(<<=) :: c a -> Op c a -> IO () infix 0 Source #

store the result of a Op to the lhs

(<<+) :: c a -> Op c a -> IO () infix 0 Source #

add the result of a Op to the lhs and store

Instances

sumElements :: (Storable a, Num a) => DenseMatrix a -> IO a Source #

sum up all elements in the DenseMatrix

corr2 Source #

Arguments

:: (Storable a, Numeric a) 
=> Int

number of 0s padded around

-> Vector (DenseMatrix a)

vector of kernels

-> DenseMatrix a

matrix to be operated

-> (Op DenseMatrixArray a -> IO b)

how to perform the final operation

-> IO b 

2D correlation. Apply a vector of kernels to a dense-matrix with some zero-padding.

conv2 Source #

Arguments

:: (Storable a, Numeric a) 
=> Int

number of 0s padded around

-> Vector (DenseMatrix a)

vector of kernels

-> DenseMatrix a

matrix to be operated

-> (Op DenseMatrixArray a -> IO b)

how to perform the final operation

-> IO b 

2D convolution. Apply a vector of kernels to a dense-matrix with some zero-padding.

pool :: Int -> DenseMatrix Float -> IO (DenseVector Int, DenseMatrix Float) Source #

max-pooling, picking out the maximum element in each stride x stride sub-matrices. Assuming that the original matrix row and column size are both multiple of stride.

unpool :: Int -> DenseVector Int -> DenseMatrix Float -> IO (DenseMatrix Float) Source #

The reverse of max-pooling.

transpose :: Storable a => Vector (DenseMatrixArray a) -> IO (Vector (Vector (DenseMatrix a))) Source #

transpose a vector of DenseMatrixArray The result is vector of vector of DenseMatrix, because the matrices are no longer placed consecutively in storage.

data ByBLASHS Source #

The backend data type

Constructors

ByBLASHS 

Instances

(HeadSize z, TranslateBody s, Component (RunLayer (SpecToTag s)), (~) (* -> *) (Run (RunLayer (SpecToTag s))) IO) => Backend ByBLASHS ((:++) z s) Source #

Neural network specified to start with 1D / 2D input

Associated Types

type Env ByBLASHS :: * -> * #

type ConvertFromSpec ((:++) z s) :: * #

type Env ByBLASHS Source # 

data ErrCode Source #

Constructors

ErrMismatch 

cost' :: SIMDPACK Float -> SIMDPACK Float -> SIMDPACK Float Source #

SIMD based, derivative of error measurement