packages feed

hmatrix-quadprogpp (empty) → 0.1.0.0

raw patch · 5 files changed

+193/−0 lines, 5 filesdep +basedep +hmatrixdep +vectorsetup-changed

Dependencies added: base, hmatrix, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Alex Lang, Takano Akio++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 Alex Lang, Takano Akio 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.
+ Numeric/Minimization/QuadProgPP.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ForeignFunctionInterface #-}+module Numeric.Minimization.QuadProgPP (solveQuadProg) where++import Control.Applicative+import Control.Monad+import Data.Maybe+import Data.Packed+import Data.Packed.Development+import qualified Data.Vector.Storable as VS+import Foreign.C.String+import Foreign.C.Types (CInt(..))+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable+import System.IO.Unsafe (unsafePerformIO)++-- | Solve a strictly convex quadratic program with optional linear+-- constraints. It returns a pair of the optimal solution and the+-- value of the objective function at that point. On error it returns+-- Left.+solveQuadProg+    :: (Matrix Double, Vector Double)+        -- ^ The function to minimize. It should be of the form+        -- @(A, B)@, which represents a quadratic function+        -- @x -> (1/2)x'Ax + x'B@ where t' denotes the transpose+        -- of t. @A@ must be positive definite.+    -> Maybe (Matrix Double, Vector Double)+        -- ^ Optional equality constraints. When given, this+        -- argument should be of the form @Just (C, D)@, which+        -- represents a linear equality @x -> x'C + D = 0@.+    -> Maybe (Matrix Double, Vector Double)+        -- ^ Optional inequality constraints. When given, this+        -- argument should be of the form @Just (E, F)@, which+        -- represents linear inequalities @x -> x'E + F >= 0@.+    -> Either String (Vector Double, Double)+solveQuadProg (g, g0) (split -> (ce, ce0)) (split -> (ci, ci0))+        = unsafePerformIO $+    mat' (Just g) $ \gRow gCol gPtr ->+    vec' (Just g0) $ \g0Size g0Ptr ->+    mat' (trans <$> ce) $ \ceRow ceCol cePtr ->+    vec' ce0 $ \ce0Size ce0Ptr ->+    mat' (trans <$> ci) $ \ciRow ciCol ciPtr ->+    vec' ci0 $ \ci0Size ci0Ptr ->+    fromMaybe (return $ Left sizeMismatchError) $ do+        let !nVar = gRow+        guard $ gCol == nVar+        guard $ g0Size == nVar+        guard $ ceRow == nVar || ceRow == 0+        let !nCE = ceCol+        guard $ ce0Size == nCE+        guard $ ciRow == nVar || ciRow == 0+        let !nCI = ciCol+        guard $ ci0Size == nCI+        return $ alloca $ \ptrErrorStr -> do+            fpSolution <- mallocForeignPtrArray (fromIntegral nVar)+            best <- withForeignPtr fpSolution $ \ptrSolution ->+                c_hs_solve_quadprog nVar nCE nCI+                    gPtr g0Ptr+                    cePtr ce0Ptr+                    ciPtr ci0Ptr+                    ptrSolution+                    ptrErrorStr+            errorCStr <- peek ptrErrorStr+            if errorCStr == nullPtr -- success+                then let+                    !solutionVec = VS.unsafeFromForeignPtr0 fpSolution+                        (fromIntegral nVar)+                    in return $ Right (solutionVec, best)+                else do+                    errorStr <- peekCAString errorCStr+                    free errorCStr+                    return $ Left errorStr+    where+        mat' (Just m) f = mat (cmat m) $ \church -> church $ \nrow ncol ptr -> f nrow ncol ptr+        mat' Nothing f = f 0 0 nullPtr+        vec' (Just v) f = vec v $ \church -> church $ \size ptr -> f size ptr+        vec' Nothing f = f 0 nullPtr+        sizeMismatchError =+            "Numeric.Minimization.QuadProgPP.solveQuadProg: size mismatch"++split :: Maybe (a, b) -> (Maybe a, Maybe b)+split x = (fst <$> x, snd <$> x)++foreign import ccall "hs_solve_quadprog"+    c_hs_solve_quadprog+        :: CInt -> CInt -> CInt+        -> Ptr Double+        -> Ptr Double+        -> Ptr Double+        -> Ptr Double+        -> Ptr Double+        -> Ptr Double+        -> Ptr Double+        -> Ptr CString+        -> IO Double
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ c++/binding.cxx view
@@ -0,0 +1,35 @@+# include <QuadProg++.hh>+# include <exception>+# include <string.h>++extern "C" double hs_solve_quadprog(+  int n_vars, int n_ce, int n_ci,+  const double *G_,+  const double *g0_,+  const double *CE_,+  const double *ce0_,+  const double *CI_,+  const double *ci0_,+  double *x_,+  const char **p_errorstr) try+{+  using namespace QuadProgPP;+  Matrix<double> G(G_, n_vars, n_vars);+  Vector<double> g0(g0_, n_vars);+  Matrix<double> CE(CE_, n_vars, n_ce);+  Vector<double> ce0(ce0_, n_ce);+  Matrix<double> CI(CI_, n_vars, n_ci);+  Vector<double> ci0(ci0_, n_ci);+  Vector<double> x;+  double r = solve_quadprog(G, g0, CE, ce0, CI, ci0, x);+  for(int i = 0; i < n_vars; i++)+    x_[i] = x[i];+  *p_errorstr = 0;+  return r;+} catch(const std::exception &e) {+  *p_errorstr = strdup(e.what());+  return 0;+} catch(...) {+  *p_errorstr = strdup("unknown C++ error");+  return 0;+}
+ hmatrix-quadprogpp.cabal view
@@ -0,0 +1,28 @@+-- Initial hmatrix-quadprogpp.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                hmatrix-quadprogpp+version:             0.1.0.0+synopsis:            Bindings to QuadProg+++description:+  Bindings to QuadProg++, a C++ library for quadratic programming.+  <http://sourceforge.net/projects/quadprog/>+license:             BSD3+license-file:        LICENSE+author:              Alex Lang, Takano Akio+maintainer:          Alex Lang <me@alang.ca>+-- copyright:           +category:            Math+build-type:          Simple+cabal-version:       >=1.8++source-repository head+  type:     git+  location: https://github.com/alang9/hmatrix-quadprogpp.git++library+  c-sources: c++/binding.cxx+  exposed-modules:     Numeric.Minimization.QuadProgPP+  -- other-modules:       +  build-depends:       base ==4.5.*, vector >= 0.9, hmatrix >= 0.14+  extra-libraries:  QuadProgpp, stdc++