├── .clang-format ├── .gitattributes ├── .gitignore ├── .markdownlint.json ├── lib ├── mlgsl_matrix_double.c ├── mlgsl_matrix_float.c ├── mlgsl_vector_double.c ├── mlgsl_vector_float.c ├── mlgsl_matrix_complex.c ├── mlgsl_matrix_complex_float.c ├── config │ ├── Makefile │ ├── dune │ ├── do_common.ml │ ├── do_const.ml │ └── discover.ml ├── mlgsl_vector_double.h ├── mlgsl_vector_float.h ├── mlgsl_vector_complex_float.h ├── version.ml ├── mlgsl_matrix_double.h ├── mlgsl_rng.h ├── mlgsl_matrix_float.h ├── Makefile ├── mlgsl_matrix_complex_float.h ├── misc.ml ├── combi.mli ├── mlgsl_permut.h ├── deriv.ml ├── cheb.mli ├── mlgsl_math.c ├── bspline.mli ├── qrng.mli ├── combi.ml ├── gsl_sort.mli ├── min.mli ├── mlgsl_vector_complex.h ├── multifit.mli ├── sum.mli ├── qrng.ml ├── fit.ml ├── fit.mli ├── bspline.ml ├── mlgsl_matrix_complex.h ├── mlgsl_blas.h ├── siman.mli ├── min.ml ├── multifit_nlin.mli ├── fun.ml ├── mlgsl_deriv.c ├── mlgsl_combi.c ├── sum.ml ├── mlgsl_bspline.c ├── poly.mli ├── root.mli ├── multifit_nlin.ml ├── mlgsl_complex.h ├── vector_complex_flat.mli ├── ieee.mli ├── cheb.ml ├── wavelet.mli ├── poly.ml ├── dune ├── multimin.mli ├── siman.ml ├── mlgsl_qrng.c ├── fun.mli ├── permut.mli ├── mlgsl_error.c ├── math.mli ├── ieee.ml ├── multifit.ml ├── deriv.mli ├── mlgsl_sort.c ├── multiroot.mli ├── mlgsl_cheb.c ├── root.ml ├── interp.mli ├── vector_complex.mli ├── mlgsl_sum.c ├── vector_flat.mli ├── math.ml ├── multimin.ml ├── stats.ml ├── stats.mli ├── odeiv.mli ├── histo.mli ├── matrix_flat.mli ├── multiroot.ml ├── mlgsl_min.c ├── gsl_sort.ml ├── mlgsl_fun.h ├── mlgsl_matrix.h ├── vector_complex_flat.ml ├── histo.ml ├── permut.ml ├── vector_flat.ml ├── matrix_complex_flat.mli ├── interp.ml ├── monte.mli ├── wavelet.ml ├── rng.ml ├── rng.mli ├── mlgsl_vector.h ├── mlgsl_complex.c ├── eigen.mli ├── mlgsl_vector_impl.h ├── fft.mli ├── error.mli ├── vector_complex.ml └── mlgsl_matrix_impl.h ├── .ocamlformat ├── examples ├── Makefile ├── qrng_ex.ml ├── combi_ex.ml ├── multifit_data_ex.ml ├── dune ├── const_ex.ml ├── linalg_ex.ml ├── cheb_ex.ml ├── integration_ex.ml ├── fft_hc.ml ├── fft_c.ml ├── blas_speed_test.ml ├── fft_c2.ml ├── rng_ex.ml ├── deriv_ex.ml ├── siman_ex.ml ├── histo_ex.ml ├── permut_ex.ml ├── blas_ex.ml ├── fit_ex.ml ├── interp_ex.ml ├── wavelet_ex.ml ├── min_ex.ml ├── stats_ex.ml ├── eigen_ex.ml ├── sum_ex.ml ├── bspline_ex.ml ├── multifit_ex.ml ├── monte_ex.ml ├── root_ex.ml ├── multiroot_ex.ml └── multimin_ex.ml ├── dune ├── Makefile ├── TODO.md ├── .editorconfig ├── .github ├── dependabot.yml └── workflows │ └── main.yml ├── dune-project ├── NOTES.md └── gsl.opam /.clang-format: -------------------------------------------------------------------------------- 1 | BasedOnStyle: LLVM 2 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | *.ml linguist-language=OCaml 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | lib/compile_commands\.json 3 | -------------------------------------------------------------------------------- /.markdownlint.json: -------------------------------------------------------------------------------- 1 | { 2 | "no-duplicate-heading": { 3 | "siblings_only": true 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix_double.c: -------------------------------------------------------------------------------- 1 | 2 | #include "mlgsl_matrix_double.h" 3 | 4 | #include "mlgsl_matrix_impl.h" 5 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix_float.c: -------------------------------------------------------------------------------- 1 | 2 | #include "mlgsl_matrix_float.h" 3 | 4 | #include "mlgsl_matrix_impl.h" 5 | -------------------------------------------------------------------------------- /lib/mlgsl_vector_double.c: -------------------------------------------------------------------------------- 1 | 2 | #include "mlgsl_vector_double.h" 3 | 4 | #include "mlgsl_vector_impl.h" 5 | -------------------------------------------------------------------------------- /lib/mlgsl_vector_float.c: -------------------------------------------------------------------------------- 1 | 2 | #include "mlgsl_vector_float.h" 3 | 4 | #include "mlgsl_vector_impl.h" 5 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix_complex.c: -------------------------------------------------------------------------------- 1 | 2 | #include "mlgsl_matrix_complex.h" 3 | 4 | #include "mlgsl_matrix_impl.h" 5 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix_complex_float.c: -------------------------------------------------------------------------------- 1 | 2 | #include "mlgsl_matrix_complex_float.h" 3 | 4 | #include "mlgsl_matrix_impl.h" 5 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.28.1 2 | profile = conventional 3 | 4 | # Default overrides 5 | wrap-comments = true 6 | parse-docstrings = true 7 | -------------------------------------------------------------------------------- /lib/config/Makefile: -------------------------------------------------------------------------------- 1 | TARGETS = discover.bc do_cdf.bc do_const.bc 2 | 3 | .PHONY: all clean 4 | 5 | all: 6 | @dune build $(TARGETS) 7 | 8 | clean: 9 | @dune clean 10 | -------------------------------------------------------------------------------- /lib/mlgsl_vector_double.h: -------------------------------------------------------------------------------- 1 | 2 | #define BASE_TYPE double 3 | 4 | #define CONV_FLAT 5 | 6 | #define TYPE(t) t 7 | #define FUNCTION(a, b) a##_##b 8 | 9 | #include "mlgsl_vector.h" 10 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | EXAMPLES = $(wildcard *.ml) 2 | TARGETS = $(patsubst %.ml, %.bc, $(EXAMPLES)) 3 | 4 | .PHONY: all clean 5 | 6 | all: 7 | @dune build $(TARGETS) 8 | 9 | clean: 10 | @dune clean 11 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags 4 | (:standard -w -9 -principal)) 5 | (c_flags 6 | (:standard -Wall -pedantic -Wextra -Wunused))) 7 | (release 8 | (ocamlopt_flags 9 | (:standard -O3)))) 10 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean doc 2 | 3 | all: 4 | @dune build @install 5 | @make -C lib compile_commands.json 6 | 7 | clean: 8 | @dune clean 9 | @make -C lib clean-compile-commands 10 | 11 | doc: 12 | @dune build @doc 13 | -------------------------------------------------------------------------------- /examples/qrng_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let _ = 4 | let qrng = Qrng.make Qrng.SOBOL 2 in 5 | let tmp = Array.make 2 0. in 6 | for _i = 0 to 1023 do 7 | Qrng.get qrng tmp; 8 | Printf.printf "%.5f %.5f\n" tmp.(0) tmp.(1) 9 | done 10 | -------------------------------------------------------------------------------- /lib/mlgsl_vector_float.h: -------------------------------------------------------------------------------- 1 | #include "wrappers.h" 2 | 3 | #define BASE_TYPE float 4 | 5 | #undef CONV_FLAT 6 | 7 | #define TYPE(t) CONCAT2(t, BASE_TYPE) 8 | #define FUNCTION(a, b) CONCAT3(a, BASE_TYPE, b) 9 | 10 | #include "mlgsl_vector.h" 11 | -------------------------------------------------------------------------------- /lib/mlgsl_vector_complex_float.h: -------------------------------------------------------------------------------- 1 | 2 | #include "wrappers.h" 3 | 4 | #define BASE_TYPE complex_float 5 | 6 | #undef CONV_FLAT 7 | 8 | #define TYPE(t) CONCAT2(t, BASE_TYPE) 9 | #define FUNCTION(a, b) CONCAT3(a, BASE_TYPE, b) 10 | 11 | #include "mlgsl_vector.h" 12 | -------------------------------------------------------------------------------- /lib/version.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2014- - Markus Mottl *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | let version = "%%VERSION_NUM%%" 7 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix_double.h: -------------------------------------------------------------------------------- 1 | 2 | #define BASE_TYPE double 3 | 4 | #define CONV_FLAT 5 | 6 | #define TYPE(t) t 7 | #define _DECLARE_BASE_TYPE(v) double conv_##v 8 | #define _CONVERT_BASE_TYPE(v) conv_##v = Double_val(v) 9 | #define FUNCTION(a, b) a##_##b 10 | 11 | #include "mlgsl_matrix.h" 12 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | # TODO 2 | 3 | ## Remaining 4 | 5 | - Custom blocks? 6 | 7 | - 2D histograms 8 | - Complex and double matrices & vectors with a type param? 9 | - Finish special functions 10 | - Remaining modules 11 | - Polymorphic variants for FFT? 12 | 13 | ## Check 14 | 15 | - Complex matrices 16 | - BLAS functions 17 | -------------------------------------------------------------------------------- /lib/mlgsl_rng.h: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | #include 7 | 8 | #define Rng_val(v) ((gsl_rng *)(Field(v, 0))) 9 | -------------------------------------------------------------------------------- /examples/combi_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let () = Error.init () 4 | 5 | let print_arr arr = 6 | Array.iter (fun i -> Printf.printf "% 4d " i) arr; 7 | print_newline () 8 | 9 | let () = 10 | let c = Combi.make 4 2 in 11 | for _i = 1 to int_of_float (Sf.choose 4 2) do 12 | print_arr (Combi.to_array c); 13 | Combi.next c 14 | done 15 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix_float.h: -------------------------------------------------------------------------------- 1 | 2 | #include "wrappers.h" 3 | 4 | #define BASE_TYPE float 5 | 6 | #undef CONV_FLAT 7 | 8 | #define TYPE(t) CONCAT2(t, BASE_TYPE) 9 | #define _DECLARE_BASE_TYPE(v) double conv_##v 10 | #define _CONVERT_BASE_TYPE(v) conv_##v = Double_val(v) 11 | #define FUNCTION(a, b) CONCAT3(a, BASE_TYPE, b) 12 | 13 | #include "mlgsl_matrix.h" 14 | -------------------------------------------------------------------------------- /lib/Makefile: -------------------------------------------------------------------------------- 1 | TARGETS = gsl.cma libgsl_stubs.a 2 | 3 | .PHONY: all clean clean-compile-commands 4 | 5 | all: compile_commands.json 6 | @dune build $(TARGETS) 7 | 8 | clean: clean-compile-commands 9 | @dune clean 10 | 11 | compile_commands.json: config/dune config/discover.ml $(wildcard *.c *.h) 12 | @dune rules | dune-compiledb 13 | 14 | clean-compile-commands: 15 | @rm -f compile_commands.json 16 | -------------------------------------------------------------------------------- /examples/multifit_data_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let _ = 4 | Error.init (); 5 | Rng.env_setup () 6 | 7 | let rng = Rng.make (Rng.default ()) 8 | 9 | let _ = 10 | let x = ref 0.1 in 11 | while !x < 2. do 12 | let y0 = exp !x in 13 | let sigma = 0.1 *. y0 in 14 | let dy = Randist.gaussian rng ~sigma in 15 | Printf.printf "%.1f %g %g\n" !x (y0 +. dy) sigma; 16 | x := !x +. 0.1 17 | done 18 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names blas_ex blas_speed_test bspline_ex cheb_ex combi_ex const_ex deriv_ex 3 | eigen_ex fft_c fft_c2 fft_hc fit_ex histo_ex integration_ex interp_ex 4 | linalg_ex min_ex monte_ex multifit_data_ex multifit_ex multifit_nlin_ex 5 | multimin_ex multiroot_ex odeiv_ex permut_ex qrng_ex rng_ex root_ex 6 | siman_ex siman_tsp_ex stats_ex sum_ex wavelet_ex) 7 | (libraries gsl unix) 8 | (modes byte exe)) 9 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig: https://EditorConfig.org 2 | 3 | # Top-most EditorConfig file 4 | root = true 5 | 6 | # Default settings for all files 7 | [*] 8 | charset = utf-8 9 | end_of_line = lf 10 | insert_final_newline = true 11 | trim_trailing_whitespace = true 12 | indent_style = space 13 | indent_size = 2 14 | max_line_length = 80 15 | 16 | # Makefile 17 | [Makefile] 18 | # Makefiles require tabs instead of spaces 19 | indent_style = tab 20 | -------------------------------------------------------------------------------- /examples/const_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let () = 4 | let au = Const.MKSA.astronomical_unit in 5 | let c = Const.MKSA.speed_of_light in 6 | let min = Const.MKSA.minute in 7 | 8 | let r_earth = 1.00 *. au in 9 | let r_mars = 1.52 *. au in 10 | 11 | Printf.printf "light travel time from Earth to Mars:\n"; 12 | Printf.printf "minimum = %.1f minutes\n" ((r_mars -. r_earth) /. c /. min); 13 | Printf.printf "maximum = %.1f minutes\n" ((r_mars +. r_earth) /. c /. min) 14 | -------------------------------------------------------------------------------- /examples/linalg_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let mA = 4 | [| 5 | 0.18; 0.60; 0.57; 0.96; 6 | 0.41; 0.24; 0.99; 0.58; 7 | 0.14; 0.30; 0.97; 0.66; 8 | 0.51; 0.13; 0.19; 0.85; 9 | |] 10 | [@ocamlformat "disable"] 11 | 12 | let vB = [| 1.0; 2.0; 3.0; 4.0 |] 13 | 14 | let test () = 15 | let x = Linalg.solve_LU ~protect:true (`A (mA, 4, 4)) (`A vB) in 16 | Printf.printf "x = \n"; 17 | Array.iter (fun v -> Printf.printf " %g\n" v) x 18 | 19 | let () = test () 20 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix_complex_float.h: -------------------------------------------------------------------------------- 1 | 2 | #include "wrappers.h" 3 | 4 | #define BASE_TYPE complex_float 5 | 6 | #undef CONV_FLAT 7 | 8 | #define TYPE(t) CONCAT2(t, BASE_TYPE) 9 | #define _DECLARE_BASE_TYPE(v) gsl_complex_float conv_##v 10 | #define _CONVERT_BASE_TYPE(v) \ 11 | GSL_SET_COMPLEX(&conv_##v, Double_field(v, 0), Double_field(v, 1)) 12 | #define FUNCTION(a, b) CONCAT3(a, BASE_TYPE, b) 13 | 14 | #include "mlgsl_matrix.h" 15 | -------------------------------------------------------------------------------- /lib/misc.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | let maybe_or_else o def = match o with None -> def | Some v -> v 7 | let may vo f = match vo with None -> () | Some v -> f v 8 | let may_apply fo v = match fo with None -> () | Some f -> f v 9 | let is = function None -> false | Some _ -> true 10 | -------------------------------------------------------------------------------- /lib/combi.mli: -------------------------------------------------------------------------------- 1 | open Bigarray 2 | 3 | type t = private { 4 | n : int; 5 | k : int; 6 | data : (int, int_elt, c_layout) Bigarray.Array1.t; 7 | } 8 | 9 | external _init_first : t -> unit = "ml_gsl_combination_init_first" 10 | external _init_last : t -> unit = "ml_gsl_combination_init_last" 11 | val make : int -> int -> t 12 | val to_array : t -> int array 13 | external prev : t -> unit = "ml_gsl_combination_prev" 14 | external next : t -> unit = "ml_gsl_combination_next" 15 | val valid : t -> bool 16 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | # To get started with Dependabot version updates, you'll need to specify which 2 | # package ecosystems to update and where the package manifests are located. 3 | # Please see the documentation for all configuration options: 4 | # https://docs.github.com/code-security/dependabot/dependabot-version-updates/configuration-options-for-the-dependabot.yml-file 5 | 6 | version: 2 7 | updates: 8 | - package-ecosystem: github-actions 9 | directory: "/" # Location of package manifests 10 | schedule: 11 | interval: "weekly" 12 | -------------------------------------------------------------------------------- /lib/config/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name do_common) 3 | (modules do_common)) 4 | 5 | (executable 6 | (name discover) 7 | (modules discover) 8 | (libraries dune.configurator) 9 | (modes byte exe)) 10 | 11 | (executable 12 | (name do_cdf) 13 | (modules do_cdf) 14 | (libraries do_common str) 15 | (modes byte exe)) 16 | 17 | (executable 18 | (name do_const) 19 | (modules do_const) 20 | (libraries do_common str) 21 | (modes byte exe)) 22 | 23 | (executable 24 | (name do_sf) 25 | (modules do_sf) 26 | (libraries do_common str) 27 | (modes byte exe)) 28 | -------------------------------------------------------------------------------- /lib/mlgsl_permut.h: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #define GSL_PERMUT_OF_BIGARRAY(arr) \ 8 | struct caml_ba_array *bigarr_##arr = Caml_ba_array_val(arr); \ 9 | gsl_permutation perm_##arr = {/*.size =*/bigarr_##arr->dim[0], \ 10 | /*.data =*/bigarr_##arr->data} 11 | -------------------------------------------------------------------------------- /examples/cheb_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let f x = if x < 0.5 then 0.25 else 0.75 4 | 5 | let test n = 6 | let cs = Cheb.make 40 in 7 | Cheb.init cs f ~a:0. ~b:1.; 8 | (let coefs = Cheb.coefs cs in 9 | Printf.printf "coefs = ["; 10 | for i = 0 to 40 do 11 | Printf.printf " %f;" coefs.(i) 12 | done; 13 | Printf.printf " ]\n"); 14 | for i = 0 to pred n do 15 | let x = float i /. float n in 16 | let r10 = Cheb.eval cs ~order:10 x in 17 | let r40 = Cheb.eval cs x in 18 | Printf.printf "%g %g %g %g\n" x (f x) r10 r40 19 | done 20 | 21 | let _ = 22 | Error.init (); 23 | test 1000 24 | -------------------------------------------------------------------------------- /lib/deriv.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (* C code in mlgsl_deriv.c *) 6 | 7 | let () = Error.init () 8 | 9 | external central : f:(float -> float) -> x:float -> h:float -> Fun.result 10 | = "ml_gsl_deriv_central" 11 | 12 | external forward : f:(float -> float) -> x:float -> h:float -> Fun.result 13 | = "ml_gsl_deriv_forward" 14 | 15 | external backward : f:(float -> float) -> x:float -> h:float -> Fun.result 16 | = "ml_gsl_deriv_backward" 17 | -------------------------------------------------------------------------------- /lib/cheb.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Chebyshev Approximations *) 6 | 7 | type t 8 | 9 | val make : int -> t 10 | external order : t -> int = "ml_gsl_cheb_order" 11 | external coefs : t -> float array = "ml_gsl_cheb_coefs" 12 | 13 | external init : t -> Fun.gsl_fun -> a:float -> b:float -> unit 14 | = "ml_gsl_cheb_init" 15 | 16 | val eval : t -> ?order:int -> float -> float 17 | val eval_err : t -> ?order:int -> float -> Fun.result 18 | val deriv : t -> t 19 | val integ : t -> t 20 | -------------------------------------------------------------------------------- /lib/mlgsl_math.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #include "wrappers.h" 8 | #include 9 | 10 | ML1(gsl_log1p, Double_val, caml_copy_double) 11 | ML1(gsl_expm1, Double_val, caml_copy_double) 12 | ML2(gsl_hypot, Double_val, Double_val, caml_copy_double) 13 | ML1(gsl_acosh, Double_val, caml_copy_double) 14 | ML1(gsl_asinh, Double_val, caml_copy_double) 15 | ML1(gsl_atanh, Double_val, caml_copy_double) 16 | 17 | ML3(gsl_fcmp, Double_val, Double_val, Double_val, Val_int) 18 | -------------------------------------------------------------------------------- /examples/integration_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let f alpha x = 4 | Gc.major (); 5 | log (alpha *. x) /. sqrt x 6 | 7 | let compute f expected = 8 | let ws = Integration.make_ws 1000 in 9 | let gslfun = f in 10 | let { Fun.res; Fun.err } = 11 | Integration.qags gslfun ~a:0. ~b:1. ~epsabs:0. ~epsrel:1e-7 ws 12 | in 13 | Printf.printf "result = % .18f\n" res; 14 | Printf.printf "exact result = % .18f\n" expected; 15 | Printf.printf "estimated error = % .18f\n" err; 16 | Printf.printf "actual error = % .18f\n" (res -. expected); 17 | Printf.printf "intervals = %d\n" (Integration.size ws) 18 | 19 | let _ = 20 | Error.init (); 21 | compute (f 1.0) (-4.) 22 | -------------------------------------------------------------------------------- /lib/bspline.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2007 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Basis Splines *) 6 | 7 | type ws 8 | 9 | val make : k:int -> nbreak:int -> ws 10 | external ncoeffs : ws -> int = "ml_gsl_bspline_ncoeffs" [@@noalloc] 11 | 12 | open Vectmat 13 | 14 | external knots : [< vec ] -> ws -> unit = "ml_gsl_bspline_knots" 15 | 16 | external knots_uniform : a:float -> b:float -> ws -> unit 17 | = "ml_gsl_bspline_knots_uniform" 18 | 19 | external _eval : float -> [< vec ] -> ws -> unit = "ml_gsl_bspline_eval" 20 | val eval : ws -> float -> [> vec ] 21 | -------------------------------------------------------------------------------- /examples/fft_hc.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let print_data { Fft.data = a } = 4 | for i = 0 to Array.length a - 1 do 5 | Printf.printf "%d: %e\n" i a.(i) 6 | done; 7 | Printf.printf "\n" 8 | 9 | let init_data n = 10 | let data = Array.make n 0. in 11 | Array.fill data (n / 3) (n / 3) 1.; 12 | { Fft.layout = Fft.Real; data } 13 | 14 | let main n = 15 | let data = init_data n in 16 | print_data data; 17 | let ws = Fft.Real.make_workspace n and wt = Fft.Real.make_wavetable n in 18 | Fft.Real.transform data wt ws; 19 | Array.fill data.Fft.data 11 (n - 11) 0.; 20 | let wt_hc = Fft.Halfcomplex.make_wavetable n in 21 | Fft.Halfcomplex.inverse data wt_hc ws; 22 | print_data data 23 | 24 | let _ = main 100 25 | -------------------------------------------------------------------------------- /examples/fft_c.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let print_data a r = 4 | let n = Array.length a / 2 in 5 | for i = 0 to n - 1 do 6 | let c = Gsl_complex.get a i in 7 | Printf.printf "%d %e %e\n" i (c.Gsl_complex.re *. r) (c.Gsl_complex.im *. r) 8 | done; 9 | Printf.printf "\n" 10 | 11 | let init_data n = 12 | let data = Array.make (n * 2) 0. in 13 | let one = Complex.one in 14 | Gsl_complex.set data 0 one; 15 | for i = 1 to 10 do 16 | Gsl_complex.set data i one; 17 | Gsl_complex.set data (n - i) one 18 | done; 19 | data 20 | 21 | let main n = 22 | let data = init_data n in 23 | print_data data 1.; 24 | Fft.Complex.forward_rad2 data; 25 | print_data data (1. /. sqrt (float n)) 26 | 27 | let _ = main 128 28 | -------------------------------------------------------------------------------- /lib/qrng.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Quasi-Random Sequences *) 6 | 7 | type qrng_type = NIEDERREITER_2 | SOBOL 8 | type t 9 | 10 | val make : qrng_type -> int -> t 11 | external init : t -> unit = "ml_gsl_qrng_init" 12 | external get : t -> float array -> unit = "ml_gsl_qrng_get" 13 | external sample : t -> float array = "ml_gsl_qrng_sample" 14 | external name : t -> string = "ml_gsl_qrng_name" 15 | external dimension : t -> int = "ml_gsl_qrng_dimension" 16 | external memcpy : src:t -> dst:t -> unit = "ml_gsl_qrng_memcpy" 17 | external clone : t -> t = "ml_gsl_qrng_clone" 18 | -------------------------------------------------------------------------------- /examples/blas_speed_test.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let m = 1000 4 | let n = 100 5 | let p = 50 6 | let a = Array.init (m * n) float 7 | let b = Array.init (n * p) float 8 | let mA = Matrix.of_array a m n 9 | let mB = Matrix.of_array b n p 10 | let mC = Matrix.create ~init:0. m p 11 | let mfA = Matrix_flat.of_array a m n 12 | let mfB = Matrix_flat.of_array b n p 13 | let mfC = Matrix_flat.create ~init:0. m p 14 | 15 | open Blas 16 | 17 | let test f mA mB mC = 18 | let t1 = Unix.gettimeofday () in 19 | for _i = 1 to 10_000 do 20 | f ~ta:NoTrans ~tb:NoTrans ~alpha:1.0 ~a:mA ~b:mB ~beta:0. ~c:mC 21 | done; 22 | let t2 = Unix.gettimeofday () in 23 | Printf.printf "%.3f\n" (t2 -. t1) 24 | 25 | let () = 26 | test Blas.gemm mA mB mC; 27 | test Blas_flat.gemm mfA mfB mfC 28 | -------------------------------------------------------------------------------- /examples/fft_c2.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let print_data a = 4 | let n = Array.length a / 2 in 5 | for i = 0 to n - 1 do 6 | let c = Gsl_complex.get a i in 7 | Printf.printf "%d: %e %e\n" i c.Gsl_complex.re c.Gsl_complex.im 8 | done; 9 | Printf.printf "\n" 10 | 11 | let init_data n = 12 | let data = Array.make (n * 2) 0. in 13 | let one = Complex.one in 14 | Gsl_complex.set data 0 one; 15 | for i = 1 to 10 do 16 | Gsl_complex.set data i one; 17 | Gsl_complex.set data (n - i) one 18 | done; 19 | data 20 | 21 | let main n = 22 | let data = init_data n in 23 | print_data data; 24 | let wt = Fft.Complex.make_wavetable n and ws = Fft.Complex.make_workspace n in 25 | Fft.Complex.forward data wt ws; 26 | print_data data 27 | 28 | let _ = main 630 29 | -------------------------------------------------------------------------------- /examples/rng_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let _ = 4 | Error.init (); 5 | Rng.env_setup () 6 | 7 | let rng = Rng.make (Rng.default ()) 8 | 9 | let _ = 10 | Printf.printf "# generator type: %s\n" (Rng.name rng); 11 | Printf.printf "# seed = %nu\n" (Rng.default_seed ()); 12 | Printf.printf "# min value = %nu\n" (Rng.min rng); 13 | Printf.printf "# max value = %nu\n" (Rng.max rng); 14 | Printf.printf "# first value = %nu\n" (Rng.get rng) 15 | 16 | let sigma = 3. 17 | 18 | let _ = 19 | Printf.printf "# gaussian with sigma=%g\n" sigma; 20 | for _i = 1 to 10 do 21 | let x = Randist.gaussian rng ~sigma in 22 | Printf.printf "%+.7f\n" x 23 | done 24 | 25 | (* Local Variables: *) 26 | (* compile-command: "ocamlopt -o rng -I .. gsl.cmxa rng.ml" *) 27 | (* End: *) 28 | -------------------------------------------------------------------------------- /examples/deriv_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | open Fun 3 | 4 | let f x = 5 | (* raise Exit ;*) 6 | x ** 1.5 7 | 8 | let test () = 9 | let gslfun = f in 10 | Printf.printf "f(x) = x^(3/2)\n"; 11 | flush stdout; 12 | 13 | (let { res = result; err = abserr } = 14 | Deriv.central ~f:gslfun ~x:2.0 ~h:1e-3 15 | in 16 | Printf.printf "x = 2.0\n"; 17 | Printf.printf "f'(x) = %.10f +/- %.5f\n" result abserr; 18 | Printf.printf "exact = %.10f\n\n" (1.5 *. sqrt 2.0)); 19 | 20 | flush stdout; 21 | 22 | let { res = result; err = abserr } = Deriv.forward ~f:gslfun ~x:0.0 ~h:1e-3 in 23 | Printf.printf "x = 0.0\n"; 24 | Printf.printf "f'(x) = %.10f +/- %.5f\n" result abserr; 25 | Printf.printf "exact = %.10f\n\n" 0.0 26 | 27 | let _ = 28 | Error.init (); 29 | test () 30 | -------------------------------------------------------------------------------- /lib/combi.ml: -------------------------------------------------------------------------------- 1 | open Bigarray 2 | 3 | let () = Error.init () 4 | 5 | type t = { n : int; k : int; data : (int, int_elt, c_layout) Bigarray.Array1.t } 6 | 7 | external _init_first : t -> unit = "ml_gsl_combination_init_first" 8 | external _init_last : t -> unit = "ml_gsl_combination_init_last" 9 | 10 | let make n k = 11 | let c = { n; k; data = Array1.create int c_layout k } in 12 | _init_first c; 13 | c 14 | 15 | let to_array { data; _ } = 16 | let len = Array1.dim data in 17 | Array.init len (Array1.get data) 18 | 19 | external prev : t -> unit = "ml_gsl_combination_prev" 20 | external next : t -> unit = "ml_gsl_combination_next" 21 | external _valid : t -> bool = "ml_gsl_combination_valid" 22 | 23 | let valid c = try _valid c with Error.Gsl_exn (Error.FAILURE, _) -> false 24 | -------------------------------------------------------------------------------- /examples/siman_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let energ x = exp ~-.((x -. 1.) ** 2.) *. sin (8. *. x) 4 | 5 | let step rng x step_size = 6 | let u = Rng.uniform rng in 7 | x +. (2. *. (u -. 0.5) *. step_size) 8 | 9 | let print x = Printf.sprintf "%12g" x 10 | 11 | let _ = 12 | Error.init (); 13 | Rng.env_setup (); 14 | let rng = Rng.make (Rng.default ()) in 15 | 16 | let params = 17 | { 18 | Siman.iters_fixed_T = 10; 19 | Siman.step_size = 10.; 20 | Siman.k = 1.; 21 | Siman.t_initial = 2e-3; 22 | Siman.mu_t = 1.005; 23 | Siman.t_min = 2e-6; 24 | } 25 | in 26 | 27 | let res = 28 | Siman.solve rng 15.5 ~energ_func:energ ~step_func:step 29 | (* ~print_func:print *) 30 | params 31 | in 32 | Printf.printf "result = %12g\n" res 33 | -------------------------------------------------------------------------------- /lib/gsl_sort.mli: -------------------------------------------------------------------------------- 1 | (** Sorting *) 2 | 3 | val vector : Vector.vector -> unit 4 | val vector_index : Vector.vector -> Permut.permut 5 | val vector_smallest : int -> Vector.vector -> float array 6 | val vector_largest : int -> Vector.vector -> float array 7 | val vector_smallest_index : int -> Vector.vector -> Permut.permut 8 | val vector_largest_index : int -> Vector.vector -> Permut.permut 9 | val vector_flat : Vector_flat.vector -> unit 10 | val vector_flat_index : Vector_flat.vector -> Permut.permut 11 | val vector_flat_smallest : int -> Vector_flat.vector -> float array 12 | val vector_flat_largest : int -> Vector_flat.vector -> float array 13 | val vector_flat_smallest_index : int -> Vector_flat.vector -> Permut.permut 14 | val vector_flat_largest_index : int -> Vector_flat.vector -> Permut.permut 15 | -------------------------------------------------------------------------------- /lib/min.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** One dimensional Minimization *) 6 | 7 | type kind = GOLDENSECTION | BRENT 8 | type t 9 | 10 | val make : kind -> Fun.gsl_fun -> min:float -> lo:float -> up:float -> t 11 | external name : t -> string = "ml_gsl_min_fminimizer_name" 12 | external iterate : t -> unit = "ml_gsl_min_fminimizer_iterate" 13 | external minimum : t -> float = "ml_gsl_min_fminimizer_x_minimum" 14 | external interval : t -> float * float = "ml_gsl_min_fminimizer_x_interv" 15 | 16 | external test_interval : 17 | x_lo:float -> x_up:float -> epsabs:float -> epsrel:float -> bool 18 | = "ml_gsl_min_test_interval" 19 | -------------------------------------------------------------------------------- /lib/mlgsl_vector_complex.h: -------------------------------------------------------------------------------- 1 | 2 | #include "wrappers.h" 3 | 4 | #define BASE_TYPE complex 5 | 6 | #define CONV_FLAT 7 | 8 | #define TYPE(t) CONCAT2(t, BASE_TYPE) 9 | #define FUNCTION(a, b) CONCAT3(a, BASE_TYPE, b) 10 | 11 | #include "mlgsl_vector.h" 12 | 13 | #define _DECLARE_COMPLEX_VECTOR(a) gsl_vector_complex v_##a 14 | #define _DECLARE_COMPLEX_VECTOR2(a, b) \ 15 | _DECLARE_COMPLEX_VECTOR(a); \ 16 | _DECLARE_COMPLEX_VECTOR(b) 17 | 18 | #define _CONVERT_COMPLEX_VECTOR(a) mlgsl_vec_of_value_complex(&v_##a, a) 19 | #define _CONVERT_COMPLEX_VECTOR2(a, b) \ 20 | _CONVERT_COMPLEX_VECTOR(a); \ 21 | _CONVERT_COMPLEX_VECTOR(b) 22 | -------------------------------------------------------------------------------- /lib/config/do_common.ml: -------------------------------------------------------------------------------- 1 | let channel_with_file open_ch close_ch name ~f = 2 | let ch = open_ch name in 3 | Fun.protect ~finally:(fun () -> close_ch ch) (fun () -> f ch) 4 | 5 | module In_channel = struct 6 | let with_file file = channel_with_file open_in close_in file 7 | 8 | let rec iter_lines ic ~f = 9 | match input_line ic with 10 | | line -> 11 | f line; 12 | iter_lines ic ~f 13 | | exception End_of_file -> () 14 | end 15 | (* In_channel *) 16 | 17 | module Out_channel = struct 18 | let with_file file = channel_with_file open_out close_out file 19 | end 20 | (* Out_channel *) 21 | 22 | let gsl_include_dir = 23 | let gsl_include = 24 | let ic = open_in "gsl_include.sexp" in 25 | Fun.protect ~finally:(fun () -> close_in ic) (fun () -> input_line ic) 26 | in 27 | Filename.concat gsl_include "gsl" 28 | -------------------------------------------------------------------------------- /examples/histo_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let pprint_histo { Histo.n; Histo.range = r; Histo.bin = b } = 4 | for i = 0 to pred n do 5 | Printf.printf "%g %g %g\n" r.(i) r.(succ i) b.(i) 6 | done 7 | 8 | let main xmin xmax n = 9 | let h = Histo.make n in 10 | Histo.set_ranges_uniform h ~xmin ~xmax; 11 | 12 | (try 13 | while true do 14 | Scanf.scanf "%g" (fun x -> Histo.accumulate h x) 15 | done 16 | with End_of_file -> ()); 17 | 18 | pprint_histo h 19 | 20 | let _ = 21 | if Array.length Sys.argv <> 4 then ( 22 | Printf.printf "Usage: gsl-histogram xmin xmax n\n"; 23 | Printf.printf 24 | "Computes a histogram of the data on stdin using n bins from xmin to xmax\n"; 25 | exit 1); 26 | main 27 | (float_of_string Sys.argv.(1)) 28 | (float_of_string Sys.argv.(2)) 29 | (int_of_string Sys.argv.(3)) 30 | -------------------------------------------------------------------------------- /lib/multifit.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Multi-parameter Least-Squares Fitting *) 6 | 7 | open Vectmat 8 | 9 | type ws 10 | 11 | val make : n:int -> p:int -> ws 12 | 13 | external _linear : 14 | ?weight:vec -> x:mat -> y:vec -> c:vec -> cov:mat -> ws -> float 15 | = "ml_gsl_multifit_linear_bc" "ml_gsl_multifit_linear" 16 | 17 | val linear : ?weight:vec -> mat -> vec -> Vector.vector * Matrix.matrix * float 18 | 19 | external linear_est : x:vec -> c:vec -> cov:mat -> Fun.result 20 | = "ml_gsl_multifit_linear_est" 21 | 22 | val fit_poly : 23 | ?weight:float array -> 24 | x:float array -> 25 | y:float array -> 26 | int -> 27 | float array * float array array * float 28 | -------------------------------------------------------------------------------- /lib/sum.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Series Acceleration *) 6 | 7 | type ws 8 | 9 | val make : int -> ws 10 | external accel : float array -> ws -> Fun.result = "ml_gsl_sum_levin_u_accel" 11 | 12 | type ws_info = { size : int; terms_used : int; sum_plain : float } 13 | 14 | external get_info : ws -> ws_info = "ml_gsl_sum_levin_u_getinfo" 15 | 16 | module Trunc : sig 17 | type ws 18 | 19 | val make : int -> ws 20 | 21 | external accel : float array -> ws -> Fun.result 22 | = "ml_gsl_sum_levin_utrunc_accel" 23 | 24 | type ws_info = { size : int; terms_used : int; sum_plain : float } 25 | 26 | external get_info : ws -> ws_info = "ml_gsl_sum_levin_utrunc_getinfo" 27 | end 28 | -------------------------------------------------------------------------------- /examples/permut_ex.ml: -------------------------------------------------------------------------------- 1 | open Bigarray 2 | open Gsl 3 | 4 | let _ = 5 | Error.init (); 6 | Random.self_init () 7 | 8 | let print_arr arr = 9 | Array.iter (fun i -> Printf.printf "% 4d " i) arr; 10 | print_newline () 11 | 12 | let print_barr arr = 13 | for i = 0 to pred (Array1.dim arr) do 14 | Printf.printf "% 4d " arr.{i} 15 | done; 16 | print_newline () 17 | 18 | let _ = 19 | let p = Permut.make 5 in 20 | Permut.next p; 21 | print_string "permut :"; 22 | print_arr (Permut.to_array p); 23 | let a = Array.init 5 (fun _ -> Random.int 10) in 24 | print_string "arr :"; 25 | print_arr a; 26 | Permut.permute p a; 27 | print_string "arr :"; 28 | print_arr a; 29 | 30 | let a1 = Array1.of_array int c_layout a in 31 | print_string "arr1 :"; 32 | print_barr a1; 33 | Permut.permute_barr p a1; 34 | print_string "arr1 :"; 35 | print_barr a1 36 | -------------------------------------------------------------------------------- /examples/blas_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let a = [| 0.11; 0.12; 0.13; 0.21; 0.22; 0.23 |] 4 | let b = [| 1011.; 1012.; 1021.; 1022.; 1031.; 1032. |] 5 | let mA = Matrix.of_array a 2 3 6 | let mB = Matrix.of_array b 3 2 7 | let mC = Matrix.create ~init:0. 2 2 8 | let mfA = Matrix_flat.of_array a 2 3 9 | let mfB = Matrix_flat.of_array b 3 2 10 | let mfC = Matrix_flat.create ~init:0. 2 2 11 | 12 | open Blas 13 | 14 | let _ = 15 | Blas.gemm ~ta:NoTrans ~tb:NoTrans ~alpha:1.0 ~a:mA ~b:mB ~beta:0. ~c:mC; 16 | Printf.printf "[ %g, %g\n" mC.{0, 0} mC.{0, 1}; 17 | Printf.printf " %g, %g ]\n" mC.{1, 0} mC.{1, 1}; 18 | 19 | print_newline (); 20 | 21 | Blas_flat.gemm ~ta:NoTrans ~tb:NoTrans ~alpha:1.0 ~a:mfA ~b:mfB ~beta:0. 22 | ~c:mfC; 23 | let mfC' = Matrix_flat.to_arrays mfC in 24 | Printf.printf "[ %g, %g\n" mfC'.(0).(0) mfC'.(0).(1); 25 | Printf.printf " %g, %g ]\n" mfC'.(1).(0) mfC'.(1).(1) 26 | -------------------------------------------------------------------------------- /lib/qrng.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type qrng_type = NIEDERREITER_2 | SOBOL 8 | type t 9 | 10 | external _alloc : qrng_type -> int -> t = "ml_gsl_qrng_alloc" 11 | external _free : t -> unit = "ml_gsl_qrng_free" 12 | external init : t -> unit = "ml_gsl_qrng_init" 13 | 14 | let make t d = 15 | let qrng = _alloc t d in 16 | Gc.finalise _free qrng; 17 | qrng 18 | 19 | external dimension : t -> int = "ml_gsl_qrng_dimension" 20 | external name : t -> string = "ml_gsl_qrng_name" 21 | external memcpy : src:t -> dst:t -> unit = "ml_gsl_qrng_memcpy" 22 | external clone : t -> t = "ml_gsl_qrng_clone" 23 | external get : t -> float array -> unit = "ml_gsl_qrng_get" 24 | external sample : t -> float array = "ml_gsl_qrng_sample" 25 | -------------------------------------------------------------------------------- /lib/fit.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type linear_fit_coeffs = { 8 | c0 : float; 9 | c1 : float; 10 | cov00 : float; 11 | cov01 : float; 12 | cov11 : float; 13 | sumsq : float; 14 | } 15 | 16 | external linear : 17 | ?weight:float array -> float array -> float array -> linear_fit_coeffs 18 | = "ml_gsl_fit_linear" 19 | 20 | external linear_est : float -> coeffs:linear_fit_coeffs -> Fun.result 21 | = "ml_gsl_fit_linear_est" 22 | 23 | type mul_fit_coeffs = { m_c1 : float; m_cov11 : float; m_sumsq : float } 24 | 25 | external mul : 26 | ?weight:float array -> float array -> float array -> mul_fit_coeffs 27 | = "ml_gsl_fit_mul" 28 | 29 | external mul_est : float -> coeffs:mul_fit_coeffs -> Fun.result 30 | = "ml_gsl_fit_mul_est" 31 | -------------------------------------------------------------------------------- /lib/fit.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Least-Squares Fitting *) 6 | 7 | type linear_fit_coeffs = { 8 | c0 : float; 9 | c1 : float; 10 | cov00 : float; 11 | cov01 : float; 12 | cov11 : float; 13 | sumsq : float; 14 | } 15 | 16 | external linear : 17 | ?weight:float array -> float array -> float array -> linear_fit_coeffs 18 | = "ml_gsl_fit_linear" 19 | 20 | external linear_est : float -> coeffs:linear_fit_coeffs -> Fun.result 21 | = "ml_gsl_fit_linear_est" 22 | 23 | type mul_fit_coeffs = { m_c1 : float; m_cov11 : float; m_sumsq : float } 24 | 25 | external mul : 26 | ?weight:float array -> float array -> float array -> mul_fit_coeffs 27 | = "ml_gsl_fit_mul" 28 | 29 | external mul_est : float -> coeffs:mul_fit_coeffs -> Fun.result 30 | = "ml_gsl_fit_mul_est" 31 | -------------------------------------------------------------------------------- /lib/bspline.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2007 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type ws 8 | 9 | external _alloc : k:int -> nbreak:int -> ws = "ml_gsl_bspline_alloc" 10 | external _free : ws -> unit = "ml_gsl_bspline_free" 11 | 12 | let make ~k ~nbreak = 13 | let ws = _alloc ~k ~nbreak in 14 | Gc.finalise _free ws; 15 | ws 16 | 17 | external ncoeffs : ws -> int = "ml_gsl_bspline_ncoeffs" [@@noalloc] 18 | 19 | open Vectmat 20 | 21 | external knots : [< vec ] -> ws -> unit = "ml_gsl_bspline_knots" 22 | 23 | external knots_uniform : a:float -> b:float -> ws -> unit 24 | = "ml_gsl_bspline_knots_uniform" 25 | 26 | external _eval : float -> [< vec ] -> ws -> unit = "ml_gsl_bspline_eval" 27 | 28 | let eval ws x = 29 | let n = ncoeffs ws in 30 | let v = `V (Vector.create n) in 31 | _eval x v ws; 32 | v 33 | -------------------------------------------------------------------------------- /examples/fit_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let x = [| 1970.; 1980.; 1990.; 2000. |] 4 | let y = [| 12.; 11.; 14.; 13. |] 5 | let w = [| 0.1; 0.2; 0.3; 0.4 |] 6 | 7 | open Fun 8 | open Fit 9 | 10 | let _ = 11 | let coeffs = Fit.linear ~weight:w x y in 12 | Printf.printf "#best fit: Y = %g + %G X\n" coeffs.c0 coeffs.c1; 13 | Printf.printf "# covariance matrix:\n"; 14 | Printf.printf "# [ %g, %g\n# %g, %g]\n" coeffs.cov00 coeffs.cov01 15 | coeffs.cov01 coeffs.cov11; 16 | Printf.printf "# chisq = %g\n" coeffs.sumsq; 17 | for i = 0 to 3 do 18 | Printf.printf "data: %g %g %g\n" x.(i) y.(i) (1. /. sqrt w.(i)) 19 | done; 20 | Printf.printf "\n"; 21 | 22 | for i = -30 to 129 do 23 | let xf = x.(0) +. (float i /. 100. *. (x.(3) -. x.(0))) in 24 | let { res = yf; err = yf_err } = Fit.linear_est xf ~coeffs in 25 | Printf.printf "fit: %g %g\n" xf yf; 26 | Printf.printf "hi : %g %g\n" xf (yf +. yf_err); 27 | Printf.printf "lo : %g %g\n" xf (yf -. yf_err) 28 | done 29 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | 3 | (name gsl) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github mmottl/gsl-ocaml)) 9 | 10 | (license "GPL-3.0-or-later") 11 | 12 | (homepage "https://mmottl.github.io/gsl-ocaml") 13 | 14 | (documentation "https://mmottl.github.io/gsl-ocaml/api") 15 | 16 | (maintainers "Markus Mottl ") 17 | 18 | (authors "Olivier Andrieu " 19 | "Markus Mottl ") 20 | 21 | (package 22 | (name gsl) 23 | (synopsis "GSL - Bindings to the GNU Scientific Library") 24 | (description 25 | "gsl-ocaml interfaces the GSL (GNU Scientific Library), providing many of the\nmost frequently used functions for scientific computation including algorithms\nfor optimization, differential equations, statistics, random number generation,\nlinear algebra, etc.") 26 | (depends 27 | (ocaml 28 | (>= 4.12)) 29 | dune-compiledb 30 | dune-configurator 31 | (conf-gsl :build) 32 | (conf-pkg-config :build))) 33 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix_complex.h: -------------------------------------------------------------------------------- 1 | 2 | #include "wrappers.h" 3 | 4 | #define BASE_TYPE complex 5 | 6 | #define CONV_FLAT 7 | 8 | #define TYPE(t) CONCAT2(t, BASE_TYPE) 9 | #define _DECLARE_BASE_TYPE(v) gsl_complex conv_##v 10 | #define _CONVERT_BASE_TYPE(v) \ 11 | GSL_SET_COMPLEX(&conv_##v, Double_field(v, 0), Double_field(v, 1)) 12 | #define FUNCTION(a, b) CONCAT3(a, BASE_TYPE, b) 13 | 14 | #include "mlgsl_matrix.h" 15 | 16 | #define _DECLARE_COMPLEX_MATRIX(a) gsl_matrix_complex m_##a 17 | #define _DECLARE_COMPLEX_MATRIX2(a, b) \ 18 | _DECLARE_COMPLEX_MATRIX(a); \ 19 | _DECLARE_COMPLEX_MATRIX(b) 20 | 21 | #define _CONVERT_COMPLEX_MATRIX(a) mlgsl_mat_of_value_complex(&m_##a, a) 22 | #define _CONVERT_COMPLEX_MATRIX2(a, b) \ 23 | _CONVERT_COMPLEX_MATRIX(a); \ 24 | _CONVERT_COMPLEX_MATRIX(b) 25 | -------------------------------------------------------------------------------- /lib/mlgsl_blas.h: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | static inline CBLAS_ORDER_t CBLAS_ORDER_val(value v) { 6 | CBLAS_ORDER_t conv[] = {CblasRowMajor, CblasColMajor}; 7 | return conv[Int_val(v)]; 8 | } 9 | 10 | static inline CBLAS_TRANSPOSE_t CBLAS_TRANS_val(value v) { 11 | CBLAS_TRANSPOSE_t conv[] = {CblasNoTrans, CblasTrans, CblasConjTrans}; 12 | return conv[Int_val(v)]; 13 | } 14 | 15 | static inline CBLAS_UPLO_t CBLAS_UPLO_val(value v) { 16 | CBLAS_UPLO_t conv[] = {CblasUpper, CblasLower}; 17 | return conv[Int_val(v)]; 18 | } 19 | 20 | static inline CBLAS_DIAG_t CBLAS_DIAG_val(value v) { 21 | CBLAS_DIAG_t conv[] = {CblasNonUnit, CblasUnit}; 22 | return conv[Int_val(v)]; 23 | } 24 | 25 | static inline CBLAS_SIDE_t CBLAS_SIDE_val(value v) { 26 | CBLAS_SIDE_t conv[] = {CblasLeft, CblasRight}; 27 | return conv[Int_val(v)]; 28 | } 29 | -------------------------------------------------------------------------------- /examples/interp_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let _ = Error.init () 4 | let check_return_status = function Unix.WEXITED 0 -> true | _ -> false 5 | 6 | open Interp 7 | 8 | let print_data oc i = 9 | Printf.fprintf oc "#m=0,S=2\n"; 10 | for j = 0 to 9 do 11 | Printf.fprintf oc "%g %g\n" i.xa.(j) i.ya.(j) 12 | done 13 | 14 | let print_interp oc i = 15 | Printf.fprintf oc "#m=1,S=0\n"; 16 | let xi = ref i.xa.(0) in 17 | let yi = ref 0. in 18 | while !xi < i.xa.(9) do 19 | yi := Interp.eval i !xi; 20 | Printf.fprintf oc "%g %g\n" !xi !yi; 21 | xi := !xi +. 0.1 22 | done 23 | 24 | let x = Array.init 10 (fun i -> float i +. (0.5 *. sin (float i))) 25 | let y = Array.init 10 (fun i -> float i +. cos (float (i * i))) 26 | 27 | let _ = 28 | let i = Interp.make_interp Interp.CSPLINE x y in 29 | let oc = Unix.open_process_out "graph -T X" in 30 | print_data oc i; 31 | print_interp oc i; 32 | flush oc; 33 | if not (check_return_status (Unix.close_process_out oc)) then 34 | prerr_endline "Oops !" 35 | -------------------------------------------------------------------------------- /lib/siman.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Simulated Annealing *) 6 | 7 | (** NB: This module is not interfaced to GSL, it is implemented in OCaml. It is 8 | quite simple in fact, so rather than using it you may want to copy the code 9 | and tweak the algorithm in your own program. *) 10 | 11 | type params = { 12 | iters_fixed_T : int; (** The number of iterations at each temperature *) 13 | step_size : float; (** The maximum step size in the random walk *) 14 | k : float; (** parameter of the Boltzmann distribution *) 15 | t_initial : float; (** initial temperature *) 16 | mu_t : float; (** cooling factor *) 17 | t_min : float; (** minimum temperature *) 18 | } 19 | 20 | val solve : 21 | Rng.t -> 22 | 'a -> 23 | energ_func:('a -> float) -> 24 | step_func:(Rng.t -> 'a -> float -> 'a) -> 25 | ?print_func:('a -> unit) -> 26 | params -> 27 | 'a 28 | -------------------------------------------------------------------------------- /NOTES.md: -------------------------------------------------------------------------------- 1 | # Notes 2 | 3 | ## Complete 4 | 5 | - Fast Fourier Transforms 6 | - Random Number Generation 7 | - Random Number Distributions 8 | - Polynomials 9 | - Interpolation 10 | - Mathematical Functions 11 | - Least-Squares Fitting 12 | - One dimensional Root-Finding 13 | - One dimensional Minimization 14 | - Numerical Differentiation 15 | - Monte Carlo Integration 16 | - IEEE floating-point arithmetic 17 | - Numerical Integration 18 | - Quasi-Random Sequences 19 | - Chebyshev Approximations 20 | - Multidimensional Root-Finding 21 | - Multidimensional Minimization 22 | - Series Acceleration 23 | - Nonlinear Least-Squares Fitting 24 | - Simulated Annealing 25 | - Ordinary Differential Equations 26 | - Linear Algebra 27 | - Eigensystems 28 | - BLAS Support 29 | - Vectors and Matrices 30 | - Physical Constants 31 | - Statistics 32 | - Complex Numbers 33 | - Wavelet Transforms 34 | 35 | ## Partial 36 | 37 | - Special Functions 38 | - Permutations 39 | - Histograms 40 | - Sorting 41 | 42 | ## Not yet 43 | 44 | - Combinations 45 | - N-tuples 46 | - Discrete Hankel Transforms 47 | -------------------------------------------------------------------------------- /lib/min.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type kind = GOLDENSECTION | BRENT 8 | type t 9 | 10 | external _alloc : kind -> t = "ml_gsl_min_fminimizer_alloc" 11 | external _free : t -> unit = "ml_gsl_min_fminimizer_free" 12 | 13 | external _set : t -> Fun.gsl_fun -> min:float -> lo:float -> up:float -> unit 14 | = "ml_gsl_min_fminimizer_set" 15 | 16 | let make k f ~min ~lo ~up = 17 | let m = _alloc k in 18 | Gc.finalise _free m; 19 | _set m f ~min ~lo ~up; 20 | m 21 | 22 | external name : t -> string = "ml_gsl_min_fminimizer_name" 23 | external iterate : t -> unit = "ml_gsl_min_fminimizer_iterate" 24 | external minimum : t -> float = "ml_gsl_min_fminimizer_x_minimum" 25 | external interval : t -> float * float = "ml_gsl_min_fminimizer_x_interv" 26 | 27 | external test_interval : 28 | x_lo:float -> x_up:float -> epsabs:float -> epsrel:float -> bool 29 | = "ml_gsl_min_test_interval" 30 | -------------------------------------------------------------------------------- /lib/multifit_nlin.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Nonlinear Least-Squares Fitting *) 6 | 7 | open Fun 8 | open Vector 9 | 10 | type t 11 | type kind = LMSDER | LMDER 12 | 13 | val make : kind -> n:int -> p:int -> multi_fun_fdf -> vector -> t 14 | external name : t -> string = "ml_gsl_multifit_fdfsolver_name" 15 | external iterate : t -> unit = "ml_gsl_multifit_fdfsolver_iterate" 16 | external position : t -> vector -> unit = "ml_gsl_multifit_fdfsolver_position" 17 | 18 | external get_state : t -> ?x:vector -> ?f:vector -> ?dx:vector -> unit -> unit 19 | = "ml_gsl_multifit_fdfsolver_get_state" 20 | 21 | external test_delta : t -> epsabs:float -> epsrel:float -> bool 22 | = "ml_gsl_multifit_test_delta" 23 | 24 | external test_gradient : t -> Matrix.matrix -> epsabs:float -> vector -> bool 25 | = "ml_gsl_multifit_test_gradient" 26 | 27 | external covar : Matrix.matrix -> epsrel:float -> Matrix.matrix -> unit 28 | = "ml_gsl_multifit_covar" 29 | -------------------------------------------------------------------------------- /examples/wavelet_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let read_file init do_line finish f = 4 | let ic = open_in f in 5 | let acc = ref init in 6 | (try 7 | while true do 8 | let l = input_line ic in 9 | acc := do_line !acc l 10 | done 11 | with 12 | | End_of_file -> close_in ic 13 | | exn -> 14 | close_in ic; 15 | raise exn); 16 | finish !acc 17 | 18 | let read_data_file = 19 | read_file [] 20 | (fun acc l -> float_of_string l :: acc) 21 | (fun acc -> Array.of_list (List.rev acc)) 22 | 23 | let main f = 24 | let data = read_data_file f in 25 | let n = Array.length data in 26 | Printf.eprintf "read %d values\n%!" n; 27 | 28 | let w = Wavelet.make Wavelet.DAUBECHIES 4 in 29 | Wavelet.transform_forward w data; 30 | let high = 31 | Gsl_sort.vector_flat_largest_index 20 32 | (Vector_flat.view_array (Array.map abs_float data)) 33 | in 34 | let high_coeff = Array.make n 0. in 35 | for i = 0 to 20 - 1 do 36 | let j = high.{i} in 37 | high_coeff.(j) <- data.(j) 38 | done; 39 | Wavelet.transform_inverse w high_coeff; 40 | 41 | Array.iter (fun f -> Printf.printf "%g\n" f) high_coeff 42 | 43 | let () = main "ecg.dat" 44 | -------------------------------------------------------------------------------- /lib/fun.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type result = { res : float; err : float } 8 | type result_e10 = { res_e10 : float; err_e10 : float; e10 : int } 9 | type mode = DOUBLE | SIMPLE | APPROX 10 | 11 | external smash : result_e10 -> result = "ml_gsl_sf_result_smash_e" 12 | 13 | type gsl_fun = float -> float 14 | 15 | type gsl_fun_fdf = { 16 | f : float -> float; 17 | df : float -> float; 18 | fdf : float -> float * float; 19 | } 20 | 21 | type monte_fun = float array -> float 22 | 23 | open Vector 24 | 25 | type multi_fun = x:vector -> f:vector -> unit 26 | 27 | type multi_fun_fdf = { 28 | multi_f : x:vector -> f:vector -> unit; 29 | multi_df : x:vector -> j:Matrix.matrix -> unit; 30 | multi_fdf : x:vector -> f:vector -> j:Matrix.matrix -> unit; 31 | } 32 | 33 | type multim_fun = x:vector -> float 34 | 35 | type multim_fun_fdf = { 36 | multim_f : x:vector -> float; 37 | multim_df : x:vector -> g:vector -> unit; 38 | multim_fdf : x:vector -> g:vector -> float; 39 | } 40 | -------------------------------------------------------------------------------- /lib/mlgsl_deriv.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #include 8 | #include 9 | 10 | #include "mlgsl_fun.h" 11 | #include "wrappers.h" 12 | 13 | value ml_gsl_deriv_central(value f, value x, value h) { 14 | CAMLparam1(f); 15 | double result, abserr; 16 | GSLFUN_CLOSURE(gf, f); 17 | gsl_deriv_central(&gf, Double_val(x), Double_val(h), &result, &abserr); 18 | CAMLreturn(copy_two_double_arr(result, abserr)); 19 | } 20 | 21 | value ml_gsl_deriv_forward(value f, value x, value h) { 22 | CAMLparam1(f); 23 | double result, abserr; 24 | GSLFUN_CLOSURE(gf, f); 25 | gsl_deriv_forward(&gf, Double_val(x), Double_val(h), &result, &abserr); 26 | CAMLreturn(copy_two_double_arr(result, abserr)); 27 | } 28 | 29 | value ml_gsl_deriv_backward(value f, value x, value h) { 30 | CAMLparam1(f); 31 | double result, abserr; 32 | GSLFUN_CLOSURE(gf, f); 33 | gsl_deriv_backward(&gf, Double_val(x), Double_val(h), &result, &abserr); 34 | CAMLreturn(copy_two_double_arr(result, abserr)); 35 | } 36 | -------------------------------------------------------------------------------- /examples/min_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let f x = 4 | Gc.major (); 5 | cos x +. 1. 6 | 7 | let max_iter = 25 8 | 9 | let find_min s m_expected = 10 | Printf.printf "using %s method\n" (Min.name s); 11 | Printf.printf "%5s [%9s, %9s] %9s %10s %9s\n" "iter" "lower" "upper" "min" 12 | "err" "err(est)"; 13 | flush stdout; 14 | let rec proc i = function 15 | | true -> () 16 | | false when i > max_iter -> 17 | Printf.printf "Did not converge after %d iterations.\n" max_iter 18 | | _ -> 19 | let a, b = Min.interval s in 20 | let m = Min.minimum s in 21 | let status = 22 | Min.test_interval ~x_lo:a ~x_up:b ~epsabs:1e-3 ~epsrel:0. 23 | in 24 | if i = 3 then Gc.full_major (); 25 | if status then Printf.printf "Converged:\n"; 26 | Printf.printf "%5d [%.7f, %.7f] %.7f %+.7f %.7f\n" i a b m 27 | (m -. m_expected) (b -. a); 28 | flush stdout; 29 | Min.iterate s; 30 | proc (succ i) status 31 | in 32 | proc 0 false 33 | 34 | let _ = 35 | let gslfun = f in 36 | List.iter 37 | (fun k -> 38 | let s = Min.make k gslfun ~min:2. ~lo:0. ~up:6. in 39 | find_min s Math.pi; 40 | print_newline ()) 41 | [ Min.GOLDENSECTION; Min.BRENT ] 42 | -------------------------------------------------------------------------------- /lib/mlgsl_combi.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include 4 | #include 5 | #include 6 | 7 | static void combi_of_val(gsl_combination *c, value vc) { 8 | c->n = Int_val(Field(vc, 0)); 9 | c->k = Int_val(Field(vc, 1)); 10 | c->data = Caml_ba_data_val(Field(vc, 2)); 11 | } 12 | 13 | CAMLprim value ml_gsl_combination_init_first(value vc) { 14 | gsl_combination c; 15 | combi_of_val(&c, vc); 16 | gsl_combination_init_first(&c); 17 | return Val_unit; 18 | } 19 | 20 | CAMLprim value ml_gsl_combination_init_last(value vc) { 21 | gsl_combination c; 22 | combi_of_val(&c, vc); 23 | gsl_combination_init_last(&c); 24 | return Val_unit; 25 | } 26 | 27 | CAMLprim value ml_gsl_combination_valid(value vc) { 28 | int r; 29 | gsl_combination c; 30 | combi_of_val(&c, vc); 31 | r = gsl_combination_valid(&c); 32 | return Val_not(Val_bool(r)); 33 | } 34 | 35 | CAMLprim value ml_gsl_combination_next(value vc) { 36 | gsl_combination c; 37 | combi_of_val(&c, vc); 38 | gsl_combination_next(&c); 39 | return Val_unit; 40 | } 41 | 42 | CAMLprim value ml_gsl_combination_prev(value vc) { 43 | gsl_combination c; 44 | combi_of_val(&c, vc); 45 | gsl_combination_prev(&c); 46 | return Val_unit; 47 | } 48 | -------------------------------------------------------------------------------- /lib/sum.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type ws 8 | 9 | external _alloc : int -> ws = "ml_gsl_sum_levin_u_alloc" 10 | external _free : ws -> unit = "ml_gsl_sum_levin_u_free" 11 | 12 | let make size = 13 | let ws = _alloc size in 14 | Gc.finalise _free ws; 15 | ws 16 | 17 | external accel : float array -> ws -> Fun.result = "ml_gsl_sum_levin_u_accel" 18 | 19 | type ws_info = { size : int; terms_used : int; sum_plain : float } 20 | 21 | external get_info : ws -> ws_info = "ml_gsl_sum_levin_u_getinfo" 22 | 23 | module Trunc = struct 24 | type ws 25 | 26 | external _alloc : int -> ws = "ml_gsl_sum_levin_utrunc_alloc" 27 | external _free : ws -> unit = "ml_gsl_sum_levin_utrunc_free" 28 | 29 | let make size = 30 | let ws = _alloc size in 31 | Gc.finalise _free ws; 32 | ws 33 | 34 | external accel : float array -> ws -> Fun.result 35 | = "ml_gsl_sum_levin_utrunc_accel" 36 | 37 | type ws_info = { size : int; terms_used : int; sum_plain : float } 38 | 39 | external get_info : ws -> ws_info = "ml_gsl_sum_levin_utrunc_getinfo" 40 | end 41 | -------------------------------------------------------------------------------- /examples/stats_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let _ = 4 | let data = [| 17.2; 18.1; 16.5; 18.3; 12.6 |] in 5 | let mean = Stats.mean data in 6 | let variance = Stats.variance data in 7 | let largest = Stats.max data in 8 | let smallest = Stats.min data in 9 | Printf.printf "The dataset is %g, %g, %g, %g, %g\n" data.(0) data.(1) data.(2) 10 | data.(3) data.(4); 11 | Printf.printf "The sample mean is %g\n" mean; 12 | Printf.printf "The estimated variance is %g\n" variance; 13 | Printf.printf "The largest value is %g\n" largest; 14 | Printf.printf "The smallest value is %g\n" smallest 15 | 16 | let _ = 17 | let data = [| 17.2; 18.1; 16.5; 18.3; 12.6 |] in 18 | Printf.printf "Original dataset is %g, %g, %g, %g, %g\n" data.(0) data.(1) 19 | data.(2) data.(3) data.(4); 20 | Array.sort compare data; 21 | Printf.printf "Sorted dataset is %g, %g, %g, %g, %g\n" data.(0) data.(1) 22 | data.(2) data.(3) data.(4); 23 | let median = Stats.quantile_from_sorted_data data 0.5 in 24 | let upperq = Stats.quantile_from_sorted_data data 0.75 in 25 | let lowerq = Stats.quantile_from_sorted_data data 0.25 in 26 | Printf.printf "The median is %g\n" median; 27 | Printf.printf "The upper quartile is %g\n" upperq; 28 | Printf.printf "The lower quartile is %g\n" lowerq 29 | -------------------------------------------------------------------------------- /lib/mlgsl_bspline.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2007 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #include 8 | #include 9 | 10 | #include "wrappers.h" 11 | 12 | CAMLprim value ml_gsl_bspline_alloc(value k, value nbreak) { 13 | value r; 14 | gsl_bspline_workspace *w = gsl_bspline_alloc(Long_val(k), Long_val(nbreak)); 15 | Abstract_ptr(r, w); 16 | return r; 17 | } 18 | 19 | #define Bspline_val(v) ((gsl_bspline_workspace *)(Field((v), 0))) 20 | 21 | ML1(gsl_bspline_free, Bspline_val, Unit) 22 | ML1(gsl_bspline_ncoeffs, Bspline_val, Val_long) 23 | 24 | #include "mlgsl_vector_double.h" 25 | 26 | CAMLprim value ml_gsl_bspline_knots(value b, value w) { 27 | _DECLARE_VECTOR(b); 28 | _CONVERT_VECTOR(b); 29 | gsl_bspline_knots(&v_b, Bspline_val(w)); 30 | return Val_unit; 31 | } 32 | 33 | ML3(gsl_bspline_knots_uniform, Double_val, Double_val, Bspline_val, Unit) 34 | 35 | CAMLprim value ml_gsl_bspline_eval(value x, value B, value w) { 36 | _DECLARE_VECTOR(B); 37 | _CONVERT_VECTOR(B); 38 | gsl_bspline_eval(Double_val(x), &v_B, Bspline_val(w)); 39 | return Val_unit; 40 | } 41 | -------------------------------------------------------------------------------- /gsl.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "GSL - Bindings to the GNU Scientific Library" 4 | description: """ 5 | gsl-ocaml interfaces the GSL (GNU Scientific Library), providing many of the 6 | most frequently used functions for scientific computation including algorithms 7 | for optimization, differential equations, statistics, random number generation, 8 | linear algebra, etc.""" 9 | maintainer: ["Markus Mottl "] 10 | authors: [ 11 | "Olivier Andrieu " 12 | "Markus Mottl " 13 | ] 14 | license: "GPL-3.0-or-later" 15 | homepage: "https://mmottl.github.io/gsl-ocaml" 16 | doc: "https://mmottl.github.io/gsl-ocaml/api" 17 | bug-reports: "https://github.com/mmottl/gsl-ocaml/issues" 18 | depends: [ 19 | "dune" {>= "2.7"} 20 | "ocaml" {>= "4.12"} 21 | "dune-compiledb" 22 | "dune-configurator" 23 | "conf-gsl" {build} 24 | "conf-pkg-config" {build} 25 | "odoc" {with-doc} 26 | ] 27 | build: [ 28 | ["dune" "subst"] {dev} 29 | [ 30 | "dune" 31 | "build" 32 | "-p" 33 | name 34 | "-j" 35 | jobs 36 | "@install" 37 | "@runtest" {with-test} 38 | "@doc" {with-doc} 39 | ] 40 | ] 41 | dev-repo: "git+https://github.com/mmottl/gsl-ocaml.git" 42 | -------------------------------------------------------------------------------- /examples/eigen_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let data n = 4 | let d = Matrix.create n n in 5 | for i = 0 to pred n do 6 | for j = 0 to pred n do 7 | d.{i, j} <- 1. /. float (i + j + 1) 8 | done 9 | done; 10 | d 11 | 12 | let _ = 13 | Printf.printf "Real Symmetric Matrices\n"; 14 | let d = data 4 in 15 | let ((eval, evec) as eigen) = Eigen.symmv (`M d) in 16 | Eigen.symmv_sort eigen Eigen.ABS_ASC; 17 | for i = 0 to 3 do 18 | Printf.printf "eigenvalue = %g\n" eval.{i}; 19 | Printf.printf "eigenvector = \n"; 20 | for j = 0 to 3 do 21 | Printf.printf "\t%g\n" evec.{j, i} 22 | done 23 | done; 24 | print_newline () 25 | 26 | let _ = 27 | Printf.printf "Real Nonsymmetric Matrices\n"; 28 | let data = 29 | [| 30 | -1.; 1.; -1.; 1.; 31 | -8.; 4.; -2.; 1.; 32 | 27.; 9.; 3.; 1.; 33 | 64.; 16.; 4.; 1.; 34 | |] 35 | [@ocamlformat "disable"] 36 | in 37 | let ((eval, evec) as eigen) = Eigen.nonsymmv (`A (data, 4, 4)) in 38 | Eigen.nonsymmv_sort eigen Eigen.ABS_DESC; 39 | for i = 0 to 3 do 40 | let { Complex.re; im } = eval.{i} in 41 | Printf.printf "eigenvalue = %g + %gi\n" re im; 42 | Printf.printf "eigenvector = \n"; 43 | for j = 0 to 3 do 44 | let { Complex.re; im } = evec.{j, i} in 45 | Printf.printf "\t%g + %gi\n" re im 46 | done 47 | done 48 | -------------------------------------------------------------------------------- /lib/poly.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Polynomials *) 6 | 7 | open Gsl_complex 8 | 9 | type poly = float array 10 | 11 | (** {3 Polynomial Evaluation} *) 12 | 13 | external eval : poly -> float -> float = "ml_gsl_poly_eval" 14 | (** [eval p x] returns 15 | [p.(0) +. p.(1) *. x +. p.(2) *. x**2 +. ... +. p.(n) *. x**n] where 16 | [n = Array.length p]. *) 17 | 18 | (** {3 Quadratic Equations} *) 19 | 20 | type quad_sol = Quad_0 | Quad_2 of float * float 21 | 22 | external solve_quadratic : a:float -> b:float -> c:float -> quad_sol 23 | = "ml_gsl_poly_solve_quadratic" 24 | 25 | external complex_solve_quadratic : 26 | a:float -> b:float -> c:float -> complex * complex 27 | = "ml_gsl_poly_complex_solve_quadratic" 28 | 29 | (** {3 Cubic Equations} *) 30 | 31 | type cubic_sol = Cubic_0 | Cubic_1 of float | Cubic_3 of float * float * float 32 | 33 | external solve_cubic : a:float -> b:float -> c:float -> cubic_sol 34 | = "ml_gsl_poly_solve_cubic" 35 | 36 | external complex_solve_cubic : 37 | a:float -> b:float -> c:float -> complex * complex * complex 38 | = "ml_gsl_poly_complex_solve_cubic" 39 | 40 | (** {3 General Polynomial Equations} *) 41 | 42 | val solve : poly -> complex_array 43 | -------------------------------------------------------------------------------- /lib/root.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** One dimensional Root-Finding *) 6 | 7 | module Bracket : sig 8 | type kind = BISECTION | FALSEPOS | BRENT 9 | type t 10 | 11 | val make : kind -> Fun.gsl_fun -> float -> float -> t 12 | external name : t -> string = "ml_gsl_root_fsolver_name" 13 | external iterate : t -> unit = "ml_gsl_root_fsolver_iterate" 14 | external root : t -> float = "ml_gsl_root_fsolver_root" 15 | external interval : t -> float * float = "ml_gsl_root_fsolver_x_interv" 16 | end 17 | 18 | module Polish : sig 19 | type kind = NEWTON | SECANT | STEFFENSON 20 | type t 21 | 22 | val make : kind -> Fun.gsl_fun_fdf -> float -> t 23 | external name : t -> string = "ml_gsl_root_fdfsolver_name" 24 | external iterate : t -> unit = "ml_gsl_root_fdfsolver_iterate" 25 | external root : t -> float = "ml_gsl_root_fdfsolver_root" 26 | end 27 | 28 | external test_interval : 29 | lo:float -> up:float -> epsabs:float -> epsrel:float -> bool 30 | = "ml_gsl_root_test_interval" 31 | 32 | external test_delta : 33 | x1:float -> x0:float -> epsabs:float -> epsrel:float -> bool 34 | = "ml_gsl_root_test_delta" 35 | 36 | external test_residual : f:float -> epsabs:float -> bool 37 | = "ml_gsl_root_test_residual" 38 | -------------------------------------------------------------------------------- /lib/multifit_nlin.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | open Fun 8 | open Vector 9 | 10 | type t 11 | type kind = LMSDER | LMDER 12 | 13 | external _alloc : kind -> n:int -> p:int -> t 14 | = "ml_gsl_multifit_fdfsolver_alloc" 15 | 16 | external _free : t -> unit = "ml_gsl_multifit_fdfsolver_free" 17 | 18 | external _set : t -> multi_fun_fdf -> vector -> unit 19 | = "ml_gsl_multifit_fdfsolver_set" 20 | 21 | let make kind ~n ~p gf x = 22 | let s = _alloc kind ~n ~p in 23 | Gc.finalise _free s; 24 | _set s gf x; 25 | s 26 | 27 | external name : t -> string = "ml_gsl_multifit_fdfsolver_name" 28 | external iterate : t -> unit = "ml_gsl_multifit_fdfsolver_iterate" 29 | external position : t -> vector -> unit = "ml_gsl_multifit_fdfsolver_position" 30 | 31 | external get_state : t -> ?x:vector -> ?f:vector -> ?dx:vector -> unit -> unit 32 | = "ml_gsl_multifit_fdfsolver_get_state" 33 | 34 | external test_delta : t -> epsabs:float -> epsrel:float -> bool 35 | = "ml_gsl_multifit_test_delta" 36 | 37 | external test_gradient : t -> Matrix.matrix -> epsabs:float -> vector -> bool 38 | = "ml_gsl_multifit_test_gradient" 39 | 40 | external covar : Matrix.matrix -> epsrel:float -> Matrix.matrix -> unit 41 | = "ml_gsl_multifit_covar" 42 | -------------------------------------------------------------------------------- /examples/sum_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let _ = Error.init () 4 | let zeta2 = Math.pi *. Math.pi /. 6. 5 | 6 | let zeta_terms n = 7 | let t = Array.make n 0. in 8 | let sum = ref 0. in 9 | for i = 0 to pred n do 10 | let np1 = float (i + 1) in 11 | t.(i) <- 1. /. (np1 *. np1); 12 | sum := !sum +. t.(i) 13 | done; 14 | (t, !sum) 15 | 16 | let print_res sum nbterms sum_accel sum_plain nbterms_accel = 17 | Printf.printf "term-by-term sum = % .16f using %d terms\n" sum nbterms; 18 | Printf.printf "term-by-term sum = % .16f using %d terms\n" sum_plain 19 | nbterms_accel; 20 | Printf.printf "exact value = % .16f\n" zeta2; 21 | Printf.printf "accelerated sum = % .16f using %d terms\n" sum_accel.Fun.res 22 | nbterms_accel; 23 | Printf.printf "estimated error = % .16f\n" sum_accel.Fun.err; 24 | Printf.printf "actual error = % .16f\n" (sum_accel.Fun.res -. zeta2) 25 | 26 | let _ = 27 | let n = 20 in 28 | let t, sum = zeta_terms n in 29 | let ws = Sum.make n in 30 | let res = Sum.accel t ws in 31 | let { Sum.sum_plain; Sum.terms_used = nbterms_used } = Sum.get_info ws in 32 | print_res sum n res sum_plain nbterms_used; 33 | print_newline (); 34 | print_endline "\"truncated\" version:"; 35 | let ws = Sum.Trunc.make n in 36 | let res = Sum.Trunc.accel t ws in 37 | let { Sum.Trunc.sum_plain; Sum.Trunc.terms_used = nbterms_used } = 38 | Sum.Trunc.get_info ws 39 | in 40 | print_res sum n res sum_plain nbterms_used 41 | -------------------------------------------------------------------------------- /lib/mlgsl_complex.h: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #include "wrappers.h" 8 | 9 | static inline value 10 | #ifndef FLOAT_COMPLEX 11 | copy_complex(gsl_complex *c) 12 | #else 13 | copy_complex(gsl_complex_float *c) 14 | #endif /* FLOAT_COMPLEX */ 15 | { 16 | return copy_two_double_arr(GSL_COMPLEX_P_REAL(c), GSL_COMPLEX_P_IMAG(c)); 17 | } 18 | 19 | #ifndef FLOAT_COMPLEX 20 | #define _DECLARE_COMPLEX(v) gsl_complex z_##v 21 | #else 22 | #define _DECLARE_COMPLEX(v) gsl_complex_float z_##v 23 | #endif /* FLOAT_COMPLEX */ 24 | #define _DECLARE_COMPLEX2(v1, v2) \ 25 | _DECLARE_COMPLEX(v1); \ 26 | _DECLARE_COMPLEX(v2) 27 | #define _DECLARE_COMPLEX3(v1, v2, v3) \ 28 | _DECLARE_COMPLEX2(v1, v2); \ 29 | _DECLARE_COMPLEX(v3) 30 | 31 | #define _CONVERT_COMPLEX(v) \ 32 | GSL_SET_COMPLEX(&z_##v, Double_field(v, 0), Double_field(v, 1)) 33 | #define _CONVERT_COMPLEX2(v1, v2) \ 34 | _CONVERT_COMPLEX(v1); \ 35 | _CONVERT_COMPLEX(v2) 36 | -------------------------------------------------------------------------------- /lib/vector_complex_flat.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Vector of complex numbers implemented with a [float array] *) 6 | 7 | type complex_vector_flat = private { 8 | data : float array; 9 | off : int; 10 | len : int; 11 | stride : int; 12 | } 13 | 14 | type vector = complex_vector_flat 15 | 16 | (** {3 Operations} *) 17 | 18 | open Gsl_complex 19 | 20 | val create : ?init:complex -> int -> vector 21 | val of_array : complex array -> vector 22 | val to_array : vector -> complex array 23 | val of_complex_array : complex_array -> vector 24 | val to_complex_array : vector -> complex_array 25 | val length : vector -> int 26 | val get : vector -> int -> complex 27 | val set : vector -> int -> complex -> unit 28 | val set_all : vector -> complex -> unit 29 | val set_zero : vector -> unit 30 | val set_basis : vector -> int -> unit 31 | val memcpy : vector -> vector -> unit 32 | val copy : vector -> vector 33 | val swap_element : vector -> int -> int -> unit 34 | val reverse : vector -> unit 35 | 36 | (** {3 No-copy operations} *) 37 | 38 | val subvector : ?stride:int -> vector -> off:int -> len:int -> vector 39 | 40 | val view_complex_array : 41 | ?stride:int -> ?off:int -> ?len:int -> complex_array -> vector 42 | 43 | val real : vector -> Vector_flat.vector 44 | val imag : vector -> Vector_flat.vector 45 | -------------------------------------------------------------------------------- /lib/ieee.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** IEEE floating-point arithmetic *) 6 | 7 | (** {3 Representation of floating point numbers} *) 8 | 9 | type ieee_type = NAN | INF | NORMAL | DENORMAL | ZERO 10 | 11 | type float_rep = { 12 | sign : int; 13 | mantissa : string; 14 | exponent : int; 15 | ieee_type : ieee_type; 16 | } 17 | 18 | external rep_of_float : float -> float_rep = "ml_gsl_ieee_double_to_rep" 19 | val print : float -> string 20 | 21 | (** {3 IEEE environment} *) 22 | 23 | type precision = SINGLE | DOUBLE | EXTENDED 24 | type rounding = TO_NEAREST | DOWN | UP | TO_ZERO 25 | 26 | type exceptions = 27 | | MASK_INVALID 28 | | MASK_DENORMALIZED 29 | | MASK_DIVISION_BY_ZERO 30 | | MASK_OVERFLOW 31 | | MASK_UNDERFLOW 32 | | MASK_ALL 33 | | TRAP_INEXACT 34 | 35 | external set_mode : 36 | ?precision:precision -> ?rounding:rounding -> exceptions list -> unit 37 | = "ml_gsl_ieee_set_mode" 38 | 39 | external env_setup : unit -> unit = "ml_gsl_ieee_env_setup" 40 | 41 | (** {3 FPU status word} *) 42 | 43 | type excepts = 44 | | FE_INEXACT 45 | | FE_DIVBYZERO 46 | | FE_UNDERFLOW 47 | | FE_OVERFLOW 48 | | FE_INVALID 49 | | FE_ALL_EXCEPT 50 | 51 | external clear_except : excepts list -> unit = "ml_feclearexcept" 52 | external test_except : excepts list -> excepts list = "ml_fetestexcept" 53 | -------------------------------------------------------------------------------- /lib/cheb.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type t 8 | 9 | external _alloc : int -> t = "ml_gsl_cheb_alloc" 10 | external _free : t -> unit = "ml_gsl_cheb_free" 11 | 12 | let make n = 13 | let cs = _alloc n in 14 | Gc.finalise _free cs; 15 | cs 16 | 17 | external order : t -> int = "ml_gsl_cheb_order" 18 | external coefs : t -> float array = "ml_gsl_cheb_coefs" 19 | 20 | external init : t -> Fun.gsl_fun -> a:float -> b:float -> unit 21 | = "ml_gsl_cheb_init" 22 | 23 | external _eval : t -> float -> float = "ml_gsl_cheb_eval" 24 | external _eval_err : t -> float -> Fun.result = "ml_gsl_cheb_eval_err" 25 | external _eval_n : t -> int -> float -> float = "ml_gsl_cheb_eval_n" 26 | 27 | external _eval_n_err : t -> int -> float -> Fun.result 28 | = "ml_gsl_cheb_eval_n_err" 29 | 30 | let eval cs ?order x = 31 | match order with None -> _eval cs x | Some o -> _eval_n cs o x 32 | 33 | let eval_err cs ?order x = 34 | match order with None -> _eval_err cs x | Some o -> _eval_n_err cs o x 35 | 36 | external calc_deriv : t -> t -> unit = "ml_gsl_cheb_calc_deriv" 37 | external calc_integ : t -> t -> unit = "ml_gsl_cheb_calc_integ" 38 | 39 | let deriv cs = 40 | let d = make (order cs) in 41 | calc_deriv d cs; 42 | d 43 | 44 | let integ cs = 45 | let d = make (order cs) in 46 | calc_integ d cs; 47 | d 48 | -------------------------------------------------------------------------------- /lib/wavelet.mli: -------------------------------------------------------------------------------- 1 | (** Wavelet Transforms *) 2 | 3 | type t 4 | type ws 5 | 6 | type kind = 7 | | DAUBECHIES 8 | | DAUBECHIES_CENTERED 9 | | HAAR 10 | | HAAR_CENTERED 11 | | BSPLINE 12 | | BSPLINE_CENTERED 13 | 14 | type direction = FORWARD | BACKWARD 15 | 16 | val make : kind -> int -> t 17 | external name : t -> string = "ml_gsl_wavelet_name" 18 | val workspace_make : int -> ws 19 | external workspace_size : ws -> int = "ml_gsl_wavelet_workspace_size" 20 | 21 | (** {3 1D transforms} *) 22 | 23 | val transform_array : 24 | t -> 25 | direction -> 26 | ?ws:ws -> 27 | ?stride:int -> 28 | ?off:int -> 29 | ?len:int -> 30 | float array -> 31 | unit 32 | 33 | val transform_forward : 34 | t -> ?ws:ws -> ?stride:int -> ?off:int -> ?len:int -> float array -> unit 35 | 36 | val transform_inverse : 37 | t -> ?ws:ws -> ?stride:int -> ?off:int -> ?len:int -> float array -> unit 38 | 39 | val transform_vector_flat : 40 | t -> direction -> ?ws:ws -> Vector_flat.vector -> unit 41 | 42 | val transform_vector : t -> direction -> ?ws:ws -> Vector.vector -> unit 43 | val transform_gen : t -> direction -> ?ws:ws -> [< Vectmat.vec ] -> unit 44 | 45 | (** {3 2D transforms} *) 46 | 47 | type ordering = STANDARD | NON_STANDARD 48 | 49 | val transform_matrix_flat : 50 | t -> ordering -> direction -> ?ws:ws -> Matrix_flat.matrix -> unit 51 | 52 | val transform_matrix : 53 | t -> ordering -> direction -> ?ws:ws -> Matrix.matrix -> unit 54 | 55 | val transform_matrix_gen : 56 | t -> ordering -> direction -> ?ws:ws -> [< Vectmat.mat ] -> unit 57 | -------------------------------------------------------------------------------- /lib/poly.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | open Gsl_complex 8 | 9 | type poly = float array 10 | 11 | external eval : poly -> float -> float = "ml_gsl_poly_eval" 12 | 13 | type quad_sol = Quad_0 | Quad_2 of float * float 14 | 15 | external solve_quadratic : a:float -> b:float -> c:float -> quad_sol 16 | = "ml_gsl_poly_solve_quadratic" 17 | 18 | external complex_solve_quadratic : 19 | a:float -> b:float -> c:float -> complex * complex 20 | = "ml_gsl_poly_complex_solve_quadratic" 21 | 22 | type cubic_sol = Cubic_0 | Cubic_1 of float | Cubic_3 of float * float * float 23 | 24 | external solve_cubic : a:float -> b:float -> c:float -> cubic_sol 25 | = "ml_gsl_poly_solve_cubic" 26 | 27 | external complex_solve_cubic : 28 | a:float -> b:float -> c:float -> complex * complex * complex 29 | = "ml_gsl_poly_complex_solve_cubic" 30 | 31 | type ws 32 | 33 | external _alloc_ws : int -> ws = "ml_gsl_poly_complex_workspace_alloc" 34 | external _free_ws : ws -> unit = "ml_gsl_poly_complex_workspace_free" 35 | 36 | external _solve : poly -> ws -> complex_array -> unit 37 | = "ml_gsl_poly_complex_solve" 38 | 39 | let solve poly = 40 | let n = Array.length poly in 41 | let ws = _alloc_ws n in 42 | try 43 | let sol = Array.make (2 * (n - 1)) 0. in 44 | _solve poly ws sol; 45 | _free_ws ws; 46 | sol 47 | with exn -> 48 | _free_ws ws; 49 | raise exn 50 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name gsl) 3 | (foreign_stubs 4 | (language c) 5 | (names mlgsl_blas mlgsl_blas_complex mlgsl_blas_complex_float 6 | mlgsl_blas_float mlgsl_bspline mlgsl_cdf mlgsl_cheb mlgsl_combi 7 | mlgsl_complex mlgsl_deriv mlgsl_eigen mlgsl_error mlgsl_fft mlgsl_fit 8 | mlgsl_fun mlgsl_histo mlgsl_ieee mlgsl_integration mlgsl_interp 9 | mlgsl_linalg mlgsl_linalg_complex mlgsl_math mlgsl_matrix_complex 10 | mlgsl_matrix_complex_float mlgsl_matrix_double mlgsl_matrix_float 11 | mlgsl_min mlgsl_monte mlgsl_multifit mlgsl_multimin mlgsl_multiroots 12 | mlgsl_odeiv mlgsl_permut mlgsl_poly mlgsl_qrng mlgsl_randist mlgsl_rng 13 | mlgsl_roots mlgsl_sf mlgsl_sort mlgsl_stats mlgsl_sum mlgsl_vector_double 14 | mlgsl_vector_float mlgsl_wavelet) 15 | (flags 16 | (:standard) 17 | (:include c_flags.sexp) 18 | -fPIC 19 | -DPIC 20 | ; NOTE: for limiting excessive warning about unused parameters 21 | -Wno-unused-parameter)) 22 | (c_library_flags 23 | (:include c_library_flags.sexp)) 24 | (libraries bigarray)) 25 | 26 | (rule 27 | (targets c_flags.sexp c_library_flags.sexp gsl_include.sexp) 28 | (action 29 | (run config/discover.exe))) 30 | 31 | (rule 32 | (targets cdf.mli cdf.ml mlgsl_cdf.c) 33 | (deps gsl_include.sexp) 34 | (action 35 | (run config/do_cdf.exe))) 36 | 37 | (rule 38 | (targets const.mli const.ml) 39 | (deps gsl_include.sexp) 40 | (action 41 | (run config/do_const.exe))) 42 | 43 | (rule 44 | (targets sf.mli sf.ml) 45 | (deps gsl_include.sexp sf.mli.q) 46 | (action 47 | (run config/do_sf.exe))) 48 | -------------------------------------------------------------------------------- /lib/multimin.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Multidimensional Minimization *) 6 | 7 | open Fun 8 | open Vector 9 | 10 | module Deriv : sig 11 | type kind = 12 | | CONJUGATE_FR 13 | | CONJUGATE_PR 14 | | VECTOR_BFGS 15 | | VECTOR_BFGS2 16 | | STEEPEST_DESCENT 17 | 18 | type t 19 | 20 | val make : 21 | kind -> int -> multim_fun_fdf -> x:vector -> step:float -> tol:float -> t 22 | 23 | external name : t -> string = "ml_gsl_multimin_fdfminimizer_name" 24 | external iterate : t -> unit = "ml_gsl_multimin_fdfminimizer_iterate" 25 | external restart : t -> unit = "ml_gsl_multimin_fdfminimizer_restart" 26 | 27 | external minimum : ?x:vector -> ?dx:vector -> ?g:vector -> t -> float 28 | = "ml_gsl_multimin_fdfminimizer_minimum" 29 | 30 | external test_gradient : t -> float -> bool = "ml_gsl_multimin_test_gradient" 31 | end 32 | 33 | module NoDeriv : sig 34 | type kind = NM_SIMPLEX 35 | type t 36 | 37 | val make : kind -> int -> multim_fun -> x:vector -> step_size:vector -> t 38 | external name : t -> string = "ml_gsl_multimin_fminimizer_name" 39 | external iterate : t -> unit = "ml_gsl_multimin_fminimizer_iterate" 40 | 41 | external minimum : ?x:vector -> t -> float 42 | = "ml_gsl_multimin_fminimizer_minimum" 43 | 44 | external size : t -> float = "ml_gsl_multimin_fminimizer_size" 45 | external test_size : t -> float -> bool = "ml_gsl_multimin_test_size" 46 | end 47 | -------------------------------------------------------------------------------- /examples/bspline_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let n = 200 4 | let ncoeffs = 8 5 | let nbreak = ncoeffs - 2 6 | 7 | open Printf 8 | 9 | let _ = 10 | let rng = Rng.make (Rng.default ()) in 11 | 12 | (* allocate a cubic bspline workspace (k = 4) *) 13 | let bw = Bspline.make ~k:4 ~nbreak in 14 | 15 | let x = Vector.create n 16 | and y = Vector.create n 17 | and w = Vector.create n 18 | and mX = Matrix.create n ncoeffs 19 | and vB = Vector.create ncoeffs in 20 | 21 | (* this is the data to be fitted *) 22 | (printf "#m=0,S=0\n"; 23 | let sigma = 0.1 in 24 | for i = 0 to n - 1 do 25 | let xi = 15. /. float (n - 1) *. float i in 26 | let yi = cos xi *. exp (-0.1 *. xi) in 27 | let dy = Randist.gaussian rng ~sigma in 28 | x.{i} <- xi; 29 | y.{i} <- yi +. dy; 30 | w.{i} <- 1. /. (sigma *. sigma); 31 | printf "%f %f\n" xi yi 32 | done); 33 | 34 | (* use uniform breakpoints on [0, 15] *) 35 | Bspline.knots_uniform ~a:0. ~b:15. bw; 36 | 37 | (* construct the fit matrix X *) 38 | for i = 0 to n - 1 do 39 | (* compute B_j(xi) for all j *) 40 | Bspline._eval x.{i} (`V vB) bw; 41 | (* fill in row i of X *) 42 | for j = 0 to ncoeffs - 1 do 43 | mX.{i, j} <- vB.{j} 44 | done 45 | done; 46 | 47 | (* do the fit *) 48 | let c, cov, _chisq = Multifit.linear ~weight:(`V w) (`M mX) (`V y) in 49 | 50 | (* output the smoothed curve *) 51 | printf "#m=1,S=0\n"; 52 | let xi = ref 0. in 53 | while !xi < 15. do 54 | Bspline._eval !xi (`V vB) bw; 55 | let yi = Multifit.linear_est ~x:(`V vB) ~c:(`V c) ~cov:(`M cov) in 56 | printf "%f %f\n" !xi yi.Fun.res; 57 | xi := !xi +. 0.1 58 | done 59 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Builds, tests & co 2 | 3 | on: 4 | - pull_request 5 | - push 6 | - workflow_dispatch 7 | 8 | permissions: read-all 9 | 10 | jobs: 11 | build: 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | os: 16 | - ubuntu-latest 17 | - macos-latest 18 | # - windows-latest 19 | 20 | runs-on: ${{ matrix.os }} 21 | 22 | steps: 23 | - name: Checkout tree 24 | uses: actions/checkout@v6 25 | 26 | - name: Set-up OCaml 27 | uses: ocaml/setup-ocaml@v3 28 | with: 29 | ocaml-compiler: 5 30 | 31 | - run: opam install . --deps-only --with-test 32 | 33 | - run: opam exec -- dune build 34 | 35 | - run: opam exec -- dune runtest 36 | 37 | lint-doc: 38 | runs-on: ubuntu-latest 39 | steps: 40 | - name: Checkout tree 41 | uses: actions/checkout@v6 42 | - name: Set-up OCaml 43 | uses: ocaml/setup-ocaml@v3 44 | with: 45 | ocaml-compiler: 5 46 | - uses: ocaml/setup-ocaml/lint-doc@v3 47 | 48 | lint-fmt: 49 | runs-on: ubuntu-latest 50 | steps: 51 | - name: Checkout tree 52 | uses: actions/checkout@v6 53 | - name: Set-up OCaml 54 | uses: ocaml/setup-ocaml@v3 55 | with: 56 | ocaml-compiler: 5 57 | - uses: ocaml/setup-ocaml/lint-fmt@v3 58 | 59 | lint-opam: 60 | runs-on: ubuntu-latest 61 | steps: 62 | - name: Checkout tree 63 | uses: actions/checkout@v6 64 | - name: Set-up OCaml 65 | uses: ocaml/setup-ocaml@v3 66 | with: 67 | ocaml-compiler: 5 68 | - uses: ocaml/setup-ocaml/lint-opam@v3 69 | -------------------------------------------------------------------------------- /lib/siman.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type params = { 8 | iters_fixed_T : int; 9 | step_size : float; 10 | k : float; 11 | t_initial : float; 12 | mu_t : float; 13 | t_min : float; 14 | } 15 | 16 | open Misc 17 | 18 | let solve rng conf0 ~energ_func ~step_func ?print_func params = 19 | let best_energ = ref (energ_func conf0) in 20 | let best_x = ref conf0 in 21 | let energ = ref !best_energ in 22 | let x = ref !best_x in 23 | 24 | let t = ref params.t_initial in 25 | let n_iter = ref 0 in 26 | let n_eval = ref 1 in 27 | 28 | if is print_func then 29 | print_string "#-iter #-evals temperature position energy\n"; 30 | 31 | while !t >= params.t_min do 32 | for _i = 1 to params.iters_fixed_T do 33 | let new_x = step_func rng !x params.step_size in 34 | let new_energ = energ_func new_x in 35 | incr n_eval; 36 | if new_energ <= !best_energ then ( 37 | best_energ := new_energ; 38 | best_x := new_x); 39 | 40 | if 41 | new_energ < !energ 42 | || 43 | let lim = exp (~-.(new_energ -. !energ) /. (!t *. params.k)) in 44 | Rng.uniform rng < lim 45 | then ( 46 | energ := new_energ; 47 | x := new_x) 48 | done; 49 | 50 | if is print_func then ( 51 | Printf.printf "%5d %7d %12g" !n_iter !n_eval !t; 52 | may_apply print_func !x; 53 | Printf.printf " %12g\n" !energ); 54 | 55 | t := !t /. params.mu_t; 56 | incr n_iter 57 | done; 58 | !best_x 59 | -------------------------------------------------------------------------------- /lib/mlgsl_qrng.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #include "wrappers.h" 8 | 9 | static inline const gsl_qrng_type *qrngtype_val(value v) { 10 | const gsl_qrng_type *qrng_type[] = {gsl_qrng_niederreiter_2, gsl_qrng_sobol}; 11 | return qrng_type[Int_val(v)]; 12 | } 13 | 14 | #define Qrng_val(v) (gsl_qrng *)Field((v), 0) 15 | 16 | CAMLprim value ml_gsl_qrng_alloc(value type, value dim) { 17 | value r; 18 | Abstract_ptr(r, gsl_qrng_alloc(qrngtype_val(type), Int_val(dim))); 19 | return r; 20 | } 21 | 22 | ML1(gsl_qrng_free, Qrng_val, Unit) 23 | ML1(gsl_qrng_init, Qrng_val, Unit) 24 | 25 | CAMLprim value ml_gsl_qrng_dimension(value qrng) { 26 | return Val_int((Qrng_val(qrng))->dimension); 27 | } 28 | 29 | CAMLprim value ml_gsl_qrng_get(value qrng, value x) { 30 | if (Double_array_length(x) != (Qrng_val(qrng))->dimension) 31 | GSL_ERROR("wrong array size", GSL_EBADLEN); 32 | gsl_qrng_get(Qrng_val(qrng), Double_array_val(x)); 33 | return Val_unit; 34 | } 35 | 36 | CAMLprim value ml_gsl_qrng_sample(value qrng) { 37 | gsl_qrng *q = Qrng_val(qrng); 38 | value arr = caml_alloc(q->dimension * Double_wosize, Double_array_tag); 39 | gsl_qrng_get(q, Double_array_val(arr)); 40 | return arr; 41 | } 42 | 43 | ML1(gsl_qrng_name, Qrng_val, caml_copy_string) 44 | 45 | CAMLprim value ml_gsl_qrng_memcpy(value src, value dst) { 46 | gsl_qrng_memcpy(Qrng_val(dst), Qrng_val(src)); 47 | return Val_unit; 48 | } 49 | 50 | CAMLprim value ml_gsl_qrng_clone(value qrng) { 51 | value r; 52 | Abstract_ptr(r, gsl_qrng_clone(Qrng_val(qrng))); 53 | return r; 54 | } 55 | -------------------------------------------------------------------------------- /lib/fun.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Callbacks and types for error estimates *) 6 | 7 | (** {3 Types for special functions} *) 8 | 9 | (** These type are used by module {! Sf} *) 10 | 11 | type result = { res : float; err : float } 12 | (** The result of a computation : [res] is the value and [err] an estimate of 13 | the absolute error in the value. *) 14 | 15 | type result_e10 = { res_e10 : float; err_e10 : float; e10 : int } 16 | (** Result of computation with a scaling exponent. Actual result is obtained as 17 | [res *. 10. ** e10]. *) 18 | 19 | (** Reduce the accuracy of some evaluations to speed up computations. *) 20 | type mode = 21 | | DOUBLE (** Double precision : 2 * 10^-16 *) 22 | | SIMPLE (** Single precision : 10^-7 *) 23 | | APPROX (** Approximate values : 5 * 10^-4 *) 24 | 25 | external smash : result_e10 -> result = "ml_gsl_sf_result_smash_e" 26 | 27 | (** {3 Callbacks} *) 28 | 29 | type gsl_fun = float -> float 30 | 31 | type gsl_fun_fdf = { 32 | f : float -> float; 33 | df : float -> float; 34 | fdf : float -> float * float; 35 | } 36 | 37 | type monte_fun = float array -> float 38 | 39 | open Vector 40 | 41 | type multi_fun = x:vector -> f:vector -> unit 42 | 43 | type multi_fun_fdf = { 44 | multi_f : x:vector -> f:vector -> unit; 45 | multi_df : x:vector -> j:Matrix.matrix -> unit; 46 | multi_fdf : x:vector -> f:vector -> j:Matrix.matrix -> unit; 47 | } 48 | 49 | type multim_fun = x:vector -> float 50 | 51 | type multim_fun_fdf = { 52 | multim_f : x:vector -> float; 53 | multim_df : x:vector -> g:vector -> unit; 54 | multim_fdf : x:vector -> g:vector -> float; 55 | } 56 | -------------------------------------------------------------------------------- /lib/permut.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Permutations *) 6 | 7 | type permut = (int, Bigarray.int_elt, Bigarray.c_layout) Bigarray.Array1.t 8 | 9 | val of_array : int array -> permut 10 | val to_array : permut -> int array 11 | val init : permut -> unit 12 | val create : int -> permut 13 | val make : int -> permut 14 | val swap : permut -> int -> int -> unit 15 | val size : permut -> int 16 | val valid : permut -> bool 17 | external reverse : permut -> unit = "ml_gsl_permutation_reverse" 18 | val inverse : permut -> permut 19 | external next : permut -> unit = "ml_gsl_permutation_next" 20 | external prev : permut -> unit = "ml_gsl_permutation_prev" 21 | external permute : permut -> 'a array -> unit = "ml_gsl_permute" 22 | 23 | external permute_barr : permut -> ('a, 'b, 'c) Bigarray.Array1.t -> unit 24 | = "ml_gsl_permute_barr" 25 | 26 | external permute_complex : permut -> Gsl_complex.complex_array -> unit 27 | = "ml_gsl_permute_complex" 28 | 29 | external permute_inverse : permut -> 'a array -> unit = "ml_gsl_permute_inverse" 30 | 31 | external permute_inverse_barr : permut -> ('a, 'b, 'c) Bigarray.Array1.t -> unit 32 | = "ml_gsl_permute_inverse_barr" 33 | 34 | external permute_inverse_complex : permut -> Gsl_complex.complex_array -> unit 35 | = "ml_gsl_permute_inverse_complex" 36 | 37 | val mul : permut -> permut -> permut 38 | val linear_to_canonical : permut -> permut 39 | val canonical_to_linear : permut -> permut 40 | external inversions : permut -> int = "ml_gsl_permute_inversions" 41 | external canonical_cycles : permut -> int = "ml_gsl_permute_canonical_cycles" 42 | external linear_cycles : permut -> int = "ml_gsl_permute_linear_cycles" 43 | -------------------------------------------------------------------------------- /lib/mlgsl_error.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | #include 7 | 8 | #include 9 | #include 10 | #include 11 | #include 12 | 13 | CAMLprim value ml_gsl_version(value unit) { 14 | return caml_copy_string(gsl_version); 15 | } 16 | 17 | CAMLprim value ml_gsl_strerror(value ml_errno) { 18 | int c_errno = Int_val(ml_errno); 19 | int gsl_errno = (c_errno <= 1) ? (c_errno - 2) : (c_errno - 1); 20 | return caml_copy_string(gsl_strerror(gsl_errno)); 21 | } 22 | 23 | static const value *ml_gsl_err_handler = NULL; 24 | 25 | static void ml_gsl_error_handler(const char *reason, const char *file, int line, 26 | int gsl_errno) { 27 | value exn_msg; 28 | int ml_errno; 29 | 30 | if (0 < gsl_errno && gsl_errno <= GSL_EOF) 31 | ml_errno = gsl_errno + 1; 32 | else if (GSL_CONTINUE <= gsl_errno && gsl_errno <= GSL_FAILURE) 33 | ml_errno = gsl_errno + 2; 34 | else 35 | caml_failwith("invalid GSL error code"); 36 | 37 | exn_msg = caml_copy_string(reason); 38 | caml_callback2(Field(*ml_gsl_err_handler, 0), Val_int(ml_errno), exn_msg); 39 | } 40 | 41 | CAMLprim value ml_gsl_error_init(value init) { 42 | static gsl_error_handler_t *old; 43 | 44 | if (ml_gsl_err_handler == NULL) 45 | ml_gsl_err_handler = caml_named_value("mlgsl_err_handler"); 46 | 47 | if (Bool_val(init)) { 48 | gsl_error_handler_t *prev; 49 | prev = gsl_set_error_handler(&ml_gsl_error_handler); 50 | if (prev != ml_gsl_error_handler) 51 | old = prev; 52 | } else 53 | gsl_set_error_handler(old); 54 | 55 | return Val_unit; 56 | } 57 | -------------------------------------------------------------------------------- /lib/config/do_const.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | open Do_common 3 | 4 | let () = 5 | let rex = Str.regexp "^#define GSL_CONST_[^_]+_\\(.*\\)\\b.*(\\(.*\\))" in 6 | let get_name line = String.lowercase_ascii (Str.matched_group 1 line) in 7 | let get_data line = String.lowercase_ascii (Str.matched_group 2 line) in 8 | Out_channel.with_file "const.mli" ~f:(fun mli_oc -> 9 | Out_channel.with_file "const.ml" ~f:(fun ml_oc -> 10 | let act const = 11 | let print_both str = 12 | output_string mli_oc str; 13 | output_string ml_oc str 14 | in 15 | print_both "(** Values of physical constants *)\n"; 16 | let upper_const = String.uppercase_ascii const in 17 | fprintf mli_oc "\nmodule %s : sig\n" (String.uppercase_ascii const); 18 | fprintf ml_oc "\nmodule %s = struct\n" upper_const; 19 | let gsl_path = 20 | Filename.concat gsl_include_dir (sprintf "gsl_const_%s.h" const) 21 | in 22 | In_channel.with_file gsl_path ~f:(fun ic -> 23 | let rec loop () = 24 | match input_line ic with 25 | | line -> 26 | if Str.string_match rex line 0 then ( 27 | let name = get_name line in 28 | let data = get_data line in 29 | fprintf mli_oc " val %s : float\n" name; 30 | fprintf ml_oc " let %s = %s\n" name data); 31 | loop () 32 | | exception End_of_file -> print_both "end\n" 33 | in 34 | loop ()) 35 | in 36 | let gsl_consts = [| "cgs"; "cgsm"; "mks"; "mksa"; "num" |] in 37 | Array.iter act gsl_consts; 38 | output_string ml_oc "\nlet () = Error.init ()\n")) 39 | -------------------------------------------------------------------------------- /lib/math.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Mathematical constants and some simple functions *) 6 | 7 | (** {3 Constants} *) 8 | 9 | val e : float 10 | (** e *) 11 | 12 | val log2e : float 13 | (** log_2 (e) *) 14 | 15 | val log10e : float 16 | (** log_10 (e) *) 17 | 18 | val sqrt2 : float 19 | (** sqrt(2) *) 20 | 21 | val sqrt1_2 : float 22 | (** sqrt(1/2) *) 23 | 24 | val sqrt3 : float 25 | (** sqrt(3) *) 26 | 27 | val pi : float 28 | (** pi *) 29 | 30 | val pi_2 : float 31 | (** pi/2 *) 32 | 33 | val pi_4 : float 34 | (** pi/4 *) 35 | 36 | val sqrtpi : float 37 | (** sqrt(pi) *) 38 | 39 | val i_2_sqrtpi : float 40 | (** 2/sqrt(pi) *) 41 | 42 | val i_1_pi : float 43 | (** 1/pi *) 44 | 45 | val i_2_pi : float 46 | (** 2/pi *) 47 | 48 | val ln10 : float 49 | (** ln(10) *) 50 | 51 | val ln2 : float 52 | (** ln(2) *) 53 | 54 | val lnpi : float 55 | (** ln(pi) *) 56 | 57 | val euler : float 58 | (** Euler constant *) 59 | 60 | (** {3 Simple Functions} *) 61 | 62 | val pow_int : float -> int -> float 63 | 64 | external log1p : float -> float = "ml_gsl_log1p" "gsl_log1p" 65 | [@@unboxed] [@@noalloc] 66 | 67 | external expm1 : float -> float = "ml_gsl_expm1" "gsl_expm1" 68 | [@@unboxed] [@@noalloc] 69 | 70 | external hypot : float -> float -> float = "ml_gsl_hypot" "gsl_hypot" 71 | [@@unboxed] [@@noalloc] 72 | 73 | external acosh : float -> float = "ml_gsl_acosh" "gsl_acosh" 74 | [@@unboxed] [@@noalloc] 75 | 76 | external asinh : float -> float = "ml_gsl_asinh" "gsl_asinh" 77 | [@@unboxed] [@@noalloc] 78 | 79 | external atanh : float -> float = "ml_gsl_atanh" "gsl_atanh" 80 | [@@unboxed] [@@noalloc] 81 | 82 | external fcmp : float -> float -> epsilon:float -> int = "ml_gsl_fcmp" 83 | -------------------------------------------------------------------------------- /lib/ieee.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type ieee_type = NAN | INF | NORMAL | DENORMAL | ZERO 8 | 9 | type float_rep = { 10 | sign : int; 11 | mantissa : string; 12 | exponent : int; 13 | ieee_type : ieee_type; 14 | } 15 | 16 | external rep_of_float : float -> float_rep = "ml_gsl_ieee_double_to_rep" 17 | external env_setup : unit -> unit = "ml_gsl_ieee_env_setup" 18 | 19 | type precision = SINGLE | DOUBLE | EXTENDED 20 | type rounding = TO_NEAREST | DOWN | UP | TO_ZERO 21 | 22 | type exceptions = 23 | | MASK_INVALID 24 | | MASK_DENORMALIZED 25 | | MASK_DIVISION_BY_ZERO 26 | | MASK_OVERFLOW 27 | | MASK_UNDERFLOW 28 | | MASK_ALL 29 | | TRAP_INEXACT 30 | 31 | external set_mode : 32 | ?precision:precision -> ?rounding:rounding -> exceptions list -> unit 33 | = "ml_gsl_ieee_set_mode" 34 | 35 | let print f = 36 | let rep = rep_of_float f in 37 | match rep.ieee_type with 38 | | NAN -> "NaN" 39 | | INF when rep.sign = 0 -> "Inf" 40 | | INF -> "-Inf" 41 | | ZERO when rep.sign = 0 -> "0" 42 | | ZERO -> "-0" 43 | | DENORMAL -> 44 | (if rep.sign = 0 then "" else "-") 45 | ^ "0." ^ rep.mantissa 46 | ^ if rep.exponent = 0 then "" else string_of_int rep.exponent 47 | | NORMAL -> 48 | (if rep.sign = 0 then "" else "-") 49 | ^ "1." ^ rep.mantissa 50 | ^ if rep.exponent = 0 then "" else "*2^" ^ string_of_int rep.exponent 51 | 52 | type excepts = 53 | | FE_INEXACT 54 | | FE_DIVBYZERO 55 | | FE_UNDERFLOW 56 | | FE_OVERFLOW 57 | | FE_INVALID 58 | | FE_ALL_EXCEPT 59 | 60 | external clear_except : excepts list -> unit = "ml_feclearexcept" 61 | external test_except : excepts list -> excepts list = "ml_fetestexcept" 62 | -------------------------------------------------------------------------------- /lib/multifit.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | open Vectmat 8 | 9 | type ws 10 | 11 | external alloc_ws : int -> int -> ws = "ml_gsl_multifit_linear_alloc" 12 | external free_ws : ws -> unit = "ml_gsl_multifit_linear_free" 13 | 14 | let make ~n ~p = 15 | let ws = alloc_ws n p in 16 | Gc.finalise free_ws ws; 17 | ws 18 | 19 | external _linear : 20 | ?weight:vec -> x:mat -> y:vec -> c:vec -> cov:mat -> ws -> float 21 | = "ml_gsl_multifit_linear_bc" "ml_gsl_multifit_linear" 22 | 23 | let linear ?weight x y = 24 | let n, p = Vectmat.dims x in 25 | let dy = Vectmat.length y in 26 | if dy <> n then invalid_arg "Multifit.linear: wrong dimensions"; 27 | Misc.may weight (fun w -> 28 | if Vectmat.length w <> n then 29 | invalid_arg "Multifit.linear: wrong dimensions"); 30 | let c = Vector.create p in 31 | let cov = Matrix.create p p in 32 | let ws = alloc_ws n p in 33 | try 34 | let chisq = _linear ?weight ~x ~y ~c:(`V c) ~cov:(`M cov) ws in 35 | free_ws ws; 36 | (c, cov, chisq) 37 | with exn -> 38 | free_ws ws; 39 | raise exn 40 | 41 | external linear_est : x:vec -> c:vec -> cov:mat -> Fun.result 42 | = "ml_gsl_multifit_linear_est" 43 | 44 | let fit_poly ?weight ~x ~y order = 45 | let n = Array.length y in 46 | let x_mat = Matrix.create n (succ order) in 47 | for i = 0 to pred n do 48 | let xi = x.(i) in 49 | for j = 0 to order do 50 | x_mat.{i, j} <- Math.pow_int xi j 51 | done 52 | done; 53 | let weight = 54 | match weight with None -> None | Some a -> Some (vec_convert (`A a)) 55 | in 56 | let c, cov, chisq = linear ?weight (`M x_mat) (vec_convert (`A y)) in 57 | (Vector.to_array c, Matrix.to_arrays cov, chisq) 58 | -------------------------------------------------------------------------------- /lib/deriv.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Numerical Differentiation *) 6 | 7 | external central : f:(float -> float) -> x:float -> h:float -> Fun.result 8 | = "ml_gsl_deriv_central" 9 | (** [central f x h] computes the numerical derivative of the function [f] at the 10 | point [x] using an adaptive central difference algorithm with a step-size of 11 | [h]. The function returns a value [r] with the derivative being in [r.res] 12 | and an estimate of its absolute error in [r.err]. *) 13 | 14 | external forward : f:(float -> float) -> x:float -> h:float -> Fun.result 15 | = "ml_gsl_deriv_forward" 16 | (** [forward f x h] computes the numerical derivative of the function [f] at the 17 | point [x] using an adaptive forward difference algorithm with a step-size of 18 | [h]. The function is evaluated only at points greater than [x], and never at 19 | [x] itself. The function returns [r] with the derivative in [r.res] and an 20 | estimate of its absolute in [r.err]. This function should be used if f(x) 21 | has a discontinuity at [x], or is undefined for values less than [x]. *) 22 | 23 | external backward : f:(float -> float) -> x:float -> h:float -> Fun.result 24 | = "ml_gsl_deriv_backward" 25 | (** [forward f x h] computes the numerical derivative of the function [f] at the 26 | point [x] using an adaptive backward difference algorithm with a step-size 27 | of [h]. The function is evaluated only at points less than [x], and never at 28 | [x] itself. The function returns a value [r] with the derivative in [r.res] 29 | and an estimate of its absolute error in [r.err]. This function should be 30 | used if f(x) has a discontinuity at [x], or is undefined for values greater 31 | than [x]. *) 32 | -------------------------------------------------------------------------------- /lib/mlgsl_sort.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2005-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | #include 7 | #include 8 | 9 | #include 10 | 11 | #include "mlgsl_permut.h" 12 | #include "mlgsl_vector_double.h" 13 | #include "wrappers.h" 14 | 15 | CAMLprim value ml_gsl_sort_vector(value v) { 16 | _DECLARE_VECTOR(v); 17 | _CONVERT_VECTOR(v); 18 | gsl_sort_vector(&v_v); 19 | return Val_unit; 20 | } 21 | 22 | CAMLprim value ml_gsl_sort_vector_index(value p, value v) { 23 | GSL_PERMUT_OF_BIGARRAY(p); 24 | _DECLARE_VECTOR(v); 25 | _CONVERT_VECTOR(v); 26 | gsl_sort_vector_index(&perm_p, &v_v); 27 | return Val_unit; 28 | } 29 | 30 | CAMLprim value ml_gsl_sort_vector_smallest(value dest, value v) { 31 | _DECLARE_VECTOR(v); 32 | _CONVERT_VECTOR(v); 33 | gsl_sort_vector_smallest(Double_array_val(dest), Double_array_length(dest), 34 | &v_v); 35 | return Val_unit; 36 | } 37 | 38 | CAMLprim value ml_gsl_sort_vector_largest(value dest, value v) { 39 | _DECLARE_VECTOR(v); 40 | _CONVERT_VECTOR(v); 41 | gsl_sort_vector_largest(Double_array_val(dest), Double_array_length(dest), 42 | &v_v); 43 | return Val_unit; 44 | } 45 | 46 | CAMLprim value ml_gsl_sort_vector_smallest_index(value p, value v) { 47 | GSL_PERMUT_OF_BIGARRAY(p); 48 | _DECLARE_VECTOR(v); 49 | _CONVERT_VECTOR(v); 50 | gsl_sort_vector_smallest_index(perm_p.data, perm_p.size, &v_v); 51 | return Val_unit; 52 | } 53 | 54 | CAMLprim value ml_gsl_sort_vector_largest_index(value p, value v) { 55 | GSL_PERMUT_OF_BIGARRAY(p); 56 | _DECLARE_VECTOR(v); 57 | _CONVERT_VECTOR(v); 58 | gsl_sort_vector_largest_index(perm_p.data, perm_p.size, &v_v); 59 | return Val_unit; 60 | } 61 | -------------------------------------------------------------------------------- /lib/multiroot.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Multidimensional Root-Finding *) 6 | 7 | open Fun 8 | open Vector 9 | 10 | module NoDeriv : sig 11 | type kind = HYBRIDS | HYBRID | DNEWTON | BROYDEN 12 | type t 13 | 14 | val make : kind -> int -> multi_fun -> vector -> t 15 | external name : t -> string = "ml_gsl_multiroot_fsolver_name" 16 | external iterate : t -> unit = "ml_gsl_multiroot_fsolver_iterate" 17 | external root : t -> vector -> unit = "ml_gsl_multiroot_fsolver_root" 18 | 19 | external get_state : t -> ?x:vector -> ?f:vector -> ?dx:vector -> unit -> unit 20 | = "ml_gsl_multiroot_fsolver_get_state" 21 | 22 | external test_delta : t -> epsabs:float -> epsrel:float -> bool 23 | = "ml_gsl_multiroot_test_delta_f" 24 | 25 | external test_residual : t -> epsabs:float -> bool 26 | = "ml_gsl_multiroot_test_residual_f" 27 | end 28 | 29 | module Deriv : sig 30 | type kind = HYBRIDSJ | HYBRIDJ | NEWTON | GNEWTON 31 | type t 32 | 33 | val make : kind -> int -> multi_fun_fdf -> vector -> t 34 | external name : t -> string = "ml_gsl_multiroot_fdfsolver_name" 35 | external iterate : t -> unit = "ml_gsl_multiroot_fdfsolver_iterate" 36 | external root : t -> vector -> unit = "ml_gsl_multiroot_fdfsolver_root" 37 | 38 | external get_state : 39 | t -> 40 | ?x:vector -> 41 | ?f:vector -> 42 | ?j:Matrix.matrix -> 43 | ?dx:vector -> 44 | unit -> 45 | unit 46 | = "ml_gsl_multiroot_fdfsolver_get_state_bc" 47 | "ml_gsl_multiroot_fdfsolver_get_state" 48 | 49 | external test_delta : t -> epsabs:float -> epsrel:float -> bool 50 | = "ml_gsl_multiroot_test_delta_fdf" 51 | 52 | external test_residual : t -> epsabs:float -> bool 53 | = "ml_gsl_multiroot_test_residual_fdf" 54 | end 55 | -------------------------------------------------------------------------------- /lib/mlgsl_cheb.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #include 8 | 9 | #include 10 | #include 11 | 12 | #include "mlgsl_fun.h" 13 | #include "wrappers.h" 14 | 15 | #define CHEB_VAL(v) ((gsl_cheb_series *)Field((v), 0)) 16 | ML1_alloc(gsl_cheb_alloc, Int_val, Abstract_ptr) 17 | ML1(gsl_cheb_free, CHEB_VAL, Unit) 18 | 19 | CAMLprim value ml_gsl_cheb_order(value c) { 20 | return Val_int(CHEB_VAL(c)->order); 21 | } 22 | 23 | CAMLprim value ml_gsl_cheb_coefs(value c) { 24 | CAMLparam1(c); 25 | CAMLlocal1(a); 26 | gsl_cheb_series *cs = CHEB_VAL(c); 27 | size_t len = cs->order + 1; 28 | a = caml_alloc(len * Double_wosize, Double_array_tag); 29 | memcpy(Bp_val(a), cs->c, len * sizeof(double)); 30 | CAMLreturn(a); 31 | } 32 | 33 | CAMLprim value ml_gsl_cheb_init(value cs, value f, value a, value b) { 34 | CAMLparam2(cs, f); 35 | GSLFUN_CLOSURE(gf, f); 36 | gsl_cheb_init(CHEB_VAL(cs), &gf, Double_val(a), Double_val(b)); 37 | CAMLreturn(Val_unit); 38 | } 39 | 40 | ML2(gsl_cheb_eval, CHEB_VAL, Double_val, caml_copy_double) 41 | 42 | CAMLprim value ml_gsl_cheb_eval_err(value cheb, value x) { 43 | double res, err; 44 | gsl_cheb_eval_err(CHEB_VAL(cheb), Double_val(x), &res, &err); 45 | return copy_two_double_arr(res, err); 46 | } 47 | 48 | ML3(gsl_cheb_eval_n, CHEB_VAL, Int_val, Double_val, caml_copy_double) 49 | 50 | CAMLprim value ml_gsl_cheb_eval_n_err(value cheb, value order, value x) { 51 | double res, err; 52 | gsl_cheb_eval_n_err(CHEB_VAL(cheb), Int_val(order), Double_val(x), &res, 53 | &err); 54 | return copy_two_double_arr(res, err); 55 | } 56 | 57 | ML2(gsl_cheb_calc_deriv, CHEB_VAL, CHEB_VAL, Unit) 58 | ML2(gsl_cheb_calc_integ, CHEB_VAL, CHEB_VAL, Unit) 59 | -------------------------------------------------------------------------------- /lib/root.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | module Bracket = struct 8 | type kind = BISECTION | FALSEPOS | BRENT 9 | type t 10 | 11 | external _alloc : kind -> t = "ml_gsl_root_fsolver_alloc" 12 | external _free : t -> unit = "ml_gsl_root_fsolver_free" 13 | 14 | external _set : t -> Fun.gsl_fun -> float -> float -> unit 15 | = "ml_gsl_root_fsolver_set" 16 | 17 | let make kind f x y = 18 | let s = _alloc kind in 19 | Gc.finalise _free s; 20 | _set s f x y; 21 | s 22 | 23 | external name : t -> string = "ml_gsl_root_fsolver_name" 24 | external iterate : t -> unit = "ml_gsl_root_fsolver_iterate" 25 | external root : t -> float = "ml_gsl_root_fsolver_root" 26 | external interval : t -> float * float = "ml_gsl_root_fsolver_x_interv" 27 | end 28 | 29 | module Polish = struct 30 | type kind = NEWTON | SECANT | STEFFENSON 31 | type t 32 | 33 | external _alloc : kind -> t = "ml_gsl_root_fdfsolver_alloc" 34 | external _free : t -> unit = "ml_gsl_root_fdfsolver_free" 35 | 36 | external _set : t -> Fun.gsl_fun_fdf -> float -> unit 37 | = "ml_gsl_root_fdfsolver_set" 38 | 39 | let make kind f r = 40 | let s = _alloc kind in 41 | Gc.finalise _free s; 42 | _set s f r; 43 | s 44 | 45 | external name : t -> string = "ml_gsl_root_fdfsolver_name" 46 | external iterate : t -> unit = "ml_gsl_root_fdfsolver_iterate" 47 | external root : t -> float = "ml_gsl_root_fdfsolver_root" 48 | end 49 | 50 | external test_interval : 51 | lo:float -> up:float -> epsabs:float -> epsrel:float -> bool 52 | = "ml_gsl_root_test_interval" 53 | 54 | external test_delta : 55 | x1:float -> x0:float -> epsabs:float -> epsrel:float -> bool 56 | = "ml_gsl_root_test_delta" 57 | 58 | external test_residual : f:float -> epsabs:float -> bool 59 | = "ml_gsl_root_test_residual" 60 | -------------------------------------------------------------------------------- /lib/interp.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Interpolation *) 6 | 7 | type t 8 | type accel 9 | 10 | type interp_type = 11 | | LINEAR 12 | | POLYNOMIAL 13 | | CSPLINE 14 | | CSPLINE_PERIODIC 15 | | AKIMA 16 | | AKIMA_PERIODIC 17 | 18 | val make : interp_type -> int -> t 19 | val init : t -> float array -> float array -> unit 20 | external name : t -> string = "ml_gsl_interp_name" 21 | external min_size : t -> int = "ml_gsl_interp_min_size" 22 | val make_accel : unit -> accel 23 | 24 | external i_eval : t -> float array -> float array -> float -> accel -> float 25 | = "ml_gsl_interp_eval" 26 | 27 | external i_eval_deriv : 28 | t -> float array -> float array -> float -> accel -> float 29 | = "ml_gsl_interp_eval_deriv" 30 | 31 | external i_eval_deriv2 : 32 | t -> float array -> float array -> float -> accel -> float 33 | = "ml_gsl_interp_eval_deriv2" 34 | 35 | external i_eval_integ : 36 | t -> float array -> float array -> float -> float -> accel -> float 37 | = "ml_gsl_interp_eval_integ_bc" "ml_gsl_interp_eval_integ" 38 | 39 | (** {3 Higher level functions} *) 40 | 41 | type interp = { 42 | interp : t; 43 | accel : accel; 44 | xa : float array; 45 | ya : float array; 46 | size : int; 47 | i_type : interp_type; 48 | } 49 | 50 | val make_interp : interp_type -> float array -> float array -> interp 51 | val eval : interp -> float -> float 52 | 53 | external eval_array : interp -> float array -> float array -> unit 54 | = "ml_gsl_interp_eval_array" 55 | (** [eval_array interp x_a y_a] fills the array [y_a] with the evaluation of the 56 | interpolation function [interp] for each point of array [x_a]. [x_a] and 57 | [y_a] must have the same length. *) 58 | 59 | val eval_deriv : interp -> float -> float 60 | val eval_deriv2 : interp -> float -> float 61 | val eval_integ : interp -> float -> float -> float 62 | -------------------------------------------------------------------------------- /lib/vector_complex.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Vector of complex numbers implemented with a [Bigarray] *) 6 | 7 | open Bigarray 8 | open Gsl_complex 9 | 10 | type complex_double_vector_bigarr = 11 | (Complex.t, complex64_elt, c_layout) Array1.t 12 | 13 | type vector = complex_double_vector_bigarr 14 | 15 | val create : ?init:complex -> int -> vector 16 | val of_array : complex array -> vector 17 | val to_array : vector -> complex array 18 | val of_complex_array : complex_array -> vector 19 | val to_complex_array : vector -> complex_array 20 | val length : vector -> int 21 | val get : vector -> int -> complex 22 | val set : vector -> int -> complex -> unit 23 | val set_all : vector -> complex -> unit 24 | val set_zero : vector -> unit 25 | val set_basis : vector -> int -> unit 26 | val memcpy : src:vector -> dst:vector -> unit 27 | val copy : vector -> vector 28 | val swap_element : vector -> int -> int -> unit 29 | val reverse : vector -> unit 30 | val subvector : vector -> off:int -> len:int -> vector 31 | 32 | module Single : sig 33 | type complex_float_vector_bigarr = 34 | (Complex.t, complex32_elt, c_layout) Array1.t 35 | 36 | type vector = complex_float_vector_bigarr 37 | 38 | val create : ?init:complex -> int -> vector 39 | val of_array : complex array -> vector 40 | val to_array : vector -> complex array 41 | val of_complex_array : complex_array -> vector 42 | val to_complex_array : vector -> complex_array 43 | val length : vector -> int 44 | val get : vector -> int -> complex 45 | val set : vector -> int -> complex -> unit 46 | val set_all : vector -> complex -> unit 47 | val set_zero : vector -> unit 48 | val set_basis : vector -> int -> unit 49 | val memcpy : src:vector -> dst:vector -> unit 50 | val copy : vector -> vector 51 | val swap_element : vector -> int -> int -> unit 52 | val reverse : vector -> unit 53 | val subvector : vector -> off:int -> len:int -> vector 54 | end 55 | -------------------------------------------------------------------------------- /lib/mlgsl_sum.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #include 8 | #include 9 | 10 | #include "wrappers.h" 11 | 12 | #define WS_val(v) ((gsl_sum_levin_u_workspace *)(Field((v), 0))) 13 | ML1_alloc(gsl_sum_levin_u_alloc, Int_val, Abstract_ptr) 14 | ML1(gsl_sum_levin_u_free, WS_val, Unit) 15 | 16 | CAMLprim value ml_gsl_sum_levin_u_accel(value arr, value ws) { 17 | double sum_accel, abserr; 18 | gsl_sum_levin_u_accel(Double_array_val(arr), Double_array_length(arr), 19 | WS_val(ws), &sum_accel, &abserr); 20 | return copy_two_double_arr(sum_accel, abserr); 21 | } 22 | 23 | CAMLprim value ml_gsl_sum_levin_u_getinfo(value ws) { 24 | gsl_sum_levin_u_workspace *W = WS_val(ws); 25 | CAMLparam0(); 26 | CAMLlocal2(v, s); 27 | s = caml_copy_double(W->sum_plain); 28 | v = caml_alloc_small(3, 0); 29 | Field(v, 0) = Val_int(W->size); 30 | Field(v, 1) = Val_int(W->terms_used); 31 | Field(v, 2) = s; 32 | CAMLreturn(v); 33 | } 34 | 35 | #define WStrunc_val(v) ((gsl_sum_levin_utrunc_workspace *)(Field((v), 0))) 36 | ML1_alloc(gsl_sum_levin_utrunc_alloc, Int_val, Abstract_ptr) 37 | ML1(gsl_sum_levin_utrunc_free, WStrunc_val, Unit) 38 | 39 | CAMLprim value ml_gsl_sum_levin_utrunc_accel(value arr, value ws) { 40 | double sum_accel, abserr; 41 | gsl_sum_levin_utrunc_accel(Double_array_val(arr), Double_array_length(arr), 42 | WStrunc_val(ws), &sum_accel, &abserr); 43 | return copy_two_double_arr(sum_accel, abserr); 44 | } 45 | 46 | CAMLprim value ml_gsl_sum_levin_utrunc_getinfo(value ws) { 47 | gsl_sum_levin_utrunc_workspace *W = WStrunc_val(ws); 48 | CAMLparam0(); 49 | CAMLlocal2(v, s); 50 | s = caml_copy_double(W->sum_plain); 51 | v = caml_alloc_small(3, 0); 52 | Field(v, 0) = Val_int(W->size); 53 | Field(v, 1) = Val_int(W->terms_used); 54 | Field(v, 2) = s; 55 | CAMLreturn(v); 56 | } 57 | -------------------------------------------------------------------------------- /lib/vector_flat.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Vector of floats implemented with a [float array] *) 6 | 7 | type double_vector_flat = private { 8 | data : float array; 9 | off : int; 10 | len : int; 11 | stride : int; 12 | } 13 | 14 | type vector = double_vector_flat 15 | 16 | val check : vector -> vector 17 | (** @raise Failure 18 | if [off], [len] or [stride] designate an invalid subvector of [data] *) 19 | 20 | (** {3 Operations} *) 21 | 22 | val create : ?init:float -> int -> vector 23 | val of_array : float array -> vector 24 | val to_array : vector -> float array 25 | val length : vector -> int 26 | val get : vector -> int -> float 27 | val set : vector -> int -> float -> unit 28 | val set_all : vector -> float -> unit 29 | val set_zero : vector -> unit 30 | val set_basis : vector -> int -> unit 31 | val memcpy : src:vector -> dst:vector -> unit 32 | val copy : vector -> vector 33 | val swap_element : vector -> int -> int -> unit 34 | val reverse : vector -> unit 35 | external add : vector -> vector -> unit = "ml_gsl_vector_add" 36 | external sub : vector -> vector -> unit = "ml_gsl_vector_sub" 37 | external mul : vector -> vector -> unit = "ml_gsl_vector_mul" 38 | external div : vector -> vector -> unit = "ml_gsl_vector_div" 39 | external scale : vector -> float -> unit = "ml_gsl_vector_scale" 40 | external add_constant : vector -> float -> unit = "ml_gsl_vector_add_constant" 41 | external is_null : vector -> bool = "ml_gsl_vector_isnull" 42 | external max : vector -> float = "ml_gsl_vector_max" 43 | external min : vector -> float = "ml_gsl_vector_min" 44 | external minmax : vector -> float * float = "ml_gsl_vector_minmax" 45 | external max_index : vector -> int = "ml_gsl_vector_maxindex" 46 | external min_index : vector -> int = "ml_gsl_vector_minindex" 47 | external minmax_index : vector -> int * int = "ml_gsl_vector_minmaxindex" 48 | 49 | (** {3 No-copy operations} *) 50 | 51 | val subvector : ?stride:int -> vector -> off:int -> len:int -> vector 52 | val view_array : ?stride:int -> ?off:int -> ?len:int -> float array -> vector 53 | -------------------------------------------------------------------------------- /lib/math.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | let e = 2.71828182845904523536028747135 (* e *) 7 | let log2e = 1.44269504088896340735992468100 (* log_2 (e) *) 8 | let log10e = 0.43429448190325182765112891892 (* log_10 (e) *) 9 | let sqrt2 = 1.41421356237309504880168872421 (* sqrt(2) *) 10 | let sqrt1_2 = 0.70710678118654752440084436210 (* sqrt(1/2) *) 11 | let sqrt3 = 1.73205080756887729352744634151 (* sqrt(3) *) 12 | let pi = 3.14159265358979323846264338328 (* pi *) 13 | let pi_2 = 1.57079632679489661923132169164 (* pi/2 *) 14 | let pi_4 = 0.78539816339744830966156608458 (* pi/4 *) 15 | let sqrtpi = 1.77245385090551602729816748334 (* sqrt(pi) *) 16 | let i_2_sqrtpi = 1.12837916709551257389615890312 (* 2/sqrt(pi) *) 17 | let i_1_pi = 0.31830988618379067153776752675 (* 1/pi *) 18 | let i_2_pi = 0.63661977236758134307553505349 (* 2/pi *) 19 | let ln10 = 2.30258509299404568401799145468 (* ln(10) *) 20 | let ln2 = 0.69314718055994530941723212146 (* ln(2) *) 21 | let lnpi = 1.14472988584940017414342735135 (* ln(pi) *) 22 | let euler = 0.57721566490153286060651209008 (* Euler constant *) 23 | 24 | let rec unsafe_pow_int x = function 25 | | 1 -> x 26 | | n when n mod 2 = 0 -> unsafe_pow_int (x *. x) (n / 2) 27 | | n -> x *. unsafe_pow_int x (pred n) 28 | 29 | let pow_int x = function 30 | | 0 -> 1. 31 | | n when n > 0 -> unsafe_pow_int x n 32 | | _ -> invalid_arg "pow_int" 33 | 34 | external log1p : float -> float = "ml_gsl_log1p" "gsl_log1p" 35 | [@@unboxed] [@@noalloc] 36 | 37 | external expm1 : float -> float = "ml_gsl_expm1" "gsl_expm1" 38 | [@@unboxed] [@@noalloc] 39 | 40 | external hypot : float -> float -> float = "ml_gsl_hypot" "gsl_hypot" 41 | [@@unboxed] [@@noalloc] 42 | 43 | external acosh : float -> float = "ml_gsl_acosh" "gsl_acosh" 44 | [@@unboxed] [@@noalloc] 45 | 46 | external asinh : float -> float = "ml_gsl_asinh" "gsl_asinh" 47 | [@@unboxed] [@@noalloc] 48 | 49 | external atanh : float -> float = "ml_gsl_atanh" "gsl_atanh" 50 | [@@unboxed] [@@noalloc] 51 | 52 | external fcmp : float -> float -> epsilon:float -> int = "ml_gsl_fcmp" 53 | -------------------------------------------------------------------------------- /examples/multifit_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let () = Error.init () 4 | 5 | let read_lines () = 6 | let acc = ref [] in 7 | let cnt = ref 0 in 8 | (try 9 | while true do 10 | acc := read_line () :: !acc; 11 | incr cnt 12 | done 13 | with End_of_file -> ()); 14 | Printf.printf "read %d points\n" !cnt; 15 | List.rev !acc 16 | 17 | exception Wrong_format 18 | 19 | let parse_input line = Scanf.sscanf line "%f %f %f" (fun a b c -> (a, b, c)) 20 | 21 | let parse_data lines = 22 | let n = List.length lines in 23 | let x = Array.make n 0. in 24 | let y = Array.make n 0. in 25 | let w = Array.make n 0. in 26 | let _ = 27 | List.fold_left 28 | (fun i line -> 29 | let xi, yi, ei = parse_input line in 30 | Printf.printf "%3g %.5g +/- %g\n" xi yi ei; 31 | x.(i) <- xi; 32 | y.(i) <- yi; 33 | w.(i) <- 1. /. (ei *. ei); 34 | succ i) 35 | 0 lines 36 | in 37 | print_newline (); 38 | (x, y, w) 39 | 40 | let setup (x, y, w) = 41 | let n = Array.length x in 42 | let x' = Matrix.create n 3 in 43 | let y' = Vector.of_array y in 44 | let w' = Vector.of_array w in 45 | for i = 0 to pred n do 46 | let xi = x.(i) in 47 | x'.{i, 0} <- 1.0; 48 | x'.{i, 1} <- xi; 49 | x'.{i, 2} <- xi *. xi 50 | done; 51 | (x', y', w') 52 | 53 | let fit (x, y, w) = 54 | let c, cov, chisq = Multifit.linear ~weight:(`V w) (`M x) (`V y) in 55 | Printf.printf "# best fit: Y = %g + %g X + %g X^2\n" c.{0} c.{1} c.{2}; 56 | Printf.printf "# covariance matrix:\n"; 57 | Printf.printf "[ %+.5e, %+.5e, %+.5e \n" cov.{0, 0} cov.{0, 1} cov.{0, 2}; 58 | Printf.printf " %+.5e, %+.5e, %+.5e \n" cov.{1, 0} cov.{1, 1} cov.{1, 2}; 59 | Printf.printf " %+.5e, %+.5e, %+.5e ]\n" cov.{2, 0} cov.{2, 1} cov.{2, 2}; 60 | Printf.printf "# chisq = %g\n" chisq 61 | 62 | let fit_alt (x, y, w) = 63 | let c, _cov, chisq = Multifit.fit_poly ~weight:w ~x ~y 3 in 64 | assert (Array.length c = 4); 65 | Printf.printf "# best fit: Y = %g + %g X + %g X^2 + %g X^3\n" c.(0) c.(1) 66 | c.(2) c.(3); 67 | Printf.printf "# chisq = %g\n" chisq 68 | 69 | let () = 70 | let data = parse_data (read_lines ()) in 71 | fit (setup data); 72 | print_newline (); 73 | fit_alt data 74 | -------------------------------------------------------------------------------- /examples/monte_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | open Math 3 | 4 | let _ = Error.init () 5 | 6 | let exact = 7 | let e = (Sf.gamma 0.25 ** 4.) /. (4. *. (pi ** 3.)) in 8 | Printf.printf "computing exact: %.9f\n" e; 9 | e 10 | 11 | let g = 12 | let a = 1. /. (pi *. pi *. pi) in 13 | fun x -> a /. (1. -. (cos x.(0) *. cos x.(1) *. cos x.(2))) 14 | 15 | let display_results title { Fun.res = result; Fun.err = error } = 16 | Printf.printf "%s ==================\n" title; 17 | Printf.printf "result = % .6f\n" result; 18 | Printf.printf "sigma = % .6f\n" error; 19 | Printf.printf "exact = % .6f\n" exact; 20 | Printf.printf "error = % .6f = %.1g sigma\n" (result -. exact) 21 | (abs_float (result -. exact) /. error) 22 | 23 | let compute rng = 24 | let lo = [| 0.; 0.; 0. |] in 25 | let up = [| pi; pi; pi |] in 26 | 27 | let gslfun = g in 28 | let calls = 500000 in 29 | 30 | (let res = Monte.integrate Monte.PLAIN gslfun ~lo ~up calls rng in 31 | display_results "PLAIN" res; 32 | print_newline ()); 33 | 34 | (let res = Monte.integrate Monte.MISER gslfun ~lo ~up calls rng in 35 | display_results "MISER" res; 36 | print_newline ()); 37 | 38 | let state = Monte.make_vegas_state 3 in 39 | let params = Monte.get_vegas_params state in 40 | let oc = open_out "truc" in 41 | Monte.set_vegas_params state 42 | { params with Monte.verbose = 0; Monte.ostream = Some oc }; 43 | let res = Monte.integrate_vegas gslfun ~lo ~up 10000 rng state in 44 | display_results "VEGAS warm-up" res; 45 | Printf.printf "converging...\n"; 46 | flush stdout; 47 | let rec proc () = 48 | let ({ Fun.res = result; Fun.err } as res) = 49 | Monte.integrate_vegas gslfun ~lo ~up (calls / 5) rng state 50 | in 51 | let { Monte.chisq } = Monte.get_vegas_info state in 52 | Printf.printf "result = % .6f sigma = % .6f chisq/dof = %.1f\n" result err 53 | chisq; 54 | flush stdout; 55 | if abs_float (chisq -. 1.) > 0.5 then proc () else res 56 | in 57 | let res_final = proc () in 58 | display_results "VEGAS final" res_final; 59 | close_out oc 60 | 61 | let _ = 62 | Rng.env_setup (); 63 | let rng = Rng.make (Rng.default ()) in 64 | Printf.printf "using %s RNG\n" (Rng.name rng); 65 | print_newline (); 66 | compute rng 67 | -------------------------------------------------------------------------------- /lib/multimin.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | open Fun 8 | open Vector 9 | 10 | module Deriv = struct 11 | type kind = 12 | | CONJUGATE_FR 13 | | CONJUGATE_PR 14 | | VECTOR_BFGS 15 | | VECTOR_BFGS2 16 | | STEEPEST_DESCENT 17 | 18 | type t 19 | 20 | external _alloc : kind -> int -> t = "ml_gsl_multimin_fdfminimizer_alloc" 21 | external _free : t -> unit = "ml_gsl_multimin_fdfminimizer_free" 22 | 23 | external _set : 24 | t -> multim_fun_fdf -> x:vector -> step:float -> tol:float -> unit 25 | = "ml_gsl_multimin_fdfminimizer_set" 26 | 27 | let make kind dim gf ~x ~step ~tol = 28 | let mini = _alloc kind dim in 29 | Gc.finalise _free mini; 30 | _set mini gf ~x ~step ~tol; 31 | mini 32 | 33 | external name : t -> string = "ml_gsl_multimin_fdfminimizer_name" 34 | external iterate : t -> unit = "ml_gsl_multimin_fdfminimizer_iterate" 35 | external restart : t -> unit = "ml_gsl_multimin_fdfminimizer_restart" 36 | 37 | external minimum : ?x:vector -> ?dx:vector -> ?g:vector -> t -> float 38 | = "ml_gsl_multimin_fdfminimizer_minimum" 39 | 40 | external test_gradient : t -> float -> bool = "ml_gsl_multimin_test_gradient" 41 | end 42 | 43 | module NoDeriv = struct 44 | type kind = NM_SIMPLEX 45 | type t 46 | 47 | external _alloc : kind -> int -> t = "ml_gsl_multimin_fminimizer_alloc" 48 | external _free : t -> unit = "ml_gsl_multimin_fminimizer_free" 49 | 50 | external _set : t -> multim_fun -> x:vector -> step_size:vector -> unit 51 | = "ml_gsl_multimin_fminimizer_set" 52 | 53 | let make kind dim gf ~x ~step_size = 54 | let mini = _alloc kind dim in 55 | Gc.finalise _free mini; 56 | _set mini gf ~x ~step_size; 57 | mini 58 | 59 | external name : t -> string = "ml_gsl_multimin_fminimizer_name" 60 | external iterate : t -> unit = "ml_gsl_multimin_fminimizer_iterate" 61 | 62 | external minimum : ?x:vector -> t -> float 63 | = "ml_gsl_multimin_fminimizer_minimum" 64 | 65 | external size : t -> float = "ml_gsl_multimin_fminimizer_size" 66 | external test_size : t -> float -> bool = "ml_gsl_multimin_test_size" 67 | end 68 | -------------------------------------------------------------------------------- /lib/config/discover.ml: -------------------------------------------------------------------------------- 1 | module Option = struct 2 | include Option 3 | 4 | let value_map ~default ~f = function Some x -> f x | None -> default 5 | end 6 | (* Option *) 7 | 8 | module List = struct 9 | include List 10 | 11 | let find_map t ~f = 12 | let rec loop = function 13 | | [] -> None 14 | | x :: l -> ( match f x with None -> loop l | Some _ as r -> r) 15 | in 16 | loop t 17 | end 18 | (* List *) 19 | 20 | let () = 21 | let module C = Configurator.V1 in 22 | let open C.Pkg_config in 23 | C.main ~name:"gsl" (fun c -> 24 | let conf = 25 | let default = 26 | { libs = [ "-lgsl"; "-lgslcblas"; "-lm" ]; cflags = [] } 27 | in 28 | let write_gsl_include = C.Flags.write_lines "gsl_include.sexp" in 29 | let default_gsl_include = [ "/usr/include" ] in 30 | match C.Pkg_config.get c with 31 | | None -> 32 | write_gsl_include default_gsl_include; 33 | default 34 | | Some pc -> 35 | Option.value_map ~default (C.Pkg_config.query pc ~package:"gsl") 36 | ~f:(fun conf -> 37 | let gsl_include = 38 | Option.value ~default:default_gsl_include 39 | @@ List.find_map conf.cflags ~f:(fun cflag -> 40 | let len = String.length cflag in 41 | if len >= 2 && cflag.[0] = '-' && cflag.[1] = 'I' then 42 | Some [ String.sub cflag 2 (len - 2) ] 43 | else None) 44 | in 45 | write_gsl_include gsl_include; 46 | conf) 47 | in 48 | let conf = 49 | let without_cblas () = 50 | List.filter (fun x -> not (String.equal x "-lgslcblas")) conf.libs 51 | in 52 | match Sys.getenv_opt "GSL_CBLAS_LIB" with 53 | | Some alt_blas -> { conf with libs = without_cblas () @ [ alt_blas ] } 54 | | None -> 55 | Option.value_map ~default:conf (C.ocaml_config_var c "system") 56 | ~f:(function 57 | | "macosx" -> 58 | let libs = "-framework" :: "Accelerate" :: without_cblas () in 59 | { conf with libs } 60 | | _ -> conf) 61 | in 62 | C.Flags.write_sexp "c_flags.sexp" conf.cflags; 63 | C.Flags.write_sexp "c_library_flags.sexp" conf.libs) 64 | -------------------------------------------------------------------------------- /lib/stats.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | external mean : ?w:float array -> float array -> float = "ml_gsl_stats_mean" 8 | 9 | external variance : ?w:float array -> ?mean:float -> float array -> float 10 | = "ml_gsl_stats_variance" 11 | 12 | external sd : ?w:float array -> ?mean:float -> float array -> float 13 | = "ml_gsl_stats_sd" 14 | 15 | external variance_with_fixed_mean : 16 | ?w:float array -> mean:float -> float array -> float 17 | = "ml_gsl_stats_variance_with_fixed_mean" 18 | 19 | external sd_with_fixed_mean : 20 | ?w:float array -> mean:float -> float array -> float 21 | = "ml_gsl_stats_sd_with_fixed_mean" 22 | 23 | external absdev : ?w:float array -> ?mean:float -> float array -> float 24 | = "ml_gsl_stats_absdev" 25 | 26 | external skew : ?w:float array -> float array -> float = "ml_gsl_stats_skew" 27 | 28 | external skew_m_sd : 29 | ?w:float array -> mean:float -> sd:float -> float array -> float 30 | = "ml_gsl_stats_skew_m_sd" 31 | 32 | external kurtosis : ?w:float array -> float array -> float 33 | = "ml_gsl_stats_kurtosis" 34 | 35 | external kurtosis_m_sd : 36 | ?w:float array -> mean:float -> sd:float -> float array -> float 37 | = "ml_gsl_stats_kurtosis_m_sd" 38 | 39 | external lag1_autocorrelation : ?mean:float -> float array -> float 40 | = "ml_gsl_stats_lag1_autocorrelation" 41 | 42 | external covariance : float array -> float array -> float 43 | = "ml_gsl_stats_covariance" 44 | 45 | external covariance_m : 46 | mean1:float -> float array -> mean2:float -> float array -> float 47 | = "ml_gsl_stats_covariance_m" 48 | 49 | external max : float array -> float = "ml_gsl_stats_max" 50 | external min : float array -> float = "ml_gsl_stats_min" 51 | external minmax : float array -> float * float = "ml_gsl_stats_minmax" 52 | external max_index : float array -> int = "ml_gsl_stats_max_index" 53 | external min_index : float array -> int = "ml_gsl_stats_min_index" 54 | external minmax_index : float array -> int * int = "ml_gsl_stats_minmax_index" 55 | 56 | external quantile_from_sorted_data : float array -> float -> float 57 | = "ml_gsl_stats_quantile_from_sorted_data" 58 | 59 | external correlation : float array -> float array -> float 60 | = "ml_gsl_stats_correlation" 61 | -------------------------------------------------------------------------------- /lib/stats.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Statistics *) 6 | 7 | external mean : ?w:float array -> float array -> float = "ml_gsl_stats_mean" 8 | 9 | external variance : ?w:float array -> ?mean:float -> float array -> float 10 | = "ml_gsl_stats_variance" 11 | 12 | external sd : ?w:float array -> ?mean:float -> float array -> float 13 | = "ml_gsl_stats_sd" 14 | 15 | external variance_with_fixed_mean : 16 | ?w:float array -> mean:float -> float array -> float 17 | = "ml_gsl_stats_variance_with_fixed_mean" 18 | 19 | external sd_with_fixed_mean : 20 | ?w:float array -> mean:float -> float array -> float 21 | = "ml_gsl_stats_sd_with_fixed_mean" 22 | 23 | external absdev : ?w:float array -> ?mean:float -> float array -> float 24 | = "ml_gsl_stats_absdev" 25 | 26 | external skew : ?w:float array -> float array -> float = "ml_gsl_stats_skew" 27 | 28 | external skew_m_sd : 29 | ?w:float array -> mean:float -> sd:float -> float array -> float 30 | = "ml_gsl_stats_skew_m_sd" 31 | 32 | external kurtosis : ?w:float array -> float array -> float 33 | = "ml_gsl_stats_kurtosis" 34 | 35 | external kurtosis_m_sd : 36 | ?w:float array -> mean:float -> sd:float -> float array -> float 37 | = "ml_gsl_stats_kurtosis_m_sd" 38 | 39 | external lag1_autocorrelation : ?mean:float -> float array -> float 40 | = "ml_gsl_stats_lag1_autocorrelation" 41 | 42 | external covariance : float array -> float array -> float 43 | = "ml_gsl_stats_covariance" 44 | 45 | external covariance_m : 46 | mean1:float -> float array -> mean2:float -> float array -> float 47 | = "ml_gsl_stats_covariance_m" 48 | 49 | external max : float array -> float = "ml_gsl_stats_max" 50 | external min : float array -> float = "ml_gsl_stats_min" 51 | external minmax : float array -> float * float = "ml_gsl_stats_minmax" 52 | external max_index : float array -> int = "ml_gsl_stats_max_index" 53 | external min_index : float array -> int = "ml_gsl_stats_min_index" 54 | external minmax_index : float array -> int * int = "ml_gsl_stats_minmax_index" 55 | 56 | external quantile_from_sorted_data : float array -> float -> float 57 | = "ml_gsl_stats_quantile_from_sorted_data" 58 | 59 | external correlation : float array -> float array -> float 60 | = "ml_gsl_stats_correlation" 61 | -------------------------------------------------------------------------------- /lib/odeiv.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Ordinary Differential Equations *) 6 | 7 | type system 8 | 9 | val make_system : 10 | (float -> float array -> float array -> unit) -> 11 | ?jac:(float -> float array -> Matrix.matrix -> float array -> unit) -> 12 | int -> 13 | system 14 | 15 | type step 16 | 17 | type step_kind = 18 | | RK2 19 | | RK4 20 | | RKF45 21 | | RKCK 22 | | RK8PD 23 | | RK2IMP 24 | | RK2SIMP 25 | | RK4IMP 26 | | BSIMP 27 | | GEAR1 28 | | GEAR2 29 | 30 | val make_step : step_kind -> dim:int -> step 31 | external step_reset : step -> unit = "ml_gsl_odeiv_step_reset" 32 | external step_name : step -> string = "ml_gsl_odeiv_step_name" 33 | external step_order : step -> int = "ml_gsl_odeiv_step_order" 34 | 35 | external step_apply : 36 | step -> 37 | t:float -> 38 | h:float -> 39 | y:float array -> 40 | yerr:float array -> 41 | ?dydt_in:float array -> 42 | ?dydt_out:float array -> 43 | system -> 44 | unit = "ml_gsl_odeiv_step_apply_bc" "ml_gsl_odeiv_step_apply" 45 | 46 | type control 47 | 48 | val make_control_standard_new : 49 | eps_abs:float -> eps_rel:float -> a_y:float -> a_dydt:float -> control 50 | 51 | val make_control_y_new : eps_abs:float -> eps_rel:float -> control 52 | val make_control_yp_new : eps_abs:float -> eps_rel:float -> control 53 | 54 | val make_control_scaled_new : 55 | eps_abs:float -> 56 | eps_rel:float -> 57 | a_y:float -> 58 | a_dydt:float -> 59 | scale_abs:float array -> 60 | control 61 | 62 | external control_name : control -> string = "ml_gsl_odeiv_control_name" 63 | 64 | type hadjust = HADJ_DEC | HADJ_NIL | HADJ_INC 65 | 66 | external control_hadjust : 67 | control -> 68 | step -> 69 | y:float array -> 70 | yerr:float array -> 71 | dydt:float array -> 72 | h:float -> 73 | hadjust * float 74 | = "ml_gsl_odeiv_control_hadjust_bc" "ml_gsl_odeiv_control_hadjust" 75 | 76 | type evolve 77 | 78 | val make_evolve : int -> evolve 79 | external evolve_reset : evolve -> unit = "ml_gsl_odeiv_evolve_reset" 80 | 81 | external evolve_apply : 82 | evolve -> 83 | control -> 84 | step -> 85 | system -> 86 | t:float -> 87 | t1:float -> 88 | h:float -> 89 | y:float array -> 90 | float * float = "ml_gsl_odeiv_evolve_apply_bc" "ml_gsl_odeiv_evolve_apply" 91 | -------------------------------------------------------------------------------- /examples/root_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | 3 | let _ = Error.init () 4 | 5 | let quad a b c x = 6 | (* Gc.major () ; *) 7 | (((a *. x) +. b) *. x) +. c 8 | 9 | let quad_deriv a b x = (2. *. a *. x) +. b 10 | 11 | let quad_fdf a b c x = 12 | let y = (((a *. x) +. b) *. x) +. c in 13 | let dy = (2. *. a *. x) +. b in 14 | (y, dy) 15 | 16 | let a, b, c = (1., 0., -5.0) 17 | let r_expected = sqrt 5.0 18 | 19 | open Root.Bracket 20 | 21 | let find_f ?(max_iter = 100) s = 22 | Printf.printf "\nusing %s method\n" (name s); 23 | Printf.printf "%5s [%9s, %9s] %9s %10s %9s\n" "iter" "lower" "upper" "root" 24 | "err" "err(est)"; 25 | let rec proc i = function 26 | | true -> () 27 | | _ when i >= max_iter -> () 28 | | _ -> 29 | iterate s; 30 | let r = root s in 31 | let x_lo, x_hi = interval s in 32 | let status = 33 | Root.test_interval ~lo:x_lo ~up:x_hi ~epsabs:0. ~epsrel:0.001 34 | in 35 | if status then Printf.printf "Converged:\n"; 36 | Printf.printf "%5d [%.7f, %.7f] %.7f %+.7f %.7f\n" i x_lo x_hi r 37 | (r -. r_expected) (x_hi -. x_lo); 38 | proc (succ i) status 39 | in 40 | proc 1 false 41 | 42 | open Root.Polish 43 | 44 | let find_fdf ?(max_iter = 100) s x_init = 45 | Printf.printf "\nusing %s method\n" (name s); 46 | Printf.printf "%-5s %10s %10s %10s\n" "iter" "root" "err" "err(est)"; 47 | let rec proc i x0 = function 48 | | true -> () 49 | | _ when i >= max_iter -> () 50 | | _ -> 51 | iterate s; 52 | let x = root s in 53 | let status = Root.test_delta ~x1:x ~x0 ~epsabs:0. ~epsrel:1e-3 in 54 | if status then Printf.printf "Converged:\n"; 55 | Printf.printf "%5d %10.7f %+10.7f %10.7f\n" i x (x -. r_expected) 56 | (x -. x0); 57 | proc (succ i) x status 58 | in 59 | proc 1 x_init false 60 | 61 | let _ = 62 | let gslfun = quad a b c in 63 | List.iter 64 | (fun t -> 65 | let s = Root.Bracket.make t gslfun 0. 5. in 66 | find_f s) 67 | [ Root.Bracket.BISECTION; Root.Bracket.FALSEPOS; Root.Bracket.BRENT ] 68 | 69 | let _ = 70 | print_newline (); 71 | flush stdout 72 | 73 | let _ = 74 | let gslfun_fdf = 75 | { Fun.f = quad a b c; Fun.df = quad_deriv a b; Fun.fdf = quad_fdf a b c } 76 | in 77 | List.iter 78 | (fun t -> 79 | let s = Root.Polish.make t gslfun_fdf 5. in 80 | find_fdf s 5.) 81 | [ Root.Polish.NEWTON; Root.Polish.SECANT; Root.Polish.STEFFENSON ] 82 | -------------------------------------------------------------------------------- /lib/histo.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Histograms *) 6 | 7 | type t = private { 8 | n : int; (** number of histogram bins *) 9 | range : float array; (** ranges of the bins ; n+1 elements *) 10 | bin : float array; (** counts for each bin ; n elements *) 11 | } 12 | (** The histogram type *) 13 | 14 | val check : t -> bool 15 | 16 | (** {3 Allocating histograms} *) 17 | 18 | val make : int -> t 19 | val copy : t -> t 20 | external set_ranges : t -> float array -> unit = "ml_gsl_histogram_set_ranges" 21 | 22 | external set_ranges_uniform : t -> xmin:float -> xmax:float -> unit 23 | = "ml_gsl_histogram_set_ranges_uniform" 24 | 25 | (** {3 Updating and accessing histogram elements} *) 26 | 27 | external accumulate : t -> ?w:float -> float -> unit 28 | = "ml_gsl_histogram_accumulate" 29 | 30 | val get : t -> int -> float 31 | val get_range : t -> int -> float * float 32 | val h_max : t -> float 33 | val h_min : t -> float 34 | val bins : t -> int 35 | val reset : t -> unit 36 | 37 | (** {3 Searching histogram ranges} *) 38 | 39 | external find : t -> float -> int = "ml_gsl_histogram_find" 40 | 41 | (** {3 Histograms statistics} *) 42 | 43 | external max_val : t -> float = "ml_gsl_histogram_max_val" 44 | external max_bin : t -> int = "ml_gsl_histogram_max_bin" 45 | external min_val : t -> float = "ml_gsl_histogram_min_val" 46 | external min_bin : t -> int = "ml_gsl_histogram_min_bin" 47 | external mean : t -> float = "ml_gsl_histogram_mean" 48 | external sigma : t -> float = "ml_gsl_histogram_sigma" 49 | external sum : t -> float = "ml_gsl_histogram_sum" 50 | 51 | (** {3 Histogram operations} *) 52 | 53 | external equal_bins_p : t -> t -> bool = "ml_gsl_histogram_equal_bins_p" 54 | external add : t -> t -> unit = "ml_gsl_histogram_add" 55 | external sub : t -> t -> unit = "ml_gsl_histogram_sub" 56 | external mul : t -> t -> unit = "ml_gsl_histogram_mul" 57 | external div : t -> t -> unit = "ml_gsl_histogram_div" 58 | external scale : t -> float -> unit = "ml_gsl_histogram_scale" 59 | external shift : t -> float -> unit = "ml_gsl_histogram_shift" 60 | 61 | (** {3 Resampling} *) 62 | 63 | type histo_pdf = private { 64 | pdf_n : int; 65 | pdf_range : float array; 66 | pdf_sum : float array; 67 | } 68 | 69 | val init : t -> histo_pdf 70 | external sample : histo_pdf -> float -> float = "ml_gsl_histogram_pdf_sample" 71 | -------------------------------------------------------------------------------- /lib/matrix_flat.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Matrices of floats implemented with [float array] *) 6 | 7 | type double_mat_flat = private { 8 | data : float array; 9 | off : int; 10 | dim1 : int; 11 | dim2 : int; 12 | tda : int; 13 | } 14 | 15 | type matrix = double_mat_flat 16 | 17 | val create : ?init:float -> int -> int -> matrix 18 | val dims : matrix -> int * int 19 | val of_array : float array -> int -> int -> matrix 20 | val of_arrays : float array array -> matrix 21 | val to_array : matrix -> float array 22 | val to_arrays : matrix -> float array array 23 | val get : matrix -> int -> int -> float 24 | val set : matrix -> int -> int -> float -> unit 25 | val set_all : matrix -> float -> unit 26 | val set_zero : matrix -> unit 27 | val set_id : matrix -> unit 28 | val memcpy : src:matrix -> dst:matrix -> unit 29 | val copy : matrix -> matrix 30 | external add : matrix -> matrix -> unit = "ml_gsl_matrix_add" 31 | external sub : matrix -> matrix -> unit = "ml_gsl_matrix_sub" 32 | external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_mul" 33 | external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_div" 34 | external scale : matrix -> float -> unit = "ml_gsl_matrix_scale" 35 | external add_constant : matrix -> float -> unit = "ml_gsl_matrix_add_constant" 36 | external add_diagonal : matrix -> float -> unit = "ml_gsl_matrix_add_diagonal" 37 | external is_null : matrix -> bool = "ml_gsl_matrix_isnull" 38 | external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_rows" 39 | 40 | external swap_columns : matrix -> int -> int -> unit 41 | = "ml_gsl_matrix_swap_columns" 42 | 43 | external swap_rowcol : matrix -> int -> int -> unit 44 | = "ml_gsl_matrix_swap_rowcol" 45 | 46 | external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_transpose_memcpy" 47 | external transpose_in_place : matrix -> unit = "ml_gsl_matrix_transpose" 48 | 49 | open Vector_flat 50 | 51 | val submatrix : matrix -> k1:int -> k2:int -> n1:int -> n2:int -> matrix 52 | val row : matrix -> int -> vector 53 | val column : matrix -> int -> vector 54 | val diagonal : matrix -> vector 55 | val subdiagonal : matrix -> int -> vector 56 | val superdiagonal : matrix -> int -> vector 57 | val view_array : float array -> ?off:int -> int -> ?tda:int -> int -> matrix 58 | val view_vector : vector -> ?off:int -> int -> ?tda:int -> int -> matrix 59 | -------------------------------------------------------------------------------- /lib/multiroot.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | open Fun 8 | open Vector 9 | 10 | module NoDeriv = struct 11 | type kind = HYBRIDS | HYBRID | DNEWTON | BROYDEN 12 | type t 13 | 14 | external _alloc : kind -> int -> t = "ml_gsl_multiroot_fsolver_alloc" 15 | external _free : t -> unit = "ml_gsl_multiroot_fsolver_free" 16 | 17 | external _set : t -> multi_fun -> vector -> unit 18 | = "ml_gsl_multiroot_fsolver_set" 19 | 20 | let make kind dim f x = 21 | let s = _alloc kind dim in 22 | Gc.finalise _free s; 23 | _set s f x; 24 | s 25 | 26 | external name : t -> string = "ml_gsl_multiroot_fsolver_name" 27 | external iterate : t -> unit = "ml_gsl_multiroot_fsolver_iterate" 28 | external root : t -> vector -> unit = "ml_gsl_multiroot_fsolver_root" 29 | 30 | external get_state : t -> ?x:vector -> ?f:vector -> ?dx:vector -> unit -> unit 31 | = "ml_gsl_multiroot_fsolver_get_state" 32 | 33 | external test_delta : t -> epsabs:float -> epsrel:float -> bool 34 | = "ml_gsl_multiroot_test_delta_f" 35 | 36 | external test_residual : t -> epsabs:float -> bool 37 | = "ml_gsl_multiroot_test_residual_f" 38 | end 39 | 40 | module Deriv = struct 41 | type kind = HYBRIDSJ | HYBRIDJ | NEWTON | GNEWTON 42 | type t 43 | 44 | external _alloc : kind -> int -> t = "ml_gsl_multiroot_fdfsolver_alloc" 45 | external _free : t -> unit = "ml_gsl_multiroot_fdfsolver_free" 46 | 47 | external _set : t -> multi_fun_fdf -> vector -> unit 48 | = "ml_gsl_multiroot_fdfsolver_set" 49 | 50 | let make kind dim f x = 51 | let s = _alloc kind dim in 52 | Gc.finalise _free s; 53 | _set s f x; 54 | s 55 | 56 | external name : t -> string = "ml_gsl_multiroot_fdfsolver_name" 57 | external root : t -> vector -> unit = "ml_gsl_multiroot_fdfsolver_root" 58 | external iterate : t -> unit = "ml_gsl_multiroot_fdfsolver_iterate" 59 | 60 | external get_state : 61 | t -> 62 | ?x:vector -> 63 | ?f:vector -> 64 | ?j:Matrix.matrix -> 65 | ?dx:vector -> 66 | unit -> 67 | unit 68 | = "ml_gsl_multiroot_fdfsolver_get_state_bc" 69 | "ml_gsl_multiroot_fdfsolver_get_state" 70 | 71 | external test_delta : t -> epsabs:float -> epsrel:float -> bool 72 | = "ml_gsl_multiroot_test_delta_fdf" 73 | 74 | external test_residual : t -> epsabs:float -> bool 75 | = "ml_gsl_multiroot_test_residual_fdf" 76 | end 77 | -------------------------------------------------------------------------------- /lib/mlgsl_min.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #include 8 | #include 9 | #include 10 | 11 | #include "mlgsl_fun.h" 12 | #include "wrappers.h" 13 | 14 | static const gsl_min_fminimizer_type *Minimizertype_val(value mini_type) { 15 | const gsl_min_fminimizer_type *minimizer[] = { 16 | gsl_min_fminimizer_goldensection, gsl_min_fminimizer_brent}; 17 | return minimizer[Int_val(mini_type)]; 18 | } 19 | 20 | CAMLprim value ml_gsl_min_fminimizer_alloc(value t) { 21 | CAMLparam0(); 22 | CAMLlocal1(res); 23 | struct callback_params *params; 24 | gsl_min_fminimizer *s; 25 | 26 | s = gsl_min_fminimizer_alloc(Minimizertype_val(t)); 27 | params = caml_stat_alloc(sizeof *params); 28 | 29 | res = caml_alloc_small(2, Abstract_tag); 30 | Field(res, 0) = (value)s; 31 | Field(res, 1) = (value)params; 32 | params->gslfun.gf.function = &gslfun_callback; 33 | params->gslfun.gf.params = params; 34 | params->closure = Val_unit; 35 | params->dbl = Val_unit; 36 | caml_register_global_root(&(params->closure)); 37 | CAMLreturn(res); 38 | } 39 | #define Minimizer_val(v) ((gsl_min_fminimizer *)Field((v), 0)) 40 | #define Mparams_val(v) ((struct callback_params *)Field((v), 1)) 41 | 42 | CAMLprim value ml_gsl_min_fminimizer_set(value s, value f, value min, value lo, 43 | value up) { 44 | CAMLparam1(s); 45 | Mparams_val(s)->closure = f; 46 | gsl_min_fminimizer_set(Minimizer_val(s), &(Mparams_val(s)->gslfun.gf), 47 | Double_val(min), Double_val(lo), Double_val(up)); 48 | CAMLreturn(Val_unit); 49 | } 50 | 51 | CAMLprim value ml_gsl_min_fminimizer_free(value s) { 52 | caml_remove_global_root(&(Mparams_val(s)->closure)); 53 | caml_stat_free(Mparams_val(s)); 54 | gsl_min_fminimizer_free(Minimizer_val(s)); 55 | return Val_unit; 56 | } 57 | 58 | ML1(gsl_min_fminimizer_name, Minimizer_val, caml_copy_string) 59 | 60 | ML1(gsl_min_fminimizer_iterate, Minimizer_val, Unit) 61 | 62 | ML1(gsl_min_fminimizer_x_minimum, Minimizer_val, caml_copy_double) 63 | 64 | CAMLprim value ml_gsl_min_fminimizer_x_interv(value S) { 65 | return copy_two_double(gsl_min_fminimizer_x_lower(Minimizer_val(S)), 66 | gsl_min_fminimizer_x_upper(Minimizer_val(S))); 67 | } 68 | 69 | ML4(gsl_min_test_interval, Double_val, Double_val, Double_val, Double_val, 70 | Val_negbool) 71 | -------------------------------------------------------------------------------- /lib/gsl_sort.ml: -------------------------------------------------------------------------------- 1 | let () = Error.init () 2 | 3 | external vector : Vector.vector -> unit = "ml_gsl_sort_vector" 4 | 5 | external _vector_index : Permut.permut -> Vector.vector -> unit 6 | = "ml_gsl_sort_vector_index" 7 | 8 | let vector_index v = 9 | let p = Permut.create (Vector.length v) in 10 | _vector_index p v; 11 | p 12 | 13 | external _vector_smallest : float array -> Vector.vector -> unit 14 | = "ml_gsl_sort_vector_smallest" 15 | 16 | external _vector_largest : float array -> Vector.vector -> unit 17 | = "ml_gsl_sort_vector_largest" 18 | 19 | let vector_smallest k v = 20 | let dest = Array.make k 0. in 21 | _vector_smallest dest v; 22 | dest 23 | 24 | let vector_largest k v = 25 | let dest = Array.make k 0. in 26 | _vector_largest dest v; 27 | dest 28 | 29 | external _vector_smallest_index : Permut.permut -> Vector.vector -> unit 30 | = "ml_gsl_sort_vector_smallest_index" 31 | 32 | external _vector_largest_index : Permut.permut -> Vector.vector -> unit 33 | = "ml_gsl_sort_vector_largest_index" 34 | 35 | let vector_smallest_index k v = 36 | let p = Permut.create k in 37 | _vector_smallest_index p v; 38 | p 39 | 40 | let vector_largest_index k v = 41 | let p = Permut.create k in 42 | _vector_largest_index p v; 43 | p 44 | 45 | external vector_flat : Vector_flat.vector -> unit = "ml_gsl_sort_vector" 46 | 47 | external _vector_flat_index : Permut.permut -> Vector_flat.vector -> unit 48 | = "ml_gsl_sort_vector_index" 49 | 50 | let vector_flat_index v = 51 | let p = Permut.create (Vector_flat.length v) in 52 | _vector_flat_index p v; 53 | p 54 | 55 | external _vector_flat_smallest : float array -> Vector_flat.vector -> unit 56 | = "ml_gsl_sort_vector_smallest" 57 | 58 | external _vector_flat_largest : float array -> Vector_flat.vector -> unit 59 | = "ml_gsl_sort_vector_largest" 60 | 61 | let vector_flat_smallest k v = 62 | let dest = Array.make k 0. in 63 | _vector_flat_smallest dest v; 64 | dest 65 | 66 | let vector_flat_largest k v = 67 | let dest = Array.make k 0. in 68 | _vector_flat_largest dest v; 69 | dest 70 | 71 | external _vector_flat_smallest_index : 72 | Permut.permut -> Vector_flat.vector -> unit 73 | = "ml_gsl_sort_vector_smallest_index" 74 | 75 | external _vector_flat_largest_index : 76 | Permut.permut -> Vector_flat.vector -> unit 77 | = "ml_gsl_sort_vector_largest_index" 78 | 79 | let vector_flat_smallest_index k v = 80 | let p = Permut.create k in 81 | _vector_flat_smallest_index p v; 82 | p 83 | 84 | let vector_flat_largest_index k v = 85 | let p = Permut.create k in 86 | _vector_flat_largest_index p v; 87 | p 88 | -------------------------------------------------------------------------------- /lib/mlgsl_fun.h: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | #include 12 | #include 13 | 14 | struct callback_params { 15 | value closure; /* the closure(s) for the caml callback */ 16 | value dbl; /* a preallocated caml float array for monte callbacks */ 17 | union { 18 | gsl_function gf; 19 | gsl_function_fdf gfdf; 20 | gsl_monte_function mf; 21 | gsl_multiroot_function mrf; 22 | gsl_multiroot_function_fdf mrfdf; 23 | gsl_multimin_function mmf; 24 | gsl_multimin_function_fdf mmfdf; 25 | gsl_multifit_function_fdf mffdf; 26 | } gslfun; 27 | }; 28 | 29 | extern double gslfun_callback(double, void *); 30 | extern double gslfun_callback_indir(double, void *); 31 | 32 | extern double gslfun_callback_f(double, void *); 33 | extern double gslfun_callback_df(double, void *); 34 | extern void gslfun_callback_fdf(double, void *, double *, double *); 35 | 36 | extern double gsl_monte_callback(double *, size_t, void *); 37 | extern double gsl_monte_callback_fast(double *, size_t, void *); 38 | 39 | extern int gsl_multiroot_callback(const gsl_vector *, void *, gsl_vector *); 40 | extern int gsl_multiroot_callback_f(const gsl_vector *, void *, gsl_vector *); 41 | extern int gsl_multiroot_callback_df(const gsl_vector *, void *, gsl_matrix *); 42 | extern int gsl_multiroot_callback_fdf(const gsl_vector *, void *, gsl_vector *, 43 | gsl_matrix *); 44 | 45 | extern double gsl_multimin_callback(const gsl_vector *, void *); 46 | extern double gsl_multimin_callback_f(const gsl_vector *, void *); 47 | extern void gsl_multimin_callback_df(const gsl_vector *, void *, gsl_vector *); 48 | extern void gsl_multimin_callback_fdf(const gsl_vector *, void *, double *, 49 | gsl_vector *); 50 | 51 | extern int gsl_multifit_callback_f(const gsl_vector *, void *, gsl_vector *); 52 | extern int gsl_multifit_callback_df(const gsl_vector *, void *, gsl_matrix *); 53 | extern int gsl_multifit_callback_fdf(const gsl_vector *, void *, gsl_vector *, 54 | gsl_matrix *); 55 | 56 | #define GSLFUN_CLOSURE(gf, v) \ 57 | gsl_function gf = {/*.function =*/&gslfun_callback_indir, /*.params =*/&v} 58 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix.h: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | #include 7 | 8 | #include "wrappers.h" 9 | 10 | #ifndef TYPE 11 | #error pb with include files 12 | #endif 13 | 14 | static inline void TYPE(mlgsl_mat_of_bigarray)(TYPE(gsl_matrix) * cmat, 15 | value vmat) { 16 | struct caml_ba_array *bigarr = Caml_ba_array_val(vmat); 17 | cmat->block = NULL; 18 | cmat->owner = 0; 19 | cmat->size1 = bigarr->dim[0]; 20 | cmat->size2 = bigarr->dim[1]; 21 | cmat->tda = bigarr->dim[1]; 22 | cmat->data = bigarr->data; 23 | } 24 | 25 | #ifdef CONV_FLAT 26 | static inline void TYPE(mlgsl_mat_of_floatarray)(TYPE(gsl_matrix) * cmat, 27 | value vmat) { 28 | cmat->block = NULL; 29 | cmat->owner = 0; 30 | cmat->size1 = Int_val(Field(vmat, 2)); 31 | cmat->size2 = Int_val(Field(vmat, 3)); 32 | cmat->tda = Int_val(Field(vmat, 4)); 33 | cmat->data = (double *)Field(vmat, 0) + Int_val(Field(vmat, 1)); 34 | } 35 | #endif 36 | 37 | static inline void TYPE(mlgsl_mat_of_value)(TYPE(gsl_matrix) * cmat, 38 | value vmat) { 39 | if (Tag_val(vmat) == 0 && Wosize_val(vmat) == 2) 40 | /* value is a polymorphic variant */ 41 | vmat = Field(vmat, 1); 42 | if (Tag_val(vmat) == Custom_tag) 43 | /* value is a bigarray */ 44 | TYPE(mlgsl_mat_of_bigarray)(cmat, vmat); 45 | #ifdef CONV_FLAT 46 | else 47 | /* value is a record wrapping a float array */ 48 | TYPE(mlgsl_mat_of_floatarray)(cmat, vmat); 49 | #endif 50 | } 51 | 52 | #define _DECLARE_MATRIX(a) TYPE(gsl_matrix) m_##a 53 | #define _DECLARE_MATRIX2(a, b) \ 54 | _DECLARE_MATRIX(a); \ 55 | _DECLARE_MATRIX(b) 56 | #define _DECLARE_MATRIX3(a, b, c) \ 57 | _DECLARE_MATRIX2(a, b); \ 58 | _DECLARE_MATRIX(c) 59 | 60 | #define _CONVERT_MATRIX(a) TYPE(mlgsl_mat_of_value)(&m_##a, a) 61 | #define _CONVERT_MATRIX2(a, b) \ 62 | _CONVERT_MATRIX(a); \ 63 | _CONVERT_MATRIX(b) 64 | #define _CONVERT_MATRIX3(a, b, c) \ 65 | _CONVERT_MATRIX2(a, b); \ 66 | _CONVERT_MATRIX(c) 67 | -------------------------------------------------------------------------------- /lib/vector_complex_flat.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type complex_vector_flat = { 8 | data : float array; 9 | off : int; 10 | len : int; 11 | stride : int; 12 | } 13 | 14 | type vector = complex_vector_flat 15 | 16 | let create ?(init = Complex.zero) len = 17 | let arr = 18 | { data = Array.make (2 * len) init.Complex.re; off = 0; len; stride = 1 } 19 | in 20 | if init.Complex.im <> init.Complex.re then 21 | for i = 0 to pred len do 22 | arr.data.((2 * i) + 1) <- init.Complex.im 23 | done; 24 | arr 25 | 26 | let of_array arr = 27 | let carr = Gsl_complex.pack arr in 28 | { data = carr; off = 0; len = Array.length arr; stride = 1 } 29 | 30 | let length { len } = len 31 | let get v i = Gsl_complex.get v.data (v.off + (i * v.stride)) 32 | let set v i d = Gsl_complex.set v.data (v.off + (i * v.stride)) d 33 | 34 | let set_all v d = 35 | for i = 0 to pred v.len do 36 | set v i d 37 | done 38 | 39 | let set_zero v = set_all v Complex.zero 40 | 41 | let set_basis v i = 42 | set_zero v; 43 | set v i Complex.one 44 | 45 | let to_array v = Array.init v.len (get v) 46 | 47 | let of_complex_array carr = 48 | { data = Array.copy carr; off = 0; len = Array.length carr / 2; stride = 1 } 49 | 50 | let to_complex_array arr = 51 | let carr = Array.make (2 * arr.len) 0. in 52 | for i = 0 to pred arr.len do 53 | Gsl_complex.set carr i (get arr i) 54 | done; 55 | carr 56 | 57 | let real carr = 58 | Vector_flat.view_array ~stride:(2 * carr.stride) ~off:(2 * carr.off) 59 | ~len:carr.len carr.data 60 | 61 | let imag carr = 62 | Vector_flat.view_array ~stride:(2 * carr.stride) 63 | ~off:((2 * carr.off) + 1) 64 | ~len:carr.len carr.data 65 | 66 | let subvector ?(stride = 1) v ~off ~len = 67 | { v with off = (off * v.stride) + v.off; len; stride = stride * v.stride } 68 | 69 | let view_complex_array ?(stride = 1) ?(off = 0) ?len arr = 70 | let alen = Array.length arr in 71 | if alen mod 2 <> 0 then invalid_arg "complex_array dim"; 72 | let len = match len with None -> alen / 2 | Some l -> l in 73 | { data = arr; off; stride; len } 74 | 75 | let memcpy v w = 76 | if v.len <> w.len then invalid_arg "Vector.memcpy"; 77 | for i = 0 to pred v.len do 78 | set w i (get v i) 79 | done 80 | 81 | let copy v = { v with data = Array.copy v.data } 82 | 83 | let swap_element v i j = 84 | let d = get v i in 85 | let d' = get v j in 86 | set v j d; 87 | set v i d' 88 | 89 | let reverse v = 90 | for i = 0 to pred (v.len / 2) do 91 | swap_element v i (pred v.len - i) 92 | done 93 | -------------------------------------------------------------------------------- /lib/histo.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | (** Histograms *) 8 | 9 | type t = { n : int; range : float array; bin : float array } 10 | (** The histogram type *) 11 | 12 | let check h = 13 | h.n > 0 && Array.length h.range = succ h.n && Array.length h.bin = h.n 14 | 15 | (** {3 Allocating histograms} *) 16 | 17 | let make n = { n; range = Array.make (succ n) 0.; bin = Array.make n 0. } 18 | let copy h = { n = h.n; range = Array.copy h.range; bin = Array.copy h.bin } 19 | 20 | external set_ranges : t -> float array -> unit = "ml_gsl_histogram_set_ranges" 21 | 22 | external set_ranges_uniform : t -> xmin:float -> xmax:float -> unit 23 | = "ml_gsl_histogram_set_ranges_uniform" 24 | 25 | (** {3 Updating and accessing histogram elements} *) 26 | 27 | external accumulate : t -> ?w:float -> float -> unit 28 | = "ml_gsl_histogram_accumulate" 29 | 30 | let get h i = h.bin.(i) 31 | let get_range h i = (h.range.(i), h.range.(succ i)) 32 | let h_max h = h.range.(h.n) 33 | let h_min h = h.range.(0) 34 | let bins h = h.n 35 | let reset h = Array.fill h.bin 0 h.n 0. 36 | 37 | (** {3 Searching histogram ranges} *) 38 | 39 | external find : t -> float -> int = "ml_gsl_histogram_find" 40 | 41 | (** {3 Histograms statistics} *) 42 | 43 | external max_val : t -> float = "ml_gsl_histogram_max_val" 44 | external max_bin : t -> int = "ml_gsl_histogram_max_bin" 45 | external min_val : t -> float = "ml_gsl_histogram_min_val" 46 | external min_bin : t -> int = "ml_gsl_histogram_min_bin" 47 | external mean : t -> float = "ml_gsl_histogram_mean" 48 | external sigma : t -> float = "ml_gsl_histogram_sigma" 49 | external sum : t -> float = "ml_gsl_histogram_sum" 50 | 51 | (** {3 Histogram operations} *) 52 | 53 | external equal_bins_p : t -> t -> bool = "ml_gsl_histogram_equal_bins_p" 54 | external add : t -> t -> unit = "ml_gsl_histogram_add" 55 | external sub : t -> t -> unit = "ml_gsl_histogram_sub" 56 | external mul : t -> t -> unit = "ml_gsl_histogram_mul" 57 | external div : t -> t -> unit = "ml_gsl_histogram_div" 58 | external scale : t -> float -> unit = "ml_gsl_histogram_scale" 59 | external shift : t -> float -> unit = "ml_gsl_histogram_shift" 60 | 61 | (** {3 Resampling} *) 62 | 63 | type histo_pdf = { pdf_n : int; pdf_range : float array; pdf_sum : float array } 64 | 65 | external _init : histo_pdf -> t -> unit = "ml_gsl_histogram_pdf_init" 66 | 67 | let init h = 68 | let p = 69 | { pdf_n = h.n; pdf_range = Array.copy h.range; pdf_sum = Array.copy h.bin } 70 | in 71 | _init p h; 72 | p 73 | 74 | external sample : histo_pdf -> float -> float = "ml_gsl_histogram_pdf_sample" 75 | -------------------------------------------------------------------------------- /lib/permut.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | open Bigarray 8 | 9 | type permut = (int, int_elt, c_layout) Array1.t 10 | 11 | let of_array arr = Array1.of_array int c_layout arr 12 | 13 | let to_array perm = 14 | let len = Array1.dim perm in 15 | Array.init len (Array1.get perm) 16 | 17 | external init : permut -> unit = "ml_gsl_permutation_init" 18 | 19 | let create len = Array1.create int c_layout len 20 | 21 | let make len = 22 | let p = create len in 23 | init p; 24 | p 25 | 26 | let swap p i j = 27 | let tmp_i = p.{i} in 28 | let tmp_j = p.{j} in 29 | p.{i} <- tmp_j; 30 | p.{j} <- tmp_i 31 | 32 | let size = Array1.dim 33 | 34 | external _valid : permut -> bool = "ml_gsl_permutation_valid" 35 | 36 | let valid p = try _valid p with Error.Gsl_exn (Error.FAILURE, _) -> false 37 | 38 | external reverse : permut -> unit = "ml_gsl_permutation_reverse" 39 | 40 | external _inverse : src:permut -> dst:permut -> unit 41 | = "ml_gsl_permutation_inverse" 42 | 43 | let inverse p = 44 | let i = create (size p) in 45 | _inverse ~src:p ~dst:i; 46 | i 47 | 48 | external next : permut -> unit = "ml_gsl_permutation_next" 49 | external prev : permut -> unit = "ml_gsl_permutation_prev" 50 | external permute : permut -> 'a array -> unit = "ml_gsl_permute" 51 | 52 | external permute_barr : permut -> ('a, 'b, 'c) Bigarray.Array1.t -> unit 53 | = "ml_gsl_permute_barr" 54 | 55 | external permute_complex : permut -> Gsl_complex.complex_array -> unit 56 | = "ml_gsl_permute_complex" 57 | 58 | external permute_inverse : permut -> 'a array -> unit = "ml_gsl_permute_inverse" 59 | 60 | external permute_inverse_barr : permut -> ('a, 'b, 'c) Bigarray.Array1.t -> unit 61 | = "ml_gsl_permute_inverse_barr" 62 | 63 | external permute_inverse_complex : permut -> Gsl_complex.complex_array -> unit 64 | = "ml_gsl_permute_inverse_complex" 65 | 66 | external _mul : permut -> permut -> permut -> unit = "ml_gsl_permute_mul" 67 | 68 | let mul pa pb = 69 | let p = create (size pa) in 70 | _mul p pa pb; 71 | p 72 | 73 | external _lin_to_can : permut -> permut -> unit 74 | = "ml_gsl_permute_linear_to_canonical" 75 | 76 | let linear_to_canonical p = 77 | let q = create (size p) in 78 | _lin_to_can q p; 79 | q 80 | 81 | external _can_to_lin : permut -> permut -> unit 82 | = "ml_gsl_permute_canonical_to_linear" 83 | 84 | let canonical_to_linear q = 85 | let p = create (size q) in 86 | _can_to_lin p q; 87 | p 88 | 89 | external inversions : permut -> int = "ml_gsl_permute_inversions" 90 | external canonical_cycles : permut -> int = "ml_gsl_permute_canonical_cycles" 91 | external linear_cycles : permut -> int = "ml_gsl_permute_linear_cycles" 92 | -------------------------------------------------------------------------------- /lib/vector_flat.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type double_vector_flat = { 8 | data : float array; 9 | off : int; 10 | len : int; 11 | stride : int; 12 | } 13 | 14 | type vector = double_vector_flat 15 | 16 | let check v = 17 | let size = Array.length v.data in 18 | if 19 | v.off < 0 || v.len < 0 || v.stride < 1 20 | || v.off + ((v.len - 1) * v.stride) >= size 21 | then failwith "Vector_flat.check"; 22 | v 23 | 24 | let create ?(init = 0.) len = 25 | { data = Array.make len init; off = 0; len; stride = 1 } 26 | 27 | let of_array arr = 28 | { data = Array.copy arr; off = 0; len = Array.length arr; stride = 1 } 29 | 30 | let length { len } = len 31 | let get v i = v.data.(v.off + (i * v.stride)) 32 | let set v i d = v.data.(v.off + (i * v.stride)) <- d 33 | 34 | let set_all v d = 35 | for i = 0 to pred v.len do 36 | set v i d 37 | done 38 | 39 | let set_zero v = set_all v 0. 40 | 41 | let set_basis v i = 42 | set_zero v; 43 | set v i 1. 44 | 45 | let to_array v = Array.init v.len (get v) 46 | 47 | let subvector ?(stride = 1) v ~off ~len = 48 | check 49 | { v with off = (off * v.stride) + v.off; len; stride = stride * v.stride } 50 | 51 | let view_array ?(stride = 1) ?(off = 0) ?len arr = 52 | let len = match len with None -> Array.length arr | Some l -> l in 53 | check { data = arr; off; stride; len } 54 | 55 | let memcpy ~src:v ~dst:w = 56 | if v.len <> w.len then invalid_arg "Vector.memcpy"; 57 | for i = 0 to pred v.len do 58 | set w i (get v i) 59 | done 60 | 61 | let copy v = { v with data = Array.copy v.data } 62 | 63 | let swap_element v i j = 64 | let d = get v i in 65 | let d' = get v j in 66 | set v j d; 67 | set v i d' 68 | 69 | let reverse v = 70 | for i = 0 to pred (v.len / 2) do 71 | swap_element v i (pred v.len - i) 72 | done 73 | 74 | external add : vector -> vector -> unit = "ml_gsl_vector_add" 75 | external sub : vector -> vector -> unit = "ml_gsl_vector_sub" 76 | external mul : vector -> vector -> unit = "ml_gsl_vector_mul" 77 | external div : vector -> vector -> unit = "ml_gsl_vector_div" 78 | external scale : vector -> float -> unit = "ml_gsl_vector_scale" 79 | external add_constant : vector -> float -> unit = "ml_gsl_vector_add_constant" 80 | external is_null : vector -> bool = "ml_gsl_vector_isnull" 81 | external max : vector -> float = "ml_gsl_vector_max" 82 | external min : vector -> float = "ml_gsl_vector_min" 83 | external minmax : vector -> float * float = "ml_gsl_vector_minmax" 84 | external max_index : vector -> int = "ml_gsl_vector_maxindex" 85 | external min_index : vector -> int = "ml_gsl_vector_minindex" 86 | external minmax_index : vector -> int * int = "ml_gsl_vector_minmaxindex" 87 | -------------------------------------------------------------------------------- /lib/matrix_complex_flat.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Matrices of complex number simplemented with [float array] *) 6 | 7 | type complex_mat_flat = private { 8 | data : float array; 9 | off : int; 10 | dim1 : int; 11 | dim2 : int; 12 | tda : int; 13 | } 14 | 15 | type matrix = complex_mat_flat 16 | 17 | open Gsl_complex 18 | 19 | val create : ?init:complex -> int -> int -> matrix 20 | val dims : matrix -> int * int 21 | val of_arrays : complex array array -> matrix 22 | val of_array : complex array -> int -> int -> matrix 23 | val to_arrays : matrix -> complex array array 24 | val to_array : matrix -> complex array 25 | val of_complex_array : float array -> int -> int -> matrix 26 | val to_complex_array : matrix -> complex_array 27 | val get : matrix -> int -> int -> complex 28 | val set : matrix -> int -> int -> complex -> unit 29 | val set_all : matrix -> complex -> unit 30 | val set_zero : matrix -> unit 31 | val set_id : matrix -> unit 32 | val memcpy : src:matrix -> dst:matrix -> unit 33 | val copy : matrix -> matrix 34 | external add : matrix -> matrix -> unit = "ml_gsl_matrix_complex_add" 35 | external sub : matrix -> matrix -> unit = "ml_gsl_matrix_complex_sub" 36 | external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_mul" 37 | external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_div" 38 | external scale : matrix -> float -> unit = "ml_gsl_matrix_complex_scale" 39 | 40 | external add_constant : matrix -> float -> unit 41 | = "ml_gsl_matrix_complex_add_constant" 42 | 43 | external add_diagonal : matrix -> complex -> unit 44 | = "ml_gsl_matrix_complex_add_diagonal" 45 | 46 | external is_null : matrix -> bool = "ml_gsl_matrix_complex_isnull" 47 | 48 | external swap_rows : matrix -> int -> int -> unit 49 | = "ml_gsl_matrix_complex_swap_rows" 50 | 51 | external swap_columns : matrix -> int -> int -> unit 52 | = "ml_gsl_matrix_complex_swap_columns" 53 | 54 | external swap_rowcol : matrix -> int -> int -> unit 55 | = "ml_gsl_matrix_complex_swap_rowcol" 56 | 57 | external transpose : matrix -> matrix -> unit 58 | = "ml_gsl_matrix_complex_transpose_memcpy" 59 | 60 | external transpose_in_place : matrix -> unit = "ml_gsl_matrix_complex_transpose" 61 | 62 | open Vector_complex_flat 63 | 64 | val submatrix : matrix -> k1:int -> k2:int -> n1:int -> n2:int -> matrix 65 | val row : matrix -> int -> vector 66 | val column : matrix -> int -> vector 67 | val diagonal : matrix -> vector 68 | val subdiagonal : matrix -> int -> vector 69 | val superdiagonal : matrix -> int -> vector 70 | 71 | val view_complex_array : 72 | complex_array -> ?off:int -> int -> ?tda:int -> int -> matrix 73 | 74 | val view_vector : vector -> ?off:int -> int -> ?tda:int -> int -> matrix 75 | -------------------------------------------------------------------------------- /examples/multiroot_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | open Fun 3 | 4 | let _ = Error.init () 5 | 6 | let f a b ~x ~f:y = 7 | let x0 = x.{0} in 8 | let x1 = x.{1} in 9 | y.{0} <- a *. (1. -. x0); 10 | y.{1} <- b *. (x1 -. (x0 *. x0)) 11 | 12 | let df a b ~x ~j = 13 | let x0 = x.{0} in 14 | j.{0, 0} <- ~-.a; 15 | j.{0, 1} <- 0.; 16 | j.{1, 0} <- -2. *. b *. x0; 17 | j.{1, 1} <- b 18 | 19 | let fdf a b ~x ~f:y ~j = 20 | f a b ~x ~f:y; 21 | df a b ~x ~j 22 | 23 | let print_state n = 24 | let x = Vector.create n in 25 | let f = Vector.create n in 26 | fun iter solv -> 27 | Multiroot.NoDeriv.get_state solv ~x ~f (); 28 | Printf.printf "iter = %3u x = %+.3f %+.3f f(x) = %+.3e %+.3e\n" iter x.{0} 29 | x.{1} f.{0} f.{1}; 30 | flush stdout 31 | 32 | let epsabs = 1e-7 33 | let maxiter = 1000 34 | 35 | let solve kind n gf x_init = 36 | let solv = Multiroot.NoDeriv.make kind n gf (Vector.of_array x_init) in 37 | Printf.printf "solver: %s\n" (Multiroot.NoDeriv.name solv); 38 | let print_state = print_state n in 39 | print_state 0 solv; 40 | let rec proc iter = 41 | Multiroot.NoDeriv.iterate solv; 42 | print_state iter solv; 43 | let status = Multiroot.NoDeriv.test_residual solv ~epsabs in 44 | match status with 45 | | true -> Printf.printf "status = converged\n" 46 | | false when iter >= maxiter -> 47 | Printf.printf "status = too many iterations\n" 48 | | false -> proc (succ iter) 49 | in 50 | proc 1 51 | 52 | open Multiroot.NoDeriv 53 | 54 | let _ = 55 | List.iter 56 | (fun kind -> 57 | solve kind 2 (f 1. 10.) [| -10.; -5. |]; 58 | print_newline ()) 59 | [ HYBRIDS; HYBRID; DNEWTON; BROYDEN ] 60 | 61 | let print_state_deriv n = 62 | let x = Vector.create n in 63 | let f = Vector.create n in 64 | fun iter solv -> 65 | Multiroot.Deriv.get_state solv ~x ~f (); 66 | Printf.printf "iter = %3u x = %+.3f %+.3f f(x) = %+.3e %+.3e\n" iter x.{0} 67 | x.{1} f.{0} f.{1}; 68 | flush stdout 69 | 70 | let solve_deriv kind n gf x_init = 71 | let solv = Multiroot.Deriv.make kind n gf (Vector.of_array x_init) in 72 | Printf.printf "solver: %s\n" (Multiroot.Deriv.name solv); 73 | let print_state = print_state_deriv n in 74 | print_state 0 solv; 75 | let rec proc iter = 76 | Multiroot.Deriv.iterate solv; 77 | print_state iter solv; 78 | let status = Multiroot.Deriv.test_residual solv ~epsabs in 79 | match status with 80 | | true -> Printf.printf "status = converged\n" 81 | | false when iter >= maxiter -> 82 | Printf.printf "status = too many iterations\n" 83 | | false -> proc (succ iter) 84 | in 85 | proc 1 86 | 87 | open Multiroot.Deriv 88 | 89 | let _ = 90 | let gf = 91 | { multi_f = f 1. 10.; multi_df = df 1. 10.; multi_fdf = fdf 1. 10. } 92 | in 93 | List.iter 94 | (fun kind -> 95 | solve_deriv kind 2 gf [| -10.; -5. |]; 96 | print_newline ()) 97 | [ HYBRIDSJ; HYBRIDJ; NEWTON; GNEWTON ] 98 | -------------------------------------------------------------------------------- /lib/interp.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type t 8 | type accel 9 | 10 | type interp_type = 11 | | LINEAR 12 | | POLYNOMIAL 13 | | CSPLINE 14 | | CSPLINE_PERIODIC 15 | | AKIMA 16 | | AKIMA_PERIODIC 17 | 18 | external _alloc : interp_type -> int -> t = "ml_gsl_interp_alloc" 19 | external _free : t -> unit = "ml_gsl_interp_free" 20 | 21 | let make t s = 22 | let i = _alloc t s in 23 | Gc.finalise _free i; 24 | i 25 | 26 | external _init : t -> float array -> float array -> int -> unit 27 | = "ml_gsl_interp_init" 28 | 29 | let init i x y = 30 | let lx = Array.length x in 31 | let ly = Array.length y in 32 | if lx <> ly then invalid_arg "Interp: init"; 33 | _init i x y lx 34 | 35 | external name : t -> string = "ml_gsl_interp_name" 36 | external min_size : t -> int = "ml_gsl_interp_min_size" 37 | external _accel_alloc : unit -> accel = "ml_gsl_interp_accel_alloc" 38 | external _accel_free : accel -> unit = "ml_gsl_interp_accel_free" 39 | 40 | let make_accel () = 41 | let a = _accel_alloc () in 42 | Gc.finalise _accel_free a; 43 | a 44 | 45 | external i_eval : t -> float array -> float array -> float -> accel -> float 46 | = "ml_gsl_interp_eval" 47 | 48 | external i_eval_deriv : 49 | t -> float array -> float array -> float -> accel -> float 50 | = "ml_gsl_interp_eval_deriv" 51 | 52 | external i_eval_deriv2 : 53 | t -> float array -> float array -> float -> accel -> float 54 | = "ml_gsl_interp_eval_deriv2" 55 | 56 | external i_eval_integ : 57 | t -> float array -> float array -> float -> float -> accel -> float 58 | = "ml_gsl_interp_eval_integ_bc" "ml_gsl_interp_eval_integ" 59 | 60 | (* Higher level functions *) 61 | type interp = { 62 | interp : t; 63 | accel : accel; 64 | xa : float array; 65 | ya : float array; 66 | size : int; 67 | i_type : interp_type; 68 | } 69 | 70 | let make_interp i_type x y = 71 | let len = Array.length x in 72 | let ly = Array.length y in 73 | if len <> ly then invalid_arg "Interp.make"; 74 | let t = _alloc i_type len in 75 | let a = _accel_alloc () in 76 | let v = { interp = t; accel = a; xa = x; ya = y; size = len; i_type } in 77 | Gc.finalise 78 | (fun v -> 79 | _free v.interp; 80 | _accel_free v.accel) 81 | v; 82 | init t x y; 83 | v 84 | 85 | let eval interp x = i_eval interp.interp interp.xa interp.ya x interp.accel 86 | 87 | external eval_array : interp -> float array -> float array -> unit 88 | = "ml_gsl_interp_eval_array" 89 | 90 | let eval_deriv interp x = 91 | i_eval_deriv interp.interp interp.xa interp.ya x interp.accel 92 | 93 | let eval_deriv2 interp x = 94 | i_eval_deriv2 interp.interp interp.xa interp.ya x interp.accel 95 | 96 | let eval_integ interp a b = 97 | i_eval_integ interp.interp interp.xa interp.ya a b interp.accel 98 | -------------------------------------------------------------------------------- /lib/monte.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Monte Carlo Integration *) 6 | 7 | open Fun 8 | 9 | (** {3 High-level interface} *) 10 | 11 | type kind = PLAIN | MISER | VEGAS 12 | 13 | val integrate : 14 | kind -> 15 | monte_fun -> 16 | lo:float array -> 17 | up:float array -> 18 | int -> 19 | Rng.t -> 20 | Fun.result 21 | 22 | (** {3 Low-level interface} *) 23 | 24 | (** {4 PLAIN algorithm} *) 25 | 26 | type plain_state 27 | 28 | val make_plain_state : int -> plain_state 29 | external init_plain : plain_state -> unit = "ml_gsl_monte_plain_init" 30 | 31 | external integrate_plain : 32 | monte_fun -> 33 | lo:float array -> 34 | up:float array -> 35 | int -> 36 | Rng.t -> 37 | plain_state -> 38 | Fun.result = "ml_gsl_monte_plain_integrate_bc" "ml_gsl_monte_plain_integrate" 39 | 40 | (** {4 MISER algorithm} *) 41 | 42 | type miser_state 43 | 44 | type miser_params = { 45 | estimate_frac : float; 46 | min_calls : int; 47 | min_calls_per_bisection : int; 48 | miser_alpha : float; 49 | dither : float; 50 | } 51 | 52 | val make_miser_state : int -> miser_state 53 | external init_miser : miser_state -> unit = "ml_gsl_monte_miser_init" 54 | 55 | external integrate_miser : 56 | monte_fun -> 57 | lo:float array -> 58 | up:float array -> 59 | int -> 60 | Rng.t -> 61 | miser_state -> 62 | Fun.result = "ml_gsl_monte_miser_integrate_bc" "ml_gsl_monte_miser_integrate" 63 | 64 | external get_miser_params : miser_state -> miser_params 65 | = "ml_gsl_monte_miser_get_params" 66 | 67 | external set_miser_params : miser_state -> miser_params -> unit 68 | = "ml_gsl_monte_miser_set_params" 69 | 70 | (** {4 VEGAS algorithm} *) 71 | 72 | type vegas_state 73 | type vegas_info = { result : float; sigma : float; chisq : float } 74 | type vegas_mode = STRATIFIED | IMPORTANCE_ONLY | IMPORTANCE 75 | 76 | type vegas_params = { 77 | vegas_alpha : float; (** 1.5 *) 78 | iterations : int; (** 5 *) 79 | stage : int; 80 | mode : vegas_mode; 81 | verbose : int; 82 | ostream : out_channel option; 83 | } 84 | 85 | val make_vegas_state : int -> vegas_state 86 | external init_vegas : vegas_state -> unit = "ml_gsl_monte_vegas_init" 87 | 88 | external integrate_vegas : 89 | monte_fun -> 90 | lo:float array -> 91 | up:float array -> 92 | int -> 93 | Rng.t -> 94 | vegas_state -> 95 | Fun.result = "ml_gsl_monte_vegas_integrate_bc" "ml_gsl_monte_vegas_integrate" 96 | 97 | external get_vegas_info : vegas_state -> vegas_info 98 | = "ml_gsl_monte_vegas_get_info" 99 | 100 | external get_vegas_params : vegas_state -> vegas_params 101 | = "ml_gsl_monte_vegas_get_params" 102 | 103 | external set_vegas_params : vegas_state -> vegas_params -> unit 104 | = "ml_gsl_monte_vegas_set_params" 105 | -------------------------------------------------------------------------------- /lib/wavelet.ml: -------------------------------------------------------------------------------- 1 | type t 2 | type ws 3 | 4 | let () = Error.init () 5 | 6 | type kind = 7 | | DAUBECHIES 8 | | DAUBECHIES_CENTERED 9 | | HAAR 10 | | HAAR_CENTERED 11 | | BSPLINE 12 | | BSPLINE_CENTERED 13 | 14 | type direction = FORWARD | BACKWARD 15 | 16 | external _alloc : kind -> int -> t = "ml_gsl_wavelet_alloc" 17 | external _free : t -> unit = "ml_gsl_wavelet_free" 18 | 19 | let make kind size = 20 | let w = _alloc kind size in 21 | Gc.finalise _free w; 22 | w 23 | 24 | external name : t -> string = "ml_gsl_wavelet_name" 25 | external _workspace_alloc : int -> ws = "ml_gsl_wavelet_workspace_alloc" 26 | external _workspace_free : ws -> unit = "ml_gsl_wavelet_workspace_free" 27 | 28 | let workspace_make size = 29 | let ws = _workspace_alloc size in 30 | Gc.finalise _workspace_free ws; 31 | ws 32 | 33 | external workspace_size : ws -> int = "ml_gsl_wavelet_workspace_size" 34 | 35 | external _transform : t -> direction -> Vector_flat.vector -> ws -> unit 36 | = "ml_gsl_wavelet_transform" 37 | 38 | external _transform_bigarray : t -> direction -> Vector.vector -> ws -> unit 39 | = "ml_gsl_wavelet_transform_bigarray" 40 | 41 | let with_workspace ws length f arg = 42 | let workspace = 43 | match ws with Some ws -> ws | None -> _workspace_alloc (length arg) 44 | in 45 | try 46 | f arg workspace; 47 | if ws = None then _workspace_free workspace 48 | with exn -> 49 | if ws = None then _workspace_free workspace; 50 | raise exn 51 | 52 | let transform_vector_flat w dir ?ws = 53 | with_workspace ws Vector_flat.length (_transform w dir) 54 | 55 | let transform_vector w dir ?ws = 56 | with_workspace ws Vector.length (_transform_bigarray w dir) 57 | 58 | let transform_gen w dir ?ws = function 59 | | `V v -> transform_vector w dir ?ws v 60 | | `VF v -> transform_vector_flat w dir ?ws v 61 | 62 | let transform_array w dir ?ws ?stride ?off ?len arr = 63 | transform_vector_flat w dir ?ws (Vector_flat.view_array ?stride ?off ?len arr) 64 | 65 | let transform_forward w = transform_array w FORWARD 66 | let transform_inverse w = transform_array w BACKWARD 67 | 68 | type ordering = STANDARD | NON_STANDARD 69 | 70 | external _transform_2d : 71 | t -> ordering -> direction -> Matrix_flat.matrix -> ws -> unit 72 | = "ml_gsl_wavelet2d_transform_matrix" 73 | 74 | external _transform_2d_bigarray : 75 | t -> ordering -> direction -> Matrix.matrix -> ws -> unit 76 | = "ml_gsl_wavelet2d_transform_matrix" 77 | 78 | external _transform_2d_gen : 79 | t -> ordering -> direction -> [< Vectmat.mat ] -> ws -> unit 80 | = "ml_gsl_wavelet2d_transform_matrix" 81 | 82 | let transform_matrix_flat w order dir ?ws = 83 | with_workspace ws 84 | (fun m -> fst (Matrix_flat.dims m)) 85 | (_transform_2d w order dir) 86 | 87 | let transform_matrix w order dir ?ws = 88 | with_workspace ws 89 | (fun m -> fst (Matrix.dims m)) 90 | (_transform_2d_bigarray w order dir) 91 | 92 | let transform_matrix_gen w order dir ?ws = 93 | with_workspace ws 94 | (fun m -> fst (Vectmat.dims m)) 95 | (_transform_2d_gen w order dir) 96 | -------------------------------------------------------------------------------- /lib/rng.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | type rng_type = 8 | | BOROSH13 9 | | COVEYOU 10 | | CMRG 11 | | FISHMAN18 12 | | FISHMAN20 13 | | FISHMAN2X 14 | | GFSR4 15 | | KNUTHRAN 16 | | KNUTHRAN2 17 | | KNUTHRAN2002 18 | | LECUYER21 19 | | MINSTD 20 | | MRG 21 | | MT19937 22 | | MT19937_1999 23 | | MT19937_1998 24 | | R250 25 | | RAN0 26 | | RAN1 27 | | RAN2 28 | | RAN3 29 | | RAND 30 | | RAND48 31 | | RANDOM128_BSD 32 | | RANDOM128_GLIBC2 33 | | RANDOM128_LIBC5 34 | | RANDOM256_BSD 35 | | RANDOM256_GLIBC2 36 | | RANDOM256_LIBC5 37 | | RANDOM32_BSD 38 | | RANDOM32_GLIBC2 39 | | RANDOM32_LIBC5 40 | | RANDOM64_BSD 41 | | RANDOM64_GLIBC2 42 | | RANDOM64_LIBC5 43 | | RANDOM8_BSD 44 | | RANDOM8_GLIBC2 45 | | RANDOM8_LIBC5 46 | | RANDOM_BSD 47 | | RANDOM_GLIBC2 48 | | RANDOM_LIBC5 49 | | RANDU 50 | | RANF 51 | | RANLUX 52 | | RANLUX389 53 | | RANLXD1 54 | | RANLXD2 55 | | RANLXS0 56 | | RANLXS1 57 | | RANLXS2 58 | | RANMAR 59 | | SLATEC 60 | | TAUS 61 | | TAUS_2 62 | | TAUS_113 63 | | TRANSPUTER 64 | | TT800 65 | | UNI 66 | | UNI32 67 | | VAX 68 | | WATERMAN14 69 | | ZUF 70 | 71 | type t 72 | 73 | external default : unit -> rng_type = "ml_gsl_rng_get_default" 74 | external default_seed : unit -> nativeint = "ml_gsl_rng_get_default_seed" 75 | external set_default : rng_type -> unit = "ml_gsl_rng_set_default" 76 | external set_default_seed : nativeint -> unit = "ml_gsl_rng_set_default_seed" 77 | external env_setup : unit -> unit = "ml_gsl_rng_env_setup" 78 | external create : rng_type -> t = "ml_gsl_rng_alloc" 79 | external delete : t -> unit = "ml_gsl_rng_free" 80 | 81 | let make rngtype = 82 | let rng = create rngtype in 83 | Gc.finalise delete rng; 84 | rng 85 | 86 | external set : t -> nativeint -> unit = "ml_gsl_rng_set" 87 | external name : t -> string = "ml_gsl_rng_name" 88 | external max : t -> nativeint = "ml_gsl_rng_max" 89 | external min : t -> nativeint = "ml_gsl_rng_min" 90 | external get_type : t -> rng_type = "ml_gsl_rng_get_type" 91 | external memcpy : t -> t -> unit = "ml_gsl_rng_memcpy" 92 | external clone : t -> t = "ml_gsl_rng_clone" 93 | external dump_state : t -> string * string = "ml_gsl_rng_dump_state" 94 | external set_state : t -> string * string -> unit = "ml_gsl_rng_set_state" 95 | external get : t -> nativeint = "ml_gsl_rng_get" 96 | external uniform : t -> float = "ml_gsl_rng_uniform" 97 | external uniform_pos : t -> float = "ml_gsl_rng_uniform_pos" 98 | external uniform_int : t -> int -> int = "ml_gsl_rng_uniform_int" [@@noalloc] 99 | 100 | external uniform_arr : t -> float array -> unit = "ml_gsl_rng_uniform_arr" 101 | [@@noalloc] 102 | 103 | external uniform_pos_arr : t -> float array -> unit 104 | = "ml_gsl_rng_uniform_pos_arr" 105 | [@@noalloc] 106 | -------------------------------------------------------------------------------- /lib/rng.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Random Number Generation *) 6 | 7 | type rng_type = 8 | | BOROSH13 9 | | COVEYOU 10 | | CMRG 11 | | FISHMAN18 12 | | FISHMAN20 13 | | FISHMAN2X 14 | | GFSR4 15 | | KNUTHRAN 16 | | KNUTHRAN2 17 | | KNUTHRAN2002 18 | | LECUYER21 19 | | MINSTD 20 | | MRG 21 | | MT19937 22 | | MT19937_1999 23 | | MT19937_1998 24 | | R250 25 | | RAN0 26 | | RAN1 27 | | RAN2 28 | | RAN3 29 | | RAND 30 | | RAND48 31 | | RANDOM128_BSD 32 | | RANDOM128_GLIBC2 33 | | RANDOM128_LIBC5 34 | | RANDOM256_BSD 35 | | RANDOM256_GLIBC2 36 | | RANDOM256_LIBC5 37 | | RANDOM32_BSD 38 | | RANDOM32_GLIBC2 39 | | RANDOM32_LIBC5 40 | | RANDOM64_BSD 41 | | RANDOM64_GLIBC2 42 | | RANDOM64_LIBC5 43 | | RANDOM8_BSD 44 | | RANDOM8_GLIBC2 45 | | RANDOM8_LIBC5 46 | | RANDOM_BSD 47 | | RANDOM_GLIBC2 48 | | RANDOM_LIBC5 49 | | RANDU 50 | | RANF 51 | | RANLUX 52 | | RANLUX389 53 | | RANLXD1 54 | | RANLXD2 55 | | RANLXS0 56 | | RANLXS1 57 | | RANLXS2 58 | | RANMAR 59 | | SLATEC 60 | | TAUS 61 | | TAUS_2 62 | | TAUS_113 63 | | TRANSPUTER 64 | | TT800 65 | | UNI 66 | | UNI32 67 | | VAX 68 | | WATERMAN14 69 | | ZUF 70 | 71 | type t 72 | 73 | (** {3 Default values} *) 74 | 75 | external default : unit -> rng_type = "ml_gsl_rng_get_default" 76 | external default_seed : unit -> nativeint = "ml_gsl_rng_get_default_seed" 77 | external set_default : rng_type -> unit = "ml_gsl_rng_set_default" 78 | external set_default_seed : nativeint -> unit = "ml_gsl_rng_set_default_seed" 79 | external env_setup : unit -> unit = "ml_gsl_rng_env_setup" 80 | 81 | (** {3 Creating} *) 82 | 83 | val make : rng_type -> t 84 | external set : t -> nativeint -> unit = "ml_gsl_rng_set" 85 | external name : t -> string = "ml_gsl_rng_name" 86 | external get_type : t -> rng_type = "ml_gsl_rng_get_type" 87 | 88 | (** warning : the nativeint used for seeds are in fact unsigned but ocaml treats 89 | them as signed. But you can still print them using %nu with printf 90 | functions. *) 91 | 92 | external max : t -> nativeint = "ml_gsl_rng_max" 93 | external min : t -> nativeint = "ml_gsl_rng_min" 94 | external memcpy : t -> t -> unit = "ml_gsl_rng_memcpy" 95 | external clone : t -> t = "ml_gsl_rng_clone" 96 | external dump_state : t -> string * string = "ml_gsl_rng_dump_state" 97 | external set_state : t -> string * string -> unit = "ml_gsl_rng_set_state" 98 | 99 | (** {3 Sampling} *) 100 | 101 | external get : t -> nativeint = "ml_gsl_rng_get" 102 | external uniform : t -> float = "ml_gsl_rng_uniform" 103 | external uniform_pos : t -> float = "ml_gsl_rng_uniform_pos" 104 | external uniform_int : t -> int -> int = "ml_gsl_rng_uniform_int" [@@noalloc] 105 | 106 | (** These function fill the array with random numbers : *) 107 | 108 | external uniform_arr : t -> float array -> unit = "ml_gsl_rng_uniform_arr" 109 | [@@noalloc] 110 | 111 | external uniform_pos_arr : t -> float array -> unit 112 | = "ml_gsl_rng_uniform_pos_arr" 113 | [@@noalloc] 114 | -------------------------------------------------------------------------------- /examples/multimin_ex.ml: -------------------------------------------------------------------------------- 1 | open Gsl 2 | open Fun 3 | 4 | let _ = Error.init () 5 | 6 | let parab a b = 7 | let f ~x = 8 | let xa = x.{0} -. a in 9 | let yb = x.{1} -. b in 10 | (10. *. xa *. xa) +. (20. *. yb *. yb) +. 30. 11 | in 12 | let df ~x ~g = 13 | g.{0} <- 20. *. (x.{0} -. a); 14 | g.{1} <- 40. *. (x.{1} -. b) 15 | in 16 | let fdf ~x ~g = 17 | let xa = x.{0} -. a in 18 | let yb = x.{1} -. b in 19 | g.{0} <- 20. *. xa; 20 | g.{1} <- 40. *. yb; 21 | (10. *. xa *. xa) +. (20. *. yb *. yb) +. 30. 22 | in 23 | { multim_f = f; multim_df = df; multim_fdf = fdf } 24 | 25 | let epsabs = 1e-3 26 | let maxiter = 50 27 | 28 | let print_state n = 29 | let x = Vector.create n in 30 | let g = Vector.create n in 31 | fun mini iter -> 32 | let f = Multimin.Deriv.minimum ~x ~g mini in 33 | Printf.printf "%5d x=%.5f y=%.5f f=%10.5f g0=%.5g g1=%.5g\n" iter x.{0} 34 | x.{1} f g.{0} g.{1} 35 | 36 | let mini kind gf start ~step ~tol = 37 | let minim = 38 | Multimin.Deriv.make kind 2 gf ~x:(Vector.of_array start) ~step ~tol 39 | in 40 | let print_state = print_state 2 in 41 | let rec proc iter = 42 | Multimin.Deriv.iterate minim; 43 | let status = Multimin.Deriv.test_gradient minim epsabs in 44 | match status with 45 | | true -> 46 | Printf.printf "Minimum found at:\n"; 47 | print_state minim iter 48 | | false when iter >= maxiter -> 49 | print_state minim iter; 50 | Printf.printf "Too many iterations\n" 51 | | false -> 52 | print_state minim iter; 53 | proc (succ iter) 54 | in 55 | Printf.printf "minimizer: %s\n" (Multimin.Deriv.name minim); 56 | proc 1 57 | 58 | let print_state_simplex n = 59 | let x = Vector.create n in 60 | fun mini iter -> 61 | let f = Multimin.NoDeriv.minimum ~x mini in 62 | let ssval = Multimin.NoDeriv.size mini in 63 | Printf.printf "%5d x=%10.3f y=%10.3f f()=%-10.3f ssize=%.3f\n" iter x.{0} 64 | x.{1} f ssval 65 | 66 | let mini_simplex kind gf ~start ~step_size = 67 | let minim = 68 | Multimin.NoDeriv.make kind 2 gf ~x:(Vector.of_array start) 69 | ~step_size:(Vector.of_array step_size) 70 | in 71 | let print_state = print_state_simplex 2 in 72 | let rec proc iter = 73 | Multimin.NoDeriv.iterate minim; 74 | let status = Multimin.NoDeriv.test_size minim epsabs in 75 | match status with 76 | | true -> 77 | Printf.printf "Minimum found at:\n"; 78 | print_state minim iter 79 | | false when iter >= maxiter -> 80 | print_state minim iter; 81 | Printf.printf "Too many iterations\n" 82 | | false -> 83 | print_state minim iter; 84 | proc (succ iter) 85 | in 86 | Printf.printf "minimizer: %s\n" (Multimin.NoDeriv.name minim); 87 | proc 1 88 | 89 | open Multimin.Deriv 90 | 91 | let _ = 92 | List.iter 93 | (fun kind -> 94 | mini kind (parab 1. 2.) [| 5.; 7. |] ~step:0.01 ~tol:1e-4; 95 | print_newline (); 96 | flush stdout) 97 | [ CONJUGATE_FR; CONJUGATE_PR; VECTOR_BFGS; STEEPEST_DESCENT ]; 98 | 99 | mini_simplex Multimin.NoDeriv.NM_SIMPLEX (parab 1. 2.).multim_f 100 | ~start:[| 5.; 7. |] ~step_size:[| 1.; 1. |] 101 | -------------------------------------------------------------------------------- /lib/mlgsl_vector.h: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | #include 7 | 8 | #include "wrappers.h" 9 | 10 | #ifndef TYPE 11 | #error pb with include files 12 | #endif 13 | 14 | static inline void TYPE(mlgsl_vec_of_bigarray)(TYPE(gsl_vector) * cvec, 15 | value vvec) { 16 | struct caml_ba_array *bigarr = Caml_ba_array_val(vvec); 17 | cvec->block = NULL; 18 | cvec->owner = 0; 19 | cvec->size = bigarr->dim[0]; 20 | cvec->stride = 1; 21 | cvec->data = bigarr->data; 22 | } 23 | 24 | #ifdef CONV_FLAT 25 | static inline void TYPE(mlgsl_vec_of_floatarray)(TYPE(gsl_vector) * cvec, 26 | value vvec) { 27 | cvec->block = NULL; 28 | cvec->owner = 0; 29 | cvec->size = Int_val(Field(vvec, 2)); 30 | cvec->stride = Int_val(Field(vvec, 3)); 31 | cvec->data = (double *)Field(vvec, 0) + Int_val(Field(vvec, 1)); 32 | } 33 | #endif 34 | 35 | static inline void TYPE(mlgsl_vec_of_value)(TYPE(gsl_vector) * cvec, 36 | value vvec) { 37 | if (Tag_val(vvec) == 0 && Wosize_val(vvec) == 2) 38 | /* value is a polymorphic variant */ 39 | vvec = Field(vvec, 1); 40 | if (Tag_val(vvec) == Custom_tag) 41 | /* value is a bigarray */ 42 | TYPE(mlgsl_vec_of_bigarray)(cvec, vvec); 43 | #ifdef CONV_FLAT 44 | else 45 | /* value is a record wrapping a float array */ 46 | TYPE(mlgsl_vec_of_floatarray)(cvec, vvec); 47 | #endif 48 | } 49 | 50 | #define _DECLARE_VECTOR(a) TYPE(gsl_vector) v_##a 51 | #define _DECLARE_VECTOR2(a, b) \ 52 | _DECLARE_VECTOR(a); \ 53 | _DECLARE_VECTOR(b) 54 | #define _DECLARE_VECTOR3(a, b, c) \ 55 | _DECLARE_VECTOR2(a, b); \ 56 | _DECLARE_VECTOR(c) 57 | #define _DECLARE_VECTOR4(a, b, c, d) \ 58 | _DECLARE_VECTOR2(a, b); \ 59 | _DECLARE_VECTOR2(c, d) 60 | #define _DECLARE_VECTOR5(a, b, c, d, e) \ 61 | _DECLARE_VECTOR4(a, b, c, d); \ 62 | _DECLARE_VECTOR(e) 63 | 64 | #define _CONVERT_VECTOR(a) TYPE(mlgsl_vec_of_value)(&v_##a, a) 65 | #define _CONVERT_VECTOR2(a, b) \ 66 | _CONVERT_VECTOR(a); \ 67 | _CONVERT_VECTOR(b) 68 | #define _CONVERT_VECTOR3(a, b, c) \ 69 | _CONVERT_VECTOR2(a, b); \ 70 | _CONVERT_VECTOR(c) 71 | #define _CONVERT_VECTOR4(a, b, c, d) \ 72 | _CONVERT_VECTOR2(a, b); \ 73 | _CONVERT_VECTOR2(c, d) 74 | #define _CONVERT_VECTOR5(a, b, c, d, e) \ 75 | _CONVERT_VECTOR4(a, b, c, d); \ 76 | _CONVERT_VECTOR(e) 77 | -------------------------------------------------------------------------------- /lib/mlgsl_complex.c: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2003 - Paul Pelzl */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include "mlgsl_complex.h" 6 | #include 7 | #include 8 | 9 | #define _COMPLEX_HANDLER(funct) \ 10 | CAMLprim value ml_gsl_complex_##funct(value Z) { \ 11 | _DECLARE_COMPLEX2(Z, temp); \ 12 | _CONVERT_COMPLEX(Z); \ 13 | z_temp = gsl_complex_##funct(z_Z); \ 14 | return copy_complex(&z_temp); \ 15 | } 16 | 17 | #define _COMPLEX_HANDLER2(funct) \ 18 | CAMLprim value ml_gsl_complex_##funct(value Z, value A) { \ 19 | _DECLARE_COMPLEX3(Z, A, temp); \ 20 | _CONVERT_COMPLEX2(Z, A); \ 21 | z_temp = gsl_complex_##funct(z_Z, z_A); \ 22 | return copy_complex(&z_temp); \ 23 | } 24 | 25 | #define _COMPLEX_HANDLER_DOUBLE(funct) \ 26 | CAMLprim value ml_gsl_complex_##funct(value X) { \ 27 | gsl_complex temp; \ 28 | temp = gsl_complex_##funct(Double_val(X)); \ 29 | return copy_complex(&temp); \ 30 | } 31 | 32 | /* properties of complex numbers */ 33 | CAMLprim value ml_gsl_complex_logabs(value Z) { 34 | _DECLARE_COMPLEX(Z); 35 | _CONVERT_COMPLEX(Z); 36 | return caml_copy_double(gsl_complex_logabs(z_Z)); 37 | } 38 | 39 | _COMPLEX_HANDLER(sqrt) 40 | _COMPLEX_HANDLER_DOUBLE(sqrt_real) 41 | _COMPLEX_HANDLER2(pow) 42 | 43 | CAMLprim value ml_gsl_complex_pow_real(value Z, value X) { 44 | _DECLARE_COMPLEX2(Z, temp); 45 | _CONVERT_COMPLEX(Z); 46 | z_temp = gsl_complex_pow_real(z_Z, Double_val(X)); 47 | return copy_complex(&z_temp); 48 | } 49 | 50 | _COMPLEX_HANDLER(exp) 51 | _COMPLEX_HANDLER(log) 52 | _COMPLEX_HANDLER(log10) 53 | _COMPLEX_HANDLER2(log_b) 54 | 55 | _COMPLEX_HANDLER(sin) 56 | _COMPLEX_HANDLER(cos) 57 | _COMPLEX_HANDLER(tan) 58 | _COMPLEX_HANDLER(sec) 59 | _COMPLEX_HANDLER(csc) 60 | _COMPLEX_HANDLER(cot) 61 | 62 | _COMPLEX_HANDLER(arcsin) 63 | _COMPLEX_HANDLER_DOUBLE(arcsin_real) 64 | _COMPLEX_HANDLER(arccos) 65 | _COMPLEX_HANDLER_DOUBLE(arccos_real) 66 | _COMPLEX_HANDLER(arctan) 67 | _COMPLEX_HANDLER(arcsec) 68 | _COMPLEX_HANDLER_DOUBLE(arcsec_real) 69 | _COMPLEX_HANDLER(arccsc) 70 | _COMPLEX_HANDLER_DOUBLE(arccsc_real) 71 | _COMPLEX_HANDLER(arccot) 72 | 73 | _COMPLEX_HANDLER(sinh) 74 | _COMPLEX_HANDLER(cosh) 75 | _COMPLEX_HANDLER(tanh) 76 | _COMPLEX_HANDLER(sech) 77 | _COMPLEX_HANDLER(csch) 78 | _COMPLEX_HANDLER(coth) 79 | 80 | _COMPLEX_HANDLER(arcsinh) 81 | _COMPLEX_HANDLER(arccosh) 82 | _COMPLEX_HANDLER_DOUBLE(arccosh_real) 83 | _COMPLEX_HANDLER(arctanh) 84 | _COMPLEX_HANDLER_DOUBLE(arctanh_real) 85 | _COMPLEX_HANDLER(arcsech) 86 | _COMPLEX_HANDLER(arccsch) 87 | _COMPLEX_HANDLER(arccoth) 88 | -------------------------------------------------------------------------------- /lib/eigen.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Eigensystems *) 6 | 7 | open Vectmat 8 | 9 | (** {3 Real Symmetric Matrices} *) 10 | 11 | type symm_ws 12 | 13 | val make_symm_ws : int -> symm_ws 14 | external _symm : mat -> vec -> symm_ws -> unit = "ml_gsl_eigen_symm" 15 | 16 | val symm : 17 | ?protect:bool -> 18 | [< `M of Matrix.matrix 19 | | `MF of Matrix_flat.matrix 20 | | `A of float array * int * int 21 | | `AA of float array array ] -> 22 | Vector.vector 23 | 24 | type symmv_ws 25 | 26 | val make_symmv_ws : int -> symmv_ws 27 | external _symmv : mat -> vec -> mat -> symmv_ws -> unit = "ml_gsl_eigen_symmv" 28 | 29 | val symmv : 30 | ?protect:bool -> 31 | [< `M of Matrix.matrix 32 | | `MF of Matrix_flat.matrix 33 | | `A of float array * int * int 34 | | `AA of float array array ] -> 35 | Vector.vector * Matrix.matrix 36 | 37 | type sort = VAL_ASC | VAL_DESC | ABS_ASC | ABS_DESC 38 | 39 | external symmv_sort : Vector.vector * Matrix.matrix -> sort -> unit 40 | = "ml_gsl_eigen_symmv_sort" 41 | 42 | (** {3 Complex Hermitian Matrices} *) 43 | 44 | type herm_ws 45 | 46 | val make_herm_ws : int -> herm_ws 47 | external _herm : cmat -> vec -> herm_ws -> unit = "ml_gsl_eigen_herm" 48 | 49 | val herm : 50 | ?protect:bool -> 51 | [< `CM of Matrix_complex.matrix 52 | | `CMF of Matrix_complex_flat.matrix 53 | | `CA of Gsl_complex.complex_array * int * int ] -> 54 | Vector.vector 55 | 56 | type hermv_ws 57 | 58 | val make_hermv_ws : int -> hermv_ws 59 | external _hermv : cmat -> vec -> cmat -> hermv_ws -> unit = "ml_gsl_eigen_hermv" 60 | 61 | val hermv : 62 | ?protect:bool -> 63 | [< `CM of Matrix_complex.matrix 64 | | `CMF of Matrix_complex_flat.matrix 65 | | `CA of Gsl_complex.complex_array * int * int ] -> 66 | Vector.vector * Matrix_complex.matrix 67 | 68 | external hermv_sort : Vector.vector * Matrix_complex.matrix -> sort -> unit 69 | = "ml_gsl_eigen_hermv_sort" 70 | 71 | (** {3 Real Nonsymmetric Matrices} *) 72 | 73 | type nonsymm_ws 74 | 75 | val make_nonsymm_ws : int -> nonsymm_ws 76 | external _nonsymm : mat -> cvec -> nonsymm_ws -> unit = "ml_gsl_eigen_nonsymm" 77 | 78 | external _nonsymm_Z : mat -> cvec -> mat -> nonsymm_ws -> unit 79 | = "ml_gsl_eigen_nonsymm_Z" 80 | 81 | val nonsymm : 82 | ?protect:bool -> 83 | [< `M of Matrix.matrix 84 | | `MF of Matrix_flat.matrix 85 | | `A of float array * int * int 86 | | `AA of float array array ] -> 87 | Vector_complex.vector 88 | 89 | type nonsymmv_ws 90 | 91 | val make_nonsymmv_ws : int -> nonsymmv_ws 92 | 93 | external _nonsymmv : mat -> cvec -> cmat -> nonsymmv_ws -> unit 94 | = "ml_gsl_eigen_nonsymmv" 95 | 96 | external _nonsymmv_Z : mat -> cvec -> cmat -> mat -> nonsymmv_ws -> unit 97 | = "ml_gsl_eigen_nonsymmv_Z" 98 | 99 | val nonsymmv : 100 | ?protect:bool -> 101 | [< `M of Matrix.matrix 102 | | `MF of Matrix_flat.matrix 103 | | `A of float array * int * int 104 | | `AA of float array array ] -> 105 | Vector_complex.vector * Matrix_complex.matrix 106 | 107 | external nonsymmv_sort : 108 | Vector_complex.vector * Matrix_complex.matrix -> sort -> unit 109 | = "ml_gsl_eigen_nonsymmv_sort" 110 | -------------------------------------------------------------------------------- /lib/mlgsl_vector_impl.h: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #include 6 | 7 | #ifndef FUNCTION 8 | #error pb with include files 9 | #endif 10 | 11 | CAMLprim value FUNCTION(ml_gsl_vector, memcpy)(value a, value b) { 12 | _DECLARE_VECTOR2(a, b); 13 | _CONVERT_VECTOR2(a, b); 14 | FUNCTION(gsl_vector, memcpy)(&v_b, &v_a); 15 | return Val_unit; 16 | } 17 | 18 | CAMLprim value FUNCTION(ml_gsl_vector, add)(value a, value b) { 19 | _DECLARE_VECTOR2(a, b); 20 | _CONVERT_VECTOR2(a, b); 21 | FUNCTION(gsl_vector, add)(&v_a, &v_b); 22 | return Val_unit; 23 | } 24 | 25 | CAMLprim value FUNCTION(ml_gsl_vector, sub)(value a, value b) { 26 | _DECLARE_VECTOR2(a, b); 27 | _CONVERT_VECTOR2(a, b); 28 | FUNCTION(gsl_vector, sub)(&v_a, &v_b); 29 | return Val_unit; 30 | } 31 | 32 | CAMLprim value FUNCTION(ml_gsl_vector, mul)(value a, value b) { 33 | _DECLARE_VECTOR2(a, b); 34 | _CONVERT_VECTOR2(a, b); 35 | FUNCTION(gsl_vector, mul)(&v_a, &v_b); 36 | return Val_unit; 37 | } 38 | 39 | CAMLprim value FUNCTION(ml_gsl_vector, div)(value a, value b) { 40 | _DECLARE_VECTOR2(a, b); 41 | _CONVERT_VECTOR2(a, b); 42 | FUNCTION(gsl_vector, div)(&v_a, &v_b); 43 | return Val_unit; 44 | } 45 | 46 | CAMLprim value FUNCTION(ml_gsl_vector, scale)(value a, value x) { 47 | _DECLARE_VECTOR(a); 48 | _CONVERT_VECTOR(a); 49 | FUNCTION(gsl_vector, scale)(&v_a, Double_val(x)); 50 | return Val_unit; 51 | } 52 | 53 | CAMLprim value FUNCTION(ml_gsl_vector, add_constant)(value a, value x) { 54 | _DECLARE_VECTOR(a); 55 | _CONVERT_VECTOR(a); 56 | FUNCTION(gsl_vector, add_constant)(&v_a, Double_val(x)); 57 | return Val_unit; 58 | } 59 | 60 | CAMLprim value FUNCTION(ml_gsl_vector, isnull)(value a) { 61 | int r; 62 | _DECLARE_VECTOR(a); 63 | _CONVERT_VECTOR(a); 64 | r = FUNCTION(gsl_vector, isnull)(&v_a); 65 | return Val_bool(r); 66 | } 67 | 68 | CAMLprim value FUNCTION(ml_gsl_vector, max)(value a) { 69 | _DECLARE_VECTOR(a); 70 | _CONVERT_VECTOR(a); 71 | return caml_copy_double(FUNCTION(gsl_vector, max)(&v_a)); 72 | } 73 | 74 | CAMLprim value FUNCTION(ml_gsl_vector, min)(value a) { 75 | _DECLARE_VECTOR(a); 76 | _CONVERT_VECTOR(a); 77 | return caml_copy_double(FUNCTION(gsl_vector, min)(&v_a)); 78 | } 79 | 80 | CAMLprim value FUNCTION(ml_gsl_vector, minmax)(value a) { 81 | BASE_TYPE x, y; 82 | _DECLARE_VECTOR(a); 83 | _CONVERT_VECTOR(a); 84 | FUNCTION(gsl_vector, minmax)(&v_a, &x, &y); 85 | return copy_two_double(x, y); 86 | } 87 | 88 | CAMLprim value FUNCTION(ml_gsl_vector, maxindex)(value a) { 89 | _DECLARE_VECTOR(a); 90 | _CONVERT_VECTOR(a); 91 | return Val_int(FUNCTION(gsl_vector, max_index)(&v_a)); 92 | } 93 | 94 | CAMLprim value FUNCTION(ml_gsl_vector, minindex)(value a) { 95 | _DECLARE_VECTOR(a); 96 | _CONVERT_VECTOR(a); 97 | return Val_int(FUNCTION(gsl_vector, min_index)(&v_a)); 98 | } 99 | 100 | CAMLprim value FUNCTION(ml_gsl_vector, minmaxindex)(value a) { 101 | size_t x, y; 102 | value v; 103 | _DECLARE_VECTOR(a); 104 | _CONVERT_VECTOR(a); 105 | FUNCTION(gsl_vector, minmax_index)(&v_a, &x, &y); 106 | v = caml_alloc_small(2, 0); 107 | Field(v, 0) = Val_int(x); 108 | Field(v, 1) = Val_int(y); 109 | return v; 110 | } 111 | -------------------------------------------------------------------------------- /lib/fft.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Fast Fourier Transforms *) 6 | 7 | open Gsl_complex 8 | 9 | exception Wrong_layout 10 | 11 | type layout = Real | Halfcomplex | Halfcomplex_rad2 | Complex 12 | type fft_array = { mutable layout : layout; data : float array } 13 | 14 | module Real : sig 15 | type workspace 16 | type wavetable 17 | 18 | val make_workspace : int -> workspace 19 | val make_wavetable : int -> wavetable 20 | 21 | external transform : 22 | ?stride:int -> fft_array -> wavetable -> workspace -> unit 23 | = "ml_gsl_fft_real_transform" 24 | 25 | external transform_rad2 : ?stride:int -> fft_array -> unit 26 | = "ml_gsl_fft_real_radix2_transform" 27 | 28 | val unpack : ?stride:int -> fft_array -> fft_array 29 | end 30 | 31 | module Halfcomplex : sig 32 | type wavetable 33 | 34 | val make_wavetable : int -> wavetable 35 | 36 | external transform : 37 | ?stride:int -> fft_array -> wavetable -> Real.workspace -> unit 38 | = "ml_gsl_fft_halfcomplex_transform" 39 | 40 | external transform_rad2 : ?stride:int -> fft_array -> unit 41 | = "ml_gsl_fft_halfcomplex_radix2_transform" 42 | 43 | external backward : 44 | ?stride:int -> fft_array -> wavetable -> Real.workspace -> unit 45 | = "ml_gsl_fft_halfcomplex_backward" 46 | 47 | external backward_rad2 : ?stride:int -> fft_array -> unit 48 | = "ml_gsl_fft_halfcomplex_radix2_backward" 49 | 50 | external inverse : 51 | ?stride:int -> fft_array -> wavetable -> Real.workspace -> unit 52 | = "ml_gsl_fft_halfcomplex_inverse" 53 | 54 | external inverse_rad2 : ?stride:int -> fft_array -> unit 55 | = "ml_gsl_fft_halfcomplex_radix2_inverse" 56 | 57 | val unpack : ?stride:int -> fft_array -> fft_array 58 | end 59 | 60 | module Complex : sig 61 | type workspace 62 | type wavetable 63 | type direction = Forward | Backward 64 | 65 | val make_workspace : int -> workspace 66 | val make_wavetable : int -> wavetable 67 | 68 | external forward : 69 | ?stride:int -> complex_array -> wavetable -> workspace -> unit 70 | = "ml_gsl_fft_complex_forward" 71 | 72 | external forward_rad2 : ?dif:bool -> ?stride:int -> complex_array -> unit 73 | = "ml_gsl_fft_complex_rad2_forward" 74 | 75 | external transform : 76 | ?stride:int -> complex_array -> wavetable -> workspace -> direction -> unit 77 | = "ml_gsl_fft_complex_transform" 78 | 79 | external transform_rad2 : 80 | ?dif:bool -> ?stride:int -> complex_array -> direction -> unit 81 | = "ml_gsl_fft_complex_rad2_transform" 82 | 83 | external backward : 84 | ?stride:int -> complex_array -> wavetable -> workspace -> unit 85 | = "ml_gsl_fft_complex_backward" 86 | 87 | external backward_rad2 : ?dif:bool -> ?stride:int -> complex_array -> unit 88 | = "ml_gsl_fft_complex_rad2_backward" 89 | 90 | external inverse : 91 | ?stride:int -> complex_array -> wavetable -> workspace -> unit 92 | = "ml_gsl_fft_complex_inverse" 93 | 94 | external inverse_rad2 : ?dif:bool -> ?stride:int -> complex_array -> unit 95 | = "ml_gsl_fft_complex_rad2_inverse" 96 | end 97 | 98 | val unpack : fft_array -> complex_array 99 | val hc_mult : fft_array -> fft_array -> unit 100 | val hc_mult_rad2 : fft_array -> fft_array -> unit 101 | -------------------------------------------------------------------------------- /lib/error.mli: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | (** Error reporting *) 6 | 7 | val version : string 8 | (** Version of GSL library. *) 9 | 10 | type errno = 11 | | CONTINUE (** iteration has not converged *) 12 | | FAILURE 13 | | EDOM (** input domain error, e.g sqrt(-1) *) 14 | | ERANGE (** output range error, e.g. exp(1e100) *) 15 | | EFAULT (** invalid pointer *) 16 | | EINVAL (** invalid argument supplied by user *) 17 | | EFAILED (** generic failure *) 18 | | EFACTOR (** factorization failed *) 19 | | ESANITY (** sanity check failed - shouldn't happen *) 20 | | ENOMEM (** malloc failed *) 21 | | EBADFUNC (** problem with user-supplied function *) 22 | | ERUNAWAY (** iterative process is out of control *) 23 | | EMAXITER (** exceeded max number of iterations *) 24 | | EZERODIV (** tried to divide by zero *) 25 | | EBADTOL (** user specified an invalid tolerance *) 26 | | ETOL (** failed to reach the specified tolerance *) 27 | | EUNDRFLW (** underflow *) 28 | | EOVRFLW (** overflow *) 29 | | ELOSS (** loss of accuracy *) 30 | | EROUND (** failed because of roundoff error *) 31 | | EBADLEN (** matrix, vector lengths are not conformant *) 32 | | ENOTSQR (** matrix not square *) 33 | | ESING (** apparent singularity detected *) 34 | | EDIVERGE (** integral or series is divergent *) 35 | | EUNSUP (** requested feature is not supported by the hardware *) 36 | | EUNIMPL (** requested feature not (yet) implemented *) 37 | | ECACHE (** cache limit exceeded *) 38 | | ETABLE (** table limit exceeded *) 39 | | ENOPROG (** iteration is not making progress towards solution *) 40 | | ENOPROGJ (** jacobian evaluations are not improving the solution *) 41 | | ETOLF (** cannot reach the specified tolerance in F *) 42 | | ETOLX (** cannot reach the specified tolerance in X *) 43 | | ETOLG (** cannot reach the specified tolerance in gradient *) 44 | | EOF (** end of file *) 45 | 46 | exception Gsl_exn of errno * string 47 | (** [Error.Gsl_exn] is raised by GSL to indicate an error. The second argument 48 | gives the reason for the error. *) 49 | 50 | val init : unit -> unit 51 | (** [Error.init ()] sets up the GSL error handler so that the OCaml function 52 | {!Error.handler} gets called in case of an error. This behavior is the 53 | default now. *) 54 | 55 | val uninit : unit -> unit 56 | (** [Error.uninit ()] reverts the GSL error handler to the default of the GSL 57 | C-library. The default GSL error simply aborts the program. *) 58 | 59 | val handler : (errno -> string -> unit) ref 60 | (** The OCaml handler for GSL errors. Initially set to {!Error.default_handler}. 61 | If the function returns, the error is ignored and execution of the GSL 62 | function continues. 63 | 64 | Redefine it so as to ignore some particular errors ([EOVRFLW] or [EUNDRFLW] 65 | for instance). *) 66 | 67 | val default_handler : errno -> string -> 'a 68 | (** The default OCaml handler for GSL errors. It simply raises the 69 | {!Error.Gsl_exn} exception. *) 70 | 71 | val strerror : errno -> string 72 | (** [strerror e] returns a description of the error [e]. *) 73 | 74 | val string_of_errno : errno -> string 75 | (** [string_of_errno e] returns the name of [e]. *) 76 | 77 | val printer : exn -> string option 78 | (** [printer exn] is an exception printer for [exn]. It is registered by default 79 | with [Printexc]. *) 80 | -------------------------------------------------------------------------------- /lib/vector_complex.ml: -------------------------------------------------------------------------------- 1 | (* gsl-ocaml - OCaml interface to GSL *) 2 | (* Copyright (©) 2002-2012 - Olivier Andrieu *) 3 | (* Distributed under the terms of the GPL version 3 *) 4 | 5 | let () = Error.init () 6 | 7 | open Bigarray 8 | 9 | type complex_double_vector_bigarr = 10 | (Complex.t, complex64_elt, c_layout) Bigarray.Array1.t 11 | 12 | type vector = complex_double_vector_bigarr 13 | 14 | let create ?init len = 15 | let barr = Array1.create complex64 c_layout len in 16 | (match init with None -> () | Some x -> Array1.fill barr x); 17 | barr 18 | 19 | let length = Array1.dim 20 | let of_array arr = Array1.of_array complex64 c_layout arr 21 | let to_array v = Array.init (Array1.dim v) (Array1.get v) 22 | 23 | let of_complex_array arr = 24 | let n = Array.length arr / 2 in 25 | let barr = create n in 26 | for i = 0 to pred n do 27 | barr.{i} <- Gsl_complex.get arr i 28 | done; 29 | barr 30 | 31 | let to_complex_array barr = 32 | let n = Array1.dim barr in 33 | let arr = Array.make (2 * n) 0. in 34 | for i = 0 to pred n do 35 | Gsl_complex.set arr i barr.{i} 36 | done; 37 | arr 38 | 39 | let get (v : vector) i = Array1.get v i 40 | let set (v : vector) i x = Array1.set v i x 41 | let set_all = Array1.fill 42 | let set_zero v = set_all v Complex.zero 43 | 44 | let set_basis v i = 45 | set_zero v; 46 | set v i Complex.one 47 | 48 | let subvector v ~off ~len = Array1.sub v off len 49 | 50 | let memcpy ~src:v ~dst:w = 51 | if length v <> length w then invalid_arg "Vector.memcpy"; 52 | Array1.blit v w 53 | 54 | let copy v = 55 | let w = create (length v) in 56 | memcpy ~src:v ~dst:w; 57 | w 58 | 59 | let swap_element v i j = 60 | let d = get v i in 61 | let d' = get v j in 62 | set v j d; 63 | set v i d' 64 | 65 | let reverse v = 66 | let len = length v in 67 | for i = 0 to pred (len / 2) do 68 | swap_element v i (pred len - i) 69 | done 70 | 71 | module Single = struct 72 | type complex_float_vector_bigarr = 73 | (Complex.t, complex32_elt, c_layout) Bigarray.Array1.t 74 | 75 | type vector = complex_float_vector_bigarr 76 | 77 | let create ?init len = 78 | let barr = Array1.create complex32 c_layout len in 79 | (match init with None -> () | Some x -> Array1.fill barr x); 80 | barr 81 | 82 | let length = length 83 | let of_array arr = Array1.of_array complex32 c_layout arr 84 | let to_array = to_array 85 | 86 | let of_complex_array arr = 87 | let n = Array.length arr / 2 in 88 | let barr = create n in 89 | for i = 0 to pred n do 90 | barr.{i} <- Gsl_complex.get arr i 91 | done; 92 | barr 93 | 94 | let to_complex_array barr = 95 | let n = Array1.dim barr in 96 | let arr = Array.make (2 * n) 0. in 97 | for i = 0 to pred n do 98 | Gsl_complex.set arr i barr.{i} 99 | done; 100 | arr 101 | 102 | let get (v : vector) i = Array1.get v i 103 | let set (v : vector) i x = Array1.set v i x 104 | let set_all = set_all 105 | let set_zero = set_zero 106 | 107 | let set_basis v i = 108 | set_zero v; 109 | set v i Complex.one 110 | 111 | let subvector = subvector 112 | let memcpy = memcpy 113 | 114 | let copy v = 115 | let w = create (length v) in 116 | memcpy ~src:v ~dst:w; 117 | w 118 | 119 | let swap_element v i j = 120 | let d = get v i in 121 | let d' = get v j in 122 | set v j d; 123 | set v i d' 124 | 125 | let reverse v = 126 | let len = length v in 127 | for i = 0 to pred (len / 2) do 128 | swap_element v i (pred len - i) 129 | done 130 | end 131 | -------------------------------------------------------------------------------- /lib/mlgsl_matrix_impl.h: -------------------------------------------------------------------------------- 1 | /* gsl-ocaml - OCaml interface to GSL */ 2 | /* Copyright (©) 2002-2012 - Olivier Andrieu */ 3 | /* Distributed under the terms of the GPL version 3 */ 4 | 5 | #ifndef FUNCTION 6 | #error pb with include files 7 | #endif 8 | 9 | CAMLprim value FUNCTION(ml_gsl_matrix, memcpy)(value A, value B) { 10 | _DECLARE_MATRIX2(A, B); 11 | _CONVERT_MATRIX2(A, B); 12 | FUNCTION(gsl_matrix, memcpy)(&m_B, &m_A); 13 | return Val_unit; 14 | } 15 | 16 | CAMLprim value FUNCTION(ml_gsl_matrix, add)(value A, value B) { 17 | _DECLARE_MATRIX2(A, B); 18 | _CONVERT_MATRIX2(A, B); 19 | FUNCTION(gsl_matrix, add)(&m_A, &m_B); 20 | return Val_unit; 21 | } 22 | 23 | CAMLprim value FUNCTION(ml_gsl_matrix, sub)(value A, value B) { 24 | _DECLARE_MATRIX2(A, B); 25 | _CONVERT_MATRIX2(A, B); 26 | FUNCTION(gsl_matrix, sub)(&m_A, &m_B); 27 | return Val_unit; 28 | } 29 | 30 | CAMLprim value FUNCTION(ml_gsl_matrix, mul)(value A, value B) { 31 | _DECLARE_MATRIX2(A, B); 32 | _CONVERT_MATRIX2(A, B); 33 | FUNCTION(gsl_matrix, mul_elements)(&m_A, &m_B); 34 | return Val_unit; 35 | } 36 | 37 | CAMLprim value FUNCTION(ml_gsl_matrix, div)(value A, value B) { 38 | _DECLARE_MATRIX2(A, B); 39 | _CONVERT_MATRIX2(A, B); 40 | FUNCTION(gsl_matrix, div_elements)(&m_A, &m_B); 41 | return Val_unit; 42 | } 43 | 44 | CAMLprim value FUNCTION(ml_gsl_matrix, scale)(value A, value X) { 45 | _DECLARE_MATRIX(A); 46 | _DECLARE_BASE_TYPE(X); 47 | _CONVERT_MATRIX(A); 48 | _CONVERT_BASE_TYPE(X); 49 | FUNCTION(gsl_matrix, scale)(&m_A, conv_X); 50 | return Val_unit; 51 | } 52 | 53 | CAMLprim value FUNCTION(ml_gsl_matrix, add_constant)(value A, value X) { 54 | _DECLARE_MATRIX(A); 55 | _DECLARE_BASE_TYPE(X); 56 | _CONVERT_MATRIX(A); 57 | _CONVERT_BASE_TYPE(X); 58 | FUNCTION(gsl_matrix, add_constant)(&m_A, conv_X); 59 | return Val_unit; 60 | } 61 | 62 | CAMLprim value FUNCTION(ml_gsl_matrix, add_diagonal)(value A, value X) { 63 | _DECLARE_MATRIX(A); 64 | _DECLARE_BASE_TYPE(X); 65 | _CONVERT_MATRIX(A); 66 | _CONVERT_BASE_TYPE(X); 67 | FUNCTION(gsl_matrix, add_diagonal)(&m_A, conv_X); 68 | return Val_unit; 69 | } 70 | 71 | CAMLprim value FUNCTION(ml_gsl_matrix, isnull)(value A) { 72 | int r; 73 | _DECLARE_MATRIX(A); 74 | _CONVERT_MATRIX(A); 75 | r = FUNCTION(gsl_matrix, isnull)(&m_A); 76 | return Val_bool(r); 77 | } 78 | 79 | CAMLprim value FUNCTION(ml_gsl_matrix, swap_rows)(value A, value i, value j) { 80 | _DECLARE_MATRIX(A); 81 | _CONVERT_MATRIX(A); 82 | FUNCTION(gsl_matrix, swap_rows)(&m_A, Int_val(i), Int_val(j)); 83 | return Val_unit; 84 | } 85 | 86 | CAMLprim value FUNCTION(ml_gsl_matrix, swap_columns)(value A, value i, 87 | value j) { 88 | _DECLARE_MATRIX(A); 89 | _CONVERT_MATRIX(A); 90 | FUNCTION(gsl_matrix, swap_columns)(&m_A, Int_val(i), Int_val(j)); 91 | return Val_unit; 92 | } 93 | 94 | CAMLprim value FUNCTION(ml_gsl_matrix, swap_rowcol)(value A, value i, value j) { 95 | _DECLARE_MATRIX(A); 96 | _CONVERT_MATRIX(A); 97 | FUNCTION(gsl_matrix, swap_rowcol)(&m_A, Int_val(i), Int_val(j)); 98 | return Val_unit; 99 | } 100 | 101 | CAMLprim value FUNCTION(ml_gsl_matrix, transpose_memcpy)(value A, value B) { 102 | _DECLARE_MATRIX2(A, B); 103 | _CONVERT_MATRIX2(A, B); 104 | FUNCTION(gsl_matrix, transpose_memcpy)(&m_A, &m_B); 105 | return Val_unit; 106 | } 107 | 108 | CAMLprim value FUNCTION(ml_gsl_matrix, transpose)(value A) { 109 | _DECLARE_MATRIX(A); 110 | _CONVERT_MATRIX(A); 111 | FUNCTION(gsl_matrix, transpose)(&m_A); 112 | return Val_unit; 113 | } 114 | --------------------------------------------------------------------------------