packages feed

casadi-bindings 3.1.0.3 → 3.4.5.0

raw patch · 15 files changed

+630/−362 lines, 15 filesdep ~casadi-bindings-coredep ~casadi-bindings-internal

Dependency ranges changed: casadi-bindings-core, casadi-bindings-internal

Files

casadi-bindings.cabal view
@@ -1,5 +1,5 @@ name:                casadi-bindings-version:             3.1.0.3+version:             3.4.5.0 synopsis:            mid-level bindings to CasADi category:            Numerical, Math description:@@ -33,7 +33,7 @@ license-file:        LICENSE author:              Greg Horn maintainer:          gregmainland@gmail.com-copyright:           (c) Greg Horn 2013-2016+copyright:           (c) Greg Horn 2013-2018 build-type:          Simple cabal-version:       >=1.10 @@ -41,12 +41,12 @@  library   hs-source-dirs:      src-  exposed-modules:     Casadi.CMatrix-                       Casadi.Callback+  exposed-modules:     Casadi.Callback                        Casadi.DM                        Casadi.Function                        Casadi.GenericType                        Casadi.Interpolant+                       Casadi.Matrix                        Casadi.MX                        Casadi.Overloading                        Casadi.Slice@@ -62,15 +62,15 @@                        cereal,                        binary,                        vector-binary-instances,-                       casadi-bindings-internal == 0.1.5.0,-                       casadi-bindings-core     == 3.1.0.0+                       casadi-bindings-internal == 0.1.6.1,+                       casadi-bindings-core     == 3.4.5.0   default-language:    Haskell2010    C-sources:           cbits/casadi_bindings.cpp   extra-libraries:     stdc++ casadi-  cc-options:          -Wall -Wno-sign-compare -std=c++11+  cc-options:          -Wall -Wextra -Werror -std=c++11   ghc-prof-options:    -O2-  ghc-options:         -O2+  ghc-options:         -O2 -Wall  source-repository head   type: git
cbits/casadi_bindings.cpp view
@@ -1,7 +1,7 @@ #include "math.h" #include <iostream> #include "casadi/core/core.hpp"-#include "casadi/core/function/callback.hpp"+#include "casadi/core/callback.hpp"  #include "HsFFI.h" @@ -20,44 +20,42 @@  class HaskellCallback : public casadi::Callback { public:-  HaskellCallback(HsFunPtr hsfp,+  HaskellCallback(const std::string &name,+                  HsFunPtr hsfp,                   std::vector<casadi::Sparsity> &sp_in_,-                  std::vector<casadi::Sparsity> &sp_out_) : sp_in(sp_in_), sp_out(sp_out_) {-    debug("HaskellCallback constructor called...");+                  std::vector<casadi::Sparsity> &sp_out_) : cb_name(name), sp_in(sp_in_), sp_out(sp_out_) {+    debug(cb_name << ": HaskellCallback constructor called...");+    construct(name);     hs_fun_ptr = hsfp;   } -  // Creator function, creates an owning reference-  static casadi::Function create(const std::string& name,-                                 HsFunPtr hsfp,-                                 std::vector<casadi::Sparsity> &sp_in_,-                                 std::vector<casadi::Sparsity> &sp_out_,-                                 const casadi::Dict& opts=casadi::Dict()) {-    debug("HaskellCallback create called...");-    return casadi::Callback::create(name, new HaskellCallback(hsfp, sp_in_, sp_out_), opts);+  // Initialize the object+  void init() override {+    debug(cb_name << ": HaskellCallback::init() called...");   }    // Number of inputs and outputs-  virtual int get_n_in() { return sp_in.size(); }-  virtual int get_n_out() { return sp_out.size(); }-  virtual casadi::Sparsity get_sparsity_in(int i) {-    debug("HaskellCallback::get_sparsity_in called");+  long long get_n_in() override { return sp_in.size(); }+  long long get_n_out() override { return sp_out.size(); }++  casadi::Sparsity get_sparsity_in(long long i) override {+    debug(cb_name << ": HaskellCallback::get_sparsity_in called");     return sp_in[i];   }-  virtual casadi::Sparsity get_sparsity_out(int i) {-    debug("HaskellCallback::get_sparsity_out called");+  casadi::Sparsity get_sparsity_out(long long i) override {+    debug(cb_name << ": HaskellCallback::get_sparsity_out called");     return sp_out[i];   }-  -  virtual std::vector<casadi::DM> eval(const std::vector<casadi::DM>& args) {-    debug("HaskellCallback::eval() called. Converting inputs to haskell-friendly...");++  std::vector<casadi::DM> eval(const std::vector<casadi::DM>& args) const override {+    debug(cb_name << ": HaskellCallback::eval() called. Converting inputs to haskell-friendly...");     std::vector<casadi::DM*> *hsArgs = new std::vector<casadi::DM*>();-    for (int k = 0; k < args.size(); k++) {+    for (size_t k = 0; k < args.size(); k++) {       hsArgs->push_back(new casadi::DM(args[k]));     }-    +     std::map<std::string, casadi::GenericType> latestStats = stats();-    debug("HaskellCallback::eval() called. Converting stats to haskell-friendly...");+    debug(cb_name << ": HaskellCallback::eval() called. Converting stats to haskell-friendly...");     std::map<std::string, casadi::GenericType*> *hsStats =       new std::map<std::string, casadi::GenericType*>();     std::map<std::string, casadi::GenericType>::iterator it;@@ -67,33 +65,29 @@       std::pair<std::string, casadi::GenericType*> keyVal(key, val);       hsStats->insert(keyVal);     }-    -    debug("HaskellCallback::eval() calling back to the haskell function...");++    debug(cb_name << ": HaskellCallback::eval() calling back to the haskell function...");     std::vector<casadi::DM>* hsRet = ((hs_callback_thing)hs_fun_ptr)(hsArgs, hsStats); -    debug("HaskellCallback::call() converting haskell outputs to casadi-friendly...");+    debug(cb_name << ": HaskellCallback::call() converting haskell outputs to casadi-friendly...");     std::vector<casadi::DM> ret;-    for (int k = 0; k < hsRet->size(); k++) {+    for (size_t k = 0; k < hsRet->size(); k++) {       ret.push_back((*hsRet)[k]);     }     delete hsRet; -    debug("HaskellCallback::call() return size: " << ret.size());-    debug("HaskellCallback::call() returning casadi outputs to casadi...");+    debug(cb_name << ": HaskellCallback::call() return size: " << ret.size());+    debug(cb_name << ": HaskellCallback::call() returning casadi outputs to casadi...");     return ret;   }-  -  // Initialize the object-  virtual void init() {-    debug("HaskellCallback::init() called...");-  }    ~HaskellCallback() {     // free the haskell FunPtr-    debug("HaskellCallback destructor started\n");+    debug(cb_name << ": HaskellCallback destructor started");     hs_free_fun_ptr(hs_fun_ptr);-    debug("HaskellCallback destructor finished\n");+    debug(cb_name << ": HaskellCallback destructor finished");   }+  std::string cb_name; private:   HsFunPtr hs_fun_ptr;   std::vector<casadi::Sparsity> sp_in;@@ -103,33 +97,41 @@   extern "C"-casadi::Function * new_callback_haskell(HsFunPtr hsfp,+void delete_haskell_callback(casadi::Function *haskell_callback0);+void delete_haskell_callback(casadi::Function *haskell_callback0) {+  HaskellCallback *haskell_callback = static_cast<HaskellCallback*>(haskell_callback0);+  const std::string name = haskell_callback->cb_name; // copy so we don't use after delete+  debug(name << ": deleting haskell callback...");+  delete haskell_callback;+  debug(name << ": haskell callback deleted");+}++extern "C"+casadi::Function * new_haskell_callback(const std::string *cb_name,+                                        HsFunPtr hsfp,                                         std::vector<casadi::Sparsity*> *sp_in,                                         std::vector<casadi::Sparsity*> *sp_out);-casadi::Function * new_callback_haskell(HsFunPtr hsfp,+casadi::Function * new_haskell_callback(const std::string *cb_name,+                                        HsFunPtr hsfp,                                         std::vector<casadi::Sparsity*> *sp_in_p,                                         std::vector<casadi::Sparsity*> *sp_out_p) {-  casadi::Dict options = casadi::Dict();-  debug("new_callback_haskell called. Unpacking sparsity_in/sparsity_out");+  debug(*cb_name << ": new_callback_haskell called. Unpacking sparsity_in/sparsity_out");   std::vector<casadi::Sparsity> sp_in;-  for (int k=0; k<sp_in_p->size(); k++) {+  for (size_t k=0; k<sp_in_p->size(); k++) {     sp_in.push_back(*((*sp_in_p)[k]));   }   std::vector<casadi::Sparsity> sp_out;-  for (int k=0; k<sp_out_p->size(); k++) {+  for (size_t k=0; k<sp_out_p->size(); k++) {     sp_out.push_back(*((*sp_out_p)[k]));   }-  return new casadi::Function(HaskellCallback::create("haskell_callback",-                                                      hsfp,-                                                      sp_in, sp_out,-                                                      options));+  return static_cast<casadi::Function*>(new HaskellCallback(*cb_name, hsfp, sp_in, sp_out)); }  extern "C" std::vector<casadi::DM>* to_dm_vec(std::vector<casadi::DM*> *x); std::vector<casadi::DM>* to_dm_vec(std::vector<casadi::DM*> *x) {   std::vector<casadi::DM> *ret = new std::vector<casadi::DM>();-  for (int k=0; k<x->size(); k++) {+  for (size_t k=0; k<x->size(); k++) {     ret->push_back(*((*x)[k]));   }   return ret;@@ -143,4 +145,30 @@ extern "C" float c_fmodf(float x, float y); float c_fmodf(float x, float y) {   return fmodf(x, y);+}++extern "C"+void hs_call_casadi_function_with_pointers(+  std::string ** err_msg,+  casadi::Function &f,+  double ** arg, int narg,+  double ** res, int nres) {+  try {+    // setup inputs+    std::vector<const double*> argv(narg);+    for (int k = 0; k < narg; k++) {+      argv[k] = arg[k];+    }++    // setup outputs+    std::vector<double*> resv(nres);+    for (int k = 0; k < nres; k++) {+      resv[k] = res[k];+    }++    // call the function+    f(argv, resv);+  } catch (std::exception& ex) {+    *err_msg = new std::string(ex.what());+  } }
− src/Casadi/CMatrix.hs 
@@ -1,92 +0,0 @@-{-# OPTIONS_GHC -Wall #-}--module Casadi.CMatrix-       ( CMatrix(..)-       , vertslice, horzslice-       ) where--import qualified Data.Vector as V-import Data.Map ( Map )--import Casadi.Core.Classes.DM ( DM )-import Casadi.Core.Classes.GenericType ( GenericType )--import Casadi.Overloading ( Fmod, ArcTan2, SymOrd, Erf )-import Casadi.Sparsity ( Sparsity )-import Casadi.Slice ( Slice, slice )-import Casadi.Viewable ( Viewable )---- TODO(greg): alphabetize this, it's getting too big to manage-class (Eq a, Show a, Floating a, Fmod a, ArcTan2 a, SymOrd a, Erf a, Viewable a)-      => CMatrix a where-  blocksplit :: a -> V.Vector Int -> V.Vector Int -> V.Vector (V.Vector a)-  blockcat :: V.Vector (V.Vector a) -> a-  vertsplit :: a -> V.Vector Int -> V.Vector a-  vertcat :: V.Vector a -> a-  horzsplit :: a -> V.Vector Int -> V.Vector a-  horzcat :: V.Vector a -> a-  veccat :: V.Vector a -> a-  size1 :: a -> Int-  size2 :: a -> Int-  numel :: a -> Int-  -- | matrix matrix product-  mm :: a -> a -> a-  -- | sumAll(x*y), x and y same dimension-  dot :: a -> a -> a-  sum1 :: a -> a-  sum2 :: a -> a-  -- | transpose-  trans :: a -> a-  diag :: a -> a-  eye :: Int -> a-  ones :: (Int,Int) -> a-  zeros :: (Int,Int) -> a-  zerosSp :: Sparsity -> a-  solve :: a -> a -> String -> Map String GenericType -> a-  solve' :: a -> a -> a-  indexed :: a -> Slice -> Slice -> a-  sparsity :: a -> Sparsity-  getNZ :: a -> Slice -> a-  setNZ :: a -> a -> Slice -> IO ()-  inv :: a -> a-  pinv :: a -> a-  pinv' :: a -> String -> Map String GenericType -> a-  triu :: a -> a-  tril :: a -> a-  triu2symm :: a -> a-  tril2symm :: a -> a-  copy :: a -> IO a-  densify :: a -> a-  fromDM :: DM -> a-  fromDVector :: V.Vector Double -> a-  fromDouble :: Double -> a-  reshape :: a -> (Int, Int) -> a-  conditional :: a -> V.Vector a -> a -> a-  conditional' :: a -> V.Vector a -> a -> Bool -> a-  cmin :: a -> a -> a-  cmax :: a -> a -> a-  cand :: a -> a -> a-  cor :: a -> a -> a-  -- TODO(greg): any and all-  repmat :: a -> (Int, Int) -> a-  printme :: a -> a -> a-{-# DEPRECATED solve' "use the new solve, this one is going away" #-}---vertslice :: CMatrix a => a -> V.Vector Int -> V.Vector a-vertslice x vs = V.fromList (f (V.toList vs))-  where-    cols = size2 x-    hslice = slice 0 cols 1--    f (v0:v1:others) = indexed x (slice v0 v1 1) hslice : f (v1:others)-    f _ = []--horzslice :: CMatrix a => a -> V.Vector Int -> V.Vector a-horzslice x vs = V.fromList (f (V.toList vs))-  where-    rows = size1 x-    vslice = slice 0 rows 1--    f (v0:v1:others) = indexed x vslice (slice v0 v1 1) : f (v1:others)-    f _ = []
src/Casadi/Callback.hs view
@@ -9,9 +9,10 @@ import Data.Map ( Map ) import qualified Data.Traversable as T import Data.Vector ( Vector )+import Foreign.ForeignPtr ( newForeignPtr ) import Foreign.Ptr ( Ptr, FunPtr ) -import Casadi.Core.Data ( DM, DM', Function, Function'+import Casadi.Core.Data ( DM, DM', Function(..), Function'                         , GenericType, GenericType', Sparsity, Sparsity' ) import Casadi.Internal.Marshal ( withMarshal ) import Casadi.Internal.MarshalTypes@@ -19,27 +20,31 @@  import Casadi.GenericType ( GType, toGType ) -type HaskellCallback =+type HaskellCallbackFun =   Ptr (StdVec (Ptr DM')) -> Ptr (StdMap StdString (Ptr GenericType')) -> IO (Ptr (StdVec DM))  foreign import ccall "wrapper" mkCallback-  :: HaskellCallback -> IO (FunPtr HaskellCallback)+  :: HaskellCallbackFun -> IO (FunPtr HaskellCallbackFun) -foreign import ccall safe "new_callback_haskell" c_newCallbackHaskell-  :: FunPtr HaskellCallback-     -> Ptr (StdVec (Ptr Sparsity')) -> Ptr (StdVec (Ptr Sparsity'))-     -> IO (Ptr Function')+foreign import ccall safe "new_haskell_callback" c_newHaskellCallback+  :: Ptr StdString+  -> FunPtr HaskellCallbackFun+  -> Ptr (StdVec (Ptr Sparsity'))+  -> Ptr (StdVec (Ptr Sparsity'))+  -> IO (Ptr Function') +foreign import ccall safe "&delete_haskell_callback" c_deleteHaskellCallback+  :: FunPtr (Ptr Function' -> IO ())+ foreign import ccall safe "to_dm_vec" c_toDmVec   :: Ptr (StdVec (Ptr DM')) -> IO (Ptr (StdVec DM)) - -- | add a callback to an NLPSolver-makeCallback :: Vector Sparsity -> Vector Sparsity+makeCallback :: String -> Vector Sparsity -> Vector Sparsity              -> (Vector DM -> Map String GType -> IO (Vector DM)) -> IO Function-makeCallback sp_in sp_out userCallback = do+makeCallback name sp_in sp_out userCallback = do   -- safely wrap the callback into the C-friendly version-  let lowlevelCallback :: HaskellCallback+  let lowlevelCallback :: HaskellCallbackFun       lowlevelCallback dmInPtrs statsInPtrs = do         dmIns <- wrapReturn dmInPtrs :: IO (Vector DM)         stats0 <- wrapReturn statsInPtrs :: IO (Map String GenericType)@@ -48,9 +53,11 @@         withMarshal dmOuts c_toDmVec    -- turn the callback into a FunPtr-  callbackFunPtr <- mkCallback lowlevelCallback :: IO (FunPtr HaskellCallback)+  callbackFunPtr <- mkCallback lowlevelCallback :: IO (FunPtr HaskellCallbackFun)    -- create the callback object-  withMarshal sp_in $ \sp_in' ->-    withMarshal sp_out $ \sp_out' ->-    c_newCallbackHaskell callbackFunPtr sp_in' sp_out' >>= wrapReturn+  withMarshal name $ \name' ->+    withMarshal sp_in $ \sp_in' ->+    withMarshal sp_out $ \sp_out' -> do+    cbFun <- c_newHaskellCallback name' callbackFunPtr sp_in' sp_out' :: IO (Ptr Function')+    Function <$> newForeignPtr c_deleteHaskellCallback cbFun
src/Casadi/DM.hs view
@@ -17,8 +17,9 @@ import Casadi.Core.Classes.Sparsity ( Sparsity ) import qualified Casadi.Core.Tools as C +import Casadi.Matrix ( CMatrix(..) )+import Casadi.GenericType ( fromGType ) import Casadi.Overloading ( Fmod(..), ArcTan2(..), SymOrd(..), Erf(..) )-import Casadi.CMatrix ( CMatrix(..) ) import Casadi.Viewable ( Viewable(..) )  getWith :: Monad m => m Sparsity -> m (V.Vector Double) -> m DM@@ -62,7 +63,7 @@ {-# NOINLINE dnonzeros #-}  instance Show DM where-  show x = unsafePerformIO (dm_getDescription x)+  show x = unsafePerformIO (dm_get_str__0 x)   {-# NOINLINE show #-}  instance Eq DM where@@ -72,7 +73,7 @@ instance CMatrix DM where   blocksplit x ix iy = unsafePerformIO (C.casadi_blocksplit__7 x ix iy)   {-# NOINLINE blocksplit #-}-  blockcat x = unsafePerformIO (C.casadi_blockcat__3 x)+  blockcat x = unsafePerformIO (C.casadi_blockcat__1 x)   {-# NOINLINE blockcat #-}   veccat x = unsafePerformIO (C.casadi_veccat__1 x)   {-# NOINLINE veccat #-}@@ -90,10 +91,10 @@   {-# NOINLINE size1 #-}   size2 x = unsafePerformIO (dm_size2 x)   {-# NOINLINE size2 #-}-  numel x = unsafePerformIO (dm_numel__1 x)+  numel x = unsafePerformIO (dm_numel x)   {-# NOINLINE numel #-}-  mm x y = unsafePerformIO (C.casadi_mtimes__3 x y)-  {-# NOINLINE mm #-}+  mtimes x y = unsafePerformIO (C.casadi_mtimes__3 x y)+  {-# NOINLINE mtimes #-}   dot x y = unsafePerformIO (C.casadi_dot__1 x y)   {-# NOINLINE dot #-}   sum1 x = unsafePerformIO (C.casadi_sum1__1 x)@@ -112,7 +113,7 @@   {-# NOINLINE zeros #-}   zerosSp sp = unsafePerformIO (dm_zeros__1 sp)   {-# NOINLINE zerosSp #-}-  solve x y s m = unsafePerformIO (C.casadi_solve__4 x y s m)+  solve x y s m = unsafePerformIO (mapM fromGType m >>= C.casadi_solve__4 x y s)   {-# NOINLINE solve #-}   solve' x y = unsafePerformIO (C.casadi_solve__5 x y)   {-# NOINLINE solve' #-}@@ -145,15 +146,15 @@   {-# NOINLINE conditional #-}   conditional' x0 x1 x2 x3 = unsafePerformIO (C.casadi_conditional__3 x0 x1 x2 x3)   {-# NOINLINE conditional' #-}-  inv x = unsafePerformIO (C.casadi_inv__1 x)+  inv x = unsafePerformIO (C.casadi_inv__5 x)   {-# NOINLINE inv #-}   pinv x = unsafePerformIO (C.casadi_pinv__5 x)   {-# NOINLINE pinv #-}-  pinv' x n o = unsafePerformIO (C.casadi_pinv__4 x n o)+  pinv' x n o = unsafePerformIO (mapM fromGType o >>= C.casadi_pinv__4 x n)   {-# NOINLINE pinv' #-}-  cmax x y = unsafePerformIO (C.casadi_max__2 x y)+  cmax x y = unsafePerformIO (C.casadi_fmax__2 x y)   {-# NOINLINE cmax #-}-  cmin x y = unsafePerformIO (C.casadi_min__2 x y)+  cmin x y = unsafePerformIO (C.casadi_fmin__2 x y)   {-# NOINLINE cmin #-}   cand x y = unsafePerformIO (C.casadi_and__2 x y)   {-# NOINLINE cand #-}@@ -163,6 +164,36 @@   {-# NOINLINE repmat #-}   printme x y = unsafePerformIO (dm_printme x y)   {-# NOINLINE printme #-}++  sumSquare x = unsafePerformIO (C.casadi_sumsqr__1 x)+  {-# NOINLINE sumSquare #-}+  invSkew x = unsafePerformIO (C.casadi_inv_skew__1 x)+  {-# NOINLINE invSkew #-}+  cnot x = unsafePerformIO (C.casadi_not__2 x)+  {-# NOINLINE cnot #-}+  nullspace x = unsafePerformIO (C.casadi_nullspace__1 x)+  {-# NOINLINE nullspace #-}+  norm1 x = unsafePerformIO (C.casadi_norm_1__1 x)+  {-# NOINLINE norm1 #-}+  norm2 x = unsafePerformIO (C.casadi_norm_2__1 x)+  {-# NOINLINE norm2 #-}+  normFro x = unsafePerformIO (C.casadi_norm_fro__1 x)+  {-# NOINLINE normFro #-}+  normInf x = unsafePerformIO (C.casadi_norm_inf__1 x)+  {-# NOINLINE normInf #-}+  kron x y = unsafePerformIO (C.casadi_kron__1 x y)+  {-# NOINLINE kron #-}+  mldivide x y = unsafePerformIO (C.casadi_mldivide__1 x y)+  {-# NOINLINE mldivide #-}+  mrdivide x y = unsafePerformIO (C.casadi_mrdivide__1 x y)+  {-# NOINLINE mrdivide #-}+  mpower x y = unsafePerformIO (C.casadi_mpower__1 x y)+  {-# NOINLINE mpower #-}+  ceil' x = unsafePerformIO (C.casadi_ceil__2 x)+  {-# NOINLINE ceil' #-}+  floor' x = unsafePerformIO (C.casadi_floor__2 x)+  {-# NOINLINE floor' #-}+  instance Num DM where   (+) x y = unsafePerformIO (C.casadi_plus__2 x y)
src/Casadi/Function.hs view
@@ -1,121 +1,192 @@-{-# OPTIONS_GHC -Wall -fno-cse -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wall -fno-cse #-}  module Casadi.Function-       ( C.Function, AlwaysInline(..), NeverInline(..)-       , mxFunction, mxFunction', sxFunction, sxFunction'-       , callMX, callMX', callSX, callSX', callDM, callDM'-       , hessian, jacobian, gradient+       ( C.Function        , externalFunction, externalFunction'        , generateCode, generateCode'+       , callDM, callDM'+       , callV, callV'        ) where -import Data.Map ( Map )+import           Control.Monad ( when, zipWithM, zipWithM_ )+import           Data.Map ( Map )+import qualified Data.Map as M+import qualified Data.Set as S+import           Data.Vector ( Vector )+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as VM import qualified Data.Traversable as T-import Data.Vector ( Vector )-import System.IO.Unsafe ( unsafePerformIO )+import           Foreign.C.Types ( CDouble, CInt(..) )+import           Foreign.ForeignPtr ( withForeignPtr )+import           Foreign.Ptr ( Ptr, nullPtr )+import           Foreign.Marshal.Alloc ( free )+import           Foreign.Marshal.Array ( mallocArray )+import           Foreign.Marshal.Utils ( new )+import           Foreign.Storable ( peekElemOff, pokeElemOff, peek )  import qualified Casadi.Core.Classes.CodeGenerator as C+import           Casadi.Core.Classes.DM ( DM ) import qualified Casadi.Core.Classes.Function as C+import           Casadi.Core.Data ( Function(..), Function' ) import qualified Casadi.Core.Tools as C+import           Casadi.Internal.FormatException ( formatException )+import           Casadi.Internal.MarshalTypes ( StdString )+import           Casadi.Internal.WrapReturn ( wrapReturn ) -import Casadi.SX ( SX )-import Casadi.MX ( MX )-import Casadi.DM ( DM ) import Casadi.GenericType ( GenericType, GType, fromGType ) -newtype AlwaysInline = AlwaysInline Bool-newtype NeverInline = NeverInline Bool---- | call an MXFunction on symbolic inputs, getting symbolic outputs-callMX :: C.Function -> Vector MX -> AlwaysInline -> NeverInline -> Vector MX-callMX f ins (AlwaysInline alwaysInline) (NeverInline neverInline) =-  unsafePerformIO $ C.function_call__11 f ins alwaysInline neverInline+generateCode :: C.Function -> String -> Map String GType -> IO String+generateCode f n opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)+  C.function_generate__3 f n opts --- | call an MXFunction on symbolic inputs, getting symbolic outputs-callMX' :: C.Function -> Map String MX -> AlwaysInline -> NeverInline -> Map String MX-callMX' f ins (AlwaysInline alwaysInline) (NeverInline neverInline) =-  unsafePerformIO $ C.function_call__2 f ins alwaysInline neverInline+generateCode' :: C.Function -> String -> Map String GType -> IO String+generateCode' f name opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)+  cg <- C.codeGenerator__1 name opts+  C.codeGenerator_add__0 cg f+  C.codeGenerator_generate__0 cg --- | call an SXFunction on symbolic inputs, getting symbolic outputs-callSX :: C.Function -> Vector SX -> AlwaysInline -> NeverInline -> Vector SX-callSX f ins (AlwaysInline alwaysInline) (NeverInline neverInline) =-  unsafePerformIO $ C.function_call__14 f ins alwaysInline neverInline+externalFunction :: String -> Map String GType -> IO C.Function+externalFunction name opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)+  C.external__5 name opts --- | call an SXFunction on symbolic inputs, getting symbolic outputs-callSX' :: C.Function -> Map String SX -> AlwaysInline -> NeverInline -> Map String SX-callSX' f ins (AlwaysInline alwaysInline) (NeverInline neverInline) =-  unsafePerformIO $ C.function_call__5 f ins alwaysInline neverInline+externalFunction' :: String -> String -> Map String GType -> IO C.Function+externalFunction' name binName opts0 = do+  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)+  C.external__3 name binName opts --- TODO(greg): expose the thread safe way--- | evaluate a Function with many inputs, many outputs callDM :: C.Function -> Vector DM -> IO (Vector DM) callDM f ins = C.function_call__15 f ins --- | evaluate a Function with many inputs, many outputs-callDM' :: C.FunctionClass f => f -> Map String DM -> IO (Map String DM)+callDM' :: C.Function -> Map String DM -> IO (Map String DM) callDM' f ins = C.function_call__6 f ins -hessian :: C.FunctionClass a => a -> Int -> Int -> IO C.Function-hessian = C.function_hessian__6 -jacobian :: C.FunctionClass a => a -> Int -> Int -> Bool -> Bool -> IO C.Function-jacobian = C.function_jacobian__14+foreign import ccall safe "void hs_call_casadi_function_with_pointers" c_callV+  :: Ptr (Ptr StdString) -> Ptr Function'+  -> Ptr (Ptr CDouble) -> CInt+  -> Ptr (Ptr CDouble) -> CInt+  -> IO () -gradient :: C.FunctionClass a => a -> Int -> Int -> IO C.Function-gradient = C.function_gradient__6+callV :: C.Function -> Vector (Vector Double) -> IO (Vector (Vector Double))+callV f@(Function f') args = do+  -- check number of inputs+  nIn <- C.function_n_in f+  when (nIn /= V.length args) $+    error $ "callV: Function has " ++ show nIn ++ " inputs but you provided " ++ show (V.length args) -generateCode :: C.FunctionClass a => a -> String -> Map String GType -> IO String-generateCode f n opts0 = do-  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)-  C.function_generate__3 (C.castFunction f) n opts+  -- check the size of each input+  inputSizes <- mapM (C.function_nnz_in__1 f) (take nIn [0..])+  let inputSizes' :: Vector Int+      inputSizes' = fmap V.length args -generateCode' :: C.FunctionClass a => a -> String -> Map String GType -> IO String-generateCode' f name opts0 = do-  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)-  cg <- C.codeGenerator__1 name opts-  C.codeGenerator_add cg (C.castFunction f)-  C.codeGenerator_generate__0 cg+      checkInputSize k inputSize+        | inputSizes' V.! k == inputSize = return ()+        | otherwise = error $ "Function input " ++ show k ++ " has " ++ show inputSize+                      ++ " nonzeros but you provided " ++ show (inputSizes' V.! k)+  zipWithM_ checkInputSize [0..] inputSizes -externalFunction :: String -> Map String GenericType -> IO C.Function-externalFunction name opts = C.external__5 name opts+  -- allocate the input buffer+  argBuffer <- mallocArray nIn :: IO (Ptr (Ptr CDouble)) -externalFunction' :: String -> String -> Map String GenericType -> IO C.Function-externalFunction' name binName opts =-  fmap C.castFunction $ C.external__3 name binName opts+  -- allocate and assign each input array+  let allocAndAssignArg k inputSize = do+        -- allocate input array+        argp <- mallocArray inputSize :: IO (Ptr CDouble) -sxFunction :: String -> Vector SX -> Vector SX -> Map String GType-              -> IO C.Function-sxFunction n x y opts0 = do-  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)-  C.function__11 n x y opts+        -- copy input to array+        let arg = args V.! k  :: Vector Double+        mapM_ (\j -> pokeElemOff argp j (realToFrac (arg V.! j))) (take inputSize [0..]) -sxFunction' ::-  String -> (Vector SX, Vector String) -> (Vector SX, Vector String)-  -> Map String GType-  -> IO C.Function-sxFunction' n (x,nx) (y,ny) opts0 = do-  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)-  C.function__9 n x y nx ny opts+        -- assign input array to input buffer+        pokeElemOff argBuffer k argp ---sxFunctionFromFunction :: C.Function -> IO C.SXFunction---sxFunctionFromFunction = C.sxFunction__8+  zipWithM_ allocAndAssignArg (take nIn [0..]) inputSizes ---sxFunctionFromMXFunction :: C.MXFunction -> IO C.SXFunction---sxFunctionFromMXFunction = C.sxFunction__9+  -- allocate output buffer+  nOut <- C.function_n_out f+  resBuffer <- mallocArray nOut :: IO (Ptr (Ptr CDouble)) -mxFunction :: String -> Vector MX -> Vector MX -> Map String GType-              -> IO C.Function-mxFunction n x y opts0 = do-  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)-  C.function__5 n x y opts+  -- allocate memory for each output+  outputSizes <- mapM (C.function_nnz_out__1 f) (take nOut [0..])+  let allocRes k outputSize = do+        -- allocate output array+        resp <- mallocArray outputSize :: IO (Ptr CDouble) -mxFunction' ::-  String -> (Vector MX, Vector String) -> (Vector MX, Vector String)-  -> Map String GType-  -> IO C.Function-mxFunction' n (x,nx) (y,ny) opts0 = do-  opts <- T.mapM fromGType opts0 :: IO (Map String GenericType)-  C.function__3 n x y nx ny opts+        -- assign output array to output buffer+        pokeElemOff resBuffer k resp ---mxFunctionFromFunction :: C.Function -> IO C.MXFunction---mxFunctionFromFunction = C.mxFunction__8+  zipWithM_ allocRes [0..] outputSizes+++  -- call the function+  errStrPtrP <- new nullPtr+  withForeignPtr f' $ \ff -> c_callV errStrPtrP ff argBuffer (fromIntegral nIn) resBuffer (fromIntegral nOut)+  errStrPtr <- peek errStrPtrP+  free errStrPtrP++  if errStrPtr /= nullPtr+    then wrapReturn errStrPtr >>= (error . formatException)+    else do++    -- deallocate the input vectors+    let freeInput k = peekElemOff argBuffer k >>= free+    mapM_ freeInput (take nIn [0..])++    -- deallocate the input buffer+    free argBuffer++    -- copy the outputs and free the output arrays+    let copyAndFreeOutput k outputSize = do+          resp <- peekElemOff resBuffer k+          res <- VM.new outputSize :: IO (VM.IOVector Double)+          let copyOutput j = peekElemOff resp j >>= (VM.write res j . realToFrac)+          mapM_ copyOutput (take outputSize [0..])+          -- free the output array+          free resp+          -- return the vector+          V.unsafeFreeze res++    ret <- zipWithM copyAndFreeOutput [0..] outputSizes++    -- free the output buffer+    free resBuffer++    return (V.fromList ret)+++callV' :: C.Function -> M.Map String (Vector Double) -> IO (M.Map String (Vector Double))+callV' f inputMap = do+  funName <- C.function_name f+  inputNames <- C.function_name_in__1 f+  outputNames <- C.function_name_out__1 f++  let inputNamesSet = S.fromList (V.toList inputNames)+      inputMapKeysSet = M.keysSet inputMap+      missingInputs = S.difference inputNamesSet inputMapKeysSet+      extraInputs = S.difference inputMapKeysSet inputNamesSet++      describeBadInputs =+        error $ "callV': " ++ funName ++ ":\n" +++        "expected inputs: " ++ show (V.toList inputNames) +++        (if null missingInputs then "" else "\nmissing inputs: " ++ show missingInputs) +++        (if null extraInputs then "" else "\nextra inputs: " ++ show extraInputs)++  when (M.size inputMap /= V.length inputNames) describeBadInputs++  let inputVec :: Vector (Vector Double)+      inputVec = fmap lookupInput inputNames+        where+          lookupInput inputName = case M.lookup inputName inputMap of+            Nothing -> describeBadInputs+            Just r -> r++  outputVec <- callV f inputVec++  when (V.length outputVec /= V.length outputNames) $+    error $ "callV': " ++ funName ++ ": something really weird happened, length of outputs "+      ++ show (V.length outputVec) ++ " /= length of names " ++ show (V.length outputNames)++  return $ M.fromList $ zip (V.toList outputNames) (V.toList outputVec)
src/Casadi/GenericType.hs view
@@ -47,17 +47,21 @@   | GString String   | GBoolVec (Vector Bool)   | GDoubleVec (Vector Double)+  | GDoubleVecVec (Vector (Vector Double))   | GIntVec (Vector Int)   | GIntVecVec (Vector (Vector Int))   | GStringVec (Vector String) --  | GGenericType GenericType   | GFunction Function+  | GFunctionVec (Vector Function)   | GDict (Map String GType)   deriving Show  instance Eq GType where   (==) (GFunction _) _ = error "can't compare GFunctions"   (==) _ (GFunction _) = error "can't compare GFunctions"+  (==) (GFunctionVec _) _ = error "can't compare GFunctions"+  (==) _ (GFunctionVec _) = error "can't compare GFunctionsVec"   (==) (GBool x) (GBool y) = x == y   (==) (GBool _) _ = False   (==) (GDouble x) (GDouble y)@@ -71,6 +75,8 @@   (==) (GBoolVec _) _ = False   (==) (GDoubleVec x) (GDoubleVec y) = x == y   (==) (GDoubleVec _) _ = False+  (==) (GDoubleVecVec x) (GDoubleVecVec y) = x == y+  (==) (GDoubleVecVec _) _ = False   (==) (GIntVec x) (GIntVec y) = x == y   (==) (GIntVec _) _ = False   (==) (GIntVecVec x) (GIntVecVec y) = x == y@@ -88,23 +94,25 @@   (==) (GDict _) _ = False  fromGType :: GType -> IO GenericType-fromGType (GBool r) = genericType__10 r-fromGType (GDouble r) = genericType__8 r-fromGType (GInt r) = genericType__9 r-fromGType (GString r) = genericType__7 r+fromGType (GDict r) = T.mapM fromGType r >>= genericType__0+fromGType (GFunctionVec r) = genericType__1 r+fromGType (GFunction r) = genericType__2 r+fromGType (GStringVec r) = genericType__3 r+fromGType (GDoubleVecVec r) = genericType__4 r+fromGType (GDoubleVec r) = genericType__5 r+fromGType (GIntVecVec r) = genericType__6 r+fromGType (GIntVec r) = genericType__7 r fromGType (GBoolVec r) = do-  gt <- genericType__6 r+  gt <- genericType__9 r   gtype <- getType gt   case gtype of     OT_BOOLVECTOR -> error "fromGType GBoolVec got OT_BOOLVECTOR, which means a casadi issue was fixed and this special casing code should be removed"     OT_INTVECTOR -> return gt     other -> error $ "fromGType GBoolVec got " ++ show other ++ ", which is really weird"-fromGType (GDoubleVec r) = genericType__3 r-fromGType (GIntVec r) = genericType__5 r-fromGType (GIntVecVec r) = genericType__4 r-fromGType (GStringVec r) = genericType__2 r-fromGType (GFunction r) = genericType__1 r-fromGType (GDict r) = T.mapM fromGType r >>= genericType__0+fromGType (GString r) = genericType__10 r+fromGType (GDouble r) = genericType__11 r+fromGType (GInt r) = genericType__12 r+fromGType (GBool r) = genericType__14 r  toGType :: GenericType -> IO GType toGType gt = do@@ -129,7 +137,9 @@       return (fmap GDict (sequenceA dict1))     OT_DOUBLE -> Right . GDouble <$> genericType_to_double gt     OT_DOUBLEVECTOR -> Right . GDoubleVec <$> genericType_to_double_vector gt+    OT_DOUBLEVECTORVECTOR -> Right . GDoubleVecVec <$> genericType_to_double_vector_vector gt     OT_FUNCTION -> Right . GFunction <$> genericType_to_function gt+    OT_FUNCTIONVECTOR -> Right . GFunctionVec <$> genericType_to_function_vector gt     OT_INT -> Right . GInt <$> genericType_to_int gt     OT_INTVECTOR -> Right . GIntVec <$> genericType_to_int_vector gt     OT_INTVECTORVECTOR -> Right . GIntVecVec <$> genericType_to_int_vector_vector gt
src/Casadi/MX.hs view
@@ -2,22 +2,23 @@  module Casadi.MX        ( MX-       , sym, symV, symM, gradient, jacobian, hessian-       , expand, attachAssert+       , attachAssert        ) where -import Data.Vector ( Vector )-import System.IO.Unsafe ( unsafePerformIO )+import qualified Data.Vector as V import Linear.Conjugate ( Conjugate(..) )+import System.IO.Unsafe ( unsafePerformIO ) +import qualified Casadi.Core.Classes.Function as C import Casadi.Core.Classes.MX import qualified Casadi.Core.Tools as C -import Casadi.Overloading ( Fmod(..), ArcTan2(..), SymOrd(..), Erf(..) )-import Casadi.CMatrix ( CMatrix(..) ) import Casadi.DM ()-import Casadi.Viewable ( Viewable(..) )+import Casadi.GenericType ( fromGType )+import Casadi.Matrix ( CMatrix(..), SMatrix(..) )+import Casadi.Overloading ( Fmod(..), ArcTan2(..), SymOrd(..), Erf(..) ) import Casadi.SharedObject ( castSharedObject )+import Casadi.Viewable ( Viewable(..) )  instance Conjugate MX where   conjugate = id@@ -37,34 +38,6 @@   vsize2 = size2   vrecoverDimension _ dim = zeros dim -sym :: String -> IO MX-sym x = fmap castMX (mx_sym__6 x)--symV :: String -> Int -> IO MX-symV x y = fmap castMX (mx_sym__7 x y)--symM :: String -> Int -> Int -> IO MX-symM x y z = fmap castMX (mx_sym__8 x y z)---- | @jacobian exp x@ is the jacobian of exp w.r.t. x-gradient :: MX -> MX -> MX-gradient x y = unsafePerformIO (C.casadi_gradient__3 x y)-{-# NOINLINE gradient #-}---- | @jacobian exp x@ is the jacobian of exp w.r.t. x-jacobian :: MX -> MX -> MX-jacobian x y = unsafePerformIO (C.casadi_jacobian__3 x y)-{-# NOINLINE jacobian #-}--expand :: Vector MX -> Vector MX-expand x = unsafePerformIO (C.casadi_matrix_expand__3 x)-{-# NOINLINE expand #-}------ | @hessian exp x@ is the jacobian of exp w.r.t. x-hessian :: MX -> MX -> MX -> MX-hessian x y z = unsafePerformIO (C.casadi_hessian__3 x y z)-{-# NOINLINE hessian #-}- attachAssert :: MX -> MX -> String -> MX attachAssert x y msg = unsafePerformIO (mx_attachAssert__1 x y msg) {-# NOINLINE attachAssert #-}@@ -76,7 +49,7 @@ instance CMatrix MX where   blocksplit x ix iy = unsafePerformIO (C.casadi_blocksplit__15 x ix iy)   {-# NOINLINE blocksplit #-}-  blockcat x = unsafePerformIO (C.casadi_blockcat__7 x)+  blockcat x = unsafePerformIO (C.casadi_blockcat__3 x)   {-# NOINLINE blockcat #-}   veccat x = unsafePerformIO (C.casadi_veccat__3 x)   {-# NOINLINE veccat #-}@@ -94,10 +67,10 @@   {-# NOINLINE size1 #-}   size2 x = unsafePerformIO (mx_size2 x)   {-# NOINLINE size2 #-}-  numel x = unsafePerformIO (mx_numel__1 x)+  numel x = unsafePerformIO (mx_numel x)   {-# NOINLINE numel #-}-  mm x y = unsafePerformIO (C.casadi_mtimes__7 x y)-  {-# NOINLINE mm #-}+  mtimes x y = unsafePerformIO (C.casadi_mtimes__7 x y)+  {-# NOINLINE mtimes #-}   dot x y = unsafePerformIO (C.casadi_dot__3 x y)   {-# NOINLINE dot #-}   sum1 x = unsafePerformIO (C.casadi_sum1__3 x)@@ -116,7 +89,7 @@   {-# NOINLINE zeros #-}   zerosSp sp = unsafePerformIO (mx_zeros__1 sp)   {-# NOINLINE zerosSp #-}-  solve x y s m = unsafePerformIO (C.casadi_solve__10 x y s m)+  solve x y s m = unsafePerformIO (mapM fromGType m >>= C.casadi_solve__10 x y s)   {-# NOINLINE solve #-}   solve' x y = unsafePerformIO (C.casadi_solve__11 x y)   {-# NOINLINE solve' #-}@@ -150,15 +123,15 @@   {-# NOINLINE conditional #-}   conditional' x0 x1 x2 x3 = unsafePerformIO (C.casadi_conditional__7 x0 x1 x2 x3)   {-# NOINLINE conditional' #-}-  inv x = unsafePerformIO (C.casadi_inv__3 x)+  inv x = unsafePerformIO (C.casadi_inv__11 x)   {-# NOINLINE inv #-}   pinv x = unsafePerformIO (C.casadi_pinv__11 x)   {-# NOINLINE pinv #-}-  pinv' x n o = unsafePerformIO (C.casadi_pinv__10 x n o)+  pinv' x n o = unsafePerformIO (mapM fromGType o >>= C.casadi_pinv__10 x n)   {-# NOINLINE pinv' #-}-  cmax x y = unsafePerformIO (C.casadi_max__4 x y)+  cmax x y = unsafePerformIO (C.casadi_fmax__4 x y)   {-# NOINLINE cmax #-}-  cmin x y = unsafePerformIO (C.casadi_min__4 x y)+  cmin x y = unsafePerformIO (C.casadi_fmin__4 x y)   {-# NOINLINE cmin #-}   cand x y = unsafePerformIO (C.casadi_and__4 x y)   {-# NOINLINE cand #-}@@ -168,6 +141,70 @@   {-# NOINLINE repmat #-}   printme x y = unsafePerformIO (mx_printme x y)   {-# NOINLINE printme #-}++  sumSquare x = unsafePerformIO (C.casadi_sumsqr__3 x)+  {-# NOINLINE sumSquare #-}+  invSkew x = unsafePerformIO (C.casadi_inv_skew__3 x)+  {-# NOINLINE invSkew #-}+  cnot x = unsafePerformIO (C.casadi_not__4 x)+  {-# NOINLINE cnot #-}+  nullspace x = unsafePerformIO (C.casadi_nullspace__3 x)+  {-# NOINLINE nullspace #-}+  norm1 x = unsafePerformIO (C.casadi_norm_1__3 x)+  {-# NOINLINE norm1 #-}+  norm2 x = unsafePerformIO (C.casadi_norm_2__3 x)+  {-# NOINLINE norm2 #-}+  normFro x = unsafePerformIO (C.casadi_norm_fro__3 x)+  {-# NOINLINE normFro #-}+  normInf x = unsafePerformIO (C.casadi_norm_inf__3 x)+  {-# NOINLINE normInf #-}+  kron x y = unsafePerformIO (C.casadi_kron__3 x y)+  {-# NOINLINE kron #-}+  mldivide x y = unsafePerformIO (C.casadi_mldivide__3 x y)+  {-# NOINLINE mldivide #-}+  mrdivide x y = unsafePerformIO (C.casadi_mrdivide__3 x y)+  {-# NOINLINE mrdivide #-}+  mpower x y = unsafePerformIO (C.casadi_mpower__3 x y)+  {-# NOINLINE mpower #-}+  ceil' x = unsafePerformIO (C.casadi_ceil__4 x)+  {-# NOINLINE ceil' #-}+  floor' x = unsafePerformIO (C.casadi_floor__4 x)+  {-# NOINLINE floor' #-}+++instance SMatrix MX where+  gradient x y = unsafePerformIO (C.casadi_gradient__3 x y)+  {-# NOINLINE gradient #-}+  jacobian x y = unsafePerformIO (C.casadi_jacobian__6 x y)+  {-# NOINLINE jacobian #-}+  hessian expr args = unsafePerformIO $ do+    grad <- mx__7+    hess <- C.casadi_hessian__3 expr args grad+    return (hess, grad)+  {-# NOINLINE hessian #-}+  jtimes x y z = unsafePerformIO (C.casadi_jtimes__6 x y z)+  {-# NOINLINE jtimes #-}+  forward x y z w = unsafePerformIO (mapM fromGType w >>= C.casadi_forward__7 x y z)+  {-# NOINLINE forward #-}+  reverse x y z w = unsafePerformIO (mapM fromGType w >>= C.casadi_reverse__7 x y z)+  {-# NOINLINE reverse #-}++  sym = mx_sym__8++  toFunction n x y opts0 = do+    opts <- mapM fromGType opts0+    C.function__5 n x y opts++  toFunction' n nxx nyy opts0 = do+    let (nx, x) = V.unzip nxx+        (ny, y) = V.unzip nyy+    opts <- mapM fromGType opts0+    C.function__3 n x y nx ny opts++  callSym f ins = unsafePerformIO (C.function_call__9 f ins)+  {-# NOINLINE callSym #-}+  callSym' f ins = unsafePerformIO (C.function_call__0 f ins)+  {-# NOINLINE callSym' #-}   instance Num MX where
+ src/Casadi/Matrix.hs view
@@ -0,0 +1,130 @@+{-# OPTIONS_GHC -Wall #-}++module Casadi.Matrix+       ( CMatrix(..), SMatrix(..)+       , vertslice, horzslice+       ) where++import qualified Data.Map as M+import qualified Data.Vector as V++import Casadi.Core.Classes.DM ( DM )+import Casadi.Core.Classes.Function ( Function )++import Casadi.GenericType ( GType )+import Casadi.Overloading ( Fmod, ArcTan2, SymOrd, Erf )+import Casadi.Sparsity ( Sparsity )+import Casadi.Slice ( Slice, slice )+import Casadi.Viewable ( Viewable )++-- TODO(greg): alphabetize this, it's getting too big to manage+-- | casadi matrix+class (Eq a, Show a, Floating a, Fmod a, ArcTan2 a, SymOrd a, Erf a, Viewable a)+      => CMatrix a where+  blocksplit :: a -> V.Vector Int -> V.Vector Int -> V.Vector (V.Vector a)+  blockcat :: V.Vector (V.Vector a) -> a+  vertsplit :: a -> V.Vector Int -> V.Vector a+  vertcat :: V.Vector a -> a+  horzsplit :: a -> V.Vector Int -> V.Vector a+  horzcat :: V.Vector a -> a+  veccat :: V.Vector a -> a+  size1 :: a -> Int+  size2 :: a -> Int+  numel :: a -> Int+  -- | matrix matrix product+  mtimes :: a -> a -> a+  -- | sumAll(x*y), x and y same dimension+  dot :: a -> a -> a+  sum1 :: a -> a+  sum2 :: a -> a+  sumSquare :: a -> a+  -- | transpose+  trans :: a -> a+  diag :: a -> a+  eye :: Int -> a+  ones :: (Int,Int) -> a+  zeros :: (Int,Int) -> a+  zerosSp :: Sparsity -> a+  solve :: a -> a -> String -> M.Map String GType -> a+  solve' :: a -> a -> a+  indexed :: a -> Slice -> Slice -> a+  sparsity :: a -> Sparsity+  getNZ :: a -> Slice -> a+  setNZ :: a -> a -> Slice -> IO ()+  inv :: a -> a+  invSkew :: a -> a+  pinv :: a -> a+  pinv' :: a -> String -> M.Map String GType -> a+  triu :: a -> a+  tril :: a -> a+  triu2symm :: a -> a+  tril2symm :: a -> a+  copy :: a -> IO a+  densify :: a -> a+  fromDM :: DM -> a+  fromDVector :: V.Vector Double -> a+  fromDouble :: Double -> a+  reshape :: a -> (Int, Int) -> a+  conditional :: a -> V.Vector a -> a -> a+  conditional' :: a -> V.Vector a -> a -> Bool -> a+  cmin :: a -> a -> a+  cmax :: a -> a -> a+  cand :: a -> a -> a+  cor :: a -> a -> a+  cnot :: a -> a+  nullspace :: a -> a+  norm1 :: a -> a+  norm2 :: a -> a+  normFro :: a -> a+  normInf :: a -> a++--  if_else ::+  -- TODO(greg): any and all, mac, repsum?+  repmat :: a -> (Int, Int) -> a+  printme :: a -> a -> a+  kron :: a -> a -> a+  mldivide :: a -> a -> a+  mrdivide :: a -> a -> a+  mpower :: a -> a -> a+--  matrix_expand :: a -> a -> a++  ceil' :: a -> a+  floor' :: a -> a+++-- | symbolic matrix+class CMatrix a => SMatrix a where+  sym :: String -> Int -> Int -> IO a+  toFunction :: String -> V.Vector a -> V.Vector a -> M.Map String GType -> IO Function+  toFunction' :: String -> V.Vector (String, a) -> V.Vector (String, a) -> M.Map String GType -> IO Function+  -- | @gradient exp x@ is the gradient of exp w.r.t. x+  gradient :: a -> a -> a+  -- | @jacobian exp x@ is the jacobian of exp w.r.t. x+  jacobian :: a -> a -> a+  -- | @(hess, grad) = hessian exp args@+  hessian :: a -> a -> (a, a)+  jtimes :: a -> a -> a -> a+  forward :: V.Vector a -> V.Vector a -> V.Vector (V.Vector a) -> M.Map String GType -> V.Vector (V.Vector a)+  reverse :: V.Vector a -> V.Vector a -> V.Vector (V.Vector a) -> M.Map String GType -> V.Vector (V.Vector a)++  callSym :: Function -> V.Vector a -> V.Vector a+  callSym' :: Function -> M.Map String a -> M.Map String a+++vertslice :: CMatrix a => a -> V.Vector Int -> V.Vector a+vertslice x vs = V.fromList (f (V.toList vs))+  where+    cols = size2 x+    hslice = slice 0 cols 1++    f (v0:v1:others) = indexed x (slice v0 v1 1) hslice : f (v1:others)+    f _ = []++horzslice :: CMatrix a => a -> V.Vector Int -> V.Vector a+horzslice x vs = V.fromList (f (V.toList vs))+  where+    rows = size1 x+    vslice = slice 0 rows 1++    f (v0:v1:others) = indexed x vslice (slice v0 v1 1) : f (v1:others)+    f _ = []
src/Casadi/SX.hs view
@@ -2,23 +2,25 @@  module Casadi.SX        ( SX-       , ssym, ssymV, ssymM, sgradient, sjacobian, shessian        , ssparsify        ) where +import qualified Data.Vector as V import System.IO.Unsafe ( unsafePerformIO ) import Linear.Conjugate ( Conjugate(..) ) +import qualified Casadi.Core.Classes.Function as C import Casadi.Core.Classes.SX import qualified Casadi.Core.Tools as C -import Casadi.Overloading ( Fmod(..), ArcTan2(..), SymOrd(..), Erf(..) )-import Casadi.CMatrix ( CMatrix(..) ) import Casadi.DM ()+import Casadi.GenericType ( fromGType )+import Casadi.Matrix ( CMatrix(..), SMatrix(..) )+import Casadi.Overloading ( Fmod(..), ArcTan2(..), SymOrd(..), Erf(..) ) import Casadi.Viewable ( Viewable(..) )  instance Show SX where-  show x = unsafePerformIO (sx_getDescription x)+  show x = unsafePerformIO (sx_get_str__0 x)   {-# NOINLINE show #-}  instance Eq SX where@@ -35,39 +37,10 @@   vsize2 = size2   vrecoverDimension _ dim = zeros dim -ssym :: String -> IO SX-ssym = sx_sym__6--ssymV :: String -> Int -> IO SX-ssymV = sx_sym__7--ssymM :: String -> Int -> Int -> IO SX-ssymM = sx_sym__8---- | @jacobian exp x@ is the jacobian of exp w.r.t. x-sgradient :: SX -> SX -> SX-sgradient x y = unsafePerformIO (C.casadi_gradient__0 x y)-{-# NOINLINE sgradient #-}---- | @jacobian exp x@ is the jacobian of exp w.r.t. x-sjacobian :: SX -> SX -> SX-sjacobian x y = unsafePerformIO (C.casadi_jacobian__0 x y)-{-# NOINLINE sjacobian #-}---- | @hessian exp x@ is the hessian of exp w.r.t. x-shessian :: SX -> SX -> SX -> SX-shessian x y z = unsafePerformIO (C.casadi_hessian__0 x y z)-{-# NOINLINE shessian #-}--ssparsify :: SX -> SX-ssparsify x = unsafePerformIO (C.casadi_sparsify__0 x)-{-# NOINLINE ssparsify #-}-- instance CMatrix SX where   blocksplit x ix iy = unsafePerformIO (C.casadi_blocksplit__3 x ix iy)   {-# NOINLINE blocksplit #-}-  blockcat x = unsafePerformIO (C.casadi_blockcat__1 x)+  blockcat x = unsafePerformIO (C.casadi_blockcat__0 x)   {-# NOINLINE blockcat #-}   veccat x = unsafePerformIO (C.casadi_veccat__0 x)   {-# NOINLINE veccat #-}@@ -85,10 +58,10 @@   {-# NOINLINE size1 #-}   size2 x = unsafePerformIO (sx_size2 x)   {-# NOINLINE size2 #-}-  numel x = unsafePerformIO (sx_numel__1 x)+  numel x = unsafePerformIO (sx_numel x)   {-# NOINLINE numel #-}-  mm x y = unsafePerformIO (C.casadi_mtimes__1 x y)-  {-# NOINLINE mm #-}+  mtimes x y = unsafePerformIO (C.casadi_mtimes__1 x y)+  {-# NOINLINE mtimes #-}   dot x y = unsafePerformIO (C.casadi_dot__0 x y)   {-# NOINLINE dot #-}   sum1 x = unsafePerformIO (C.casadi_sum1__0 x)@@ -107,7 +80,7 @@   {-# NOINLINE zeros #-}   zerosSp sp = unsafePerformIO (sx_zeros__1 sp)   {-# NOINLINE zerosSp #-}-  solve x y s m = unsafePerformIO (C.casadi_solve__1 x y s m)+  solve x y s m = unsafePerformIO (mapM fromGType m >>= C.casadi_solve__1 x y s)   {-# NOINLINE solve #-}   solve' x y = unsafePerformIO (C.casadi_solve__2 x y)   {-# NOINLINE solve' #-}@@ -141,15 +114,15 @@   {-# NOINLINE conditional #-}   conditional' x0 x1 x2 x3 = unsafePerformIO (C.casadi_conditional__1 x0 x1 x2 x3)   {-# NOINLINE conditional' #-}-  inv x = unsafePerformIO (C.casadi_inv__0 x)+  inv x = unsafePerformIO (C.casadi_inv__2 x)   {-# NOINLINE inv #-}   pinv x = unsafePerformIO (C.casadi_pinv__2 x)   {-# NOINLINE pinv #-}-  pinv' x n o = unsafePerformIO (C.casadi_pinv__1 x n o)+  pinv' x n o = unsafePerformIO (mapM fromGType o >>= C.casadi_pinv__1 x n)   {-# NOINLINE pinv' #-}-  cmax x y = unsafePerformIO (C.casadi_max__1 x y)+  cmax x y = unsafePerformIO (C.casadi_fmax__1 x y)   {-# NOINLINE cmax #-}-  cmin x y = unsafePerformIO (C.casadi_min__1 x y)+  cmin x y = unsafePerformIO (C.casadi_fmin__1 x y)   {-# NOINLINE cmin #-}   cand x y = unsafePerformIO (C.casadi_and__1 x y)   {-# NOINLINE cand #-}@@ -159,6 +132,76 @@   {-# NOINLINE repmat #-}   printme x y = unsafePerformIO (sx_printme x y)   {-# NOINLINE printme #-}++  sumSquare x = unsafePerformIO (C.casadi_sumsqr__0 x)+  {-# NOINLINE sumSquare #-}+  invSkew x = unsafePerformIO (C.casadi_inv_skew__0 x)+  {-# NOINLINE invSkew #-}+  cnot x = unsafePerformIO (C.casadi_not__1 x)+  {-# NOINLINE cnot #-}+  nullspace x = unsafePerformIO (C.casadi_nullspace__0 x)+  {-# NOINLINE nullspace #-}+  norm1 x = unsafePerformIO (C.casadi_norm_1__0 x)+  {-# NOINLINE norm1 #-}+  norm2 x = unsafePerformIO (C.casadi_norm_2__0 x)+  {-# NOINLINE norm2 #-}+  normFro x = unsafePerformIO (C.casadi_norm_fro__0 x)+  {-# NOINLINE normFro #-}+  normInf x = unsafePerformIO (C.casadi_norm_inf__0 x)+  {-# NOINLINE normInf #-}+  kron x y = unsafePerformIO (C.casadi_kron__0 x y)+  {-# NOINLINE kron #-}+  mldivide x y = unsafePerformIO (C.casadi_mldivide__0 x y)+  {-# NOINLINE mldivide #-}+  mrdivide x y = unsafePerformIO (C.casadi_mrdivide__0 x y)+  {-# NOINLINE mrdivide #-}+  mpower x y = unsafePerformIO (C.casadi_mpower__0 x y)+  {-# NOINLINE mpower #-}+  ceil' x = unsafePerformIO (C.casadi_ceil__1 x)+  {-# NOINLINE ceil' #-}+  floor' x = unsafePerformIO (C.casadi_floor__1 x)+  {-# NOINLINE floor' #-}+++instance SMatrix SX where+  gradient x y = unsafePerformIO (C.casadi_gradient__0 x y)+  {-# NOINLINE gradient #-}+  jacobian x y = unsafePerformIO (C.casadi_jacobian__0 x y)+  {-# NOINLINE jacobian #-}+  hessian expr args = unsafePerformIO $ do+    grad <- sx__10+    hess <- C.casadi_hessian__0 expr args grad+    return (hess, grad)+  {-# NOINLINE hessian #-}+  jtimes x y z = unsafePerformIO (C.casadi_jtimes__0 x y z)+  {-# NOINLINE jtimes #-}+  forward x y z w = unsafePerformIO (mapM fromGType w >>= C.casadi_forward__1 x y z)+  {-# NOINLINE forward #-}+  reverse x y z w = unsafePerformIO (mapM fromGType w >>= C.casadi_reverse__1 x y z)+  {-# NOINLINE reverse #-}++  sym = sx_sym__8++  toFunction n x y opts0 = do+    opts <- mapM fromGType opts0+    C.function__11 n x y opts++  toFunction' n nxx nyy opts0 = do+    let (nx, x) = V.unzip nxx+        (ny, y) = V.unzip nyy+    opts <- mapM fromGType opts0+    C.function__9 n x y nx ny opts++  callSym f ins = unsafePerformIO (C.function_call__12 f ins)+  {-# NOINLINE callSym #-}+  callSym' f ins = unsafePerformIO (C.function_call__3 f ins)+  {-# NOINLINE callSym' #-}+++ssparsify :: SX -> SX+ssparsify x = unsafePerformIO (C.casadi_sparsify__0 x)+{-# NOINLINE ssparsify #-}+   instance Num SX where
src/Casadi/SharedObject.hs view
@@ -9,5 +9,5 @@ import qualified Casadi.Core.Classes.SharedObject as C  instance Show C.SharedObject where-  show x = unsafePerformIO (C.sharedObject_getDescription x)+  show x = unsafePerformIO (C.sharedObject_get_str__0 x)   {-# NOINLINE show #-}
src/Casadi/Slice.hs view
@@ -9,7 +9,7 @@ import Casadi.Core.Classes.Slice  instance Show Slice where-  show x = unsafePerformIO (slice_getDescription x)+  show x = unsafePerformIO (slice_get_str__0 x)   {-# NOINLINE show #-}  -- | slice start stop step@@ -19,5 +19,5 @@  -- | Slice() slice' :: Slice-slice' = unsafePerformIO slice__4+slice' = unsafePerformIO slice__10 {-# NOINLINE slice' #-}
src/Casadi/Sparsity.hs view
@@ -79,5 +79,5 @@ {-# NOINLINE compress #-}  compressed :: V.Vector Int -> Sparsity-compressed v = unsafePerformIO (sparsity_compressed v)+compressed v = unsafePerformIO (sparsity_compressed__0 v) {-# NOINLINE compressed #-}
tests/CallbackTests.hs view
@@ -26,7 +26,7 @@           [x] -> return (V.singleton (x*x))           _ -> error $ "callback got wrong number of args: " ++ show xs -  fun <- makeCallback (V.singleton (dense 1 1)) (V.singleton (dense 1 1)) cb+  fun <- makeCallback "test_callback" (V.singleton (dense 1 1)) (V.singleton (dense 1 1)) cb    putStrLn "calling callback"   outs <- callDM fun (V.singleton 2.2)
tests/GTypeTests.hs view
@@ -20,6 +20,8 @@     gtypes' :: [(String, GType)]     gtypes' = gtypes'' ++ [("a map lol", GDict (M.fromList gtypes''))] +    doubleVec = V.fromList [42, 0, read "Infinity"]+     gtypes'' :: [(String, GType)]     gtypes'' =         [ ("GBool True", GBool True)@@ -36,7 +38,8 @@ --        , ("GBoolVec V.empty", GBoolVec V.empty) --        , ("GBoolVec V.singleton True", GBoolVec (V.singleton True)) --        , ("GBoolVec V.fromList [True, False]", GBoolVec (V.fromList [True, False]))-        , ("GDoubleVec [42, 0, read \"Infinity\"]", GDoubleVec (V.fromList ([42, 0, read "Infinity"])))+        , ("GDoubleVec [42, 0, read \"Infinity\"]", GDoubleVec doubleVec)+        , ("GDoubleVecVec", GDoubleVecVec (V.fromList [doubleVec, V.singleton 22.2, doubleVec]))         , ("GIntVec [42, 0]", GIntVec (V.fromList [42, 0]))         , ("GIntVecVec", GIntVecVec (V.fromList [V.fromList [42, 0], V.singleton 2, V.empty]))         , ("GStringVec [\"\", \"yolo\"]", GStringVec (V.fromList ["", "yolo"]))