diff --git a/Bindings/LevMar.hsc b/Bindings/LevMar.hsc --- a/Bindings/LevMar.hsc +++ b/Bindings/LevMar.hsc @@ -1,5 +1,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-} + -------------------------------------------------------------------------------- -- | -- Module : Bindings.LevMar @@ -9,36 +12,39 @@ -- Maintainer : vandijk.roel@gmail.com, v.dijk.bas@gmail.com -- Stability : Experimental -- --- A binding to the C levmar (Levenberg-Marquardt) library +-- A low level binding to the C levmar (Levenberg-Marquardt) library. -- -- For documentation see: -- -------------------------------------------------------------------------------- +#include +#include + module Bindings.LevMar - ( _LM_VERSION + ( c'LM_VERSION -- * Maximum sizes of arrays. - , _LM_OPTS_SZ - , _LM_INFO_SZ + , c'LM_OPTS_SZ + , c'LM_INFO_SZ -- * Errors. - , _LM_ERROR - , _LM_ERROR_LAPACK_ERROR - , _LM_ERROR_NO_JACOBIAN - , _LM_ERROR_NO_BOX_CONSTRAINTS - , _LM_ERROR_FAILED_BOX_CHECK - , _LM_ERROR_MEMORY_ALLOCATION_FAILURE - , _LM_ERROR_CONSTRAINT_MATRIX_ROWS_GT_COLS - , _LM_ERROR_CONSTRAINT_MATRIX_NOT_FULL_ROW_RANK - , _LM_ERROR_TOO_FEW_MEASUREMENTS - , _LM_ERROR_SINGULAR_MATRIX - , _LM_ERROR_SUM_OF_SQUARES_NOT_FINITE + , c'LM_ERROR + , c'LM_ERROR_LAPACK_ERROR + , c'LM_ERROR_NO_JACOBIAN + , c'LM_ERROR_NO_BOX_CONSTRAINTS + , c'LM_ERROR_FAILED_BOX_CHECK + , c'LM_ERROR_MEMORY_ALLOCATION_FAILURE + , c'LM_ERROR_CONSTRAINT_MATRIX_ROWS_GT_COLS + , c'LM_ERROR_CONSTRAINT_MATRIX_NOT_FULL_ROW_RANK + , c'LM_ERROR_TOO_FEW_MEASUREMENTS + , c'LM_ERROR_SINGULAR_MATRIX + , c'LM_ERROR_SUM_OF_SQUARES_NOT_FINITE -- * Default values for minimization options. - , _LM_INIT_MU - , _LM_STOP_THRESH - , _LM_DIFF_DELTA + , c'LM_INIT_MU + , c'LM_STOP_THRESH + , c'LM_DIFF_DELTA -- * Handy type synonyms , Parameters @@ -76,28 +82,28 @@ , LevMarBLecDif -- * Levenberg-Marquardt algorithms. - , dlevmar_der - , slevmar_der - , dlevmar_dif - , slevmar_dif - , dlevmar_bc_der - , slevmar_bc_der - , dlevmar_bc_dif - , slevmar_bc_dif - , dlevmar_lec_der - , slevmar_lec_der - , dlevmar_lec_dif - , slevmar_lec_dif - , dlevmar_blec_der - , slevmar_blec_der - , dlevmar_blec_dif - , slevmar_blec_dif + , c'dlevmar_der + , c'slevmar_der + , c'dlevmar_dif + , c'slevmar_dif + , c'dlevmar_bc_der + , c'slevmar_bc_der + , c'dlevmar_bc_dif + , c'slevmar_bc_dif + , c'dlevmar_lec_der + , c'slevmar_lec_der + , c'dlevmar_lec_dif + , c'slevmar_lec_dif + , c'dlevmar_blec_der + , c'slevmar_blec_der + , c'dlevmar_blec_dif + , c'slevmar_blec_dif -- * Jacobian verification , Errors , LevMarChkJac - , dlevmar_chkjac - , slevmar_chkjac + , c'dlevmar_chkjac + , c'slevmar_chkjac -- * Utils , BestFitParameterIx @@ -108,25 +114,39 @@ , Result - , dlevmar_stddev - , slevmar_stddev - , dlevmar_corcoef - , slevmar_corcoef - , dlevmar_R2 - , slevmar_R2 + , c'dlevmar_stddev + , c'slevmar_stddev + , c'dlevmar_corcoef + , c'slevmar_corcoef + , c'dlevmar_R2 + , c'slevmar_R2 ) where +-------------------------------------------------------------------------------- +-- Imports +-------------------------------------------------------------------------------- + +import Prelude ( Num, Fractional ) + +#if __GLASGOW_HASKELL__ < 700 +import Prelude ( negate, fromInteger, fromRational ) +#endif + +import System.IO ( IO ) +import Data.Char ( String ) import Foreign.C.Types ( CInt, CFloat, CDouble ) import Foreign.Ptr ( Ptr, FunPtr, freeHaskellFunPtr ) import Control.Exception ( bracket ) -#include +-------------------------------------------------------------------------------- +-- Version +-------------------------------------------------------------------------------- -- | The version of the C levmar library. -_LM_VERSION :: String -_LM_VERSION = #const_str LM_VERSION +c'LM_VERSION :: String +c'LM_VERSION = #const_str LM_VERSION -------------------------------------------------------------------------------- @@ -134,44 +154,36 @@ -------------------------------------------------------------------------------- -- | The maximum size of the options array. -_LM_OPTS_SZ :: Int -_LM_OPTS_SZ = #const LM_OPTS_SZ +#num LM_OPTS_SZ -- | The size of the info array. -_LM_INFO_SZ :: Int -_LM_INFO_SZ = #const LM_INFO_SZ +#num LM_INFO_SZ -------------------------------------------------------------------------------- -- Errors. -------------------------------------------------------------------------------- -#{enum CInt, - , _LM_ERROR = LM_ERROR - , _LM_ERROR_LAPACK_ERROR = LM_ERROR_LAPACK_ERROR - , _LM_ERROR_NO_JACOBIAN = LM_ERROR_NO_JACOBIAN - , _LM_ERROR_NO_BOX_CONSTRAINTS = LM_ERROR_NO_BOX_CONSTRAINTS - , _LM_ERROR_FAILED_BOX_CHECK = LM_ERROR_FAILED_BOX_CHECK - , _LM_ERROR_MEMORY_ALLOCATION_FAILURE = LM_ERROR_MEMORY_ALLOCATION_FAILURE - , _LM_ERROR_CONSTRAINT_MATRIX_ROWS_GT_COLS = LM_ERROR_CONSTRAINT_MATRIX_ROWS_GT_COLS - , _LM_ERROR_CONSTRAINT_MATRIX_NOT_FULL_ROW_RANK = LM_ERROR_CONSTRAINT_MATRIX_NOT_FULL_ROW_RANK - , _LM_ERROR_TOO_FEW_MEASUREMENTS = LM_ERROR_TOO_FEW_MEASUREMENTS - , _LM_ERROR_SINGULAR_MATRIX = LM_ERROR_SINGULAR_MATRIX - , _LM_ERROR_SUM_OF_SQUARES_NOT_FINITE = LM_ERROR_SUM_OF_SQUARES_NOT_FINITE - } +#num LM_ERROR +#num LM_ERROR_LAPACK_ERROR +#num LM_ERROR_NO_JACOBIAN +#num LM_ERROR_NO_BOX_CONSTRAINTS +#num LM_ERROR_FAILED_BOX_CHECK +#num LM_ERROR_MEMORY_ALLOCATION_FAILURE +#num LM_ERROR_CONSTRAINT_MATRIX_ROWS_GT_COLS +#num LM_ERROR_CONSTRAINT_MATRIX_NOT_FULL_ROW_RANK +#num LM_ERROR_TOO_FEW_MEASUREMENTS +#num LM_ERROR_SINGULAR_MATRIX +#num LM_ERROR_SUM_OF_SQUARES_NOT_FINITE -------------------------------------------------------------------------------- -- Default values for minimization options. -------------------------------------------------------------------------------- -#let const_real r = "%e", r - -_LM_INIT_MU, _LM_STOP_THRESH, _LM_DIFF_DELTA :: Fractional a => a - -_LM_INIT_MU = #const_real LM_INIT_MU -_LM_STOP_THRESH = #const_real LM_STOP_THRESH -_LM_DIFF_DELTA = #const_real LM_DIFF_DELTA +#fractional LM_INIT_MU +#fractional LM_STOP_THRESH +#fractional LM_DIFF_DELTA -------------------------------------------------------------------------------- @@ -361,22 +373,22 @@ -- Levenberg-Marquardt algorithms. -------------------------------------------------------------------------------- -foreign import ccall "slevmar_der" slevmar_der :: LevMarDer CFloat -foreign import ccall "dlevmar_der" dlevmar_der :: LevMarDer CDouble -foreign import ccall "slevmar_dif" slevmar_dif :: LevMarDif CFloat -foreign import ccall "dlevmar_dif" dlevmar_dif :: LevMarDif CDouble -foreign import ccall "slevmar_bc_der" slevmar_bc_der :: LevMarBCDer CFloat -foreign import ccall "dlevmar_bc_der" dlevmar_bc_der :: LevMarBCDer CDouble -foreign import ccall "slevmar_bc_dif" slevmar_bc_dif :: LevMarBCDif CFloat -foreign import ccall "dlevmar_bc_dif" dlevmar_bc_dif :: LevMarBCDif CDouble -foreign import ccall "slevmar_lec_der" slevmar_lec_der :: LevMarLecDer CFloat -foreign import ccall "dlevmar_lec_der" dlevmar_lec_der :: LevMarLecDer CDouble -foreign import ccall "slevmar_lec_dif" slevmar_lec_dif :: LevMarLecDif CFloat -foreign import ccall "dlevmar_lec_dif" dlevmar_lec_dif :: LevMarLecDif CDouble -foreign import ccall "slevmar_blec_der" slevmar_blec_der :: LevMarBLecDer CFloat -foreign import ccall "dlevmar_blec_der" dlevmar_blec_der :: LevMarBLecDer CDouble -foreign import ccall "slevmar_blec_dif" slevmar_blec_dif :: LevMarBLecDif CFloat -foreign import ccall "dlevmar_blec_dif" dlevmar_blec_dif :: LevMarBLecDif CDouble +#ccall slevmar_der , LevMarDer CFloat +#ccall dlevmar_der , LevMarDer CDouble +#ccall slevmar_dif , LevMarDif CFloat +#ccall dlevmar_dif , LevMarDif CDouble +#ccall slevmar_bc_der , LevMarBCDer CFloat +#ccall dlevmar_bc_der , LevMarBCDer CDouble +#ccall slevmar_bc_dif , LevMarBCDif CFloat +#ccall dlevmar_bc_dif , LevMarBCDif CDouble +#ccall slevmar_lec_der , LevMarLecDer CFloat +#ccall dlevmar_lec_der , LevMarLecDer CDouble +#ccall slevmar_lec_dif , LevMarLecDif CFloat +#ccall dlevmar_lec_dif , LevMarLecDif CDouble +#ccall slevmar_blec_der , LevMarBLecDer CFloat +#ccall dlevmar_blec_der , LevMarBLecDer CDouble +#ccall slevmar_blec_dif , LevMarBLecDif CFloat +#ccall dlevmar_blec_dif , LevMarBLecDif CDouble -------------------------------------------------------------------------------- @@ -394,8 +406,8 @@ -> Errors cr -> IO () -foreign import ccall "dlevmar_chkjac" dlevmar_chkjac :: LevMarChkJac CDouble -foreign import ccall "slevmar_chkjac" slevmar_chkjac :: LevMarChkJac CFloat +#ccall dlevmar_chkjac , LevMarChkJac CDouble +#ccall slevmar_chkjac , LevMarChkJac CFloat -------------------------------------------------------------------------------- @@ -429,12 +441,12 @@ type Result = Ptr -foreign import ccall "dlevmar_stddev" dlevmar_stddev :: LevMarStddev CDouble -foreign import ccall "slevmar_stddev" slevmar_stddev :: LevMarStddev CFloat -foreign import ccall "dlevmar_corcoef" dlevmar_corcoef :: LevMarCorCoef CDouble -foreign import ccall "slevmar_corcoef" slevmar_corcoef :: LevMarCorCoef CFloat -foreign import ccall "dlevmar_R2" dlevmar_R2 :: LevMarR2 CDouble -foreign import ccall "slevmar_R2" slevmar_R2 :: LevMarR2 CFloat +#ccall dlevmar_stddev , LevMarStddev CDouble +#ccall slevmar_stddev , LevMarStddev CFloat +#ccall dlevmar_corcoef , LevMarCorCoef CDouble +#ccall slevmar_corcoef , LevMarCorCoef CFloat +#ccall dlevmar_R2 , LevMarR2 CDouble +#ccall slevmar_R2 , LevMarR2 CFloat -- The End --------------------------------------------------------------------- diff --git a/Bindings/LevMar/CurryFriendly.hs b/Bindings/LevMar/CurryFriendly.hs deleted file mode 100644 --- a/Bindings/LevMar/CurryFriendly.hs +++ /dev/null @@ -1,244 +0,0 @@ --------------------------------------------------------------------------------- --- | --- Module : Bindings.LevMar.CurryFriendly --- Copyright : (c) 2009 Roel van Dijk & Bas van Dijk --- License : BSD-style (see the file LICENSE) --- --- Maintainer : vandijk.roel@gmail.com, v.dijk.bas@gmail.com --- Stability : Experimental --- --- Curry friendly variants of the Levenberg-Marquardt algorithms in 'Bindings.LevMar'. --- --- (This module re-exports all the necessary types and function from --- 'Bindings.LevMar', so there's no need to import that module when --- you want to use this one.) --- --------------------------------------------------------------------------------- - -module Bindings.LevMar.CurryFriendly - ( LMA_C._LM_VERSION - - -- * Maximum sizes of arrays. - , LMA_C._LM_OPTS_SZ - , LMA_C._LM_INFO_SZ - - -- * Errors - , LMA_C._LM_ERROR - , LMA_C._LM_ERROR_LAPACK_ERROR - , LMA_C._LM_ERROR_NO_JACOBIAN - , LMA_C._LM_ERROR_NO_BOX_CONSTRAINTS - , LMA_C._LM_ERROR_FAILED_BOX_CHECK - , LMA_C._LM_ERROR_MEMORY_ALLOCATION_FAILURE - , LMA_C._LM_ERROR_CONSTRAINT_MATRIX_ROWS_GT_COLS - , LMA_C._LM_ERROR_CONSTRAINT_MATRIX_NOT_FULL_ROW_RANK - , LMA_C._LM_ERROR_TOO_FEW_MEASUREMENTS - , LMA_C._LM_ERROR_SINGULAR_MATRIX - , LMA_C._LM_ERROR_SUM_OF_SQUARES_NOT_FINITE - - -- * Default values for options. - , LMA_C._LM_INIT_MU - , LMA_C._LM_STOP_THRESH - , LMA_C._LM_DIFF_DELTA - - -- * Handy type synonyms - , LMA_C.Parameters - , LMA_C.Measurements - , LMA_C.Options - , LMA_C.LowerBounds - , LMA_C.UpperBounds - , LMA_C.ConstraintsMatrix - , LMA_C.ConstraintsVector - , LMA_C.Weights - , LMA_C.Info - , LMA_C.Work - , LMA_C.Covar - , LMA_C.AData - , LMA_C.NrOfParameters - , LMA_C.NrOfMeasurements - , LMA_C.NrOfConstraints - , LMA_C.MaxIterations - - -- * Model & Jacobian - , LMA_C.Model - , LMA_C.Jacobian - - , LMA_C.withModel - , LMA_C.withJacobian - - -- * Handy type synonyms used in the curry friendly types. - , BoxConstraints - , LinearConstraints - - -- * Curry friendly types of the Levenberg-Marquardt algorithms. - , LevMarDer - , LevMarDif - , LevMarBCDer - , LevMarBCDif - , LevMarLecDer - , LevMarLecDif - , LevMarBLecDer - , LevMarBLecDif - - -- * Curry friendly variants of the Levenberg-Marquardt algorithms in 'Bindings.Levmar'. - , dlevmar_der - , slevmar_der - , dlevmar_dif - , slevmar_dif - , dlevmar_bc_der - , slevmar_bc_der - , dlevmar_bc_dif - , slevmar_bc_dif - , dlevmar_lec_der - , slevmar_lec_der - , dlevmar_lec_dif - , slevmar_lec_dif - , dlevmar_blec_der - , slevmar_blec_der - , dlevmar_blec_dif - , slevmar_blec_dif - - -- * Jacobian verification - , LMA_C.Errors - , LMA_C.LevMarChkJac - , LMA_C.dlevmar_chkjac - , LMA_C.slevmar_chkjac - - -- * Utils - , LMA_C.BestFitParameterIx - - , LMA_C.LevMarStddev - , LMA_C.LevMarCorCoef - , LMA_C.LevMarR2 - - , LMA_C.Result - - , LMA_C.dlevmar_stddev - , LMA_C.slevmar_stddev - , LMA_C.dlevmar_corcoef - , LMA_C.slevmar_corcoef - , LMA_C.dlevmar_R2 - , LMA_C.slevmar_R2 - ) where - - -import Foreign.C.Types ( CFloat, CDouble ) -import Foreign.Ptr ( FunPtr ) - -import qualified Bindings.LevMar as LMA_C - - --------------------------------------------------------------------------------- --- Handy type synonyms used in the curry friendly types. --------------------------------------------------------------------------------- - -type BoxConstraints cr a = LMA_C.LowerBounds cr - -> LMA_C.UpperBounds cr - -> a - -type LinearConstraints cr a = LMA_C.ConstraintsMatrix cr - -> LMA_C.ConstraintsVector cr - -> LMA_C.NrOfConstraints - -> a - - --------------------------------------------------------------------------------- --- Curry friendly types of the Levenberg-Marquardt algorithms. --------------------------------------------------------------------------------- - -type LevMarDif cr = LMA_C.LevMarDif cr -type LevMarDer cr = FunPtr (LMA_C.Jacobian cr) -> LevMarDif cr -type LevMarBCDif cr = BoxConstraints cr (LevMarDif cr) -type LevMarBCDer cr = BoxConstraints cr (LevMarDer cr) -type LevMarLecDif cr = LinearConstraints cr (LevMarDif cr) -type LevMarLecDer cr = LinearConstraints cr (LevMarDer cr) -type LevMarBLecDif cr = BoxConstraints cr (LinearConstraints cr (LMA_C.Weights cr -> (LevMarDif cr))) -type LevMarBLecDer cr = BoxConstraints cr (LinearConstraints cr (LMA_C.Weights cr -> (LevMarDer cr))) - - --------------------------------------------------------------------------------- --- Reordering arguments to create curry friendly variants. --------------------------------------------------------------------------------- - -mk_levmar_der :: LMA_C.LevMarDer cr -> LevMarDer cr -mk_levmar_der lma j f - = lma f j - -mk_levmar_bc_dif :: LMA_C.LevMarBCDif cr -> LevMarBCDif cr -mk_levmar_bc_dif lma lb ub f p x m n - = lma f p x m n lb ub - -mk_levmar_bc_der :: LMA_C.LevMarBCDer cr -> LevMarBCDer cr -mk_levmar_bc_der lma lb ub j f p x m n - = lma f j p x m n lb ub - -mk_levmar_lec_dif :: LMA_C.LevMarLecDif cr -> LevMarLecDif cr -mk_levmar_lec_dif lma a b k f p x m n - = lma f p x m n a b k - -mk_levmar_lec_der :: LMA_C.LevMarLecDer cr -> LevMarLecDer cr -mk_levmar_lec_der lma a b k j f p x m n - = lma f j p x m n a b k - -mk_levmar_blec_dif :: LMA_C.LevMarBLecDif cr -> LevMarBLecDif cr -mk_levmar_blec_dif lma lb ub a b k wghts f p x m n - = lma f p x m n lb ub a b k wghts - -mk_levmar_blec_der :: LMA_C.LevMarBLecDer cr -> LevMarBLecDer cr -mk_levmar_blec_der lma lb ub a b k wghts j f p x m n - = lma f j p x m n lb ub a b k wghts - - --------------------------------------------------------------------------------- --- Curry friendly variants of the Levenberg-Marquardt algorithms in 'Bindings.Levmar'. --------------------------------------------------------------------------------- - -slevmar_dif :: LevMarDif CFloat -slevmar_dif = LMA_C.slevmar_dif - -dlevmar_dif :: LevMarDif CDouble -dlevmar_dif = LMA_C.dlevmar_dif - -slevmar_der :: LevMarDer CFloat -slevmar_der = mk_levmar_der LMA_C.slevmar_der - -dlevmar_der :: LevMarDer CDouble -dlevmar_der = mk_levmar_der LMA_C.dlevmar_der - -slevmar_bc_dif :: LevMarBCDif CFloat -slevmar_bc_dif = mk_levmar_bc_dif LMA_C.slevmar_bc_dif - -dlevmar_bc_dif :: LevMarBCDif CDouble -dlevmar_bc_dif = mk_levmar_bc_dif LMA_C.dlevmar_bc_dif - -slevmar_bc_der :: LevMarBCDer CFloat -slevmar_bc_der = mk_levmar_bc_der LMA_C.slevmar_bc_der - -dlevmar_bc_der :: LevMarBCDer CDouble -dlevmar_bc_der = mk_levmar_bc_der LMA_C.dlevmar_bc_der - -slevmar_lec_dif :: LevMarLecDif CFloat -slevmar_lec_dif = mk_levmar_lec_dif LMA_C.slevmar_lec_dif - -dlevmar_lec_dif :: LevMarLecDif CDouble -dlevmar_lec_dif = mk_levmar_lec_dif LMA_C.dlevmar_lec_dif - -slevmar_lec_der :: LevMarLecDer CFloat -slevmar_lec_der = mk_levmar_lec_der LMA_C.slevmar_lec_der - -dlevmar_lec_der :: LevMarLecDer CDouble -dlevmar_lec_der = mk_levmar_lec_der LMA_C.dlevmar_lec_der - -slevmar_blec_dif :: LevMarBLecDif CFloat -slevmar_blec_dif = mk_levmar_blec_dif LMA_C.slevmar_blec_dif - -dlevmar_blec_dif :: LevMarBLecDif CDouble -dlevmar_blec_dif = mk_levmar_blec_dif LMA_C.dlevmar_blec_dif - -slevmar_blec_der :: LevMarBLecDer CFloat -slevmar_blec_der = mk_levmar_blec_der LMA_C.slevmar_blec_der - -dlevmar_blec_der :: LevMarBLecDer CDouble -dlevmar_blec_der = mk_levmar_blec_der LMA_C.dlevmar_blec_der - - --- The End --------------------------------------------------------------------- diff --git a/bindings-levmar.cabal b/bindings-levmar.cabal --- a/bindings-levmar.cabal +++ b/bindings-levmar.cabal @@ -1,16 +1,15 @@ name: bindings-levmar -version: 0.1.1.1 +version: 0.2.0.1 cabal-version: >= 1.6 build-type: Simple stability: experimental -tested-with: GHC ==6.10.4 author: Roel van Dijk & Bas van Dijk maintainer: vandijk.roel@gmail.com, v.dijk.bas@gmail.com copyright: (c) 2009 Roel van Dijk & Bas van Dijk license: OtherLicense license-file: LICENSE -category: numerical, FFI -synopsis: A binding to the C levmar (Levenberg-Marquardt) library +category: Numerical, FFI +synopsis: Low level bindings to the C levmar (Levenberg-Marquardt) library description: The Levenberg-Marquardt algorithm is an iterative technique that finds a local minimum of a function that is expressed as the sum of squares of nonlinear @@ -32,7 +31,7 @@ . Note that the included C library is lightly patched to make it pure. This way the functions can be used inside - unsafePerformIO. + @unsafePerformIO@. . A note regarding the license: . @@ -72,10 +71,10 @@ location: http://code.haskell.org/bindings-levmar library - build-depends: base >= 3 && < 4.2 + build-depends: base >= 3 && < 4.4 + , bindings-DSL >= 1.0.2 && < 1.1 exposed-modules: Bindings.LevMar - , Bindings.LevMar.CurryFriendly - ghc-options: -Wall -O2 + ghc-options: -Wall cc-options: -D_OPENMP include-dirs: levmar-2.4 c-sources: