{-# LANGUAGE ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  HFANN
-- Copyright   :  (c) Olivier Boudry 2008
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  olivier.boudry@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- The Fast Artificial Neural Network Library (FANN) is a free open source
-- neural network library written in C with support for both fully connected
-- and sparsely connected networks (<http://leenissen.dk/fann/>).
--
-- HFANN is a Haskell interface to this library.
--
-----------------------------------------------------------------------------

module HFANN.Base (

  -- * ANN Creation
  withStandardFann,
  withSparseFann,
  withShortcutFann,

  -- * ANN Initialization
  randomizeWeights,

  -- * ANN Use
  runFann,
  printConnections,

  ) where

import HFANN.Data (FannType, CFannType, CFannTypePtr, FannPtr)

import Control.Exception (bracket)

import Foreign (Ptr)
import Foreign.C.Types (CUInt, CFloat)
import Foreign.Marshal.Array (peekArray, withArray)

-- | Run the trained Neural Network on provided input
--
runFann :: FannPtr       -- ^ The ANN
        -> [FannType]    -- ^ A list of inputs
        -> IO [FannType] -- ^ A list of outputs
runFann fann input = do
  len <- getOutputNodesCount fann
  withArray (map realToFrac input) $ \arr -> do
    res <- f_fann_run fann arr
    a <- peekArray len res
    return $ map realToFrac a

-- | Create a new standard fully connected Neural Network and call the
--   given function with the ANN as argument.
--   When finished destroy the Neural Network.
--
--   The structure of the ANN is given by the first parameter. It's an
--   Int list giving the number of nodes per layer from input layer to
--   output layer.
--
--   Example: @[2,3,1]@ would describe an ANN with 2 nodes in the input layer,
--   one hidden layer of 3 nodes and 1 node in the output layer.
--
--   The function provided as second argument will be called with the created
--   ANN as parameter.
--
withStandardFann :: [Int]             -- ^ The ANN structure
                 -> (FannPtr -> IO a) -- ^ A function using the ANN
                 -> IO a              -- ^ The return value
withStandardFann nodes f = do
  bracket
    (createStandardFann nodes)
    destroyFann
    f

-- | Create a new sparse not fully connected Neural Network and call the
--   given function with the ANN as argument. When finished destroy the ANN.
--
withSparseFann :: Float             -- ^ The ratio of connections
               -> [Int]             -- ^ The ANN structure
               -> (FannPtr -> IO a) -- ^ A function using the ANN
               -> IO a              -- ^ The return value
withSparseFann ratio nodes f = do
  bracket
    (createSparseFann ratio nodes)
    destroyFann
    f

-- | Create a new sparse not fully connected Neural Network with shortcut
--   connections between layers and call the given function with the ANN 
--   as argument. When finished destroy the Neural Network
--
withShortcutFann :: [Int]             -- ^ The ANN structure
                 -> (FannPtr -> IO a) -- ^ A function using the ANN
                 -> IO a              -- ^ The return value
withShortcutFann nodes f = do
  bracket
    (createShortcutFann nodes)
    destroyFann
    f

-- | Randomize weights to values in the given range
--
-- Weights in a newly created ANN are already initialized to random values.
-- You can use this function if you want to customize the random weights
-- upper and lower bounds.
--
randomizeWeights :: FannPtr              -- ^ The ANN
                 -> (FannType, FannType) -- ^ min and max bounds for weights
                                         -- initialization
                 -> IO ()
randomizeWeights fann (low, high) = do
  f_fann_randomize_weights fann l h
  where
    l = realToFrac low
    h = realToFrac high
-- | Create a new standard fully connected Neural Network

createStandardFann :: [Int] -> IO FannPtr
createStandardFann nodes = do
  let len = fromIntegral $ length nodes
  withArray (map fromIntegral nodes) $ f_fann_create_standard_array len

-- | Create a sparse not fully connected Neural Network

createSparseFann :: Float -> [Int] -> IO FannPtr
createSparseFann ratio nodes = do
  let len = fromIntegral $ length nodes
  withArray (map fromIntegral nodes)
              $ f_fann_create_sparse_array (realToFrac ratio) len

-- | Create a sparse not fully connected Neural Network with shortcut
--   connections between layers

createShortcutFann :: [Int] -> IO FannPtr
createShortcutFann nodes = do
  let len = fromIntegral $ length nodes
  withArray (map fromIntegral nodes) $ f_fann_create_shortcut_array len

-- | Return the number of output nodes of the Neural Network

getOutputNodesCount :: FannPtr -> IO Int
getOutputNodesCount fann = do
  n <- f_fann_get_num_output fann
  return $ fromIntegral n

-- | Create a standard fully connected Neural Network

foreign import ccall unsafe "fann.h fann_create_standard_array"
  f_fann_create_standard_array :: CUInt -> Ptr CUInt -> IO FannPtr

-- | Create a sparse not fully connected Neural Network

foreign import ccall unsafe "fann.h fann_create_sparse_array"
  f_fann_create_sparse_array :: CFloat -> CUInt -> Ptr CUInt -> IO FannPtr

-- | Create a sparse not fully connected Neural Network with shortcuts between
--   layers

foreign import ccall unsafe "fann.h fann_create_shortcut_array"
  f_fann_create_shortcut_array :: CUInt -> Ptr CUInt -> IO FannPtr

-- | Destroy the Neural Network, releasing memory.

foreign import ccall unsafe "fann.h fann_destroy"
  destroyFann :: FannPtr -> IO ()

-- | Return the number of output nodes

foreign import ccall unsafe "fann.h fann_get_num_output"
  f_fann_get_num_output :: FannPtr -> IO (CUInt)

-- | Run the trained Neural Network with a specific input

foreign import ccall unsafe "fann.h fann_run"
  f_fann_run :: FannPtr -> CFannTypePtr -> IO (CFannTypePtr)

-- | Print the connections

foreign import ccall unsafe "fann.h fann_print_connections"
  printConnections :: FannPtr -> IO ()

-- | Randomize the weights to values in the given range

foreign import ccall unsafe "fann.h fann_randomize_weights"
  f_fann_randomize_weights :: FannPtr -> CFannType -> CFannType -> IO ()