Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Initial patch

Ignore-this: 52283584bd78000ca728618c21b2d74f

darcs-hash:20090827081836-b004c-0e0957fa60e20c63b051966eeaa84ebaa908380d.gz
  • Loading branch information...
commit a81f995f119d13599af688017b0d15a4bf523360 0 parents
@roelvandijk roelvandijk authored
244 Bindings/LevMar.hsc
@@ -0,0 +1,244 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Bindings.LevMar
+ ( _LM_OPTS_SZ
+ , _LM_INFO_SZ
+
+ , _LM_ERROR
+
+ , _LM_INIT_MU
+ , _LM_STOP_THRESH
+ , _LM_DIFF_DELTA
+
+ , _LM_VERSION
+
+ , Model
+ , Jacobian
+
+ , withModel
+ , withJacobian
+
+ , LevMarDer
+ , LevMarDif
+ , LevMarBCDer
+ , LevMarBCDif
+ , LevMarLecDer
+ , LevMarLecDif
+ , LevMarBLecDer
+ , LevMarBLecDif
+
+ , 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
+ ) where
+
+import Foreign.C.Types (CInt, CFloat, CDouble)
+import Foreign.Ptr (Ptr, FunPtr, freeHaskellFunPtr)
+import Control.Exception (bracket)
+
+#include <lm.h>
+
+-- |The maximum size of the options array.
+_LM_OPTS_SZ :: Int
+_LM_OPTS_SZ = #const LM_OPTS_SZ
+
+-- |The size of the info array.
+_LM_INFO_SZ :: Int
+_LM_INFO_SZ = #const LM_INFO_SZ
+
+-- |Integer value which represents an error when returned by the C library routines.
+_LM_ERROR :: CInt
+_LM_ERROR = #const LM_ERROR
+
+#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
+
+-- |The version of the C levmar library.
+_LM_VERSION :: String
+_LM_VERSION = #const_str LM_VERSION
+
+-- |Functional relation describing measurements.
+type Model r = Ptr r -- p
+ -> Ptr r -- hx
+ -> CInt -- m
+ -> CInt -- n
+ -> Ptr () -- adata
+ -> IO ()
+
+type Jacobian a = Model a
+
+foreign import ccall "wrapper" mkModel :: Model a -> IO (FunPtr (Model a))
+
+mkJacobian :: Jacobian a -> IO (FunPtr (Jacobian a))
+mkJacobian = mkModel
+
+withModel :: Model a -> (FunPtr (Model a) -> IO b) -> IO b
+withModel m = bracket (mkModel m) freeHaskellFunPtr
+
+withJacobian :: Jacobian a -> (FunPtr (Jacobian a) -> IO b) -> IO b
+withJacobian j = bracket (mkJacobian j) freeHaskellFunPtr
+
+type LevMarDer cr = FunPtr (Model cr) -- func
+ -> FunPtr (Jacobian cr) -- jacf
+ -> Ptr cr -- p
+ -> Ptr cr -- x
+ -> CInt -- m
+ -> CInt -- n
+ -> CInt -- itmax
+ -> Ptr cr -- opts
+ -> Ptr cr -- info
+ -> Ptr cr -- work
+ -> Ptr cr -- covar
+ -> Ptr () -- adata
+ -> IO CInt
+
+type LevMarDif cr = FunPtr (Model cr) -- func
+ -> Ptr cr -- p
+ -> Ptr cr -- x
+ -> CInt -- m
+ -> CInt -- n
+ -> CInt -- itmax
+ -> Ptr cr -- opts
+ -> Ptr cr -- info
+ -> Ptr cr -- work
+ -> Ptr cr -- covar
+ -> Ptr () -- adata
+ -> IO CInt
+
+type LevMarBCDer cr = FunPtr (Model cr) -- func
+ -> FunPtr (Jacobian cr) -- jacf
+ -> Ptr cr -- p
+ -> Ptr cr -- x
+ -> CInt -- m
+ -> CInt -- n
+ -> Ptr cr -- lb
+ -> Ptr cr -- ub
+ -> CInt -- itmax
+ -> Ptr cr -- opts
+ -> Ptr cr -- info
+ -> Ptr cr -- work
+ -> Ptr cr -- covar
+ -> Ptr () -- adata
+ -> IO CInt
+
+type LevMarBCDif cr = FunPtr (Model cr) -- func
+ -> Ptr cr -- p
+ -> Ptr cr -- x
+ -> CInt -- m
+ -> CInt -- n
+ -> Ptr cr -- lb
+ -> Ptr cr -- ub
+ -> CInt -- itmax
+ -> Ptr cr -- opts
+ -> Ptr cr -- info
+ -> Ptr cr -- work
+ -> Ptr cr -- covar
+ -> Ptr () -- adata
+ -> IO CInt
+
+type LevMarLecDer cr = FunPtr (Model cr) -- func
+ -> FunPtr (Jacobian cr) -- jacf
+ -> Ptr cr -- p
+ -> Ptr cr -- x
+ -> CInt -- m
+ -> CInt -- n
+ -> Ptr cr -- A
+ -> Ptr cr -- B
+ -> CInt -- k
+ -> CInt -- itmax
+ -> Ptr cr -- opts
+ -> Ptr cr -- info
+ -> Ptr cr -- work
+ -> Ptr cr -- covar
+ -> Ptr () -- adata
+ -> IO CInt
+
+type LevMarLecDif cr = FunPtr (Model cr) -- func
+ -> Ptr cr -- p
+ -> Ptr cr -- x
+ -> CInt -- m
+ -> CInt -- n
+ -> Ptr cr -- A
+ -> Ptr cr -- B
+ -> CInt -- k
+ -> CInt -- itmax
+ -> Ptr cr -- opts
+ -> Ptr cr -- info
+ -> Ptr cr -- work
+ -> Ptr cr -- covar
+ -> Ptr () -- adata
+ -> IO CInt
+
+type LevMarBLecDer cr = FunPtr (Model cr) -- func
+ -> FunPtr (Jacobian cr) -- jacf
+ -> Ptr cr -- p
+ -> Ptr cr -- x
+ -> CInt -- m
+ -> CInt -- n
+ -> Ptr cr -- lb
+ -> Ptr cr -- ub
+ -> Ptr cr -- A
+ -> Ptr cr -- B
+ -> CInt -- k
+ -> Ptr cr -- wghts
+ -> CInt -- itmax
+ -> Ptr cr -- opts
+ -> Ptr cr -- info
+ -> Ptr cr -- work
+ -> Ptr cr -- covar
+ -> Ptr () -- adata
+ -> IO CInt
+
+type LevMarBLecDif cr = FunPtr (Model cr) -- func
+ -> Ptr cr -- p
+ -> Ptr cr -- x
+ -> CInt -- m
+ -> CInt -- n
+ -> Ptr cr -- lb
+ -> Ptr cr -- ub
+ -> Ptr cr -- A
+ -> Ptr cr -- B
+ -> CInt -- k
+ -> Ptr cr -- wghts
+ -> CInt -- itmax
+ -> Ptr cr -- opts
+ -> Ptr cr -- info
+ -> Ptr cr -- work
+ -> Ptr cr -- covar
+ -> Ptr () -- adata
+ -> IO CInt
+
+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
+
139 Bindings/LevMar/CurryFriendly.hs
@@ -0,0 +1,139 @@
+module Bindings.LevMar.CurryFriendly
+ ( LMA_C._LM_OPTS_SZ
+ , LMA_C._LM_INFO_SZ
+
+ , LMA_C._LM_ERROR
+
+ , LMA_C._LM_INIT_MU
+ , LMA_C._LM_STOP_THRESH
+ , LMA_C._LM_DIFF_DELTA
+
+ , LMA_C._LM_VERSION
+
+ , LMA_C.Model
+ , LMA_C.Jacobian
+
+ , LMA_C.withModel
+ , LMA_C.withJacobian
+
+ , LevMarDer
+ , LevMarDif
+ , LevMarBCDer
+ , LevMarBCDif
+ , LevMarLecDer
+ , LevMarLecDif
+ , LevMarBLecDer
+ , LevMarBLecDif
+
+ , 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
+ ) where
+
+import Foreign.C.Types (CInt, CFloat, CDouble)
+import Foreign.Ptr (Ptr, FunPtr)
+
+import qualified Bindings.LevMar as LMA_C
+
+type BoxConstraints cr a = Ptr cr -> Ptr cr -> a
+type LinearConstraints cr a = Ptr cr -> Ptr cr -> CInt -> a
+
+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 (Ptr cr -> LevMarDif cr))
+type LevMarBLecDer cr = BoxConstraints cr (LinearConstraints cr (Ptr cr -> LevMarDer cr))
+
+
+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
+
+
+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
32 LICENSE
@@ -0,0 +1,32 @@
+Copyright (c) 2009 Roel van Dijk, Bas van Dijk
+
+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.
+
+ * The name of Roel van Dijk and Bas van Dijk and the names of
+ contributors may NOT 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.
3  Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
57 bindings-levmar.cabal
@@ -0,0 +1,57 @@
+name: bindings-levmar
+version: 0.1
+cabal-version: >= 1.6
+build-type: Simple
+stability: experimental
+author: Roel van Dijk & Bas van Dijk
+maintainer: Roel van Dijk & Bas van Dijk
+copyright: (c) 2009 Roel van Dijk & Bas van Dijk
+license: BSD3
+license-file: LICENSE
+category: numerical
+synopsis: A binding to the 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 functions. It has become a standard
+ technique for nonlinear least-squares problems and can be thought
+ of as a combination of steepest descent and the Gauss-Newton
+ method. When the current solution is far from the correct one,
+ the algorithm behaves like a steepest descent method: slow, but
+ guaranteed to converge. When the current solution is close to the
+ correct solution, it becomes a Gauss-Newton method.
+ .
+ Both unconstrained and constrained (under linear equations and
+ box constraints) Levenberg-Marquardt variants are included.
+ All functions have Double and Float variants.
+ .
+ See: <http://www.ics.forth.gr/~lourakis/levmar/>
+
+extra-source-files: levmar-2.4/LICENSE
+ , levmar-2.4/*.h
+ , levmar-2.4/*.c
+ , levmar-2.4/*.txt
+ , levmar-2.4/Makefile
+ , levmar-2.4/Makefile.icc
+ , levmar-2.4/Makefile.vc
+ , levmar-2.4/levmar.vcproj
+ , levmar-2.4/matlab/*.m
+ , levmar-2.4/matlab/*.c
+ , levmar-2.4/matlab/*.txt
+ , levmar-2.4/matlab/Makefile
+ , levmar-2.4/matlab/Makefile.w32
+
+library
+ build-depends: base >= 3 && < 4.2
+ exposed-modules: Bindings.LevMar
+ , Bindings.LevMar.CurryFriendly
+ ghc-options: -Wall -O2
+ cc-options: -D_OPENMP
+ include-dirs: levmar-2.4
+ c-sources:
+ levmar-2.4/Axb.c
+ levmar-2.4/lm.c
+ levmar-2.4/lmbc.c
+ levmar-2.4/lmblec.c
+ levmar-2.4/lmlec.c
+ levmar-2.4/misc.c
+ pkgconfig-depends: lapack
Please sign in to comment.
Something went wrong with that request. Please try again.