├── examples ├── Setup.hs ├── ChangeLog.md ├── data.txt ├── deriv.hs ├── plot.hs ├── error.hs ├── devel │ └── example │ │ ├── functions.c │ │ └── wrappers.hs ├── pinv.hs ├── integrate.hs ├── fitting.hs ├── random.hs ├── examples.cabal ├── root.hs ├── parallel.hs ├── VectorShow.hs ├── lie.hs ├── ButcherTableau.hs ├── minimize.hs ├── ode.hs ├── kalman.hs ├── pca1.hs ├── LICENSE ├── bool.hs ├── sundials.hs ├── pca2.hs ├── multiply.hs ├── repmat.ipynb ├── monadic.hs └── inplace.hs ├── packages ├── gsl │ ├── THANKS.md │ ├── Setup.lhs │ ├── CHANGELOG │ ├── src │ │ └── Numeric │ │ │ ├── GSL.hs │ │ │ └── GSL │ │ │ ├── Fourier.hs │ │ │ ├── IO.hs │ │ │ ├── Polynomials.hs │ │ │ ├── Random.hs │ │ │ ├── Differentiation.hs │ │ │ ├── Internal.hs │ │ │ ├── Vector.hs │ │ │ └── LinearAlgebra.hs │ └── hmatrix-gsl.cabal ├── tests │ ├── CHANGES │ ├── src │ │ ├── Benchmark.hs │ │ ├── TestGSL.hs │ │ └── TestBase.hs │ ├── Setup.lhs │ ├── LICENSE │ └── hmatrix-tests.cabal ├── special │ ├── CHANGES │ ├── Setup.lhs │ ├── lib │ │ └── Numeric │ │ │ └── GSL │ │ │ ├── Special │ │ │ ├── replace.hs │ │ │ ├── Dawson.hs │ │ │ ├── Clausen.hs │ │ │ ├── Pow_int.hs │ │ │ ├── autoall.sh │ │ │ ├── Elljac.hs │ │ │ ├── Elementary.hs │ │ │ ├── Lambert.hs │ │ │ ├── Synchrotron.hs │ │ │ ├── Dilog.hs │ │ │ ├── Transport.hs │ │ │ ├── Laguerre.hs │ │ │ ├── Log.hs │ │ │ ├── Erf.hs │ │ │ ├── Gegenbauer.hs │ │ │ ├── Debye.hs │ │ │ ├── Psi.hs │ │ │ ├── Zeta.hs │ │ │ ├── Internal.hsc │ │ │ ├── Coulomb.hs │ │ │ ├── Coupling.hs │ │ │ ├── Exp.hs │ │ │ └── Fermi_dirac.hs │ │ │ └── Special.hs │ └── hmatrix-special.cabal ├── glpk │ ├── Setup.lhs │ ├── examples │ │ ├── simplex1.hs │ │ ├── simplex2.hs │ │ ├── simplex3.hs │ │ ├── simplex4.hs │ │ └── simplex5.hs │ ├── hmatrix-glpk.cabal │ └── src │ │ ├── Numeric │ │ └── LinearProgramming │ │ │ └── L1.hs │ │ └── C │ │ └── glpk.c ├── base │ ├── Setup.lhs │ ├── stack.yaml │ ├── default.nix │ ├── src │ │ ├── Numeric │ │ │ ├── LinearAlgebra │ │ │ │ ├── HMatrix.hs │ │ │ │ ├── Devel.hs │ │ │ │ └── Data.hs │ │ │ └── Matrix.hs │ │ └── Internal │ │ │ ├── Random.hs │ │ │ ├── Conversion.hs │ │ │ ├── Devel.hs │ │ │ ├── C │ │ │ └── lapack-aux.h │ │ │ └── Convolution.hs │ ├── LICENSE │ └── hmatrix.cabal ├── sparse │ ├── Setup.lhs │ ├── src │ │ └── Numeric │ │ │ └── LinearAlgebra │ │ │ ├── Sparse.hs │ │ │ └── sparse.c │ ├── hmatrix-sparse.cabal │ └── LICENSE ├── README └── Makefile ├── nixpkgs.nix ├── .github └── workflows │ └── main.yml ├── .gitignore ├── stack.yaml ├── release.nix ├── shell.nix ├── stack.yaml.lock ├── docs └── SUNDIALS.md └── README.md /examples/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /packages/gsl/THANKS.md: -------------------------------------------------------------------------------- 1 | 2 | See the THANKS file of the hmatrix package. 3 | 4 | -------------------------------------------------------------------------------- /packages/tests/CHANGES: -------------------------------------------------------------------------------- 1 | 0.1 2 | === 3 | 4 | Created a separate testing package. 5 | 6 | -------------------------------------------------------------------------------- /packages/tests/src/Benchmark.hs: -------------------------------------------------------------------------------- 1 | import Numeric.LinearAlgebra.Tests 2 | 3 | main = runBenchmarks 4 | -------------------------------------------------------------------------------- /packages/special/CHANGES: -------------------------------------------------------------------------------- 1 | 0.1.1 2 | ===== 3 | 4 | Added a few complex functions and mkComplex_e 5 | 6 | -------------------------------------------------------------------------------- /packages/tests/src/TestGSL.hs: -------------------------------------------------------------------------------- 1 | import Numeric.GSL.Tests 2 | 3 | main :: IO () 4 | main = runTests 20 5 | -------------------------------------------------------------------------------- /packages/glpk/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/tests/src/TestBase.hs: -------------------------------------------------------------------------------- 1 | import Numeric.LinearAlgebra.Tests 2 | 3 | main :: IO () 4 | main = runTests 20 5 | -------------------------------------------------------------------------------- /packages/base/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | 6 | -------------------------------------------------------------------------------- /packages/gsl/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | 6 | -------------------------------------------------------------------------------- /packages/sparse/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/special/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | -------------------------------------------------------------------------------- /packages/tests/Setup.lhs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env runhaskell 2 | 3 | > import Distribution.Simple 4 | > main = defaultMain 5 | 6 | -------------------------------------------------------------------------------- /nixpkgs.nix: -------------------------------------------------------------------------------- 1 | import (fetchTarball "https://github.com/nixos/nixpkgs/archive/f93d4b6181f5c28b20d63a4d76e182511369c1bf.tar.gz") 2 | -------------------------------------------------------------------------------- /packages/README: -------------------------------------------------------------------------------- 1 | The package "sparse" depends on MKL but it is not needed by the other packages, 2 | it is only intended for testing. 3 | 4 | -------------------------------------------------------------------------------- /packages/base/stack.yaml: -------------------------------------------------------------------------------- 1 | flags: 2 | hmatrix: 3 | openblas: false 4 | packages: 5 | - '.' 6 | extra-deps: [] 7 | resolver: lts-13.21 8 | 9 | -------------------------------------------------------------------------------- /examples/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for hmatrix-examples 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /examples/data.txt: -------------------------------------------------------------------------------- 1 | 0.9 1.1 2 | 2.1 3.9 3 | 3.1 9.2 4 | 4.0 51.8 5 | 4.9 25.3 6 | 6.1 35.7 7 | 7.0 49.4 8 | 7.9 3.6 9 | 9.1 81.5 10 | 10.2 99.5 -------------------------------------------------------------------------------- /examples/deriv.hs: -------------------------------------------------------------------------------- 1 | -- Numerical differentiation 2 | 3 | import Numeric.GSL 4 | 5 | d :: (Double -> Double) -> (Double -> Double) 6 | d f x = fst $ derivCentral 0.01 f x 7 | 8 | main = print $ d (\x-> x * d (\y-> x+y) 1) 1 9 | -------------------------------------------------------------------------------- /packages/gsl/CHANGELOG: -------------------------------------------------------------------------------- 1 | 0.17.0.0 2 | -------- 3 | 4 | * Added interpolation modules 5 | 6 | * Added simulated annealing module 7 | 8 | * Added odeSolveVWith 9 | 10 | 0.16.0.0 11 | -------- 12 | 13 | * The modules Numeric.GSL.* have been moved from hmatrix to the new package hmatrix-gsl. 14 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: "Test" 2 | on: 3 | pull_request: 4 | push: 5 | jobs: 6 | tests: 7 | runs-on: ubuntu-latest 8 | steps: 9 | - uses: actions/checkout@v2.3.4 10 | - uses: cachix/install-nix-action@v12 11 | with: 12 | nix_path: nixpkgs=channel:nixos-unstable 13 | - run: nix-build release.nix 14 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _darcs 2 | dist 3 | experiments 4 | examples/session 5 | examples/mnist.txt 6 | examples/candidates 7 | material 8 | doc.sh 9 | 10 | *.o 11 | *.hi 12 | *.chi 13 | *.chs.h 14 | 15 | push.sh 16 | index.html 17 | title.md 18 | 19 | /base-reinstall.sh 20 | .cabal-sandbox 21 | cabal.sandbox.config 22 | 23 | # The Haskell Tool Stack-related 24 | .stack-work 25 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/replace.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | 3 | import Data.List(isPrefixOf) 4 | import System.Environment(getArgs) 5 | 6 | rep (c,r) [] = [] 7 | rep (c,r) f@(x:xs) 8 | | c `isPrefixOf` f = r ++ rep (c,r) (drop (length c) f) 9 | | otherwise = x:(rep (c,r) xs) 10 | 11 | main = do 12 | args <- getArgs 13 | let [p',r'] = map (rep ("\\n","\n")) args 14 | interact $ rep (p',r') 15 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: 2 | hmatrix-special: 3 | safe-cheap: false 4 | hmatrix-tests: 5 | gsl: true 6 | hmatrix: 7 | openblas: false 8 | hmatrix-gsl: 9 | onlygsl: false 10 | packages: 11 | - packages/tests/ 12 | - packages/special/ 13 | - packages/gsl/ 14 | - packages/glpk/ 15 | - packages/base/ 16 | - examples/ 17 | extra-deps: 18 | - diagrams-rasterific-1.4 19 | - plots-0.1.0.2 20 | resolver: lts-10.9 21 | nix: 22 | path: [nixpkgs=./nixpkgs.nix] 23 | shell-file: shell.nix 24 | -------------------------------------------------------------------------------- /examples/plot.hs: -------------------------------------------------------------------------------- 1 | import Numeric.LinearAlgebra 2 | import Graphics.Plot 3 | import Numeric.GSL.Special(erf_Z, erf) 4 | 5 | sombrero n = f x y where 6 | (x,y) = meshdom range range 7 | range = linspace n (-2,2) 8 | f x y = exp (-r2) * cos (2*r2) where 9 | r2 = x*x+y*y 10 | 11 | f x = sin x + 0.5 * sin (5*x) 12 | 13 | gaussianPDF = erf_Z 14 | cumdist x = 0.5 * (1+ erf (x/sqrt 2)) 15 | 16 | main = do 17 | let x = linspace 1000 (-4,4) 18 | mplot [f x] 19 | mplot [x, cmap cumdist x, cmap gaussianPDF x] 20 | mesh (sombrero 40) 21 | -------------------------------------------------------------------------------- /packages/glpk/examples/simplex1.hs: -------------------------------------------------------------------------------- 1 | -- first example in glpk manual 2 | 3 | import Numeric.LinearProgramming 4 | 5 | objFun = Maximize [10, 6, 4] 6 | 7 | constr = Dense [ [1,1,1] :<=: 100 8 | , [10,4,5] :<=: 600 9 | , [2,2,6] :<=: 300 ] 10 | 11 | -- default bounds 12 | bnds = [ 1 :>=: 0 13 | , 2 :>=: 0 14 | , 3 :>=: 0 ] 15 | 16 | main = do 17 | print $ simplex objFun constr [] 18 | print $ simplex objFun constr bnds 19 | print $ simplex objFun constr [Free 3] 20 | print $ simplex objFun constr [ 2 :<=: 50 ] 21 | -------------------------------------------------------------------------------- /examples/error.hs: -------------------------------------------------------------------------------- 1 | import Numeric.GSL 2 | import Numeric.GSL.Special 3 | import Numeric.LinearAlgebra 4 | import Prelude hiding (catch) 5 | import Control.Exception 6 | 7 | test x = catch 8 | (print x) 9 | (\e -> putStrLn $ "captured ["++ show (e :: SomeException) ++"]") 10 | 11 | 12 | main = do 13 | setErrorHandlerOff 14 | 15 | test $ log_e (-1) 16 | test $ 5 + (fst.exp_e) 1000 17 | test $ bessel_zero_Jnu_e (-0.3) 2 18 | 19 | test $ (inv 0 :: Matrix Double) 20 | test $ (linearSolveLS 5 (sqrt (-1)) :: Matrix Double) 21 | 22 | putStrLn "Bye" 23 | 24 | -------------------------------------------------------------------------------- /examples/devel/example/functions.c: -------------------------------------------------------------------------------- 1 | 2 | typedef struct { double r, i; } doublecomplex; 3 | 4 | #define VEC(T,A) int A##n, T* A##p 5 | #define MAT(T,A) int A##r, int A##c, int A##Xr, int A##Xc, T* A##p 6 | 7 | #define AT(m,i,j) (m##p[(i)*m##Xr + (j)*m##Xc]) 8 | #define TRAV(m,i,j) int i,j; for (i=0;i Vector R -> Matrix R 5 | expand n x = fromColumns $ map (x^) [0 .. n] 6 | 7 | polynomialModel :: Vector R -> Vector R -> Int 8 | -> (Vector R -> Vector R) 9 | polynomialModel x y n = f where 10 | f z = expand n z #> ws 11 | ws = expand n x <\> y 12 | 13 | main = do 14 | [x,y] <- toColumns <$> loadMatrix "data.txt" 15 | let pol = polynomialModel x y 16 | let view = [x, y, pol 1 x, pol 2 x, pol 3 x] 17 | putStrLn $ " x y p 1 p 2 p 3" 18 | putStrLn $ format " " (printf "%.2f") $ fromColumns view 19 | 20 | -------------------------------------------------------------------------------- /packages/glpk/examples/simplex2.hs: -------------------------------------------------------------------------------- 1 | import Numeric.LinearProgramming 2 | 3 | prob = Maximize [4, -3, 2] 4 | 5 | constr1 = Sparse [ [2#1, 1#2] :<=: 10 6 | , [1#2, 5#3] :<=: 20 7 | ] 8 | 9 | constr2 = Dense [ [2,1,0] :<=: 10 10 | , [0,1,5] :<=: 20 11 | ] 12 | 13 | constr3 = General [ [1#1, 1#1, 1#2] :<=: 10 14 | , [1#2, 5#3] :<=: 20 15 | ] 16 | 17 | main = do 18 | print $ simplex prob constr1 [] 19 | print $ simplex prob constr2 [] 20 | print $ simplex prob constr3 [] 21 | print $ simplex prob constr2 [ 2 :>=: 1, 3 :&: (2,7)] 22 | print $ simplex prob constr2 [ Free 2 ] 23 | 24 | -------------------------------------------------------------------------------- /examples/integrate.hs: -------------------------------------------------------------------------------- 1 | -- Numerical integration 2 | import Numeric.GSL 3 | 4 | quad f a b = fst $ integrateQAGS 1E-9 100 f a b 5 | 6 | -- A multiple integral can be easily defined using partial application 7 | quad2 f y1 y2 g1 g2 = quad h y1 y2 8 | where 9 | h y = quad (flip f y) (g1 y) (g2 y) 10 | 11 | volSphere r = 8 * quad2 (\x y -> sqrt (r*r-x*x-y*y)) 12 | 0 r (const 0) (\x->sqrt (r*r-x*x)) 13 | 14 | -- wikipedia example 15 | exw = quad2 f 7 10 (const 11) (const 14) 16 | where 17 | f x y = x**2 + 4*y 18 | 19 | main = do 20 | print $ quad (\x -> 4/(x^2+1)) 0 1 21 | print pi 22 | print $ volSphere 2.5 23 | print $ 4/3*pi*2.5**3 24 | print $ exw 25 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import {} }: 2 | let p = nixpkgs; in 3 | 4 | let 5 | myStack = p.writeShellScriptBin "stack" '' 6 | exec ${p.stack}/bin/stack --no-nix --no-docker --system-ghc $STACK_IN_NIX_EXTRA_ARGS "$@" 7 | ''; 8 | in 9 | p.haskell.lib.buildStackProject { 10 | name = "hmatrix"; 11 | 12 | buildInputs = [ 13 | p.zlib 14 | p.sundials 15 | p.blas 16 | p.gfortran.cc 17 | p.liblapack 18 | p.gsl 19 | p.glpk 20 | p.pkgconfig 21 | p.stack 22 | p.sundials 23 | myStack 24 | ] ++ (if p.stdenv.isDarwin then [p.darwin.apple_sdk.frameworks.Accelerate] else []) 25 | ++ (if p.stdenv.isDarwin then [p.darwin.apple_sdk.frameworks.Cocoa] else []); 26 | } 27 | -------------------------------------------------------------------------------- /examples/fitting.hs: -------------------------------------------------------------------------------- 1 | -- nonlinear least-squares fitting 2 | 3 | import Numeric.GSL.Fitting 4 | import Numeric.LinearAlgebra 5 | 6 | xs = map return [0 .. 39] 7 | sigma = 0.1 8 | ys = map return $ toList $ fromList (map (head . expModel [5,0.1,1]) xs) 9 | + scalar sigma * (randomVector 0 Gaussian 40) 10 | 11 | dat :: [([Double],([Double],Double))] 12 | 13 | dat = zip xs (zip ys (repeat sigma)) 14 | 15 | expModel [a,lambda,b] [t] = [a * exp (-lambda * t) + b] 16 | 17 | expModelDer [a,lambda,b] [t] = [[exp (-lambda * t), -t * a * exp(-lambda*t) , 1]] 18 | 19 | (sol,path) = fitModelScaled 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0] 20 | 21 | main = do 22 | print dat 23 | print path 24 | print sol 25 | -------------------------------------------------------------------------------- /examples/random.hs: -------------------------------------------------------------------------------- 1 | import System.Random.MWC 2 | import qualified System.Random.MWC.Distributions as D 3 | import Numeric.LinearAlgebra 4 | import Numeric.LinearAlgebra.Devel 5 | 6 | rvec :: Vector Double 7 | rvec = runSTVector $ do 8 | v <- newUndefinedVector 10 9 | g <- initialize (fromList [4, 8, 15, 16, 23, 42]) 10 | mapM_ (\k -> writeVector v k =<< D.standard g) [0..9] 11 | return v 12 | 13 | 14 | main = do 15 | v <- withSystemRandom . asGenST $ \gen -> uniformVector gen 20 16 | print (v :: Vector Double) 17 | 18 | g <- initialize (fromList [4, 8, 15, 16, 23, 42]) 19 | x <- uniform g :: IO Double 20 | print x 21 | print =<< (uniform g :: IO Double) 22 | print =<< (uniformVector g 20 :: IO (Vector Double)) 23 | 24 | -------------------------------------------------------------------------------- /examples/examples.cabal: -------------------------------------------------------------------------------- 1 | name: examples 2 | version: 0.20.0.0 3 | synopsis: Example usage of the various hmatrix packages 4 | homepage: https://github.com/albertoruiz/hmatrix 5 | license: BSD3 6 | license-file: LICENSE 7 | author: Dominic Steinitz 8 | maintainer: dominic@steinitz.org 9 | copyright: Dominic Steinitz, Novadiscovery 10 | category: Math 11 | build-type: Simple 12 | extra-source-files: ChangeLog.md 13 | cabal-version: >=1.10 14 | 15 | executable vectorShow 16 | main-is: VectorShow.hs 17 | build-depends: base >=4.10 && <5, 18 | hmatrix, 19 | hmatrix-gsl 20 | default-language: Haskell2010 21 | -------------------------------------------------------------------------------- /packages/base/default.nix: -------------------------------------------------------------------------------- 1 | { mkDerivation, array, base, binary, bytestring, darwin, deepseq 2 | , openblasCompat, primitive, random, semigroups, split, stdenv 3 | , storable-complex, vector 4 | }: 5 | mkDerivation { 6 | pname = "hmatrix"; 7 | version = "0.20.2"; 8 | src = ./.; 9 | configureFlags = [ "-fdisable-default-paths" "-fopenblas" ]; 10 | libraryHaskellDepends = [ 11 | array base binary bytestring deepseq primitive random semigroups 12 | split storable-complex vector 13 | ]; 14 | buildDepends = [ (if stdenv.isDarwin then [darwin.apple_sdk.frameworks.Accelerate] else []) ]; 15 | librarySystemDepends = [ openblasCompat ]; 16 | homepage = "https://github.com/haskell-numerics/hmatrix"; 17 | description = "Numeric Linear Algebra"; 18 | license = stdenv.lib.licenses.bsd3; 19 | } 20 | -------------------------------------------------------------------------------- /examples/root.hs: -------------------------------------------------------------------------------- 1 | -- root finding examples 2 | import Numeric.GSL 3 | import Numeric.LinearAlgebra 4 | import Text.Printf(printf) 5 | 6 | rosenbrock a b [x,y] = [ a*(1-x), b*(y-x^2) ] 7 | 8 | test method = do 9 | print method 10 | let (s,p) = root method 1E-7 30 (rosenbrock 1 10) [-10,-5] 11 | print s -- solution 12 | disp' p -- evolution of the algorithm 13 | 14 | jacobian a b [x,y] = [ [-a , 0] 15 | , [-2*b*x, b] ] 16 | 17 | testJ method = do 18 | print method 19 | let (s,p) = rootJ method 1E-7 30 (rosenbrock 1 10) (jacobian 1 10) [-10,-5] 20 | print s 21 | disp' p 22 | 23 | disp' = putStrLn . format " " (printf "%.3f") 24 | 25 | main = do 26 | test Hybrids 27 | test Hybrid 28 | test DNewton 29 | test Broyden 30 | 31 | mapM_ testJ [HybridsJ .. GNewton] 32 | -------------------------------------------------------------------------------- /packages/Makefile: -------------------------------------------------------------------------------- 1 | pkgs=base gsl special glpk tests ../../hTensor ../../easyVision/packages/tools ../../easyVision/packages/base 2 | 3 | mkl=--extra-include-dirs=$(MKL) --extra-lib-dirs=$(MKL) 4 | 5 | cabalcmd = \ 6 | for p in $(1); do \ 7 | if [ -e $$p ]; then \ 8 | cd $$p; cabal $(2) ; cd -; \ 9 | fi; \ 10 | done; \ 11 | cd sparse; \ 12 | cabal $(3) $(2); cd -; 13 | 14 | 15 | all: 16 | $(call cabalcmd, $(pkgs), install --force-reinstall --enable-documentation, $(mkl)) 17 | 18 | fast: 19 | $(call cabalcmd, $(pkgs), install --force-reinstall, $(mkl)) 20 | 21 | clean: 22 | $(call cabalcmd, $(pkgs), clean) 23 | 24 | prof: 25 | $(call cabalcmd, $(pkgs), install --force-reinstall --enable-library-profiling, $(mkl)) 26 | 27 | -------------------------------------------------------------------------------- /packages/glpk/examples/simplex3.hs: -------------------------------------------------------------------------------- 1 | -- compare with 2 | -- $ glpsol --cpxlp /usr/share/doc/glpk-utils/examples/plan.lp -o result.txt 3 | 4 | import Numeric.LinearProgramming 5 | 6 | prob = Minimize [0.03, 0.08, 0.17, 0.12, 0.15, 0.21, 0.38] 7 | 8 | constr = Dense 9 | [ [1,1,1,1,1,1,1] :==: 2000 10 | , [0.15, 0.04, 0.02, 0.04, 0.2,0.01, 0.03] :<=: 60 11 | , [0.03, 0.05, 0.08, 0.02, 0.06, 0.01, 0] :<=: 100 12 | , [0.02, 0.04, 0.01, 0.02, 0.02, 0, 0] :<=: 40 13 | , [0.02, 0.03, 0, 0, 0.01, 0, 0] :<=: 30 14 | , [0.7, 0.75, 0.8, 0.75, 0.8, 0.97, 0] :>=: 1500 15 | , [0.02, 0.06, 0.08, 0.12, 0.02, 0.01, 0.97] :&: (250,300) 16 | ] 17 | 18 | bounds = [ 1 :&: (0,200) 19 | , 2 :&: (0,2500) 20 | , 3 :&: (400,800) 21 | , 4 :&: (100,700) 22 | , 5 :&: (0,1500) ] 23 | 24 | main = print $ simplex prob constr bounds 25 | 26 | -------------------------------------------------------------------------------- /examples/parallel.hs: -------------------------------------------------------------------------------- 1 | -- $ ghc --make -O -rtsopts -threaded parallel.hs 2 | -- $ ./parallel 3000 +RTS -N4 -s -A200M 3 | 4 | import System.Environment(getArgs) 5 | import Numeric.LinearAlgebra 6 | import Control.Parallel.Strategies 7 | import System.Time 8 | 9 | inParallel = parMap rwhnf id 10 | 11 | -- matrix product decomposed into p parallel subtasks 12 | parMul p x y = fromBlocks [ inParallel ( map (x <>) ys ) ] 13 | where [ys] = toBlocksEvery (rows y) (cols y `div` p) y 14 | 15 | main = do 16 | n <- (read . head) `fmap` getArgs 17 | let m = ident n :: Matrix Double 18 | time $ print $ maxElement $ takeDiag $ m <> m 19 | time $ print $ maxElement $ takeDiag $ parMul 2 m m 20 | time $ print $ maxElement $ takeDiag $ parMul 4 m m 21 | time $ print $ maxElement $ takeDiag $ parMul 8 m m 22 | 23 | time act = do 24 | t0 <- getClockTime 25 | act 26 | t1 <- getClockTime 27 | print $ tdSec $ normalizeTimeDiff $ diffClockTimes t1 t0 28 | 29 | -------------------------------------------------------------------------------- /examples/VectorShow.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | 3 | module Main 4 | ( main 5 | ) where 6 | 7 | import Numeric.LinearAlgebra.Static 8 | import qualified Numeric.LinearAlgebra as LA 9 | import qualified Numeric.GSL.Minimization as Min 10 | 11 | u :: R 4 12 | u = vec4 10 20 30 40 13 | 14 | v :: R 5 15 | v = vec2 5 0 & 0 & 3 & 7 16 | 17 | b :: L 4 3 18 | b = matrix 19 | [ 2, 0,-1 20 | , 1, 1, 7 21 | , 5, 3, 1 22 | , 2, 8, 0 ] :: L 4 3 23 | 24 | w :: R 10 25 | w = vector [1..10] :: R 10 26 | 27 | f :: [Double] -> Double 28 | f [x,y] = 10*(x-1)^(2::Int) + 20*(y-2)^(2::Int) + 30 29 | f _ = error "f only defined for exactly 2 elements" 30 | 31 | main :: IO () 32 | main = do 33 | print u 34 | print v 35 | print b 36 | print w 37 | print $ diag u 38 | print (eye + 2 :: Sq 4) 39 | print $ LA.diag (LA.fromList [1,2,3 :: Double]) 40 | -- 41 | let (s,p) = Min.minimize Min.NMSimplex2 1E-2 30 [1,1] f [5,7] 42 | print s 43 | print p 44 | -------------------------------------------------------------------------------- /packages/glpk/examples/simplex4.hs: -------------------------------------------------------------------------------- 1 | -- compare with 2 | -- $ glpsol --cpxlp /usr/share/doc/glpk-utils/examples/plan.lp -o result.txt 3 | 4 | import Numeric.LinearProgramming 5 | 6 | prob = Minimize [0.03, 0.08, 0.17, 0.12, 0.15, 0.21, 0.38] 7 | 8 | constr = Sparse 9 | [ [1#1,1#2,1#3,1#4,1#5,1#6,1#7] :==: 2000 10 | , [0.15#1, 0.04#2, 0.02#3, 0.04#4, 0.2#5,0.01#6, 0.03#7] :<=: 60 11 | , [0.03#1, 0.05#2, 0.08#3, 0.02#4, 0.06#5, 0.01#6] :<=: 100 12 | , [0.02#1, 0.04#2, 0.01#3, 0.02#4, 0.02#5] :<=: 40 13 | , [0.02#1, 0.03#2, 0.01#5] :<=: 30 14 | , [0.7#1, 0.75#2, 0.8#3, 0.75#4, 0.8#5, 0.97#6] :>=: 1500 15 | , [0.02#1, 0.06#2, 0.08#3, 0.12#4, 0.02#5, 0.01#6, 0.97#7] :&: (250,300) 16 | ] 17 | 18 | bounds = [ 1 :&: (0,200) 19 | , 2 :&: (0,2500) 20 | , 3 :&: (400,800) 21 | , 4 :&: (100,700) 22 | , 5 :&: (0,1500) ] 23 | 24 | main = print $ simplex prob constr bounds 25 | 26 | -------------------------------------------------------------------------------- /packages/glpk/examples/simplex5.hs: -------------------------------------------------------------------------------- 1 | import Numeric.LinearProgramming 2 | 3 | -- This is a linear program from the paper "Picking vs. Guessing Secrets: A Game-theoretic Analysis" 4 | 5 | gamma = 100000 :: Double 6 | sigma = 1 :: Double 7 | n = 64 :: Int 8 | cost_fun :: Int -> Double 9 | cost_fun i = (fromIntegral i) / (fromIntegral n) 10 | size_fun :: Int -> Double 11 | size_fun i = 2^(fromIntegral i) 12 | 13 | prob = Minimize $ map cost_fun [1..n] 14 | bnds = [i :&: (0,1) | i <- [1..n]] 15 | 16 | constr1 = [[1 # i | i <- [1..n]] :==: 1] ++ 17 | [[1/(size_fun i) # i, 18 | -1/(size_fun (i+1)) # i+1] :>=: 0 | i <- [1..n-1]] ++ 19 | [( 20 | [gamma#i | i <- [1..k]] ++ 21 | (concat [[sigma*(size_fun i) # j | j <- [1..i-1]] | i <- [1..k]]) ++ 22 | [((size_fun i) - 1)/2 # i | i <- [1..k]]) 23 | :<=: (sigma * (foldr (+) 0 (map size_fun [1..k]))) | k <- [1..n]] 24 | 25 | main = do 26 | print $ simplex prob (General constr1) bnds -- NoFeasible 27 | print $ exact prob (General constr1) bnds -- solution found 28 | -------------------------------------------------------------------------------- /packages/sparse/src/Numeric/LinearAlgebra/Sparse.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | 5 | 6 | module Numeric.LinearAlgebra.Sparse ( 7 | dss 8 | ) where 9 | 10 | import Foreign.C.Types(CInt(..)) 11 | import Numeric.LinearAlgebra.Devel 12 | import System.IO.Unsafe(unsafePerformIO) 13 | import Foreign(Ptr) 14 | import Numeric.LinearAlgebra.HMatrix 15 | import Text.Printf 16 | import Control.Monad(when) 17 | 18 | (???) :: Bool -> String -> IO () 19 | infixl 0 ??? 20 | c ??? msg = when c (error msg) 21 | 22 | type IV t = CInt -> Ptr CInt -> t 23 | type V t = CInt -> Ptr Double -> t 24 | type SMxV = V (IV (IV (V (V (IO CInt))))) 25 | 26 | dss :: CSR -> Vector Double -> Vector Double 27 | dss CSR{..} b = unsafePerformIO $ do 28 | size b /= csrNRows ??? printf "dss: incorrect sizes: (%d,%d) x %d" csrNRows csrNCols (size b) 29 | r <- createVector csrNCols 30 | c_dss `apply` csrVals `apply` csrCols `apply` csrRows `apply` b `apply` r #|"dss" 31 | return r 32 | 33 | foreign import ccall unsafe "dss" 34 | c_dss :: SMxV 35 | 36 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: diagrams-rasterific-1.4@sha256:725c29db134366d2c1e5e95b5e5f1ed6f364f04753e906773a81f84447709078,2027 9 | pantry-tree: 10 | size: 1212 11 | sha256: 3b0c20d9f5cb8e431c7b2b884a7089c3b0b1189810f89780a785c3de64e03f09 12 | original: 13 | hackage: diagrams-rasterific-1.4 14 | - completed: 15 | hackage: plots-0.1.0.2@sha256:3d45b5b973339a50d0686153d77b0f1e438c1a890e75c2274830e878e9fd78d8,2131 16 | pantry-tree: 17 | size: 5210 18 | sha256: ff47de4b79b97c735f5cc75ae52a32db807f94a1bd4f2324be9816d5a34f612d 19 | original: 20 | hackage: plots-0.1.0.2 21 | snapshots: 22 | - completed: 23 | size: 569315 24 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/10/9.yaml 25 | sha256: c85a3b35a7c2fa3771728a6f19e363c62ff5619afc2670f87450c19e6770c37f 26 | original: lts-10.9 27 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Dawson.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Dawson 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Dawson( 17 | dawson_e 18 | , dawson 19 | ) where 20 | 21 | import Foreign(Ptr) 22 | import Foreign.C.Types 23 | import Numeric.GSL.Special.Internal 24 | 25 | dawson_e :: Double -> (Double,Double) 26 | dawson_e x = createSFR "dawson_e" $ gsl_sf_dawson_e x 27 | foreign import ccall SAFE_CHEAP "gsl_sf_dawson_e" gsl_sf_dawson_e :: Double -> Ptr () -> IO CInt 28 | 29 | dawson :: Double -> Double 30 | dawson = gsl_sf_dawson 31 | foreign import ccall SAFE_CHEAP "gsl_sf_dawson" gsl_sf_dawson :: Double -> Double 32 | -------------------------------------------------------------------------------- /packages/base/src/Numeric/LinearAlgebra/HMatrix.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | -------------------------------------------------------------------------------- 3 | {- | 4 | Module : Numeric.LinearAlgebra.HMatrix 5 | Copyright : (c) Alberto Ruiz 2006-14 6 | License : BSD3 7 | Maintainer : Alberto Ruiz 8 | Stability : provisional 9 | 10 | compatibility with previous version, to be removed 11 | 12 | -} 13 | -------------------------------------------------------------------------------- 14 | 15 | module Numeric.LinearAlgebra.HMatrix ( 16 | module Numeric.LinearAlgebra, 17 | (¦),(——),ℝ,ℂ,(<·>),app,mul, cholSH, mbCholSH, eigSH', eigenvaluesSH', geigSH' 18 | ) where 19 | 20 | import Numeric.LinearAlgebra 21 | import Internal.Util 22 | import Internal.Algorithms(cholSH, mbCholSH, eigSH', eigenvaluesSH', geigSH') 23 | #if MIN_VERSION_base(4,11,0) 24 | import Prelude hiding ((<>)) 25 | #endif 26 | 27 | infixr 8 <·> 28 | (<·>) :: Numeric t => Vector t -> Vector t -> t 29 | (<·>) = dot 30 | 31 | app :: Numeric t => Matrix t -> Vector t -> Vector t 32 | app m v = m #> v 33 | 34 | mul :: Numeric t => Matrix t -> Matrix t -> Matrix t 35 | mul a b = a <> b 36 | 37 | -------------------------------------------------------------------------------- /examples/devel/example/wrappers.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | {-# LANGUAGE GADTs #-} 4 | 5 | {- 6 | $ ghc -O2 wrappers.hs functions.c 7 | $ ./wrappers 8 | -} 9 | 10 | import Numeric.LinearAlgebra 11 | import Numeric.LinearAlgebra.Devel 12 | import System.IO.Unsafe(unsafePerformIO) 13 | import Foreign.C.Types(CInt(..)) 14 | import Foreign.Ptr(Ptr) 15 | 16 | 17 | infixl 1 # 18 | a # b = apply a b 19 | {-# INLINE (#) #-} 20 | 21 | infixr 5 :>, ::> 22 | type (:>) t r = CInt -> Ptr t -> r 23 | type (::>) t r = CInt -> CInt -> CInt -> CInt -> Ptr t -> r 24 | type Ok = IO CInt 25 | 26 | ----------------------------------------------------- 27 | 28 | x = (3><5) [1..] 29 | 30 | main = do 31 | print x 32 | print $ myDiag x 33 | print $ myDiag (tr x) 34 | 35 | ----------------------------------------------------- 36 | foreign import ccall unsafe "c_diag" cDiag :: Double ::> Double :> Double ::> Ok 37 | 38 | myDiag m = unsafePerformIO $ do 39 | y <- createVector (min r c) 40 | z <- createMatrix RowMajor r c 41 | cDiag # m # y # z #| "cDiag" 42 | return (y,z) 43 | where 44 | (r,c) = size m 45 | 46 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Clausen.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Clausen 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Clausen( 17 | clausen_e 18 | , clausen 19 | ) where 20 | 21 | import Foreign(Ptr) 22 | import Foreign.C.Types 23 | import Numeric.GSL.Special.Internal 24 | 25 | clausen_e :: Double -> (Double,Double) 26 | clausen_e x = createSFR "clausen_e" $ gsl_sf_clausen_e x 27 | foreign import ccall SAFE_CHEAP "gsl_sf_clausen_e" gsl_sf_clausen_e :: Double -> Ptr () -> IO CInt 28 | 29 | clausen :: Double -> Double 30 | clausen = gsl_sf_clausen 31 | foreign import ccall SAFE_CHEAP "gsl_sf_clausen" gsl_sf_clausen :: Double -> Double 32 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Pow_int.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Pow_int 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Pow_int( 17 | pow_int_e 18 | , pow_int 19 | ) where 20 | 21 | import Foreign(Ptr) 22 | import Foreign.C.Types 23 | import Numeric.GSL.Special.Internal 24 | 25 | pow_int_e :: Double -> CInt -> (Double,Double) 26 | pow_int_e x n = createSFR "pow_int_e" $ gsl_sf_pow_int_e x n 27 | foreign import ccall SAFE_CHEAP "gsl_sf_pow_int_e" gsl_sf_pow_int_e :: Double -> CInt -> Ptr () -> IO CInt 28 | 29 | pow_int :: Double -> CInt -> Double 30 | pow_int = gsl_sf_pow_int 31 | foreign import ccall SAFE_CHEAP "gsl_sf_pow_int" gsl_sf_pow_int :: Double -> CInt -> Double 32 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/autoall.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | function rep { 4 | ./replace.hs "$1" "$2" < $3 > /tmp/tmp-rep 5 | cp /tmp/tmp-rep $3 6 | } 7 | 8 | rm -f funs.txt 9 | 10 | ./auto.hs airy 11 | rep ') where' ', Precision(..)\n) where' Airy.hs 12 | ./auto.hs bessel 13 | ./auto.hs clausen 14 | ./auto.hs coulomb 15 | ./auto.hs coupling 16 | rep ', coupling_6j_INCORRECT_e\n, coupling_6j_INCORRECT\n' '' Coupling.hs 17 | ./auto.hs dawson 18 | ./auto.hs debye 19 | ./auto.hs dilog 20 | ./auto.hs elementary 21 | ./auto.hs ellint 22 | #./auto.hs elljac 23 | ./auto.hs erf 24 | ./auto.hs exp 25 | rep ', exp\n' ', Numeric.GSL.Special.Exp.exp\n' Exp.hs 26 | rep ', exprel_n_CF_e' '-- , exprel_n_CF_e' Exp.hs 27 | ./auto.hs expint 28 | ./auto.hs fermi_dirac 29 | ./auto.hs gamma 30 | ./auto.hs gegenbauer 31 | ./auto.hs hyperg 32 | ./auto.hs laguerre 33 | ./auto.hs lambert 34 | ./auto.hs legendre 35 | ./auto.hs log 36 | rep ', log\n' ', Numeric.GSL.Special.Log.log\n' Log.hs 37 | #./auto.hs mathieu 38 | ./auto.hs pow_int 39 | ./auto.hs psi 40 | ./auto.hs synchrotron 41 | ./auto.hs transport 42 | ./auto.hs trig 43 | rep ', sin\n' ', Numeric.GSL.Special.Trig.sin\n' Trig.hs 44 | rep ', cos\n' ', Numeric.GSL.Special.Trig.cos\n' Trig.hs 45 | ./auto.hs zeta 46 | -------------------------------------------------------------------------------- /packages/sparse/hmatrix-sparse.cabal: -------------------------------------------------------------------------------- 1 | Name: hmatrix-sparse 2 | Version: 0.19.0.0 3 | License: BSD3 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/hmatrix 9 | Synopsis: Sparse linear solver 10 | Description: Interface to MKL direct sparse linear solver 11 | 12 | -- cabal install --extra-include-dirs=$MKL --extra-lib-dirs=$MKL 13 | 14 | Category: Math 15 | tested-with: GHC ==7.8 16 | 17 | cabal-version: >=1.6 18 | build-type: Simple 19 | 20 | 21 | library 22 | Build-Depends: base<5, hmatrix>=0.16 23 | 24 | hs-source-dirs: src 25 | 26 | Exposed-modules: Numeric.LinearAlgebra.Sparse 27 | 28 | ghc-options: -Wall 29 | 30 | c-sources: src/Numeric/LinearAlgebra/sparse.c 31 | 32 | cc-options: -O4 -Wall 33 | 34 | if arch(x86_64) 35 | cc-options: -msse2 36 | 37 | if arch(i386) 38 | cc-options: -msse2 39 | 40 | extra-libraries: mkl_intel mkl_sequential mkl_core 41 | 42 | source-repository head 43 | type: git 44 | location: https://github.com/albertoruiz/hmatrix 45 | 46 | -------------------------------------------------------------------------------- /docs/SUNDIALS.md: -------------------------------------------------------------------------------- 1 | # Sundials installation 2 | 3 | You can download the Sundials source files [here](https://computation.llnl.gov/projects/sundials/sundials-software). Note: `hmatrix-sundials` doesn't work with versions superior to 3.2.1 (4.0.0 and above). 4 | 5 | Assuming we choose the 3.2.1 version: 6 | 7 | $ wget https://computation.llnl.gov/projects/sundials/download/sundials-3.2.1.tar.gz 8 | $ tar -xzf sundials-3.2.1.tar.gz 9 | $ cd sundials-3.2.1 10 | $ mkdir instdir 11 | $ mkdir builddir 12 | $ cd builddir 13 | $ cmake -DCMAKE_INSTALL_PREFIX=/absolute/path/to/sundials-3.2.1/instdir -DEXAMPLES_INSTALL_PATH=/absolute/path/to/sundials-3.2.1/instdir/examples ../../sundials-3.2.1 14 | $ make 15 | $ make install 16 | 17 | 18 | Then for an installation in a project, one should add to `stack.yaml`: 19 | ``` 20 | extra-include-dirs: 21 | - /absolute/path/to/instdir/sundials-3.2.1/include 22 | extra-lib-dirs: 23 | - /absolute/path/to/instdir/sundials-3.2.1/builddir/src/cvode 24 | - /absolute/path/to/instdir/sundials-3.2.1/builddir/src/arkode 25 | ``` 26 | 27 | Or in the global scope: `stack install hmatrix-sundials --extra-lib-dirs=/absolute/path/to/instdir/sundials-3.2.1/builddir/src/arkode --extra-lib-dirs=//absolute/path/to/instdir/sundials-3.2.1/builddir/src/cvode --extra-include-dirs=/absolute/path/to/instdir/sundials-3.2.1/include` 28 | 29 | -------------------------------------------------------------------------------- /packages/gsl/src/Numeric/GSL.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | 3 | Module : Numeric.GSL 4 | Copyright : (c) Alberto Ruiz 2006-14 5 | License : GPL 6 | 7 | Maintainer : Alberto Ruiz 8 | Stability : provisional 9 | 10 | This module reexports all available GSL functions. 11 | 12 | The GSL special functions are in the separate package hmatrix-special. 13 | 14 | -} 15 | 16 | module Numeric.GSL ( 17 | module Numeric.GSL.Integration 18 | , module Numeric.GSL.Differentiation 19 | , module Numeric.GSL.Fourier 20 | , module Numeric.GSL.Polynomials 21 | , module Numeric.GSL.Minimization 22 | , module Numeric.GSL.Root 23 | , module Numeric.GSL.ODE 24 | , module Numeric.GSL.Fitting 25 | , module Numeric.GSL.Interpolation 26 | , module Data.Complex 27 | , setErrorHandlerOff 28 | ) where 29 | 30 | import Numeric.GSL.Integration 31 | import Numeric.GSL.Differentiation 32 | import Numeric.GSL.Fourier 33 | import Numeric.GSL.Polynomials 34 | import Numeric.GSL.Minimization 35 | import Numeric.GSL.Root 36 | import Numeric.GSL.ODE 37 | import Numeric.GSL.Fitting 38 | import Numeric.GSL.Interpolation 39 | import Data.Complex 40 | 41 | 42 | -- | This action removes the GSL default error handler (which aborts the program), so that 43 | -- GSL errors can be handled by Haskell (using Control.Exception) and ghci doesn't abort. 44 | foreign import ccall unsafe "GSL/gsl-aux.h no_abort_on_error" setErrorHandlerOff :: IO () 45 | 46 | -------------------------------------------------------------------------------- /examples/lie.hs: -------------------------------------------------------------------------------- 1 | -- The magic of Lie Algebra 2 | 3 | {-# LANGUAGE FlexibleContexts #-} 4 | 5 | import Numeric.LinearAlgebra 6 | 7 | rot1 :: Double -> Matrix Double 8 | rot1 a = (3><3) 9 | [ 1, 0, 0 10 | , 0, c, s 11 | , 0,-s, c ] 12 | where c = cos a 13 | s = sin a 14 | 15 | g1,g2,g3 :: Matrix Double 16 | 17 | g1 = (3><3) [0, 0,0 18 | ,0, 0,1 19 | ,0,-1,0] 20 | 21 | rot2 :: Double -> Matrix Double 22 | rot2 a = (3><3) 23 | [ c, 0, s 24 | , 0, 1, 0 25 | ,-s, 0, c ] 26 | where c = cos a 27 | s = sin a 28 | 29 | g2 = (3><3) [ 0,0,1 30 | , 0,0,0 31 | ,-1,0,0] 32 | 33 | rot3 :: Double -> Matrix Double 34 | rot3 a = (3><3) 35 | [ c, s, 0 36 | ,-s, c, 0 37 | , 0, 0, 1 ] 38 | where c = cos a 39 | s = sin a 40 | 41 | g3 = (3><3) [ 0,1,0 42 | ,-1,0,0 43 | , 0,0,0] 44 | 45 | deg=pi/180 46 | 47 | -- commutator 48 | infix 8 & 49 | a & b = a <> b - b <> a 50 | 51 | infixl 6 |+| 52 | a |+| b = a + b + a&b /2 + (a-b)&(a & b) /12 53 | 54 | main = do 55 | let a = 45*deg 56 | b = 50*deg 57 | c = -30*deg 58 | exact = rot3 a <> rot1 b <> rot2 c 59 | lie = scalar a * g3 |+| scalar b * g1 |+| scalar c * g2 60 | putStrLn "position in the tangent space:" 61 | disp 5 lie 62 | putStrLn "exponential map back to the group (2 terms):" 63 | disp 5 (expm lie) 64 | putStrLn "exact position:" 65 | disp 5 exact 66 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Elljac.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------ 2 | -- | 3 | -- Module : Numeric.GSL.Special.Elljac 4 | -- Copyright : (c) Alberto Ruiz 2006 5 | -- License : GPL 6 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 7 | -- Stability : provisional 8 | -- Portability : uses ffi 9 | -- 10 | -- Wrappers for selected functions described at: 11 | -- 12 | -- 13 | ------------------------------------------------------------ 14 | 15 | module Numeric.GSL.Special.Elljac( 16 | elljac_e 17 | ) where 18 | 19 | import System.IO.Unsafe 20 | import Foreign.Ptr 21 | import Foreign.Storable 22 | import Foreign.Marshal 23 | import Foreign.C.Types 24 | 25 | elljac_e :: Double -> Double -> (Double,Double,Double) 26 | elljac_e u m = unsafePerformIO $ do 27 | psn <- malloc 28 | pcn <- malloc 29 | pdn <- malloc 30 | res <- gsl_sf_elljac_e u m psn pcn pdn 31 | sn <- peek psn 32 | cn <- peek pcn 33 | dn <- peek pdn 34 | free psn 35 | free pcn 36 | free pdn 37 | if res == 0 then return (sn,cn,dn) 38 | else error $ "error code "++show res++ 39 | " in elljac_e "++show u++" "++show m 40 | 41 | foreign import ccall "gsl_sf_elljac_e" gsl_sf_elljac_e :: Double -> Double -> Ptr Double -> Ptr Double -> Ptr Double -> IO CInt 42 | -------------------------------------------------------------------------------- /packages/gsl/src/Numeric/GSL/Fourier.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | 3 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 4 | 5 | {- | 6 | Module : Numeric.GSL.Fourier 7 | Copyright : (c) Alberto Ruiz 2006 8 | License : GPL 9 | Maintainer : Alberto Ruiz 10 | Stability : provisional 11 | 12 | Fourier Transform. 13 | 14 | 15 | 16 | -} 17 | 18 | module Numeric.GSL.Fourier ( 19 | fft, 20 | ifft 21 | ) where 22 | 23 | import Numeric.LinearAlgebra.HMatrix 24 | import Numeric.GSL.Internal 25 | import Foreign.C.Types 26 | import System.IO.Unsafe (unsafePerformIO) 27 | 28 | genfft code v = unsafePerformIO $ do 29 | r <- createVector (size v) 30 | (v `applyRaw` (r `applyRaw` id)) (c_fft code) #|"fft" 31 | return r 32 | 33 | foreign import ccall unsafe "gsl-aux.h fft" c_fft :: CInt -> TCV (TCV Res) 34 | 35 | 36 | {- | Fast 1D Fourier transform of a 'Vector' @(@'Complex' 'Double'@)@ using /gsl_fft_complex_forward/. It uses the same scaling conventions as GNU Octave. 37 | 38 | >>> fft (fromList [1,2,3,4]) 39 | fromList [10.0 :+ 0.0,(-2.0) :+ 2.0,(-2.0) :+ 0.0,(-2.0) :+ (-2.0)] 40 | 41 | -} 42 | fft :: Vector (Complex Double) -> Vector (Complex Double) 43 | fft = genfft 0 44 | 45 | -- | The inverse of 'fft', using /gsl_fft_complex_inverse/. 46 | ifft :: Vector (Complex Double) -> Vector (Complex Double) 47 | ifft = genfft 1 48 | 49 | -------------------------------------------------------------------------------- /examples/ButcherTableau.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wall #-} 2 | 3 | import Numeric.Sundials.ARKode.ODE 4 | import Numeric.LinearAlgebra 5 | 6 | import Data.List (intercalate) 7 | 8 | import Text.PrettyPrint.HughesPJClass 9 | 10 | 11 | butcherTableauTex :: ButcherTable -> String 12 | butcherTableauTex (ButcherTable m c b b2) = 13 | render $ 14 | vcat [ text ("\n\\begin{array}{c|" ++ (concat $ replicate n "c") ++ "}") 15 | , us 16 | , text "\\hline" 17 | , text bs <+> text "\\\\" 18 | , text b2s <+> text "\\\\" 19 | , text "\\end{array}" 20 | ] 21 | where 22 | n = rows m 23 | rs = toLists m 24 | ss = map (\r -> intercalate " & " $ map show r) rs 25 | ts = zipWith (\i r -> show i ++ " & " ++ r) (toList c) ss 26 | us = vcat $ map (\r -> text r <+> text "\\\\") ts 27 | bs = " & " ++ (intercalate " & " $ map show $ toList b) 28 | b2s = " & " ++ (intercalate " & " $ map show $ toList b2) 29 | 30 | main :: IO () 31 | main = do 32 | 33 | let res = butcherTable (SDIRK_2_1_2 undefined) 34 | putStrLn $ show res 35 | putStrLn $ butcherTableauTex res 36 | 37 | let resA = butcherTable (KVAERNO_4_2_3 undefined) 38 | putStrLn $ show resA 39 | putStrLn $ butcherTableauTex resA 40 | 41 | let resB = butcherTable (SDIRK_5_3_4 undefined) 42 | putStrLn $ show resB 43 | putStrLn $ butcherTableauTex resB 44 | 45 | let resC = butcherTable (FEHLBERG_6_4_5 undefined) 46 | putStrLn $ show resC 47 | putStrLn $ butcherTableauTex resC 48 | -------------------------------------------------------------------------------- /examples/minimize.hs: -------------------------------------------------------------------------------- 1 | -- the multidimensional minimization example in the GSL manual 2 | import Numeric.GSL 3 | import Numeric.LinearAlgebra 4 | import Graphics.Plot 5 | import Text.Printf(printf) 6 | 7 | -- the function to be minimized 8 | f [x,y] = 10*(x-1)^2 + 20*(y-2)^2 + 30 9 | 10 | -- exact gradient 11 | df [x,y] = [20*(x-1), 40*(y-2)] 12 | 13 | -- a minimization algorithm which does not require the gradient 14 | minimizeS f xi = minimize NMSimplex2 1E-2 100 (replicate (length xi) 1) f xi 15 | 16 | -- Numerical estimation of the gradient 17 | gradient f v = [partialDerivative k f v | k <- [0 .. length v -1]] 18 | 19 | partialDerivative n f v = fst (derivCentral 0.01 g (v!!n)) where 20 | g x = f (concat [a,x:b]) 21 | (a,_:b) = splitAt n v 22 | 23 | disp' = putStrLn . format " " (printf "%.3f") 24 | 25 | allMethods :: (Enum a, Bounded a) => [a] 26 | allMethods = [minBound .. maxBound] 27 | 28 | test method = do 29 | print method 30 | let (s,p) = minimize method 1E-2 30 [1,1] f [5,7] 31 | print s 32 | disp' p 33 | 34 | testD method = do 35 | print method 36 | let (s,p) = minimizeD method 1E-3 30 1E-2 1E-4 f df [5,7] 37 | print s 38 | disp' p 39 | 40 | testD' method = do 41 | putStrLn $ show method ++ " with estimated gradient" 42 | let (s,p) = minimizeD method 1E-3 30 1E-2 1E-4 f (gradient f) [5,7] 43 | print s 44 | disp' p 45 | 46 | main = do 47 | mapM_ test [NMSimplex, NMSimplex2] 48 | mapM_ testD allMethods 49 | testD' ConjugateFR 50 | mplot $ drop 3 . toColumns . snd $ minimizeS f [5,7] 51 | 52 | -------------------------------------------------------------------------------- /examples/ode.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ViewPatterns #-} 2 | import Numeric.GSL.ODE 3 | import Numeric.LinearAlgebra 4 | import Graphics.Plot 5 | import Debug.Trace(trace) 6 | debug x = trace (show x) x 7 | 8 | vanderpol mu = do 9 | let xdot mu t [x,v] = [v, -x + mu * v * (1-x^2)] 10 | ts = linspace 1000 (0,50) 11 | sol = toColumns $ odeSolve (xdot mu) [1,0] ts 12 | mplot (ts : sol) 13 | mplot sol 14 | 15 | 16 | harmonic w d = do 17 | let xdot w d t [x,v] = [v, a*x + b*v] where a = -w^2; b = -2*d*w 18 | ts = linspace 100 (0,20) 19 | sol = odeSolve (xdot w d) [1,0] ts 20 | mplot (ts : toColumns sol) 21 | 22 | 23 | kepler v a = mplot (take 2 $ toColumns sol) where 24 | xdot t [x,y,vx,vy] = [vx,vy,x*k,y*k] 25 | where g=1 26 | k=(-g)*(x*x+y*y)**(-1.5) 27 | ts = linspace 100 (0,30) 28 | sol = odeSolve xdot [4, 0, v * cos (a*degree), v * sin (a*degree)] ts 29 | degree = pi/180 30 | 31 | 32 | main = do 33 | vanderpol 2 34 | harmonic 1 0 35 | harmonic 1 0.1 36 | kepler 0.3 60 37 | kepler 0.4 70 38 | vanderpol' 2 39 | 40 | -- example of odeSolveV with jacobian 41 | vanderpol' mu = do 42 | let xdot mu t (toList->[x,v]) = fromList [v, -x + mu * v * (1-x^2)] 43 | jac t (toList->[x,v]) = (2><2) [ 0 , 1 44 | , -1-2*x*v*mu, mu*(1-x**2) ] 45 | ts = linspace 1000 (0,50) 46 | hi = (ts!1 - ts!0)/100 47 | sol = toColumns $ odeSolveV (MSBDF jac) hi 1E-8 1E-8 (xdot mu) (fromList [1,0]) ts 48 | mplot sol 49 | 50 | 51 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Elementary.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Elementary 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Elementary( 17 | multiply_e 18 | , multiply 19 | , multiply_err_e 20 | ) where 21 | 22 | import Foreign(Ptr) 23 | import Foreign.C.Types 24 | import Numeric.GSL.Special.Internal 25 | 26 | multiply_e :: Double -> Double -> (Double,Double) 27 | multiply_e x y = createSFR "multiply_e" $ gsl_sf_multiply_e x y 28 | foreign import ccall SAFE_CHEAP "gsl_sf_multiply_e" gsl_sf_multiply_e :: Double -> Double -> Ptr () -> IO CInt 29 | 30 | multiply :: Double -> Double -> Double 31 | multiply = gsl_sf_multiply 32 | foreign import ccall SAFE_CHEAP "gsl_sf_multiply" gsl_sf_multiply :: Double -> Double -> Double 33 | 34 | multiply_err_e :: Double -> Double -> Double -> Double -> (Double,Double) 35 | multiply_err_e x dx y dy = createSFR "multiply_err_e" $ gsl_sf_multiply_err_e x dx y dy 36 | foreign import ccall SAFE_CHEAP "gsl_sf_multiply_err_e" gsl_sf_multiply_err_e :: Double -> Double -> Double -> Double -> Ptr () -> IO CInt 37 | -------------------------------------------------------------------------------- /examples/kalman.hs: -------------------------------------------------------------------------------- 1 | import Numeric.LinearAlgebra 2 | import Graphics.Plot 3 | 4 | f = fromLists 5 | [[1,0,0,0], 6 | [1,1,0,0], 7 | [0,0,1,0], 8 | [0,0,0,1]] 9 | 10 | h = fromLists 11 | [[0,-1,1,0], 12 | [0,-1,0,1]] 13 | 14 | q = diagl [1,1,0,0] 15 | 16 | r = diagl [2,2] 17 | 18 | s0 = State (vector [0, 0, 10, -10]) (diagl [10,0, 100, 100]) 19 | 20 | data System = System {kF, kH, kQ, kR :: Matrix Double} 21 | data State = State {sX :: Vector Double , sP :: Matrix Double} 22 | type Measurement = Vector Double 23 | 24 | kalman :: System -> State -> Measurement -> State 25 | kalman (System f h q r) (State x p) z = State x' p' where 26 | px = f #> x -- prediction 27 | pq = f <> p <> tr f + q -- its covariance 28 | y = z - h #> px -- residue 29 | cy = h <> pq <> tr h + r -- its covariance 30 | k = pq <> tr h <> inv cy -- kalman gain 31 | x' = px + k #> y -- new state 32 | p' = (ident (size x) - k <> h) <> pq -- its covariance 33 | 34 | sys = System f h q r 35 | 36 | zs = [vector [15-k,-20-k] | k <- [0..]] 37 | 38 | xs = s0 : zipWith (kalman sys) xs zs 39 | 40 | des = map (sqrt.takeDiag.sP) xs 41 | 42 | evolution n (xs,des) = 43 | vector [1.. fromIntegral n]:(toColumns $ fromRows $ take n (zipWith (-) (map sX xs) des)) ++ 44 | (toColumns $ fromRows $ take n (zipWith (+) (map sX xs) des)) 45 | 46 | main = do 47 | print $ fromRows $ take 10 (map sX xs) 48 | mapM_ (print . sP) $ take 10 xs 49 | mplot (evolution 20 (xs,des)) 50 | 51 | -------------------------------------------------------------------------------- /packages/sparse/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014 Alberto Ruiz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | * Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | * Redistributions in binary form must reproduce the above copyright 10 | notice, this list of conditions and the following disclaimer in the 11 | documentation and/or other materials provided with the distribution. 12 | * Neither the name of Alberto Ruiz nor the names of other contributors may 13 | be used to endorse or promote products derived from this software 14 | without specific prior written permission. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 17 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY 20 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 21 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 22 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 23 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 25 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | 27 | -------------------------------------------------------------------------------- /examples/pca1.hs: -------------------------------------------------------------------------------- 1 | -- Principal component analysis 2 | 3 | import Numeric.LinearAlgebra 4 | import System.Directory(doesFileExist) 5 | import System.Process(system) 6 | import Control.Monad(when) 7 | 8 | type Vec = Vector Double 9 | type Mat = Matrix Double 10 | 11 | {- 12 | -- Vector with the mean value of the columns of a matrix 13 | mean a = constant (recip . fromIntegral . rows $ a) (rows a) <> a 14 | 15 | -- covariance matrix of a list of observations stored as rows 16 | cov x = (trans xc <> xc) / fromIntegral (rows x - 1) 17 | where xc = x - asRow (mean x) 18 | -} 19 | 20 | 21 | -- creates the compression and decompression functions from the desired number of components 22 | pca :: Int -> Mat -> (Vec -> Vec , Vec -> Vec) 23 | pca n dataSet = (encode,decode) 24 | where 25 | encode x = vp #> (x - m) 26 | decode x = x <# vp + m 27 | (m,c) = meanCov dataSet 28 | (_,v) = eigSH (trustSym c) 29 | vp = tr $ takeColumns n v 30 | 31 | main = do 32 | ok <- doesFileExist ("mnist.txt") 33 | when (not ok) $ do 34 | putStrLn "\nTrying to download test datafile..." 35 | system("wget -nv http://dis.um.es/~alberto/material/sp/mnist.txt.gz") 36 | system("gunzip mnist.txt.gz") 37 | return () 38 | m <- loadMatrix "mnist.txt" -- fromFile "mnist.txt" (5000,785) 39 | let xs = takeColumns (cols m -1) m -- the last column is the digit type (class label) 40 | let x = toRows xs !! 4 -- an arbitrary test Vec 41 | let (pe,pd) = pca 10 xs 42 | let y = pe x 43 | print y -- compressed version 44 | print $ norm_2 (x - pd y) / norm_2 x --reconstruction quality 45 | -------------------------------------------------------------------------------- /packages/base/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2006-2014 Alberto Ruiz and other contributors 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | * Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | * Redistributions in binary form must reproduce the above copyright 10 | notice, this list of conditions and the following disclaimer in the 11 | documentation and/or other materials provided with the distribution. 12 | * Neither the name of Alberto Ruiz nor the names of other contributors may 13 | be used to endorse or promote products derived from this software 14 | without specific prior written permission. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 17 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY 20 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 21 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 22 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 23 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 25 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | 27 | -------------------------------------------------------------------------------- /packages/tests/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2006-2014 Alberto Ruiz and other contributors 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | * Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | * Redistributions in binary form must reproduce the above copyright 10 | notice, this list of conditions and the following disclaimer in the 11 | documentation and/or other materials provided with the distribution. 12 | * Neither the name of Alberto Ruiz nor the names of other contributors may 13 | be used to endorse or promote products derived from this software 14 | without specific prior written permission. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 17 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY 20 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 21 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 22 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 23 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 25 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | 27 | -------------------------------------------------------------------------------- /examples/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, Dominic Steinitz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Dominic Steinitz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /packages/gsl/src/Numeric/GSL/IO.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Numeric.GSL.IO 4 | -- Copyright : (c) Alberto Ruiz 2007-14 5 | -- License : GPL 6 | -- Maintainer : Alberto Ruiz 7 | -- Stability : provisional 8 | -- 9 | ----------------------------------------------------------------------------- 10 | 11 | module Numeric.GSL.IO ( 12 | saveMatrix, 13 | fwriteVector, freadVector, fprintfVector, fscanfVector, 14 | fileDimensions, loadMatrix, fromFile 15 | ) where 16 | 17 | import Numeric.LinearAlgebra.HMatrix hiding(saveMatrix, loadMatrix) 18 | import Numeric.GSL.Vector 19 | import System.Process(readProcess) 20 | 21 | 22 | {- | obtains the number of rows and columns in an ASCII data file 23 | (provisionally using unix's wc). 24 | -} 25 | fileDimensions :: FilePath -> IO (Int,Int) 26 | fileDimensions fname = do 27 | wcres <- readProcess "wc" ["-w",fname] "" 28 | contents <- readFile fname 29 | let tot = read . head . words $ wcres 30 | c = length . head . dropWhile null . map words . lines $ contents 31 | if tot > 0 32 | then return (tot `div` c, c) 33 | else return (0,0) 34 | 35 | -- | Loads a matrix from an ASCII file formatted as a 2D table. 36 | loadMatrix :: FilePath -> IO (Matrix Double) 37 | loadMatrix file = fromFile file =<< fileDimensions file 38 | 39 | -- | Loads a matrix from an ASCII file (the number of rows and columns must be known in advance). 40 | fromFile :: FilePath -> (Int,Int) -> IO (Matrix Double) 41 | fromFile filename (r,c) = reshape c `fmap` fscanfVector filename (r*c) 42 | 43 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Lambert.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Lambert 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Lambert( 17 | lambert_W0_e 18 | , lambert_W0 19 | , lambert_Wm1_e 20 | , lambert_Wm1 21 | ) where 22 | 23 | import Foreign(Ptr) 24 | import Foreign.C.Types 25 | import Numeric.GSL.Special.Internal 26 | 27 | lambert_W0_e :: Double -> (Double,Double) 28 | lambert_W0_e x = createSFR "lambert_W0_e" $ gsl_sf_lambert_W0_e x 29 | foreign import ccall SAFE_CHEAP "gsl_sf_lambert_W0_e" gsl_sf_lambert_W0_e :: Double -> Ptr () -> IO CInt 30 | 31 | lambert_W0 :: Double -> Double 32 | lambert_W0 = gsl_sf_lambert_W0 33 | foreign import ccall SAFE_CHEAP "gsl_sf_lambert_W0" gsl_sf_lambert_W0 :: Double -> Double 34 | 35 | lambert_Wm1_e :: Double -> (Double,Double) 36 | lambert_Wm1_e x = createSFR "lambert_Wm1_e" $ gsl_sf_lambert_Wm1_e x 37 | foreign import ccall SAFE_CHEAP "gsl_sf_lambert_Wm1_e" gsl_sf_lambert_Wm1_e :: Double -> Ptr () -> IO CInt 38 | 39 | lambert_Wm1 :: Double -> Double 40 | lambert_Wm1 = gsl_sf_lambert_Wm1 41 | foreign import ccall SAFE_CHEAP "gsl_sf_lambert_Wm1" gsl_sf_lambert_Wm1 :: Double -> Double 42 | -------------------------------------------------------------------------------- /examples/bool.hs: -------------------------------------------------------------------------------- 1 | -- vectorized boolean operations defined in terms of step or cond 2 | 3 | {-# LANGUAGE FlexibleContexts #-} 4 | 5 | import Numeric.LinearAlgebra 6 | 7 | infix 4 .==., ./=., .<., .<=., .>=., .>. 8 | infixr 3 .&&. 9 | infixr 2 .||. 10 | 11 | -- specialized for Int result 12 | cond' 13 | :: (Element t, Ord t, Container c I, Container c t) 14 | => c t -> c t -> c I -> c I -> c I -> c I 15 | cond' = cond 16 | 17 | a .<. b = cond' a b 1 0 0 18 | a .<=. b = cond' a b 1 1 0 19 | a .==. b = cond' a b 0 1 0 20 | a ./=. b = cond' a b 1 0 1 21 | a .>=. b = cond' a b 0 1 1 22 | a .>. b = cond' a b 0 0 1 23 | 24 | a .&&. b = step (a*b) 25 | a .||. b = step (a+b) 26 | no a = 1-a 27 | xor a b = a ./=. b 28 | equiv a b = a .==. b 29 | imp a b = no a .||. b 30 | 31 | taut x = minElement x == 1 32 | 33 | minEvery a b = cond a b a a b 34 | maxEvery a b = cond a b b b a 35 | 36 | -- examples 37 | 38 | clip a b x = cond y b y y b where y = cond x a a x x 39 | 40 | eye n = ident n :: Matrix R 41 | 42 | m = (3><4) [1..] :: Matrix R 43 | 44 | p = fromList [0,0,1,1] :: Vector I 45 | q = fromList [0,1,0,1] :: Vector I 46 | 47 | main = do 48 | print $ find (>6) m 49 | disp 3 $ assoc (6,8) 7 $ zip (find (/=0) (eye 5)) [10..] 50 | disp 3 $ accum (eye 5) (+) [((0,2),3), ((3,1),7), ((1,1),1)] 51 | print $ m .>=. 10 .||. m .<. 4 52 | (print . fromColumns) [p, q, p.&&.q, p .||.q, p `xor` q, p `equiv` q, p `imp` q] 53 | print $ taut $ (p `imp` q ) `equiv` (no q `imp` no p) 54 | print $ taut $ (xor p q) `equiv` (p .&&. no q .||. no p .&&. q) 55 | disp 3 $ clip 3 8 m 56 | print $ col [1..7] .<=. row [1..5] 57 | print $ cond (col [1..3]) (row [1..4]) m 50 (3*m) 58 | 59 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Synchrotron.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Synchrotron 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Synchrotron( 17 | synchrotron_1_e 18 | , synchrotron_1 19 | , synchrotron_2_e 20 | , synchrotron_2 21 | ) where 22 | 23 | import Foreign(Ptr) 24 | import Foreign.C.Types 25 | import Numeric.GSL.Special.Internal 26 | 27 | synchrotron_1_e :: Double -> (Double,Double) 28 | synchrotron_1_e x = createSFR "synchrotron_1_e" $ gsl_sf_synchrotron_1_e x 29 | foreign import ccall SAFE_CHEAP "gsl_sf_synchrotron_1_e" gsl_sf_synchrotron_1_e :: Double -> Ptr () -> IO CInt 30 | 31 | synchrotron_1 :: Double -> Double 32 | synchrotron_1 = gsl_sf_synchrotron_1 33 | foreign import ccall SAFE_CHEAP "gsl_sf_synchrotron_1" gsl_sf_synchrotron_1 :: Double -> Double 34 | 35 | synchrotron_2_e :: Double -> (Double,Double) 36 | synchrotron_2_e x = createSFR "synchrotron_2_e" $ gsl_sf_synchrotron_2_e x 37 | foreign import ccall SAFE_CHEAP "gsl_sf_synchrotron_2_e" gsl_sf_synchrotron_2_e :: Double -> Ptr () -> IO CInt 38 | 39 | synchrotron_2 :: Double -> Double 40 | synchrotron_2 = gsl_sf_synchrotron_2 41 | foreign import ccall SAFE_CHEAP "gsl_sf_synchrotron_2" gsl_sf_synchrotron_2 :: Double -> Double 42 | -------------------------------------------------------------------------------- /packages/gsl/src/Numeric/GSL/Polynomials.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {- | 3 | Module : Numeric.GSL.Polynomials 4 | Copyright : (c) Alberto Ruiz 2006 5 | License : GPL 6 | Maintainer : Alberto Ruiz 7 | Stability : provisional 8 | 9 | Polynomials. 10 | 11 | 12 | 13 | -} 14 | 15 | 16 | module Numeric.GSL.Polynomials ( 17 | polySolve 18 | ) where 19 | 20 | import Numeric.LinearAlgebra.HMatrix 21 | import Numeric.GSL.Internal 22 | import System.IO.Unsafe (unsafePerformIO) 23 | 24 | #if __GLASGOW_HASKELL__ >= 704 25 | import Foreign.C.Types (CInt(..)) 26 | #endif 27 | 28 | {- | Solution of general polynomial equations, using /gsl_poly_complex_solve/. 29 | 30 | For example, the three solutions of x^3 + 8 = 0 31 | 32 | >>> polySolve [8,0,0,1] 33 | [(-2.0) :+ 0.0,1.0 :+ 1.7320508075688776,1.0 :+ (-1.7320508075688776)] 34 | 35 | 36 | The example in the GSL manual: To find the roots of x^5 -1 = 0: 37 | 38 | >>> polySolve [-1, 0, 0, 0, 0, 1] 39 | [(-0.8090169943749472) :+ 0.5877852522924731, 40 | (-0.8090169943749472) :+ (-0.5877852522924731), 41 | 0.30901699437494756 :+ 0.9510565162951535, 42 | 0.30901699437494756 :+ (-0.9510565162951535), 43 | 1.0000000000000002 :+ 0.0] 44 | 45 | -} 46 | polySolve :: [Double] -> [Complex Double] 47 | polySolve = toList . polySolve' . fromList 48 | 49 | polySolve' :: Vector Double -> Vector (Complex Double) 50 | polySolve' v | size v > 1 = unsafePerformIO $ do 51 | r <- createVector (size v-1) 52 | (v `applyRaw` (r `applyRaw` id)) c_polySolve #| "polySolve" 53 | return r 54 | | otherwise = error "polySolve on a polynomial of degree zero" 55 | 56 | foreign import ccall unsafe "gsl-aux.h polySolve" c_polySolve:: TV (TCV Res) 57 | 58 | -------------------------------------------------------------------------------- /packages/glpk/hmatrix-glpk.cabal: -------------------------------------------------------------------------------- 1 | Name: hmatrix-glpk 2 | Version: 0.19.0.0 3 | License: GPL-3 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/hmatrix 9 | Synopsis: Linear Programming based on GLPK 10 | Description: 11 | Simple interface to linear programming functions provided by GLPK. 12 | 13 | Category: Math 14 | tested-with: GHC ==7.8 15 | 16 | cabal-version: >=1.6 17 | build-type: Simple 18 | 19 | extra-source-files: examples/simplex1.hs 20 | examples/simplex2.hs 21 | examples/simplex3.hs 22 | examples/simplex4.hs 23 | examples/simplex5.hs 24 | 25 | flag disable-default-paths 26 | description: When enabled, don't add default hardcoded include/link dirs by default. Needed for hermetic builds like in nix. 27 | default: False 28 | manual: True 29 | 30 | library 31 | Build-Depends: base <5, hmatrix >= 0.17, containers 32 | 33 | hs-source-dirs: src 34 | 35 | Exposed-modules: Numeric.LinearProgramming 36 | Numeric.LinearProgramming.L1 37 | 38 | c-sources: src/C/glpk.c 39 | 40 | ghc-options: -Wall 41 | 42 | extra-libraries: glpk 43 | 44 | if os(OSX) 45 | if !flag(disable-default-paths) 46 | extra-lib-dirs: /usr/lib 47 | extra-lib-dirs: /opt/local/lib/ 48 | include-dirs: /opt/local/include/ 49 | extra-lib-dirs: /usr/local/lib/ 50 | include-dirs: /usr/local/include/ 51 | if arch(i386) 52 | cc-options: -arch i386 53 | 54 | source-repository head 55 | type: git 56 | location: https://github.com/albertoruiz/hmatrix 57 | 58 | -------------------------------------------------------------------------------- /examples/sundials.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 2 | 3 | {-# LANGUAGE ViewPatterns #-} 4 | 5 | import Numeric.Sundials.ARKode.ODE 6 | import Numeric.LinearAlgebra 7 | import Graphics.Plot 8 | 9 | vanderpol mu = do 10 | let xdot nu _t [x,v] = [v, -x + nu * v * (1-x*x)] 11 | xdot _ _ _ = error "vanderpol RHS not defined" 12 | ts = linspace 1000 (0,50) 13 | sol = toColumns $ odeSolve (xdot mu) [1,0] ts 14 | mplot (ts : sol) 15 | mplot sol 16 | 17 | 18 | harmonic w d = do 19 | let xdot u dd _t [x,v] = [v, a*x + b*v] where a = -u*u; b = -2*dd*u 20 | xdot _ _ _ _ = error "harmonic RHS not defined" 21 | ts = linspace 100 (0,20) 22 | sol = odeSolve (xdot w d) [1,0] ts 23 | mplot (ts : toColumns sol) 24 | 25 | 26 | kepler v a = mplot (take 2 $ toColumns sol) where 27 | xdot _t [x,y,vx,vy] = [vx,vy,x*k,y*k] 28 | where g=1 29 | k=(-g)*(x*x+y*y)**(-1.5) 30 | xdot _ _ = error "kepler RHS not defined" 31 | ts = linspace 100 (0,30) 32 | sol = odeSolve xdot [4, 0, v * cos (a*degree), v * sin (a*degree)] ts 33 | degree = pi/180 34 | 35 | 36 | main = do 37 | vanderpol 2 38 | harmonic 1 0 39 | harmonic 1 0.1 40 | kepler 0.3 60 41 | kepler 0.4 70 42 | vanderpol' 2 43 | 44 | -- example of odeSolveV with jacobian 45 | vanderpol' mu = do 46 | let xdot nu _t (toList->[x,v]) = fromList [v, -x + nu * v * (1-x*x)] 47 | xdot _ _ _ = error "vanderpol' RHS not defined" 48 | jac _ (toList->[x,v]) = (2><2) [ 0 , 1 49 | , -1-2*x*v*mu, mu*(1-x**2) ] 50 | jac _ _ = error "vanderpol' Jacobian not defined" 51 | ts = linspace 1000 (0,50) 52 | hi = pure $ (ts!1 - ts!0) / 100.0 53 | sol = toColumns $ odeSolveV (SDIRK_5_3_4 jac) hi 1E-8 1E-8 (xdot mu) (fromList [1,0]) ts 54 | mplot sol 55 | 56 | 57 | -------------------------------------------------------------------------------- /packages/sparse/src/Numeric/LinearAlgebra/sparse.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | #include 4 | #include 5 | 6 | #include "mkl_dss.h" 7 | #include "mkl_types.h" 8 | #include "mkl_spblas.h" 9 | 10 | #define KIVEC(A) int A##n, const int*A##p 11 | #define KDVEC(A) int A##n, const double*A##p 12 | #define DVEC(A) int A##n, double*A##p 13 | #define OK return 0; 14 | 15 | 16 | void check_error(int error) 17 | { 18 | if(error != MKL_DSS_SUCCESS) { 19 | printf ("Solver returned error code %d\n", error); 20 | exit (1); 21 | } 22 | } 23 | 24 | int dss(KDVEC(vals),KIVEC(cols),KIVEC(rows),KDVEC(x),DVEC(r)) { 25 | MKL_INT nRows = rowsn-1, nCols = rn, nNonZeros = valsn, nRhs = 1; 26 | MKL_INT *rowIndex = (MKL_INT*) rowsp; 27 | MKL_INT *columns = (MKL_INT*) colsp; 28 | double *values = (double*) valsp; 29 | _DOUBLE_PRECISION_t *rhs = (_DOUBLE_PRECISION_t*) xp; 30 | // _DOUBLE_PRECISION_t *obtrhs = (_DOUBLE_PRECISION_t*) malloc((nCols)*sizeof(_DOUBLE_PRECISION_t)); 31 | _DOUBLE_PRECISION_t *solValues = (_DOUBLE_PRECISION_t*) rp; 32 | 33 | _MKL_DSS_HANDLE_t handle; 34 | _INTEGER_t error; 35 | // _CHARACTER_t *uplo; 36 | MKL_INT opt; 37 | 38 | opt = MKL_DSS_DEFAULTS; 39 | error = dss_create(handle, opt); 40 | check_error(error); 41 | 42 | opt = MKL_DSS_NON_SYMMETRIC; 43 | error = dss_define_structure(handle, opt, rowIndex, nRows, nCols, columns, nNonZeros); 44 | check_error(error); 45 | 46 | opt = MKL_DSS_DEFAULTS; 47 | error = dss_reorder(handle, opt, 0); 48 | check_error(error); 49 | 50 | opt = MKL_DSS_INDEFINITE; 51 | error = dss_factor_real(handle, opt, values); 52 | check_error(error); 53 | 54 | int j; 55 | for (j = 0; j < nCols; j++) { 56 | solValues[j] = 0.0; 57 | } 58 | 59 | // Solve system 60 | opt = MKL_DSS_REFINEMENT_ON; 61 | error = dss_solve_real(handle, opt, rhs, nRhs, solValues); 62 | check_error(error); 63 | 64 | OK 65 | } 66 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Dilog.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Dilog 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Dilog( 17 | dilog_e 18 | , dilog 19 | , complex_dilog_xy_e 20 | , complex_dilog_e 21 | , complex_spence_xy_e 22 | ) where 23 | 24 | import Foreign(Ptr) 25 | import Foreign.C.Types 26 | import Numeric.GSL.Special.Internal 27 | 28 | dilog_e :: Double -> (Double,Double) 29 | dilog_e x = createSFR "dilog_e" $ gsl_sf_dilog_e x 30 | foreign import ccall SAFE_CHEAP "gsl_sf_dilog_e" gsl_sf_dilog_e :: Double -> Ptr () -> IO CInt 31 | 32 | dilog :: Double -> Double 33 | dilog = gsl_sf_dilog 34 | foreign import ccall SAFE_CHEAP "gsl_sf_dilog" gsl_sf_dilog :: Double -> Double 35 | 36 | complex_dilog_xy_e :: Double -> Double -> ((Double,Double),(Double,Double)) 37 | complex_dilog_xy_e x y = create2SFR "complex_dilog_xy_e" $ gsl_sf_complex_dilog_xy_e x y 38 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_xy_e" gsl_sf_complex_dilog_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt 39 | 40 | complex_dilog_e :: Double -> Double -> ((Double,Double),(Double,Double)) 41 | complex_dilog_e r theta = create2SFR "complex_dilog_e" $ gsl_sf_complex_dilog_e r theta 42 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_e" gsl_sf_complex_dilog_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt 43 | 44 | complex_spence_xy_e :: Double -> Double -> ((Double,Double),(Double,Double)) 45 | complex_spence_xy_e x y = create2SFR "complex_spence_xy_e" $ gsl_sf_complex_spence_xy_e x y 46 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_spence_xy_e" gsl_sf_complex_spence_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt 47 | -------------------------------------------------------------------------------- /examples/pca2.hs: -------------------------------------------------------------------------------- 1 | -- Improved PCA, including illustrative graphics 2 | 3 | {-# LANGUAGE FlexibleContexts #-} 4 | 5 | import Numeric.LinearAlgebra 6 | import Graphics.Plot 7 | import System.Directory(doesFileExist) 8 | import System.Process(system) 9 | import Control.Monad(when) 10 | 11 | type Vec = Vector Double 12 | type Mat = Matrix Double 13 | 14 | -- Vector with the mean value of the columns of a matrix 15 | mean a = konst (recip . fromIntegral . rows $ a) (rows a) <# a 16 | 17 | -- covariance matrix of a list of observations stored as rows 18 | cov x = (mTm xc) -- / fromIntegral (rows x - 1) 19 | where xc = x - asRow (mean x) 20 | 21 | 22 | type Stat = (Vec, [Double], Mat) 23 | -- 1st and 2nd order statistics of a dataset (mean, eigenvalues and eigenvectors of cov) 24 | stat :: Mat -> Stat 25 | stat x = (m, toList s, tr v) where 26 | m = mean x 27 | (s,v) = eigSH (cov x) 28 | 29 | -- creates the compression and decompression functions from the desired reconstruction 30 | -- quality and the statistics of a data set 31 | pca :: Double -> Stat -> (Vec -> Vec , Vec -> Vec) 32 | pca prec (m,s,v) = (encode,decode) 33 | where 34 | encode x = vp #> (x - m) 35 | decode x = x <# vp + m 36 | vp = takeRows n v 37 | n = 1 + (length $ fst $ span (< (prec'*sum s)) $ cumSum s) 38 | cumSum = tail . scanl (+) 0.0 39 | prec' = if prec <=0.0 || prec >= 1.0 40 | then error "the precision in pca must be 0 IO () 44 | shdigit v = imshow (reshape 28 (-v)) 45 | 46 | -- shows the effect of a given reconstruction quality on a test vector 47 | test :: Stat -> Double -> Vec -> IO () 48 | test st prec x = do 49 | let (pe,pd) = pca prec st 50 | let y = pe x 51 | print $ size y 52 | shdigit (pd y) 53 | 54 | main = do 55 | ok <- doesFileExist ("mnist.txt") 56 | when (not ok) $ do 57 | putStrLn "\nTrying to download test datafile..." 58 | system("wget -nv http://dis.um.es/~alberto/material/sp/mnist.txt.gz") 59 | system("gunzip mnist.txt.gz") 60 | return () 61 | m <- loadMatrix "mnist.txt" 62 | let xs = takeColumns (cols m -1) m 63 | let x = toRows xs !! 4 -- an arbitrary test vector 64 | shdigit x 65 | let st = stat xs 66 | test st 0.90 x 67 | test st 0.50 x 68 | 69 | -------------------------------------------------------------------------------- /packages/base/src/Numeric/LinearAlgebra/Devel.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | {- | 3 | Module : Numeric.HMatrix.Devel 4 | Copyright : (c) Alberto Ruiz 2014 5 | License : BSD3 6 | Maintainer : Alberto Ruiz 7 | Stability : provisional 8 | 9 | The library can be easily extended using the tools in this module. 10 | 11 | -} 12 | -------------------------------------------------------------------------------- 13 | 14 | module Numeric.LinearAlgebra.Devel( 15 | -- * FFI tools 16 | -- | See @examples/devel@ in the repository. 17 | 18 | createVector, createMatrix, 19 | TransArray(..), 20 | MatrixOrder(..), orderOf, cmat, fmat, 21 | matrixFromVector, 22 | unsafeFromForeignPtr, 23 | unsafeToForeignPtr, 24 | check, (//), (#|), 25 | at', atM', fi, ti, 26 | 27 | -- * ST 28 | -- | In-place manipulation inside the ST monad. 29 | -- See @examples/inplace.hs@ in the repository. 30 | 31 | -- ** Mutable Vectors 32 | STVector, newVector, thawVector, freezeVector, runSTVector, 33 | readVector, writeVector, modifyVector, liftSTVector, 34 | -- ** Mutable Matrices 35 | STMatrix, newMatrix, thawMatrix, freezeMatrix, runSTMatrix, 36 | readMatrix, writeMatrix, modifyMatrix, liftSTMatrix, 37 | mutable, extractMatrix, setMatrix, rowOper, RowOper(..), RowRange(..), ColRange(..), gemmm, Slice(..), 38 | -- ** Unsafe functions 39 | newUndefinedVector, 40 | unsafeReadVector, unsafeWriteVector, 41 | unsafeThawVector, unsafeFreezeVector, 42 | newUndefinedMatrix, 43 | unsafeReadMatrix, unsafeWriteMatrix, 44 | unsafeThawMatrix, unsafeFreezeMatrix, 45 | 46 | -- * Special maps and zips 47 | mapVectorWithIndex, zipVector, zipVectorWith, unzipVector, unzipVectorWith, 48 | mapVectorM, mapVectorM_, mapVectorWithIndexM, mapVectorWithIndexM_, 49 | foldLoop, foldVector, foldVectorG, foldVectorWithIndex, 50 | mapMatrixWithIndex, mapMatrixWithIndexM, mapMatrixWithIndexM_, 51 | liftMatrix, liftMatrix2, liftMatrix2Auto, 52 | 53 | -- * Sparse representation 54 | CSR(..), fromCSR, mkCSR, impureCSR, 55 | GMatrix(..), 56 | 57 | -- * Misc 58 | toByteString, fromByteString, showInternal, reorderVector 59 | 60 | ) where 61 | 62 | import Internal.Devel 63 | import Internal.ST 64 | import Internal.Vector 65 | import Internal.Matrix 66 | import Internal.Element 67 | import Internal.Sparse 68 | 69 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Transport.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Transport 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Transport( 17 | transport_2_e 18 | , transport_2 19 | , transport_3_e 20 | , transport_3 21 | , transport_4_e 22 | , transport_4 23 | , transport_5_e 24 | , transport_5 25 | ) where 26 | 27 | import Foreign(Ptr) 28 | import Foreign.C.Types 29 | import Numeric.GSL.Special.Internal 30 | 31 | transport_2_e :: Double -> (Double,Double) 32 | transport_2_e x = createSFR "transport_2_e" $ gsl_sf_transport_2_e x 33 | foreign import ccall SAFE_CHEAP "gsl_sf_transport_2_e" gsl_sf_transport_2_e :: Double -> Ptr () -> IO CInt 34 | 35 | transport_2 :: Double -> Double 36 | transport_2 = gsl_sf_transport_2 37 | foreign import ccall SAFE_CHEAP "gsl_sf_transport_2" gsl_sf_transport_2 :: Double -> Double 38 | 39 | transport_3_e :: Double -> (Double,Double) 40 | transport_3_e x = createSFR "transport_3_e" $ gsl_sf_transport_3_e x 41 | foreign import ccall SAFE_CHEAP "gsl_sf_transport_3_e" gsl_sf_transport_3_e :: Double -> Ptr () -> IO CInt 42 | 43 | transport_3 :: Double -> Double 44 | transport_3 = gsl_sf_transport_3 45 | foreign import ccall SAFE_CHEAP "gsl_sf_transport_3" gsl_sf_transport_3 :: Double -> Double 46 | 47 | transport_4_e :: Double -> (Double,Double) 48 | transport_4_e x = createSFR "transport_4_e" $ gsl_sf_transport_4_e x 49 | foreign import ccall SAFE_CHEAP "gsl_sf_transport_4_e" gsl_sf_transport_4_e :: Double -> Ptr () -> IO CInt 50 | 51 | transport_4 :: Double -> Double 52 | transport_4 = gsl_sf_transport_4 53 | foreign import ccall SAFE_CHEAP "gsl_sf_transport_4" gsl_sf_transport_4 :: Double -> Double 54 | 55 | transport_5_e :: Double -> (Double,Double) 56 | transport_5_e x = createSFR "transport_5_e" $ gsl_sf_transport_5_e x 57 | foreign import ccall SAFE_CHEAP "gsl_sf_transport_5_e" gsl_sf_transport_5_e :: Double -> Ptr () -> IO CInt 58 | 59 | transport_5 :: Double -> Double 60 | transport_5 = gsl_sf_transport_5 61 | foreign import ccall SAFE_CHEAP "gsl_sf_transport_5" gsl_sf_transport_5 :: Double -> Double 62 | -------------------------------------------------------------------------------- /packages/tests/hmatrix-tests.cabal: -------------------------------------------------------------------------------- 1 | Name: hmatrix-tests 2 | Version: 0.19.0.0 3 | License: BSD3 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: provisional 8 | Homepage: https://github.com/albertoruiz/hmatrix 9 | Synopsis: Tests for hmatrix 10 | Description: Tests for hmatrix 11 | Category: Math 12 | tested-with: GHC==7.8 13 | 14 | cabal-version: >=1.8 15 | 16 | build-type: Simple 17 | 18 | extra-source-files: CHANGES, 19 | src/TestBase.hs, 20 | src/TestGSL.hs, 21 | src/Benchmark.hs 22 | 23 | flag gsl 24 | description: Enable GSL tests 25 | default: True 26 | 27 | library 28 | Build-Depends: base >= 4 && < 5 29 | , binary 30 | , deepseq 31 | , hmatrix >= 0.18 32 | , HUnit 33 | , random 34 | , QuickCheck >= 2 35 | if flag(gsl) 36 | Build-Depends: hmatrix-gsl >= 0.18 37 | 38 | hs-source-dirs: src 39 | 40 | exposed-modules: Numeric.LinearAlgebra.Tests 41 | if flag(gsl) 42 | exposed-modules: Numeric.GSL.Tests 43 | 44 | other-modules: Numeric.LinearAlgebra.Tests.Instances, 45 | Numeric.LinearAlgebra.Tests.Properties 46 | 47 | ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-orphans 48 | 49 | 50 | source-repository head 51 | type: git 52 | location: https://github.com/albertoruiz/hmatrix 53 | 54 | 55 | test-suite hmatrix-base-testsuite 56 | type: exitcode-stdio-1.0 57 | main-is: src/TestBase.hs 58 | build-depends: base >= 4 && < 5, 59 | hmatrix-tests, 60 | QuickCheck >= 2, HUnit, random 61 | 62 | 63 | test-suite hmatrix-gsl-testsuite 64 | type: exitcode-stdio-1.0 65 | main-is: src/TestGSL.hs 66 | build-depends: base >= 4 && < 5, 67 | hmatrix-tests, 68 | QuickCheck >= 2, HUnit, random 69 | if flag(gsl) 70 | buildable: True 71 | else 72 | buildable: False 73 | 74 | 75 | benchmark hmatrix-base-benchmark 76 | type: exitcode-stdio-1.0 77 | main-is: src/Benchmark.hs 78 | build-depends: base >= 4 && < 5, 79 | hmatrix-tests, 80 | QuickCheck >= 2, HUnit, random 81 | -------------------------------------------------------------------------------- /packages/base/src/Internal/Random.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Numeric.LinearAlgebra.Random 4 | -- Copyright : (c) Alberto Ruiz 2009-14 5 | -- License : BSD3 6 | -- Maintainer : Alberto Ruiz 7 | -- Stability : provisional 8 | -- 9 | -- Random vectors and matrices. 10 | -- 11 | ----------------------------------------------------------------------------- 12 | 13 | module Internal.Random ( 14 | Seed, 15 | RandDist(..), 16 | randomVector, 17 | gaussianSample, 18 | uniformSample, 19 | rand, randn 20 | ) where 21 | 22 | import Internal.Vectorized 23 | import Internal.Vector 24 | import Internal.Matrix 25 | import Internal.Numeric 26 | import Internal.Algorithms 27 | import System.Random(randomIO) 28 | 29 | -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate 30 | -- Gaussian distribution. 31 | gaussianSample :: Seed 32 | -> Int -- ^ number of rows 33 | -> Vector Double -- ^ mean vector 34 | -> Herm Double -- ^ covariance matrix 35 | -> Matrix Double -- ^ result 36 | gaussianSample seed n med cov = m where 37 | c = dim med 38 | meds = konst' 1 n `outer` med 39 | rs = reshape c $ randomVector seed Gaussian (c * n) 40 | m = rs `mXm` chol cov `add` meds 41 | 42 | -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate 43 | -- uniform distribution. 44 | uniformSample :: Seed 45 | -> Int -- ^ number of rows 46 | -> [(Double,Double)] -- ^ ranges for each column 47 | -> Matrix Double -- ^ result 48 | uniformSample seed n rgs = m where 49 | (as,bs) = unzip rgs 50 | a = fromList as 51 | cs = zipWith subtract as bs 52 | d = dim a 53 | dat = toRows $ reshape n $ randomVector seed Uniform (n*d) 54 | am = konst' 1 n `outer` a 55 | m = fromColumns (zipWith scale cs dat) `add` am 56 | 57 | -- | pseudorandom matrix with uniform elements between 0 and 1 58 | randm :: RandDist 59 | -> Int -- ^ rows 60 | -> Int -- ^ columns 61 | -> IO (Matrix Double) 62 | randm d r c = do 63 | seed <- randomIO 64 | return (reshape c $ randomVector seed d (r*c)) 65 | 66 | -- | pseudorandom matrix with uniform elements between 0 and 1 67 | rand :: Int -> Int -> IO (Matrix Double) 68 | rand = randm Uniform 69 | 70 | {- | pseudorandom matrix with normal elements 71 | 72 | >>> disp 3 =<< randn 3 5 73 | 3x5 74 | 0.386 -1.141 0.491 -0.510 1.512 75 | 0.069 -0.919 1.022 -0.181 0.745 76 | 0.313 -0.670 -0.097 -1.575 -0.583 77 | 78 | -} 79 | randn :: Int -> Int -> IO (Matrix Double) 80 | randn = randm Gaussian 81 | 82 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Laguerre.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Laguerre 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Laguerre( 17 | laguerre_1_e 18 | , laguerre_2_e 19 | , laguerre_3_e 20 | , laguerre_1 21 | , laguerre_2 22 | , laguerre_3 23 | , laguerre_n_e 24 | , laguerre_n 25 | ) where 26 | 27 | import Foreign(Ptr) 28 | import Foreign.C.Types 29 | import Numeric.GSL.Special.Internal 30 | 31 | laguerre_1_e :: Double -> Double -> (Double,Double) 32 | laguerre_1_e a x = createSFR "laguerre_1_e" $ gsl_sf_laguerre_1_e a x 33 | foreign import ccall SAFE_CHEAP "gsl_sf_laguerre_1_e" gsl_sf_laguerre_1_e :: Double -> Double -> Ptr () -> IO CInt 34 | 35 | laguerre_2_e :: Double -> Double -> (Double,Double) 36 | laguerre_2_e a x = createSFR "laguerre_2_e" $ gsl_sf_laguerre_2_e a x 37 | foreign import ccall SAFE_CHEAP "gsl_sf_laguerre_2_e" gsl_sf_laguerre_2_e :: Double -> Double -> Ptr () -> IO CInt 38 | 39 | laguerre_3_e :: Double -> Double -> (Double,Double) 40 | laguerre_3_e a x = createSFR "laguerre_3_e" $ gsl_sf_laguerre_3_e a x 41 | foreign import ccall SAFE_CHEAP "gsl_sf_laguerre_3_e" gsl_sf_laguerre_3_e :: Double -> Double -> Ptr () -> IO CInt 42 | 43 | laguerre_1 :: Double -> Double -> Double 44 | laguerre_1 = gsl_sf_laguerre_1 45 | foreign import ccall SAFE_CHEAP "gsl_sf_laguerre_1" gsl_sf_laguerre_1 :: Double -> Double -> Double 46 | 47 | laguerre_2 :: Double -> Double -> Double 48 | laguerre_2 = gsl_sf_laguerre_2 49 | foreign import ccall SAFE_CHEAP "gsl_sf_laguerre_2" gsl_sf_laguerre_2 :: Double -> Double -> Double 50 | 51 | laguerre_3 :: Double -> Double -> Double 52 | laguerre_3 = gsl_sf_laguerre_3 53 | foreign import ccall SAFE_CHEAP "gsl_sf_laguerre_3" gsl_sf_laguerre_3 :: Double -> Double -> Double 54 | 55 | laguerre_n_e :: CInt -> Double -> Double -> (Double,Double) 56 | laguerre_n_e n a x = createSFR "laguerre_n_e" $ gsl_sf_laguerre_n_e n a x 57 | foreign import ccall SAFE_CHEAP "gsl_sf_laguerre_n_e" gsl_sf_laguerre_n_e :: CInt -> Double -> Double -> Ptr () -> IO CInt 58 | 59 | laguerre_n :: CInt -> Double -> Double -> Double 60 | laguerre_n = gsl_sf_laguerre_n 61 | foreign import ccall SAFE_CHEAP "gsl_sf_laguerre_n" gsl_sf_laguerre_n :: CInt -> Double -> Double -> Double 62 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Log.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Log 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Log( 17 | log_e 18 | , Numeric.GSL.Special.Log.log 19 | , log_abs_e 20 | , log_abs 21 | , complex_log_e 22 | , log_1plusx_e 23 | , log_1plusx 24 | , log_1plusx_mx_e 25 | , log_1plusx_mx 26 | ) where 27 | 28 | import Foreign(Ptr) 29 | import Foreign.C.Types 30 | import Numeric.GSL.Special.Internal 31 | 32 | log_e :: Double -> (Double,Double) 33 | log_e x = createSFR "log_e" $ gsl_sf_log_e x 34 | foreign import ccall SAFE_CHEAP "gsl_sf_log_e" gsl_sf_log_e :: Double -> Ptr () -> IO CInt 35 | 36 | log :: Double -> Double 37 | log = gsl_sf_log 38 | foreign import ccall SAFE_CHEAP "gsl_sf_log" gsl_sf_log :: Double -> Double 39 | 40 | log_abs_e :: Double -> (Double,Double) 41 | log_abs_e x = createSFR "log_abs_e" $ gsl_sf_log_abs_e x 42 | foreign import ccall SAFE_CHEAP "gsl_sf_log_abs_e" gsl_sf_log_abs_e :: Double -> Ptr () -> IO CInt 43 | 44 | log_abs :: Double -> Double 45 | log_abs = gsl_sf_log_abs 46 | foreign import ccall SAFE_CHEAP "gsl_sf_log_abs" gsl_sf_log_abs :: Double -> Double 47 | 48 | complex_log_e :: Double -> Double -> ((Double,Double),(Double,Double)) 49 | complex_log_e zr zi = create2SFR "complex_log_e" $ gsl_sf_complex_log_e zr zi 50 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_log_e" gsl_sf_complex_log_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt 51 | 52 | log_1plusx_e :: Double -> (Double,Double) 53 | log_1plusx_e x = createSFR "log_1plusx_e" $ gsl_sf_log_1plusx_e x 54 | foreign import ccall SAFE_CHEAP "gsl_sf_log_1plusx_e" gsl_sf_log_1plusx_e :: Double -> Ptr () -> IO CInt 55 | 56 | log_1plusx :: Double -> Double 57 | log_1plusx = gsl_sf_log_1plusx 58 | foreign import ccall SAFE_CHEAP "gsl_sf_log_1plusx" gsl_sf_log_1plusx :: Double -> Double 59 | 60 | log_1plusx_mx_e :: Double -> (Double,Double) 61 | log_1plusx_mx_e x = createSFR "log_1plusx_mx_e" $ gsl_sf_log_1plusx_mx_e x 62 | foreign import ccall SAFE_CHEAP "gsl_sf_log_1plusx_mx_e" gsl_sf_log_1plusx_mx_e :: Double -> Ptr () -> IO CInt 63 | 64 | log_1plusx_mx :: Double -> Double 65 | log_1plusx_mx = gsl_sf_log_1plusx_mx 66 | foreign import ccall SAFE_CHEAP "gsl_sf_log_1plusx_mx" gsl_sf_log_1plusx_mx :: Double -> Double 67 | -------------------------------------------------------------------------------- /packages/gsl/src/Numeric/GSL/Random.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Numeric.GSL.Random 5 | -- Copyright : (c) Alberto Ruiz 2009-14 6 | -- License : GPL 7 | -- 8 | -- Maintainer : Alberto Ruiz 9 | -- Stability : provisional 10 | -- 11 | -- Random vectors and matrices. 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Numeric.GSL.Random ( 16 | Seed, 17 | RandDist(..), 18 | randomVector, 19 | gaussianSample, 20 | uniformSample, 21 | rand, randn 22 | ) where 23 | 24 | import Numeric.GSL.Vector 25 | import Numeric.LinearAlgebra.HMatrix hiding ( 26 | randomVector, 27 | gaussianSample, 28 | uniformSample, 29 | Seed, 30 | rand, 31 | randn 32 | ) 33 | import System.Random(randomIO) 34 | #if MIN_VERSION_base(4,11,0) 35 | import Prelude hiding ((<>)) 36 | #endif 37 | 38 | type Seed = Int 39 | 40 | -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate 41 | -- Gaussian distribution. 42 | gaussianSample :: Seed 43 | -> Int -- ^ number of rows 44 | -> Vector Double -- ^ mean vector 45 | -> Herm Double -- ^ covariance matrix 46 | -> Matrix Double -- ^ result 47 | gaussianSample seed n med cov = m where 48 | c = size med 49 | meds = konst 1 n `outer` med 50 | rs = reshape c $ randomVector seed Gaussian (c * n) 51 | m = rs <> chol cov + meds 52 | 53 | -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate 54 | -- uniform distribution. 55 | uniformSample :: Seed 56 | -> Int -- ^ number of rows 57 | -> [(Double,Double)] -- ^ ranges for each column 58 | -> Matrix Double -- ^ result 59 | uniformSample seed n rgs = m where 60 | (as,bs) = unzip rgs 61 | a = fromList as 62 | cs = zipWith subtract as bs 63 | d = size a 64 | dat = toRows $ reshape n $ randomVector seed Uniform (n*d) 65 | am = konst 1 n `outer` a 66 | m = fromColumns (zipWith scale cs dat) + am 67 | 68 | -- | pseudorandom matrix with uniform elements between 0 and 1 69 | randm :: RandDist 70 | -> Int -- ^ rows 71 | -> Int -- ^ columns 72 | -> IO (Matrix Double) 73 | randm d r c = do 74 | seed <- randomIO 75 | return (reshape c $ randomVector seed d (r*c)) 76 | 77 | -- | pseudorandom matrix with uniform elements between 0 and 1 78 | rand :: Int -> Int -> IO (Matrix Double) 79 | rand = randm Uniform 80 | 81 | {- | pseudorandom matrix with normal elements 82 | 83 | >>> x <- randn 3 5 84 | >>> disp 3 x 85 | 3x5 86 | 0.386 -1.141 0.491 -0.510 1.512 87 | 0.069 -0.919 1.022 -0.181 0.745 88 | 0.313 -0.670 -0.097 -1.575 -0.583 89 | 90 | -} 91 | randn :: Int -> Int -> IO (Matrix Double) 92 | randn = randm Gaussian 93 | -------------------------------------------------------------------------------- /examples/multiply.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE UnicodeSyntax 2 | , MultiParamTypeClasses 3 | , FunctionalDependencies 4 | , FlexibleInstances 5 | , FlexibleContexts 6 | -- , OverlappingInstances 7 | , UndecidableInstances #-} 8 | 9 | import Numeric.LinearAlgebra 10 | 11 | class Scaling a b c | a b -> c where 12 | -- ^ 0x22C5 8901 DOT OPERATOR, scaling 13 | infixl 7 ⋅ 14 | (⋅) :: a -> b -> c 15 | 16 | instance (Num t) => Scaling t t t where 17 | (⋅) = (*) 18 | 19 | instance Container Vector t => Scaling t (Vector t) (Vector t) where 20 | (⋅) = scale 21 | 22 | instance Container Vector t => Scaling (Vector t) t (Vector t) where 23 | (⋅) = flip scale 24 | 25 | instance (Num t, Container Vector t) => Scaling t (Matrix t) (Matrix t) where 26 | (⋅) = scale 27 | 28 | instance (Num t, Container Vector t) => Scaling (Matrix t) t (Matrix t) where 29 | (⋅) = flip scale 30 | 31 | 32 | class Mul a b c | a b -> c, a c -> b, b c -> a where 33 | -- ^ 0x00D7 215 MULTIPLICATION SIGN ×, contraction 34 | infixl 7 × 35 | (×) :: a -> b -> c 36 | 37 | 38 | ------- 39 | 40 | 41 | 42 | instance Product t => Mul (Vector t) (Vector t) t where 43 | (×) = udot 44 | 45 | instance (Numeric t, Product t) => Mul (Matrix t) (Vector t) (Vector t) where 46 | (×) = (#>) 47 | 48 | instance (Numeric t, Product t) => Mul (Vector t) (Matrix t) (Vector t) where 49 | (×) = (<#) 50 | 51 | instance (Numeric t, Product t) => Mul (Matrix t) (Matrix t) (Matrix t) where 52 | (×) = (<>) 53 | 54 | 55 | --instance Scaling a b c => Contraction a b c where 56 | -- (×) = (⋅) 57 | 58 | -------------------------------------------------------------------------------- 59 | 60 | class Outer a 61 | where 62 | infixl 7 ⊗ 63 | -- | unicode 0x2297 8855 CIRCLED TIMES ⊗ 64 | -- 65 | -- vector outer product and matrix Kronecker product 66 | (⊗) :: Product t => a t -> a t -> Matrix t 67 | 68 | instance Outer Vector where 69 | (⊗) = outer 70 | 71 | instance Outer Matrix where 72 | (⊗) = kronecker 73 | 74 | -------------------------------------------------------------------------------- 75 | 76 | 77 | v = 3 |> [1..] :: Vector Double 78 | 79 | m = (3 >< 3) [1..] :: Matrix Double 80 | 81 | s = 3 :: Double 82 | 83 | a = s ⋅ v × m × m × v ⋅ s 84 | 85 | --b = (v ⊗ m) ⊗ (v ⊗ m) 86 | 87 | --c = v ⊗ m ⊗ v ⊗ m 88 | 89 | d = s ⋅ (3 |> [10,20..] :: Vector Double) 90 | 91 | u = fromList [3,0,5] 92 | w = konst 1 (2,3) :: Matrix Double 93 | 94 | main = do 95 | print $ (scale s v <# m) `udot` v 96 | print $ scale s v `udot` (m #> v) 97 | print $ s * ((v <# m) `udot` v) 98 | print $ s ⋅ v × m × v 99 | print a 100 | -- print (b == c) 101 | print d 102 | print $ asColumn u ⊗ w 103 | print $ w ⊗ asColumn u 104 | 105 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | A Haskell library for numerical computation 2 | ------------------------------------------- 3 | 4 | A purely functional interface to linear algebra and other numerical 5 | algorithms, internally implemented using [LAPACK][lapack], 6 | [BLAS][blas], [GSL][gsl] and [GLPK][glpk]. 7 | 8 | This package includes matrix decompositions (eigensystems, singular 9 | values, Cholesky, QR, etc.), linear solvers, numeric integration, root 10 | finding, etc. 11 | 12 | - [What's new][changes] in version 0.19 (April 2018). This is not 13 | intended to be a breaking change but a lot of modules have been 14 | modified to ensure that continuous integration is green. 15 | 16 | - [Code examples][examples] 17 | 18 | - Source code and documentation (Hackage) 19 | - linear algebra: [hmatrix][hmatrix] 20 | - numeric algorithms: [hmatrix-gsl][hmatrix-gsl] 21 | - special functions: [hmatrix-special][hmatrix-special] 22 | - linear programming: [hmatrix-glpk][hmatrix-glpk] 23 | 24 | - [Tutorial (old version)][tutorial] 25 | 26 | - [Installation help][installation] 27 | 28 | For numerical algorithms internally implemented using [SUNDIALS][sundials], see 29 | package [hmatrix-sundials] and its separate respository. 30 | 31 | Contributions, suggestions, and bug reports are welcome! 32 | 33 | 34 | 35 | [lapack]: https://www.netlib.org/lapack/ 36 | [blas]: https://www.netlib.org/blas/ 37 | [glpk]: https://www.gnu.org/software/glpk/ 38 | [gsl]: https://www.gnu.org/software/gsl/ 39 | [sundials]: https://computation.llnl.gov/projects/sundials 40 | 41 | [tutorial]: http://dis.um.es/profesores/alberto/material/hmatrix.pdf 42 | [installation]: https://github.com/AlbertoRuiz/hmatrix/blob/master/INSTALL.md 43 | [changes]: https://github.com/albertoruiz/hmatrix/tree/master/packages/base/CHANGELOG 44 | [examples]: http://dis.um.es/~alberto/hmatrix/hmatrix.html 45 | 46 | [hmatrix]: https://hackage.haskell.org/package/hmatrix 47 | [hmatrix-glpk]: https://hackage.haskell.org/package/hmatrix-glpk 48 | [hmatrix-gsl]: https://hackage.haskell.org/package/hmatrix-gsl 49 | [hmatrix-gsl-stats]: https://hackage.haskell.org/package/hmatrix-gsl-stats 50 | [hmatrix-special]: https://hackage.haskell.org/package/hmatrix-special 51 | [hmatrix-static]: https://hackage.haskell.org/package/hmatrix-static 52 | [hmatrix-sundials]: https://hackage.haskell.org/package/hmatrix-sundials 53 | [hstatistics]: https://hackage.haskell.org/package/hstatistics 54 | [hsignal]: https://hackage.haskell.org/package/hsignal 55 | [hTensor]: https://github.com/AlbertoRuiz/hTensor 56 | [pBLAS]: https://hackage.haskell.org/package/blas 57 | [pLAPACK]: https://github.com/patperry/lapack 58 | [aGSL]: https://hackage.haskell.org/package/bindings-gsl 59 | [nprelude]: https://hackage.haskell.org/package/numeric-prelude 60 | [mathHack]: https://hackage.haskell.org/packages/#cat:Math 61 | [easyVision]: https://github.com/AlbertoRuiz/easyVision 62 | [repa]: https://hackage.haskell.org/package/repa 63 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Erf.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Erf 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Erf( 17 | erfc_e 18 | , erfc 19 | , log_erfc_e 20 | , log_erfc 21 | , erf_e 22 | , erf 23 | , erf_Z_e 24 | , erf_Q_e 25 | , erf_Z 26 | , erf_Q 27 | , hazard_e 28 | , hazard 29 | ) where 30 | 31 | import Foreign(Ptr) 32 | import Foreign.C.Types 33 | import Numeric.GSL.Special.Internal 34 | 35 | erfc_e :: Double -> (Double,Double) 36 | erfc_e x = createSFR "erfc_e" $ gsl_sf_erfc_e x 37 | foreign import ccall SAFE_CHEAP "gsl_sf_erfc_e" gsl_sf_erfc_e :: Double -> Ptr () -> IO CInt 38 | 39 | erfc :: Double -> Double 40 | erfc = gsl_sf_erfc 41 | foreign import ccall SAFE_CHEAP "gsl_sf_erfc" gsl_sf_erfc :: Double -> Double 42 | 43 | log_erfc_e :: Double -> (Double,Double) 44 | log_erfc_e x = createSFR "log_erfc_e" $ gsl_sf_log_erfc_e x 45 | foreign import ccall SAFE_CHEAP "gsl_sf_log_erfc_e" gsl_sf_log_erfc_e :: Double -> Ptr () -> IO CInt 46 | 47 | log_erfc :: Double -> Double 48 | log_erfc = gsl_sf_log_erfc 49 | foreign import ccall SAFE_CHEAP "gsl_sf_log_erfc" gsl_sf_log_erfc :: Double -> Double 50 | 51 | erf_e :: Double -> (Double,Double) 52 | erf_e x = createSFR "erf_e" $ gsl_sf_erf_e x 53 | foreign import ccall SAFE_CHEAP "gsl_sf_erf_e" gsl_sf_erf_e :: Double -> Ptr () -> IO CInt 54 | 55 | erf :: Double -> Double 56 | erf = gsl_sf_erf 57 | foreign import ccall SAFE_CHEAP "gsl_sf_erf" gsl_sf_erf :: Double -> Double 58 | 59 | erf_Z_e :: Double -> (Double,Double) 60 | erf_Z_e x = createSFR "erf_Z_e" $ gsl_sf_erf_Z_e x 61 | foreign import ccall SAFE_CHEAP "gsl_sf_erf_Z_e" gsl_sf_erf_Z_e :: Double -> Ptr () -> IO CInt 62 | 63 | erf_Q_e :: Double -> (Double,Double) 64 | erf_Q_e x = createSFR "erf_Q_e" $ gsl_sf_erf_Q_e x 65 | foreign import ccall SAFE_CHEAP "gsl_sf_erf_Q_e" gsl_sf_erf_Q_e :: Double -> Ptr () -> IO CInt 66 | 67 | erf_Z :: Double -> Double 68 | erf_Z = gsl_sf_erf_Z 69 | foreign import ccall SAFE_CHEAP "gsl_sf_erf_Z" gsl_sf_erf_Z :: Double -> Double 70 | 71 | erf_Q :: Double -> Double 72 | erf_Q = gsl_sf_erf_Q 73 | foreign import ccall SAFE_CHEAP "gsl_sf_erf_Q" gsl_sf_erf_Q :: Double -> Double 74 | 75 | hazard_e :: Double -> (Double,Double) 76 | hazard_e x = createSFR "hazard_e" $ gsl_sf_hazard_e x 77 | foreign import ccall SAFE_CHEAP "gsl_sf_hazard_e" gsl_sf_hazard_e :: Double -> Ptr () -> IO CInt 78 | 79 | hazard :: Double -> Double 80 | hazard = gsl_sf_hazard 81 | foreign import ccall SAFE_CHEAP "gsl_sf_hazard" gsl_sf_hazard :: Double -> Double 82 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 4 | 5 | ------------------------------------------------------------ 6 | -- | 7 | -- Module : Numeric.GSL.Special.Gegenbauer 8 | -- Copyright : (c) Alberto Ruiz 2006-11 9 | -- License : GPL 10 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 11 | -- Stability : provisional 12 | -- Portability : uses ffi 13 | -- 14 | -- Wrappers for selected functions described at: 15 | -- 16 | -- 17 | ------------------------------------------------------------ 18 | 19 | module Numeric.GSL.Special.Gegenbauer( 20 | gegenpoly_1_e 21 | , gegenpoly_2_e 22 | , gegenpoly_3_e 23 | , gegenpoly_1 24 | , gegenpoly_2 25 | , gegenpoly_3 26 | , gegenpoly_n_e 27 | , gegenpoly_n 28 | ) where 29 | 30 | import Foreign(Ptr) 31 | import Foreign.C.Types 32 | import Numeric.GSL.Special.Internal 33 | 34 | gegenpoly_1_e :: Double -> Double -> (Double,Double) 35 | gegenpoly_1_e lambda x = createSFR "gegenpoly_1_e" $ gsl_sf_gegenpoly_1_e lambda x 36 | foreign import ccall SAFE_CHEAP "gsl_sf_gegenpoly_1_e" gsl_sf_gegenpoly_1_e :: Double -> Double -> Ptr () -> IO CInt 37 | 38 | gegenpoly_2_e :: Double -> Double -> (Double,Double) 39 | gegenpoly_2_e lambda x = createSFR "gegenpoly_2_e" $ gsl_sf_gegenpoly_2_e lambda x 40 | foreign import ccall SAFE_CHEAP "gsl_sf_gegenpoly_2_e" gsl_sf_gegenpoly_2_e :: Double -> Double -> Ptr () -> IO CInt 41 | 42 | gegenpoly_3_e :: Double -> Double -> (Double,Double) 43 | gegenpoly_3_e lambda x = createSFR "gegenpoly_3_e" $ gsl_sf_gegenpoly_3_e lambda x 44 | foreign import ccall SAFE_CHEAP "gsl_sf_gegenpoly_3_e" gsl_sf_gegenpoly_3_e :: Double -> Double -> Ptr () -> IO CInt 45 | 46 | gegenpoly_1 :: Double -> Double -> Double 47 | gegenpoly_1 = gsl_sf_gegenpoly_1 48 | foreign import ccall SAFE_CHEAP "gsl_sf_gegenpoly_1" gsl_sf_gegenpoly_1 :: Double -> Double -> Double 49 | 50 | gegenpoly_2 :: Double -> Double -> Double 51 | gegenpoly_2 = gsl_sf_gegenpoly_2 52 | foreign import ccall SAFE_CHEAP "gsl_sf_gegenpoly_2" gsl_sf_gegenpoly_2 :: Double -> Double -> Double 53 | 54 | gegenpoly_3 :: Double -> Double -> Double 55 | gegenpoly_3 = gsl_sf_gegenpoly_3 56 | foreign import ccall SAFE_CHEAP "gsl_sf_gegenpoly_3" gsl_sf_gegenpoly_3 :: Double -> Double -> Double 57 | 58 | gegenpoly_n_e :: CInt -> Double -> Double -> (Double,Double) 59 | gegenpoly_n_e n lambda x = createSFR "gegenpoly_n_e" $ gsl_sf_gegenpoly_n_e n lambda x 60 | foreign import ccall SAFE_CHEAP "gsl_sf_gegenpoly_n_e" gsl_sf_gegenpoly_n_e :: CInt -> Double -> Double -> Ptr () -> IO CInt 61 | 62 | gegenpoly_n :: CInt -> Double -> Double -> Double 63 | gegenpoly_n = gsl_sf_gegenpoly_n 64 | foreign import ccall SAFE_CHEAP "gsl_sf_gegenpoly_n" gsl_sf_gegenpoly_n :: CInt -> Double -> Double -> Double 65 | 66 | gegenpoly_array :: CInt -> Double -> Double -> Ptr Double -> CInt 67 | gegenpoly_array = gsl_sf_gegenpoly_array 68 | foreign import ccall SAFE_CHEAP "gsl_sf_gegenpoly_array" gsl_sf_gegenpoly_array :: CInt -> Double -> Double -> Ptr Double -> CInt 69 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Debye.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Debye 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Debye( 17 | debye_1_e 18 | , debye_1 19 | , debye_2_e 20 | , debye_2 21 | , debye_3_e 22 | , debye_3 23 | , debye_4_e 24 | , debye_4 25 | , debye_5_e 26 | , debye_5 27 | , debye_6_e 28 | , debye_6 29 | ) where 30 | 31 | import Foreign(Ptr) 32 | import Foreign.C.Types 33 | import Numeric.GSL.Special.Internal 34 | 35 | debye_1_e :: Double -> (Double,Double) 36 | debye_1_e x = createSFR "debye_1_e" $ gsl_sf_debye_1_e x 37 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_1_e" gsl_sf_debye_1_e :: Double -> Ptr () -> IO CInt 38 | 39 | debye_1 :: Double -> Double 40 | debye_1 = gsl_sf_debye_1 41 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_1" gsl_sf_debye_1 :: Double -> Double 42 | 43 | debye_2_e :: Double -> (Double,Double) 44 | debye_2_e x = createSFR "debye_2_e" $ gsl_sf_debye_2_e x 45 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_2_e" gsl_sf_debye_2_e :: Double -> Ptr () -> IO CInt 46 | 47 | debye_2 :: Double -> Double 48 | debye_2 = gsl_sf_debye_2 49 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_2" gsl_sf_debye_2 :: Double -> Double 50 | 51 | debye_3_e :: Double -> (Double,Double) 52 | debye_3_e x = createSFR "debye_3_e" $ gsl_sf_debye_3_e x 53 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_3_e" gsl_sf_debye_3_e :: Double -> Ptr () -> IO CInt 54 | 55 | debye_3 :: Double -> Double 56 | debye_3 = gsl_sf_debye_3 57 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_3" gsl_sf_debye_3 :: Double -> Double 58 | 59 | debye_4_e :: Double -> (Double,Double) 60 | debye_4_e x = createSFR "debye_4_e" $ gsl_sf_debye_4_e x 61 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_4_e" gsl_sf_debye_4_e :: Double -> Ptr () -> IO CInt 62 | 63 | debye_4 :: Double -> Double 64 | debye_4 = gsl_sf_debye_4 65 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_4" gsl_sf_debye_4 :: Double -> Double 66 | 67 | debye_5_e :: Double -> (Double,Double) 68 | debye_5_e x = createSFR "debye_5_e" $ gsl_sf_debye_5_e x 69 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_5_e" gsl_sf_debye_5_e :: Double -> Ptr () -> IO CInt 70 | 71 | debye_5 :: Double -> Double 72 | debye_5 = gsl_sf_debye_5 73 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_5" gsl_sf_debye_5 :: Double -> Double 74 | 75 | debye_6_e :: Double -> (Double,Double) 76 | debye_6_e x = createSFR "debye_6_e" $ gsl_sf_debye_6_e x 77 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_6_e" gsl_sf_debye_6_e :: Double -> Ptr () -> IO CInt 78 | 79 | debye_6 :: Double -> Double 80 | debye_6 = gsl_sf_debye_6 81 | foreign import ccall SAFE_CHEAP "gsl_sf_debye_6" gsl_sf_debye_6 :: Double -> Double 82 | -------------------------------------------------------------------------------- /packages/special/hmatrix-special.cabal: -------------------------------------------------------------------------------- 1 | Name: hmatrix-special 2 | Version: 0.19.0.0 3 | License: GPL-3 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Alberto Ruiz 7 | Stability: experimental 8 | Homepage: https://github.com/albertoruiz/hmatrix 9 | Synopsis: Interface to GSL special functions 10 | Description: 11 | Interface to GSL special functions. 12 | 13 | Category: Math 14 | tested-with: GHC ==7.4 15 | 16 | cabal-version: >=1.6 17 | build-type: Simple 18 | 19 | extra-source-files: lib/Numeric/GSL/Special/auto.hs, 20 | lib/Numeric/GSL/Special/autoall.sh, 21 | lib/Numeric/GSL/Special/replace.hs, 22 | CHANGES 23 | 24 | flag safe-cheap 25 | description: use slower non-blocking "safe" foreign calls 26 | to GSL special functions. 27 | default: False 28 | 29 | library 30 | Build-Depends: base <5, hmatrix>=0.17, hmatrix-gsl 31 | 32 | Extensions: ForeignFunctionInterface 33 | 34 | hs-source-dirs: lib 35 | 36 | Exposed-modules: Numeric.GSL.Special, 37 | Numeric.GSL.Special.Gamma, 38 | Numeric.GSL.Special.Erf, 39 | Numeric.GSL.Special.Airy, 40 | Numeric.GSL.Special.Exp, 41 | Numeric.GSL.Special.Bessel, 42 | Numeric.GSL.Special.Clausen, 43 | Numeric.GSL.Special.Coulomb, 44 | Numeric.GSL.Special.Coupling, 45 | Numeric.GSL.Special.Dawson, 46 | Numeric.GSL.Special.Debye, 47 | Numeric.GSL.Special.Dilog, 48 | Numeric.GSL.Special.Elementary, 49 | Numeric.GSL.Special.Ellint, 50 | Numeric.GSL.Special.Elljac, 51 | Numeric.GSL.Special.Expint, 52 | Numeric.GSL.Special.Fermi_dirac, 53 | Numeric.GSL.Special.Gegenbauer, 54 | Numeric.GSL.Special.Hyperg, 55 | Numeric.GSL.Special.Laguerre, 56 | Numeric.GSL.Special.Lambert, 57 | Numeric.GSL.Special.Legendre, 58 | Numeric.GSL.Special.Log, 59 | Numeric.GSL.Special.Pow_int, 60 | Numeric.GSL.Special.Psi, 61 | Numeric.GSL.Special.Synchrotron, 62 | Numeric.GSL.Special.Transport, 63 | Numeric.GSL.Special.Trig, 64 | Numeric.GSL.Special.Zeta 65 | 66 | other-modules: Numeric.GSL.Special.Internal 67 | 68 | ghc-options: -Wall -fno-warn-unused-binds 69 | 70 | if flag(safe-cheap) 71 | cpp-options: -DSAFE_CHEAP=safe 72 | else 73 | cpp-options: -DSAFE_CHEAP=unsafe 74 | 75 | source-repository head 76 | type: git 77 | location: https://github.com/albertoruiz/hmatrix 78 | 79 | -------------------------------------------------------------------------------- /packages/base/src/Internal/Conversion.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE FunctionalDependencies #-} 6 | 7 | ----------------------------------------------------------------------------- 8 | -- | 9 | -- Module : Numeric.Conversion 10 | -- Copyright : (c) Alberto Ruiz 2010 11 | -- License : BSD3 12 | -- Maintainer : Alberto Ruiz 13 | -- Stability : provisional 14 | -- 15 | -- Conversion routines 16 | -- 17 | ----------------------------------------------------------------------------- 18 | 19 | 20 | module Internal.Conversion ( 21 | Complexable(..), RealElement, 22 | module Data.Complex 23 | ) where 24 | 25 | import Internal.Vector 26 | import Internal.Matrix 27 | import Internal.Vectorized 28 | import Data.Complex 29 | import Control.Arrow((***)) 30 | 31 | ------------------------------------------------------------------- 32 | 33 | -- | Supported single-double precision type pairs 34 | class (Element s, Element d) => Precision s d | s -> d, d -> s where 35 | double2FloatG :: Vector d -> Vector s 36 | float2DoubleG :: Vector s -> Vector d 37 | 38 | instance Precision Float Double where 39 | double2FloatG = double2FloatV 40 | float2DoubleG = float2DoubleV 41 | 42 | instance Precision (Complex Float) (Complex Double) where 43 | double2FloatG = asComplex . double2FloatV . asReal 44 | float2DoubleG = asComplex . float2DoubleV . asReal 45 | 46 | instance Precision I Z where 47 | double2FloatG = long2intV 48 | float2DoubleG = int2longV 49 | 50 | 51 | -- | Supported real types 52 | class (Element t, Element (Complex t), RealFloat t) 53 | => RealElement t 54 | 55 | instance RealElement Double 56 | instance RealElement Float 57 | 58 | 59 | -- | Structures that may contain complex numbers 60 | class Complexable c where 61 | toComplex' :: (RealElement e) => (c e, c e) -> c (Complex e) 62 | fromComplex' :: (RealElement e) => c (Complex e) -> (c e, c e) 63 | comp' :: (RealElement e) => c e -> c (Complex e) 64 | single' :: Precision a b => c b -> c a 65 | double' :: Precision a b => c a -> c b 66 | 67 | 68 | instance Complexable Vector where 69 | toComplex' = toComplexV 70 | fromComplex' = fromComplexV 71 | comp' v = toComplex' (v,constantD 0 (dim v)) 72 | single' = double2FloatG 73 | double' = float2DoubleG 74 | 75 | 76 | -- | creates a complex vector from vectors with real and imaginary parts 77 | toComplexV :: (RealElement a) => (Vector a, Vector a) -> Vector (Complex a) 78 | toComplexV (r,i) = asComplex $ flatten $ fromColumns [r,i] 79 | 80 | -- | the inverse of 'toComplex' 81 | fromComplexV :: (RealElement a) => Vector (Complex a) -> (Vector a, Vector a) 82 | fromComplexV z = (r,i) where 83 | [r,i] = toColumns $ reshape 2 $ asReal z 84 | 85 | 86 | instance Complexable Matrix where 87 | toComplex' = uncurry $ liftMatrix2 $ curry toComplex' 88 | fromComplex' z = (reshape c *** reshape c) . fromComplex' . flatten $ z 89 | where c = cols z 90 | comp' = liftMatrix comp' 91 | single' = liftMatrix single' 92 | double' = liftMatrix double' 93 | 94 | -------------------------------------------------------------------------------- /packages/base/src/Numeric/LinearAlgebra/Data.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeOperators #-} 2 | 3 | -------------------------------------------------------------------------------- 4 | {- | 5 | Module : Numeric.LinearAlgebra.Data 6 | Copyright : (c) Alberto Ruiz 2015 7 | License : BSD3 8 | Maintainer : Alberto Ruiz 9 | Stability : provisional 10 | 11 | This module provides functions for creation and manipulation of vectors and matrices, IO, and other utilities. 12 | 13 | -} 14 | -------------------------------------------------------------------------------- 15 | 16 | module Numeric.LinearAlgebra.Data( 17 | 18 | -- * Elements 19 | R,C,I,Z,type(./.), 20 | 21 | -- * Vector 22 | {- | 1D arrays are storable vectors directly reexported from the vector package. 23 | -} 24 | 25 | fromList, toList, (|>), vector, range, idxs, 26 | 27 | -- * Matrix 28 | 29 | {- | The main data type of hmatrix is a 2D dense array defined on top of 30 | a storable vector. The internal representation is suitable for direct 31 | interface with standard numeric libraries. 32 | -} 33 | 34 | (><), matrix, tr, tr', 35 | 36 | -- * Dimensions 37 | 38 | size, rows, cols, 39 | 40 | -- * Conversion from\/to lists 41 | 42 | fromLists, toLists, 43 | row, col, 44 | 45 | -- * Conversions vector\/matrix 46 | 47 | flatten, reshape, asRow, asColumn, 48 | fromRows, toRows, fromColumns, toColumns, 49 | 50 | -- * Indexing 51 | 52 | atIndex, 53 | Indexable(..), 54 | 55 | -- * Construction 56 | scalar, Konst(..), Build(..), assoc, accum, linspace, -- ones, zeros, 57 | 58 | -- * Diagonal 59 | ident, diag, diagl, diagRect, takeDiag, 60 | 61 | -- * Vector extraction 62 | subVector, takesV, vjoin, 63 | 64 | -- * Matrix extraction 65 | Extractor(..), (??), 66 | 67 | (?), (¿), fliprl, flipud, 68 | 69 | subMatrix, takeRows, dropRows, takeColumns, dropColumns, 70 | 71 | remap, 72 | 73 | -- * Block matrix 74 | fromBlocks, (|||), (===), diagBlock, repmat, toBlocks, toBlocksEvery, 75 | 76 | -- * Mapping functions 77 | conj, cmap, cmod, 78 | 79 | step, cond, 80 | 81 | -- * Find elements 82 | find, maxIndex, minIndex, maxElement, minElement, 83 | sortVector, sortIndex, 84 | 85 | -- * Sparse 86 | AssocMatrix, toDense, 87 | mkSparse, mkDiagR, mkDense, 88 | 89 | -- * IO 90 | disp, 91 | loadMatrix, loadMatrix', saveMatrix, 92 | latexFormat, 93 | dispf, disps, dispcf, format, 94 | dispDots, dispBlanks, dispShort, 95 | -- * Element conversion 96 | Convert(..), 97 | roundVector, 98 | fromInt,toInt,fromZ,toZ, 99 | -- * Misc 100 | arctan2, 101 | separable, 102 | fromArray2D, 103 | module Data.Complex, 104 | Mod, 105 | Vector, Matrix, GMatrix, nRows, nCols 106 | 107 | ) where 108 | 109 | import Internal.Vector 110 | import Internal.Vectorized 111 | import Internal.Matrix hiding (size) 112 | import Internal.Element 113 | import Internal.IO 114 | import Internal.Numeric 115 | import Internal.Container 116 | import Internal.Util hiding ((&)) 117 | import Data.Complex 118 | import Internal.Sparse 119 | import Internal.Modular 120 | 121 | 122 | -------------------------------------------------------------------------------- /packages/base/src/Internal/Devel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeOperators #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | 4 | -- | 5 | -- Module : Internal.Devel 6 | -- Copyright : (c) Alberto Ruiz 2007-15 7 | -- License : BSD3 8 | -- Maintainer : Alberto Ruiz 9 | -- Stability : provisional 10 | -- 11 | 12 | module Internal.Devel where 13 | 14 | 15 | import Control.Monad ( when ) 16 | import Foreign.C.Types ( CInt ) 17 | --import Foreign.Storable.Complex () 18 | import Foreign.Ptr(Ptr) 19 | import Control.Exception (SomeException, SomeAsyncException (..)) 20 | import qualified Control.Exception as Exception 21 | import Internal.Vector(Vector,avec) 22 | import Foreign.Storable(Storable) 23 | 24 | -- | postfix function application (@flip ($)@) 25 | (//) :: x -> (x -> y) -> y 26 | infixl 0 // 27 | (//) = flip ($) 28 | 29 | 30 | -- GSL error codes are <= 1024 31 | -- | error codes for the auxiliary functions required by the wrappers 32 | errorCode :: CInt -> String 33 | errorCode 2000 = "bad size" 34 | errorCode 2001 = "bad function code" 35 | errorCode 2002 = "memory problem" 36 | errorCode 2003 = "bad file" 37 | errorCode 2004 = "singular" 38 | errorCode 2005 = "didn't converge" 39 | errorCode 2006 = "the input matrix is not positive definite" 40 | errorCode 2007 = "not yet supported in this OS" 41 | errorCode n = "code "++show n 42 | 43 | 44 | -- | clear the fpu 45 | foreign import ccall unsafe "asm_finit" finit :: IO () 46 | 47 | -- | check the error code 48 | check :: String -> IO CInt -> IO () 49 | check msg f = do 50 | -- finit 51 | err <- f 52 | when (err/=0) $ error (msg++": "++errorCode err) 53 | return () 54 | 55 | 56 | -- | postfix error code check 57 | infixl 0 #| 58 | (#|) :: IO CInt -> String -> IO () 59 | (#|) = flip check 60 | 61 | -- | Error capture and conversion to Maybe 62 | mbCatch :: IO x -> IO (Maybe x) 63 | mbCatch act = 64 | hush <$> 65 | Exception.tryJust 66 | (\e -> if isSyncException e then Just e else Nothing) 67 | act 68 | 69 | where 70 | hush :: Either a b -> Maybe b 71 | hush = either (const Nothing) Just 72 | 73 | isSyncException :: SomeException -> Bool 74 | isSyncException e = 75 | case Exception.fromException e of 76 | Just (SomeAsyncException _) -> False 77 | Nothing -> True 78 | 79 | -------------------------------------------------------------------------------- 80 | 81 | type CM b r = CInt -> CInt -> Ptr b -> r 82 | type CV b r = CInt -> Ptr b -> r 83 | type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r 84 | 85 | type CIdxs r = CV CInt r 86 | type Ok = IO CInt 87 | 88 | infixr 5 :>, ::>, ..> 89 | type (:>) t r = CV t r 90 | type (::>) t r = OM t r 91 | type (..>) t r = CM t r 92 | 93 | class TransArray c 94 | where 95 | type Trans c b 96 | type TransRaw c b 97 | apply :: c -> (b -> IO r) -> (Trans c b) -> IO r 98 | applyRaw :: c -> (b -> IO r) -> (TransRaw c b) -> IO r 99 | infixl 1 `apply`, `applyRaw` 100 | 101 | instance Storable t => TransArray (Vector t) 102 | where 103 | type Trans (Vector t) b = CInt -> Ptr t -> b 104 | type TransRaw (Vector t) b = CInt -> Ptr t -> b 105 | apply = avec 106 | {-# INLINE apply #-} 107 | applyRaw = avec 108 | {-# INLINE applyRaw #-} 109 | -------------------------------------------------------------------------------- /examples/repmat.ipynb: -------------------------------------------------------------------------------- 1 | { 2 | "cells": [ 3 | { 4 | "cell_type": "markdown", 5 | "metadata": {}, 6 | "source": [ 7 | "# repmat" 8 | ] 9 | }, 10 | { 11 | "cell_type": "markdown", 12 | "metadata": {}, 13 | "source": [ 14 | "An alternative implementation of `repmat` using the new in-place tools." 15 | ] 16 | }, 17 | { 18 | "cell_type": "code", 19 | "execution_count": 1, 20 | "metadata": { 21 | "collapsed": false 22 | }, 23 | "outputs": [], 24 | "source": [ 25 | ":ext FlexibleContexts\n", 26 | "\n", 27 | "import Numeric.LinearAlgebra\n", 28 | "import Numeric.LinearAlgebra.Devel" 29 | ] 30 | }, 31 | { 32 | "cell_type": "code", 33 | "execution_count": 2, 34 | "metadata": { 35 | "collapsed": true 36 | }, 37 | "outputs": [], 38 | "source": [ 39 | "m = (3><4)[1..] :: Matrix Z" 40 | ] 41 | }, 42 | { 43 | "cell_type": "code", 44 | "execution_count": 3, 45 | "metadata": { 46 | "collapsed": false 47 | }, 48 | "outputs": [ 49 | { 50 | "data": { 51 | "text/plain": [ 52 | "(3><4)\n", 53 | " [ 1, 2, 3, 4\n", 54 | " , 5, 6, 7, 8\n", 55 | " , 9, 10, 11, 12 ]" 56 | ] 57 | }, 58 | "metadata": {}, 59 | "output_type": "display_data" 60 | } 61 | ], 62 | "source": [ 63 | "m" 64 | ] 65 | }, 66 | { 67 | "cell_type": "code", 68 | "execution_count": 4, 69 | "metadata": { 70 | "collapsed": true 71 | }, 72 | "outputs": [], 73 | "source": [ 74 | "import Control.Monad.ST" 75 | ] 76 | }, 77 | { 78 | "cell_type": "code", 79 | "execution_count": 5, 80 | "metadata": { 81 | "collapsed": false 82 | }, 83 | "outputs": [], 84 | "source": [ 85 | "rpmt m i j = runST $ do\n", 86 | " x <- newUndefinedMatrix RowMajor dr dc\n", 87 | " sequence_ [ setMatrix x a b m | a <- [0,r..dr], b <-[0,c..dc] ]\n", 88 | " unsafeFreezeMatrix x\n", 89 | " where\n", 90 | " (r,c) = size m\n", 91 | " dr = i*r\n", 92 | " dc = j*c" 93 | ] 94 | }, 95 | { 96 | "cell_type": "code", 97 | "execution_count": 6, 98 | "metadata": { 99 | "collapsed": false 100 | }, 101 | "outputs": [ 102 | { 103 | "data": { 104 | "text/plain": [ 105 | "(6><12)\n", 106 | " [ 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4\n", 107 | " , 5, 6, 7, 8, 5, 6, 7, 8, 5, 6, 7, 8\n", 108 | " , 9, 10, 11, 12, 9, 10, 11, 12, 9, 10, 11, 12\n", 109 | " , 1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4\n", 110 | " , 5, 6, 7, 8, 5, 6, 7, 8, 5, 6, 7, 8\n", 111 | " , 9, 10, 11, 12, 9, 10, 11, 12, 9, 10, 11, 12 ]" 112 | ] 113 | }, 114 | "metadata": {}, 115 | "output_type": "display_data" 116 | } 117 | ], 118 | "source": [ 119 | "rpmt m 2 3" 120 | ] 121 | } 122 | ], 123 | "metadata": { 124 | "kernelspec": { 125 | "display_name": "Haskell", 126 | "language": "haskell", 127 | "name": "haskell" 128 | }, 129 | "language_info": { 130 | "codemirror_mode": "ihaskell", 131 | "file_extension": ".hs", 132 | "name": "haskell", 133 | "version": "7.10.1" 134 | } 135 | }, 136 | "nbformat": 4, 137 | "nbformat_minor": 0 138 | } 139 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Psi.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Psi 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Psi( 17 | psi_int_e 18 | , psi_int 19 | , psi_e 20 | , psi 21 | , psi_1piy_e 22 | , psi_1piy 23 | , complex_psi_e 24 | , psi_1_int_e 25 | , psi_1_int 26 | , psi_1_e 27 | , psi_1 28 | , psi_n_e 29 | , psi_n 30 | ) where 31 | 32 | import Foreign(Ptr) 33 | import Foreign.C.Types 34 | import Numeric.GSL.Special.Internal 35 | 36 | psi_int_e :: CInt -> (Double,Double) 37 | psi_int_e n = createSFR "psi_int_e" $ gsl_sf_psi_int_e n 38 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_int_e" gsl_sf_psi_int_e :: CInt -> Ptr () -> IO CInt 39 | 40 | psi_int :: CInt -> Double 41 | psi_int = gsl_sf_psi_int 42 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_int" gsl_sf_psi_int :: CInt -> Double 43 | 44 | psi_e :: Double -> (Double,Double) 45 | psi_e x = createSFR "psi_e" $ gsl_sf_psi_e x 46 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_e" gsl_sf_psi_e :: Double -> Ptr () -> IO CInt 47 | 48 | psi :: Double -> Double 49 | psi = gsl_sf_psi 50 | foreign import ccall SAFE_CHEAP "gsl_sf_psi" gsl_sf_psi :: Double -> Double 51 | 52 | psi_1piy_e :: Double -> (Double,Double) 53 | psi_1piy_e y = createSFR "psi_1piy_e" $ gsl_sf_psi_1piy_e y 54 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_1piy_e" gsl_sf_psi_1piy_e :: Double -> Ptr () -> IO CInt 55 | 56 | psi_1piy :: Double -> Double 57 | psi_1piy = gsl_sf_psi_1piy 58 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_1piy" gsl_sf_psi_1piy :: Double -> Double 59 | 60 | complex_psi_e :: Double -> Double -> ((Double,Double),(Double,Double)) 61 | complex_psi_e x y = create2SFR "complex_psi_e" $ gsl_sf_complex_psi_e x y 62 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_psi_e" gsl_sf_complex_psi_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt 63 | 64 | psi_1_int_e :: CInt -> (Double,Double) 65 | psi_1_int_e n = createSFR "psi_1_int_e" $ gsl_sf_psi_1_int_e n 66 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_1_int_e" gsl_sf_psi_1_int_e :: CInt -> Ptr () -> IO CInt 67 | 68 | psi_1_int :: CInt -> Double 69 | psi_1_int = gsl_sf_psi_1_int 70 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_1_int" gsl_sf_psi_1_int :: CInt -> Double 71 | 72 | psi_1_e :: Double -> (Double,Double) 73 | psi_1_e x = createSFR "psi_1_e" $ gsl_sf_psi_1_e x 74 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_1_e" gsl_sf_psi_1_e :: Double -> Ptr () -> IO CInt 75 | 76 | psi_1 :: Double -> Double 77 | psi_1 = gsl_sf_psi_1 78 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_1" gsl_sf_psi_1 :: Double -> Double 79 | 80 | psi_n_e :: CInt -> Double -> (Double,Double) 81 | psi_n_e n x = createSFR "psi_n_e" $ gsl_sf_psi_n_e n x 82 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_n_e" gsl_sf_psi_n_e :: CInt -> Double -> Ptr () -> IO CInt 83 | 84 | psi_n :: CInt -> Double -> Double 85 | psi_n = gsl_sf_psi_n 86 | foreign import ccall SAFE_CHEAP "gsl_sf_psi_n" gsl_sf_psi_n :: CInt -> Double -> Double 87 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Zeta.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Zeta 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Zeta( 17 | zeta_int_e 18 | , zeta_int 19 | , zeta_e 20 | , zeta 21 | , zetam1_e 22 | , zetam1 23 | , zetam1_int_e 24 | , zetam1_int 25 | , hzeta_e 26 | , hzeta 27 | , eta_int_e 28 | , eta_int 29 | , eta_e 30 | , eta 31 | ) where 32 | 33 | import Foreign(Ptr) 34 | import Foreign.C.Types 35 | import Numeric.GSL.Special.Internal 36 | 37 | zeta_int_e :: CInt -> (Double,Double) 38 | zeta_int_e n = createSFR "zeta_int_e" $ gsl_sf_zeta_int_e n 39 | foreign import ccall SAFE_CHEAP "gsl_sf_zeta_int_e" gsl_sf_zeta_int_e :: CInt -> Ptr () -> IO CInt 40 | 41 | zeta_int :: CInt -> Double 42 | zeta_int = gsl_sf_zeta_int 43 | foreign import ccall SAFE_CHEAP "gsl_sf_zeta_int" gsl_sf_zeta_int :: CInt -> Double 44 | 45 | zeta_e :: Double -> (Double,Double) 46 | zeta_e s = createSFR "zeta_e" $ gsl_sf_zeta_e s 47 | foreign import ccall SAFE_CHEAP "gsl_sf_zeta_e" gsl_sf_zeta_e :: Double -> Ptr () -> IO CInt 48 | 49 | zeta :: Double -> Double 50 | zeta = gsl_sf_zeta 51 | foreign import ccall SAFE_CHEAP "gsl_sf_zeta" gsl_sf_zeta :: Double -> Double 52 | 53 | zetam1_e :: Double -> (Double,Double) 54 | zetam1_e s = createSFR "zetam1_e" $ gsl_sf_zetam1_e s 55 | foreign import ccall SAFE_CHEAP "gsl_sf_zetam1_e" gsl_sf_zetam1_e :: Double -> Ptr () -> IO CInt 56 | 57 | zetam1 :: Double -> Double 58 | zetam1 = gsl_sf_zetam1 59 | foreign import ccall SAFE_CHEAP "gsl_sf_zetam1" gsl_sf_zetam1 :: Double -> Double 60 | 61 | zetam1_int_e :: CInt -> (Double,Double) 62 | zetam1_int_e s = createSFR "zetam1_int_e" $ gsl_sf_zetam1_int_e s 63 | foreign import ccall SAFE_CHEAP "gsl_sf_zetam1_int_e" gsl_sf_zetam1_int_e :: CInt -> Ptr () -> IO CInt 64 | 65 | zetam1_int :: CInt -> Double 66 | zetam1_int = gsl_sf_zetam1_int 67 | foreign import ccall SAFE_CHEAP "gsl_sf_zetam1_int" gsl_sf_zetam1_int :: CInt -> Double 68 | 69 | hzeta_e :: Double -> Double -> (Double,Double) 70 | hzeta_e s q = createSFR "hzeta_e" $ gsl_sf_hzeta_e s q 71 | foreign import ccall SAFE_CHEAP "gsl_sf_hzeta_e" gsl_sf_hzeta_e :: Double -> Double -> Ptr () -> IO CInt 72 | 73 | hzeta :: Double -> Double -> Double 74 | hzeta = gsl_sf_hzeta 75 | foreign import ccall SAFE_CHEAP "gsl_sf_hzeta" gsl_sf_hzeta :: Double -> Double -> Double 76 | 77 | eta_int_e :: CInt -> (Double,Double) 78 | eta_int_e n = createSFR "eta_int_e" $ gsl_sf_eta_int_e n 79 | foreign import ccall SAFE_CHEAP "gsl_sf_eta_int_e" gsl_sf_eta_int_e :: CInt -> Ptr () -> IO CInt 80 | 81 | eta_int :: CInt -> Double 82 | eta_int = gsl_sf_eta_int 83 | foreign import ccall SAFE_CHEAP "gsl_sf_eta_int" gsl_sf_eta_int :: CInt -> Double 84 | 85 | eta_e :: Double -> (Double,Double) 86 | eta_e s = createSFR "eta_e" $ gsl_sf_eta_e s 87 | foreign import ccall SAFE_CHEAP "gsl_sf_eta_e" gsl_sf_eta_e :: Double -> Ptr () -> IO CInt 88 | 89 | eta :: Double -> Double 90 | eta = gsl_sf_eta 91 | foreign import ccall SAFE_CHEAP "gsl_sf_eta" gsl_sf_eta :: Double -> Double 92 | -------------------------------------------------------------------------------- /packages/gsl/hmatrix-gsl.cabal: -------------------------------------------------------------------------------- 1 | Name: hmatrix-gsl 2 | Version: 0.19.0.0 3 | Synopsis: Numerical computation 4 | Description: Purely functional interface to selected numerical computations, 5 | internally implemented using GSL. 6 | Homepage: https://github.com/albertoruiz/hmatrix 7 | license: GPL-3 8 | license-file: LICENSE 9 | Author: Alberto Ruiz 10 | Maintainer: Alberto Ruiz 11 | Stability: provisional 12 | Category: Math 13 | build-type: Simple 14 | cabal-version: >=1.18 15 | 16 | 17 | extra-source-files: src/Numeric/GSL/gsl-ode.c 18 | 19 | flag onlygsl 20 | description: don't link gslcblas 21 | default: False 22 | 23 | flag disable-default-paths 24 | description: When enabled, don't add default hardcoded include/link dirs by default. Needed for hermetic builds like in nix. 25 | default: False 26 | manual: True 27 | 28 | library 29 | 30 | Build-Depends: base<5, hmatrix>=0.18, array, vector, 31 | process, random 32 | 33 | hs-source-dirs: src 34 | Exposed-modules: Numeric.GSL.Differentiation, 35 | Numeric.GSL.Integration, 36 | Numeric.GSL.Fourier, 37 | Numeric.GSL.Polynomials, 38 | Numeric.GSL.Minimization, 39 | Numeric.GSL.Root, 40 | Numeric.GSL.Fitting, 41 | Numeric.GSL.ODE, 42 | Numeric.GSL, 43 | Numeric.GSL.LinearAlgebra, 44 | Numeric.GSL.Interpolation, 45 | Numeric.GSL.SimulatedAnnealing, 46 | Graphics.Plot 47 | other-modules: Numeric.GSL.Internal, 48 | Numeric.GSL.Vector, 49 | Numeric.GSL.IO, 50 | Numeric.GSL.Random 51 | 52 | 53 | C-sources: src/Numeric/GSL/gsl-aux.c 54 | 55 | cc-options: -O4 -Wall 56 | 57 | if arch(x86_64) 58 | cc-options: -msse2 59 | if arch(i386) 60 | cc-options: -msse2 61 | 62 | ghc-options: -Wall -fno-warn-missing-signatures 63 | -fno-warn-orphans 64 | -fno-warn-unused-binds 65 | 66 | if os(OSX) 67 | if !flag(disable-default-paths) 68 | extra-lib-dirs: /opt/local/lib/ 69 | include-dirs: /opt/local/include/ 70 | extra-lib-dirs: /usr/local/lib/ 71 | include-dirs: /usr/local/include/ 72 | extra-libraries: gsl 73 | if arch(i386) 74 | cc-options: -arch i386 75 | frameworks: Accelerate 76 | 77 | if os(freebsd) 78 | if !flag(disable-default-paths) 79 | extra-lib-dirs: /usr/local/lib 80 | include-dirs: /usr/local/include 81 | extra-libraries: gsl 82 | 83 | if os(windows) 84 | extra-libraries: gsl 85 | 86 | if os(linux) 87 | if arch(x86_64) 88 | cc-options: -fPIC 89 | 90 | if flag(onlygsl) 91 | extra-libraries: gsl 92 | else 93 | pkgconfig-depends: gsl 94 | 95 | default-language: Haskell2010 96 | 97 | 98 | source-repository head 99 | type: git 100 | location: https://github.com/albertoruiz/hmatrix 101 | -------------------------------------------------------------------------------- /packages/gsl/src/Numeric/GSL/Differentiation.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Numeric.GSL.Differentiation 3 | Copyright : (c) Alberto Ruiz 2006 4 | License : GPL 5 | 6 | Maintainer : Alberto Ruiz 7 | Stability : provisional 8 | 9 | Numerical differentiation. 10 | 11 | 12 | 13 | From the GSL manual: \"The functions described in this chapter compute numerical derivatives by finite differencing. An adaptive algorithm is used to find the best choice of finite difference and to estimate the error in the derivative.\" 14 | -} 15 | 16 | 17 | module Numeric.GSL.Differentiation ( 18 | derivCentral, 19 | derivForward, 20 | derivBackward 21 | ) where 22 | 23 | import Foreign.C.Types 24 | import Foreign.Marshal.Alloc(malloc, free) 25 | import Foreign.Ptr(Ptr, FunPtr, freeHaskellFunPtr) 26 | import Foreign.Storable(peek) 27 | import Numeric.GSL.Internal 28 | import System.IO.Unsafe(unsafePerformIO) 29 | 30 | derivGen :: 31 | CInt -- ^ type: 0 central, 1 forward, 2 backward 32 | -> Double -- ^ initial step size 33 | -> (Double -> Double) -- ^ function 34 | -> Double -- ^ point where the derivative is taken 35 | -> (Double, Double) -- ^ result and error 36 | derivGen c h f x = unsafePerformIO $ do 37 | r <- malloc 38 | e <- malloc 39 | fp <- mkfun (\y _ -> f y) 40 | c_deriv c fp x h r e // check "deriv" 41 | vr <- peek r 42 | ve <- peek e 43 | let result = (vr,ve) 44 | free r 45 | free e 46 | freeHaskellFunPtr fp 47 | return result 48 | 49 | foreign import ccall safe "gsl-aux.h deriv" 50 | c_deriv :: CInt -> FunPtr (Double -> Ptr () -> Double) -> Double -> Double 51 | -> Ptr Double -> Ptr Double -> IO CInt 52 | 53 | 54 | {- | Adaptive central difference algorithm, /gsl_deriv_central/. For example: 55 | 56 | >>> let deriv = derivCentral 0.01 57 | >>> deriv sin (pi/4) 58 | (0.7071067812000676,1.0600063101654055e-10) 59 | >>> cos (pi/4) 60 | 0.7071067811865476 61 | 62 | -} 63 | derivCentral :: Double -- ^ initial step size 64 | -> (Double -> Double) -- ^ function 65 | -> Double -- ^ point where the derivative is taken 66 | -> (Double, Double) -- ^ result and absolute error 67 | derivCentral = derivGen 0 68 | 69 | -- | Adaptive forward difference algorithm, /gsl_deriv_forward/. The function is evaluated only at points greater than x, and never at x itself. The derivative is returned in result and an estimate of its absolute error is returned in abserr. This function should be used if f(x) has a discontinuity at x, or is undefined for values less than x. A backward derivative can be obtained using a negative step. 70 | derivForward :: Double -- ^ initial step size 71 | -> (Double -> Double) -- ^ function 72 | -> Double -- ^ point where the derivative is taken 73 | -> (Double, Double) -- ^ result and absolute error 74 | derivForward = derivGen 1 75 | 76 | -- | Adaptive backward difference algorithm, /gsl_deriv_backward/. 77 | derivBackward ::Double -- ^ initial step size 78 | -> (Double -> Double) -- ^ function 79 | -> Double -- ^ point where the derivative is taken 80 | -> (Double, Double) -- ^ result and absolute error 81 | derivBackward = derivGen 2 82 | 83 | {- | conversion of Haskell functions into function pointers that can be used in the C side 84 | -} 85 | foreign import ccall safe "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double)) 86 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | {- | 3 | Module : Numeric.GSL.Special 4 | Copyright : (c) Alberto Ruiz 2006 5 | License : GPL-style 6 | 7 | Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | Stability : provisional 9 | Portability : uses ffi 10 | 11 | Wrappers for selected special functions. 12 | 13 | 14 | -} 15 | ----------------------------------------------------------------------------- 16 | 17 | module Numeric.GSL.Special ( 18 | -- * Functions 19 | module Numeric.GSL.Special.Airy 20 | , module Numeric.GSL.Special.Bessel 21 | , module Numeric.GSL.Special.Clausen 22 | , module Numeric.GSL.Special.Coulomb 23 | , module Numeric.GSL.Special.Coupling 24 | , module Numeric.GSL.Special.Dawson 25 | , module Numeric.GSL.Special.Debye 26 | , module Numeric.GSL.Special.Dilog 27 | , module Numeric.GSL.Special.Elementary 28 | , module Numeric.GSL.Special.Ellint 29 | , module Numeric.GSL.Special.Elljac 30 | , module Numeric.GSL.Special.Erf 31 | , module Numeric.GSL.Special.Exp 32 | , module Numeric.GSL.Special.Expint 33 | , module Numeric.GSL.Special.Fermi_dirac 34 | , module Numeric.GSL.Special.Gamma 35 | , module Numeric.GSL.Special.Gegenbauer 36 | , module Numeric.GSL.Special.Hyperg 37 | , module Numeric.GSL.Special.Laguerre 38 | , module Numeric.GSL.Special.Lambert 39 | , module Numeric.GSL.Special.Legendre 40 | , module Numeric.GSL.Special.Log 41 | , module Numeric.GSL.Special.Pow_int 42 | , module Numeric.GSL.Special.Psi 43 | , module Numeric.GSL.Special.Synchrotron 44 | , module Numeric.GSL.Special.Transport 45 | , module Numeric.GSL.Special.Trig 46 | , module Numeric.GSL.Special.Zeta 47 | -- * Util 48 | , mkComplex_e 49 | ) 50 | where 51 | 52 | 53 | import Numeric.GSL.Special.Airy 54 | import Numeric.GSL.Special.Bessel 55 | import Numeric.GSL.Special.Clausen 56 | import Numeric.GSL.Special.Coulomb 57 | import Numeric.GSL.Special.Coupling 58 | import Numeric.GSL.Special.Dawson 59 | import Numeric.GSL.Special.Debye 60 | import Numeric.GSL.Special.Dilog 61 | import Numeric.GSL.Special.Elementary 62 | import Numeric.GSL.Special.Ellint 63 | import Numeric.GSL.Special.Elljac 64 | import Numeric.GSL.Special.Erf 65 | import Numeric.GSL.Special.Exp 66 | import Numeric.GSL.Special.Expint 67 | import Numeric.GSL.Special.Fermi_dirac 68 | import Numeric.GSL.Special.Gamma 69 | import Numeric.GSL.Special.Gegenbauer 70 | import Numeric.GSL.Special.Hyperg 71 | import Numeric.GSL.Special.Laguerre 72 | import Numeric.GSL.Special.Lambert 73 | import Numeric.GSL.Special.Legendre 74 | import Numeric.GSL.Special.Log 75 | import Numeric.GSL.Special.Pow_int 76 | import Numeric.GSL.Special.Psi 77 | import Numeric.GSL.Special.Synchrotron 78 | import Numeric.GSL.Special.Transport 79 | import Numeric.GSL.Special.Trig 80 | import Numeric.GSL.Special.Zeta 81 | 82 | import Data.Complex 83 | 84 | ---------------------------------------------------------------- 85 | 86 | {- | Some GSL complex functions work with separate real and imaginary parts stored in real variables, obtaining tuples (value, error) for the real and imaginary parts of the result: 87 | 88 | > > import Numeric.GSL.Special.Dilog 89 | 90 | > > complex_dilog_xy_e 1 1 91 | > ((0.6168502750680847,1.1097853812294034e-14),(1.4603621167531193,1.1855504863267322e-14)) 92 | 93 | We can use @mkComplex_e@ to work with \"normal\" complex numbers: 94 | 95 | > > import Numeric.GSL.Special(mkComplex_e) 96 | > > import Data.Complex 97 | 98 | > > let dilogC = fst . mkComplex_e complex_dilog_xy_e 99 | 100 | > > dilogC (1 :+ 1) 101 | > 0.6168502750680847 :+ 1.4603621167531193 102 | 103 | -} 104 | mkComplex_e :: (Double -> Double -> ((Double, Double), (Double, Double))) 105 | -> Complex Double -> (Complex Double, Complex Double) 106 | mkComplex_e f (x :+ y) = (zr :+ zi, er :+ ei) 107 | where ((zr,er),(zi,ei)) = f x y 108 | 109 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Internal.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | ----------------------------------------------------------------------------- 3 | {- | 4 | Module : Numeric.GSL.Special.Internal 5 | Copyright : (c) Alberto Ruiz 2007 6 | License : GPL-style 7 | 8 | Maintainer : Alberto Ruiz (aruiz at um dot es) 9 | Stability : provisional 10 | Portability : uses ffi 11 | 12 | Support for Special functions. 13 | 14 | 15 | -} 16 | ----------------------------------------------------------------------------- 17 | 18 | #include 19 | #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) 20 | 21 | module Numeric.GSL.Special.Internal ( 22 | createSFR, 23 | create2SFR, 24 | createSFR_E10, 25 | Precision(..), 26 | Gsl_mode_t, 27 | Size_t, 28 | precCode 29 | ) 30 | where 31 | 32 | import Foreign.Storable 33 | import Foreign.Ptr 34 | import Foreign.Marshal 35 | import System.IO.Unsafe(unsafePerformIO) 36 | import Numeric.LinearAlgebra.Devel(check,(//)) 37 | import Foreign.C.Types 38 | 39 | data Precision = PrecDouble | PrecSingle | PrecApprox 40 | 41 | precCode :: Precision -> Int 42 | precCode PrecDouble = 0 43 | precCode PrecSingle = 1 44 | precCode PrecApprox = 2 45 | 46 | type Gsl_mode_t = Int 47 | 48 | type Size_t = CSize 49 | 50 | --------------------------------------------------- 51 | 52 | data Gsl_sf_result = SF Double Double 53 | deriving (Show) 54 | 55 | instance Storable Gsl_sf_result where 56 | sizeOf _ = #size gsl_sf_result 57 | alignment _ = #alignment gsl_sf_result 58 | peek ptr = do 59 | val <- (#peek gsl_sf_result, val) ptr 60 | err <- (#peek gsl_sf_result, err) ptr 61 | return (SF val err) 62 | poke ptr (SF val err) = do 63 | (#poke gsl_sf_result, val) ptr val 64 | (#poke gsl_sf_result, err) ptr err 65 | 66 | 67 | data Gsl_sf_result_e10 = SFE Double Double CInt 68 | deriving (Show) 69 | 70 | instance Storable Gsl_sf_result_e10 where 71 | sizeOf _ = #size gsl_sf_result_e10 72 | alignment _ = #alignment gsl_sf_result_e10 73 | peek ptr = do 74 | val <- (#peek gsl_sf_result_e10, val) ptr 75 | err <- (#peek gsl_sf_result_e10, err) ptr 76 | e10 <- (#peek gsl_sf_result_e10, e10) ptr 77 | return (SFE val err e10) 78 | poke ptr (SFE val err e10) = do 79 | (#poke gsl_sf_result_e10, val) ptr val 80 | (#poke gsl_sf_result_e10, err) ptr err 81 | (#poke gsl_sf_result_e10, e10) ptr e10 82 | 83 | 84 | ---------------------------------------------------------------- 85 | -- | access to one sf_result 86 | createSFR :: String -> (Ptr a -> IO CInt) -> (Double, Double) 87 | createSFR s f = unsafePerformIO $ do 88 | p <- malloc :: IO (Ptr Gsl_sf_result) 89 | f (castPtr p) // check s 90 | SF val err <- peek p 91 | free p 92 | return (val,err) 93 | 94 | ---------------------------------------------------------------- 95 | -- | access to two sf_result's 96 | create2SFR :: String -> (Ptr a -> Ptr a -> IO CInt) -> ((Double, Double),(Double, Double)) 97 | create2SFR s f = unsafePerformIO $ do 98 | p1 <- malloc :: IO (Ptr Gsl_sf_result) 99 | p2 <- malloc :: IO (Ptr Gsl_sf_result) 100 | f (castPtr p1) (castPtr p2) // check s 101 | SF val1 err1 <- peek p1 102 | SF val2 err2 <- peek p2 103 | free p1 104 | free p2 105 | return ((val1,err1),(val2,err2)) 106 | 107 | --------------------------------------------------------------------- 108 | -- the sf_result_e10 contains two doubles and the exponent 109 | 110 | -- | access to sf_result_e10 111 | createSFR_E10 :: String -> (Ptr a -> IO CInt) -> (Double, Int, Double) 112 | createSFR_E10 s f = unsafePerformIO $ do 113 | p <- malloc :: IO (Ptr Gsl_sf_result_e10) 114 | f (castPtr p) // check s 115 | SFE val err expo <- peek p 116 | free p 117 | return (val, fromIntegral expo,err) 118 | -------------------------------------------------------------------------------- /packages/base/src/Internal/C/lapack-aux.h: -------------------------------------------------------------------------------- 1 | /* 2 | * We have copied the definitions in f2c.h required 3 | * to compile clapack.h, modified to support both 4 | * 32 and 64 bit 5 | 6 | http://opengrok.creo.hu/dragonfly/xref/src/contrib/gcc-3.4/libf2c/readme.netlib 7 | http://www.ibm.com/developerworks/library/l-port64.html 8 | */ 9 | 10 | #ifdef _LP64 11 | typedef int integer; 12 | typedef unsigned int uinteger; 13 | typedef int logical; 14 | typedef long longint; /* system-dependent */ 15 | typedef unsigned long ulongint; /* system-dependent */ 16 | #else 17 | typedef long int integer; 18 | typedef unsigned long int uinteger; 19 | typedef long int logical; 20 | typedef long long longint; /* system-dependent */ 21 | typedef unsigned long long ulongint; /* system-dependent */ 22 | #endif 23 | 24 | typedef char *address; 25 | typedef short int shortint; 26 | typedef float real; 27 | typedef double doublereal; 28 | typedef struct { real r, i; } complex; 29 | typedef struct { doublereal r, i; } doublecomplex; 30 | typedef short int shortlogical; 31 | typedef char logical1; 32 | typedef char integer1; 33 | 34 | typedef logical (*L_fp)(); 35 | typedef short ftnlen; 36 | 37 | /********************************************************/ 38 | 39 | #define IVEC(A) int A##n, int*A##p 40 | #define LVEC(A) int A##n, int64_t*A##p 41 | #define FVEC(A) int A##n, float*A##p 42 | #define DVEC(A) int A##n, double*A##p 43 | #define QVEC(A) int A##n, complex*A##p 44 | #define CVEC(A) int A##n, doublecomplex*A##p 45 | #define PVEC(A) int A##n, void* A##p, int A##s 46 | 47 | #define IMAT(A) int A##r, int A##c, int* A##p 48 | #define LMAT(A) int A##r, int A##c, int64_t* A##p 49 | #define FMAT(A) int A##r, int A##c, float* A##p 50 | #define DMAT(A) int A##r, int A##c, double* A##p 51 | #define QMAT(A) int A##r, int A##c, complex* A##p 52 | #define CMAT(A) int A##r, int A##c, doublecomplex* A##p 53 | #define PMAT(A) int A##r, int A##c, void* A##p, int A##s 54 | 55 | #define KIVEC(A) int A##n, const int*A##p 56 | #define KLVEC(A) int A##n, const int64_t*A##p 57 | #define KFVEC(A) int A##n, const float*A##p 58 | #define KDVEC(A) int A##n, const double*A##p 59 | #define KQVEC(A) int A##n, const complex*A##p 60 | #define KCVEC(A) int A##n, const doublecomplex*A##p 61 | #define KPVEC(A) int A##n, const void* A##p, int A##s 62 | 63 | #define KIMAT(A) int A##r, int A##c, const int* A##p 64 | #define KLMAT(A) int A##r, int A##c, const int64_t* A##p 65 | #define KFMAT(A) int A##r, int A##c, const float* A##p 66 | #define KDMAT(A) int A##r, int A##c, const double* A##p 67 | #define KQMAT(A) int A##r, int A##c, const complex* A##p 68 | #define KCMAT(A) int A##r, int A##c, const doublecomplex* A##p 69 | #define KPMAT(A) int A##r, int A##c, const void* A##p, int A##s 70 | 71 | #define VECG(T,A) int A##n, T* A##p 72 | #define MATG(T,A) int A##r, int A##c, int A##Xr, int A##Xc, T* A##p 73 | 74 | #define OIMAT(A) MATG(int,A) 75 | #define OLMAT(A) MATG(int64_t,A) 76 | #define OFMAT(A) MATG(float,A) 77 | #define ODMAT(A) MATG(double,A) 78 | #define OQMAT(A) MATG(complex,A) 79 | #define OCMAT(A) MATG(doublecomplex,A) 80 | 81 | #define KOIMAT(A) MATG(const int,A) 82 | #define KOLMAT(A) MATG(const int64_t,A) 83 | #define KOFMAT(A) MATG(const float,A) 84 | #define KODMAT(A) MATG(const double,A) 85 | #define KOQMAT(A) MATG(const complex,A) 86 | #define KOCMAT(A) MATG(const doublecomplex,A) 87 | 88 | #define AT(m,i,j) (m##p[(i)*m##Xr + (j)*m##Xc]) 89 | #define TRAV(m,i,j) int i,j; for (i=0;i0) { 97 | return m >=0 ? m : m+b; 98 | } else { 99 | return m <=0 ? m : m+b; 100 | } 101 | } 102 | 103 | static inline 104 | int64_t mod_l (int64_t a, int64_t b) { 105 | int64_t m = a % b; 106 | if (b>0) { 107 | return m >=0 ? m : m+b; 108 | } else { 109 | return m <=0 ? m : m+b; 110 | } 111 | } 112 | -------------------------------------------------------------------------------- /examples/monadic.hs: -------------------------------------------------------------------------------- 1 | -- monadic computations 2 | -- (contributed by Vivian McPhail) 3 | 4 | {-# LANGUAGE FlexibleContexts #-} 5 | 6 | import Numeric.LinearAlgebra 7 | import Numeric.LinearAlgebra.Devel 8 | import Control.Monad.State.Strict 9 | import Control.Monad.Trans.Maybe 10 | import Foreign.Storable(Storable) 11 | import System.Random(randomIO) 12 | 13 | ------------------------------------------- 14 | 15 | -- an instance of MonadIO, a monad transformer 16 | type VectorMonadT = StateT I IO 17 | 18 | test1 :: Vector I -> IO (Vector I) 19 | test1 = mapVectorM $ \x -> do 20 | putStr $ (show x) ++ " " 21 | return (x + 1) 22 | 23 | -- we can have an arbitrary monad AND do IO 24 | addInitialM :: Vector I -> VectorMonadT () 25 | addInitialM = mapVectorM_ $ \x -> do 26 | i <- get 27 | liftIO $ putStr $ (show $ x + i) ++ " " 28 | put $ x + i 29 | 30 | -- sum the values of the even indiced elements 31 | sumEvens :: Vector I -> I 32 | sumEvens = foldVectorWithIndex (\x a b -> if x `mod` 2 == 0 then a + b else b) 0 33 | 34 | -- sum and print running total of evens 35 | sumEvensAndPrint = mapVectorWithIndexM_ $ \ i x -> do 36 | when (i `mod` 2 == 0) $ do 37 | v <- get 38 | put $ v + x 39 | v' <- get 40 | liftIO $ putStr $ (show v') ++ " " 41 | 42 | 43 | --indexPlusSum :: Vector I -> VectorMonadT () 44 | indexPlusSum v' = do 45 | let f i x = do 46 | s <- get 47 | let inc = x+s 48 | liftIO $ putStr $ show (i,inc) ++ " " 49 | put inc 50 | return inc 51 | v <- mapVectorWithIndexM f v' 52 | liftIO $ do 53 | putStrLn "" 54 | putStrLn $ show v 55 | 56 | ------------------------------------------- 57 | 58 | -- short circuit 59 | monoStep :: Double -> MaybeT (State Double) () 60 | monoStep d = do 61 | dp <- get 62 | when (d < dp) (fail "negative difference") 63 | put d 64 | {-# INLINE monoStep #-} 65 | 66 | isMonotoneIncreasing :: Vector Double -> Bool 67 | isMonotoneIncreasing v = 68 | let res = evalState (runMaybeT $ (mapVectorM_ monoStep v)) (v ! 0) 69 | in case res of 70 | Nothing -> False 71 | Just _ -> True 72 | 73 | 74 | ------------------------------------------- 75 | 76 | -- | apply a test to successive elements of a vector, evaluates to true iff test passes for all pairs 77 | successive_ :: (Container Vector a, Indexable (Vector a) a) => (a -> a -> Bool) -> Vector a -> Bool 78 | successive_ t v = maybe False (\_ -> True) $ evalState (runMaybeT (mapVectorM_ step (subVector 1 (size v - 1) v))) (v ! 0) 79 | where step e = do 80 | ep <- lift $ get 81 | if t e ep 82 | then lift $ put e 83 | else (fail "successive_ test failed") 84 | 85 | -- | operate on successive elements of a vector and return the resulting vector, whose length 1 less than that of the input 86 | successive 87 | :: (Storable b, Container Vector s, Indexable (Vector s) s) 88 | => (s -> s -> b) -> Vector s -> Vector b 89 | successive f v = evalState (mapVectorM step (subVector 1 (size v - 1) v)) (v ! 0) 90 | where step e = do 91 | ep <- get 92 | put e 93 | return $ f ep e 94 | 95 | ------------------------------------------- 96 | 97 | v :: Vector I 98 | v = 10 |> [0..] 99 | 100 | w = fromList ([1..10]++[10,9..1]) :: Vector Double 101 | 102 | 103 | main = do 104 | v' <- test1 v 105 | putStrLn "" 106 | putStrLn $ show v' 107 | evalStateT (addInitialM v) 0 108 | putStrLn "" 109 | putStrLn $ show (sumEvens v) 110 | evalStateT (sumEvensAndPrint v) 0 111 | putStrLn "" 112 | evalStateT (indexPlusSum v) 0 113 | putStrLn "-----------------------" 114 | mapVectorM_ print v 115 | print =<< (mapVectorM (const randomIO) v :: IO (Vector Double)) 116 | print =<< (mapVectorM (\a -> fmap (+a) randomIO) (5|>[0,100..1000]) :: IO (Vector Double)) 117 | putStrLn "-----------------------" 118 | print $ isMonotoneIncreasing w 119 | print $ isMonotoneIncreasing (subVector 0 7 w) 120 | print $ successive_ (>) v 121 | print $ successive_ (>) w 122 | print $ successive (+) v 123 | 124 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Coulomb.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 4 | 5 | ------------------------------------------------------------ 6 | -- | 7 | -- Module : Numeric.GSL.Special.Coulomb 8 | -- Copyright : (c) Alberto Ruiz 2006-11 9 | -- License : GPL 10 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 11 | -- Stability : provisional 12 | -- Portability : uses ffi 13 | -- 14 | -- Wrappers for selected functions described at: 15 | -- 16 | -- 17 | ------------------------------------------------------------ 18 | 19 | module Numeric.GSL.Special.Coulomb( 20 | hydrogenicR_1_e 21 | , hydrogenicR_1 22 | , hydrogenicR_e 23 | , hydrogenicR 24 | , coulomb_CL_e 25 | ) where 26 | 27 | import Foreign(Ptr) 28 | import Foreign.C.Types 29 | import Numeric.GSL.Special.Internal 30 | 31 | hydrogenicR_1_e :: Double -> Double -> (Double,Double) 32 | hydrogenicR_1_e zZ r = createSFR "hydrogenicR_1_e" $ gsl_sf_hydrogenicR_1_e zZ r 33 | foreign import ccall SAFE_CHEAP "gsl_sf_hydrogenicR_1_e" gsl_sf_hydrogenicR_1_e :: Double -> Double -> Ptr () -> IO CInt 34 | 35 | hydrogenicR_1 :: Double -> Double -> Double 36 | hydrogenicR_1 = gsl_sf_hydrogenicR_1 37 | foreign import ccall SAFE_CHEAP "gsl_sf_hydrogenicR_1" gsl_sf_hydrogenicR_1 :: Double -> Double -> Double 38 | 39 | hydrogenicR_e :: CInt -> CInt -> Double -> Double -> (Double,Double) 40 | hydrogenicR_e n l zZ r = createSFR "hydrogenicR_e" $ gsl_sf_hydrogenicR_e n l zZ r 41 | foreign import ccall SAFE_CHEAP "gsl_sf_hydrogenicR_e" gsl_sf_hydrogenicR_e :: CInt -> CInt -> Double -> Double -> Ptr () -> IO CInt 42 | 43 | hydrogenicR :: CInt -> CInt -> Double -> Double -> Double 44 | hydrogenicR = gsl_sf_hydrogenicR 45 | foreign import ccall SAFE_CHEAP "gsl_sf_hydrogenicR" gsl_sf_hydrogenicR :: CInt -> CInt -> Double -> Double -> Double 46 | 47 | coulomb_wave_FG_e :: Double -> Double -> Double -> CInt -> Ptr () -> Ptr () -> Ptr () -> Ptr () -> Ptr Double -> Ptr Double -> CInt 48 | coulomb_wave_FG_e = gsl_sf_coulomb_wave_FG_e 49 | foreign import ccall SAFE_CHEAP "gsl_sf_coulomb_wave_FG_e" gsl_sf_coulomb_wave_FG_e :: Double -> Double -> Double -> CInt -> Ptr () -> Ptr () -> Ptr () -> Ptr () -> Ptr Double -> Ptr Double -> CInt 50 | 51 | coulomb_wave_F_array :: Double -> CInt -> Double -> Double -> Ptr Double -> Ptr Double -> CInt 52 | coulomb_wave_F_array = gsl_sf_coulomb_wave_F_array 53 | foreign import ccall SAFE_CHEAP "gsl_sf_coulomb_wave_F_array" gsl_sf_coulomb_wave_F_array :: Double -> CInt -> Double -> Double -> Ptr Double -> Ptr Double -> CInt 54 | 55 | coulomb_wave_FG_array :: Double -> CInt -> Double -> Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> CInt 56 | coulomb_wave_FG_array = gsl_sf_coulomb_wave_FG_array 57 | foreign import ccall SAFE_CHEAP "gsl_sf_coulomb_wave_FG_array" gsl_sf_coulomb_wave_FG_array :: Double -> CInt -> Double -> Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> CInt 58 | 59 | coulomb_wave_FGp_array :: Double -> CInt -> Double -> Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> CInt 60 | coulomb_wave_FGp_array = gsl_sf_coulomb_wave_FGp_array 61 | foreign import ccall SAFE_CHEAP "gsl_sf_coulomb_wave_FGp_array" gsl_sf_coulomb_wave_FGp_array :: Double -> CInt -> Double -> Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> Ptr Double -> CInt 62 | 63 | coulomb_wave_sphF_array :: Double -> CInt -> Double -> Double -> Ptr Double -> Ptr Double -> CInt 64 | coulomb_wave_sphF_array = gsl_sf_coulomb_wave_sphF_array 65 | foreign import ccall SAFE_CHEAP "gsl_sf_coulomb_wave_sphF_array" gsl_sf_coulomb_wave_sphF_array :: Double -> CInt -> Double -> Double -> Ptr Double -> Ptr Double -> CInt 66 | 67 | coulomb_CL_e :: Double -> Double -> (Double,Double) 68 | coulomb_CL_e lL eta = createSFR "coulomb_CL_e" $ gsl_sf_coulomb_CL_e lL eta 69 | foreign import ccall SAFE_CHEAP "gsl_sf_coulomb_CL_e" gsl_sf_coulomb_CL_e :: Double -> Double -> Ptr () -> IO CInt 70 | 71 | coulomb_CL_array :: Double -> CInt -> Double -> Ptr Double -> CInt 72 | coulomb_CL_array = gsl_sf_coulomb_CL_array 73 | foreign import ccall SAFE_CHEAP "gsl_sf_coulomb_CL_array" gsl_sf_coulomb_CL_array :: Double -> CInt -> Double -> Ptr Double -> CInt 74 | -------------------------------------------------------------------------------- /examples/inplace.hs: -------------------------------------------------------------------------------- 1 | -- some tests of the interface for pure 2 | -- computations with inplace updates 3 | 4 | {-# LANGUAGE FlexibleContexts #-} 5 | 6 | import Numeric.LinearAlgebra 7 | import Numeric.LinearAlgebra.Devel 8 | 9 | import Data.Array.Unboxed 10 | import Data.Array.ST 11 | import Control.Monad.ST 12 | import Control.Monad 13 | 14 | main = sequence_[ 15 | print test1, 16 | print test2, 17 | print test3, 18 | print test4, 19 | -- test5, 20 | -- test6, 21 | -- print test7, 22 | test8, 23 | test0] 24 | 25 | 26 | 27 | -- hmatrix vector and matrix 28 | v = vector [1..10] 29 | m = (5><10) [1..50::Double] 30 | 31 | ---------------------------------------------------------------------- 32 | 33 | -- vector creation by in-place updates on a copy of the argument 34 | test1 = fun v 35 | 36 | -- fun :: (Num t, Element t, Container) => Vector t -> Vector t 37 | fun x = runSTVector $ do 38 | a <- thawVector x 39 | mapM_ (flip (modifyVector a) (+57)) [0 .. size x `div` 2 - 1] 40 | return a 41 | 42 | -- another example: creation of an antidiagonal matrix from a list 43 | test2 = antiDiag 5 8 [1..] :: Matrix Double 44 | 45 | -- antiDiag :: (Element b) => Int -> Int -> [b] -> Matrix b 46 | antiDiag r c l = runSTMatrix $ do 47 | m <- newMatrix 0 r c 48 | let d = min r c - 1 49 | sequence_ $ zipWith (\i v -> writeMatrix m i (c-1-i) v) [0..d] l 50 | return m 51 | 52 | -- using vector or matrix functions on mutable objects requires freezing: 53 | test3 = g1 v 54 | 55 | g1 x = runST $ do 56 | a <- thawVector x 57 | writeVector a (size x -1) 0 58 | b <- freezeVector a 59 | return (norm_2 b) 60 | 61 | -- another possibility: 62 | test4 = g2 v 63 | 64 | g2 x = runST $ do 65 | a <- thawVector x 66 | writeVector a (size x -1) 0 67 | t <- liftSTVector norm_2 a 68 | return t 69 | 70 | -------------------------------------------------------------- 71 | 72 | {- 73 | 74 | -- haskell arrays 75 | hv = listArray (0,9) [1..10::Double] 76 | hm = listArray ((0,0),(4,9)) [1..50::Double] 77 | 78 | 79 | 80 | -- conversion from standard Haskell arrays 81 | test5 = do 82 | print $ norm_2 (vectorFromArray hv) 83 | print $ norm_2 v 84 | print $ rcond (matrixFromArray hm) 85 | print $ rcond m 86 | 87 | 88 | -- conversion to mutable ST arrays 89 | test6 = do 90 | let y = clearColumn m 1 91 | print y 92 | print (matrixFromArray y) 93 | 94 | clearColumn x c = runSTUArray $ do 95 | a <- mArrayFromMatrix x 96 | forM_ [0..rows x-1] $ \i-> 97 | writeArray a (i,c) (0::Double) 98 | return a 99 | 100 | -- hmatrix functions applied to mutable ST arrays 101 | test7 = unitary (listArray (1,4) [3,5,7,2] :: UArray Int Double) 102 | 103 | unitary v = runSTUArray $ do 104 | a <- thaw v 105 | n <- norm_2 `fmap` vectorFromMArray a 106 | b <- mapArray (/n) a 107 | return b 108 | 109 | -} 110 | ------------------------------------------------- 111 | 112 | -- (just to check that they are not affected) 113 | test0 = do 114 | print v 115 | print m 116 | --print hv 117 | --print hm 118 | 119 | ------------------------------------------------- 120 | 121 | histogram n ds = runSTVector $ do 122 | h <- newVector (0::Double) n -- number of bins 123 | let inc k = modifyVector h k (+1) 124 | mapM_ inc ds 125 | return h 126 | 127 | -- check that newVector is really called with a fresh new array 128 | histoCheck ds = runSTVector $ do 129 | h <- newVector (0::Double) 15 -- > constant for this test 130 | let inc k = modifyVector h k (+1) 131 | mapM_ inc ds 132 | return h 133 | 134 | hc = fromList [1 .. 15::Double] 135 | 136 | -- check that thawVector creates a new array 137 | histoCheck2 ds = runSTVector $ do 138 | h <- thawVector hc 139 | let inc k = modifyVector h k (+1) 140 | mapM_ inc ds 141 | return h 142 | 143 | test8 = do 144 | let ds = [0..14] 145 | print $ histogram 15 ds 146 | print $ histogram 15 ds 147 | print $ histogram 15 ds 148 | print $ histoCheck ds 149 | print $ histoCheck ds 150 | print $ histoCheck ds 151 | print $ histoCheck2 ds 152 | print $ histoCheck2 ds 153 | print $ histoCheck2 ds 154 | putStrLn "----------------------" 155 | 156 | -------------------------------------------------------------------------------- /packages/base/src/Numeric/Matrix.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeFamilies #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE UndecidableInstances #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | 7 | {-# OPTIONS_GHC -fno-warn-orphans #-} 8 | 9 | ----------------------------------------------------------------------------- 10 | -- | 11 | -- Module : Numeric.Matrix 12 | -- Copyright : (c) Alberto Ruiz 2014 13 | -- License : BSD3 14 | -- 15 | -- Maintainer : Alberto Ruiz 16 | -- Stability : provisional 17 | -- 18 | -- Provides instances of standard classes 'Show', 'Read', 'Eq', 19 | -- 'Num', 'Fractional', and 'Floating' for 'Matrix'. 20 | -- 21 | -- In arithmetic operations one-component 22 | -- vectors and matrices automatically expand to match the dimensions of the other operand. 23 | 24 | ----------------------------------------------------------------------------- 25 | 26 | module Numeric.Matrix ( 27 | ) where 28 | 29 | ------------------------------------------------------------------- 30 | 31 | import Internal.Vector 32 | import Internal.Matrix 33 | import Internal.Element 34 | import Internal.Numeric 35 | import qualified Data.Monoid as M 36 | import Data.List(partition) 37 | import qualified Data.Foldable as F 38 | import qualified Data.Semigroup as S 39 | import Internal.Chain 40 | import Foreign.Storable(Storable) 41 | 42 | 43 | ------------------------------------------------------------------- 44 | 45 | instance Container Matrix a => Eq (Matrix a) where 46 | (==) = equal 47 | 48 | instance (Container Matrix a, Num a, Num (Vector a)) => Num (Matrix a) where 49 | (+) = liftMatrix2Auto (+) 50 | (-) = liftMatrix2Auto (-) 51 | negate = liftMatrix negate 52 | (*) = liftMatrix2Auto (*) 53 | signum = liftMatrix signum 54 | abs = liftMatrix abs 55 | {-# INLINABLE fromInteger #-} 56 | fromInteger = (1><1) . return . fromInteger 57 | 58 | --------------------------------------------------- 59 | 60 | instance (Container Vector a, Fractional a, Fractional (Vector a), Num (Matrix a)) => Fractional (Matrix a) where 61 | {-# INLINABLE fromRational #-} 62 | fromRational n = (1><1) [fromRational n] 63 | (/) = liftMatrix2Auto (/) 64 | 65 | --------------------------------------------------------- 66 | 67 | instance (Floating a, Container Vector a, Floating (Vector a), Fractional (Matrix a)) => Floating (Matrix a) where 68 | sin = liftMatrix sin 69 | cos = liftMatrix cos 70 | tan = liftMatrix tan 71 | asin = liftMatrix asin 72 | acos = liftMatrix acos 73 | atan = liftMatrix atan 74 | sinh = liftMatrix sinh 75 | cosh = liftMatrix cosh 76 | tanh = liftMatrix tanh 77 | asinh = liftMatrix asinh 78 | acosh = liftMatrix acosh 79 | atanh = liftMatrix atanh 80 | exp = liftMatrix exp 81 | log = liftMatrix log 82 | (**) = liftMatrix2Auto (**) 83 | sqrt = liftMatrix sqrt 84 | {-# INLINABLE pi #-} 85 | pi = (1><1) [pi] 86 | 87 | -------------------------------------------------------------------------------- 88 | 89 | isScalar :: Matrix t -> Bool 90 | isScalar m = rows m == 1 && cols m == 1 91 | 92 | adaptScalarM :: (Foreign.Storable.Storable t1, Foreign.Storable.Storable t2) 93 | => (t1 -> Matrix t2 -> t) 94 | -> (Matrix t1 -> Matrix t2 -> t) 95 | -> (Matrix t1 -> t2 -> t) 96 | -> Matrix t1 97 | -> Matrix t2 98 | -> t 99 | adaptScalarM f1 f2 f3 x y 100 | | isScalar x = f1 (x @@>(0,0) ) y 101 | | isScalar y = f3 x (y @@>(0,0) ) 102 | | otherwise = f2 x y 103 | 104 | instance (Container Vector t, Eq t, Num (Vector t), Product t) => S.Semigroup (Matrix t) 105 | where 106 | (<>) = mappend 107 | sconcat = mconcat . F.toList 108 | 109 | instance (Container Vector t, Eq t, Num (Vector t), Product t) => M.Monoid (Matrix t) 110 | where 111 | mempty = 1 112 | mappend = adaptScalarM scale mXm (flip scale) 113 | 114 | mconcat xs = work (partition isScalar xs) 115 | where 116 | work (ss,[]) = product ss 117 | work (ss,ms) = scl (product ss) (optimiseMult ms) 118 | scl x m 119 | | isScalar x && x00 == 1 = m 120 | | otherwise = scale x00 m 121 | where 122 | x00 = x @@> (0,0) 123 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Coupling.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 4 | 5 | ------------------------------------------------------------ 6 | -- | 7 | -- Module : Numeric.GSL.Special.Coupling 8 | -- Copyright : (c) Alberto Ruiz 2006-11 9 | -- License : GPL 10 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 11 | -- Stability : provisional 12 | -- Portability : uses ffi 13 | -- 14 | -- Wrappers for selected functions described at: 15 | -- 16 | -- 17 | ------------------------------------------------------------ 18 | 19 | module Numeric.GSL.Special.Coupling( 20 | coupling_3j_e 21 | , coupling_3j 22 | , coupling_6j_e 23 | , coupling_6j 24 | , coupling_RacahW_e 25 | , coupling_RacahW 26 | , coupling_9j_e 27 | , coupling_9j 28 | ) where 29 | 30 | import Foreign(Ptr) 31 | import Foreign.C.Types 32 | import Numeric.GSL.Special.Internal 33 | 34 | coupling_3j_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> (Double,Double) 35 | coupling_3j_e two_ja two_jb two_jc two_ma two_mb two_mc = createSFR "coupling_3j_e" $ gsl_sf_coupling_3j_e two_ja two_jb two_jc two_ma two_mb two_mc 36 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_3j_e" gsl_sf_coupling_3j_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Ptr () -> IO CInt 37 | 38 | coupling_3j :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 39 | coupling_3j = gsl_sf_coupling_3j 40 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_3j" gsl_sf_coupling_3j :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 41 | 42 | coupling_6j_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> (Double,Double) 43 | coupling_6j_e two_ja two_jb two_jc two_jd two_je two_jf = createSFR "coupling_6j_e" $ gsl_sf_coupling_6j_e two_ja two_jb two_jc two_jd two_je two_jf 44 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_6j_e" gsl_sf_coupling_6j_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Ptr () -> IO CInt 45 | 46 | coupling_6j :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 47 | coupling_6j = gsl_sf_coupling_6j 48 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_6j" gsl_sf_coupling_6j :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 49 | 50 | coupling_RacahW_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> (Double,Double) 51 | coupling_RacahW_e two_ja two_jb two_jc two_jd two_je two_jf = createSFR "coupling_RacahW_e" $ gsl_sf_coupling_RacahW_e two_ja two_jb two_jc two_jd two_je two_jf 52 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_RacahW_e" gsl_sf_coupling_RacahW_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Ptr () -> IO CInt 53 | 54 | coupling_RacahW :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 55 | coupling_RacahW = gsl_sf_coupling_RacahW 56 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_RacahW" gsl_sf_coupling_RacahW :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 57 | 58 | coupling_9j_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> (Double,Double) 59 | coupling_9j_e two_ja two_jb two_jc two_jd two_je two_jf two_jg two_jh two_ji = createSFR "coupling_9j_e" $ gsl_sf_coupling_9j_e two_ja two_jb two_jc two_jd two_je two_jf two_jg two_jh two_ji 60 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_9j_e" gsl_sf_coupling_9j_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Ptr () -> IO CInt 61 | 62 | coupling_9j :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 63 | coupling_9j = gsl_sf_coupling_9j 64 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_9j" gsl_sf_coupling_9j :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 65 | 66 | coupling_6j_INCORRECT_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> (Double,Double) 67 | coupling_6j_INCORRECT_e two_ja two_jb two_jc two_jd two_je two_jf = createSFR "coupling_6j_INCORRECT_e" $ gsl_sf_coupling_6j_INCORRECT_e two_ja two_jb two_jc two_jd two_je two_jf 68 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_6j_INCORRECT_e" gsl_sf_coupling_6j_INCORRECT_e :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Ptr () -> IO CInt 69 | 70 | coupling_6j_INCORRECT :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 71 | coupling_6j_INCORRECT = gsl_sf_coupling_6j_INCORRECT 72 | foreign import ccall SAFE_CHEAP "gsl_sf_coupling_6j_INCORRECT" gsl_sf_coupling_6j_INCORRECT :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Double 73 | -------------------------------------------------------------------------------- /packages/gsl/src/Numeric/GSL/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 4 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 5 | 6 | -- | 7 | -- Module : Numeric.GSL.Internal 8 | -- Copyright : (c) Alberto Ruiz 2009 9 | -- License : GPL 10 | -- Maintainer : Alberto Ruiz 11 | -- Stability : provisional 12 | -- 13 | -- 14 | -- Auxiliary functions. 15 | -- 16 | 17 | 18 | module Numeric.GSL.Internal( 19 | iv, 20 | mkVecfun, 21 | mkVecVecfun, 22 | mkDoubleVecVecfun, 23 | mkDoublefun, 24 | aux_vTov, 25 | mkVecMatfun, 26 | mkDoubleVecMatfun, 27 | aux_vTom, 28 | createV, 29 | createMIO, 30 | module Numeric.LinearAlgebra.Devel, 31 | check,(#),(#!),vec, ww2, 32 | Res,TV,TM,TCV,TCM 33 | ) where 34 | 35 | import Numeric.LinearAlgebra.HMatrix 36 | import Numeric.LinearAlgebra.Devel hiding (check) 37 | 38 | import Foreign.Marshal.Array(copyArray) 39 | import Foreign.Ptr(Ptr, FunPtr) 40 | import Foreign.C.Types 41 | import Foreign.C.String(peekCString) 42 | import System.IO.Unsafe(unsafePerformIO) 43 | import Data.Vector.Storable as V (unsafeWith,length) 44 | import Control.Monad(when) 45 | 46 | iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double) 47 | iv f n p = f (createV (fromIntegral n) copy "iv") where 48 | copy n' q = do 49 | copyArray q p (fromIntegral n') 50 | return 0 51 | 52 | -- | conversion of Haskell functions into function pointers that can be used in the C side 53 | foreign import ccall safe "wrapper" 54 | mkVecfun :: (CInt -> Ptr Double -> Double) 55 | -> IO( FunPtr (CInt -> Ptr Double -> Double)) 56 | 57 | foreign import ccall safe "wrapper" 58 | mkVecVecfun :: TVV -> IO (FunPtr TVV) 59 | 60 | foreign import ccall safe "wrapper" 61 | mkDoubleVecVecfun :: (Double -> TVV) -> IO (FunPtr (Double -> TVV)) 62 | 63 | foreign import ccall safe "wrapper" 64 | mkDoublefun :: (Double -> Double) -> IO (FunPtr (Double -> Double)) 65 | 66 | aux_vTov :: (Vector Double -> Vector Double) -> TVV 67 | aux_vTov f n p nr r = g where 68 | v = f x 69 | x = createV (fromIntegral n) copy "aux_vTov" 70 | copy n' q = do 71 | copyArray q p (fromIntegral n') 72 | return 0 73 | g = do unsafeWith v $ \p' -> copyArray r p' (fromIntegral nr) 74 | return 0 75 | 76 | foreign import ccall safe "wrapper" 77 | mkVecMatfun :: TVM -> IO (FunPtr TVM) 78 | 79 | foreign import ccall safe "wrapper" 80 | mkDoubleVecMatfun :: (Double -> TVM) -> IO (FunPtr (Double -> TVM)) 81 | 82 | aux_vTom :: (Vector Double -> Matrix Double) -> TVM 83 | aux_vTom f n p rr cr r = g where 84 | v = flatten $ f x 85 | x = createV (fromIntegral n) copy "aux_vTov" 86 | copy n' q = do 87 | copyArray q p (fromIntegral n') 88 | return 0 89 | g = do unsafeWith v $ \p' -> copyArray r p' (fromIntegral $ rr*cr) 90 | return 0 91 | 92 | createV n fun msg = unsafePerformIO $ do 93 | r <- createVector n 94 | (r # id) fun #| msg 95 | return r 96 | 97 | createMIO r c fun msg = do 98 | res <- createMatrix RowMajor r c 99 | (res # id) fun #| msg 100 | return res 101 | 102 | -------------------------------------------------------------------------------- 103 | 104 | -- | check the error code 105 | check :: String -> IO CInt -> IO () 106 | check msg f = do 107 | err <- f 108 | when (err/=0) $ do 109 | ps <- gsl_strerror err 110 | s <- peekCString ps 111 | error (msg++": "++s) 112 | return () 113 | 114 | -- | description of GSL error codes 115 | foreign import ccall unsafe "gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar) 116 | 117 | type PF = Ptr Float 118 | type PD = Ptr Double 119 | type PQ = Ptr (Complex Float) 120 | type PC = Ptr (Complex Double) 121 | 122 | type Res = IO CInt 123 | type TV x = CInt -> PD -> x 124 | type TM x = CInt -> CInt -> PD -> x 125 | type TCV x = CInt -> PC -> x 126 | type TCM x = CInt -> CInt -> PC -> x 127 | 128 | type TVV = TV (TV Res) 129 | type TVM = TV (TM Res) 130 | 131 | ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 132 | 133 | vec x f = unsafeWith x $ \p -> do 134 | let v g = g (fi $ V.length x) p 135 | f v 136 | {-# INLINE vec #-} 137 | 138 | infixl 1 # 139 | a # b = applyRaw a b 140 | {-# INLINE (#) #-} 141 | 142 | --infixr 1 # 143 | --a # b = apply a b 144 | --{-# INLINE (#) #-} 145 | 146 | a #! b = a # b # id 147 | {-# INLINE (#!) #-} 148 | 149 | -------------------------------------------------------------------------------- /packages/gsl/src/Numeric/GSL/Vector.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 2 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 3 | 4 | ----------------------------------------------------------------------------- 5 | -- | 6 | -- Module : Numeric.GSL.Vector 7 | -- Copyright : (c) Alberto Ruiz 2007-14 8 | -- License : GPL 9 | -- Maintainer : Alberto Ruiz 10 | -- Stability : provisional 11 | -- 12 | ----------------------------------------------------------------------------- 13 | 14 | module Numeric.GSL.Vector ( 15 | randomVector, 16 | saveMatrix, 17 | fwriteVector, freadVector, fprintfVector, fscanfVector 18 | ) where 19 | 20 | import Numeric.LinearAlgebra.HMatrix hiding(randomVector, saveMatrix) 21 | import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) 22 | 23 | import Foreign.Marshal.Alloc(free) 24 | import Foreign.Ptr(Ptr) 25 | import Foreign.C.Types 26 | import Foreign.C.String(newCString) 27 | import System.IO.Unsafe(unsafePerformIO) 28 | 29 | fromei x = fromIntegral (fromEnum x) :: CInt 30 | 31 | ----------------------------------------------------------------------- 32 | 33 | -- | Obtains a vector of pseudorandom elements from the the mt19937 generator in GSL, with a given seed. Use randomIO to get a random seed. 34 | randomVector :: Int -- ^ seed 35 | -> RandDist -- ^ distribution 36 | -> Int -- ^ vector size 37 | -> Vector Double 38 | randomVector seed dist n = unsafePerformIO $ do 39 | r <- createVector n 40 | (r `applyRaw` id) (c_random_vector_GSL (fi seed) ((fi.fromEnum) dist)) #|"randomVectorGSL" 41 | return r 42 | 43 | foreign import ccall unsafe "random_vector_GSL" c_random_vector_GSL :: CInt -> CInt -> TV 44 | 45 | -------------------------------------------------------------------------------- 46 | 47 | -- | Saves a matrix as 2D ASCII table. 48 | saveMatrix :: FilePath 49 | -> String -- ^ format (%f, %g, %e) 50 | -> Matrix Double 51 | -> IO () 52 | saveMatrix filename fmt m = do 53 | charname <- newCString filename 54 | charfmt <- newCString fmt 55 | let o = if orderOf m == RowMajor then 1 else 0 56 | (m `applyRaw` id) (matrix_fprintf charname charfmt o) #|"matrix_fprintf" 57 | free charname 58 | free charfmt 59 | 60 | foreign import ccall unsafe "matrix_fprintf" matrix_fprintf :: Ptr CChar -> Ptr CChar -> CInt -> TM 61 | 62 | -------------------------------------------------------------------------------- 63 | 64 | -- | Loads a vector from an ASCII file (the number of elements must be known in advance). 65 | fscanfVector :: FilePath -> Int -> IO (Vector Double) 66 | fscanfVector filename n = do 67 | charname <- newCString filename 68 | res <- createVector n 69 | (res `applyRaw` id) (gsl_vector_fscanf charname) #|"gsl_vector_fscanf" 70 | free charname 71 | return res 72 | 73 | foreign import ccall unsafe "vector_fscanf" gsl_vector_fscanf:: Ptr CChar -> TV 74 | 75 | -- | Saves the elements of a vector, with a given format (%f, %e, %g), to an ASCII file. 76 | fprintfVector :: FilePath -> String -> Vector Double -> IO () 77 | fprintfVector filename fmt v = do 78 | charname <- newCString filename 79 | charfmt <- newCString fmt 80 | (v `applyRaw` id) (gsl_vector_fprintf charname charfmt) #|"gsl_vector_fprintf" 81 | free charname 82 | free charfmt 83 | 84 | foreign import ccall unsafe "vector_fprintf" gsl_vector_fprintf :: Ptr CChar -> Ptr CChar -> TV 85 | 86 | -- | Loads a vector from a binary file (the number of elements must be known in advance). 87 | freadVector :: FilePath -> Int -> IO (Vector Double) 88 | freadVector filename n = do 89 | charname <- newCString filename 90 | res <- createVector n 91 | (res `applyRaw` id) (gsl_vector_fread charname) #|"gsl_vector_fread" 92 | free charname 93 | return res 94 | 95 | foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV 96 | 97 | -- | Saves the elements of a vector to a binary file. 98 | fwriteVector :: FilePath -> Vector Double -> IO () 99 | fwriteVector filename v = do 100 | charname <- newCString filename 101 | (v `applyRaw` id) (gsl_vector_fwrite charname) #|"gsl_vector_fwrite" 102 | free charname 103 | 104 | foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV 105 | 106 | type PD = Ptr Double -- 107 | type TV = CInt -> PD -> IO CInt -- 108 | type TM = CInt -> CInt -> PD -> IO CInt -- 109 | 110 | -------------------------------------------------------------------------------- /packages/glpk/src/Numeric/LinearProgramming/L1.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Numeric.LinearProgramming.L1 3 | Copyright : (c) Alberto Ruiz 2011-14 4 | Stability : provisional 5 | 6 | Linear system solvers in the L_1 norm using linear programming. 7 | 8 | -} 9 | ----------------------------------------------------------------------------- 10 | 11 | module Numeric.LinearProgramming.L1 ( 12 | l1Solve, l1SolveGT, 13 | l1SolveO, lInfSolveO, 14 | l1SolveU, 15 | ) where 16 | 17 | import Numeric.LinearAlgebra.HMatrix 18 | import Numeric.LinearProgramming 19 | 20 | -- | L_inf solution of overconstrained system Ax=b. 21 | -- 22 | -- @argmin_x ||Ax-b||_inf@ 23 | lInfSolveO :: Matrix Double -> Vector Double -> Vector Double 24 | lInfSolveO a b = fromList (take n x) 25 | where 26 | n = cols a 27 | as = toRows a 28 | bs = toList b 29 | c1 = zipWith (mk (1)) as bs 30 | c2 = zipWith (mk (-1)) as bs 31 | mk sign a_i b_i = (zipWith (#) (toList (scale sign a_i)) [1..] ++ [-1#(n+1)]) :<=: (sign * b_i) 32 | p = Sparse (c1++c2) 33 | Optimal (_j,x) = simplex (Minimize (replicate n 0 ++ [1])) p (map Free [1..(n+1)]) 34 | 35 | -------------------------------------------------------------------------------- 36 | 37 | -- | L_1 solution of overconstrained system Ax=b. 38 | -- 39 | -- @argmin_x ||Ax-b||_1@ 40 | l1SolveO :: Matrix Double -> Vector Double -> Vector Double 41 | l1SolveO a b = fromList (take n x) 42 | where 43 | n = cols a 44 | m = rows a 45 | as = toRows a 46 | bs = toList b 47 | ks = [1..] 48 | c1 = zipWith3 (mk (1)) as bs ks 49 | c2 = zipWith3 (mk (-1)) as bs ks 50 | mk sign a_i b_i k = (zipWith (#) (toList (scale sign a_i)) [1..] ++ [-1#(k+n)]) :<=: (sign * b_i) 51 | p = Sparse (c1++c2) 52 | Optimal (_j,x) = simplex (Minimize (replicate n 0 ++ replicate m 1)) p (map Free [1..(n+m)]) 53 | 54 | -------------------------------------------------------------------------------- 55 | 56 | -- | L1 solution of underconstrained linear system Ax=b. 57 | -- 58 | -- @argmin_x ||x||_1 such that Ax=b@ 59 | l1SolveU :: Matrix Double -> Vector Double -> Vector Double 60 | l1SolveU a y = fromList (take n x) 61 | where 62 | n = cols a 63 | c1 = map (\k -> [ 1#k, -1#k+n] :<=: 0) [1..n] 64 | c2 = map (\k -> [-1#k, -1#k+n] :<=: 0) [1..n] 65 | c3 = zipWith (:==:) (map sp $ toRows a) (toList y) 66 | sp v = zipWith (#) (toList v) [1..] 67 | p = Sparse (c1 ++ c2 ++ c3) 68 | Optimal (_j,x) = simplex (Minimize (replicate n 0 ++ replicate n 1)) p (map Free [1..(2*n)]) 69 | 70 | -------------------------------------------------------------------------------- 71 | -- | Solution in the L_1 norm, with L_1 regularization, of a linear system @Ax=b@. 72 | -- 73 | -- @argmin_x λ||x||_1 + ||Ax-b||_1@ 74 | l1Solve 75 | :: Double -- ^ λ 76 | -> Matrix Double -- ^ A 77 | -> Vector Double -- ^ b 78 | -> Vector Double -- ^ x 79 | l1Solve λ a b = fromList (take n x) 80 | where 81 | n = cols a 82 | m = rows a 83 | as = toRows a 84 | bs = toList b 85 | c1Res = zipWith3 (mkR (1)) as bs [1..m] 86 | c2Res = zipWith3 (mkR (-1)) as bs [1..m] 87 | mkR sign a_i b_i k = (zipWith (#) (toList (scale sign a_i)) [1..] ++ [-1#(k+2*n)]) :<=: (sign * b_i) 88 | c1Sol = map (\k -> [ 1#k, -1#k+n] :<=: 0) [1..n] 89 | c2Sol = map (\k -> [-1#k, -1#k+n] :<=: 0) [1..n] 90 | p = Sparse (c1Res++c2Res++c1Sol++c2Sol) 91 | cost = replicate n 0 ++ replicate n λ ++ replicate m 1 92 | Optimal (_j,x) = simplex (Minimize cost) p (map Free [1..(2*n+m)]) 93 | 94 | -------------------------------------------------------------------------------- 95 | 96 | -- | Solution in the L_1 norm, with L_1 regularization, of a system of linear inequalities @Ax>=b@. 97 | -- 98 | -- @argmin_x λ||x||_1 + ||step(b-Ax)||_1@ 99 | l1SolveGT 100 | :: Double -- ^ λ 101 | -> Matrix Double -- ^ A 102 | -> Vector Double -- ^ b 103 | -> Vector Double -- ^ x 104 | l1SolveGT λ a b = fromList (take n x) 105 | where 106 | n = cols a 107 | m = rows a 108 | as = toRows a 109 | bs = toList b 110 | cRes = zipWith3 mkR as bs [1..m] 111 | mkR a_i b_i k = (zipWith (#) (toList a_i) [1..] ++ [1#(k+2*n)]) :>=: (b_i) 112 | c1Sol = map (\k -> [ 1#k, -1#k+n] :<=: 0) [1..n] 113 | c2Sol = map (\k -> [-1#k, -1#k+n] :<=: 0) [1..n] 114 | p = Sparse (cRes++c1Sol++c2Sol) 115 | cost = replicate n 0 ++ replicate n λ ++ replicate m 1 116 | Optimal (_j,x) = simplex (Minimize cost) p (map Free [1..(2*n)]) 117 | 118 | -------------------------------------------------------------------------------- 119 | 120 | 121 | -------------------------------------------------------------------------------- /packages/glpk/src/C/glpk.c: -------------------------------------------------------------------------------- 1 | #define DVEC(A) int A##n, double*A##p 2 | #define DMAT(A) int A##r, int A##c, double*A##p 3 | 4 | #define AT(M,r,co) (M##p[(r)*M##c+(co)]) 5 | 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | /*-----------------------------------------------------*/ 12 | 13 | #define C_X_SPARSE(X) \ 14 | int c_##X##_sparse(int m, int n, DMAT(c), DMAT(b), DVEC(s)) { \ 15 | glp_prob *lp; \ 16 | lp = glp_create_prob(); \ 17 | glp_set_obj_dir(lp, GLP_MAX); \ 18 | int i,j,k; \ 19 | int tot = cr - n; \ 20 | glp_add_rows(lp, m); \ 21 | glp_add_cols(lp, n); \ 22 | \ 23 | /*printf("%d %d\n",m,n);*/ \ 24 | \ 25 | /* the first n values */ \ 26 | for (k=1;k<=n;k++) { \ 27 | glp_set_obj_coef(lp, k, AT(c, k-1, 2)); \ 28 | /*printf("%d %f\n",k,AT(c, k-1, 2)); */ \ 29 | } \ 30 | \ 31 | int * ia = malloc((1+tot)*sizeof(int)); \ 32 | int * ja = malloc((1+tot)*sizeof(int)); \ 33 | double * ar = malloc((1+tot)*sizeof(double)); \ 34 | \ 35 | for (k=1; k<= tot; k++) { \ 36 | ia[k] = rint(AT(c,k-1+n,0)); \ 37 | ja[k] = rint(AT(c,k-1+n,1)); \ 38 | ar[k] = AT(c,k-1+n,2); \ 39 | /*printf("%d %d %f\n",ia[k],ja[k],ar[k]);*/ \ 40 | } \ 41 | glp_load_matrix(lp, tot, ia, ja, ar); \ 42 | \ 43 | int t; \ 44 | for (i=1;i<=m;i++) { \ 45 | switch((int)rint(AT(b,i-1,0))) { \ 46 | case 0: { t = GLP_FR; break; } \ 47 | case 1: { t = GLP_LO; break; } \ 48 | case 2: { t = GLP_UP; break; } \ 49 | case 3: { t = GLP_DB; break; } \ 50 | default: { t = GLP_FX; break; } \ 51 | } \ 52 | glp_set_row_bnds(lp, i, t , AT(b,i-1,1), AT(b,i-1,2)); \ 53 | } \ 54 | for (j=1;j<=n;j++) { \ 55 | switch((int)rint(AT(b,m+j-1,0))) { \ 56 | case 0: { t = GLP_FR; break; } \ 57 | case 1: { t = GLP_LO; break; } \ 58 | case 2: { t = GLP_UP; break; } \ 59 | case 3: { t = GLP_DB; break; } \ 60 | default: { t = GLP_FX; break; } \ 61 | } \ 62 | glp_set_col_bnds(lp, j, t , AT(b,m+j-1,1), AT(b,m+j-1,2)); \ 63 | } \ 64 | glp_term_out(0); \ 65 | glp_##X(lp, NULL); \ 66 | sp[0] = glp_get_status(lp); \ 67 | sp[1] = glp_get_obj_val(lp); \ 68 | for (k=1; k<=n; k++) { \ 69 | sp[k+1] = glp_get_col_prim(lp, k); \ 70 | } \ 71 | glp_delete_prob(lp); \ 72 | free(ia); \ 73 | free(ja); \ 74 | free(ar); \ 75 | \ 76 | return 0; \ 77 | } \ 78 | 79 | C_X_SPARSE(simplex); 80 | C_X_SPARSE(exact); 81 | -------------------------------------------------------------------------------- /packages/base/src/Internal/Convolution.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | ----------------------------------------------------------------------------- 4 | {- | 5 | Module : Internal.Convolution 6 | Copyright : (c) Alberto Ruiz 2012 7 | License : BSD3 8 | Maintainer : Alberto Ruiz 9 | Stability : provisional 10 | 11 | -} 12 | ----------------------------------------------------------------------------- 13 | {-# OPTIONS_HADDOCK hide #-} 14 | 15 | module Internal.Convolution( 16 | corr, conv, corrMin, 17 | corr2, conv2, separable 18 | ) where 19 | 20 | import qualified Data.Vector.Storable as SV 21 | import Internal.Vector 22 | import Internal.Matrix 23 | import Internal.Numeric 24 | import Internal.Element 25 | import Internal.Conversion 26 | import Internal.Container 27 | #if MIN_VERSION_base(4,11,0) 28 | import Prelude hiding ((<>)) 29 | #endif 30 | 31 | 32 | vectSS :: Element t => Int -> Vector t -> Matrix t 33 | vectSS n v = fromRows [ subVector k n v | k <- [0 .. dim v - n] ] 34 | 35 | 36 | corr 37 | :: (Container Vector t, Product t) 38 | => Vector t -- ^ kernel 39 | -> Vector t -- ^ source 40 | -> Vector t 41 | {- ^ correlation 42 | 43 | >>> corr (fromList[1,2,3]) (fromList [1..10]) 44 | [14.0,20.0,26.0,32.0,38.0,44.0,50.0,56.0] 45 | it :: (Enum t, Product t, Container Vector t) => Vector t 46 | 47 | -} 48 | corr ker v 49 | | dim ker == 0 = konst 0 (dim v) 50 | | dim ker <= dim v = vectSS (dim ker) v <> ker 51 | | otherwise = error $ "corr: dim kernel ("++show (dim ker)++") > dim vector ("++show (dim v)++")" 52 | 53 | 54 | conv :: (Container Vector t, Product t, Num t) => Vector t -> Vector t -> Vector t 55 | {- ^ convolution ('corr' with reversed kernel and padded input, equivalent to polynomial product) 56 | 57 | >>> conv (fromList[1,1]) (fromList [-1,1]) 58 | [-1.0,0.0,1.0] 59 | it :: (Product t, Container Vector t) => Vector t 60 | 61 | -} 62 | conv ker v 63 | | dim ker == 0 = konst 0 (dim v) 64 | | otherwise = corr ker' v' 65 | where 66 | ker' = SV.reverse ker 67 | v' = vjoin [z,v,z] 68 | z = konst 0 (dim ker -1) 69 | 70 | corrMin :: (Container Vector t, RealElement t, Product t) 71 | => Vector t 72 | -> Vector t 73 | -> Vector t 74 | -- ^ similar to 'corr', using 'min' instead of (*) 75 | corrMin ker v 76 | | dim ker == 0 = error "corrMin: empty kernel" 77 | | otherwise = minEvery ss (asRow ker) <> ones 78 | where 79 | minEvery a b = cond a b a a b 80 | ss = vectSS (dim ker) v 81 | ones = konst 1 (dim ker) 82 | 83 | 84 | 85 | matSS :: Element t => Int -> Matrix t -> [Matrix t] 86 | matSS dr m = map (reshape c) [ subVector (k*c) n v | k <- [0 .. r - dr] ] 87 | where 88 | v = flatten m 89 | c = cols m 90 | r = rows m 91 | n = dr*c 92 | 93 | 94 | {- | 2D correlation (without padding) 95 | 96 | >>> disp 5 $ corr2 (konst 1 (3,3)) (ident 10 :: Matrix Double) 97 | 8x8 98 | 3 2 1 0 0 0 0 0 99 | 2 3 2 1 0 0 0 0 100 | 1 2 3 2 1 0 0 0 101 | 0 1 2 3 2 1 0 0 102 | 0 0 1 2 3 2 1 0 103 | 0 0 0 1 2 3 2 1 104 | 0 0 0 0 1 2 3 2 105 | 0 0 0 0 0 1 2 3 106 | 107 | -} 108 | corr2 :: Product a => Matrix a -> Matrix a -> Matrix a 109 | corr2 ker mat = dims 110 | . concatMap (map (udot ker' . flatten) . matSS c . trans) 111 | . matSS r $ mat 112 | where 113 | r = rows ker 114 | c = cols ker 115 | ker' = flatten (trans ker) 116 | rr = rows mat - r + 1 117 | rc = cols mat - c + 1 118 | dims | rr > 0 && rc > 0 = (rr >< rc) 119 | | otherwise = error $ "corr2: dim kernel ("++sz ker++") > dim matrix ("++sz mat++")" 120 | sz m = show (rows m)++"x"++show (cols m) 121 | -- TODO check empty kernel 122 | 123 | {- | 2D convolution 124 | 125 | >>> disp 5 $ conv2 (konst 1 (3,3)) (ident 10 :: Matrix Double) 126 | 12x12 127 | 1 1 1 0 0 0 0 0 0 0 0 0 128 | 1 2 2 1 0 0 0 0 0 0 0 0 129 | 1 2 3 2 1 0 0 0 0 0 0 0 130 | 0 1 2 3 2 1 0 0 0 0 0 0 131 | 0 0 1 2 3 2 1 0 0 0 0 0 132 | 0 0 0 1 2 3 2 1 0 0 0 0 133 | 0 0 0 0 1 2 3 2 1 0 0 0 134 | 0 0 0 0 0 1 2 3 2 1 0 0 135 | 0 0 0 0 0 0 1 2 3 2 1 0 136 | 0 0 0 0 0 0 0 1 2 3 2 1 137 | 0 0 0 0 0 0 0 0 1 2 2 1 138 | 0 0 0 0 0 0 0 0 0 1 1 1 139 | 140 | -} 141 | conv2 142 | :: (Num (Matrix a), Product a, Container Vector a) 143 | => Matrix a -- ^ kernel 144 | -> Matrix a -> Matrix a 145 | conv2 k m 146 | | empty = konst 0 (rows m + r -1, cols m + c -1) 147 | | otherwise = corr2 (fliprl . flipud $ k) padded 148 | where 149 | padded = fromBlocks [[z,0,0] 150 | ,[0,m,0] 151 | ,[0,0,z]] 152 | r = rows k 153 | c = cols k 154 | z = konst 0 (r-1,c-1) 155 | empty = r == 0 || c == 0 156 | 157 | 158 | separable :: Element t => (Vector t -> Vector t) -> Matrix t -> Matrix t 159 | -- ^ matrix computation implemented as separated vector operations by rows and columns. 160 | separable f = fromColumns . map f . toColumns . fromRows . map f . toRows 161 | 162 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Exp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 4 | 5 | ------------------------------------------------------------ 6 | -- | 7 | -- Module : Numeric.GSL.Special.Exp 8 | -- Copyright : (c) Alberto Ruiz 2006-11 9 | -- License : GPL 10 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 11 | -- Stability : provisional 12 | -- Portability : uses ffi 13 | -- 14 | -- Wrappers for selected functions described at: 15 | -- 16 | -- 17 | ------------------------------------------------------------ 18 | 19 | module Numeric.GSL.Special.Exp( 20 | exp_e 21 | , Numeric.GSL.Special.Exp.exp 22 | , exp_e10_e 23 | , exp_mult_e 24 | , exp_mult 25 | , exp_mult_e10_e 26 | , expm1_e 27 | , expm1 28 | , exprel_e 29 | , exprel 30 | , exprel_2_e 31 | , exprel_2 32 | , exprel_n_e 33 | , exprel_n 34 | -- , exprel_n_CF_e 35 | , exp_err_e 36 | , exp_err_e10_e 37 | , exp_mult_err_e 38 | , exp_mult_err_e10_e 39 | ) where 40 | 41 | import Foreign(Ptr) 42 | import Foreign.C.Types 43 | import Numeric.GSL.Special.Internal 44 | 45 | exp_e :: Double -> (Double,Double) 46 | exp_e x = createSFR "exp_e" $ gsl_sf_exp_e x 47 | foreign import ccall SAFE_CHEAP "gsl_sf_exp_e" gsl_sf_exp_e :: Double -> Ptr () -> IO CInt 48 | 49 | exp :: Double -> Double 50 | exp = gsl_sf_exp 51 | foreign import ccall SAFE_CHEAP "gsl_sf_exp" gsl_sf_exp :: Double -> Double 52 | 53 | exp_e10_e :: Double -> (Double,Int,Double) 54 | exp_e10_e x = createSFR_E10 "exp_e10_e" $ gsl_sf_exp_e10_e x 55 | foreign import ccall SAFE_CHEAP "gsl_sf_exp_e10_e" gsl_sf_exp_e10_e :: Double -> Ptr () -> IO CInt 56 | 57 | exp_mult_e :: Double -> Double -> (Double,Double) 58 | exp_mult_e x y = createSFR "exp_mult_e" $ gsl_sf_exp_mult_e x y 59 | foreign import ccall SAFE_CHEAP "gsl_sf_exp_mult_e" gsl_sf_exp_mult_e :: Double -> Double -> Ptr () -> IO CInt 60 | 61 | exp_mult :: Double -> Double -> Double 62 | exp_mult = gsl_sf_exp_mult 63 | foreign import ccall SAFE_CHEAP "gsl_sf_exp_mult" gsl_sf_exp_mult :: Double -> Double -> Double 64 | 65 | exp_mult_e10_e :: Double -> Double -> (Double,Int,Double) 66 | exp_mult_e10_e x y = createSFR_E10 "exp_mult_e10_e" $ gsl_sf_exp_mult_e10_e x y 67 | foreign import ccall SAFE_CHEAP "gsl_sf_exp_mult_e10_e" gsl_sf_exp_mult_e10_e :: Double -> Double -> Ptr () -> IO CInt 68 | 69 | expm1_e :: Double -> (Double,Double) 70 | expm1_e x = createSFR "expm1_e" $ gsl_sf_expm1_e x 71 | foreign import ccall SAFE_CHEAP "gsl_sf_expm1_e" gsl_sf_expm1_e :: Double -> Ptr () -> IO CInt 72 | 73 | expm1 :: Double -> Double 74 | expm1 = gsl_sf_expm1 75 | foreign import ccall SAFE_CHEAP "gsl_sf_expm1" gsl_sf_expm1 :: Double -> Double 76 | 77 | exprel_e :: Double -> (Double,Double) 78 | exprel_e x = createSFR "exprel_e" $ gsl_sf_exprel_e x 79 | foreign import ccall SAFE_CHEAP "gsl_sf_exprel_e" gsl_sf_exprel_e :: Double -> Ptr () -> IO CInt 80 | 81 | exprel :: Double -> Double 82 | exprel = gsl_sf_exprel 83 | foreign import ccall SAFE_CHEAP "gsl_sf_exprel" gsl_sf_exprel :: Double -> Double 84 | 85 | exprel_2_e :: Double -> (Double,Double) 86 | exprel_2_e x = createSFR "exprel_2_e" $ gsl_sf_exprel_2_e x 87 | foreign import ccall SAFE_CHEAP "gsl_sf_exprel_2_e" gsl_sf_exprel_2_e :: Double -> Ptr () -> IO CInt 88 | 89 | exprel_2 :: Double -> Double 90 | exprel_2 = gsl_sf_exprel_2 91 | foreign import ccall SAFE_CHEAP "gsl_sf_exprel_2" gsl_sf_exprel_2 :: Double -> Double 92 | 93 | exprel_n_e :: CInt -> Double -> (Double,Double) 94 | exprel_n_e n x = createSFR "exprel_n_e" $ gsl_sf_exprel_n_e n x 95 | foreign import ccall SAFE_CHEAP "gsl_sf_exprel_n_e" gsl_sf_exprel_n_e :: CInt -> Double -> Ptr () -> IO CInt 96 | 97 | exprel_n :: CInt -> Double -> Double 98 | exprel_n = gsl_sf_exprel_n 99 | foreign import ccall SAFE_CHEAP "gsl_sf_exprel_n" gsl_sf_exprel_n :: CInt -> Double -> Double 100 | 101 | exprel_n_CF_e :: Double -> Double -> (Double,Double) 102 | exprel_n_CF_e n x = createSFR "exprel_n_CF_e" $ gsl_sf_exprel_n_CF_e n x 103 | foreign import ccall SAFE_CHEAP "gsl_sf_exprel_n_CF_e" gsl_sf_exprel_n_CF_e :: Double -> Double -> Ptr () -> IO CInt 104 | 105 | exp_err_e :: Double -> Double -> (Double,Double) 106 | exp_err_e x dx = createSFR "exp_err_e" $ gsl_sf_exp_err_e x dx 107 | foreign import ccall SAFE_CHEAP "gsl_sf_exp_err_e" gsl_sf_exp_err_e :: Double -> Double -> Ptr () -> IO CInt 108 | 109 | exp_err_e10_e :: Double -> Double -> (Double,Int,Double) 110 | exp_err_e10_e x dx = createSFR_E10 "exp_err_e10_e" $ gsl_sf_exp_err_e10_e x dx 111 | foreign import ccall SAFE_CHEAP "gsl_sf_exp_err_e10_e" gsl_sf_exp_err_e10_e :: Double -> Double -> Ptr () -> IO CInt 112 | 113 | exp_mult_err_e :: Double -> Double -> Double -> Double -> (Double,Double) 114 | exp_mult_err_e x dx y dy = createSFR "exp_mult_err_e" $ gsl_sf_exp_mult_err_e x dx y dy 115 | foreign import ccall SAFE_CHEAP "gsl_sf_exp_mult_err_e" gsl_sf_exp_mult_err_e :: Double -> Double -> Double -> Double -> Ptr () -> IO CInt 116 | 117 | exp_mult_err_e10_e :: Double -> Double -> Double -> Double -> (Double,Int,Double) 118 | exp_mult_err_e10_e x dx y dy = createSFR_E10 "exp_mult_err_e10_e" $ gsl_sf_exp_mult_err_e10_e x dx y dy 119 | foreign import ccall SAFE_CHEAP "gsl_sf_exp_mult_err_e10_e" gsl_sf_exp_mult_err_e10_e :: Double -> Double -> Double -> Double -> Ptr () -> IO CInt 120 | -------------------------------------------------------------------------------- /packages/special/lib/Numeric/GSL/Special/Fermi_dirac.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ------------------------------------------------------------ 3 | -- | 4 | -- Module : Numeric.GSL.Special.Fermi_dirac 5 | -- Copyright : (c) Alberto Ruiz 2006-11 6 | -- License : GPL 7 | -- Maintainer : Alberto Ruiz (aruiz at um dot es) 8 | -- Stability : provisional 9 | -- Portability : uses ffi 10 | -- 11 | -- Wrappers for selected functions described at: 12 | -- 13 | -- 14 | ------------------------------------------------------------ 15 | 16 | module Numeric.GSL.Special.Fermi_dirac( 17 | fermi_dirac_m1_e 18 | , fermi_dirac_m1 19 | , fermi_dirac_0_e 20 | , fermi_dirac_0 21 | , fermi_dirac_1_e 22 | , fermi_dirac_1 23 | , fermi_dirac_2_e 24 | , fermi_dirac_2 25 | , fermi_dirac_int_e 26 | , fermi_dirac_int 27 | , fermi_dirac_mhalf_e 28 | , fermi_dirac_mhalf 29 | , fermi_dirac_half_e 30 | , fermi_dirac_half 31 | , fermi_dirac_3half_e 32 | , fermi_dirac_3half 33 | , fermi_dirac_inc_0_e 34 | , fermi_dirac_inc_0 35 | ) where 36 | 37 | import Foreign(Ptr) 38 | import Foreign.C.Types 39 | import Numeric.GSL.Special.Internal 40 | 41 | fermi_dirac_m1_e :: Double -> (Double,Double) 42 | fermi_dirac_m1_e x = createSFR "fermi_dirac_m1_e" $ gsl_sf_fermi_dirac_m1_e x 43 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_m1_e" gsl_sf_fermi_dirac_m1_e :: Double -> Ptr () -> IO CInt 44 | 45 | fermi_dirac_m1 :: Double -> Double 46 | fermi_dirac_m1 = gsl_sf_fermi_dirac_m1 47 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_m1" gsl_sf_fermi_dirac_m1 :: Double -> Double 48 | 49 | fermi_dirac_0_e :: Double -> (Double,Double) 50 | fermi_dirac_0_e x = createSFR "fermi_dirac_0_e" $ gsl_sf_fermi_dirac_0_e x 51 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_0_e" gsl_sf_fermi_dirac_0_e :: Double -> Ptr () -> IO CInt 52 | 53 | fermi_dirac_0 :: Double -> Double 54 | fermi_dirac_0 = gsl_sf_fermi_dirac_0 55 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_0" gsl_sf_fermi_dirac_0 :: Double -> Double 56 | 57 | fermi_dirac_1_e :: Double -> (Double,Double) 58 | fermi_dirac_1_e x = createSFR "fermi_dirac_1_e" $ gsl_sf_fermi_dirac_1_e x 59 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_1_e" gsl_sf_fermi_dirac_1_e :: Double -> Ptr () -> IO CInt 60 | 61 | fermi_dirac_1 :: Double -> Double 62 | fermi_dirac_1 = gsl_sf_fermi_dirac_1 63 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_1" gsl_sf_fermi_dirac_1 :: Double -> Double 64 | 65 | fermi_dirac_2_e :: Double -> (Double,Double) 66 | fermi_dirac_2_e x = createSFR "fermi_dirac_2_e" $ gsl_sf_fermi_dirac_2_e x 67 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_2_e" gsl_sf_fermi_dirac_2_e :: Double -> Ptr () -> IO CInt 68 | 69 | fermi_dirac_2 :: Double -> Double 70 | fermi_dirac_2 = gsl_sf_fermi_dirac_2 71 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_2" gsl_sf_fermi_dirac_2 :: Double -> Double 72 | 73 | fermi_dirac_int_e :: CInt -> Double -> (Double,Double) 74 | fermi_dirac_int_e j x = createSFR "fermi_dirac_int_e" $ gsl_sf_fermi_dirac_int_e j x 75 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_int_e" gsl_sf_fermi_dirac_int_e :: CInt -> Double -> Ptr () -> IO CInt 76 | 77 | fermi_dirac_int :: CInt -> Double -> Double 78 | fermi_dirac_int = gsl_sf_fermi_dirac_int 79 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_int" gsl_sf_fermi_dirac_int :: CInt -> Double -> Double 80 | 81 | fermi_dirac_mhalf_e :: Double -> (Double,Double) 82 | fermi_dirac_mhalf_e x = createSFR "fermi_dirac_mhalf_e" $ gsl_sf_fermi_dirac_mhalf_e x 83 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_mhalf_e" gsl_sf_fermi_dirac_mhalf_e :: Double -> Ptr () -> IO CInt 84 | 85 | fermi_dirac_mhalf :: Double -> Double 86 | fermi_dirac_mhalf = gsl_sf_fermi_dirac_mhalf 87 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_mhalf" gsl_sf_fermi_dirac_mhalf :: Double -> Double 88 | 89 | fermi_dirac_half_e :: Double -> (Double,Double) 90 | fermi_dirac_half_e x = createSFR "fermi_dirac_half_e" $ gsl_sf_fermi_dirac_half_e x 91 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_half_e" gsl_sf_fermi_dirac_half_e :: Double -> Ptr () -> IO CInt 92 | 93 | fermi_dirac_half :: Double -> Double 94 | fermi_dirac_half = gsl_sf_fermi_dirac_half 95 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_half" gsl_sf_fermi_dirac_half :: Double -> Double 96 | 97 | fermi_dirac_3half_e :: Double -> (Double,Double) 98 | fermi_dirac_3half_e x = createSFR "fermi_dirac_3half_e" $ gsl_sf_fermi_dirac_3half_e x 99 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_3half_e" gsl_sf_fermi_dirac_3half_e :: Double -> Ptr () -> IO CInt 100 | 101 | fermi_dirac_3half :: Double -> Double 102 | fermi_dirac_3half = gsl_sf_fermi_dirac_3half 103 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_3half" gsl_sf_fermi_dirac_3half :: Double -> Double 104 | 105 | fermi_dirac_inc_0_e :: Double -> Double -> (Double,Double) 106 | fermi_dirac_inc_0_e x b = createSFR "fermi_dirac_inc_0_e" $ gsl_sf_fermi_dirac_inc_0_e x b 107 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_inc_0_e" gsl_sf_fermi_dirac_inc_0_e :: Double -> Double -> Ptr () -> IO CInt 108 | 109 | fermi_dirac_inc_0 :: Double -> Double -> Double 110 | fermi_dirac_inc_0 = gsl_sf_fermi_dirac_inc_0 111 | foreign import ccall SAFE_CHEAP "gsl_sf_fermi_dirac_inc_0" gsl_sf_fermi_dirac_inc_0 :: Double -> Double -> Double 112 | -------------------------------------------------------------------------------- /packages/gsl/src/Numeric/GSL/LinearAlgebra.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 2 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 3 | 4 | ----------------------------------------------------------------------------- 5 | -- | 6 | -- Module : Numeric.GSL.LinearAlgebra 7 | -- Copyright : (c) Alberto Ruiz 2007-14 8 | -- License : GPL 9 | -- Maintainer : Alberto Ruiz 10 | -- Stability : provisional 11 | -- 12 | ----------------------------------------------------------------------------- 13 | 14 | module Numeric.GSL.LinearAlgebra ( 15 | RandDist(..), randomVector, 16 | saveMatrix, 17 | fwriteVector, freadVector, fprintfVector, fscanfVector, 18 | fileDimensions, loadMatrix, fromFile 19 | ) where 20 | 21 | import Numeric.LinearAlgebra.HMatrix hiding (RandDist,randomVector,saveMatrix,loadMatrix) 22 | import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) 23 | 24 | import Foreign.Marshal.Alloc(free) 25 | import Foreign.Ptr(Ptr) 26 | import Foreign.C.Types 27 | import Foreign.C.String(newCString) 28 | import System.IO.Unsafe(unsafePerformIO) 29 | import System.Process(readProcess) 30 | 31 | fromei x = fromIntegral (fromEnum x) :: CInt 32 | 33 | ----------------------------------------------------------------------- 34 | 35 | data RandDist = Uniform -- ^ uniform distribution in [0,1) 36 | | Gaussian -- ^ normal distribution with mean zero and standard deviation one 37 | deriving Enum 38 | 39 | -- | Obtains a vector of pseudorandom elements from the the mt19937 generator in GSL, with a given seed. Use randomIO to get a random seed. 40 | randomVector :: Int -- ^ seed 41 | -> RandDist -- ^ distribution 42 | -> Int -- ^ vector size 43 | -> Vector Double 44 | randomVector seed dist n = unsafePerformIO $ do 45 | r <- createVector n 46 | (r `applyRaw` id) (c_random_vector (fi seed) ((fi.fromEnum) dist)) #|"randomVector" 47 | return r 48 | 49 | foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> TV 50 | 51 | -------------------------------------------------------------------------------- 52 | 53 | -- | Saves a matrix as 2D ASCII table. 54 | saveMatrix :: FilePath 55 | -> String -- ^ format (%f, %g, %e) 56 | -> Matrix Double 57 | -> IO () 58 | saveMatrix filename fmt m = do 59 | charname <- newCString filename 60 | charfmt <- newCString fmt 61 | let o = if orderOf m == RowMajor then 1 else 0 62 | (m `applyRaw` id) (matrix_fprintf charname charfmt o) #|"matrix_fprintf" 63 | free charname 64 | free charfmt 65 | 66 | foreign import ccall unsafe "matrix_fprintf" matrix_fprintf :: Ptr CChar -> Ptr CChar -> CInt -> TM 67 | 68 | -------------------------------------------------------------------------------- 69 | 70 | -- | Loads a vector from an ASCII file (the number of elements must be known in advance). 71 | fscanfVector :: FilePath -> Int -> IO (Vector Double) 72 | fscanfVector filename n = do 73 | charname <- newCString filename 74 | res <- createVector n 75 | (res `applyRaw` id) (gsl_vector_fscanf charname) #|"gsl_vector_fscanf" 76 | free charname 77 | return res 78 | 79 | foreign import ccall unsafe "vector_fscanf" gsl_vector_fscanf:: Ptr CChar -> TV 80 | 81 | -- | Saves the elements of a vector, with a given format (%f, %e, %g), to an ASCII file. 82 | fprintfVector :: FilePath -> String -> Vector Double -> IO () 83 | fprintfVector filename fmt v = do 84 | charname <- newCString filename 85 | charfmt <- newCString fmt 86 | (v `applyRaw` id) (gsl_vector_fprintf charname charfmt) #|"gsl_vector_fprintf" 87 | free charname 88 | free charfmt 89 | 90 | foreign import ccall unsafe "vector_fprintf" gsl_vector_fprintf :: Ptr CChar -> Ptr CChar -> TV 91 | 92 | -- | Loads a vector from a binary file (the number of elements must be known in advance). 93 | freadVector :: FilePath -> Int -> IO (Vector Double) 94 | freadVector filename n = do 95 | charname <- newCString filename 96 | res <- createVector n 97 | (res `applyRaw` id) (gsl_vector_fread charname) #| "gsl_vector_fread" 98 | free charname 99 | return res 100 | 101 | foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV 102 | 103 | -- | Saves the elements of a vector to a binary file. 104 | fwriteVector :: FilePath -> Vector Double -> IO () 105 | fwriteVector filename v = do 106 | charname <- newCString filename 107 | (v `applyRaw` id) (gsl_vector_fwrite charname) #|"gsl_vector_fwrite" 108 | free charname 109 | 110 | foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV 111 | 112 | type PD = Ptr Double -- 113 | type TV = CInt -> PD -> IO CInt -- 114 | type TM = CInt -> CInt -> PD -> IO CInt -- 115 | 116 | -------------------------------------------------------------------------------- 117 | 118 | {- | obtains the number of rows and columns in an ASCII data file 119 | (provisionally using unix's wc). 120 | -} 121 | fileDimensions :: FilePath -> IO (Int,Int) 122 | fileDimensions fname = do 123 | wcres <- readProcess "wc" ["-w",fname] "" 124 | contents <- readFile fname 125 | let tot = read . head . words $ wcres 126 | c = length . head . dropWhile null . map words . lines $ contents 127 | if tot > 0 128 | then return (tot `div` c, c) 129 | else return (0,0) 130 | 131 | -- | Loads a matrix from an ASCII file formatted as a 2D table. 132 | loadMatrix :: FilePath -> IO (Matrix Double) 133 | loadMatrix file = fromFile file =<< fileDimensions file 134 | 135 | -- | Loads a matrix from an ASCII file (the number of rows and columns must be known in advance). 136 | fromFile :: FilePath -> (Int,Int) -> IO (Matrix Double) 137 | fromFile filename (r,c) = reshape c `fmap` fscanfVector filename (r*c) 138 | 139 | -------------------------------------------------------------------------------- /packages/base/hmatrix.cabal: -------------------------------------------------------------------------------- 1 | Name: hmatrix 2 | Version: 0.20.2 3 | License: BSD3 4 | License-file: LICENSE 5 | Author: Alberto Ruiz 6 | Maintainer: Dominic Steinitz 7 | Stability: provisional 8 | Homepage: https://github.com/haskell-numerics/hmatrix 9 | Synopsis: Numeric Linear Algebra 10 | Description: Linear systems, matrix decompositions, and other numerical computations based on BLAS and LAPACK. 11 | . 12 | Standard interface: "Numeric.LinearAlgebra". 13 | . 14 | Safer interface with statically checked dimensions: "Numeric.LinearAlgebra.Static". 15 | . 16 | Code examples: 17 | 18 | Category: Math 19 | tested-with: GHC==8.10 20 | 21 | cabal-version: >=1.18 22 | 23 | build-type: Simple 24 | 25 | extra-source-files: THANKS.md CHANGELOG 26 | 27 | extra-source-files: src/Internal/C/lapack-aux.h 28 | 29 | flag openblas 30 | description: Link with OpenBLAS (https://github.com/xianyi/OpenBLAS) optimized libraries. 31 | default: False 32 | manual: True 33 | 34 | flag disable-default-paths 35 | description: When enabled, don't add default hardcoded include/link dirs by default. Needed for hermetic builds like in nix. 36 | default: False 37 | manual: True 38 | 39 | flag no-random_r 40 | description: When enabled, don't depend on the random_r() C function. 41 | default: False 42 | manual: True 43 | 44 | library 45 | 46 | default-language: Haskell2010 47 | 48 | Build-Depends: base >= 4.8 && < 5, 49 | binary, 50 | array, 51 | deepseq, 52 | random, 53 | split >= 0.2, 54 | bytestring, 55 | primitive, 56 | storable-complex, 57 | semigroups, 58 | vector >= 0.11 59 | 60 | hs-source-dirs: src 61 | 62 | exposed-modules: Numeric.LinearAlgebra 63 | Numeric.LinearAlgebra.Devel 64 | Numeric.LinearAlgebra.Data 65 | Numeric.LinearAlgebra.HMatrix 66 | Numeric.LinearAlgebra.Static 67 | Internal.Vector 68 | Internal.Devel 69 | Internal.Vectorized 70 | Internal.Matrix 71 | Internal.ST 72 | Internal.IO 73 | Internal.Element 74 | Internal.Conversion 75 | Internal.LAPACK 76 | Internal.Numeric 77 | Internal.Algorithms 78 | Internal.Random 79 | Internal.Container 80 | Internal.Sparse 81 | Internal.Convolution 82 | Internal.Chain 83 | Numeric.Vector 84 | Internal.CG 85 | Numeric.Matrix 86 | Internal.Util 87 | Internal.Modular 88 | Internal.Static 89 | 90 | C-sources: src/Internal/C/lapack-aux.c 91 | src/Internal/C/vector-aux.c 92 | 93 | 94 | other-extensions: ForeignFunctionInterface 95 | 96 | ghc-options: -Wall 97 | -fno-warn-missing-signatures 98 | -fno-warn-orphans 99 | -fno-prof-auto 100 | 101 | cc-options: -O4 -Wall 102 | 103 | if arch(x86_64) 104 | cc-options: -msse2 105 | if arch(i386) 106 | cc-options: -msse2 107 | 108 | 109 | if flag(no-random_r) 110 | cc-options: -DNO_RANDOM_R 111 | 112 | if os(OSX) 113 | if flag(openblas) 114 | if !flag(disable-default-paths) 115 | extra-lib-dirs: /opt/local/lib/openblas/lib 116 | extra-libraries: openblas 117 | else 118 | extra-libraries: blas lapack 119 | 120 | if !flag(disable-default-paths) 121 | extra-lib-dirs: /opt/local/lib/ 122 | include-dirs: /opt/local/include/ 123 | extra-lib-dirs: /usr/local/lib/ 124 | include-dirs: /usr/local/include/ 125 | if arch(i386) 126 | cc-options: -arch i386 127 | frameworks: Accelerate 128 | 129 | if os(freebsd) 130 | if flag(openblas) 131 | if !flag(disable-default-paths) 132 | extra-lib-dirs: /usr/local/lib/openblas/lib 133 | extra-libraries: openblas 134 | else 135 | extra-libraries: blas lapack 136 | 137 | if !flag(disable-default-paths) 138 | extra-lib-dirs: /usr/local/lib 139 | include-dirs: /usr/local/include 140 | extra-libraries: gfortran 141 | extra-lib-dirs: /usr/local/lib/gcc9 /usr/local/lib/gcc8 /usr/local/lib/gcc7 142 | 143 | if os(windows) 144 | if flag(openblas) 145 | extra-libraries: openblas 146 | else 147 | extra-libraries: blas lapack 148 | 149 | if os(linux) 150 | if flag(openblas) 151 | if !flag(disable-default-paths) 152 | extra-lib-dirs: /usr/lib/openblas/lib 153 | extra-libraries: openblas 154 | else 155 | extra-libraries: blas lapack 156 | 157 | if arch(x86_64) 158 | cc-options: -fPIC 159 | 160 | 161 | source-repository head 162 | type: git 163 | location: https://github.com/haskell-numerics/hmatrix 164 | --------------------------------------------------------------------------------