From 9ef9a9a1c2e2319358fb164bc18a8a0efb23893b Mon Sep 17 00:00:00 2001 From: CJ East Date: Mon, 12 Jan 2015 23:53:51 +1100 Subject: Minor fixes for examples --- packages/glpk/examples/simplex1.hs | 6 +++--- packages/glpk/examples/simplex2.hs | 2 +- packages/glpk/examples/simplex3.hs | 2 +- packages/glpk/examples/simplex4.hs | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/packages/glpk/examples/simplex1.hs b/packages/glpk/examples/simplex1.hs index e7aeaa9..a326555 100644 --- a/packages/glpk/examples/simplex1.hs +++ b/packages/glpk/examples/simplex1.hs @@ -9,9 +9,9 @@ constr = Dense [ [1,1,1] :<=: 100 , [2,2,6] :<=: 300 ] -- default bounds -bnds = [ 1 :=>: 0 - , 2 :=>: 0 - , 3 :=>: 0 ] +bnds = [ 1 :>=: 0 + , 2 :>=: 0 + , 3 :>=: 0 ] main = do print $ simplex objFun constr [] diff --git a/packages/glpk/examples/simplex2.hs b/packages/glpk/examples/simplex2.hs index f4e27fd..e9e8859 100644 --- a/packages/glpk/examples/simplex2.hs +++ b/packages/glpk/examples/simplex2.hs @@ -13,6 +13,6 @@ constr2 = Dense [ [2,1,0] :<=: 10 main = do print $ simplex prob constr1 [] print $ simplex prob constr2 [] - print $ simplex prob constr2 [ 2 :=>: 1, 3 :&: (2,7)] + print $ simplex prob constr2 [ 2 :>=: 1, 3 :&: (2,7)] print $ simplex prob constr2 [ Free 2 ] diff --git a/packages/glpk/examples/simplex3.hs b/packages/glpk/examples/simplex3.hs index e093124..0997320 100644 --- a/packages/glpk/examples/simplex3.hs +++ b/packages/glpk/examples/simplex3.hs @@ -11,7 +11,7 @@ constr = Dense , [0.03, 0.05, 0.08, 0.02, 0.06, 0.01, 0] :<=: 100 , [0.02, 0.04, 0.01, 0.02, 0.02, 0, 0] :<=: 40 , [0.02, 0.03, 0, 0, 0.01, 0, 0] :<=: 30 - , [0.7, 0.75, 0.8, 0.75, 0.8, 0.97, 0] :=>: 1500 + , [0.7, 0.75, 0.8, 0.75, 0.8, 0.97, 0] :>=: 1500 , [0.02, 0.06, 0.08, 0.12, 0.02, 0.01, 0.97] :&: (250,300) ] diff --git a/packages/glpk/examples/simplex4.hs b/packages/glpk/examples/simplex4.hs index 9a205ad..22b131c 100644 --- a/packages/glpk/examples/simplex4.hs +++ b/packages/glpk/examples/simplex4.hs @@ -11,7 +11,7 @@ constr = Sparse , [0.03#1, 0.05#2, 0.08#3, 0.02#4, 0.06#5, 0.01#6] :<=: 100 , [0.02#1, 0.04#2, 0.01#3, 0.02#4, 0.02#5] :<=: 40 , [0.02#1, 0.03#2, 0.01#5] :<=: 30 - , [0.7#1, 0.75#2, 0.8#3, 0.75#4, 0.8#5, 0.97#6] :=>: 1500 + , [0.7#1, 0.75#2, 0.8#3, 0.75#4, 0.8#5, 0.97#6] :>=: 1500 , [0.02#1, 0.06#2, 0.08#3, 0.12#4, 0.02#5, 0.01#6, 0.97#7] :&: (250,300) ] -- cgit v1.2.3 From 815ef730c17bcdf5c6dcbd27c32da9ef944ae498 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Tue, 13 Jan 2015 19:48:08 -0500 Subject: Chain: GHC 7.10 requires FlexibleInstances for inferred signatures --- packages/base/src/Numeric/Chain.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/packages/base/src/Numeric/Chain.hs b/packages/base/src/Numeric/Chain.hs index 4c497f0..443bd28 100644 --- a/packages/base/src/Numeric/Chain.hs +++ b/packages/base/src/Numeric/Chain.hs @@ -12,6 +12,8 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE FlexibleContexts #-} + module Numeric.Chain ( optimiseMult, ) where -- cgit v1.2.3 From 480d5327d9ab8134eea1173baa1c40e689bcd056 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Tue, 13 Jan 2015 19:48:26 -0500 Subject: Implicit quantification will soon be an error --- packages/base/src/Numeric/LinearAlgebra/Static.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs index cbcd4e2..5749c40 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Static.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs @@ -184,8 +184,8 @@ a ¦ b = tr (tr a —— tr b) type Sq n = L n n --type CSq n = CL n n -type GL = (KnownNat n, KnownNat m) => L m n -type GSq = KnownNat n => Sq n +type GL = forall n m. (KnownNat n, KnownNat m) => L m n +type GSq = forall n. KnownNat n => Sq n isKonst :: forall m n . (KnownNat m, KnownNat n) => L m n -> Maybe (ℝ,(Int,Int)) isKonst s@(unwrap -> x) -- cgit v1.2.3 From 6ac57838ce80a7fde7e56a53601dfa7bbb529c13 Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Wed, 14 Jan 2015 09:00:20 +0100 Subject: thanks --- packages/base/THANKS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/packages/base/THANKS.md b/packages/base/THANKS.md index fdbbe14..0eaf8ce 100644 --- a/packages/base/THANKS.md +++ b/packages/base/THANKS.md @@ -179,3 +179,7 @@ module reorganization, monadic mapVectorM, and many other improvements. - Kiwamu Ishikura improved randomVector for OSX +- C.J. East fixed the examples for simplex. + +- Ben Gamari contributed fixes for ghc 7.10 + -- cgit v1.2.3 From c9bc85accf8b62ff65cb5367ad7206f1228916e0 Mon Sep 17 00:00:00 2001 From: Carter Tazio Schonwald Date: Mon, 26 Jan 2015 19:37:10 -0500 Subject: fix hmatrix cabal file so it works correctly currently the cabal file assumes unconditionally that openblas flag is true on random users, this fixes it and makes -fopenblas opt in. please make a bug fix release with this post haste! --- packages/base/hmatrix.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/packages/base/hmatrix.cabal b/packages/base/hmatrix.cabal index 8ba3e06..3a1335d 100644 --- a/packages/base/hmatrix.cabal +++ b/packages/base/hmatrix.cabal @@ -35,6 +35,7 @@ extra-source-files: src/C/lapack-aux.h flag openblas description: Link with OpenBLAS (https://github.com/xianyi/OpenBLAS) optimized libraries. default: False + manual: True library -- cgit v1.2.3 From 5a6bf1299d3bdad5289f559192d60fdaf33893e7 Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Tue, 27 Jan 2015 08:44:02 +0100 Subject: bump version and thanks --- packages/base/THANKS.md | 2 +- packages/base/hmatrix.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/packages/base/THANKS.md b/packages/base/THANKS.md index 0eaf8ce..e88b516 100644 --- a/packages/base/THANKS.md +++ b/packages/base/THANKS.md @@ -92,7 +92,7 @@ module reorganization, monadic mapVectorM, and many other improvements. - Carter Schonwald helped with the configuration for Homebrew OS X and found a tolerance problem in test "1E5 rots". He also discovered - a bug in the signature of cmap. + a bug in the signature of cmap and fixed the cabal file. - Duncan Coutts reported a problem with configure.hs and contributed a solution and a simplified Setup.lhs. diff --git a/packages/base/hmatrix.cabal b/packages/base/hmatrix.cabal index 3a1335d..3563a2f 100644 --- a/packages/base/hmatrix.cabal +++ b/packages/base/hmatrix.cabal @@ -1,5 +1,5 @@ Name: hmatrix -Version: 0.16.1.3 +Version: 0.16.1.4 License: BSD3 License-file: LICENSE Author: Alberto Ruiz -- cgit v1.2.3 From e57907c22e8a16d2a9b62b70dd04ffcfd0d96b6a Mon Sep 17 00:00:00 2001 From: Piotr Mardziel Date: Sun, 22 Feb 2015 22:58:30 -0500 Subject: added handling of general sparse constraints --- packages/glpk/examples/simplex2.hs | 5 ++++ packages/glpk/hmatrix-glpk.cabal | 2 +- packages/glpk/src/Numeric/LinearProgramming.hs | 40 ++++++++++++++++++++++---- 3 files changed, 41 insertions(+), 6 deletions(-) diff --git a/packages/glpk/examples/simplex2.hs b/packages/glpk/examples/simplex2.hs index e9e8859..0d83ca9 100644 --- a/packages/glpk/examples/simplex2.hs +++ b/packages/glpk/examples/simplex2.hs @@ -10,9 +10,14 @@ constr2 = Dense [ [2,1,0] :<=: 10 , [0,1,5] :<=: 20 ] +constr3 = General [ [1#1, 1#1, 1#2] :<=: 10 + , [1#2, 5#3] :<=: 20 + ] + main = do print $ simplex prob constr1 [] print $ simplex prob constr2 [] + print $ simplex prob constr3 [] print $ simplex prob constr2 [ 2 :>=: 1, 3 :&: (2,7)] print $ simplex prob constr2 [ Free 2 ] diff --git a/packages/glpk/hmatrix-glpk.cabal b/packages/glpk/hmatrix-glpk.cabal index cd761e0..229197f 100644 --- a/packages/glpk/hmatrix-glpk.cabal +++ b/packages/glpk/hmatrix-glpk.cabal @@ -22,7 +22,7 @@ extra-source-files: examples/simplex1.hs examples/simplex4.hs library - Build-Depends: base <5, hmatrix >= 0.16 + Build-Depends: base <5, hmatrix >= 0.16, containers >= 0.5.4.0 hs-source-dirs: src diff --git a/packages/glpk/src/Numeric/LinearProgramming.hs b/packages/glpk/src/Numeric/LinearProgramming.hs index b0537cc..a54eb59 100644 --- a/packages/glpk/src/Numeric/LinearProgramming.hs +++ b/packages/glpk/src/Numeric/LinearProgramming.hs @@ -49,6 +49,14 @@ constr2 = Dense [ [2,1,0] :<=: 10 ] @ +Note that when using sparse constraints, coefficients cannot appear more than once in each constraint. You can alternatively use General which will automatically sum any duplicate coefficients when necessary. + +@ +constr3 = General [ [1\#1, 1\#1, 1\#2] :<=: 10 + , [1\#2, 5\#3] :<=: 20 + ] +@ + By default all variables are bounded as @x_i >= 0@, but this can be changed: @@ -67,6 +75,7 @@ Multiple bounds for a variable are not allowed, instead of module Numeric.LinearProgramming( simplex, + sparseOfGeneral, Optimization(..), Constraints(..), Bounds, @@ -82,13 +91,14 @@ import System.IO.Unsafe(unsafePerformIO) import Foreign.C.Types import Data.List((\\),sortBy,nub) import Data.Function(on) +import qualified Data.Map.Strict as Map --import Debug.Trace --debug x = trace (show x) x ----------------------------------------------------- --- | Coefficient of a variable for a sparse representation of constraints. +-- | Coefficient of a variable for a sparse and general representations of constraints. (#) :: Double -> Int -> (Double,Int) infixl 5 # (#) = (,) @@ -108,18 +118,29 @@ data Solution = Undefined | Unbounded deriving Show -data Constraints = Dense [ Bound [Double] ] - | Sparse [ Bound [(Double,Int)] ] +data Constraints = Dense [ Bound [Double] ] + | Sparse [ Bound [(Double,Int)] ] + | General [ Bound [(Double,Int)] ] data Optimization = Maximize [Double] | Minimize [Double] type Bounds = [Bound Int] +-- | Convert a system of General constraints to one with unique coefficients. +sparseOfGeneral :: Constraints -> Constraints +sparseOfGeneral (General cs) = + Sparse $ map (\bl -> + let cl = obj bl in + let m = foldr (\(c,t) m -> Map.insertWith (+) t c m) Map.empty cl in + withObj bl (Map.foldrWithKey' (\t c l -> (c#t) : l) [] m)) cs +sparseOfGeneral _ = error "sparseOfGeneral: a general system of constraints was expected" + simplex :: Optimization -> Constraints -> Bounds -> Solution -simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds -simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds +simplex opt (Dense []) bnds = simplex opt (Sparse []) bnds +simplex opt (Sparse []) bnds = simplex opt (Sparse [Free [0#1]]) bnds +simplex opt (General []) bnds = simplex opt (Sparse [Free [0#1]]) bnds simplex opt (Dense constr) bnds = extract sg sol where sol = simplexSparse m n (mkConstrD sz objfun constr) (mkBounds sz constr bnds) @@ -133,6 +154,8 @@ simplex opt (Sparse constr) bnds = extract sg sol where m = length constr (sz, sg, objfun) = adapt opt +simplex opt constr@(General _) bnds = simplex opt (sparseOfGeneral constr) bnds + adapt :: Optimization -> (Int, Double, [Double]) adapt opt = case opt of Maximize x -> (size x, 1 ,x) @@ -162,6 +185,13 @@ obj (x :&: _) = x obj (x :==: _) = x obj (Free x) = x +withObj :: Bound t -> t -> Bound t +withObj (_ :<=: b) x = (x :<=: b) +withObj (_ :>=: b) x = (x :>=: b) +withObj (_ :&: b) x = (x :&: b) +withObj (_ :==: b) x = (x :==: b) +withObj (Free _) x = Free x + tb :: Bound t -> Double tb (_ :<=: _) = glpUP tb (_ :>=: _) = glpLO -- cgit v1.2.3 From 012144b1e6ce75515bf3eea5dd2f0f4ddd0d3cae Mon Sep 17 00:00:00 2001 From: Piotr Mardziel Date: Mon, 23 Feb 2015 17:40:31 -0500 Subject: added support for glp_exact --- packages/glpk/examples/simplex5.hs | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 packages/glpk/examples/simplex5.hs diff --git a/packages/glpk/examples/simplex5.hs b/packages/glpk/examples/simplex5.hs new file mode 100644 index 0000000..ecbcdaa --- /dev/null +++ b/packages/glpk/examples/simplex5.hs @@ -0,0 +1,27 @@ +import Numeric.LinearProgramming + +-- This is a linear program from the paper "Picking vs. Guessing Secrets: A Game-theoretic Analysis" + +gamma = 100000 :: Double +sigma = 1 :: Double +n = 64 :: Int +cost_fun :: Int -> Double +cost_fun i = (fromIntegral i) / (fromIntegral n) +size_fun :: Int -> Double +size_fun i = 2^(fromIntegral i) + +prob = Minimize $ map cost_fun [1..n] +bnds = [i :&: (0,1) | i <- [1..n]] + +constr1 = [[1 # i | i <- [1..n]] :==: 1] ++ + [[1/(size_fun i) # i, + -1/(size_fun (i+1)) # i+1] :>=: 0 | i <- [1..n-1]] ++ + [( + [gamma#i | i <- [1..k]] ++ + (concat [[sigma*(size_fun i) # j | j <- [1..i-1]] | i <- [1..k]]) ++ + [((size_fun i) - 1)/2 # i | i <- [1..k]]) + :<=: (sigma * (foldr (+) 0 (map size_fun [1..k]))) | k <- [1..n]] + +main = do + print $ simplex prob (General constr1) bnds -- NoFeasible + print $ exact prob (General constr1) bnds -- solution found -- cgit v1.2.3 From 456aa8ebb8f8ab67f526b33930a54769b15c138a Mon Sep 17 00:00:00 2001 From: Piotr Mardziel Date: Mon, 23 Feb 2015 17:43:16 -0500 Subject: the rest of the files for glp_exact --- packages/glpk/hmatrix-glpk.cabal | 1 + packages/glpk/src/C/glpk.c | 130 +++++++++++++------------ packages/glpk/src/Numeric/LinearProgramming.hs | 39 +++++++- 3 files changed, 105 insertions(+), 65 deletions(-) diff --git a/packages/glpk/hmatrix-glpk.cabal b/packages/glpk/hmatrix-glpk.cabal index 229197f..a9859f9 100644 --- a/packages/glpk/hmatrix-glpk.cabal +++ b/packages/glpk/hmatrix-glpk.cabal @@ -20,6 +20,7 @@ extra-source-files: examples/simplex1.hs examples/simplex2.hs examples/simplex3.hs examples/simplex4.hs + examples/simplex5.hs library Build-Depends: base <5, hmatrix >= 0.16, containers >= 0.5.4.0 diff --git a/packages/glpk/src/C/glpk.c b/packages/glpk/src/C/glpk.c index bfbb435..86b1277 100644 --- a/packages/glpk/src/C/glpk.c +++ b/packages/glpk/src/C/glpk.c @@ -10,67 +10,71 @@ /*-----------------------------------------------------*/ -int c_simplex_sparse(int m, int n, DMAT(c), DMAT(b), DVEC(s)) { - glp_prob *lp; - lp = glp_create_prob(); - glp_set_obj_dir(lp, GLP_MAX); - int i,j,k; - int tot = cr - n; - glp_add_rows(lp, m); - glp_add_cols(lp, n); +#define C_X_SPARSE(X) \ + int c_##X##_sparse(int m, int n, DMAT(c), DMAT(b), DVEC(s)) { \ + glp_prob *lp; \ + lp = glp_create_prob(); \ + glp_set_obj_dir(lp, GLP_MAX); \ + int i,j,k; \ + int tot = cr - n; \ + glp_add_rows(lp, m); \ + glp_add_cols(lp, n); \ + \ + /*printf("%d %d\n",m,n);*/ \ + \ + /* the first n values */ \ + for (k=1;k<=n;k++) { \ + glp_set_obj_coef(lp, k, AT(c, k-1, 2)); \ + /*printf("%d %f\n",k,AT(c, k-1, 2)); */ \ + } \ + \ + int * ia = malloc((1+tot)*sizeof(int)); \ + int * ja = malloc((1+tot)*sizeof(int)); \ + double * ar = malloc((1+tot)*sizeof(double)); \ + \ + for (k=1; k<= tot; k++) { \ + ia[k] = rint(AT(c,k-1+n,0)); \ + ja[k] = rint(AT(c,k-1+n,1)); \ + ar[k] = AT(c,k-1+n,2); \ + /*printf("%d %d %f\n",ia[k],ja[k],ar[k]);*/ \ + } \ + glp_load_matrix(lp, tot, ia, ja, ar); \ + \ + int t; \ + for (i=1;i<=m;i++) { \ + switch((int)rint(AT(b,i-1,0))) { \ + case 0: { t = GLP_FR; break; } \ + case 1: { t = GLP_LO; break; } \ + case 2: { t = GLP_UP; break; } \ + case 3: { t = GLP_DB; break; } \ + default: { t = GLP_FX; break; } \ + } \ + glp_set_row_bnds(lp, i, t , AT(b,i-1,1), AT(b,i-1,2)); \ + } \ + for (j=1;j<=n;j++) { \ + switch((int)rint(AT(b,m+j-1,0))) { \ + case 0: { t = GLP_FR; break; } \ + case 1: { t = GLP_LO; break; } \ + case 2: { t = GLP_UP; break; } \ + case 3: { t = GLP_DB; break; } \ + default: { t = GLP_FX; break; } \ + } \ + glp_set_col_bnds(lp, j, t , AT(b,m+j-1,1), AT(b,m+j-1,2)); \ + } \ + glp_term_out(0); \ + glp_##X(lp, NULL); \ + sp[0] = glp_get_status(lp); \ + sp[1] = glp_get_obj_val(lp); \ + for (k=1; k<=n; k++) { \ + sp[k+1] = glp_get_col_prim(lp, k); \ + } \ + glp_delete_prob(lp); \ + free(ia); \ + free(ja); \ + free(ar); \ + \ + return 0; \ + } \ - //printf("%d %d\n",m,n); - - // the first n values - for (k=1;k<=n;k++) { - glp_set_obj_coef(lp, k, AT(c, k-1, 2)); - //printf("%d %f\n",k,AT(c, k-1, 2)); - } - - int * ia = malloc((1+tot)*sizeof(int)); - int * ja = malloc((1+tot)*sizeof(int)); - double * ar = malloc((1+tot)*sizeof(double)); - - for (k=1; k<= tot; k++) { - ia[k] = rint(AT(c,k-1+n,0)); - ja[k] = rint(AT(c,k-1+n,1)); - ar[k] = AT(c,k-1+n,2); - //printf("%d %d %f\n",ia[k],ja[k],ar[k]); - } - glp_load_matrix(lp, tot, ia, ja, ar); - - int t; - for (i=1;i<=m;i++) { - switch((int)rint(AT(b,i-1,0))) { - case 0: { t = GLP_FR; break; } - case 1: { t = GLP_LO; break; } - case 2: { t = GLP_UP; break; } - case 3: { t = GLP_DB; break; } - default: { t = GLP_FX; break; } - } - glp_set_row_bnds(lp, i, t , AT(b,i-1,1), AT(b,i-1,2)); - } - for (j=1;j<=n;j++) { - switch((int)rint(AT(b,m+j-1,0))) { - case 0: { t = GLP_FR; break; } - case 1: { t = GLP_LO; break; } - case 2: { t = GLP_UP; break; } - case 3: { t = GLP_DB; break; } - default: { t = GLP_FX; break; } - } - glp_set_col_bnds(lp, j, t , AT(b,m+j-1,1), AT(b,m+j-1,2)); - } - glp_term_out(0); - glp_simplex(lp, NULL); - sp[0] = glp_get_status(lp); - sp[1] = glp_get_obj_val(lp); - for (k=1; k<=n; k++) { - sp[k+1] = glp_get_col_prim(lp, k); - } - glp_delete_prob(lp); - free(ia); - free(ja); - free(ar); - - return 0; -} +C_X_SPARSE(simplex); +C_X_SPARSE(exact); diff --git a/packages/glpk/src/Numeric/LinearProgramming.hs b/packages/glpk/src/Numeric/LinearProgramming.hs index a54eb59..6a0c47d 100644 --- a/packages/glpk/src/Numeric/LinearProgramming.hs +++ b/packages/glpk/src/Numeric/LinearProgramming.hs @@ -75,6 +75,7 @@ Multiple bounds for a variable are not allowed, instead of module Numeric.LinearProgramming( simplex, + exact, sparseOfGeneral, Optimization(..), Constraints(..), @@ -132,8 +133,8 @@ sparseOfGeneral :: Constraints -> Constraints sparseOfGeneral (General cs) = Sparse $ map (\bl -> let cl = obj bl in - let m = foldr (\(c,t) m -> Map.insertWith (+) t c m) Map.empty cl in - withObj bl (Map.foldrWithKey' (\t c l -> (c#t) : l) [] m)) cs + let cl_unique = foldr (\(c,t) m -> Map.insertWith (+) t c m) Map.empty cl in + withObj bl (Map.foldrWithKey' (\t c l -> (c#t) : l) [] cl_unique)) cs sparseOfGeneral _ = error "sparseOfGeneral: a general system of constraints was expected" simplex :: Optimization -> Constraints -> Bounds -> Solution @@ -156,6 +157,27 @@ simplex opt (Sparse constr) bnds = extract sg sol where simplex opt constr@(General _) bnds = simplex opt (sparseOfGeneral constr) bnds +-- | Simplex method with exact internal arithmetic. See glp_exact in glpk documentation for more information. +exact :: Optimization -> Constraints -> Bounds -> Solution + +exact opt (Dense []) bnds = exact opt (Sparse []) bnds +exact opt (Sparse []) bnds = exact opt (Sparse [Free [0#1]]) bnds +exact opt (General []) bnds = exact opt (Sparse [Free [0#1]]) bnds + +exact opt (Dense constr) bnds = extract sg sol where + sol = exactSparse m n (mkConstrD sz objfun constr) (mkBounds sz constr bnds) + n = length objfun + m = length constr + (sz, sg, objfun) = adapt opt + +exact opt (Sparse constr) bnds = extract sg sol where + sol = exactSparse m n (mkConstrS sz objfun constr) (mkBounds sz constr bnds) + n = length objfun + m = length constr + (sz, sg, objfun) = adapt opt + +exact opt constr@(General _) bnds = exact opt (sparseOfGeneral constr) bnds + adapt :: Optimization -> (Int, Double, [Double]) adapt opt = case opt of Maximize x -> (size x, 1 ,x) @@ -265,6 +287,19 @@ simplexSparse m n c b = unsafePerformIO $ do app3 (c_simplex_sparse (fi m) (fi n)) mat (cmat c) mat (cmat b) vec s "c_simplex_sparse" return s +foreign import ccall unsafe "c_exact_sparse" c_exact_sparse + :: CInt -> CInt -- rows and cols + -> CInt -> CInt -> Ptr Double -- coeffs + -> CInt -> CInt -> Ptr Double -- bounds + -> CInt -> Ptr Double -- result + -> IO CInt -- exit code + +exactSparse :: Int -> Int -> Matrix Double -> Matrix Double -> Vector Double +exactSparse m n c b = unsafePerformIO $ do + s <- createVector (2+n) + app3 (c_exact_sparse (fi m) (fi n)) mat (cmat c) mat (cmat b) vec s "c_exact_sparse" + return s + glpFR, glpLO, glpUP, glpDB, glpFX :: Double glpFR = 0 glpLO = 1 -- cgit v1.2.3 From b73fc0c7e52b92eb66e610f072b224f928df0a4e Mon Sep 17 00:00:00 2001 From: Maxim Baz Date: Sat, 28 Feb 2015 19:14:47 +0100 Subject: GHC 7.11 cannot deduce Fractional and Element instances --- packages/base/src/Data/Packed/Internal/Numeric.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/base/src/Data/Packed/Internal/Numeric.hs b/packages/base/src/Data/Packed/Internal/Numeric.hs index 9adc023..257ad73 100644 --- a/packages/base/src/Data/Packed/Internal/Numeric.hs +++ b/packages/base/src/Data/Packed/Internal/Numeric.hs @@ -241,7 +241,7 @@ instance Container Vector (Complex Float) --------------------------------------------------------------- -instance (Container Vector a) => Container Matrix a +instance (Fractional a, Element a, Container Vector a) => Container Matrix a where size' = size scale' x = liftMatrix (scale' x) -- cgit v1.2.3 From 586373e751c77515147f5c109edca5a700e133dc Mon Sep 17 00:00:00 2001 From: Dominic Steinitz Date: Sun, 1 Mar 2015 08:55:41 +0000 Subject: Add Cholesky to Static. --- packages/base/src/Numeric/LinearAlgebra/Static.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs index 037396d..3398e6a 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Static.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs @@ -52,7 +52,7 @@ module Numeric.LinearAlgebra.Static( linSolve, (<\>), -- * Factorizations svd, withCompactSVD, svdTall, svdFlat, Eigen(..), - withNullspace, qr, + withNullspace, qr, chol, -- * Misc mean, Disp(..), Domain(..), @@ -68,7 +68,7 @@ import Numeric.LinearAlgebra.HMatrix hiding ( row,col,vector,matrix,linspace,toRows,toColumns, (<\>),fromList,takeDiag,svd,eig,eigSH,eigSH', eigenvalues,eigenvaluesSH,eigenvaluesSH',build, - qr,size,app,mul,dot) + qr,size,app,mul,dot,chol) import qualified Numeric.LinearAlgebra.HMatrix as LA import Data.Proxy(Proxy) import Numeric.LinearAlgebra.Static.Internal @@ -306,6 +306,9 @@ instance KnownNat n => Eigen (Sq n) (C n) (M n n) where (l,v) = LA.eig m +chol :: KnownNat n => Sym n -> Sq n +chol (extract . unSym -> m) = mkL $ LA.cholSH m + -------------------------------------------------------------------------------- withNullspace -- cgit v1.2.3 From 0d18936b19a4c2a0317660934f00b4391c98dc09 Mon Sep 17 00:00:00 2001 From: "Thomas M. DuBuisson" Date: Wed, 11 Mar 2015 11:12:27 -0700 Subject: In C99 int32_t is from stdint.h A windows user was complaining about this issue on IRC today, so here's a patch. --- packages/base/src/C/vector-aux.c | 1 + 1 file changed, 1 insertion(+) diff --git a/packages/base/src/C/vector-aux.c b/packages/base/src/C/vector-aux.c index dda47cb..599f69e 100644 --- a/packages/base/src/C/vector-aux.c +++ b/packages/base/src/C/vector-aux.c @@ -13,6 +13,7 @@ typedef float complex TCF; #include #include #include +#include #define MACRO(B) do {B} while (0) #define ERROR(CODE) MACRO(return CODE;) -- cgit v1.2.3 From d58584149a281656f7ba19cc8ab1711de5692268 Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Mon, 16 Mar 2015 10:46:02 +0100 Subject: bump versions and add thanks --- packages/base/THANKS.md | 9 ++++++++- packages/base/hmatrix.cabal | 2 +- packages/glpk/hmatrix-glpk.cabal | 2 +- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/packages/base/THANKS.md b/packages/base/THANKS.md index e88b516..a4188eb 100644 --- a/packages/base/THANKS.md +++ b/packages/base/THANKS.md @@ -159,7 +159,8 @@ module reorganization, monadic mapVectorM, and many other improvements. - Denis Laxalde separated the gsl tests from the base ones. -- Dominic Steinitz (idontgetoutmuch) reported a bug in the static diagonal creation functions. +- Dominic Steinitz (idontgetoutmuch) reported a bug in the static diagonal creation functions and + added Cholesky to Static. - Dylan Thurston reported an error in the glpk documentation and ambiguity in the description of linearSolve. @@ -183,3 +184,9 @@ module reorganization, monadic mapVectorM, and many other improvements. - Ben Gamari contributed fixes for ghc 7.10 +- Piotr Mardziel added general sparse constraints to simplex and the interface to glp_exact + +- Maxim Baz fixed an instance declaration for ghc 7.11 + +- Thomas M. DuBuisson fixed a C include file. + diff --git a/packages/base/hmatrix.cabal b/packages/base/hmatrix.cabal index 3563a2f..3895dc1 100644 --- a/packages/base/hmatrix.cabal +++ b/packages/base/hmatrix.cabal @@ -1,5 +1,5 @@ Name: hmatrix -Version: 0.16.1.4 +Version: 0.16.1.5 License: BSD3 License-file: LICENSE Author: Alberto Ruiz diff --git a/packages/glpk/hmatrix-glpk.cabal b/packages/glpk/hmatrix-glpk.cabal index a9859f9..5a1b59c 100644 --- a/packages/glpk/hmatrix-glpk.cabal +++ b/packages/glpk/hmatrix-glpk.cabal @@ -1,5 +1,5 @@ Name: hmatrix-glpk -Version: 0.4.0.2 +Version: 0.4.1.0 License: GPL License-file: LICENSE Author: Alberto Ruiz -- cgit v1.2.3 From 8d7c921bdff0d57a4579d3de71cd5ba3bf5276a1 Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Tue, 31 Mar 2015 13:35:05 +0200 Subject: partial fix for examples/inplace.hs --- examples/inplace.hs | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/examples/inplace.hs b/examples/inplace.hs index dcfff56..574aa44 100644 --- a/examples/inplace.hs +++ b/examples/inplace.hs @@ -1,9 +1,8 @@ -- some tests of the interface for pure -- computations with inplace updates -import Numeric.LinearAlgebra -import Data.Packed.ST -import Data.Packed.Convert +import Numeric.LinearAlgebra.HMatrix +import Numeric.LinearAlgebra.Devel import Data.Array.Unboxed import Data.Array.ST @@ -15,15 +14,13 @@ main = sequence_[ print test2, print test3, print test4, - test5, - test6, - print test7, +-- test5, +-- test6, +-- print test7, test8, test0] --- helper functions -vector l = fromList l :: Vector Double -norm v = pnorm PNorm2 v + -- hmatrix vector and matrix v = vector [1..10] @@ -34,16 +31,16 @@ m = (5><10) [1..50::Double] -- vector creation by in-place updates on a copy of the argument test1 = fun v -fun :: Element t => Vector t -> Vector t +-- fun :: (Num t, Element t, Container) => Vector t -> Vector t fun x = runSTVector $ do a <- thawVector x - mapM_ (flip (modifyVector a) (+57)) [0 .. dim x `div` 2 - 1] + mapM_ (flip (modifyVector a) (+57)) [0 .. size x `div` 2 - 1] return a -- another example: creation of an antidiagonal matrix from a list test2 = antiDiag 5 8 [1..] :: Matrix Double -antiDiag :: (Element b) => Int -> Int -> [b] -> Matrix b +-- antiDiag :: (Element b) => Int -> Int -> [b] -> Matrix b antiDiag r c l = runSTMatrix $ do m <- newMatrix 0 r c let d = min r c - 1 @@ -55,21 +52,23 @@ test3 = g1 v g1 x = runST $ do a <- thawVector x - writeVector a (dim x -1) 0 + writeVector a (size x -1) 0 b <- freezeVector a - return (norm b) + return (norm_2 b) -- another possibility: test4 = g2 v g2 x = runST $ do a <- thawVector x - writeVector a (dim x -1) 0 - t <- liftSTVector norm a + writeVector a (size x -1) 0 + t <- liftSTVector norm_2 a return t -------------------------------------------------------------- +{- + -- haskell arrays hv = listArray (0,9) [1..10::Double] hm = listArray ((0,0),(4,9)) [1..50::Double] @@ -78,8 +77,8 @@ hm = listArray ((0,0),(4,9)) [1..50::Double] -- conversion from standard Haskell arrays test5 = do - print $ norm (vectorFromArray hv) - print $ norm v + print $ norm_2 (vectorFromArray hv) + print $ norm_2 v print $ rcond (matrixFromArray hm) print $ rcond m @@ -101,10 +100,11 @@ test7 = unitary (listArray (1,4) [3,5,7,2] :: UArray Int Double) unitary v = runSTUArray $ do a <- thaw v - n <- norm `fmap` vectorFromMArray a + n <- norm_2 `fmap` vectorFromMArray a b <- mapArray (/n) a return b +-} ------------------------------------------------- -- (just to check that they are not affected) @@ -150,3 +150,4 @@ test8 = do print $ histoCheck2 ds print $ histoCheck2 ds putStrLn "----------------------" + -- cgit v1.2.3