pax_global_header00006660000000000000000000000064126231127410014511gustar00rootroot0000000000000052 comment=1e0ccc1016f0ef1646bb59563963c1d2eb47452e gsl-ocaml-1.19.1/000077500000000000000000000000001262311274100134605ustar00rootroot00000000000000gsl-ocaml-1.19.1/.gitattributes000066400000000000000000000000351262311274100163510ustar00rootroot00000000000000*.ml linguist-language=OCaml gsl-ocaml-1.19.1/.gitignore000066400000000000000000000001041262311274100154430ustar00rootroot00000000000000_build API.docdir *.bak .*.swp setup.data setup.log *.byte *.native gsl-ocaml-1.19.1/API.odocl000066400000000000000000000015661262311274100151230ustar00rootroot00000000000000# OASIS_START # DO NOT EDIT (digest: d40cc5ab833af89feba6cd40db901cd9) lib/Gsl lib/Gsl_blas lib/Gsl_blas_flat lib/Gsl_blas_gen lib/Gsl_bspline lib/Gsl_cdf lib/Gsl_cheb lib/Gsl_combi lib/Gsl_const lib/Gsl_deriv lib/Gsl_eigen lib/Gsl_error lib/Gsl_fft lib/Gsl_fit lib/Gsl_fun lib/Gsl_complex lib/Gsl_sort lib/Gsl_histo lib/Gsl_ieee lib/Gsl_integration lib/Gsl_interp lib/Gsl_linalg lib/Gsl_math lib/Gsl_matrix lib/Gsl_matrix_complex lib/Gsl_matrix_complex_flat lib/Gsl_matrix_flat lib/Gsl_min lib/Gsl_misc lib/Gsl_monte lib/Gsl_multifit lib/Gsl_multifit_nlin lib/Gsl_multimin lib/Gsl_multiroot lib/Gsl_odeiv lib/Gsl_permut lib/Gsl_poly lib/Gsl_qrng lib/Gsl_randist lib/Gsl_rng lib/Gsl_root lib/Gsl_sf lib/Gsl_siman lib/Gsl_stats lib/Gsl_sum lib/Gsl_vectmat lib/Gsl_vector lib/Gsl_vector_complex lib/Gsl_vector_complex_flat lib/Gsl_vector_flat lib/Gsl_version lib/Gsl_wavelet # OASIS_STOP gsl-ocaml-1.19.1/AUTHORS.txt000066400000000000000000000004101262311274100153410ustar00rootroot00000000000000(* OASIS_START *) (* DO NOT EDIT (digest: a68fd8f906260ad50583d0a27faf1ec1) *) Authors of gsl: * Olivier Andrieu * Markus Mottl Current maintainers of gsl: * Markus Mottl (* OASIS_STOP *) gsl-ocaml-1.19.1/CHANGES.txt000066400000000000000000000137471262311274100153050ustar00rootroot00000000000000in 1.19.1 (gsl-ocaml fork) - Fixed linking problem in 1.19.0 (gsl-ocaml fork) - Fixed incompatibilities with GSL 2.0 in 1.18.5 (gsl-ocaml fork) - Fixed building of examples that depend on camlp4 Thanks to Akinori Abe for the patch! in 1.18.4 (gsl-ocaml fork) - Fixed configuration issue relating to OPAM packaging in 1.18.3 (gsl-ocaml fork) - Removed superfluous camlp4 dependency from library. in 1.18.2 (gsl-ocaml fork) - Better expected compatibility with OCaml versions larger than 4.02.1 in 1.18.1 (gsl-ocaml fork) - Improvements to distribution process in 1.18.0 (gsl-ocaml fork) - Exploit the new module alias feature in OCaml 4.02 to improve compilation and linking speed as well as executable size. in 1.17.2 (gsl-ocaml fork) - Added missing include to C-stubs in 1.17.1 (gsl-ocaml fork) - API fixes for upcoming GSL 1.17 release. Affects - Multifit_nlin.{test_gradient,covar} - SF.ellint_D Thanks to Andrey Bergman for the initial patch! in 1.15.3 (gsl-ocaml fork) - Fixed a bug in the bindings for lag1_autocorrelation that could cause segfaults (thanks to Hezekiah Carty for the bug report!) in 1.15.2 (gsl-ocaml fork) - Fixed linking on Mac OS X Mavericks using the Accelerate-framework in 1.15.0 (gsl-ocaml fork) - Fixed superfluous Jacobian allocation when not requested for ODE solving. in 1.10.2 (gsl-ocaml fork) - Fixed linking problem in 1.10.1 (gsl-ocaml fork) - Switched to Oasis - GSL is now a packed library. E.g. the module "Gsl_rng" is now "Gsl.Rng". - Fixed new OCaml 4.00 warnings - Added stricter C-compilation flags - Minor fixes in 1.10.0 - ocamlgsl version number now indicates the required major+minor GSL version - improved error support: GSL errors are now handled by an OCaml function. By default it raises the Gsl_exn exception, but it can be redefined to ignore some errors. - callbacks: now exceptions raised in OCaml callback functions are propagated and are no longer "absorbed". Mind that for some functions (Gsl_monte.integrate_miser for one) this can result in a memory leak in GSL. - fixes for multimin (Markus) - fixes for exceptions on "all-float" functions - update the buildsystem (autoconf) - support for gsl_stats_correlation in 0.6.1 - Minor changes to improve installation and to fix stack overflows when dealing with extremely large optimization problems. (Markus Mottl) in 0.6.0 - sync with GSL 1.9 - Nonsymmetric eigensystems in Gsl_eigen - Basis splines - misc. other things, cf. GSL 1.9 NEWS file in 0.5.3 - compile with ocaml 3.10 - fix GC bugs with C functions taking a callbak parameter (min, multimin, multifit, etc.) in 0.5.2 - fix Gsl_sf.legendre_array_size in 0.5.1 - fix wrong declaration of externals in gsl_wavelet (Will M. Farr) - rewrite the blurb about callbacks raising exceptions (see below) - drop the mode argument Gsl_cheb.eval ("not for casual use") - fix GC bug in Gsl_cheb in 0.5.0 - sync with GSL 1.8 - fix Gsl_cdf - wrap new functions: gsl_multifit_linear_est, gsl_linalg_cholesky_decomp_unit, gsl_ran_gamma_mt, gsl_ran_gaussian_ziggurat, gsl_sf_debye_5, gsl_sf_debye_6 - sync with GSL 1.7 - add Gsl_randist.binomial_knuth, add Gsl_multifit._linear_svd in 0.4.1 - make several record types 'private'. This disallows building bogus values that could crash the program. - remove several unsafe manual memory-management functions from module signatures - added Associated Legendre Polynomials and Spherical Harmonics in Gsl_sf (Will M. Farr) - fixed the type Gsl_fft.Complex.direction (Joe Shirron) - fixed the type of Gsl_randist.negative_binomial and negative_binomial_pdf (Martin Willensdorfer) in 0.4.0 - sync with GSL 1.6 - new module Gsl_wavelet for DWT - new module Gsl_sort - in Gsl_linalg, support for LQ and P^T LQ decompositions - add a mode argument in Gsl_cheb.eval - add RK2SIMP in Gsl_odeiv.step_kind - a couple of other small additions - bugfix for functions in Gsl_sf returning a result_e10 - better support for Cygwin (James Scott, Lexifi) in 0.3.5 - improve build system a bit so that it works better on cygwin (thanks to Brian Wilfley) - fix bugs in Gsl_odeiv (thanks to Will M. Farr) in 0.3.4 - fix a GC bug in the error handler, simplify exception raising code - add Qrng.dimension and Qrng.sample in 0.3.3 - report an error when building on a platform with ARCH_ALIGN_DOUBLE defined - findlib support in 0.3.2 - complex functions (contributed by Paul Pelzl) in 0.3.1 : - bugfix in Gsl_interp.eval_array - mlgsl_ieee.c now compiles with gcc 2.9x - build system improvements in 0.3.0 : - sync with GSL 1.4 - new module Gsl_cdf for cumulative distributions - new function Gsl_randist.binomial_tpe - compiles with MSVC (contributed by Lexifi) - memory bugfix in adaptative integration routines - bugfix in Gsl_ieee.set_mode, added FPU status word querying - changed arguments order in Gsl_matrix.transpose : first arg is destination, second is source in 0.2.2 : - sync with GSL 1.3 - new multidimensional minimizer (Nelder Mead Simplex algorithm) - new random distributions : Dirichlet and multinomial - new function Gsl_math.fcmp for approximate floating point values comparisons - fixed some potential problems with the GC in 0.2.1 : - Gsl_linalg.matmult is now Gsl_linalg.matmult - Gsl_matrix.mul is now Gsl_matrix.mul_elements (same for Gsl_matrix.div) - vector/matrix macros work with gcc 2.9x (old_gcc target in Makefile) in 0.2 : - rewrote the vector/matrix modules to add single precision bigarrays and complex values - added complex functions in Gsl_linalg and Gsl_eigen - added Ordinary Differential Equations - added Simulated Annealing - added Statistics and Histograms in 0.1.1 : - fixed install target in Makefile - fixed several C stub function names - fixed a bug in ext_quot in quot.ml gsl-ocaml-1.19.1/COPYING.txt000066400000000000000000001045131262311274100153350ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . gsl-ocaml-1.19.1/INSTALL.txt000066400000000000000000000015541262311274100153340ustar00rootroot00000000000000(* OASIS_START *) (* DO NOT EDIT (digest: 9772e321641f48f8efabc601b644878a) *) This is the INSTALL file for the gsl distribution. This package uses OASIS to generate its build system. See section OASIS for full information. Dependencies ============ In order to compile this package, you will need: * ocaml (>= 3.12) for all, doc API * findlib (>= 1.3.1) Installing ========== 1. Uncompress the source archive and go to the root of the package 2. Run 'ocaml setup.ml -configure' 3. Run 'ocaml setup.ml -build' 4. Run 'ocaml setup.ml -install' Uninstalling ============ 1. Go to the root of the package 2. Run 'ocaml setup.ml -uninstall' OASIS ===== OASIS is a program that generates a setup.ml file using a simple '_oasis' configuration file. The generated setup only depends on the standard OCaml installation: no additional library is required. (* OASIS_STOP *) gsl-ocaml-1.19.1/Makefile000066400000000000000000000023031262311274100151160ustar00rootroot00000000000000# OASIS_START # DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954) SETUP = ocaml setup.ml build: setup.data $(SETUP) -build $(BUILDFLAGS) doc: setup.data build $(SETUP) -doc $(DOCFLAGS) test: setup.data build $(SETUP) -test $(TESTFLAGS) all: $(SETUP) -all $(ALLFLAGS) install: setup.data $(SETUP) -install $(INSTALLFLAGS) uninstall: setup.data $(SETUP) -uninstall $(UNINSTALLFLAGS) reinstall: setup.data $(SETUP) -reinstall $(REINSTALLFLAGS) clean: $(SETUP) -clean $(CLEANFLAGS) distclean: $(SETUP) -distclean $(DISTCLEANFLAGS) setup.data: $(SETUP) -configure $(CONFIGUREFLAGS) configure: $(SETUP) -configure $(CONFIGUREFLAGS) .PHONY: build doc test all install uninstall reinstall clean distclean configure # OASIS_STOP setup.ml: _oasis oasis setup -setup-update dynamic GSLINCDIR := $(shell gsl-config --prefix)/include .PHONY: post-conf post-conf: ocaml do_const.ml --mli > lib/gsl_const.mli ocaml do_const.ml > lib/gsl_const.ml ocaml do_sf.ml < lib/gsl_sf.mli.q > lib/gsl_sf.mli cp lib/gsl_sf.mli lib/gsl_sf.ml ocaml do_cdf.ml < $(GSLINCDIR)/gsl/gsl_cdf.h > lib/gsl_cdf.mli cp lib/gsl_cdf.mli lib/gsl_cdf.ml ocaml do_cdf.ml --c < $(GSLINCDIR)/gsl/gsl_cdf.h > lib/mlgsl_cdf.c gsl-ocaml-1.19.1/NOTES.md000066400000000000000000000016621262311274100146770ustar00rootroot00000000000000COMPLETE -------- * Fast Fourier Transforms * Random Number Generation * Random Number Distributions * Polynomials * Interpolation * Mathematical Functions * Least-Squares Fitting * One dimensional Root-Finding * One dimensional Minimization * Numerical Differentiation * Monte Carlo Integration * IEEE floating-point arithmetic * Numerical Integration * Quasi-Random Sequences * Chebyshev Approximations * Multidimensional Root-Finding * Multidimensional Minimization * Series Acceleration * Nonlinear Least-Squares Fitting * Simulated Annealing * Ordinary Differential Equations * Linear Algebra * Eigensystems * BLAS Support * Vectors and Matrices * Physical Constants * Statistics * Complex Numbers * Wavelet Transforms PARTIAL ------- * Special Functions * Permutations * Histograms * Sorting NOT YET ------- * Combinations * N-tuples * Discrete Hankel Transforms gsl-ocaml-1.19.1/README.md000066400000000000000000000077731262311274100147550ustar00rootroot00000000000000GSL-OCaml - GSL-Bindings for OCaml ================================== This library was written by [Olivier Andrieu](http://oandrieu.nerim.net/ocaml). This version (gsl-ocaml) contains patches by [Markus Mottl](http://www.ocaml.info) that may be merged into the original distribution in the future. GSL-OCaml is an interface to the [GSL](http://www.gnu.org/software/gsl) (GNU scientific library) for the [OCaml](http://www.ocaml.org)-language. The currently latest GSL-version known to be compatible is 2.0. Requirements ------------ The platform must not align doubles on double-word addresses, i.e. the C-macro `ARCH_ALIGN_DOUBLE` must be undefined in the OCaml C-configuration header in ``. Installation ------------ ```sh $ ./configure $ make $ make install ``` ### Configuring alternative BLAS-libraries The underlying GSL-library depends on a C-implementation of the BLAS-library (Basic Linear Algebra Subroutines). It comes with its own implementation, `gslcblas`, which GSL will link with by default, e.g.: ```sh $ gsl-config --libs -L/opt/local/lib -lgsl -lgslcblas ``` This implementation is usually considerably slower than alternatives like [OpenBLAS](http://www.openblas.net) or [ATLAS (Automatically Tuned Linear Algebra Software)](http://math-atlas.sourceforge.net) or miscellaneous platform-specific vendor implementations. If you want GSL-OCaml to link with another BLAS-implementation by default, you will need to set an environment variable before starting the build process. For example, if you are installing the package via [OPAM](http://opam.ocamlpro.com), you may want to do the following: ```sh $ export GSL_CBLAS_LIB=-lopenblas $ gsl-config --libs -L/opt/local/lib -lgsl -lopenblas $ opam install gsl-ocaml ``` The above shows that after setting the environment variable `GSL_CBLAS_LIB`, `gsl-config` will return the correct linking flags to the build process of GSL-OCaml. Note that on Mac OS X GSL-OCaml requires the Apple-specific, highly optimized vendor library `vecLib`, which is part of the Accelerate-framework, and will automatically link with it. Documentation ------------- Check the [GSL manual](http://www.gnu.org/software/gsl/manual/html_node) to learn more about the GNU Scientific Library. You can browse the OCaml module interfaces as `ocamldoc`-generated HTML files in directory `API.docdir` after building the documentation with `make doc`. It is also available [online](http://mmottl.github.io/gsl-ocaml/api). Usage Hints ----------- ### Vectors and Matrices There are several data types for handling vectors and matrices. * Modules `Gsl.Vector`, `Gsl.Vector.Single`, `Gsl.Vector_complex`, `Gsl.Vector_complex.Single`, and the corresponding matrix modules use bigarrays with single or double precision and real or complex values. * Modules `Gsl.Vector_flat`, `Gsl.Vector_complex_flat`, and the corresponding matrix modules use a record wrapping a regular OCaml float array. This is the equivalent of the `gsl_vector` and `gsl_matrix` structs in GSL. * Module `Gsl.Vectmat` defines a sum type with polymorphic variants that regroups these two representations. For instance: ```ocaml Gsl.Vectmat.v_add (`V v1) (`VF v2) ``` adds a vector in an OCaml array to a bigarray. * Modules `Gsl.Blas Gsl.Blas_flat` and `Gsl.Blas_gen` provide a (quite incomplete) interface to CBLAS for these types. ### ERROR HANDLING Errors in GSL functions are reported as exceptions: ```ocaml Gsl.Error.Gsl_exn (errno, msg) ``` You have to call `Gsl.Error.init ()` to initialize error reporting. Otherwise, the default GSL error handler is used and aborts the program, leaving a core dump (not so helpful with OCaml). If a callback (for minimizers, solvers, etc.) raises an exception, `gsl-ocaml` either returns `GSL_FAILURE` or `NaN` to GSL depending on the type of callback. In either case the original OCaml exception is not propagated. The GSL function will either return normally (but probably with values containing `NaN`s somewhere) or raise a `Gsl_exn` exception. gsl-ocaml-1.19.1/TODO.md000066400000000000000000000007651262311274100145570ustar00rootroot00000000000000 * custom blocks ? * 2D histograms * complex and double matrices & vectors with a type param ? * finish special functions * remaining modules * polymorphic variants for FFT ? CHECK ----- * complex matrices * BLAS functions DONE ---- * put .mli only modules back * complex funs in linalg and eigen * complex funs for vectmat sum types * rewrite siman in ML * drop gsl_fun type : use closures directly * check the "noalloc" directives in externals (removed most of them) gsl-ocaml-1.19.1/_oasis000066400000000000000000000272201262311274100146630ustar00rootroot00000000000000OASISFormat: 0.4 Name: gsl Version: 1.19.1 Synopsis: GSL - Bindings to the GNU Scientific Library Description: gsl-ocaml branched off from Olivier Andrieu's distribution (ocamlgsl) and includes bug fixes as well as numerous API improvements. Authors: Olivier Andrieu , Markus Mottl Copyrights: (C) 2002-2012 Olivier Andrieu (C) 2009-2015 Markus Mottl Maintainers: Markus Mottl LicenseFile: COPYING.txt License: GPL-3+ OCamlVersion: >= 3.12 FindlibVersion: >= 1.3.1 Homepage: http://mmottl.github.io/gsl-ocaml #Categories: FilesAB: lib/gsl_version.ml.ab Plugins: META (0.4), StdFiles (0.4), DevFiles (0.4) XStdFilesREADME: false PostConfCommand: make post-conf PreBuildCommand: mkdir -p _build/lib; cp lib/mlgsl_matrix.c lib/mlgsl_vector.c _build/lib BuildTools: ocamlbuild, ocamldoc Flag strict Description: Strict compile-time checks Default: true Library gsl Path: lib Modules: Gsl, Gsl_blas, Gsl_blas_flat, Gsl_blas_gen, Gsl_bspline, Gsl_cdf, Gsl_cheb, Gsl_combi, Gsl_const, Gsl_deriv, Gsl_eigen, Gsl_error, Gsl_fft, Gsl_fit, Gsl_fun, Gsl_complex, Gsl_sort, Gsl_histo, Gsl_ieee, Gsl_integration, Gsl_interp, Gsl_linalg, Gsl_math, Gsl_matrix, Gsl_matrix_complex, Gsl_matrix_complex_flat, Gsl_matrix_flat, Gsl_min, Gsl_misc, Gsl_monte, Gsl_multifit, Gsl_multifit_nlin, Gsl_multimin, Gsl_multiroot, Gsl_odeiv, Gsl_permut, Gsl_poly, Gsl_qrng, Gsl_randist, Gsl_rng, Gsl_root, Gsl_sf, Gsl_siman, Gsl_stats, Gsl_sum, Gsl_vectmat, Gsl_vector, Gsl_vector_complex, Gsl_vector_complex_flat, Gsl_vector_flat, Gsl_version, Gsl_wavelet CSources: mlgsl_blas.c, mlgsl_blas_complex.c, mlgsl_blas_complex_float.c, mlgsl_blas_float.c, mlgsl_bspline.c, mlgsl_cdf.c, mlgsl_cheb.c, mlgsl_combi.c, mlgsl_complex.c, mlgsl_deriv.c, mlgsl_eigen.c, mlgsl_error.c, mlgsl_fft.c, mlgsl_fit.c, mlgsl_fun.c, mlgsl_histo.c, mlgsl_ieee.c, mlgsl_integration.c, mlgsl_interp.c, mlgsl_linalg.c, mlgsl_linalg_complex.c, mlgsl_math.c, mlgsl_matrix_complex.c, mlgsl_matrix_complex_float.c, mlgsl_matrix_double.c, mlgsl_matrix_float.c, mlgsl_min.c, mlgsl_monte.c, mlgsl_multifit.c, mlgsl_multimin.c, mlgsl_multiroots.c, mlgsl_odeiv.c, mlgsl_permut.c, mlgsl_poly.c, mlgsl_qrng.c, mlgsl_randist.c, mlgsl_rng.c, mlgsl_roots.c, mlgsl_sf.c, mlgsl_sort.c, mlgsl_stats.c, mlgsl_sum.c, mlgsl_vector_double.c, mlgsl_vector_float.c, mlgsl_wavelet.c, io.h, mlgsl_blas.h, mlgsl_complex.h, mlgsl_fun.h, mlgsl_matrix.h, mlgsl_matrix_complex.h, mlgsl_matrix_complex_float.h, mlgsl_matrix_double.h, mlgsl_matrix_float.h, mlgsl_permut.h, mlgsl_rng.h, mlgsl_vector.h, mlgsl_vector_complex.h, mlgsl_vector_complex_float.h, mlgsl_vector_double.h, mlgsl_vector_float.h, wrappers.h BuildDepends: bigarray CCOpt: -g -O2 -fPIC -DPIC if flag(strict) && ccomp_type(cc) # FIXME: eliminate all pedantic and extra warnings # CCOpt+: -Wall -pedantic -Wextra -Wunused -Wno-long-long CCOpt+: -Wall -Wunused -Wno-long-long if system(macosx) CCLib: -framework Accelerate # Examples Flag examples Description: Build examples Default: true Flag camlp4 Description: Allow building of examples using camlp4 Default: false Executable blas_ex Path: examples MainIs: blas_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable blas_speed_test Path: examples MainIs: blas_speed_test.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable bspline_ex Path: examples MainIs: bspline_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable cheb_ex Path: examples MainIs: cheb_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable combi_ex Path: examples MainIs: combi_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable const_ex Path: examples MainIs: const_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable deriv_ex Path: examples MainIs: deriv_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable eigen_ex Path: examples MainIs: eigen_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable fft_c Path: examples MainIs: fft_c.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable fft_c2 Path: examples MainIs: fft_c2.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable fft_hc Path: examples MainIs: fft_hc.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable fit_ex Path: examples MainIs: fit_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable histo_ex Path: examples MainIs: histo_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable integration_ex Path: examples MainIs: integration_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable interp_ex Path: examples MainIs: interp_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable linalg_ex Path: examples MainIs: linalg_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable min_ex Path: examples MainIs: min_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable monte_ex Path: examples MainIs: monte_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable "multifit_data_ex" Path: examples MainIs: multifit_data_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable multifit_ex Path: examples MainIs: multifit_ex.ml Build$: flag(examples) && flag(camlp4) BuildDepends: gsl, camlp4 Install: false CompiledObject: best Executable multifit_nlin_ex Path: examples MainIs: multifit_nlin_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable multimin_ex Path: examples MainIs: multimin_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable multiroot_ex Path: examples MainIs: multiroot_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable odeiv_ex Path: examples MainIs: odeiv_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable permut_ex Path: examples MainIs: permut_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable qrng_ex Path: examples MainIs: qrng_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable rng_ex Path: examples MainIs: rng_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable root_ex Path: examples MainIs: root_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable siman_ex Path: examples MainIs: siman_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable siman_tsp_ex Path: examples MainIs: siman_tsp_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable stats_ex Path: examples MainIs: stats_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable sum_ex Path: examples MainIs: sum_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best Executable wavelet_ex Path: examples MainIs: wavelet_ex.ml Build$: flag(examples) BuildDepends: gsl Install: false CompiledObject: best # Document API Title: API reference for GSL Type: OCamlbuild (0.4) InstallDir: $docdir/api XOCamlbuildPath: . XOCamlbuildLibraries: gsl SourceRepository head Type: Git Location: https://github.com/mmottl/gsl-ocaml.git Browser: https://github.com/mmottl/gsl-ocaml Tag: v$(pkg_version) gsl-ocaml-1.19.1/_opam000066400000000000000000000000321262311274100144710ustar00rootroot00000000000000depends: [ "conf-gsl" ] gsl-ocaml-1.19.1/_tags000066400000000000000000000211221262311274100144760ustar00rootroot00000000000000# OASIS_START # DO NOT EDIT (digest: 3e936f5f715c1a592747c9574f33f223) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process true: annot, bin_annot <**/.svn>: -traverse <**/.svn>: not_hygienic ".bzr": -traverse ".bzr": not_hygienic ".hg": -traverse ".hg": not_hygienic ".git": -traverse ".git": not_hygienic "_darcs": -traverse "_darcs": not_hygienic # Library gsl "lib/gsl.cmxs": use_gsl : oasis_library_gsl_ccopt "lib/mlgsl_blas.c": oasis_library_gsl_ccopt "lib/mlgsl_blas_complex.c": oasis_library_gsl_ccopt "lib/mlgsl_blas_complex_float.c": oasis_library_gsl_ccopt "lib/mlgsl_blas_float.c": oasis_library_gsl_ccopt "lib/mlgsl_bspline.c": oasis_library_gsl_ccopt "lib/mlgsl_cdf.c": oasis_library_gsl_ccopt "lib/mlgsl_cheb.c": oasis_library_gsl_ccopt "lib/mlgsl_combi.c": oasis_library_gsl_ccopt "lib/mlgsl_complex.c": oasis_library_gsl_ccopt "lib/mlgsl_deriv.c": oasis_library_gsl_ccopt "lib/mlgsl_eigen.c": oasis_library_gsl_ccopt "lib/mlgsl_error.c": oasis_library_gsl_ccopt "lib/mlgsl_fft.c": oasis_library_gsl_ccopt "lib/mlgsl_fit.c": oasis_library_gsl_ccopt "lib/mlgsl_fun.c": oasis_library_gsl_ccopt "lib/mlgsl_histo.c": oasis_library_gsl_ccopt "lib/mlgsl_ieee.c": oasis_library_gsl_ccopt "lib/mlgsl_integration.c": oasis_library_gsl_ccopt "lib/mlgsl_interp.c": oasis_library_gsl_ccopt "lib/mlgsl_linalg.c": oasis_library_gsl_ccopt "lib/mlgsl_linalg_complex.c": oasis_library_gsl_ccopt "lib/mlgsl_math.c": oasis_library_gsl_ccopt "lib/mlgsl_matrix_complex.c": oasis_library_gsl_ccopt "lib/mlgsl_matrix_complex_float.c": oasis_library_gsl_ccopt "lib/mlgsl_matrix_double.c": oasis_library_gsl_ccopt "lib/mlgsl_matrix_float.c": oasis_library_gsl_ccopt "lib/mlgsl_min.c": oasis_library_gsl_ccopt "lib/mlgsl_monte.c": oasis_library_gsl_ccopt "lib/mlgsl_multifit.c": oasis_library_gsl_ccopt "lib/mlgsl_multimin.c": oasis_library_gsl_ccopt "lib/mlgsl_multiroots.c": oasis_library_gsl_ccopt "lib/mlgsl_odeiv.c": oasis_library_gsl_ccopt "lib/mlgsl_permut.c": oasis_library_gsl_ccopt "lib/mlgsl_poly.c": oasis_library_gsl_ccopt "lib/mlgsl_qrng.c": oasis_library_gsl_ccopt "lib/mlgsl_randist.c": oasis_library_gsl_ccopt "lib/mlgsl_rng.c": oasis_library_gsl_ccopt "lib/mlgsl_roots.c": oasis_library_gsl_ccopt "lib/mlgsl_sf.c": oasis_library_gsl_ccopt "lib/mlgsl_sort.c": oasis_library_gsl_ccopt "lib/mlgsl_stats.c": oasis_library_gsl_ccopt "lib/mlgsl_sum.c": oasis_library_gsl_ccopt "lib/mlgsl_vector_double.c": oasis_library_gsl_ccopt "lib/mlgsl_vector_float.c": oasis_library_gsl_ccopt "lib/mlgsl_wavelet.c": oasis_library_gsl_ccopt : oasis_library_gsl_cclib "lib/libgsl_stubs.lib": oasis_library_gsl_cclib "lib/dllgsl_stubs.dll": oasis_library_gsl_cclib "lib/libgsl_stubs.a": oasis_library_gsl_cclib "lib/dllgsl_stubs.so": oasis_library_gsl_cclib : use_libgsl_stubs : pkg_bigarray "lib/mlgsl_blas.c": pkg_bigarray "lib/mlgsl_blas_complex.c": pkg_bigarray "lib/mlgsl_blas_complex_float.c": pkg_bigarray "lib/mlgsl_blas_float.c": pkg_bigarray "lib/mlgsl_bspline.c": pkg_bigarray "lib/mlgsl_cdf.c": pkg_bigarray "lib/mlgsl_cheb.c": pkg_bigarray "lib/mlgsl_combi.c": pkg_bigarray "lib/mlgsl_complex.c": pkg_bigarray "lib/mlgsl_deriv.c": pkg_bigarray "lib/mlgsl_eigen.c": pkg_bigarray "lib/mlgsl_error.c": pkg_bigarray "lib/mlgsl_fft.c": pkg_bigarray "lib/mlgsl_fit.c": pkg_bigarray "lib/mlgsl_fun.c": pkg_bigarray "lib/mlgsl_histo.c": pkg_bigarray "lib/mlgsl_ieee.c": pkg_bigarray "lib/mlgsl_integration.c": pkg_bigarray "lib/mlgsl_interp.c": pkg_bigarray "lib/mlgsl_linalg.c": pkg_bigarray "lib/mlgsl_linalg_complex.c": pkg_bigarray "lib/mlgsl_math.c": pkg_bigarray "lib/mlgsl_matrix_complex.c": pkg_bigarray "lib/mlgsl_matrix_complex_float.c": pkg_bigarray "lib/mlgsl_matrix_double.c": pkg_bigarray "lib/mlgsl_matrix_float.c": pkg_bigarray "lib/mlgsl_min.c": pkg_bigarray "lib/mlgsl_monte.c": pkg_bigarray "lib/mlgsl_multifit.c": pkg_bigarray "lib/mlgsl_multimin.c": pkg_bigarray "lib/mlgsl_multiroots.c": pkg_bigarray "lib/mlgsl_odeiv.c": pkg_bigarray "lib/mlgsl_permut.c": pkg_bigarray "lib/mlgsl_poly.c": pkg_bigarray "lib/mlgsl_qrng.c": pkg_bigarray "lib/mlgsl_randist.c": pkg_bigarray "lib/mlgsl_rng.c": pkg_bigarray "lib/mlgsl_roots.c": pkg_bigarray "lib/mlgsl_sf.c": pkg_bigarray "lib/mlgsl_sort.c": pkg_bigarray "lib/mlgsl_stats.c": pkg_bigarray "lib/mlgsl_sum.c": pkg_bigarray "lib/mlgsl_vector_double.c": pkg_bigarray "lib/mlgsl_vector_float.c": pkg_bigarray "lib/mlgsl_wavelet.c": pkg_bigarray # Executable blas_ex : pkg_bigarray : use_gsl # Executable blas_speed_test : pkg_bigarray : use_gsl # Executable bspline_ex : pkg_bigarray : use_gsl # Executable cheb_ex : pkg_bigarray : use_gsl # Executable combi_ex : pkg_bigarray : use_gsl # Executable const_ex : pkg_bigarray : use_gsl # Executable deriv_ex : pkg_bigarray : use_gsl # Executable eigen_ex : pkg_bigarray : use_gsl # Executable fft_c : pkg_bigarray : use_gsl # Executable fft_c2 : pkg_bigarray : use_gsl # Executable fft_hc : pkg_bigarray : use_gsl # Executable fit_ex : pkg_bigarray : use_gsl # Executable histo_ex : pkg_bigarray : use_gsl # Executable integration_ex : pkg_bigarray : use_gsl # Executable interp_ex : pkg_bigarray : use_gsl # Executable linalg_ex : pkg_bigarray : use_gsl # Executable min_ex : pkg_bigarray : use_gsl # Executable monte_ex : pkg_bigarray : use_gsl # Executable multifit_data_ex : pkg_bigarray : use_gsl # Executable multifit_ex : pkg_bigarray : pkg_camlp4 : use_gsl : pkg_camlp4 # Executable multifit_nlin_ex : pkg_bigarray : use_gsl # Executable multimin_ex : pkg_bigarray : use_gsl # Executable multiroot_ex : pkg_bigarray : use_gsl # Executable odeiv_ex : pkg_bigarray : use_gsl # Executable permut_ex : pkg_bigarray : use_gsl # Executable qrng_ex : pkg_bigarray : use_gsl # Executable rng_ex : pkg_bigarray : use_gsl # Executable root_ex : pkg_bigarray : use_gsl # Executable siman_ex : pkg_bigarray : use_gsl # Executable siman_tsp_ex : pkg_bigarray : use_gsl # Executable stats_ex : pkg_bigarray : use_gsl # Executable sum_ex : pkg_bigarray : use_gsl # Executable wavelet_ex : pkg_bigarray : use_gsl : pkg_bigarray : use_gsl # OASIS_STOP true: -traverse <{lib,examples}/**>: traverse <**/*.ml{,i}>: warn(Aer-44), strict_sequence, safe_string, annot : camlp4of "lib/gsl.cmxs": use_libgsl_stubs <**/*>: no_alias_deps gsl-ocaml-1.19.1/configure000077500000000000000000000005531262311274100153720ustar00rootroot00000000000000#!/bin/sh # OASIS_START # DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499) set -e FST=true for i in "$@"; do if $FST; then set -- FST=false fi case $i in --*=*) ARG=${i%%=*} VAL=${i##*=} set -- "$@" "$ARG" "$VAL" ;; *) set -- "$@" "$i" ;; esac done ocaml setup.ml -configure "$@" # OASIS_STOP gsl-ocaml-1.19.1/do_cdf.ml000066400000000000000000000050701262311274100152320ustar00rootroot00000000000000#load "str.cma" type arg_type = | FLOAT | UINT let parse = let regexp_partial = Str.regexp "double gsl_cdf_" in let regexp_full = Str.regexp "double gsl_cdf_\\([^ ]+\\) (\\([^)]+\\));" in let regexp_arg = Str.regexp "const \\(double\\|unsigned int\\) \\([a-zA-Z0-9_]+\\)" in let rec loop s = if Str.string_match regexp_full s 0 then let fun_name = Str.matched_group 1 s in let args = let acc = ref [] in let i = ref (Str.group_beginning 2) in begin try while true do let _ = Str.search_forward regexp_arg s !i in let ty = match Str.matched_group 1 s with | "double" -> FLOAT | "unsigned int" -> UINT | _ -> assert false in let n = Str.matched_group 2 s in acc := (ty, n) :: !acc ; i := Str.match_end () done with Not_found -> () end; List.rev !acc in if List.length args > 5 then (Printf.eprintf "functions `%s' has more than 5 arguments, this is unsupported\n%!" fun_name ; None) else Some (fun_name, args) else if Str.string_match regexp_partial s 0 then loop (s ^ read_line ()) else None in loop let may f = function | None -> () | Some v -> f v let all_float args = List.for_all (function (FLOAT, _) -> true | _ -> false) args let print_all_float fun_name oc args = if all_float args then Printf.fprintf oc " \"gsl_cdf_%s\" \"float\"" fun_name let print_ml_args oc args = List.iter (fun (ty, a) -> let l = String.lowercase a in match ty with | FLOAT -> Printf.fprintf oc "%s:float -> " l | UINT -> Printf.fprintf oc "%s:int -> " l) args let print_ml (fun_name, args) = Printf.printf "external %s : %afloat = \"ml_gsl_cdf_%s\"%a\n" fun_name print_ml_args args fun_name (print_all_float fun_name) args let print_c_args oc args = List.iter (fun (ty, _) -> match ty with | FLOAT -> output_string oc " Double_val," | UINT -> output_string oc " Unsigned_int_val,") args let print_c (fun_name, args) = Printf.printf "ML%d(gsl_cdf_%s,%a copy_double)\n\n" (List.length args) fun_name print_c_args args let c_output = Array.length Sys.argv > 1 && Sys.argv.(1) = "--c" let _ = if c_output then Printf.printf "#include \n#include \"wrappers.h\"\n\n" else Printf.printf "(** Cumulative distribution functions *)\n\n" ; try while true do may (if c_output then print_c else print_ml) (parse (read_line ())) done with End_of_file -> () gsl-ocaml-1.19.1/do_const.ml000066400000000000000000000031221262311274100156200ustar00rootroot00000000000000#load "str.cma" #load "unix.cma" open Printf let () = let n_args = Array.length Sys.argv in printf "(** Values of physical constants *)\n"; let rex = Str.regexp "^#define GSL_CONST_[^_]+_\\(.*\\)\\b.*(\\(.*\\))" in let is_mli = n_args > 1 && Sys.argv.(1) = "--mli" in let emit, n_drop = let get_name line = String.lowercase (Str.matched_group 1 line) in let get_data line = String.lowercase (Str.matched_group 2 line) in if is_mli then let emit line = let name = get_name line in printf " val %s : float\n" name in emit, 2 else let emit line = let name = get_name line in let data = get_data line in printf " let %s = %s\n" name data in emit, 1 in let gsl_prefix = let ic = Unix.open_process_in "gsl-config --prefix" in try input_line ic with exc -> close_in ic; raise exc in let act const = let upper_const = String.uppercase const in if is_mli then printf "\nmodule %s : sig\n" (String.uppercase const) else printf "\nmodule %s = struct\n" upper_const; let gsl_path = sprintf "%s/include/gsl/gsl_const_%s.h" gsl_prefix const in let ic = open_in gsl_path in try let rec loop () = match try Some (input_line ic) with End_of_file -> None with | Some line -> if Str.string_match rex line 0 then emit line; loop () | None -> close_in ic in loop (); printf "end\n" with exc -> close_in ic; raise exc in let gsl_consts = [| "cgs"; "cgsm"; "mks"; "mksa"; "num" |] in Array.iter act gsl_consts gsl-ocaml-1.19.1/do_sf.ml000066400000000000000000000141411262311274100151050ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2005 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) #load "str.cma" open Printf let split ?(collapse=false) c s = let len = String.length s in let rec proc accu n = let n' = try String.index_from s n c with Not_found -> len in let accu' = if collapse && n' = n then accu else (String.sub s n (n' - n)) :: accu in if n' >= len - 1 then List.rev accu' else proc accu' (succ n') in proc [] 0 let words_list s = split ~collapse:true ' ' s let is_space = function | ' ' | '\012' | '\n' | '\r' | '\t' -> true | _ -> false let trim s = (* From String, OCaml 4.01 *) let len = String.length s in let i = ref 0 in while !i < len && is_space s.[!i] do incr i done; let j = ref (len - 1) in while !j >= !i && is_space s.[!j] do decr j done; if !i = 0 && !j = len - 1 then s else if !j >= !i then String.sub s !i (!j - !i + 1) else "" (** Quotation for externals : << fun1,arg1,arg2 >> -> external fun1 : arg1 -> arg2 = "fun1" << fun1@fun_c,arg1,arg2 >> -> external fun1 : arg1 -> arg2 = "fun_c" << fun1@fun_c@fun_f,float,float >> -> external fun1 : float -> float = "fun_c" "fun_f" "float" *) let ext_quot = let b = Buffer.create 256 in let bh = Format.formatter_of_buffer b in fun str -> Buffer.clear b ; match split ',' str with | [] -> failwith "ext_quot: empty quotation" | _ :: [] -> failwith "ext_quot: no arguments" | name_r :: (arg1 :: argr as args) -> let (name, name_c, name_float) = match split '@' name_r with | name :: [] -> name, name, "" | name :: name_c :: [] -> name, name_c, "" | name :: name_c :: name_f :: _ -> name, name_c, name_f | [] -> failwith "ext_quot: too many C function names" in Format.fprintf bh "@[<2>external %s : %s" (trim name) (trim arg1); List.iter (fun a -> Format.fprintf bh " -> %s" (trim a)) argr; Format.fprintf bh "@ = " ; if List.length args > 6 then Format.fprintf bh "\"%s_bc\"" name_c ; if (List.for_all ((=) "float") args) && name_float <> "" then ( if List.length args <= 6 then Format.fprintf bh "\"%s\"" name_c ; Format.fprintf bh " \"%s\" \"float\"" name_float ) else Format.fprintf bh "\"%s\"" name_c ; Format.fprintf bh "@]@\n%!"; Buffer.contents b let sf_quot = let b = Buffer.create 256 in fun str -> let wl = words_list str in let float, wl = List.partition ((=) "@float") wl in let float = float <> [] in match wl with | [] -> failwith "sf_quot: empty quotation" | _ :: [] -> failwith "sf_quot: no arguments" | name :: args -> let quot = Buffer.clear b ; bprintf b "%s@ml_gsl_sf_%s%s," name name (if float && List.for_all ((=) "float") args then "@" ^ "gsl_sf_" ^ name else ""); List.iter (fun a -> bprintf b "%s," a) args ; bprintf b "float" ; Buffer.contents b in let quot_res = Buffer.clear b ; bprintf b "%s_e@ml_gsl_sf_%s_e," name name ; List.iter (fun a -> bprintf b "%s," a) args ; bprintf b "result" ; Buffer.contents b in String.concat "" (List.map ext_quot [ quot ; quot_res ]) let bessel_quot str = match words_list str with | "cyl" :: letter :: tl -> let tl = String.concat " " tl in String.concat "" [ sf_quot ("bessel_" ^ letter ^ "0 float " ^ tl); sf_quot ("bessel_" ^ letter ^ "1 float " ^ tl); sf_quot ("bessel_" ^ letter ^ "n int float " ^ tl); ext_quot (sprintf "bessel_%sn_array@ml_gsl_sf_bessel_%sn_array,\ int,float,float array,unit" letter letter) ; ] | "cyl_scaled" :: letter :: tl -> let tl = String.concat " " tl in String.concat "" [ sf_quot ("bessel_" ^ letter ^ "0_scaled float " ^ tl); sf_quot ("bessel_" ^ letter ^ "1_scaled float " ^ tl); sf_quot ("bessel_" ^ letter ^ "n_scaled int float " ^ tl); ext_quot (sprintf "bessel_%sn_scaled_array@ml_gsl_sf_bessel_%sn_scaled_array,\ int,float,float array,unit" letter letter) ; ] | "sph" :: letter :: tl -> let tl = String.concat " " tl in String.concat "" [ sf_quot ("bessel_" ^ letter ^ "0 float " ^ tl); sf_quot ("bessel_" ^ letter ^ "1 float " ^ tl); sf_quot ("bessel_" ^ letter ^ "2 float " ^ tl); sf_quot ("bessel_" ^ letter ^ "l int float " ^ tl); ext_quot (sprintf "bessel_%sl_array@ml_gsl_sf_bessel_%sl_array,\ int,float,float array,unit" letter letter) ; ] | "sph_scaled" :: letter :: tl -> let tl = String.concat " " tl in String.concat "" [ sf_quot ("bessel_" ^ letter ^ "0_scaled float " ^ tl); sf_quot ("bessel_" ^ letter ^ "1_scaled float " ^ tl); sf_quot ("bessel_" ^ letter ^ "l_scaled int float " ^ tl); ext_quot (sprintf "bessel_%sl_scaled_array@ml_gsl_sf_bessel_%sl_scaled_array,\ int,float,float array,unit" letter letter) ; ] | _ -> failwith "bessel_quot: wrong args for quotation" let process_line = let quotation = Str.regexp "<\\(:[a-z]*\\)?<\\(.*\\)>>$" in fun l -> if Str.string_match quotation l 0 then begin let quot = try Str.matched_group 1 l with Not_found -> ":sf" in let data = Str.matched_group 2 l in match quot with | ":ext" -> ext_quot data | ":sf" -> sf_quot data | ":bessel" -> bessel_quot data | _ -> "(* quotation parse error *)" end else l let iter_lines f ic = try while true do f (input_line ic) done with End_of_file -> () let _ = iter_lines (fun l -> let nl = process_line l in print_string nl ; print_char '\n') stdin gsl-ocaml-1.19.1/examples/000077500000000000000000000000001262311274100152765ustar00rootroot00000000000000gsl-ocaml-1.19.1/examples/blas_ex.ml000066400000000000000000000014341262311274100172470ustar00rootroot00000000000000open Gsl let a = [| 0.11; 0.12; 0.13; 0.21; 0.22; 0.23; |] let b = [| 1011.; 1012.; 1021.; 1022.; 1031.; 1032.; |] let mA = Matrix.of_array a 2 3 let mB = Matrix.of_array b 3 2 let mC = Matrix.create ~init:0. 2 2 let mfA = Matrix_flat.of_array a 2 3 let mfB = Matrix_flat.of_array b 3 2 let mfC = Matrix_flat.create ~init:0. 2 2 open Blas let _ = Blas.gemm ~ta:NoTrans ~tb:NoTrans ~alpha:1.0 ~a:mA ~b:mB ~beta:0. ~c:mC; Printf.printf "[ %g, %g\n" mC.{0,0} mC.{0, 1} ; Printf.printf " %g, %g ]\n" mC.{1,0} mC.{1, 1} ; print_newline () ; Blas_flat.gemm ~ta:NoTrans ~tb:NoTrans ~alpha:1.0 ~a:mfA ~b:mfB ~beta:0. ~c:mfC; let mfC' = Matrix_flat.to_arrays mfC in Printf.printf "[ %g, %g\n" mfC'.(0).(0) mfC'.(0).(1) ; Printf.printf " %g, %g ]\n" mfC'.(1).(0) mfC'.(1).(1) gsl-ocaml-1.19.1/examples/blas_speed_test.ml000066400000000000000000000012001262311274100207610ustar00rootroot00000000000000open Gsl let m = 1000 let n = 100 let p = 50 let a = Array.init (m*n) float let b = Array.init (n*p) float let mA = Matrix.of_array a m n let mB = Matrix.of_array b n p let mC = Matrix.create ~init:0. m p let mfA = Matrix_flat.of_array a m n let mfB = Matrix_flat.of_array b n p let mfC = Matrix_flat.create ~init:0. m p open Blas let test f mA mB mC = let t1 = Unix.gettimeofday () in for _i = 1 to 10_000 do f ~ta:NoTrans ~tb:NoTrans ~alpha:1.0 ~a:mA ~b:mB ~beta:0. ~c:mC; done; let t2 = Unix.gettimeofday () in Printf.printf "%.3f\n" (t2 -. t1) let () = test Blas.gemm mA mB mC; test Blas_flat.gemm mfA mfB mfC gsl-ocaml-1.19.1/examples/bspline_ex.ml000066400000000000000000000027231262311274100177640ustar00rootroot00000000000000open Gsl let n = 200 let ncoeffs = 8 let nbreak = ncoeffs -2 open Printf let _ = let rng = Rng.make (Rng.default ()) in (* allocate a cubic bspline workspace (k = 4) *) let bw = Bspline.make ~k:4 ~nbreak in let x = Vector.create n and y = Vector.create n and w = Vector.create n and mX = Matrix.create n ncoeffs and vB = Vector.create ncoeffs in begin (* this is the data to be fitted *) printf "#m=0,S=0\n" ; let sigma = 0.1 in for i = 0 to n - 1 do let xi = 15. /. float (n-1) *. float i in let yi = cos xi *. exp (-0.1 *. xi) in let dy = Randist.gaussian rng ~sigma in x.{i} <- xi ; y.{i} <- yi +. dy ; w.{i} <- 1. /. (sigma *. sigma) ; printf "%f %f\n" xi yi done end ; (* use uniform breakpoints on [0, 15] *) Bspline.knots_uniform ~a:0. ~b:15. bw ; (* construct the fit matrix X *) for i = 0 to n -1 do (* compute B_j(xi) for all j *) Bspline._eval x.{i} (`V vB) bw ; (* fill in row i of X *) for j = 0 to ncoeffs - 1 do mX.{i,j} <- vB.{j} done done ; (* do the fit *) let c, cov, _chisq = Multifit.linear ~weight:(`V w) (`M mX) (`V y) in (* output the smoothed curve *) begin printf "#m=1,S=0\n" ; let xi = ref 0. in while !xi < 15. do Bspline._eval !xi (`V vB) bw ; let yi = Multifit.linear_est ~x:(`V vB) ~c:(`V c) ~cov:(`M cov) in printf "%f %f\n" !xi yi.Fun.res ; xi := !xi +. 0.1 done end gsl-ocaml-1.19.1/examples/cheb_ex.ml000066400000000000000000000010331262311274100172220ustar00rootroot00000000000000open Gsl let f x = if x < 0.5 then 0.25 else 0.75 let test n = let cs = Cheb.make 40 in Cheb.init cs f ~a:0. ~b:1.; begin let coefs = Cheb.coefs cs in Printf.printf "coefs = [" ; for i=0 to 40 do Printf.printf " %f;" coefs.(i) done ; Printf.printf " ]\n" end ; for i=0 to pred n do let x = float i /. float n in let r10 = Cheb.eval cs ~order:10 x in let r40 = Cheb.eval cs x in Printf.printf "%g %g %g %g\n" x (f x) r10 r40 done let _ = Error.init (); test 1000 gsl-ocaml-1.19.1/examples/combi_ex.ml000066400000000000000000000004211262311274100174120ustar00rootroot00000000000000open Gsl let () = Error.init () let print_arr arr = Array.iter (fun i -> Printf.printf "% 4d " i) arr ; print_newline () let () = let c = Combi.make 4 2 in for _i = 1 to int_of_float (Sf.choose 4 2) do print_arr (Combi.to_array c); Combi.next c done gsl-ocaml-1.19.1/examples/const_ex.ml000066400000000000000000000006371262311274100174600ustar00rootroot00000000000000open Gsl let () = let au = Const.MKSA.astronomical_unit in let c = Const.MKSA.speed_of_light in let min = Const.MKSA.minute in let r_earth = 1.00 *. au in let r_mars = 1.52 *. au in Printf.printf "light travel time from Earth to Mars:\n" ; Printf.printf "minimum = %.1f minutes\n" ((r_mars -. r_earth) /. c /. min) ; Printf.printf "maximum = %.1f minutes\n" ((r_mars +. r_earth) /. c /. min) gsl-ocaml-1.19.1/examples/deriv_ex.ml000066400000000000000000000012451262311274100174370ustar00rootroot00000000000000open Gsl open Fun let f x = (* raise Exit ;*) x ** 1.5 let test () = let gslfun = f in Printf.printf "f(x) = x^(3/2)\n" ; flush stdout ; begin let { res=result; err=abserr } = Deriv.central ~f:gslfun ~x:2.0 ~h:1e-3 in Printf.printf "x = 2.0\n" ; Printf.printf "f'(x) = %.10f +/- %.5f\n" result abserr ; Printf.printf "exact = %.10f\n\n" (1.5 *. sqrt 2.0) end ; flush stdout ; begin let { res=result; err=abserr } = Deriv.forward ~f:gslfun ~x:0.0 ~h:1e-3 in Printf.printf "x = 0.0\n" ; Printf.printf "f'(x) = %.10f +/- %.5f\n" result abserr ; Printf.printf "exact = %.10f\n\n" 0.0 end let _ = Error.init (); test () gsl-ocaml-1.19.1/examples/eigen_ex.ml000066400000000000000000000021361262311274100174150ustar00rootroot00000000000000open Gsl let data n = let d = Matrix.create n n in for i=0 to pred n do for j=0 to pred n do d.{i, j} <- 1. /. (float (i+j+1)) done done ; d let _ = Printf.printf "Real Symmetric Matrices\n" ; let d = data 4 in let (eval, evec) as eigen = Eigen.symmv (`M d) in Eigen.symmv_sort eigen Eigen.ABS_ASC ; for i=0 to 3 do Printf.printf "eigenvalue = %g\n" eval.{i} ; Printf.printf "eigenvector = \n" ; for j=0 to 3 do Printf.printf "\t%g\n" evec.{j, i} done done ; print_newline () let _ = Printf.printf "Real Nonsymmetric Matrices\n" ; let data = [| -1. ; 1. ; -1. ; 1. ; -8. ; 4. ; -2. ; 1. ; 27. ; 9. ; 3. ; 1. ; 64. ; 16. ; 4. ; 1. |] in let (eval, evec) as eigen = Eigen.nonsymmv (`A (data, 4, 4)) in Eigen.nonsymmv_sort eigen Eigen.ABS_DESC ; for i=0 to 3 do let { Complex.re = re ; im = im} = eval.{i} in Printf.printf "eigenvalue = %g + %gi\n" re im ; Printf.printf "eigenvector = \n" ; for j=0 to 3 do let { Complex.re = re ; im = im} = evec.{j, i} in Printf.printf "\t%g + %gi\n" re im done done gsl-ocaml-1.19.1/examples/fft_c.ml000066400000000000000000000012011262311274100167030ustar00rootroot00000000000000open Gsl let print_data a r = let n = Array.length a / 2 in for i = 0 to n - 1 do let c = Gsl_complex.get a i in Printf.printf "%d %e %e\n" i (c.Gsl_complex.re *. r) (c.Gsl_complex.im *. r) done ; Printf.printf "\n" let init_data n = let data = Array.make (n * 2) 0. in let one = Complex.one in Gsl_complex.set data 0 one ; for i = 1 to 10 do Gsl_complex.set data i one ; Gsl_complex.set data (n - i) one done ; data let main n = let data = init_data n in print_data data 1. ; Fft.Complex.forward_rad2 data ; print_data data (1. /. sqrt (float n)) let _ = main 128 gsl-ocaml-1.19.1/examples/fft_c2.ml000066400000000000000000000012361262311274100167750ustar00rootroot00000000000000open Gsl let print_data a = let n = Array.length a / 2 in for i = 0 to n - 1 do let c = Gsl_complex.get a i in Printf.printf "%d: %e %e\n" i c.Gsl_complex.re c.Gsl_complex.im done ; Printf.printf "\n" let init_data n = let data = Array.make (n * 2) 0. in let one = Complex.one in Gsl_complex.set data 0 one ; for i = 1 to 10 do Gsl_complex.set data i one ; Gsl_complex.set data (n - i) one done ; data let main n = let data = init_data n in print_data data ; let wt = Fft.Complex.make_wavetable n and ws = Fft.Complex.make_workspace n in Fft.Complex.forward data wt ws ; print_data data let _ = main 630 gsl-ocaml-1.19.1/examples/fft_hc.ml000066400000000000000000000011631262311274100170620ustar00rootroot00000000000000open Gsl let print_data { Fft.data = a } = for i = 0 to Array.length a - 1 do Printf.printf "%d: %e\n" i a.(i) done ; Printf.printf "\n" let init_data n = let data = Array.make n 0. in Array.fill data (n / 3) (n / 3) 1. ; { Fft.layout = Fft.Real ; data = data } let main n = let data = init_data n in print_data data ; let ws = Fft.Real.make_workspace n and wt = Fft.Real.make_wavetable n in Fft.Real.transform data wt ws ; Array.fill data.Fft.data 11 (n - 11) 0. ; let wt_hc = Fft.Halfcomplex.make_wavetable n in Fft.Halfcomplex.inverse data wt_hc ws ; print_data data let _ = main 100 gsl-ocaml-1.19.1/examples/fit_ex.ml000066400000000000000000000015711262311274100171120ustar00rootroot00000000000000open Gsl let x = [| 1970.; 1980.; 1990.; 2000. |];; let y = [| 12.; 11.; 14.; 13. |];; let w = [| 0.1; 0.2; 0.3; 0.4 |];; open Fun open Fit let _ = let coeffs = Fit.linear ~weight:w x y in Printf.printf "#best fit: Y = %g + %G X\n" coeffs.c0 coeffs.c1 ; Printf.printf "# covariance matrix:\n" ; Printf.printf "# [ %g, %g\n# %g, %g]\n" coeffs.cov00 coeffs.cov01 coeffs.cov01 coeffs.cov11 ; Printf.printf "# chisq = %g\n" coeffs.sumsq ; for i=0 to 3 do Printf.printf "data: %g %g %g\n" x.(i) y.(i) (1. /. sqrt(w.(i))) done ; Printf.printf "\n" ; for i=(-30) to 129 do let xf = x.(0) +. (float i /. 100.) *. (x.(3) -. x.(0)) in let { res = yf; err = yf_err } = Fit.linear_est xf ~coeffs in Printf.printf "fit: %g %g\n" xf yf ; Printf.printf "hi : %g %g\n" xf (yf +. yf_err) ; Printf.printf "lo : %g %g\n" xf (yf -. yf_err) ; done gsl-ocaml-1.19.1/examples/histo_ex.ml000066400000000000000000000014141262311274100174520ustar00rootroot00000000000000open Gsl let pprint_histo { Histo.n = n ; Histo.range = r ; Histo.bin = b } = for i=0 to pred n do Printf.printf "%g %g %g\n" r.(i) r.(succ i) b.(i) done let main xmin xmax n = let h = Histo.make n in Histo.set_ranges_uniform h ~xmin ~xmax ; begin try while true do Scanf.scanf "%g" (fun x -> Histo.accumulate h x) done with End_of_file -> () end ; pprint_histo h let _ = if Array.length Sys.argv <> 4 then ( Printf.printf "Usage: gsl-histogram xmin xmax n\n" ; Printf.printf "Computes a histogram of the data on \ stdin using n bins from xmin to xmax\n" ; exit 1 ) ; main (float_of_string Sys.argv.(1)) (float_of_string Sys.argv.(2)) (int_of_string Sys.argv.(3)) gsl-ocaml-1.19.1/examples/integration_ex.ml000066400000000000000000000011431262311274100206460ustar00rootroot00000000000000open Gsl let f alpha x = Gc.major (); (log (alpha *. x)) /. (sqrt x) let compute f expected = let ws = Integration.make_ws 1000 in let gslfun = f in let {Fun.res = res ; Fun.err = err } = Integration.qags gslfun ~a:0. ~b:1. ~epsabs:0. ~epsrel:1e-7 ws in Printf.printf "result = % .18f\n" res ; Printf.printf "exact result = % .18f\n" expected ; Printf.printf "estimated error = % .18f\n" err ; Printf.printf "actual error = % .18f\n" (res -. expected) ; Printf.printf "intervals = %d\n" (Integration.size ws) let _ = Error.init (); compute (f 1.0) (-4.) gsl-ocaml-1.19.1/examples/interp_ex.ml000066400000000000000000000015721262311274100176320ustar00rootroot00000000000000open Gsl let _ = Error.init ();; let check_return_status = function | Unix.WEXITED 0 -> true | _ -> false open Interp let print_data oc i = Printf.fprintf oc "#m=0,S=2\n" ; for j=0 to 9 do Printf.fprintf oc "%g %g\n" i.xa.(j) i.ya.(j) done let print_interp oc i = Printf.fprintf oc "#m=1,S=0\n" ; let xi = ref i.xa.(0) in let yi = ref 0. in while !xi < i.xa.(9) do yi := Interp.eval i !xi ; Printf.fprintf oc "%g %g\n" !xi !yi ; xi := !xi +. 0.1 done let x = Array.init 10 (fun i -> float i +. 0.5 *. sin (float i)) let y = Array.init 10 (fun i -> float i +. cos (float (i*i))) let _ = let i = Interp.make_interp Interp.CSPLINE x y in let oc = Unix.open_process_out "graph -T X" in print_data oc i ; print_interp oc i ; flush oc ; if not (check_return_status (Unix.close_process_out oc)) then prerr_endline "Oops !" gsl-ocaml-1.19.1/examples/linalg_ex.ml000066400000000000000000000005351262311274100175750ustar00rootroot00000000000000open Gsl let mA = [| 0.18; 0.60; 0.57; 0.96; 0.41; 0.24; 0.99; 0.58; 0.14; 0.30; 0.97; 0.66; 0.51; 0.13; 0.19; 0.85; |] let vB = [| 1.0; 2.0; 3.0; 4.0 |] let test () = let x = Linalg.solve_LU ~protect:true (`A (mA, 4, 4)) (`A vB) in Printf.printf "x = \n" ; Array.iter (fun v -> Printf.printf " %g\n" v) x let () = test () gsl-ocaml-1.19.1/examples/min_ex.ml000066400000000000000000000017661262311274100171210ustar00rootroot00000000000000open Gsl let f x = Gc.major (); cos x +. 1. let max_iter = 25 let find_min s m_expected = Printf.printf "using %s method\n" (Min.name s) ; Printf.printf "%5s [%9s, %9s] %9s %10s %9s\n" "iter" "lower" "upper" "min" "err" "err(est)" ; flush stdout; let rec proc i = function | true -> () | false when i > max_iter -> Printf.printf "Did not converge after %d iterations.\n" max_iter | _ -> let (a, b) = Min.interval s in let m = Min.minimum s in let status = Min.test_interval ~x_lo:a ~x_up:b ~epsabs:1e-3 ~epsrel:0. in if i=3 then Gc.full_major () ; if status then Printf.printf "Converged:\n" ; Printf.printf "%5d [%.7f, %.7f] %.7f %+.7f %.7f\n" i a b m (m -. m_expected) (b -. a) ; flush stdout; Min.iterate s ; proc (succ i) status in proc 0 false let _ = let gslfun = f in List.iter (fun k -> let s = Min.make k gslfun ~min:2. ~lo:0. ~up:6. in find_min s Math.pi ; print_newline ()) [ Min.GOLDENSECTION ; Min.BRENT ] gsl-ocaml-1.19.1/examples/monte_ex.ml000066400000000000000000000040731262311274100174520ustar00rootroot00000000000000open Gsl open Math let _ = Error.init () let exact = let e = Sf.gamma(0.25) ** 4. /. (4. *. pi ** 3.) in Printf.printf "computing exact: %.9f\n" e ; e let g = let a = 1. /. (pi *. pi *. pi) in fun x -> a /. (1. -. cos x.(0) *. cos x.(1) *. cos x.(2)) let display_results title { Fun.res=result; Fun.err=error } = Printf.printf "%s ==================\n" title ; Printf.printf "result = % .6f\n" result ; Printf.printf "sigma = % .6f\n" error ; Printf.printf "exact = % .6f\n" exact ; Printf.printf "error = % .6f = %.1g sigma\n" (result -. exact) ((abs_float (result -. exact)) /. error) let compute rng = let lo = [| 0.; 0.; 0.; |] in let up = [| pi; pi; pi |] in let gslfun = g in let calls = 500000 in begin let res = Monte.integrate Monte.PLAIN gslfun ~lo ~up calls rng in display_results "PLAIN" res ; print_newline () end ; begin let res = Monte.integrate Monte.MISER gslfun ~lo ~up calls rng in display_results "MISER" res ; print_newline () end ; begin let state = Monte.make_vegas_state 3 in let params = Monte.get_vegas_params state in let oc = open_out "truc" in Monte.set_vegas_params state { params with Monte.verbose = 0 ; Monte.ostream = Some oc } ; let res = Monte.integrate_vegas gslfun ~lo ~up 10000 rng state in display_results "VEGAS warm-up" res ; Printf.printf "converging...\n" ; flush stdout ; let rec proc () = let { Fun.res=result; Fun.err=err } as res = Monte.integrate_vegas gslfun ~lo ~up (calls / 5) rng state in let { Monte.chisq = chisq } = Monte.get_vegas_info state in Printf.printf "result = % .6f sigma = % .6f chisq/dof = %.1f\n" result err chisq ; flush stdout ; if (abs_float (chisq -. 1.)) > 0.5 then proc () else res in let res_final = proc () in display_results "VEGAS final" res_final ; close_out oc end let _ = Rng.env_setup (); let rng = Rng.make (Rng.default ()) in Printf.printf "using %s RNG\n" (Rng.name rng) ; print_newline () ; compute rng gsl-ocaml-1.19.1/examples/multifit_data_ex.ml000066400000000000000000000005001262311274100211450ustar00rootroot00000000000000open Gsl let _ = Error.init () ; Rng.env_setup () let rng = Rng.make (Rng.default ()) let _ = let x = ref 0.1 in while !x < 2. do let y0 = exp !x in let sigma = 0.1 *. y0 in let dy = Randist.gaussian rng ~sigma in Printf.printf "%.1f %g %g\n" !x (y0 +. dy) sigma ; x := !x +. 0.1 done gsl-ocaml-1.19.1/examples/multifit_ex.ml000066400000000000000000000041361262311274100201650ustar00rootroot00000000000000open Gsl let _ = Error.init () let read_lines () = let acc = ref [] in let cnt = ref 0 in begin try while true do acc := (read_line ()) :: !acc ; incr cnt ; done; with End_of_file -> () end ; Printf.printf "read %d points\n" !cnt ; List.rev !acc exception Wrong_format let parse_input = let lexer = Genlex.make_lexer [] in let parse_data = parser | [< 'Genlex.Float a; 'Genlex.Float b; 'Genlex.Float c >] -> (a, b, c) in fun line -> try parse_data (lexer (Stream.of_string line)) with Stream.Failure | Stream.Error _ -> raise Wrong_format let parse_data lines = let n = List.length lines in let x = Array.make n 0. in let y = Array.make n 0. in let w = Array.make n 0. in let _ = List.fold_left (fun i line -> let (xi, yi, ei) = parse_input line in Printf.printf "%3g %.5g +/- %g\n" xi yi ei ; x.(i) <- xi ; y.(i) <- yi ; w.(i) <- (1. /. (ei *. ei)) ; succ i) 0 lines in print_newline (); (x, y, w) let setup (x, y, w) = let n = Array.length x in let x' = Matrix.create n 3 in let y' = Vector.of_array y in let w' = Vector.of_array w in for i=0 to pred n do let xi = x.(i) in x'.{i, 0} <- 1.0 ; x'.{i, 1} <- xi ; x'.{i, 2} <- xi *. xi ; done ; (x', y', w') let fit (x, y, w) = let (c, cov, chisq) = Multifit.linear ~weight:(`V w) (`M x) (`V y) in Printf.printf "# best fit: Y = %g + %g X + %g X^2\n" c.{0} c.{1} c.{2} ; Printf.printf "# covariance matrix:\n" ; Printf.printf "[ %+.5e, %+.5e, %+.5e \n" cov.{0,0} cov.{0,1} cov.{0,2} ; Printf.printf " %+.5e, %+.5e, %+.5e \n" cov.{1,0} cov.{1,1} cov.{1,2} ; Printf.printf " %+.5e, %+.5e, %+.5e ]\n" cov.{2,0} cov.{2,1} cov.{2,2} ; Printf.printf "# chisq = %g\n" chisq let fit_alt (x, y, w) = let (c, _cov, chisq) = Multifit.fit_poly ~weight:w ~x ~y 3 in assert(Array.length c = 4) ; Printf.printf "# best fit: Y = %g + %g X + %g X^2 + %g X^3\n" c.(0) c.(1) c.(2) c.(3) ; Printf.printf "# chisq = %g\n" chisq let _ = let data = parse_data (read_lines ()) in fit (setup data) ; print_newline () ; fit_alt data ; gsl-ocaml-1.19.1/examples/multifit_nlin_ex.ml000066400000000000000000000063331262311274100212060ustar00rootroot00000000000000open Gsl open Fun let expb y sigma = let expb_f ~x ~f = let n = Vector.length f in assert(Array.length y = n); assert(Array.length sigma = n); let a = x.{0} in let lambda = x.{1} in let b = x.{2} in for i=0 to pred n do (* model Yi = A * exp(-lambda * i) + b *) let yi = a *. exp (-. lambda *. (float i)) +. b in f.{i} <- (yi -. y.(i)) /. sigma.(i) done in let expb_df ~x ~j = let (n,p) = Matrix.dims j in assert(Vector.length x = p); assert(Array.length sigma = n); let a = x.{0} in let lambda = x.{1} in for i=0 to pred n do (* Jacobian matrix J(i,j) = dfi / dxj, *) (* where fi = (Yi - yi)/sigma[i], *) (* Yi = A * exp(-lambda * i) + b *) (* and the xj are the parameters (A,lambda,b) *) let e = exp (-. lambda *. float i) in let s = sigma.(i) in j.{i, 0} <- e /. s ; j.{i, 1} <- float (-i) *. a *. e /. s ; j.{i, 2} <- 1. /. s done in let expb_fdf ~x ~f ~j = expb_f ~x ~f ; expb_df ~x ~j in { multi_f = expb_f ; multi_df = expb_df ; multi_fdf = expb_fdf ; } let n = 40 let p = 3 let maxiter = 500 let epsabs = 1e-4 let epsrel = 1e-4 let data () = Rng.env_setup () ; let r = Rng.make (Rng.default ()) in let sigma = Array.make n 0.1 in let y = Array.init n (fun t -> let yt = 1. +. 5. *. exp (-0.1 *. float t) +. (Randist.gaussian r ~sigma:sigma.(t)) in Printf.printf "data: %d %g %g\n" t yt sigma.(t) ; yt) in (y, sigma) let print_state n p = let x = Vector.create p in let f = Vector.create n in fun iter s -> Multifit_nlin.get_state s ~x ~f () ; Printf.printf "iter: %3u x = %15.8f % 15.8f % 15.8f |f(x)| = %g\n" iter x.{0} x.{1} x.{2} (Blas.nrm2 f) let solv (y, sigma) xinit = let n = Array.length y in assert(Array.length sigma = n) ; let print_state = print_state n p in let s = Multifit_nlin.make Multifit_nlin.LMSDER ~n ~p (expb y sigma) (Vector.of_array xinit) in Printf.printf "\nsolver: %s\n" (Multifit_nlin.name s) ; print_state 0 s ; let rec proc iter = Multifit_nlin.iterate s ; print_state iter s ; let status = Multifit_nlin.test_delta s ~epsabs ~epsrel in match status with | true -> Printf.printf "\nstatus = converged\n" | false when iter >= maxiter -> Printf.printf "\nstatus = too many iterations\n" | false -> proc (succ iter) in proc 1 ; let pos = Vector.create 3 in Multifit_nlin.position s pos ; () (* TODO: GSL is heavily modifying the Multifit-API right now. Once the API is stable and released more widely, the covariance functions can be used again. There currently is no way to access the required Jacobian-matrix, which has been removed from the high-level GSL-API, presumably to support factorized internal representations. *) (* let covar = Matrix.create p p in *) (* Multifit_nlin.covar s ~epsrel:0. covar ; *) (* Printf.printf *) (* "A = %.5f +/- %.5f\n" pos.{0} (sqrt covar.{0, 0}) ; *) (* Printf.printf *) (* "lambda = %.5f +/- %.5f\n" pos.{1} (sqrt covar.{1, 1}) ; *) (* Printf.printf *) (* "b = %.5f +/- %.5f\n" pos.{2} (sqrt covar.{2, 2}) *) let _ = solv (data ()) [| 1.0; 0.; 0.; |] gsl-ocaml-1.19.1/examples/multimin_ex.ml000066400000000000000000000053251262311274100201670ustar00rootroot00000000000000open Gsl open Fun let _ = Error.init () let parab a b = let f ~x = let xa = x.{0} -. a in let yb = x.{1} -. b in 10. *. xa *. xa +. 20. *. yb *. yb +. 30. in let df ~x ~g = g.{0} <- 20. *. (x.{0} -. a) ; g.{1} <- 40. *. (x.{1} -. b) in let fdf ~x ~g = let xa = x.{0} -. a in let yb = x.{1} -. b in g.{0} <- 20. *. xa ; g.{1} <- 40. *. yb ; 10. *. xa *. xa +. 20. *. yb *. yb +. 30. in { multim_f = f; multim_df = df ; multim_fdf = fdf ; } let epsabs = 1e-3 let maxiter = 50 let print_state n = let x = Vector.create n in let g = Vector.create n in fun mini iter -> let f = Multimin.Deriv.minimum ~x ~g mini in Printf.printf "%5d x=%.5f y=%.5f f=%10.5f g0=%.5g g1=%.5g\n" iter x.{0} x.{1} f g.{0} g.{1} let mini kind gf start ~step ~tol= let minim = Multimin.Deriv.make kind 2 gf ~x:(Vector.of_array start) ~step ~tol in let print_state = print_state 2 in let rec proc iter = Multimin.Deriv.iterate minim ; let status = Multimin.Deriv.test_gradient minim epsabs in match status with | true -> Printf.printf "Minimum found at:\n" ; print_state minim iter | false when iter >= maxiter -> print_state minim iter ; Printf.printf "Too many iterations\n" ; | false -> print_state minim iter ; proc (succ iter) in Printf.printf "minimizer: %s\n" (Multimin.Deriv.name minim) ; proc 1 let print_state_simplex n = let x = Vector.create n in fun mini iter -> let f = Multimin.NoDeriv.minimum ~x mini in let ssval = Multimin.NoDeriv.size mini in Printf.printf "%5d x=%10.3f y=%10.3f f()=%-10.3f ssize=%.3f\n" iter x.{0} x.{1} f ssval let mini_simplex kind gf ~start ~step_size = let minim = Multimin.NoDeriv.make kind 2 gf ~x:(Vector.of_array start) ~step_size:(Vector.of_array step_size) in let print_state = print_state_simplex 2 in let rec proc iter = Multimin.NoDeriv.iterate minim ; let status = Multimin.NoDeriv.test_size minim epsabs in match status with | true -> Printf.printf "Minimum found at:\n" ; print_state minim iter | false when iter >= maxiter -> print_state minim iter ; Printf.printf "Too many iterations\n" ; | false -> print_state minim iter ; proc (succ iter) in Printf.printf "minimizer: %s\n" (Multimin.NoDeriv.name minim) ; proc 1 open Multimin.Deriv let _ = List.iter (fun kind -> mini kind (parab 1. 2.) [| 5. ; 7. |] ~step:0.01 ~tol:1e-4 ; print_newline () ; flush stdout) [ CONJUGATE_FR ; CONJUGATE_PR ; VECTOR_BFGS ; STEEPEST_DESCENT ; ] ; mini_simplex Multimin.NoDeriv.NM_SIMPLEX (parab 1. 2.).multim_f ~start:[| 5. ; 7. |] ~step_size:[| 1. ; 1. |] gsl-ocaml-1.19.1/examples/multiroot_ex.ml000066400000000000000000000051111262311274100203600ustar00rootroot00000000000000open Gsl open Fun let _ = Error.init () let f a b ~x ~f:y = let x0 = x.{0} in let x1 = x.{1} in y.{0} <- a *. (1. -. x0) ; y.{1} <- b *. (x1 -. x0 *. x0) let df a b ~x ~j = let x0 = x.{0} in j.{0,0} <- ~-. a ; j.{0,1} <- 0. ; j.{1,0} <- -2. *. b *. x0 ; j.{1,1} <- b let fdf a b ~x ~f:y ~j = f a b ~x ~f:y ; df a b ~x ~j let print_state n = let x = Vector.create n in let f = Vector.create n in fun iter solv -> Multiroot.NoDeriv.get_state solv ~x ~f () ; Printf.printf "iter = %3u x = %+.3f %+.3f f(x) = %+.3e %+.3e\n" iter x.{0} x.{1} f.{0} f.{1} ; flush stdout let epsabs = 1e-7 let maxiter = 1000 let solve kind n gf x_init = let solv = Multiroot.NoDeriv.make kind n gf (Vector.of_array x_init) in Printf.printf "solver: %s\n" (Multiroot.NoDeriv.name solv) ; let print_state = print_state n in print_state 0 solv ; let rec proc iter = Multiroot.NoDeriv.iterate solv ; print_state iter solv ; let status = Multiroot.NoDeriv.test_residual solv ~epsabs in match status with | true -> Printf.printf "status = converged\n" | false when iter >= maxiter -> Printf.printf "status = too many iterations\n" | false -> proc (succ iter) in proc 1 open Multiroot.NoDeriv let _ = List.iter (fun kind -> solve kind 2 (f 1. 10.) [| -10.; -5. |] ; print_newline ()) [ HYBRIDS ; HYBRID ; DNEWTON ; BROYDEN ; ] let print_state_deriv n = let x = Vector.create n in let f = Vector.create n in fun iter solv -> Multiroot.Deriv.get_state solv ~x ~f () ; Printf.printf "iter = %3u x = %+.3f %+.3f f(x) = %+.3e %+.3e\n" iter x.{0} x.{1} f.{0} f.{1} ; flush stdout let solve_deriv kind n gf x_init = let solv = Multiroot.Deriv.make kind n gf (Vector.of_array x_init) in Printf.printf "solver: %s\n" (Multiroot.Deriv.name solv) ; let print_state = print_state_deriv n in print_state 0 solv ; let rec proc iter = Multiroot.Deriv.iterate solv ; print_state iter solv ; let status = Multiroot.Deriv.test_residual solv ~epsabs in match status with | true -> Printf.printf "status = converged\n" | false when iter >= maxiter -> Printf.printf "status = too many iterations\n" | false -> proc (succ iter) in proc 1 open Multiroot.Deriv let _ = let gf = { multi_f = f 1. 10. ; multi_df = df 1. 10. ; multi_fdf = fdf 1. 10. ; } in List.iter (fun kind -> solve_deriv kind 2 gf [| -10.; -5. |] ; print_newline ()) [ HYBRIDSJ ; HYBRIDJ ; NEWTON ; GNEWTON ; ] gsl-ocaml-1.19.1/examples/odeiv_ex.ml000066400000000000000000000061611262311274100174360ustar00rootroot00000000000000open Gsl let f mu _t y f = let y0 = y.(0) and y1 = y.(1) in f.(0) <- y1 ; f.(1) <- -. y0 -. mu *. y1 *. (y0 *. y0 -. 1.) let jac mu _t y dfdy dfdt = let y0 = y.(0) and y1 = y.(1) in dfdy.{0, 0} <- 0. ; dfdy.{0, 1} <- 1. ; dfdy.{1, 0} <- -. 2. *. mu *. y0 *. y1 -. 1. ; dfdy.{1, 1} <- -. mu *. (y0 *. y0 -. 1.) ; dfdt.(0) <- 0. ; dfdt.(1) <- 0. let integ mu = let step = Odeiv.make_step Odeiv.RK8PD ~dim:2 in let control = Odeiv.make_control_y_new ~eps_abs:1e-6 ~eps_rel:0. in let evolve = Odeiv.make_evolve 2 in let system = Odeiv.make_system (f mu) ~jac:(jac mu) 2 in let (t, t1, h, y) = (0., 100., 1e-6, [| 1.; 0. |]) in let rec loop data t h = if t < t1 then begin let (t, h) = Odeiv.evolve_apply evolve control step system ~t ~t1 ~h ~y in loop ((t, y.(0), y.(1)) :: data) t h end else List.rev data in loop [] t h let integ2 mu = let step = Odeiv.make_step Odeiv.RK8PD ~dim:2 in let control = Odeiv.make_control_y_new ~eps_abs:1e-6 ~eps_rel:0. in let evolve = Odeiv.make_evolve 2 in let system = Odeiv.make_system (f mu) ~jac:(jac mu) 2 in let t1 = 100. in let y = [| 1.; 0. |] in let state = ref (0., 1e-6) in let rec loop ti y = function | (t, h) when t < ti -> let new_state = Odeiv.evolve_apply evolve control step system ~t ~t1:ti ~h ~y in loop ti y new_state | state -> state in let data = ref [] in for i=1 to 100 do let ti = float i *. t1 /. 100. in state := loop ti y !state ; let (t, _) = !state in data := (t, y.(0), y.(1)) :: !data done ; List.rev !data let integ3 mu = let step = Odeiv.make_step Odeiv.RK4 ~dim:2 in let system = Odeiv.make_system (f mu) ~jac:(jac mu) 2 in let t1 = 100. in let t = ref 0. in let h = 1e-2 in let y = [| 1.; 0. |] in let yerr = Array.make 2 0. in let dydt_in = Array.make 2 0. in let dydt_out = Array.make 2 0. in let dfdy = Matrix.create 2 2 in let data = ref [] in jac mu t y dfdy dydt_in ; while !t < t1 do Odeiv.step_apply step ~t:!t ~h ~y ~yerr ~dydt_in ~dydt_out system ; Array.blit dydt_out 0 dydt_in 0 2 ; t := !t +. h ; data := (!t, y.(0), y.(1)) :: !data ; done ; List.rev !data let with_temp_file f = let tmp = Filename.temp_file "gnuplot_" ".tmp" in let res = try f tmp with exn -> Sys.remove tmp ; raise exn in Sys.remove tmp ; res let gnuplot script = with_temp_file (fun tmp -> let script_c = open_out tmp in List.iter (fun s -> Printf.fprintf script_c "%s\n" s) script ; close_out script_c ; match Unix.system (Printf.sprintf "gnuplot %s" tmp) with | Unix.WEXITED 0 -> () | _ -> prerr_endline "hmm, problems with gnuplot ?" ) let main () = Error.init () ; if Array.length Sys.argv < 2 then exit 1 ; let data = match int_of_string Sys.argv.(1) with | 3 -> integ3 10. | 2 -> integ2 10. | _ -> integ 10. in let points = List.map (fun (_, x, y) -> Printf.sprintf "%.5f %.5f" x y) data in gnuplot (List.concat [ [ "plot '-' with lines" ] ; points ; [ "e" ; "pause -1" ] ]) let _ = main () gsl-ocaml-1.19.1/examples/permut_ex.ml000066400000000000000000000013251262311274100176410ustar00rootroot00000000000000open Bigarray open Gsl let _ = Error.init () ; Random.self_init () let print_arr arr = Array.iter (fun i -> Printf.printf "% 4d " i) arr ; print_newline () let print_barr arr = for i=0 to pred (Array1.dim arr) do Printf.printf "% 4d " arr.{i} done ; print_newline () let _ = let p = Permut.make 5 in Permut.next p ; print_string "permut :" ; print_arr (Permut.to_array p) ; let a = Array.init 5 (fun _ -> Random.int 10) in print_string "arr :" ; print_arr a ; Permut.permute p a ; print_string "arr :" ; print_arr a ; let a1 = Array1.of_array int c_layout a in print_string "arr1 :" ; print_barr a1 ; Permut.permute_barr p a1 ; print_string "arr1 :" ; print_barr a1 gsl-ocaml-1.19.1/examples/qrng_ex.ml000066400000000000000000000003001262311274100172640ustar00rootroot00000000000000open Gsl let _ = let qrng = Qrng.make Qrng.SOBOL 2 in let tmp = Array.make 2 0. in for _i = 0 to 1023 do Qrng.get qrng tmp ; Printf.printf "%.5f %.5f\n" tmp.(0) tmp.(1) done gsl-ocaml-1.19.1/examples/rng_ex.ml000066400000000000000000000012651262311274100171160ustar00rootroot00000000000000open Gsl let _ = Error.init () ; Rng.env_setup () let rng = Rng.make (Rng.default ()) let _ = Printf.printf "# generator type: %s\n" (Rng.name rng) ; Printf.printf "# seed = %nu\n" (Rng.default_seed ()) ; Printf.printf "# min value = %nu\n" (Rng.min rng) ; Printf.printf "# max value = %nu\n" (Rng.max rng) ; Printf.printf "# first value = %nu\n" (Rng.get rng) let sigma = 3. let _ = Printf.printf "# gaussian with sigma=%g\n" sigma ; for _i = 1 to 10 do let x = Randist.gaussian rng ~sigma in Printf.printf "%+.7f\n" x done (* Local Variables: *) (* compile-command: "ocamlopt -o rng -I .. gsl.cmxa rng.ml" *) (* End: *) gsl-ocaml-1.19.1/examples/root_ex.ml000066400000000000000000000040131262311274100173050ustar00rootroot00000000000000open Gsl let _ = Error.init () let quad a b c x = (* Gc.major () ; *) (a *. x +. b) *. x +. c let quad_deriv a b x = 2. *. a *. x +. b let quad_fdf a b c x = let y = (a *. x +. b) *. x +. c in let dy = 2. *. a *. x +. b in (y, dy) let (a, b, c) = (1., 0., -5.0) let r_expected = sqrt 5.0 open Root.Bracket let find_f ?(max_iter=100) s = Printf.printf "\nusing %s method\n" (name s) ; Printf.printf "%5s [%9s, %9s] %9s %10s %9s\n" "iter" "lower" "upper" "root" "err" "err(est)" ; let rec proc i = function | true -> () | _ when i >= max_iter -> () | _ -> iterate s ; let r = root s in let (x_lo, x_hi) = interval s in let status = Root.test_interval ~lo:x_lo ~up:x_hi ~epsabs:0. ~epsrel:0.001 in if status then Printf.printf "Converged:\n" ; Printf.printf "%5d [%.7f, %.7f] %.7f %+.7f %.7f\n" i x_lo x_hi r (r -. r_expected) (x_hi -. x_lo) ; proc (succ i) status in proc 1 false open Root.Polish let find_fdf ?(max_iter=100) s x_init = Printf.printf "\nusing %s method\n" (name s) ; Printf.printf "%-5s %10s %10s %10s\n" "iter" "root" "err" "err(est)" ; let rec proc i x0 = function | true -> () | _ when i >= max_iter -> () | _ -> iterate s ; let x = root s in let status = Root.test_delta ~x1:x ~x0 ~epsabs:0. ~epsrel:1e-3 in if status then Printf.printf "Converged:\n" ; Printf.printf "%5d %10.7f %+10.7f %10.7f\n" i x (x -. r_expected) (x -. x0) ; proc (succ i) x status in proc 1 x_init false let _ = let gslfun = quad a b c in List.iter (fun t -> let s = Root.Bracket.make t gslfun 0. 5. in find_f s) [ Root.Bracket.BISECTION ; Root.Bracket.FALSEPOS ; Root.Bracket.BRENT ] let _ = print_newline () ; flush stdout let _ = let gslfun_fdf = { Fun.f = quad a b c ; Fun.df = quad_deriv a b ; Fun.fdf = quad_fdf a b c ; } in List.iter (fun t -> let s = Root.Polish.make t gslfun_fdf 5. in find_fdf s 5.) [ Root.Polish.NEWTON ; Root.Polish.SECANT ; Root.Polish.STEFFENSON ] gsl-ocaml-1.19.1/examples/siman_ex.ml000066400000000000000000000012131262311274100174300ustar00rootroot00000000000000open Gsl let energ x = (exp (~-. ((x -. 1.) ** 2.))) *. sin (8. *. x) let step rng x step_size = let u = Rng.uniform rng in x +. 2. *. (u -. 0.5) *. step_size let print x = Printf.sprintf "%12g" x let _ = Error.init () ; Rng.env_setup () ; let rng = Rng.make (Rng.default ()) in let params = { Siman.iters_fixed_T = 10 ; Siman.step_size = 10. ; Siman.k = 1. ; Siman.t_initial = 2e-3 ; Siman.mu_t = 1.005 ; Siman.t_min = 2e-6 ; } in let res = Siman.solve rng 15.5 ~energ_func:energ ~step_func:step (* ~print_func:print *) params in Printf.printf "result = %12g\n" res gsl-ocaml-1.19.1/examples/siman_tsp_ex.ml000066400000000000000000000076371262311274100203360ustar00rootroot00000000000000open Gsl type city = { name : string ; lat : float ; long : float ; } let cities = Array.map (fun (n,la,lo) -> { name = n; lat = la; long = lo }) [| ("Santa Fe", 35.68, 105.95) ; ("Phoenix", 33.54, 112.07) ; ("Albuquerque", 35.12, 106.62) ; ("Clovis", 34.41, 103.20) ; ("Durango", 37.29, 107.87) ; ("Dallas", 32.79, 96.77) ; ("Tesuque", 35.77, 105.92) ; ("Grants", 35.15, 107.84) ; ("Los Alamos", 35.89, 106.28) ; ("Las Cruces", 32.34, 106.76) ; ("Cortez", 37.35, 108.58) ; ("Gallup", 35.52, 108.74) ; |] let city_distance { lat = la1; long = lo1 } { lat = la2; long = lo2 } = let earth_radius = 6375. in let pi_180 = Math.pi /. 180. in let sla1 = sin (la1 *. pi_180) in let cla1 = cos (la1 *. pi_180) in let slo1 = sin (lo1 *. pi_180) in let clo1 = cos (lo1 *. pi_180) in let sla2 = sin (la2 *. pi_180) in let cla2 = cos (la2 *. pi_180) in let slo2 = sin (lo2 *. pi_180) in let clo2 = cos (lo2 *. pi_180) in let dot_prod = (cla1 *. clo1) *. (cla2 *. clo2) +. (cla1 *. slo1) *. (cla2 *. slo2) +. sla1 *. sla2 in earth_radius *. acos dot_prod let prepare_distance_matrix cities = let nb = Array.length cities in let mat = Array.make_matrix nb nb 0. in for i=0 to pred nb do for j= succ i to pred nb do let dist = city_distance cities.(i) cities.(j) in mat.(i).(j) <- dist ; mat.(j).(i) <- dist done done ; mat let print_distance_matrix mat = let nb = Array.length mat in for i=0 to pred nb do Printf.printf "# " ; for j=0 to pred nb do Printf.printf "%15.8f " mat.(i).(j) done ; print_newline () done ; flush stdout let energ_func dist_mat route = let nb = Array.length route in let e = ref 0. in for i=0 to pred nb do e := !e +. dist_mat.(route.(i)).(route.( (succ i) mod nb )) done ; !e let step_func rng route _step_size = let nb = Array.length route in let x1 = (Rng.uniform_int rng (pred nb)) + 1 in let x2 = ref x1 in while !x2 = x1 do x2 := (Rng.uniform_int rng (pred nb)) + 1 done ; let route = Array.copy route in let swap = route.(x1) in route.(x1) <- route.(!x2) ; route.(!x2) <- swap ; route let print_func route = let nb = Array.length route in print_string " [" ; for i=0 to pred nb do Printf.printf " %d " route.(i) done ; print_string "]\n" let main () = let rng = Rng.make (Rng.default ()) in let nb = Array.length cities in let matrix = prepare_distance_matrix cities in let route_init = Array.init nb (fun i -> i) in Printf.printf "# initial order of cities:\n" ; for i=0 to pred nb do Printf.printf "# \"%s\"\n" cities.(route_init.(i)).name done ; Printf.printf "# distance matrix is:\n" ; print_distance_matrix matrix ; Printf.printf "# initial coordinates of cities (longitude and latitude)\n" ; for i=0 to pred nb do let c = route_init.(i) in Printf.printf "### initial_city_coord: %g %g \"%s\"\n" (~-. (cities.(c).long)) cities.(c).lat cities.(c).name done ; flush stdout ; let siman_params = { Siman.iters_fixed_T = 2000 ; Siman.step_size = 1. ; Siman.k = 1. ; Siman.t_initial = 5000. ; Siman.mu_t = 1.002 ; Siman.t_min = 5e-1 } in let final_route = Siman.solve rng route_init ~energ_func:(energ_func matrix) ~step_func (* ~print_func *) siman_params in Printf.printf "# final order of cities:\n" ; for i=0 to pred nb do Printf.printf "# \"%s\"\n" cities.(final_route.(i)).name done ; Printf.printf "# final coordinates of cities (longitude and latitude)\n" ; for i=0 to pred nb do let c = final_route.(i) in Printf.printf "### final_city_coord: %g %g \"%s\"\n" (~-. (cities.(c).long)) cities.(c).lat cities.(c).name done ; flush stdout let () = Rng.env_setup () ; Ieee.env_setup () ; main () gsl-ocaml-1.19.1/examples/stats_ex.ml000066400000000000000000000022301262311274100174570ustar00rootroot00000000000000open Gsl let _ = let data = [| 17.2; 18.1; 16.5; 18.3; 12.6 |] in let mean = Stats.mean data in let variance = Stats.variance data in let largest = Stats.max data in let smallest = Stats.min data in Printf.printf "The dataset is %g, %g, %g, %g, %g\n" data.(0) data.(1) data.(2) data.(3) data.(4) ; Printf.printf "The sample mean is %g\n" mean ; Printf.printf "The estimated variance is %g\n" variance ; Printf.printf "The largest value is %g\n" largest ; Printf.printf "The smallest value is %g\n" smallest let _ = let data = [| 17.2; 18.1; 16.5; 18.3; 12.6 |] in Printf.printf "Original dataset is %g, %g, %g, %g, %g\n" data.(0) data.(1) data.(2) data.(3) data.(4) ; Array.sort compare data ; Printf.printf "Sorted dataset is %g, %g, %g, %g, %g\n" data.(0) data.(1) data.(2) data.(3) data.(4) ; let median = Stats.quantile_from_sorted_data data 0.5 in let upperq = Stats.quantile_from_sorted_data data 0.75 in let lowerq = Stats.quantile_from_sorted_data data 0.25 in Printf.printf "The median is %g\n" median ; Printf.printf "The upper quartile is %g\n" upperq ; Printf.printf "The lower quartile is %g\n" lowerq gsl-ocaml-1.19.1/examples/sum_ex.ml000066400000000000000000000025101262311274100171260ustar00rootroot00000000000000open Gsl let _ = Error.init () let zeta2 = Math.pi *. Math.pi /. 6. let zeta_terms n = let t = Array.make n 0. in let sum = ref 0. in for i=0 to pred n do let np1 = float (i + 1) in t.(i) <- 1. /. (np1 *. np1) ; sum := !sum +. t.(i) done ; (t, !sum) let print_res sum nbterms sum_accel sum_plain nbterms_accel = Printf.printf "term-by-term sum = % .16f using %d terms\n" sum nbterms ; Printf.printf "term-by-term sum = % .16f using %d terms\n" sum_plain nbterms_accel ; Printf.printf "exact value = % .16f\n" zeta2 ; Printf.printf "accelerated sum = % .16f using %d terms\n" sum_accel.Fun.res nbterms_accel ; Printf.printf "estimated error = % .16f\n" sum_accel.Fun.err ; Printf.printf "actual error = % .16f\n" (sum_accel.Fun.res -. zeta2) let _ = let n = 20 in let (t, sum) = zeta_terms n in let ws = Sum.make n in let res = Sum.accel t ws in let { Sum.sum_plain = sum_plain ; Sum.terms_used = nbterms_used } = Sum.get_info ws in print_res sum n res sum_plain nbterms_used ; print_newline (); print_endline "\"truncated\" version:" ; let ws = Sum.Trunc.make n in let res = Sum.Trunc.accel t ws in let { Sum.Trunc.sum_plain = sum_plain ; Sum.Trunc.terms_used = nbterms_used } = Sum.Trunc.get_info ws in print_res sum n res sum_plain nbterms_used gsl-ocaml-1.19.1/examples/wavelet_ex.ml000066400000000000000000000017731262311274100200030ustar00rootroot00000000000000open Gsl let read_file init do_line finish f = let ic = open_in f in let acc = ref init in begin try while true do let l = input_line ic in acc := do_line !acc l done with | End_of_file -> close_in ic | exn -> close_in ic ; raise exn end ; finish !acc let read_data_file = read_file [] (fun acc l -> float_of_string l :: acc) (fun acc -> Array.of_list (List.rev acc)) let main f = let data = read_data_file f in let n = Array.length data in Printf.eprintf "read %d values\n%!" n ; let w = Wavelet.make Wavelet.DAUBECHIES 4 in Wavelet.transform_forward w data ; let high = Gsl_sort.vector_flat_largest_index 20 (Vector_flat.view_array (Array.map abs_float data)) in let high_coeff = Array.make n 0. in for i = 0 to 20 - 1 do let j = high.{i} in high_coeff.(j) <- data.(j) done ; Wavelet.transform_inverse w high_coeff ; Array.iter (fun f -> Printf.printf "%g\n" f) high_coeff let () = main "ecg.dat" gsl-ocaml-1.19.1/lib/000077500000000000000000000000001262311274100142265ustar00rootroot00000000000000gsl-ocaml-1.19.1/lib/META000066400000000000000000000005171262311274100147020ustar00rootroot00000000000000# OASIS_START # DO NOT EDIT (digest: 1ad74c503fcaa170acf0f69001f21e76) version = "1.19.1" description = "GSL - Bindings to the GNU Scientific Library" requires = "bigarray" archive(byte) = "gsl.cma" archive(byte, plugin) = "gsl.cma" archive(native) = "gsl.cmxa" archive(native, plugin) = "gsl.cmxs" exists_if = "gsl.cma" # OASIS_STOP gsl-ocaml-1.19.1/lib/gsl.ml000066400000000000000000000030311262311274100153420ustar00rootroot00000000000000module Blas = Gsl_blas module Blas_flat = Gsl_blas_flat module Blas_gen = Gsl_blas_gen module Bspline = Gsl_bspline module Cdf = Gsl_cdf module Cheb = Gsl_cheb module Combi = Gsl_combi (* Exception, avoid clash with OCaml standard library *) module Gsl_complex = Gsl_complex module Const = Gsl_const module Deriv = Gsl_deriv module Eigen = Gsl_eigen module Error = Gsl_error module Fft = Gsl_fft module Fit = Gsl_fit module Fun = Gsl_fun module Histo = Gsl_histo module Ieee = Gsl_ieee module Integration = Gsl_integration module Interp = Gsl_interp module Linalg = Gsl_linalg module Math = Gsl_math module Matrix = Gsl_matrix module Matrix_complex = Gsl_matrix_complex module Matrix_complex_flat = Gsl_matrix_complex_flat module Matrix_flat = Gsl_matrix_flat module Min = Gsl_min module Misc = Gsl_misc module Monte = Gsl_monte module Multifit = Gsl_multifit module Multifit_nlin = Gsl_multifit_nlin module Multimin = Gsl_multimin module Multiroot = Gsl_multiroot module Odeiv = Gsl_odeiv module Permut = Gsl_permut module Poly = Gsl_poly module Qrng = Gsl_qrng module Randist = Gsl_randist module Rng = Gsl_rng module Root = Gsl_root module Sf = Gsl_sf module Siman = Gsl_siman (* Exception, avoid clash with OCaml standard library *) module Gsl_sort = Gsl_sort module Stats = Gsl_stats module Sum = Gsl_sum module Vectmat = Gsl_vectmat module Vector = Gsl_vector module Vector_complex = Gsl_vector_complex module Vector_complex_flat = Gsl_vector_complex_flat module Vector_flat = Gsl_vector_flat module Version = Gsl_version module Wavelet = Gsl_wavelet gsl-ocaml-1.19.1/lib/gsl.mldylib000066400000000000000000000012461262311274100163740ustar00rootroot00000000000000# OASIS_START # DO NOT EDIT (digest: f4221b74b09aecb0cfdb6ca7b7fe9fc8) Gsl Gsl_blas Gsl_blas_flat Gsl_blas_gen Gsl_bspline Gsl_cdf Gsl_cheb Gsl_combi Gsl_const Gsl_deriv Gsl_eigen Gsl_error Gsl_fft Gsl_fit Gsl_fun Gsl_complex Gsl_sort Gsl_histo Gsl_ieee Gsl_integration Gsl_interp Gsl_linalg Gsl_math Gsl_matrix Gsl_matrix_complex Gsl_matrix_complex_flat Gsl_matrix_flat Gsl_min Gsl_misc Gsl_monte Gsl_multifit Gsl_multifit_nlin Gsl_multimin Gsl_multiroot Gsl_odeiv Gsl_permut Gsl_poly Gsl_qrng Gsl_randist Gsl_rng Gsl_root Gsl_sf Gsl_siman Gsl_stats Gsl_sum Gsl_vectmat Gsl_vector Gsl_vector_complex Gsl_vector_complex_flat Gsl_vector_flat Gsl_version Gsl_wavelet # OASIS_STOP gsl-ocaml-1.19.1/lib/gsl.mllib000066400000000000000000000012461262311274100160370ustar00rootroot00000000000000# OASIS_START # DO NOT EDIT (digest: f4221b74b09aecb0cfdb6ca7b7fe9fc8) Gsl Gsl_blas Gsl_blas_flat Gsl_blas_gen Gsl_bspline Gsl_cdf Gsl_cheb Gsl_combi Gsl_const Gsl_deriv Gsl_eigen Gsl_error Gsl_fft Gsl_fit Gsl_fun Gsl_complex Gsl_sort Gsl_histo Gsl_ieee Gsl_integration Gsl_interp Gsl_linalg Gsl_math Gsl_matrix Gsl_matrix_complex Gsl_matrix_complex_flat Gsl_matrix_flat Gsl_min Gsl_misc Gsl_monte Gsl_multifit Gsl_multifit_nlin Gsl_multimin Gsl_multiroot Gsl_odeiv Gsl_permut Gsl_poly Gsl_qrng Gsl_randist Gsl_rng Gsl_root Gsl_sf Gsl_siman Gsl_stats Gsl_sum Gsl_vectmat Gsl_vector Gsl_vector_complex Gsl_vector_complex_flat Gsl_vector_flat Gsl_version Gsl_wavelet # OASIS_STOP gsl-ocaml-1.19.1/lib/gsl_blas.ml000066400000000000000000000270461262311274100163570ustar00rootroot00000000000000 (** BLAS support *) type order = | RowMajor | ColMajor type transpose = | NoTrans | Trans | ConjTrans type uplo = | Upper | Lower type diag = | NonUnit | Unit type side = | Left | Right open Gsl_matrix open Gsl_vector (** {3 LEVEL 1} *) external dot : vector -> vector -> float = "ml_gsl_blas_ddot" external nrm2 : vector -> float = "ml_gsl_blas_dnrm2" external asum : vector -> float = "ml_gsl_blas_dasum" external iamax : vector -> int = "ml_gsl_blas_idamax" external swap : vector -> vector -> unit = "ml_gsl_blas_dswap" external copy : vector -> vector -> unit = "ml_gsl_blas_dcopy" external axpy : float -> vector -> vector -> unit = "ml_gsl_blas_daxpy" external rot : vector -> vector -> float -> float -> unit = "ml_gsl_blas_drot" external scal : float -> vector -> unit = "ml_gsl_blas_dscal" (** {3 LEVEL 2} *) external gemv : transpose -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_dgemv_bc" "ml_gsl_blas_dgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_dtrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_dtrsv" external symv : uplo -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_dsymv_bc" "ml_gsl_blas_dsymv" external dger : alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_dger" external syr : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_dsyr" external syr2 : uplo -> alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_dsyr2" (** {3 LEVEL 3} *) external gemm : ta:transpose -> tb:transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dgemm_bc" "ml_gsl_blas_dgemm" external symm : side -> uplo -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsymm_bc" "ml_gsl_blas_dsymm" external trmm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_dtrmm_bc" "ml_gsl_blas_dtrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_dtrsm_bc" "ml_gsl_blas_dtrsm" external syrk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsyrk_bc" "ml_gsl_blas_dsyrk" external syr2k : uplo -> transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsyr2k_bc" "ml_gsl_blas_dsyr2k" (** {3 Single precision} *) open Gsl_vector.Single open Gsl_matrix.Single module Single = struct (** {4 LEVEL 1} *) external sdsdot : alpha:float -> vector -> vector -> float = "ml_gsl_blas_sdsdot" external dsdot : vector -> vector -> float = "ml_gsl_blas_dsdot" external dot : vector -> vector -> float = "ml_gsl_blas_sdot" external nrm2 : vector -> float = "ml_gsl_blas_snrm2" external asum : vector -> float = "ml_gsl_blas_sasum" external iamax : vector -> int = "ml_gsl_blas_isamax" external swap : vector -> vector -> unit = "ml_gsl_blas_sswap" external copy : vector -> vector -> unit = "ml_gsl_blas_scopy" external axpy : float -> vector -> vector -> unit = "ml_gsl_blas_saxpy" external rot : vector -> vector -> float -> float -> unit = "ml_gsl_blas_srot" external scal : float -> vector -> unit = "ml_gsl_blas_sscal" (** {4 LEVEL 2} *) external gemv : transpose -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_sgemv_bc" "ml_gsl_blas_sgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_strmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_strsv" external symv : uplo -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_ssymv_bc" "ml_gsl_blas_ssymv" external dger : alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_sger" external syr : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_ssyr" external syr2 : uplo -> alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_ssyr2" (** {4 LEVEL 3} *) external gemm : ta:transpose -> tb:transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_sgemm_bc" "ml_gsl_blas_sgemm" external symm : side -> uplo -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_ssymm_bc" "ml_gsl_blas_ssymm" external syrk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_ssyrk_bc" "ml_gsl_blas_ssyrk" external syr2k : uplo -> transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_ssyr2k_bc" "ml_gsl_blas_ssyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_strmm_bc" "ml_gsl_blas_strmm" external trsm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_strsm_bc" "ml_gsl_blas_strsm" end (** {3 Complex} *) open Gsl_vector_complex open Gsl_matrix_complex open Gsl_complex module Complex = struct (** {4 LEVEL 1} *) external dotu : vector -> vector -> complex = "ml_gsl_blas_zdotu" external dotc : vector -> vector -> complex = "ml_gsl_blas_zdotc" external nrm2 : vector -> float = "ml_gsl_blas_znrm2" external asum : vector -> float = "ml_gsl_blas_zasum" external iamax : vector -> int = "ml_gsl_blas_izamax" external swap : vector -> vector -> unit = "ml_gsl_blas_zswap" external copy : vector -> vector -> unit = "ml_gsl_blas_zcopy" external axpy : complex -> vector -> vector -> unit = "ml_gsl_blas_zaxpy" external scal : complex -> vector -> unit = "ml_gsl_blas_zscal" external zdscal : float -> vector -> unit = "ml_gsl_blas_zdscal" (** {4 LEVEL 2} *) external gemv : transpose -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_zgemv_bc" "ml_gsl_blas_zgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ztrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ztrsv" external hemv : uplo -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_zhemv_bc" "ml_gsl_blas_zhemv" external geru : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zgeru" external gerc : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zgerc" external her : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_zher" external her2 : uplo -> alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zher2" (** {4 LEVEL 3} *) external gemm : ta:transpose -> tb:transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zgemm_bc" "ml_gsl_blas_zgemm" external symm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsymm_bc" "ml_gsl_blas_zsymm" external syrk : uplo -> transpose -> alpha:complex -> a:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsyrk_bc" "ml_gsl_blas_zsyrk" external syr2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsyr2k_bc" "ml_gsl_blas_zsyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ztrmm_bc" "ml_gsl_blas_ztrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ztrsm_bc" "ml_gsl_blas_ztrsm" external hemm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zhemm_bc" "ml_gsl_blas_zhemm" external herk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_zherk_bc" "ml_gsl_blas_zherk" external her2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_zher2k_bc" "ml_gsl_blas_zher2k" end (** {3 Complex single precision} *) open Gsl_vector_complex.Single open Gsl_matrix_complex.Single module Complex_Single = struct (** {4 LEVEL 1} *) external dotu : vector -> vector -> complex = "ml_gsl_blas_cdotu" external dotc : vector -> vector -> complex = "ml_gsl_blas_cdotc" external nrm2 : vector -> float = "ml_gsl_blas_scnrm2" external asum : vector -> float = "ml_gsl_blas_scasum" external iamax : vector -> int = "ml_gsl_blas_icamax" external swap : vector -> vector -> unit = "ml_gsl_blas_cswap" external copy : vector -> vector -> unit = "ml_gsl_blas_ccopy" external axpy : complex -> vector -> vector -> unit = "ml_gsl_blas_caxpy" external scal : complex -> vector -> unit = "ml_gsl_blas_cscal" external csscal : float -> vector -> unit = "ml_gsl_blas_csscal" (** {4 LEVEL 2} *) external gemv : transpose -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_cgemv_bc" "ml_gsl_blas_cgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ctrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ctrsv" external hemv : uplo -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_chemv_bc" "ml_gsl_blas_chemv" external geru : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_cgeru" external gerc : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_cgerc" external her : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_cher" external her2 : uplo -> alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_cher2" (** {4 LEVEL 3} *) external gemm : ta:transpose -> tb:transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_cgemm_bc" "ml_gsl_blas_cgemm" external symm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_csymm_bc" "ml_gsl_blas_csymm" external syrk : uplo -> transpose -> alpha:complex -> a:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_csyrk_bc" "ml_gsl_blas_csyrk" external syr2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_csyr2k_bc" "ml_gsl_blas_csyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ctrmm_bc" "ml_gsl_blas_ctrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ctrsm_bc" "ml_gsl_blas_ctrsm" external hemm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_chemm_bc" "ml_gsl_blas_chemm" external herk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_cherk_bc" "ml_gsl_blas_cherk" external her2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_cher2k_bc" "ml_gsl_blas_cher2k" end gsl-ocaml-1.19.1/lib/gsl_blas.mli000066400000000000000000000270351262311274100165260ustar00rootroot00000000000000 (** BLAS support *) type order = | RowMajor | ColMajor type transpose = | NoTrans | Trans | ConjTrans type uplo = | Upper | Lower type diag = | NonUnit | Unit type side = | Left | Right open Gsl_matrix open Gsl_vector (** {3 LEVEL 1} *) external dot : vector -> vector -> float = "ml_gsl_blas_ddot" external nrm2 : vector -> float = "ml_gsl_blas_dnrm2" external asum : vector -> float = "ml_gsl_blas_dasum" external iamax : vector -> int = "ml_gsl_blas_idamax" external swap : vector -> vector -> unit = "ml_gsl_blas_dswap" external copy : vector -> vector -> unit = "ml_gsl_blas_dcopy" external axpy : float -> vector -> vector -> unit = "ml_gsl_blas_daxpy" external rot : vector -> vector -> float -> float -> unit = "ml_gsl_blas_drot" external scal : float -> vector -> unit = "ml_gsl_blas_dscal" (** {3 LEVEL 2} *) external gemv : transpose -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_dgemv_bc" "ml_gsl_blas_dgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_dtrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_dtrsv" external symv : uplo -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_dsymv_bc" "ml_gsl_blas_dsymv" external dger : alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_dger" external syr : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_dsyr" external syr2 : uplo -> alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_dsyr2" (** {3 LEVEL 3} *) external gemm : ta:transpose -> tb:transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dgemm_bc" "ml_gsl_blas_dgemm" external symm : side -> uplo -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsymm_bc" "ml_gsl_blas_dsymm" external trmm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_dtrmm_bc" "ml_gsl_blas_dtrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_dtrsm_bc" "ml_gsl_blas_dtrsm" external syrk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsyrk_bc" "ml_gsl_blas_dsyrk" external syr2k : uplo -> transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsyr2k_bc" "ml_gsl_blas_dsyr2k" (** {3 Single precision} *) open Gsl_vector.Single open Gsl_matrix.Single module Single : sig (** {4 LEVEL 1} *) external sdsdot : alpha:float -> vector -> vector -> float = "ml_gsl_blas_sdsdot" external dsdot : vector -> vector -> float = "ml_gsl_blas_dsdot" external dot : vector -> vector -> float = "ml_gsl_blas_sdot" external nrm2 : vector -> float = "ml_gsl_blas_snrm2" external asum : vector -> float = "ml_gsl_blas_sasum" external iamax : vector -> int = "ml_gsl_blas_isamax" external swap : vector -> vector -> unit = "ml_gsl_blas_sswap" external copy : vector -> vector -> unit = "ml_gsl_blas_scopy" external axpy : float -> vector -> vector -> unit = "ml_gsl_blas_saxpy" external rot : vector -> vector -> float -> float -> unit = "ml_gsl_blas_srot" external scal : float -> vector -> unit = "ml_gsl_blas_sscal" (** {4 LEVEL 2} *) external gemv : transpose -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_sgemv_bc" "ml_gsl_blas_sgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_strmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_strsv" external symv : uplo -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_ssymv_bc" "ml_gsl_blas_ssymv" external dger : alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_sger" external syr : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_ssyr" external syr2 : uplo -> alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_ssyr2" (** {4 LEVEL 3} *) external gemm : ta:transpose -> tb:transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_sgemm_bc" "ml_gsl_blas_sgemm" external symm : side -> uplo -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_ssymm_bc" "ml_gsl_blas_ssymm" external syrk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_ssyrk_bc" "ml_gsl_blas_ssyrk" external syr2k : uplo -> transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_ssyr2k_bc" "ml_gsl_blas_ssyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_strmm_bc" "ml_gsl_blas_strmm" external trsm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_strsm_bc" "ml_gsl_blas_strsm" end (** {3 Complex} *) open Gsl_vector_complex open Gsl_matrix_complex open Gsl_complex module Complex : sig (** {4 LEVEL 1} *) external dotu : vector -> vector -> complex = "ml_gsl_blas_zdotu" external dotc : vector -> vector -> complex = "ml_gsl_blas_zdotc" external nrm2 : vector -> float = "ml_gsl_blas_znrm2" external asum : vector -> float = "ml_gsl_blas_zasum" external iamax : vector -> int = "ml_gsl_blas_izamax" external swap : vector -> vector -> unit = "ml_gsl_blas_zswap" external copy : vector -> vector -> unit = "ml_gsl_blas_zcopy" external axpy : complex -> vector -> vector -> unit = "ml_gsl_blas_zaxpy" external scal : complex -> vector -> unit = "ml_gsl_blas_zscal" external zdscal : float -> vector -> unit = "ml_gsl_blas_zdscal" (** {4 LEVEL 2} *) external gemv : transpose -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_zgemv_bc" "ml_gsl_blas_zgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ztrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ztrsv" external hemv : uplo -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_zhemv_bc" "ml_gsl_blas_zhemv" external geru : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zgeru" external gerc : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zgerc" external her : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_zher" external her2 : uplo -> alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zher2" (** {4 LEVEL 3} *) external gemm : ta:transpose -> tb:transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zgemm_bc" "ml_gsl_blas_zgemm" external symm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsymm_bc" "ml_gsl_blas_zsymm" external syrk : uplo -> transpose -> alpha:complex -> a:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsyrk_bc" "ml_gsl_blas_zsyrk" external syr2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsyr2k_bc" "ml_gsl_blas_zsyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ztrmm_bc" "ml_gsl_blas_ztrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ztrsm_bc" "ml_gsl_blas_ztrsm" external hemm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zhemm_bc" "ml_gsl_blas_zhemm" external herk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_zherk_bc" "ml_gsl_blas_zherk" external her2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_zher2k_bc" "ml_gsl_blas_zher2k" end (** {3 Complex single precision} *) open Gsl_vector_complex.Single open Gsl_matrix_complex.Single module Complex_Single : sig (** {4 LEVEL 1} *) external dotu : vector -> vector -> complex = "ml_gsl_blas_cdotu" external dotc : vector -> vector -> complex = "ml_gsl_blas_cdotc" external nrm2 : vector -> float = "ml_gsl_blas_scnrm2" external asum : vector -> float = "ml_gsl_blas_scasum" external iamax : vector -> int = "ml_gsl_blas_icamax" external swap : vector -> vector -> unit = "ml_gsl_blas_cswap" external copy : vector -> vector -> unit = "ml_gsl_blas_ccopy" external axpy : complex -> vector -> vector -> unit = "ml_gsl_blas_caxpy" external scal : complex -> vector -> unit = "ml_gsl_blas_cscal" external csscal : float -> vector -> unit = "ml_gsl_blas_csscal" (** {4 LEVEL 2} *) external gemv : transpose -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_cgemv_bc" "ml_gsl_blas_cgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ctrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ctrsv" external hemv : uplo -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_chemv_bc" "ml_gsl_blas_chemv" external geru : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_cgeru" external gerc : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_cgerc" external her : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_cher" external her2 : uplo -> alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_cher2" (** {4 LEVEL 3} *) external gemm : ta:transpose -> tb:transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_cgemm_bc" "ml_gsl_blas_cgemm" external symm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_csymm_bc" "ml_gsl_blas_csymm" external syrk : uplo -> transpose -> alpha:complex -> a:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_csyrk_bc" "ml_gsl_blas_csyrk" external syr2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_csyr2k_bc" "ml_gsl_blas_csyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ctrmm_bc" "ml_gsl_blas_ctrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ctrsm_bc" "ml_gsl_blas_ctrsm" external hemm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_chemm_bc" "ml_gsl_blas_chemm" external herk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_cherk_bc" "ml_gsl_blas_cherk" external her2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_cher2k_bc" "ml_gsl_blas_cher2k" end gsl-ocaml-1.19.1/lib/gsl_blas_flat.ml000066400000000000000000000136501262311274100173610ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type order = Gsl_blas.order = | RowMajor | ColMajor type transpose = Gsl_blas.transpose = | NoTrans | Trans | ConjTrans type uplo = Gsl_blas.uplo = | Upper | Lower type diag = Gsl_blas.diag = | NonUnit | Unit type side = Gsl_blas.side = | Left | Right open Gsl_matrix_flat open Gsl_vector_flat (* LEVEL 1 *) external dot : vector -> vector -> float = "ml_gsl_blas_ddot" external nrm2 : vector -> float = "ml_gsl_blas_dnrm2" external asum : vector -> float = "ml_gsl_blas_dasum" external iamax : vector -> int = "ml_gsl_blas_idamax" external swap : vector -> vector -> unit = "ml_gsl_blas_dswap" external copy : vector -> vector -> unit = "ml_gsl_blas_dcopy" external axpy : float -> vector -> vector -> unit = "ml_gsl_blas_daxpy" external rot : vector -> vector -> float -> float -> unit = "ml_gsl_blas_drot" external scal : float -> vector -> unit = "ml_gsl_blas_dscal" (* LEVEL 2 *) external gemv : transpose -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_dgemv_bc" "ml_gsl_blas_dgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_dtrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_dtrsv" external symv : uplo -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_dsymv_bc" "ml_gsl_blas_dsymv" external dger : alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_dger" external syr : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_dsyr" external syr2 : uplo -> alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_dsyr2" (* LEVEL 3 *) external gemm : ta:transpose -> tb:transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dgemm_bc" "ml_gsl_blas_dgemm" external symm : side -> uplo -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsymm_bc" "ml_gsl_blas_dsymm" external trmm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_dtrmm_bc" "ml_gsl_blas_dtrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_dtrsm_bc" "ml_gsl_blas_dtrsm" external syrk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsyrk_bc" "ml_gsl_blas_dsyrk" external syr2k : uplo -> transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsyr2k_bc" "ml_gsl_blas_dsyr2k" open Gsl_vector_complex_flat open Gsl_matrix_complex_flat open Gsl_complex module Complex = struct (* LEVEL 1 *) external dotu : vector -> vector -> complex = "ml_gsl_blas_zdotu" external dotc : vector -> vector -> complex = "ml_gsl_blas_zdotc" external nrm2 : vector -> float = "ml_gsl_blas_znrm2" external asum : vector -> float = "ml_gsl_blas_zasum" external iamax : vector -> int = "ml_gsl_blas_izamax" external swap : vector -> vector -> unit = "ml_gsl_blas_zswap" external copy : vector -> vector -> unit = "ml_gsl_blas_zcopy" external axpy : complex -> vector -> vector -> unit = "ml_gsl_blas_zaxpy" external scal : complex -> vector -> unit = "ml_gsl_blas_zscal" external zdscal : float -> vector -> unit = "ml_gsl_blas_zdscal" (* LEVEL 2 *) external gemv : transpose -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_zgemv_bc" "ml_gsl_blas_zgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ztrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ztrsv" external hemv : uplo -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_zhemv_bc" "ml_gsl_blas_zhemv" external geru : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zgeru" external gerc : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zgerc" external her : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_zher" external her2 : uplo -> alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zher2" (* LEVEL 3 *) external gemm : ta:transpose -> tb:transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zgemm_bc" "ml_gsl_blas_zgemm" external symm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsymm_bc" "ml_gsl_blas_zsymm" external syrk : uplo -> transpose -> alpha:complex -> a:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsyrk_bc" "ml_gsl_blas_zsyrk" external syr2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsyr2k_bc" "ml_gsl_blas_zsyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ztrmm_bc" "ml_gsl_blas_ztrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ztrsm_bc" "ml_gsl_blas_ztrsm" external hemm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zhemm_bc" "ml_gsl_blas_zhemm" external herk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_zherk_bc" "ml_gsl_blas_zherk" external her2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_zher2k_bc" "ml_gsl_blas_zher2k" end gsl-ocaml-1.19.1/lib/gsl_blas_flat.mli000066400000000000000000000136451262311274100175360ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type order = Gsl_blas.order = | RowMajor | ColMajor type transpose = Gsl_blas.transpose = | NoTrans | Trans | ConjTrans type uplo = Gsl_blas.uplo = | Upper | Lower type diag = Gsl_blas.diag = | NonUnit | Unit type side = Gsl_blas.side = | Left | Right open Gsl_matrix_flat open Gsl_vector_flat (* LEVEL 1 *) external dot : vector -> vector -> float = "ml_gsl_blas_ddot" external nrm2 : vector -> float = "ml_gsl_blas_dnrm2" external asum : vector -> float = "ml_gsl_blas_dasum" external iamax : vector -> int = "ml_gsl_blas_idamax" external swap : vector -> vector -> unit = "ml_gsl_blas_dswap" external copy : vector -> vector -> unit = "ml_gsl_blas_dcopy" external axpy : float -> vector -> vector -> unit = "ml_gsl_blas_daxpy" external rot : vector -> vector -> float -> float -> unit = "ml_gsl_blas_drot" external scal : float -> vector -> unit = "ml_gsl_blas_dscal" (* LEVEL 2 *) external gemv : transpose -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_dgemv_bc" "ml_gsl_blas_dgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_dtrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_dtrsv" external symv : uplo -> alpha:float -> a:matrix -> x:vector -> beta:float -> y:vector -> unit = "ml_gsl_blas_dsymv_bc" "ml_gsl_blas_dsymv" external dger : alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_dger" external syr : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_dsyr" external syr2 : uplo -> alpha:float -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_dsyr2" (* LEVEL 3 *) external gemm : ta:transpose -> tb:transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dgemm_bc" "ml_gsl_blas_dgemm" external symm : side -> uplo -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsymm_bc" "ml_gsl_blas_dsymm" external trmm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_dtrmm_bc" "ml_gsl_blas_dtrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:float -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_dtrsm_bc" "ml_gsl_blas_dtrsm" external syrk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsyrk_bc" "ml_gsl_blas_dsyrk" external syr2k : uplo -> transpose -> alpha:float -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_dsyr2k_bc" "ml_gsl_blas_dsyr2k" open Gsl_vector_complex_flat open Gsl_matrix_complex_flat open Gsl_complex module Complex : sig (* LEVEL 1 *) external dotu : vector -> vector -> complex = "ml_gsl_blas_zdotu" external dotc : vector -> vector -> complex = "ml_gsl_blas_zdotc" external nrm2 : vector -> float = "ml_gsl_blas_znrm2" external asum : vector -> float = "ml_gsl_blas_zasum" external iamax : vector -> int = "ml_gsl_blas_izamax" external swap : vector -> vector -> unit = "ml_gsl_blas_zswap" external copy : vector -> vector -> unit = "ml_gsl_blas_zcopy" external axpy : complex -> vector -> vector -> unit = "ml_gsl_blas_zaxpy" external scal : complex -> vector -> unit = "ml_gsl_blas_zscal" external zdscal : float -> vector -> unit = "ml_gsl_blas_zdscal" (* LEVEL 2 *) external gemv : transpose -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_zgemv_bc" "ml_gsl_blas_zgemv" external trmv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ztrmv" external trsv : uplo -> transpose -> diag -> a:matrix -> x:vector -> unit = "ml_gsl_blas_ztrsv" external hemv : uplo -> alpha:complex -> a:matrix -> x:vector -> beta:complex -> y:vector -> unit = "ml_gsl_blas_zhemv_bc" "ml_gsl_blas_zhemv" external geru : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zgeru" external gerc : alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zgerc" external her : uplo -> alpha:float -> x:vector -> a:matrix -> unit = "ml_gsl_blas_zher" external her2 : uplo -> alpha:complex -> x:vector -> y:vector -> a:matrix -> unit = "ml_gsl_blas_zher2" (* LEVEL 3 *) external gemm : ta:transpose -> tb:transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zgemm_bc" "ml_gsl_blas_zgemm" external symm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsymm_bc" "ml_gsl_blas_zsymm" external syrk : uplo -> transpose -> alpha:complex -> a:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsyrk_bc" "ml_gsl_blas_zsyrk" external syr2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zsyr2k_bc" "ml_gsl_blas_zsyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ztrmm_bc" "ml_gsl_blas_ztrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:complex -> a:matrix -> b:matrix -> unit = "ml_gsl_blas_ztrsm_bc" "ml_gsl_blas_ztrsm" external hemm : side -> uplo -> alpha:complex -> a:matrix -> b:matrix -> beta:complex -> c:matrix -> unit = "ml_gsl_blas_zhemm_bc" "ml_gsl_blas_zhemm" external herk : uplo -> transpose -> alpha:float -> a:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_zherk_bc" "ml_gsl_blas_zherk" external her2k : uplo -> transpose -> alpha:complex -> a:matrix -> b:matrix -> beta:float -> c:matrix -> unit = "ml_gsl_blas_zher2k_bc" "ml_gsl_blas_zher2k" end gsl-ocaml-1.19.1/lib/gsl_blas_gen.ml000066400000000000000000000137721262311274100172110ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type order = Gsl_blas.order = | RowMajor | ColMajor type transpose = Gsl_blas.transpose = | NoTrans | Trans | ConjTrans type uplo = Gsl_blas.uplo = | Upper | Lower type diag = Gsl_blas.diag = | NonUnit | Unit type side = Gsl_blas.side = | Left | Right open Gsl_vectmat (* LEVEL 1 *) external dot : [< vec] -> [< vec] -> float = "ml_gsl_blas_ddot" external nrm2 : [< vec] -> float = "ml_gsl_blas_dnrm2" external asum : [< vec] -> float = "ml_gsl_blas_dasum" external iamax : [< vec] -> int = "ml_gsl_blas_idamax" external swap : [< vec] -> [< vec] -> unit = "ml_gsl_blas_dswap" external copy : [< vec] -> [< vec] -> unit = "ml_gsl_blas_dcopy" external axpy : float -> [< vec] -> [< vec] -> unit = "ml_gsl_blas_daxpy" external rot : [< vec] -> [< vec] -> float -> float -> unit = "ml_gsl_blas_drot" external scal : float -> [< vec] -> unit = "ml_gsl_blas_dscal" (* LEVEL 2 *) external gemv : transpose -> alpha:float -> a:[< mat] -> x:[< vec] -> beta:float -> y:[< vec] -> unit = "ml_gsl_blas_dgemv_bc" "ml_gsl_blas_dgemv" external trmv : uplo -> transpose -> diag -> a:[< mat] -> x:[< vec] -> unit = "ml_gsl_blas_dtrmv" external trsv : uplo -> transpose -> diag -> a:[< mat] -> x:[< vec] -> unit = "ml_gsl_blas_dtrsv" external symv : uplo -> alpha:float -> a:[< mat] -> x:[< vec] -> beta:float -> y:[< vec] -> unit = "ml_gsl_blas_dsymv_bc" "ml_gsl_blas_dsymv" external dger : alpha:float -> x:[< vec] -> y:[< vec] -> a:[< mat] -> unit = "ml_gsl_blas_dger" external syr : uplo -> alpha:float -> x:[< vec] -> a:[< mat] -> unit = "ml_gsl_blas_dsyr" external syr2 : uplo -> alpha:float -> x:[< vec] -> y:[< vec] -> a:[< mat] -> unit = "ml_gsl_blas_dsyr2" (* LEVEL 3 *) external gemm : ta:transpose -> tb:transpose -> alpha:float -> a:[< mat] -> b:[< mat] -> beta:float -> c:[< mat] -> unit = "ml_gsl_blas_dgemm_bc" "ml_gsl_blas_dgemm" external symm : side -> uplo -> alpha:float -> a:[< mat] -> b:[< mat] -> beta:float -> c:[< mat] -> unit = "ml_gsl_blas_dsymm_bc" "ml_gsl_blas_dsymm" external trmm : side -> uplo -> transpose -> diag -> alpha:float -> a:[< mat] -> b:[< mat] -> unit = "ml_gsl_blas_dtrmm_bc" "ml_gsl_blas_dtrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:float -> a:[< mat] -> b:[< mat] -> unit = "ml_gsl_blas_dtrsm_bc" "ml_gsl_blas_dtrsm" external syrk : uplo -> transpose -> alpha:float -> a:[< mat] -> beta:float -> c:[< mat] -> unit = "ml_gsl_blas_dsyrk_bc" "ml_gsl_blas_dsyrk" external syr2k : uplo -> transpose -> alpha:float -> a:[< mat] -> b:[< mat] -> beta:float -> c:[< mat] -> unit = "ml_gsl_blas_dsyr2k_bc" "ml_gsl_blas_dsyr2k" open Gsl_complex module Complex = struct (* LEVEL 1 *) external dotu : [< cvec] -> [< cvec] -> complex = "ml_gsl_blas_zdotu" external dotc : [< cvec] -> [< cvec] -> complex = "ml_gsl_blas_zdotc" external nrm2 : [< cvec] -> float = "ml_gsl_blas_znrm2" external asum : [< cvec] -> float = "ml_gsl_blas_zasum" external iamax : [< cvec] -> int = "ml_gsl_blas_izamax" external swap : [< cvec] -> [< cvec] -> unit = "ml_gsl_blas_zswap" external copy : [< cvec] -> [< cvec] -> unit = "ml_gsl_blas_zcopy" external axpy : complex -> [< cvec] -> [< cvec] -> unit = "ml_gsl_blas_zaxpy" external scal : complex -> [< cvec] -> unit = "ml_gsl_blas_zscal" external zdscal : float -> [< cvec] -> unit = "ml_gsl_blas_zdscal" (* LEVEL 2 *) external gemv : transpose -> alpha:complex -> a:[< cmat] -> x:[< cvec] -> beta:complex -> y:[< cvec] -> unit = "ml_gsl_blas_zgemv_bc" "ml_gsl_blas_zgemv" external trmv : uplo -> transpose -> diag -> a:[< cmat] -> x:[< cvec] -> unit = "ml_gsl_blas_ztrmv" external trsv : uplo -> transpose -> diag -> a:[< cmat] -> x:[< cvec] -> unit = "ml_gsl_blas_ztrsv" external hemv : uplo -> alpha:complex -> a:[< cmat] -> x:[< cvec] -> beta:complex -> y:[< cvec] -> unit = "ml_gsl_blas_zhemv_bc" "ml_gsl_blas_zhemv" external geru : alpha:complex -> x:[< cvec] -> y:[< cvec] -> a:[< cmat] -> unit = "ml_gsl_blas_zgeru" external gerc : alpha:complex -> x:[< cvec] -> y:[< cvec] -> a:[< cmat] -> unit = "ml_gsl_blas_zgerc" external her : uplo -> alpha:float -> x:[< cvec] -> a:[< cmat] -> unit = "ml_gsl_blas_zher" external her2 : uplo -> alpha:complex -> x:[< cvec] -> y:[< cvec] -> a:[< cmat] -> unit = "ml_gsl_blas_zher2" (* LEVEL 3 *) external gemm : ta:transpose -> tb:transpose -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zgemm_bc" "ml_gsl_blas_zgemm" external symm : side -> uplo -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zsymm_bc" "ml_gsl_blas_zsymm" external syrk : uplo -> transpose -> alpha:complex -> a:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zsyrk_bc" "ml_gsl_blas_zsyrk" external syr2k : uplo -> transpose -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zsyr2k_bc" "ml_gsl_blas_zsyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> unit = "ml_gsl_blas_ztrmm_bc" "ml_gsl_blas_ztrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> unit = "ml_gsl_blas_ztrsm_bc" "ml_gsl_blas_ztrsm" external hemm : side -> uplo -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zhemm_bc" "ml_gsl_blas_zhemm" external herk : uplo -> transpose -> alpha:float -> a:[< cmat] -> beta:float -> c:[< cmat] -> unit = "ml_gsl_blas_zherk_bc" "ml_gsl_blas_zherk" external her2k : uplo -> transpose -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:float -> c:[< cmat] -> unit = "ml_gsl_blas_zher2k_bc" "ml_gsl_blas_zher2k" end gsl-ocaml-1.19.1/lib/gsl_blas_gen.mli000066400000000000000000000137671262311274100173660ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type order = Gsl_blas.order = | RowMajor | ColMajor type transpose = Gsl_blas.transpose = | NoTrans | Trans | ConjTrans type uplo = Gsl_blas.uplo = | Upper | Lower type diag = Gsl_blas.diag = | NonUnit | Unit type side = Gsl_blas.side = | Left | Right open Gsl_vectmat (* LEVEL 1 *) external dot : [< vec] -> [< vec] -> float = "ml_gsl_blas_ddot" external nrm2 : [< vec] -> float = "ml_gsl_blas_dnrm2" external asum : [< vec] -> float = "ml_gsl_blas_dasum" external iamax : [< vec] -> int = "ml_gsl_blas_idamax" external swap : [< vec] -> [< vec] -> unit = "ml_gsl_blas_dswap" external copy : [< vec] -> [< vec] -> unit = "ml_gsl_blas_dcopy" external axpy : float -> [< vec] -> [< vec] -> unit = "ml_gsl_blas_daxpy" external rot : [< vec] -> [< vec] -> float -> float -> unit = "ml_gsl_blas_drot" external scal : float -> [< vec] -> unit = "ml_gsl_blas_dscal" (* LEVEL 2 *) external gemv : transpose -> alpha:float -> a:[< mat] -> x:[< vec] -> beta:float -> y:[< vec] -> unit = "ml_gsl_blas_dgemv_bc" "ml_gsl_blas_dgemv" external trmv : uplo -> transpose -> diag -> a:[< mat] -> x:[< vec] -> unit = "ml_gsl_blas_dtrmv" external trsv : uplo -> transpose -> diag -> a:[< mat] -> x:[< vec] -> unit = "ml_gsl_blas_dtrsv" external symv : uplo -> alpha:float -> a:[< mat] -> x:[< vec] -> beta:float -> y:[< vec] -> unit = "ml_gsl_blas_dsymv_bc" "ml_gsl_blas_dsymv" external dger : alpha:float -> x:[< vec] -> y:[< vec] -> a:[< mat] -> unit = "ml_gsl_blas_dger" external syr : uplo -> alpha:float -> x:[< vec] -> a:[< mat] -> unit = "ml_gsl_blas_dsyr" external syr2 : uplo -> alpha:float -> x:[< vec] -> y:[< vec] -> a:[< mat] -> unit = "ml_gsl_blas_dsyr2" (* LEVEL 3 *) external gemm : ta:transpose -> tb:transpose -> alpha:float -> a:[< mat] -> b:[< mat] -> beta:float -> c:[< mat] -> unit = "ml_gsl_blas_dgemm_bc" "ml_gsl_blas_dgemm" external symm : side -> uplo -> alpha:float -> a:[< mat] -> b:[< mat] -> beta:float -> c:[< mat] -> unit = "ml_gsl_blas_dsymm_bc" "ml_gsl_blas_dsymm" external trmm : side -> uplo -> transpose -> diag -> alpha:float -> a:[< mat] -> b:[< mat] -> unit = "ml_gsl_blas_dtrmm_bc" "ml_gsl_blas_dtrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:float -> a:[< mat] -> b:[< mat] -> unit = "ml_gsl_blas_dtrsm_bc" "ml_gsl_blas_dtrsm" external syrk : uplo -> transpose -> alpha:float -> a:[< mat] -> beta:float -> c:[< mat] -> unit = "ml_gsl_blas_dsyrk_bc" "ml_gsl_blas_dsyrk" external syr2k : uplo -> transpose -> alpha:float -> a:[< mat] -> b:[< mat] -> beta:float -> c:[< mat] -> unit = "ml_gsl_blas_dsyr2k_bc" "ml_gsl_blas_dsyr2k" open Gsl_complex module Complex : sig (* LEVEL 1 *) external dotu : [< cvec] -> [< cvec] -> complex = "ml_gsl_blas_zdotu" external dotc : [< cvec] -> [< cvec] -> complex = "ml_gsl_blas_zdotc" external nrm2 : [< cvec] -> float = "ml_gsl_blas_znrm2" external asum : [< cvec] -> float = "ml_gsl_blas_zasum" external iamax : [< cvec] -> int = "ml_gsl_blas_izamax" external swap : [< cvec] -> [< cvec] -> unit = "ml_gsl_blas_zswap" external copy : [< cvec] -> [< cvec] -> unit = "ml_gsl_blas_zcopy" external axpy : complex -> [< cvec] -> [< cvec] -> unit = "ml_gsl_blas_zaxpy" external scal : complex -> [< cvec] -> unit = "ml_gsl_blas_zscal" external zdscal : float -> [< cvec] -> unit = "ml_gsl_blas_zdscal" (* LEVEL 2 *) external gemv : transpose -> alpha:complex -> a:[< cmat] -> x:[< cvec] -> beta:complex -> y:[< cvec] -> unit = "ml_gsl_blas_zgemv_bc" "ml_gsl_blas_zgemv" external trmv : uplo -> transpose -> diag -> a:[< cmat] -> x:[< cvec] -> unit = "ml_gsl_blas_ztrmv" external trsv : uplo -> transpose -> diag -> a:[< cmat] -> x:[< cvec] -> unit = "ml_gsl_blas_ztrsv" external hemv : uplo -> alpha:complex -> a:[< cmat] -> x:[< cvec] -> beta:complex -> y:[< cvec] -> unit = "ml_gsl_blas_zhemv_bc" "ml_gsl_blas_zhemv" external geru : alpha:complex -> x:[< cvec] -> y:[< cvec] -> a:[< cmat] -> unit = "ml_gsl_blas_zgeru" external gerc : alpha:complex -> x:[< cvec] -> y:[< cvec] -> a:[< cmat] -> unit = "ml_gsl_blas_zgerc" external her : uplo -> alpha:float -> x:[< cvec] -> a:[< cmat] -> unit = "ml_gsl_blas_zher" external her2 : uplo -> alpha:complex -> x:[< cvec] -> y:[< cvec] -> a:[< cmat] -> unit = "ml_gsl_blas_zher2" (* LEVEL 3 *) external gemm : ta:transpose -> tb:transpose -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zgemm_bc" "ml_gsl_blas_zgemm" external symm : side -> uplo -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zsymm_bc" "ml_gsl_blas_zsymm" external syrk : uplo -> transpose -> alpha:complex -> a:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zsyrk_bc" "ml_gsl_blas_zsyrk" external syr2k : uplo -> transpose -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zsyr2k_bc" "ml_gsl_blas_zsyr2k" external trmm : side -> uplo -> transpose -> diag -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> unit = "ml_gsl_blas_ztrmm_bc" "ml_gsl_blas_ztrmm" external trsm : side -> uplo -> transpose -> diag -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> unit = "ml_gsl_blas_ztrsm_bc" "ml_gsl_blas_ztrsm" external hemm : side -> uplo -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:complex -> c:[< cmat] -> unit = "ml_gsl_blas_zhemm_bc" "ml_gsl_blas_zhemm" external herk : uplo -> transpose -> alpha:float -> a:[< cmat] -> beta:float -> c:[< cmat] -> unit = "ml_gsl_blas_zherk_bc" "ml_gsl_blas_zherk" external her2k : uplo -> transpose -> alpha:complex -> a:[< cmat] -> b:[< cmat] -> beta:float -> c:[< cmat] -> unit = "ml_gsl_blas_zher2k_bc" "ml_gsl_blas_zher2k" end gsl-ocaml-1.19.1/lib/gsl_bspline.ml000066400000000000000000000014651262311274100170670ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2007 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type ws external _alloc : k:int -> nbreak:int -> ws = "ml_gsl_bspline_alloc" external _free : ws -> unit = "ml_gsl_bspline_free" let make ~k ~nbreak = let ws = _alloc ~k ~nbreak in Gc.finalise _free ws ; ws external ncoeffs : ws -> int = "ml_gsl_bspline_ncoeffs" "noalloc" open Gsl_vectmat external knots : [< vec] -> ws -> unit = "ml_gsl_bspline_knots" external knots_uniform : a:float -> b:float -> ws -> unit = "ml_gsl_bspline_knots_uniform" external _eval : float -> [< vec] -> ws -> unit = "ml_gsl_bspline_eval" let eval ws x = let n = ncoeffs ws in let v = `V (Gsl_vector.create n) in _eval x v ws ; v gsl-ocaml-1.19.1/lib/gsl_bspline.mli000066400000000000000000000011361262311274100172330ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2007 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Basis Splines *) type ws val make : k:int -> nbreak:int -> ws external ncoeffs : ws -> int = "ml_gsl_bspline_ncoeffs" "noalloc" open Gsl_vectmat external knots : [< vec] -> ws -> unit = "ml_gsl_bspline_knots" external knots_uniform : a:float -> b:float -> ws -> unit = "ml_gsl_bspline_knots_uniform" external _eval : float -> [< vec] -> ws -> unit = "ml_gsl_bspline_eval" val eval : ws -> float -> [> vec] gsl-ocaml-1.19.1/lib/gsl_cdf.ml000066400000000000000000000222021262311274100161570ustar00rootroot00000000000000(** Cumulative distribution functions *) external ugaussian_P : x:float -> float = "ml_gsl_cdf_ugaussian_P" "gsl_cdf_ugaussian_P" "float" external ugaussian_Q : x:float -> float = "ml_gsl_cdf_ugaussian_Q" "gsl_cdf_ugaussian_Q" "float" external ugaussian_Pinv : p:float -> float = "ml_gsl_cdf_ugaussian_Pinv" "gsl_cdf_ugaussian_Pinv" "float" external ugaussian_Qinv : q:float -> float = "ml_gsl_cdf_ugaussian_Qinv" "gsl_cdf_ugaussian_Qinv" "float" external gaussian_P : x:float -> sigma:float -> float = "ml_gsl_cdf_gaussian_P" "gsl_cdf_gaussian_P" "float" external gaussian_Q : x:float -> sigma:float -> float = "ml_gsl_cdf_gaussian_Q" "gsl_cdf_gaussian_Q" "float" external gaussian_Pinv : p:float -> sigma:float -> float = "ml_gsl_cdf_gaussian_Pinv" "gsl_cdf_gaussian_Pinv" "float" external gaussian_Qinv : q:float -> sigma:float -> float = "ml_gsl_cdf_gaussian_Qinv" "gsl_cdf_gaussian_Qinv" "float" external gamma_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gamma_P" "gsl_cdf_gamma_P" "float" external gamma_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gamma_Q" "gsl_cdf_gamma_Q" "float" external gamma_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_gamma_Pinv" "gsl_cdf_gamma_Pinv" "float" external gamma_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_gamma_Qinv" "gsl_cdf_gamma_Qinv" "float" external cauchy_P : x:float -> a:float -> float = "ml_gsl_cdf_cauchy_P" "gsl_cdf_cauchy_P" "float" external cauchy_Q : x:float -> a:float -> float = "ml_gsl_cdf_cauchy_Q" "gsl_cdf_cauchy_Q" "float" external cauchy_Pinv : p:float -> a:float -> float = "ml_gsl_cdf_cauchy_Pinv" "gsl_cdf_cauchy_Pinv" "float" external cauchy_Qinv : q:float -> a:float -> float = "ml_gsl_cdf_cauchy_Qinv" "gsl_cdf_cauchy_Qinv" "float" external laplace_P : x:float -> a:float -> float = "ml_gsl_cdf_laplace_P" "gsl_cdf_laplace_P" "float" external laplace_Q : x:float -> a:float -> float = "ml_gsl_cdf_laplace_Q" "gsl_cdf_laplace_Q" "float" external laplace_Pinv : p:float -> a:float -> float = "ml_gsl_cdf_laplace_Pinv" "gsl_cdf_laplace_Pinv" "float" external laplace_Qinv : q:float -> a:float -> float = "ml_gsl_cdf_laplace_Qinv" "gsl_cdf_laplace_Qinv" "float" external rayleigh_P : x:float -> sigma:float -> float = "ml_gsl_cdf_rayleigh_P" "gsl_cdf_rayleigh_P" "float" external rayleigh_Q : x:float -> sigma:float -> float = "ml_gsl_cdf_rayleigh_Q" "gsl_cdf_rayleigh_Q" "float" external rayleigh_Pinv : p:float -> sigma:float -> float = "ml_gsl_cdf_rayleigh_Pinv" "gsl_cdf_rayleigh_Pinv" "float" external rayleigh_Qinv : q:float -> sigma:float -> float = "ml_gsl_cdf_rayleigh_Qinv" "gsl_cdf_rayleigh_Qinv" "float" external chisq_P : x:float -> nu:float -> float = "ml_gsl_cdf_chisq_P" "gsl_cdf_chisq_P" "float" external chisq_Q : x:float -> nu:float -> float = "ml_gsl_cdf_chisq_Q" "gsl_cdf_chisq_Q" "float" external chisq_Pinv : p:float -> nu:float -> float = "ml_gsl_cdf_chisq_Pinv" "gsl_cdf_chisq_Pinv" "float" external chisq_Qinv : q:float -> nu:float -> float = "ml_gsl_cdf_chisq_Qinv" "gsl_cdf_chisq_Qinv" "float" external exponential_P : x:float -> mu:float -> float = "ml_gsl_cdf_exponential_P" "gsl_cdf_exponential_P" "float" external exponential_Q : x:float -> mu:float -> float = "ml_gsl_cdf_exponential_Q" "gsl_cdf_exponential_Q" "float" external exponential_Pinv : p:float -> mu:float -> float = "ml_gsl_cdf_exponential_Pinv" "gsl_cdf_exponential_Pinv" "float" external exponential_Qinv : q:float -> mu:float -> float = "ml_gsl_cdf_exponential_Qinv" "gsl_cdf_exponential_Qinv" "float" external exppow_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_exppow_P" "gsl_cdf_exppow_P" "float" external exppow_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_exppow_Q" "gsl_cdf_exppow_Q" "float" external tdist_P : x:float -> nu:float -> float = "ml_gsl_cdf_tdist_P" "gsl_cdf_tdist_P" "float" external tdist_Q : x:float -> nu:float -> float = "ml_gsl_cdf_tdist_Q" "gsl_cdf_tdist_Q" "float" external tdist_Pinv : p:float -> nu:float -> float = "ml_gsl_cdf_tdist_Pinv" "gsl_cdf_tdist_Pinv" "float" external tdist_Qinv : q:float -> nu:float -> float = "ml_gsl_cdf_tdist_Qinv" "gsl_cdf_tdist_Qinv" "float" external fdist_P : x:float -> nu1:float -> nu2:float -> float = "ml_gsl_cdf_fdist_P" "gsl_cdf_fdist_P" "float" external fdist_Q : x:float -> nu1:float -> nu2:float -> float = "ml_gsl_cdf_fdist_Q" "gsl_cdf_fdist_Q" "float" external fdist_Pinv : p:float -> nu1:float -> nu2:float -> float = "ml_gsl_cdf_fdist_Pinv" "gsl_cdf_fdist_Pinv" "float" external fdist_Qinv : q:float -> nu1:float -> nu2:float -> float = "ml_gsl_cdf_fdist_Qinv" "gsl_cdf_fdist_Qinv" "float" external beta_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_beta_P" "gsl_cdf_beta_P" "float" external beta_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_beta_Q" "gsl_cdf_beta_Q" "float" external beta_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_beta_Pinv" "gsl_cdf_beta_Pinv" "float" external beta_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_beta_Qinv" "gsl_cdf_beta_Qinv" "float" external flat_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_flat_P" "gsl_cdf_flat_P" "float" external flat_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_flat_Q" "gsl_cdf_flat_Q" "float" external flat_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_flat_Pinv" "gsl_cdf_flat_Pinv" "float" external flat_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_flat_Qinv" "gsl_cdf_flat_Qinv" "float" external lognormal_P : x:float -> zeta:float -> sigma:float -> float = "ml_gsl_cdf_lognormal_P" "gsl_cdf_lognormal_P" "float" external lognormal_Q : x:float -> zeta:float -> sigma:float -> float = "ml_gsl_cdf_lognormal_Q" "gsl_cdf_lognormal_Q" "float" external lognormal_Pinv : p:float -> zeta:float -> sigma:float -> float = "ml_gsl_cdf_lognormal_Pinv" "gsl_cdf_lognormal_Pinv" "float" external lognormal_Qinv : q:float -> zeta:float -> sigma:float -> float = "ml_gsl_cdf_lognormal_Qinv" "gsl_cdf_lognormal_Qinv" "float" external gumbel1_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel1_P" "gsl_cdf_gumbel1_P" "float" external gumbel1_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel1_Q" "gsl_cdf_gumbel1_Q" "float" external gumbel1_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel1_Pinv" "gsl_cdf_gumbel1_Pinv" "float" external gumbel1_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel1_Qinv" "gsl_cdf_gumbel1_Qinv" "float" external gumbel2_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel2_P" "gsl_cdf_gumbel2_P" "float" external gumbel2_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel2_Q" "gsl_cdf_gumbel2_Q" "float" external gumbel2_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel2_Pinv" "gsl_cdf_gumbel2_Pinv" "float" external gumbel2_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel2_Qinv" "gsl_cdf_gumbel2_Qinv" "float" external weibull_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_weibull_P" "gsl_cdf_weibull_P" "float" external weibull_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_weibull_Q" "gsl_cdf_weibull_Q" "float" external weibull_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_weibull_Pinv" "gsl_cdf_weibull_Pinv" "float" external weibull_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_weibull_Qinv" "gsl_cdf_weibull_Qinv" "float" external pareto_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_pareto_P" "gsl_cdf_pareto_P" "float" external pareto_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_pareto_Q" "gsl_cdf_pareto_Q" "float" external pareto_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_pareto_Pinv" "gsl_cdf_pareto_Pinv" "float" external pareto_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_pareto_Qinv" "gsl_cdf_pareto_Qinv" "float" external logistic_P : x:float -> a:float -> float = "ml_gsl_cdf_logistic_P" "gsl_cdf_logistic_P" "float" external logistic_Q : x:float -> a:float -> float = "ml_gsl_cdf_logistic_Q" "gsl_cdf_logistic_Q" "float" external logistic_Pinv : p:float -> a:float -> float = "ml_gsl_cdf_logistic_Pinv" "gsl_cdf_logistic_Pinv" "float" external logistic_Qinv : q:float -> a:float -> float = "ml_gsl_cdf_logistic_Qinv" "gsl_cdf_logistic_Qinv" "float" external binomial_P : k:int -> p:float -> n:int -> float = "ml_gsl_cdf_binomial_P" external binomial_Q : k:int -> p:float -> n:int -> float = "ml_gsl_cdf_binomial_Q" external poisson_P : k:int -> mu:float -> float = "ml_gsl_cdf_poisson_P" external poisson_Q : k:int -> mu:float -> float = "ml_gsl_cdf_poisson_Q" external geometric_P : k:int -> p:float -> float = "ml_gsl_cdf_geometric_P" external geometric_Q : k:int -> p:float -> float = "ml_gsl_cdf_geometric_Q" external negative_binomial_P : k:int -> p:float -> n:float -> float = "ml_gsl_cdf_negative_binomial_P" external negative_binomial_Q : k:int -> p:float -> n:float -> float = "ml_gsl_cdf_negative_binomial_Q" external pascal_P : k:int -> p:float -> n:int -> float = "ml_gsl_cdf_pascal_P" external pascal_Q : k:int -> p:float -> n:int -> float = "ml_gsl_cdf_pascal_Q" external hypergeometric_P : k:int -> n1:int -> n2:int -> t:int -> float = "ml_gsl_cdf_hypergeometric_P" external hypergeometric_Q : k:int -> n1:int -> n2:int -> t:int -> float = "ml_gsl_cdf_hypergeometric_Q" gsl-ocaml-1.19.1/lib/gsl_cdf.mli000066400000000000000000000222021262311274100163300ustar00rootroot00000000000000(** Cumulative distribution functions *) external ugaussian_P : x:float -> float = "ml_gsl_cdf_ugaussian_P" "gsl_cdf_ugaussian_P" "float" external ugaussian_Q : x:float -> float = "ml_gsl_cdf_ugaussian_Q" "gsl_cdf_ugaussian_Q" "float" external ugaussian_Pinv : p:float -> float = "ml_gsl_cdf_ugaussian_Pinv" "gsl_cdf_ugaussian_Pinv" "float" external ugaussian_Qinv : q:float -> float = "ml_gsl_cdf_ugaussian_Qinv" "gsl_cdf_ugaussian_Qinv" "float" external gaussian_P : x:float -> sigma:float -> float = "ml_gsl_cdf_gaussian_P" "gsl_cdf_gaussian_P" "float" external gaussian_Q : x:float -> sigma:float -> float = "ml_gsl_cdf_gaussian_Q" "gsl_cdf_gaussian_Q" "float" external gaussian_Pinv : p:float -> sigma:float -> float = "ml_gsl_cdf_gaussian_Pinv" "gsl_cdf_gaussian_Pinv" "float" external gaussian_Qinv : q:float -> sigma:float -> float = "ml_gsl_cdf_gaussian_Qinv" "gsl_cdf_gaussian_Qinv" "float" external gamma_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gamma_P" "gsl_cdf_gamma_P" "float" external gamma_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gamma_Q" "gsl_cdf_gamma_Q" "float" external gamma_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_gamma_Pinv" "gsl_cdf_gamma_Pinv" "float" external gamma_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_gamma_Qinv" "gsl_cdf_gamma_Qinv" "float" external cauchy_P : x:float -> a:float -> float = "ml_gsl_cdf_cauchy_P" "gsl_cdf_cauchy_P" "float" external cauchy_Q : x:float -> a:float -> float = "ml_gsl_cdf_cauchy_Q" "gsl_cdf_cauchy_Q" "float" external cauchy_Pinv : p:float -> a:float -> float = "ml_gsl_cdf_cauchy_Pinv" "gsl_cdf_cauchy_Pinv" "float" external cauchy_Qinv : q:float -> a:float -> float = "ml_gsl_cdf_cauchy_Qinv" "gsl_cdf_cauchy_Qinv" "float" external laplace_P : x:float -> a:float -> float = "ml_gsl_cdf_laplace_P" "gsl_cdf_laplace_P" "float" external laplace_Q : x:float -> a:float -> float = "ml_gsl_cdf_laplace_Q" "gsl_cdf_laplace_Q" "float" external laplace_Pinv : p:float -> a:float -> float = "ml_gsl_cdf_laplace_Pinv" "gsl_cdf_laplace_Pinv" "float" external laplace_Qinv : q:float -> a:float -> float = "ml_gsl_cdf_laplace_Qinv" "gsl_cdf_laplace_Qinv" "float" external rayleigh_P : x:float -> sigma:float -> float = "ml_gsl_cdf_rayleigh_P" "gsl_cdf_rayleigh_P" "float" external rayleigh_Q : x:float -> sigma:float -> float = "ml_gsl_cdf_rayleigh_Q" "gsl_cdf_rayleigh_Q" "float" external rayleigh_Pinv : p:float -> sigma:float -> float = "ml_gsl_cdf_rayleigh_Pinv" "gsl_cdf_rayleigh_Pinv" "float" external rayleigh_Qinv : q:float -> sigma:float -> float = "ml_gsl_cdf_rayleigh_Qinv" "gsl_cdf_rayleigh_Qinv" "float" external chisq_P : x:float -> nu:float -> float = "ml_gsl_cdf_chisq_P" "gsl_cdf_chisq_P" "float" external chisq_Q : x:float -> nu:float -> float = "ml_gsl_cdf_chisq_Q" "gsl_cdf_chisq_Q" "float" external chisq_Pinv : p:float -> nu:float -> float = "ml_gsl_cdf_chisq_Pinv" "gsl_cdf_chisq_Pinv" "float" external chisq_Qinv : q:float -> nu:float -> float = "ml_gsl_cdf_chisq_Qinv" "gsl_cdf_chisq_Qinv" "float" external exponential_P : x:float -> mu:float -> float = "ml_gsl_cdf_exponential_P" "gsl_cdf_exponential_P" "float" external exponential_Q : x:float -> mu:float -> float = "ml_gsl_cdf_exponential_Q" "gsl_cdf_exponential_Q" "float" external exponential_Pinv : p:float -> mu:float -> float = "ml_gsl_cdf_exponential_Pinv" "gsl_cdf_exponential_Pinv" "float" external exponential_Qinv : q:float -> mu:float -> float = "ml_gsl_cdf_exponential_Qinv" "gsl_cdf_exponential_Qinv" "float" external exppow_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_exppow_P" "gsl_cdf_exppow_P" "float" external exppow_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_exppow_Q" "gsl_cdf_exppow_Q" "float" external tdist_P : x:float -> nu:float -> float = "ml_gsl_cdf_tdist_P" "gsl_cdf_tdist_P" "float" external tdist_Q : x:float -> nu:float -> float = "ml_gsl_cdf_tdist_Q" "gsl_cdf_tdist_Q" "float" external tdist_Pinv : p:float -> nu:float -> float = "ml_gsl_cdf_tdist_Pinv" "gsl_cdf_tdist_Pinv" "float" external tdist_Qinv : q:float -> nu:float -> float = "ml_gsl_cdf_tdist_Qinv" "gsl_cdf_tdist_Qinv" "float" external fdist_P : x:float -> nu1:float -> nu2:float -> float = "ml_gsl_cdf_fdist_P" "gsl_cdf_fdist_P" "float" external fdist_Q : x:float -> nu1:float -> nu2:float -> float = "ml_gsl_cdf_fdist_Q" "gsl_cdf_fdist_Q" "float" external fdist_Pinv : p:float -> nu1:float -> nu2:float -> float = "ml_gsl_cdf_fdist_Pinv" "gsl_cdf_fdist_Pinv" "float" external fdist_Qinv : q:float -> nu1:float -> nu2:float -> float = "ml_gsl_cdf_fdist_Qinv" "gsl_cdf_fdist_Qinv" "float" external beta_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_beta_P" "gsl_cdf_beta_P" "float" external beta_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_beta_Q" "gsl_cdf_beta_Q" "float" external beta_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_beta_Pinv" "gsl_cdf_beta_Pinv" "float" external beta_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_beta_Qinv" "gsl_cdf_beta_Qinv" "float" external flat_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_flat_P" "gsl_cdf_flat_P" "float" external flat_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_flat_Q" "gsl_cdf_flat_Q" "float" external flat_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_flat_Pinv" "gsl_cdf_flat_Pinv" "float" external flat_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_flat_Qinv" "gsl_cdf_flat_Qinv" "float" external lognormal_P : x:float -> zeta:float -> sigma:float -> float = "ml_gsl_cdf_lognormal_P" "gsl_cdf_lognormal_P" "float" external lognormal_Q : x:float -> zeta:float -> sigma:float -> float = "ml_gsl_cdf_lognormal_Q" "gsl_cdf_lognormal_Q" "float" external lognormal_Pinv : p:float -> zeta:float -> sigma:float -> float = "ml_gsl_cdf_lognormal_Pinv" "gsl_cdf_lognormal_Pinv" "float" external lognormal_Qinv : q:float -> zeta:float -> sigma:float -> float = "ml_gsl_cdf_lognormal_Qinv" "gsl_cdf_lognormal_Qinv" "float" external gumbel1_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel1_P" "gsl_cdf_gumbel1_P" "float" external gumbel1_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel1_Q" "gsl_cdf_gumbel1_Q" "float" external gumbel1_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel1_Pinv" "gsl_cdf_gumbel1_Pinv" "float" external gumbel1_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel1_Qinv" "gsl_cdf_gumbel1_Qinv" "float" external gumbel2_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel2_P" "gsl_cdf_gumbel2_P" "float" external gumbel2_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel2_Q" "gsl_cdf_gumbel2_Q" "float" external gumbel2_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel2_Pinv" "gsl_cdf_gumbel2_Pinv" "float" external gumbel2_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_gumbel2_Qinv" "gsl_cdf_gumbel2_Qinv" "float" external weibull_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_weibull_P" "gsl_cdf_weibull_P" "float" external weibull_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_weibull_Q" "gsl_cdf_weibull_Q" "float" external weibull_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_weibull_Pinv" "gsl_cdf_weibull_Pinv" "float" external weibull_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_weibull_Qinv" "gsl_cdf_weibull_Qinv" "float" external pareto_P : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_pareto_P" "gsl_cdf_pareto_P" "float" external pareto_Q : x:float -> a:float -> b:float -> float = "ml_gsl_cdf_pareto_Q" "gsl_cdf_pareto_Q" "float" external pareto_Pinv : p:float -> a:float -> b:float -> float = "ml_gsl_cdf_pareto_Pinv" "gsl_cdf_pareto_Pinv" "float" external pareto_Qinv : q:float -> a:float -> b:float -> float = "ml_gsl_cdf_pareto_Qinv" "gsl_cdf_pareto_Qinv" "float" external logistic_P : x:float -> a:float -> float = "ml_gsl_cdf_logistic_P" "gsl_cdf_logistic_P" "float" external logistic_Q : x:float -> a:float -> float = "ml_gsl_cdf_logistic_Q" "gsl_cdf_logistic_Q" "float" external logistic_Pinv : p:float -> a:float -> float = "ml_gsl_cdf_logistic_Pinv" "gsl_cdf_logistic_Pinv" "float" external logistic_Qinv : q:float -> a:float -> float = "ml_gsl_cdf_logistic_Qinv" "gsl_cdf_logistic_Qinv" "float" external binomial_P : k:int -> p:float -> n:int -> float = "ml_gsl_cdf_binomial_P" external binomial_Q : k:int -> p:float -> n:int -> float = "ml_gsl_cdf_binomial_Q" external poisson_P : k:int -> mu:float -> float = "ml_gsl_cdf_poisson_P" external poisson_Q : k:int -> mu:float -> float = "ml_gsl_cdf_poisson_Q" external geometric_P : k:int -> p:float -> float = "ml_gsl_cdf_geometric_P" external geometric_Q : k:int -> p:float -> float = "ml_gsl_cdf_geometric_Q" external negative_binomial_P : k:int -> p:float -> n:float -> float = "ml_gsl_cdf_negative_binomial_P" external negative_binomial_Q : k:int -> p:float -> n:float -> float = "ml_gsl_cdf_negative_binomial_Q" external pascal_P : k:int -> p:float -> n:int -> float = "ml_gsl_cdf_pascal_P" external pascal_Q : k:int -> p:float -> n:int -> float = "ml_gsl_cdf_pascal_Q" external hypergeometric_P : k:int -> n1:int -> n2:int -> t:int -> float = "ml_gsl_cdf_hypergeometric_P" external hypergeometric_Q : k:int -> n1:int -> n2:int -> t:int -> float = "ml_gsl_cdf_hypergeometric_Q" gsl-ocaml-1.19.1/lib/gsl_cheb.ml000066400000000000000000000025221262311274100163270ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type t external _alloc : int -> t = "ml_gsl_cheb_alloc" external _free : t -> unit = "ml_gsl_cheb_free" let make n = let cs = _alloc n in Gc.finalise _free cs ; cs external order : t -> int = "ml_gsl_cheb_order" external coefs : t -> float array = "ml_gsl_cheb_coefs" external init : t -> Gsl_fun.gsl_fun -> a:float -> b:float -> unit = "ml_gsl_cheb_init" external _eval : t -> float -> float = "ml_gsl_cheb_eval" external _eval_err : t -> float -> Gsl_fun.result = "ml_gsl_cheb_eval_err" external _eval_n : t -> int -> float -> float = "ml_gsl_cheb_eval_n" external _eval_n_err : t -> int -> float -> Gsl_fun.result = "ml_gsl_cheb_eval_n_err" let eval cs ?order x = match order with | None -> _eval cs x | Some o -> _eval_n cs o x let eval_err cs ?order x = match order with | None -> _eval_err cs x | Some o -> _eval_n_err cs o x external calc_deriv : t -> t -> unit = "ml_gsl_cheb_calc_deriv" external calc_integ : t -> t -> unit = "ml_gsl_cheb_calc_integ" let deriv cs = let d = make (order cs) in calc_deriv d cs ; d let integ cs = let d = make (order cs) in calc_integ d cs ; d gsl-ocaml-1.19.1/lib/gsl_cheb.mli000066400000000000000000000011321262311274100164740ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Chebyshev Approximations *) type t val make : int -> t external order : t -> int = "ml_gsl_cheb_order" external coefs : t -> float array = "ml_gsl_cheb_coefs" external init : t -> Gsl_fun.gsl_fun -> a:float -> b:float -> unit = "ml_gsl_cheb_init" val eval : t -> ?order:int -> float -> float val eval_err : t -> ?order:int -> float -> Gsl_fun.result val deriv : t -> t val integ : t -> t gsl-ocaml-1.19.1/lib/gsl_combi.ml000066400000000000000000000012761262311274100165240ustar00rootroot00000000000000open Bigarray type t = { n : int; k : int; data : (int, int_elt, c_layout) Bigarray.Array1.t } external _init_first : t -> unit = "ml_gsl_combination_init_first" external _init_last : t -> unit = "ml_gsl_combination_init_last" let make n k = let c = { n; k; data = Array1.create int c_layout k } in begin _init_first c; c end let to_array { data; _ } = let len = Array1.dim data in Array.init len (Array1.get data) external prev : t -> unit = "ml_gsl_combination_prev" external next : t -> unit = "ml_gsl_combination_next" external _valid : t -> bool = "ml_gsl_combination_valid" let valid c = try _valid c with Gsl_error.Gsl_exn (Gsl_error.FAILURE, _) -> false gsl-ocaml-1.19.1/lib/gsl_combi.mli000066400000000000000000000006701262311274100166720ustar00rootroot00000000000000open Bigarray type t = private { n : int; k : int; data : (int, int_elt, c_layout) Bigarray.Array1.t } external _init_first : t -> unit = "ml_gsl_combination_init_first" external _init_last : t -> unit = "ml_gsl_combination_init_last" val make : int -> int -> t val to_array : t -> int array external prev : t -> unit = "ml_gsl_combination_prev" external next : t -> unit = "ml_gsl_combination_next" val valid : t -> bool gsl-ocaml-1.19.1/lib/gsl_complex.ml000066400000000000000000000111571262311274100171010ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012, 2003 - Olivier Andrieu, Paul Pelzl *) (* Distributed under the terms of the GPL version 3 *) type complex = Complex.t = { re : float ; im : float } let complex ~re ~im = { re = re ; im = im } type complex_array = float array let set a i c = a.(2*i) <- c.re ; a.(2*i + 1) <- c.im let get a i = { re = a.(2*i); im = a.(2*i+1) } let unpack ca = let len = Array.length ca in if len mod 2 <> 0 then invalid_arg "unpack_complex_array" ; Array.init (len / 2) (get ca) let pack a = let len = Array.length a in let ca = Array.make (2 * len) 0. in for i=0 to pred len do ca.(2*i) <- a.(i).re ; ca.(2*i+1) <- a.(i).im done ; ca let mult a b = if Array.length a mod 2 <> 0 then invalid_arg "mult: not a complex array" ; let len = (Array.length a) / 2 in for i = 0 to pred len do let re = a.(2*i) *. b.(2*i) -. a.(2*i+1) *. b.(2*i+1) in let im = a.(2*i) *. b.(2*i+1) +. a.(2*i+1) *. b.(2*i) in a.(2*i) <- re ; a.(2*i+1) <- im done (* added by Paul Pelzl, 2003/12/25 *) let rect x y = {re = x; im = y} let polar = Complex.polar let arg = Complex.arg let abs = Complex.norm let abs2 = Complex.norm2 external logabs : complex -> float = "ml_gsl_complex_logabs" let add = Complex.add let sub = Complex.sub let mul = Complex.mul let div = Complex.div let add_real a x = {re = a.re +. x; im = a.im} let sub_real a x = {re = a.re -. x; im = a.im} let mul_real a x = {re = a.re *. x; im = a.im *. x} let div_real a x = {re = a.re /. x; im = a.im /. x} let add_imag a y = {re = a.re; im = a.im +. y} let sub_imag a y = {re = a.re; im = a.im -. y} let mul_imag a y = {re = a.im *. (~-. y); im = a.re *. y} let div_imag a y = {re = a.im /. y; im = a.re /. (~-. y)} let conjugate = Complex.conj let inverse = Complex.inv let negative = Complex.neg (* elementary complex functions *) external sqrt : complex -> complex = "ml_gsl_complex_sqrt" external sqrt_real : float -> complex = "ml_gsl_complex_sqrt_real" external pow : complex -> complex -> complex = "ml_gsl_complex_pow" external pow_real : complex -> float -> complex = "ml_gsl_complex_pow_real" external exp : complex -> complex = "ml_gsl_complex_exp" external log : complex -> complex = "ml_gsl_complex_log" external log10 : complex -> complex = "ml_gsl_complex_log10" external log_b : complex -> complex -> complex = "ml_gsl_complex_log_b" (* complex trigonometric functions *) external sin : complex -> complex = "ml_gsl_complex_sin" external cos : complex -> complex = "ml_gsl_complex_cos" external tan : complex -> complex = "ml_gsl_complex_tan" external sec : complex -> complex = "ml_gsl_complex_sec" external csc : complex -> complex = "ml_gsl_complex_csc" external cot : complex -> complex = "ml_gsl_complex_cot" (* inverse complex trigonometric functions *) external arcsin : complex -> complex = "ml_gsl_complex_arcsin" external arcsin_real : float -> complex = "ml_gsl_complex_arcsin_real" external arccos : complex -> complex = "ml_gsl_complex_arccos" external arccos_real : float -> complex = "ml_gsl_complex_arccos_real" external arctan : complex -> complex = "ml_gsl_complex_arctan" external arcsec : complex -> complex = "ml_gsl_complex_arcsec" external arcsec_real : float -> complex = "ml_gsl_complex_arcsec_real" external arccsc : complex -> complex = "ml_gsl_complex_arccsc" external arccsc_real : float -> complex = "ml_gsl_complex_arccsc_real" external arccot : complex -> complex = "ml_gsl_complex_arccot" (* complex hyperbolic functions *) external sinh : complex -> complex = "ml_gsl_complex_sinh" external cosh : complex -> complex = "ml_gsl_complex_cosh" external tanh : complex -> complex = "ml_gsl_complex_tanh" external sech : complex -> complex = "ml_gsl_complex_sech" external csch : complex -> complex = "ml_gsl_complex_csch" external coth : complex -> complex = "ml_gsl_complex_coth" (* inverse complex hyperbolic functions *) external arcsinh : complex -> complex = "ml_gsl_complex_arcsinh" external arccosh : complex -> complex = "ml_gsl_complex_arccosh" external arccosh_real : float -> complex = "ml_gsl_complex_arccosh_real" external arctanh : complex -> complex = "ml_gsl_complex_arctanh" external arctanh_real : float -> complex = "ml_gsl_complex_arctanh_real" external arcsech : complex -> complex = "ml_gsl_complex_arcsech" external arccsch : complex -> complex = "ml_gsl_complex_arccsch" external arccoth : complex -> complex = "ml_gsl_complex_arccoth" gsl-ocaml-1.19.1/lib/gsl_complex.mli000066400000000000000000000104741262311274100172530ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012, 2003 - Olivier Andrieu, Paul Pelzl *) (* Distributed under the terms of the GPL version 3 *) (** Complex arithmetic and simple functions *) type complex = Complex.t = { re : float ; im : float } val complex : re:float -> im:float -> complex type complex_array = float array val set : complex_array -> int -> complex -> unit val get : complex_array -> int -> complex val unpack : complex_array -> complex array val pack : complex array -> complex_array val mult : complex_array -> complex_array -> unit (* added by Paul Pelzl 2003/12/25 *) val rect : float -> float -> complex val polar : float -> float -> complex (** {4 Properties of complex numbers} *) val arg : complex -> float val abs : complex -> float val abs2 : complex -> float external logabs : complex -> float = "ml_gsl_complex_logabs" (** {4 Complex arithmetic operators} *) val add : complex -> complex -> complex val sub : complex -> complex -> complex val mul : complex -> complex -> complex val div : complex -> complex -> complex val add_real : complex -> float -> complex val sub_real : complex -> float -> complex val mul_real : complex -> float -> complex val div_real : complex -> float -> complex val add_imag : complex -> float -> complex val sub_imag : complex -> float -> complex val mul_imag : complex -> float -> complex val div_imag : complex -> float -> complex val conjugate : complex -> complex val inverse : complex -> complex val negative : complex -> complex (** {4 Elementary complex functions} *) external sqrt : complex -> complex = "ml_gsl_complex_sqrt" external sqrt_real : float -> complex = "ml_gsl_complex_sqrt_real" external pow : complex -> complex -> complex = "ml_gsl_complex_pow" external pow_real : complex -> float -> complex = "ml_gsl_complex_pow_real" external exp : complex -> complex = "ml_gsl_complex_exp" external log : complex -> complex = "ml_gsl_complex_log" external log10 : complex -> complex = "ml_gsl_complex_log10" external log_b : complex -> complex -> complex = "ml_gsl_complex_log_b" (** {4 Complex trigonometric functions} *) external sin : complex -> complex = "ml_gsl_complex_sin" external cos : complex -> complex = "ml_gsl_complex_cos" external tan : complex -> complex = "ml_gsl_complex_tan" external sec : complex -> complex = "ml_gsl_complex_sec" external csc : complex -> complex = "ml_gsl_complex_csc" external cot : complex -> complex = "ml_gsl_complex_cot" (** {4 Inverse complex trigonometric functions} *) external arcsin : complex -> complex = "ml_gsl_complex_arcsin" external arcsin_real : float -> complex = "ml_gsl_complex_arcsin_real" external arccos : complex -> complex = "ml_gsl_complex_arccos" external arccos_real : float -> complex = "ml_gsl_complex_arccos_real" external arctan : complex -> complex = "ml_gsl_complex_arctan" external arcsec : complex -> complex = "ml_gsl_complex_arcsec" external arcsec_real : float -> complex = "ml_gsl_complex_arcsec_real" external arccsc : complex -> complex = "ml_gsl_complex_arccsc" external arccsc_real : float -> complex = "ml_gsl_complex_arccsc_real" external arccot : complex -> complex = "ml_gsl_complex_arccot" (** {4 Complex hyperbolic functions} *) external sinh : complex -> complex = "ml_gsl_complex_sinh" external cosh : complex -> complex = "ml_gsl_complex_cosh" external tanh : complex -> complex = "ml_gsl_complex_tanh" external sech : complex -> complex = "ml_gsl_complex_sech" external csch : complex -> complex = "ml_gsl_complex_csch" external coth : complex -> complex = "ml_gsl_complex_coth" (** {4 Inverse complex hyperbolic functions} *) external arcsinh : complex -> complex = "ml_gsl_complex_arcsinh" external arccosh : complex -> complex = "ml_gsl_complex_arccosh" external arccosh_real : float -> complex = "ml_gsl_complex_arccosh_real" external arctanh : complex -> complex = "ml_gsl_complex_arctanh" external arctanh_real : float -> complex = "ml_gsl_complex_arctanh_real" external arcsech : complex -> complex = "ml_gsl_complex_arcsech" external arccsch : complex -> complex = "ml_gsl_complex_arccsch" external arccoth : complex -> complex = "ml_gsl_complex_arccoth" gsl-ocaml-1.19.1/lib/gsl_const.ml000066400000000000000000000266301262311274100165620ustar00rootroot00000000000000(** Values of physical constants *) module CGS = struct let speed_of_light = 2.99792458e10 let gravitational_constant = 6.673e-8 let plancks_constant_h = 6.62606896e-27 let plancks_constant_hbar = 1.05457162825e-27 let astronomical_unit = 1.49597870691e13 let light_year = 9.46053620707e17 let parsec = 3.08567758135e18 let grav_accel = 9.80665e2 let electron_volt = 1.602176487e-12 let mass_electron = 9.10938188e-28 let mass_muon = 1.88353109e-25 let mass_proton = 1.67262158e-24 let mass_neutron = 1.67492716e-24 let rydberg = 2.17987196968e-11 let boltzmann = 1.3806504e-16 let molar_gas = 8.314472e7 let standard_gas_volume = 2.2710981e4 let minute = 6e1 let hour = 3.6e3 let day = 8.64e4 let week = 6.048e5 let inch = 2.54e0 let foot = 3.048e1 let yard = 9.144e1 let mile = 1.609344e5 let nautical_mile = 1.852e5 let fathom = 1.8288e2 let mil = 2.54e-3 let point = 3.52777777778e-2 let texpoint = 3.51459803515e-2 let micron = 1e-4 let angstrom = 1e-8 let hectare = 1e8 let acre = 4.04685642241e7 let barn = 1e-24 let liter = 1e3 let us_gallon = 3.78541178402e3 let quart = 9.46352946004e2 let pint = 4.73176473002e2 let cup = 2.36588236501e2 let fluid_ounce = 2.95735295626e1 let tablespoon = 1.47867647813e1 let teaspoon = 4.92892159375e0 let canadian_gallon = 4.54609e3 let uk_gallon = 4.546092e3 let miles_per_hour = 4.4704e1 let kilometers_per_hour = 2.77777777778e1 let knot = 5.14444444444e1 let pound_mass = 4.5359237e2 let ounce_mass = 2.8349523125e1 let ton = 9.0718474e5 let metric_ton = 1e6 let uk_ton = 1.0160469088e6 let troy_ounce = 3.1103475e1 let carat = 2e-1 let unified_atomic_mass = 1.660538782e-24 let gram_force = 9.80665e2 let pound_force = 4.44822161526e5 let kilopound_force = 4.44822161526e8 let poundal = 1.38255e4 let calorie = 4.1868e7 let btu = 1.05505585262e10 let therm = 1.05506e15 let horsepower = 7.457e9 let bar = 1e6 let std_atmosphere = 1.01325e6 let torr = 1.33322368421e3 let meter_of_mercury = 1.33322368421e6 let inch_of_mercury = 3.38638815789e4 let inch_of_water = 2.490889e3 let psi = 6.89475729317e4 let poise = 1e0 let stokes = 1e0 let stilb = 1e0 let lumen = 1e0 let lux = 1e-4 let phot = 1e0 let footcandle = 1.076e-3 let lambert = 1e0 let footlambert = 1.07639104e-3 let curie = 3.7e10 let roentgen = 2.58e-7 let rad = 1e2 let solar_mass = 1.98892e33 let bohr_radius = 5.291772083e-9 let newton = 1e5 let dyne = 1e0 let joule = 1e7 let erg = 1e0 let stefan_boltzmann_constant = 5.67040047374e-5 let thomson_cross_section = 6.65245893699e-25 end module CGSM = struct let speed_of_light = 2.99792458e10 let gravitational_constant = 6.673e-8 let plancks_constant_h = 6.62606896e-27 let plancks_constant_hbar = 1.05457162825e-27 let astronomical_unit = 1.49597870691e13 let light_year = 9.46053620707e17 let parsec = 3.08567758135e18 let grav_accel = 9.80665e2 let electron_volt = 1.602176487e-12 let mass_electron = 9.10938188e-28 let mass_muon = 1.88353109e-25 let mass_proton = 1.67262158e-24 let mass_neutron = 1.67492716e-24 let rydberg = 2.17987196968e-11 let boltzmann = 1.3806504e-16 let molar_gas = 8.314472e7 let standard_gas_volume = 2.2710981e4 let minute = 6e1 let hour = 3.6e3 let day = 8.64e4 let week = 6.048e5 let inch = 2.54e0 let foot = 3.048e1 let yard = 9.144e1 let mile = 1.609344e5 let nautical_mile = 1.852e5 let fathom = 1.8288e2 let mil = 2.54e-3 let point = 3.52777777778e-2 let texpoint = 3.51459803515e-2 let micron = 1e-4 let angstrom = 1e-8 let hectare = 1e8 let acre = 4.04685642241e7 let barn = 1e-24 let liter = 1e3 let us_gallon = 3.78541178402e3 let quart = 9.46352946004e2 let pint = 4.73176473002e2 let cup = 2.36588236501e2 let fluid_ounce = 2.95735295626e1 let tablespoon = 1.47867647813e1 let teaspoon = 4.92892159375e0 let canadian_gallon = 4.54609e3 let uk_gallon = 4.546092e3 let miles_per_hour = 4.4704e1 let kilometers_per_hour = 2.77777777778e1 let knot = 5.14444444444e1 let pound_mass = 4.5359237e2 let ounce_mass = 2.8349523125e1 let ton = 9.0718474e5 let metric_ton = 1e6 let uk_ton = 1.0160469088e6 let troy_ounce = 3.1103475e1 let carat = 2e-1 let unified_atomic_mass = 1.660538782e-24 let gram_force = 9.80665e2 let pound_force = 4.44822161526e5 let kilopound_force = 4.44822161526e8 let poundal = 1.38255e4 let calorie = 4.1868e7 let btu = 1.05505585262e10 let therm = 1.05506e15 let horsepower = 7.457e9 let bar = 1e6 let std_atmosphere = 1.01325e6 let torr = 1.33322368421e3 let meter_of_mercury = 1.33322368421e6 let inch_of_mercury = 3.38638815789e4 let inch_of_water = 2.490889e3 let psi = 6.89475729317e4 let poise = 1e0 let stokes = 1e0 let stilb = 1e0 let lumen = 1e0 let lux = 1e-4 let phot = 1e0 let footcandle = 1.076e-3 let lambert = 1e0 let footlambert = 1.07639104e-3 let curie = 3.7e10 let roentgen = 2.58e-8 let rad = 1e2 let solar_mass = 1.98892e33 let bohr_radius = 5.291772083e-9 let newton = 1e5 let dyne = 1e0 let joule = 1e7 let erg = 1e0 let stefan_boltzmann_constant = 5.67040047374e-5 let thomson_cross_section = 6.65245893699e-25 let bohr_magneton = 9.27400899e-21 let nuclear_magneton = 5.05078317e-24 let electron_magnetic_moment = 9.28476362e-21 let proton_magnetic_moment = 1.410606633e-23 let faraday = 9.64853429775e3 let electron_charge = 1.602176487e-20 end module MKS = struct let speed_of_light = 2.99792458e8 let gravitational_constant = 6.673e-11 let plancks_constant_h = 6.62606896e-34 let plancks_constant_hbar = 1.05457162825e-34 let astronomical_unit = 1.49597870691e11 let light_year = 9.46053620707e15 let parsec = 3.08567758135e16 let grav_accel = 9.80665e0 let electron_volt = 1.602176487e-19 let mass_electron = 9.10938188e-31 let mass_muon = 1.88353109e-28 let mass_proton = 1.67262158e-27 let mass_neutron = 1.67492716e-27 let rydberg = 2.17987196968e-18 let boltzmann = 1.3806504e-23 let molar_gas = 8.314472e0 let standard_gas_volume = 2.2710981e-2 let minute = 6e1 let hour = 3.6e3 let day = 8.64e4 let week = 6.048e5 let inch = 2.54e-2 let foot = 3.048e-1 let yard = 9.144e-1 let mile = 1.609344e3 let nautical_mile = 1.852e3 let fathom = 1.8288e0 let mil = 2.54e-5 let point = 3.52777777778e-4 let texpoint = 3.51459803515e-4 let micron = 1e-6 let angstrom = 1e-10 let hectare = 1e4 let acre = 4.04685642241e3 let barn = 1e-28 let liter = 1e-3 let us_gallon = 3.78541178402e-3 let quart = 9.46352946004e-4 let pint = 4.73176473002e-4 let cup = 2.36588236501e-4 let fluid_ounce = 2.95735295626e-5 let tablespoon = 1.47867647813e-5 let teaspoon = 4.92892159375e-6 let canadian_gallon = 4.54609e-3 let uk_gallon = 4.546092e-3 let miles_per_hour = 4.4704e-1 let kilometers_per_hour = 2.77777777778e-1 let knot = 5.14444444444e-1 let pound_mass = 4.5359237e-1 let ounce_mass = 2.8349523125e-2 let ton = 9.0718474e2 let metric_ton = 1e3 let uk_ton = 1.0160469088e3 let troy_ounce = 3.1103475e-2 let carat = 2e-4 let unified_atomic_mass = 1.660538782e-27 let gram_force = 9.80665e-3 let pound_force = 4.44822161526e0 let kilopound_force = 4.44822161526e3 let poundal = 1.38255e-1 let calorie = 4.1868e0 let btu = 1.05505585262e3 let therm = 1.05506e8 let horsepower = 7.457e2 let bar = 1e5 let std_atmosphere = 1.01325e5 let torr = 1.33322368421e2 let meter_of_mercury = 1.33322368421e5 let inch_of_mercury = 3.38638815789e3 let inch_of_water = 2.490889e2 let psi = 6.89475729317e3 let poise = 1e-1 let stokes = 1e-4 let stilb = 1e4 let lumen = 1e0 let lux = 1e0 let phot = 1e4 let footcandle = 1.076e1 let lambert = 1e4 let footlambert = 1.07639104e1 let curie = 3.7e10 let roentgen = 2.58e-4 let rad = 1e-2 let solar_mass = 1.98892e30 let bohr_radius = 5.291772083e-11 let newton = 1e0 let dyne = 1e-5 let joule = 1e0 let erg = 1e-7 let stefan_boltzmann_constant = 5.67040047374e-8 let thomson_cross_section = 6.65245893699e-29 let bohr_magneton = 9.27400899e-24 let nuclear_magneton = 5.05078317e-27 let electron_magnetic_moment = 9.28476362e-24 let proton_magnetic_moment = 1.410606633e-26 let faraday = 9.64853429775e4 let electron_charge = 1.602176487e-19 let vacuum_permittivity = 8.854187817e-12 let vacuum_permeability = 1.25663706144e-6 let debye = 3.33564095198e-30 let gauss = 1e-4 end module MKSA = struct let speed_of_light = 2.99792458e8 let gravitational_constant = 6.673e-11 let plancks_constant_h = 6.62606896e-34 let plancks_constant_hbar = 1.05457162825e-34 let astronomical_unit = 1.49597870691e11 let light_year = 9.46053620707e15 let parsec = 3.08567758135e16 let grav_accel = 9.80665e0 let electron_volt = 1.602176487e-19 let mass_electron = 9.10938188e-31 let mass_muon = 1.88353109e-28 let mass_proton = 1.67262158e-27 let mass_neutron = 1.67492716e-27 let rydberg = 2.17987196968e-18 let boltzmann = 1.3806504e-23 let molar_gas = 8.314472e0 let standard_gas_volume = 2.2710981e-2 let minute = 6e1 let hour = 3.6e3 let day = 8.64e4 let week = 6.048e5 let inch = 2.54e-2 let foot = 3.048e-1 let yard = 9.144e-1 let mile = 1.609344e3 let nautical_mile = 1.852e3 let fathom = 1.8288e0 let mil = 2.54e-5 let point = 3.52777777778e-4 let texpoint = 3.51459803515e-4 let micron = 1e-6 let angstrom = 1e-10 let hectare = 1e4 let acre = 4.04685642241e3 let barn = 1e-28 let liter = 1e-3 let us_gallon = 3.78541178402e-3 let quart = 9.46352946004e-4 let pint = 4.73176473002e-4 let cup = 2.36588236501e-4 let fluid_ounce = 2.95735295626e-5 let tablespoon = 1.47867647813e-5 let teaspoon = 4.92892159375e-6 let canadian_gallon = 4.54609e-3 let uk_gallon = 4.546092e-3 let miles_per_hour = 4.4704e-1 let kilometers_per_hour = 2.77777777778e-1 let knot = 5.14444444444e-1 let pound_mass = 4.5359237e-1 let ounce_mass = 2.8349523125e-2 let ton = 9.0718474e2 let metric_ton = 1e3 let uk_ton = 1.0160469088e3 let troy_ounce = 3.1103475e-2 let carat = 2e-4 let unified_atomic_mass = 1.660538782e-27 let gram_force = 9.80665e-3 let pound_force = 4.44822161526e0 let kilopound_force = 4.44822161526e3 let poundal = 1.38255e-1 let calorie = 4.1868e0 let btu = 1.05505585262e3 let therm = 1.05506e8 let horsepower = 7.457e2 let bar = 1e5 let std_atmosphere = 1.01325e5 let torr = 1.33322368421e2 let meter_of_mercury = 1.33322368421e5 let inch_of_mercury = 3.38638815789e3 let inch_of_water = 2.490889e2 let psi = 6.89475729317e3 let poise = 1e-1 let stokes = 1e-4 let stilb = 1e4 let lumen = 1e0 let lux = 1e0 let phot = 1e4 let footcandle = 1.076e1 let lambert = 1e4 let footlambert = 1.07639104e1 let curie = 3.7e10 let roentgen = 2.58e-4 let rad = 1e-2 let solar_mass = 1.98892e30 let bohr_radius = 5.291772083e-11 let newton = 1e0 let dyne = 1e-5 let joule = 1e0 let erg = 1e-7 let stefan_boltzmann_constant = 5.67040047374e-8 let thomson_cross_section = 6.65245893699e-29 let bohr_magneton = 9.27400899e-24 let nuclear_magneton = 5.05078317e-27 let electron_magnetic_moment = 9.28476362e-24 let proton_magnetic_moment = 1.410606633e-26 let faraday = 9.64853429775e4 let electron_charge = 1.602176487e-19 let vacuum_permittivity = 8.854187817e-12 let vacuum_permeability = 1.25663706144e-6 let debye = 3.33564095198e-30 let gauss = 1e-4 end module NUM = struct let fine_structure = 7.297352533e-3 let avogadro = 6.02214199e23 let yotta = 1e24 let zetta = 1e21 let exa = 1e18 let peta = 1e15 let tera = 1e12 let giga = 1e9 let mega = 1e6 let kilo = 1e3 let milli = 1e-3 let micro = 1e-6 let nano = 1e-9 let pico = 1e-12 let femto = 1e-15 let atto = 1e-18 let zepto = 1e-21 let yocto = 1e-24 end gsl-ocaml-1.19.1/lib/gsl_const.mli000066400000000000000000000233271262311274100167330ustar00rootroot00000000000000(** Values of physical constants *) module CGS : sig val speed_of_light : float val gravitational_constant : float val plancks_constant_h : float val plancks_constant_hbar : float val astronomical_unit : float val light_year : float val parsec : float val grav_accel : float val electron_volt : float val mass_electron : float val mass_muon : float val mass_proton : float val mass_neutron : float val rydberg : float val boltzmann : float val molar_gas : float val standard_gas_volume : float val minute : float val hour : float val day : float val week : float val inch : float val foot : float val yard : float val mile : float val nautical_mile : float val fathom : float val mil : float val point : float val texpoint : float val micron : float val angstrom : float val hectare : float val acre : float val barn : float val liter : float val us_gallon : float val quart : float val pint : float val cup : float val fluid_ounce : float val tablespoon : float val teaspoon : float val canadian_gallon : float val uk_gallon : float val miles_per_hour : float val kilometers_per_hour : float val knot : float val pound_mass : float val ounce_mass : float val ton : float val metric_ton : float val uk_ton : float val troy_ounce : float val carat : float val unified_atomic_mass : float val gram_force : float val pound_force : float val kilopound_force : float val poundal : float val calorie : float val btu : float val therm : float val horsepower : float val bar : float val std_atmosphere : float val torr : float val meter_of_mercury : float val inch_of_mercury : float val inch_of_water : float val psi : float val poise : float val stokes : float val stilb : float val lumen : float val lux : float val phot : float val footcandle : float val lambert : float val footlambert : float val curie : float val roentgen : float val rad : float val solar_mass : float val bohr_radius : float val newton : float val dyne : float val joule : float val erg : float val stefan_boltzmann_constant : float val thomson_cross_section : float end module CGSM : sig val speed_of_light : float val gravitational_constant : float val plancks_constant_h : float val plancks_constant_hbar : float val astronomical_unit : float val light_year : float val parsec : float val grav_accel : float val electron_volt : float val mass_electron : float val mass_muon : float val mass_proton : float val mass_neutron : float val rydberg : float val boltzmann : float val molar_gas : float val standard_gas_volume : float val minute : float val hour : float val day : float val week : float val inch : float val foot : float val yard : float val mile : float val nautical_mile : float val fathom : float val mil : float val point : float val texpoint : float val micron : float val angstrom : float val hectare : float val acre : float val barn : float val liter : float val us_gallon : float val quart : float val pint : float val cup : float val fluid_ounce : float val tablespoon : float val teaspoon : float val canadian_gallon : float val uk_gallon : float val miles_per_hour : float val kilometers_per_hour : float val knot : float val pound_mass : float val ounce_mass : float val ton : float val metric_ton : float val uk_ton : float val troy_ounce : float val carat : float val unified_atomic_mass : float val gram_force : float val pound_force : float val kilopound_force : float val poundal : float val calorie : float val btu : float val therm : float val horsepower : float val bar : float val std_atmosphere : float val torr : float val meter_of_mercury : float val inch_of_mercury : float val inch_of_water : float val psi : float val poise : float val stokes : float val stilb : float val lumen : float val lux : float val phot : float val footcandle : float val lambert : float val footlambert : float val curie : float val roentgen : float val rad : float val solar_mass : float val bohr_radius : float val newton : float val dyne : float val joule : float val erg : float val stefan_boltzmann_constant : float val thomson_cross_section : float val bohr_magneton : float val nuclear_magneton : float val electron_magnetic_moment : float val proton_magnetic_moment : float val faraday : float val electron_charge : float end module MKS : sig val speed_of_light : float val gravitational_constant : float val plancks_constant_h : float val plancks_constant_hbar : float val astronomical_unit : float val light_year : float val parsec : float val grav_accel : float val electron_volt : float val mass_electron : float val mass_muon : float val mass_proton : float val mass_neutron : float val rydberg : float val boltzmann : float val molar_gas : float val standard_gas_volume : float val minute : float val hour : float val day : float val week : float val inch : float val foot : float val yard : float val mile : float val nautical_mile : float val fathom : float val mil : float val point : float val texpoint : float val micron : float val angstrom : float val hectare : float val acre : float val barn : float val liter : float val us_gallon : float val quart : float val pint : float val cup : float val fluid_ounce : float val tablespoon : float val teaspoon : float val canadian_gallon : float val uk_gallon : float val miles_per_hour : float val kilometers_per_hour : float val knot : float val pound_mass : float val ounce_mass : float val ton : float val metric_ton : float val uk_ton : float val troy_ounce : float val carat : float val unified_atomic_mass : float val gram_force : float val pound_force : float val kilopound_force : float val poundal : float val calorie : float val btu : float val therm : float val horsepower : float val bar : float val std_atmosphere : float val torr : float val meter_of_mercury : float val inch_of_mercury : float val inch_of_water : float val psi : float val poise : float val stokes : float val stilb : float val lumen : float val lux : float val phot : float val footcandle : float val lambert : float val footlambert : float val curie : float val roentgen : float val rad : float val solar_mass : float val bohr_radius : float val newton : float val dyne : float val joule : float val erg : float val stefan_boltzmann_constant : float val thomson_cross_section : float val bohr_magneton : float val nuclear_magneton : float val electron_magnetic_moment : float val proton_magnetic_moment : float val faraday : float val electron_charge : float val vacuum_permittivity : float val vacuum_permeability : float val debye : float val gauss : float end module MKSA : sig val speed_of_light : float val gravitational_constant : float val plancks_constant_h : float val plancks_constant_hbar : float val astronomical_unit : float val light_year : float val parsec : float val grav_accel : float val electron_volt : float val mass_electron : float val mass_muon : float val mass_proton : float val mass_neutron : float val rydberg : float val boltzmann : float val molar_gas : float val standard_gas_volume : float val minute : float val hour : float val day : float val week : float val inch : float val foot : float val yard : float val mile : float val nautical_mile : float val fathom : float val mil : float val point : float val texpoint : float val micron : float val angstrom : float val hectare : float val acre : float val barn : float val liter : float val us_gallon : float val quart : float val pint : float val cup : float val fluid_ounce : float val tablespoon : float val teaspoon : float val canadian_gallon : float val uk_gallon : float val miles_per_hour : float val kilometers_per_hour : float val knot : float val pound_mass : float val ounce_mass : float val ton : float val metric_ton : float val uk_ton : float val troy_ounce : float val carat : float val unified_atomic_mass : float val gram_force : float val pound_force : float val kilopound_force : float val poundal : float val calorie : float val btu : float val therm : float val horsepower : float val bar : float val std_atmosphere : float val torr : float val meter_of_mercury : float val inch_of_mercury : float val inch_of_water : float val psi : float val poise : float val stokes : float val stilb : float val lumen : float val lux : float val phot : float val footcandle : float val lambert : float val footlambert : float val curie : float val roentgen : float val rad : float val solar_mass : float val bohr_radius : float val newton : float val dyne : float val joule : float val erg : float val stefan_boltzmann_constant : float val thomson_cross_section : float val bohr_magneton : float val nuclear_magneton : float val electron_magnetic_moment : float val proton_magnetic_moment : float val faraday : float val electron_charge : float val vacuum_permittivity : float val vacuum_permeability : float val debye : float val gauss : float end module NUM : sig val fine_structure : float val avogadro : float val yotta : float val zetta : float val exa : float val peta : float val tera : float val giga : float val mega : float val kilo : float val milli : float val micro : float val nano : float val pico : float val femto : float val atto : float val zepto : float val yocto : float end gsl-ocaml-1.19.1/lib/gsl_deriv.ml000066400000000000000000000010361262311274100165360ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (* C code in mlgsl_deriv.c *) external central : f:(float -> float) -> x:float -> h:float -> Gsl_fun.result = "ml_gsl_deriv_central" external forward : f:(float -> float) -> x:float -> h:float -> Gsl_fun.result = "ml_gsl_deriv_forward" external backward : f:(float -> float) -> x:float -> h:float -> Gsl_fun.result = "ml_gsl_deriv_backward" gsl-ocaml-1.19.1/lib/gsl_deriv.mli000066400000000000000000000034551262311274100167160ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Numerical Differentiation *) external central : f:(float -> float) -> x:float -> h:float -> Gsl_fun.result = "ml_gsl_deriv_central" (** [central f x h] computes the numerical derivative of the function [f] at the point [x] using an adaptive central difference algorithm with a step-size of [h]. The function returns a value [r] with the derivative being in [r.res] and an estimate of its absolute error in [r.err]. *) external forward : f:(float -> float) -> x:float -> h:float -> Gsl_fun.result = "ml_gsl_deriv_forward" (** [forward f x h] computes the numerical derivative of the function [f] at the point [x] using an adaptive forward difference algorithm with a step-size of [h]. The function is evaluated only at points greater than [x], and never at [x] itself. The function returns [r] with the derivative in [r.res] and an estimate of its absolute in [r.err]. This function should be used if f(x) has a discontinuity at [x], or is undefined for values less than [x]. *) external backward : f:(float -> float) -> x:float -> h:float -> Gsl_fun.result = "ml_gsl_deriv_backward" (** [forward f x h] computes the numerical derivative of the function [f] at the point [x] using an adaptive backward difference algorithm with a step-size of [h]. The function is evaluated only at points less than [x], and never at [x] itself. The function returns a value [r] with the derivative in [r.res] and an estimate of its absolute error in [r.err]. This function should be used if f(x) has a discontinuity at [x], or is undefined for values greater than [x]. *) gsl-ocaml-1.19.1/lib/gsl_eigen.ml000066400000000000000000000114121262311274100165130ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_vectmat type symm_ws external _symm_alloc : int -> symm_ws = "ml_gsl_eigen_symm_alloc" external _symm_free : symm_ws -> unit = "ml_gsl_eigen_symm_free" let make_symm_ws s = let ws = _symm_alloc s in Gc.finalise _symm_free ws ; ws external _symm : mat -> vec -> symm_ws -> unit = "ml_gsl_eigen_symm" let symm ?protect a = let a' = Gsl_vectmat.mat_convert ?protect a in let (n, _) = Gsl_vectmat.dims a' in let v = Gsl_vector.create n in let ws = _symm_alloc n in begin try _symm a' (`V v) ws with exn -> _symm_free ws ; raise exn end ; _symm_free ws ; v type symmv_ws external _symmv_alloc_v : int -> symmv_ws = "ml_gsl_eigen_symmv_alloc" external _symmv_free_v : symmv_ws -> unit = "ml_gsl_eigen_symmv_free" let make_symmv_ws s = let ws = _symmv_alloc_v s in Gc.finalise _symmv_free_v ws ; ws external _symmv : mat -> vec -> mat -> symmv_ws -> unit = "ml_gsl_eigen_symmv" let symmv ?protect a = let a' = Gsl_vectmat.mat_convert ?protect a in let (n, _) = Gsl_vectmat.dims a' in let v = Gsl_vector.create n in let evec = Gsl_matrix.create n n in let ws = _symmv_alloc_v n in begin try _symmv a' (`V v) (`M evec) ws with exn -> _symmv_free_v ws ; raise exn end ; _symmv_free_v ws ; (v, evec) type sort = | VAL_ASC | VAL_DESC | ABS_ASC | ABS_DESC external symmv_sort : Gsl_vector.vector * Gsl_matrix.matrix -> sort -> unit = "ml_gsl_eigen_symmv_sort" (* Complex Hermitian Matrices *) type herm_ws external _herm_alloc : int -> herm_ws = "ml_gsl_eigen_herm_alloc" external _herm_free : herm_ws -> unit = "ml_gsl_eigen_herm_free" let make_herm_ws s = let ws = _herm_alloc s in Gc.finalise _herm_free ws ; ws external _herm : cmat -> vec -> herm_ws -> unit = "ml_gsl_eigen_herm" let herm ?protect a = let a' = Gsl_vectmat.cmat_convert ?protect a in let (n, _) = Gsl_vectmat.dims a' in let v = Gsl_vector.create n in let ws = _herm_alloc n in begin try _herm a' (`V v) ws with exn -> _herm_free ws ; raise exn end ; _herm_free ws ; v type hermv_ws external _hermv_alloc_v : int -> hermv_ws = "ml_gsl_eigen_hermv_alloc" external _hermv_free_v : hermv_ws -> unit = "ml_gsl_eigen_hermv_free" let make_hermv_ws s = let ws = _hermv_alloc_v s in Gc.finalise _hermv_free_v ws ; ws external _hermv : cmat -> vec -> cmat -> hermv_ws -> unit = "ml_gsl_eigen_hermv" let hermv ?protect a = let a' = Gsl_vectmat.cmat_convert ?protect a in let (n, _) = Gsl_vectmat.dims a' in let v = Gsl_vector.create n in let evec = Gsl_matrix_complex.create n n in let ws = _hermv_alloc_v n in begin try _hermv a' (`V v) (`CM evec) ws with exn -> _hermv_free_v ws ; raise exn end ; _hermv_free_v ws ; (v, evec) external hermv_sort : Gsl_vector.vector * Gsl_matrix_complex.matrix -> sort -> unit = "ml_gsl_eigen_hermv_sort" (** Real Nonsymmetric Matrices *) type nonsymm_ws external _nonsymm_alloc : int -> nonsymm_ws = "ml_gsl_eigen_nonsymm_alloc" external _nonsymm_free : nonsymm_ws -> unit = "ml_gsl_eigen_nonsymm_free" let make_nonsymm_ws s = let ws = _nonsymm_alloc s in Gc.finalise _nonsymm_free ws ; ws external _nonsymm : mat -> cvec -> nonsymm_ws -> unit = "ml_gsl_eigen_nonsymm" external _nonsymm_Z : mat -> cvec -> mat -> nonsymm_ws -> unit = "ml_gsl_eigen_nonsymm_Z" let nonsymm ?protect a = let a' = Gsl_vectmat.mat_convert ?protect a in let (n, _) = Gsl_vectmat.dims a' in let v = Gsl_vector_complex.create n in let ws = _nonsymm_alloc n in begin try _nonsymm a' (`CV v) ws with exn -> _nonsymm_free ws ; raise exn end ; _nonsymm_free ws ; v type nonsymmv_ws external _nonsymmv_alloc_v : int -> nonsymmv_ws = "ml_gsl_eigen_nonsymmv_alloc" external _nonsymmv_free_v : nonsymmv_ws -> unit = "ml_gsl_eigen_nonsymmv_free" let make_nonsymmv_ws s = let ws = _nonsymmv_alloc_v s in Gc.finalise _nonsymmv_free_v ws ; ws external _nonsymmv : mat -> cvec -> cmat -> nonsymmv_ws -> unit = "ml_gsl_eigen_nonsymmv" external _nonsymmv_Z : mat -> cvec -> cmat -> mat -> nonsymmv_ws -> unit = "ml_gsl_eigen_nonsymmv_Z" let nonsymmv ?protect a = let a' = Gsl_vectmat.mat_convert ?protect a in let (n, _) = Gsl_vectmat.dims a' in let v = Gsl_vector_complex.create n in let evec = Gsl_matrix_complex.create n n in let ws = _nonsymmv_alloc_v n in begin try _nonsymmv a' (`CV v) (`CM evec) ws with exn -> _nonsymmv_free_v ws ; raise exn end ; _nonsymmv_free_v ws ; (v, evec) external nonsymmv_sort : Gsl_vector_complex.vector * Gsl_matrix_complex.matrix -> sort -> unit = "ml_gsl_eigen_nonsymmv_sort" gsl-ocaml-1.19.1/lib/gsl_eigen.mli000066400000000000000000000057021262311274100166710ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Eigensystems *) open Gsl_vectmat (** {3 Real Symmetric Matrices} *) type symm_ws val make_symm_ws : int -> symm_ws external _symm : mat -> vec -> symm_ws -> unit = "ml_gsl_eigen_symm" val symm : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> Gsl_vector.vector type symmv_ws val make_symmv_ws : int -> symmv_ws external _symmv : mat -> vec -> mat -> symmv_ws -> unit = "ml_gsl_eigen_symmv" val symmv : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> Gsl_vector.vector * Gsl_matrix.matrix type sort = | VAL_ASC | VAL_DESC | ABS_ASC | ABS_DESC external symmv_sort : Gsl_vector.vector * Gsl_matrix.matrix -> sort -> unit = "ml_gsl_eigen_symmv_sort" (** {3 Complex Hermitian Matrices} *) type herm_ws val make_herm_ws : int -> herm_ws external _herm : cmat -> vec -> herm_ws -> unit = "ml_gsl_eigen_herm" val herm : ?protect:bool -> [< `CM of Gsl_matrix_complex.matrix | `CMF of Gsl_matrix_complex_flat.matrix | `CA of Gsl_complex.complex_array * int * int ] -> Gsl_vector.vector type hermv_ws val make_hermv_ws : int -> hermv_ws external _hermv : cmat -> vec -> cmat -> hermv_ws -> unit = "ml_gsl_eigen_hermv" val hermv : ?protect:bool -> [< `CM of Gsl_matrix_complex.matrix | `CMF of Gsl_matrix_complex_flat.matrix | `CA of Gsl_complex.complex_array * int * int ] -> Gsl_vector.vector * Gsl_matrix_complex.matrix external hermv_sort : Gsl_vector.vector * Gsl_matrix_complex.matrix -> sort -> unit = "ml_gsl_eigen_hermv_sort" (** {3 Real Nonsymmetric Matrices} *) type nonsymm_ws val make_nonsymm_ws : int -> nonsymm_ws external _nonsymm : mat -> cvec -> nonsymm_ws -> unit = "ml_gsl_eigen_nonsymm" external _nonsymm_Z : mat -> cvec -> mat -> nonsymm_ws -> unit = "ml_gsl_eigen_nonsymm_Z" val nonsymm : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> Gsl_vector_complex.vector type nonsymmv_ws val make_nonsymmv_ws : int -> nonsymmv_ws external _nonsymmv : mat -> cvec -> cmat -> nonsymmv_ws -> unit = "ml_gsl_eigen_nonsymmv" external _nonsymmv_Z : mat -> cvec -> cmat -> mat -> nonsymmv_ws -> unit = "ml_gsl_eigen_nonsymmv_Z" val nonsymmv : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> Gsl_vector_complex.vector * Gsl_matrix_complex.matrix external nonsymmv_sort : Gsl_vector_complex.vector * Gsl_matrix_complex.matrix -> sort -> unit = "ml_gsl_eigen_nonsymmv_sort" gsl-ocaml-1.19.1/lib/gsl_error.ml000066400000000000000000000066121262311274100165630ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Printf external gsl_version : unit -> string = "ml_gsl_version" let version = gsl_version () type errno = | CONTINUE (* iteration has not converged *) | FAILURE | EDOM (* input domain error, e.g sqrt(-1) *) | ERANGE (* output range error, e.g. exp(1e100) *) | EFAULT (* invalid pointer *) | EINVAL (* invalid argument supplied by user *) | EFAILED (* generic failure *) | EFACTOR (* factorization failed *) | ESANITY (* sanity check failed - shouldn't happen *) | ENOMEM (* malloc failed *) | EBADFUNC (* problem with user-supplied function *) | ERUNAWAY (* iterative process is out of control *) | EMAXITER (* exceeded max number of iterations *) | EZERODIV (* tried to divide by zero *) | EBADTOL (* user specified an invalid tolerance *) | ETOL (* failed to reach the specified tolerance *) | EUNDRFLW (* underflow *) | EOVRFLW (* overflow *) | ELOSS (* loss of accuracy *) | EROUND (* failed because of roundoff error *) | EBADLEN (* matrix, vector lengths are not conformant *) | ENOTSQR (* matrix not square *) | ESING (* apparent singularity detected *) | EDIVERGE (* integral or series is divergent *) | EUNSUP (* requested feature is not supported by the hardware *) | EUNIMPL (* requested feature not (yet) implemented *) | ECACHE (* cache limit exceeded *) | ETABLE (* table limit exceeded *) | ENOPROG (* iteration is not making progress towards solution *) | ENOPROGJ (* jacobian evaluations are not improving the solution *) | ETOLF (* cannot reach the specified tolerance in F *) | ETOLX (* cannot reach the specified tolerance in X *) | ETOLG (* cannot reach the specified tolerance in gradient *) | EOF (* end of file *) exception Gsl_exn of errno * string let default_handler errcode s = raise (Gsl_exn(errcode,s)) let handler = ref default_handler external setup_caml_error_handler : bool -> unit = "ml_gsl_error_init" let init () = setup_caml_error_handler true let uninit () = setup_caml_error_handler false let () = Callback.register "mlgsl_err_handler" handler; init () external strerror : errno -> string = "ml_gsl_strerror" let string_of_errno = function | CONTINUE -> "CONTINUE" | FAILURE -> "FAILURE" | EDOM -> "EDOM" | ERANGE -> "ERANGE" | EFAULT -> "EFAULT" | EINVAL -> "EINVAL" | EFAILED -> "EFAILED" | EFACTOR -> "EFACTOR" | ESANITY -> "ESANITY" | ENOMEM -> "ENOMEM" | EBADFUNC -> "EBADFUNC" | ERUNAWAY -> "ERUNAWAY" | EMAXITER -> "EMAXITER" | EZERODIV -> "EZERODIV" | EBADTOL -> "EBADTOL" | ETOL -> "ETOL" | EUNDRFLW -> "EUNDRFLW" | EOVRFLW -> "EOVRFLW" | ELOSS -> "ELOSS" | EROUND -> "EROUND" | EBADLEN -> "EBADLEN" | ENOTSQR -> "ENOTSQR" | ESING -> "ESING" | EDIVERGE -> "EDIVERGE" | EUNSUP -> "EUNSUP" | EUNIMPL -> "EUNIMPL" | ECACHE -> "ECACHE" | ETABLE -> "ETABLE" | ENOPROG -> "ENOPROG" | ENOPROGJ -> "ENOPROGJ" | ETOLF -> "ETOLF" | ETOLX -> "ETOLX" | ETOLG -> "ETOLG" | EOF -> "EOF" let printer = function | Gsl_exn(errno, msg) -> Some(sprintf "Gsl.Error.Gsl_exn(%s, %S)" (string_of_errno errno) msg) | _ -> None let () = Printexc.register_printer printer gsl-ocaml-1.19.1/lib/gsl_error.mli000066400000000000000000000063361262311274100167370ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Error reporting *) val version : string (** Version of GSL library. *) type errno = | CONTINUE (** iteration has not converged *) | FAILURE | EDOM (** input domain error, e.g sqrt(-1) *) | ERANGE (** output range error, e.g. exp(1e100) *) | EFAULT (** invalid pointer *) | EINVAL (** invalid argument supplied by user *) | EFAILED (** generic failure *) | EFACTOR (** factorization failed *) | ESANITY (** sanity check failed - shouldn't happen *) | ENOMEM (** malloc failed *) | EBADFUNC (** problem with user-supplied function *) | ERUNAWAY (** iterative process is out of control *) | EMAXITER (** exceeded max number of iterations *) | EZERODIV (** tried to divide by zero *) | EBADTOL (** user specified an invalid tolerance *) | ETOL (** failed to reach the specified tolerance *) | EUNDRFLW (** underflow *) | EOVRFLW (** overflow *) | ELOSS (** loss of accuracy *) | EROUND (** failed because of roundoff error *) | EBADLEN (** matrix, vector lengths are not conformant *) | ENOTSQR (** matrix not square *) | ESING (** apparent singularity detected *) | EDIVERGE (** integral or series is divergent *) | EUNSUP (** requested feature is not supported by the hardware *) | EUNIMPL (** requested feature not (yet) implemented *) | ECACHE (** cache limit exceeded *) | ETABLE (** table limit exceeded *) | ENOPROG (** iteration is not making progress towards solution *) | ENOPROGJ (** jacobian evaluations are not improving the solution *) | ETOLF (** cannot reach the specified tolerance in F *) | ETOLX (** cannot reach the specified tolerance in X *) | ETOLG (** cannot reach the specified tolerance in gradient *) | EOF (** end of file *) exception Gsl_exn of errno * string (** [Error.Gsl_exn] is raised by GSL to indicate an error. The second argument gives the reason for the error. *) (** [Error.init ()] setups the GSL error handler so that the OCaml function {!Error.handler} gets called in case of an error. This behavior is the default now. *) val init : unit -> unit (** [Error.uninit ()] reverts the GSL error handler to the default of the GSL C-library. The default GSL error simply aborts the program. *) val uninit : unit -> unit (** The OCaml handler for GSL errors. Initially set to {!Error.default_handler}. If the function returns, the error is ignored and execution of the GSL function continues. Redefine it so as to ignore some particular errors ([EOVRFLW] or [EUNDRFLW] for instance). *) val handler : (errno -> string -> unit) ref (** The default OCaml handler for GSL errors. It simply raises the {!Error.Gsl_exn} exception. *) val default_handler : errno -> string -> 'a val strerror : errno -> string (** [strerror e] returns a description of the error [e]. *) val string_of_errno : errno -> string (** [string_of_errno e] returns the name of [e]. *) val printer : exn -> string option (** [printer] is an exceoption printer for {!Exn}. It is registered by default with [Printexc]. *) gsl-ocaml-1.19.1/lib/gsl_fft.ml000066400000000000000000000150341262311274100162070ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_complex exception Wrong_layout let _ = Callback.register_exception "mlgsl_layout_exn" Wrong_layout type layout = | Real | Halfcomplex | Halfcomplex_rad2 | Complex type fft_array = { mutable layout : layout ; data : float array } let check_layout layout a = if a.layout <> layout then raise Wrong_layout module Real = struct type workspace type wavetable external alloc_workspace : int -> workspace = "ml_gsl_fft_real_workspace_alloc" external alloc_wavetable : int -> wavetable = "ml_gsl_fft_real_wavetable_alloc" external free_workspace : workspace -> unit = "ml_gsl_fft_real_workspace_free" external free_wavetable : wavetable -> unit = "ml_gsl_fft_real_wavetable_free" let make_workspace size = let ws = alloc_workspace size in Gc.finalise free_workspace ws ; ws let make_wavetable size = let wt = alloc_wavetable size in Gc.finalise free_wavetable wt ; wt external transform : ?stride:int -> fft_array -> wavetable -> workspace -> unit = "ml_gsl_fft_real_transform" external transform_rad2 : ?stride:int -> fft_array -> unit = "ml_gsl_fft_real_radix2_transform" external ex_unpack : ?stride:int -> float array -> float array -> unit = "ml_gsl_fft_real_unpack" let unpack ?(stride=1) r_arr = if r_arr.layout <> Real then raise Wrong_layout ; let c_arr = Array.make (2 * (Array.length r_arr.data) / stride) 0. in ex_unpack ~stride r_arr.data c_arr ; { layout = Complex ; data = c_arr } end module Halfcomplex = struct type wavetable external alloc_wavetable : int -> wavetable = "ml_gsl_fft_halfcomplex_wavetable_alloc" external free_wavetable : wavetable -> unit = "ml_gsl_fft_halfcomplex_wavetable_free" let make_wavetable size = let wt = alloc_wavetable size in Gc.finalise free_wavetable wt ; wt external transform : ?stride:int -> fft_array -> wavetable -> Real.workspace -> unit = "ml_gsl_fft_halfcomplex_transform" external transform_rad2 : ?stride:int -> fft_array -> unit = "ml_gsl_fft_halfcomplex_radix2_transform" external backward : ?stride:int -> fft_array -> wavetable -> Real.workspace -> unit = "ml_gsl_fft_halfcomplex_backward" external backward_rad2 : ?stride:int -> fft_array -> unit = "ml_gsl_fft_halfcomplex_radix2_backward" external inverse : ?stride:int -> fft_array -> wavetable -> Real.workspace -> unit = "ml_gsl_fft_halfcomplex_inverse" external inverse_rad2 : ?stride:int -> fft_array -> unit = "ml_gsl_fft_halfcomplex_radix2_inverse" external ex_unpack : ?stride:int -> float array -> float array -> unit = "ml_gsl_fft_halfcomplex_unpack" external ex_unpack_rad2 : ?stride:int -> float array -> float array -> unit = "ml_gsl_fft_halfcomplex_unpack_rad2" let unpack ?(stride=1) hc_arr = match hc_arr.layout with | Halfcomplex -> let c_arr = Array.make (2 * (Array.length hc_arr.data) / stride) 0. in ex_unpack ~stride hc_arr.data c_arr ; { layout = Complex ; data = c_arr } | Halfcomplex_rad2 -> let c_arr = Array.make (2 * (Array.length hc_arr.data) / stride) 0. in ex_unpack_rad2 ~stride hc_arr.data c_arr ; { layout = Complex ; data = c_arr } | _ -> raise Wrong_layout end module Complex = struct type workspace type wavetable type direction = Forward | Backward external alloc_workspace : int -> workspace = "ml_gsl_fft_complex_workspace_alloc" external alloc_wavetable : int -> wavetable = "ml_gsl_fft_complex_wavetable_alloc" external free_workspace : workspace -> unit = "ml_gsl_fft_complex_workspace_free" external free_wavetable : wavetable -> unit = "ml_gsl_fft_complex_wavetable_free" let make_workspace size = let ws = alloc_workspace size in Gc.finalise free_workspace ws ; ws let make_wavetable size = let wt = alloc_wavetable size in Gc.finalise free_wavetable wt ; wt external forward : ?stride:int -> complex_array -> wavetable -> workspace -> unit = "ml_gsl_fft_complex_forward" external forward_rad2 : ?dif:bool -> ?stride:int -> complex_array -> unit = "ml_gsl_fft_complex_rad2_forward" external transform : ?stride:int -> complex_array -> wavetable -> workspace -> direction -> unit = "ml_gsl_fft_complex_transform" external transform_rad2 : ?dif:bool -> ?stride:int -> complex_array -> direction -> unit = "ml_gsl_fft_complex_rad2_transform" external backward : ?stride:int -> complex_array -> wavetable -> workspace -> unit = "ml_gsl_fft_complex_backward" external backward_rad2 : ?dif:bool -> ?stride:int -> complex_array -> unit = "ml_gsl_fft_complex_rad2_backward" external inverse : ?stride:int -> complex_array -> wavetable -> workspace -> unit = "ml_gsl_fft_complex_inverse" external inverse_rad2 : ?dif:bool -> ?stride:int -> complex_array -> unit = "ml_gsl_fft_complex_rad2_inverse" end let unpack = function | { layout = Real } as f -> (Real.unpack f).data | { layout = Halfcomplex } | { layout = Halfcomplex_rad2 } as f -> (Halfcomplex.unpack f).data | { layout = Complex ; data = d } -> d let hc_mult ({ data = a } as fa) ({ data = b } as fb) = check_layout Halfcomplex fa ; check_layout Halfcomplex fb ; let len = Array.length a in if Array.length b <> len then invalid_arg "hc_mult: array sizes differ" ; a.(0) <- a.(0) *. b.(0) ; for i=1 to (pred len) / 2 do let a_re = a.(2*i - 1) in let a_im = a.(2*i) in let b_re = b.(2*i - 1) in let b_im = b.(2*i) in a.(2* i-1) <- a_re *. b_re -. a_im *. b_im ; a.(2* i) <- a_re *. b_im +. a_im *. b_re ; done ; if len mod 2 = 0 then a.(pred len) <- a.(pred len) *. b.(pred len) let hc_mult_rad2 ({data = a } as fa) ({data = b } as fb) = check_layout Halfcomplex_rad2 fa ; check_layout Halfcomplex_rad2 fb ; let len = Array.length a in if Array.length b <> len then invalid_arg "hc_mult_rad2: array sizes differ" ; a.(0) <- a.(0) *. b.(0) ; for i=1 to (pred len) / 2 do let a_re = a.(i) in let a_im = a.(len - i) in let b_re = b.(i) in let b_im = b.(len - i) in a.(i) <- a_re *. b_re -. a_im *. b_im ; a.(len - i) <- a_re *. b_im +. a_im *. b_re ; done ; a.(len/2) <- a.(len/2) *. b.(len/2) gsl-ocaml-1.19.1/lib/gsl_fft.mli000066400000000000000000000061631262311274100163630ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Fast Fourier Transforms *) open Gsl_complex exception Wrong_layout type layout = | Real | Halfcomplex | Halfcomplex_rad2 | Complex type fft_array = { mutable layout : layout ; data : float array } module Real : sig type workspace type wavetable val make_workspace : int -> workspace val make_wavetable : int -> wavetable external transform : ?stride:int -> fft_array -> wavetable -> workspace -> unit = "ml_gsl_fft_real_transform" external transform_rad2 : ?stride:int -> fft_array -> unit = "ml_gsl_fft_real_radix2_transform" val unpack : ?stride:int -> fft_array -> fft_array end module Halfcomplex : sig type wavetable val make_wavetable : int -> wavetable external transform : ?stride:int -> fft_array -> wavetable -> Real.workspace -> unit = "ml_gsl_fft_halfcomplex_transform" external transform_rad2 : ?stride:int -> fft_array -> unit = "ml_gsl_fft_halfcomplex_radix2_transform" external backward : ?stride:int -> fft_array -> wavetable -> Real.workspace -> unit = "ml_gsl_fft_halfcomplex_backward" external backward_rad2 : ?stride:int -> fft_array -> unit = "ml_gsl_fft_halfcomplex_radix2_backward" external inverse : ?stride:int -> fft_array -> wavetable -> Real.workspace -> unit = "ml_gsl_fft_halfcomplex_inverse" external inverse_rad2 : ?stride:int -> fft_array -> unit = "ml_gsl_fft_halfcomplex_radix2_inverse" val unpack : ?stride:int -> fft_array -> fft_array end module Complex : sig type workspace type wavetable type direction = Forward | Backward val make_workspace : int -> workspace val make_wavetable : int -> wavetable external forward : ?stride:int -> complex_array -> wavetable -> workspace -> unit = "ml_gsl_fft_complex_forward" external forward_rad2 : ?dif:bool -> ?stride:int -> complex_array -> unit = "ml_gsl_fft_complex_rad2_forward" external transform : ?stride:int -> complex_array -> wavetable -> workspace -> direction -> unit = "ml_gsl_fft_complex_transform" external transform_rad2 : ?dif:bool -> ?stride:int -> complex_array -> direction -> unit = "ml_gsl_fft_complex_rad2_transform" external backward : ?stride:int -> complex_array -> wavetable -> workspace -> unit = "ml_gsl_fft_complex_backward" external backward_rad2 : ?dif:bool -> ?stride:int -> complex_array -> unit = "ml_gsl_fft_complex_rad2_backward" external inverse : ?stride:int -> complex_array -> wavetable -> workspace -> unit = "ml_gsl_fft_complex_inverse" external inverse_rad2 : ?dif:bool -> ?stride:int -> complex_array -> unit = "ml_gsl_fft_complex_rad2_inverse" end val unpack : fft_array -> complex_array val hc_mult : fft_array -> fft_array -> unit val hc_mult_rad2 : fft_array -> fft_array -> unit gsl-ocaml-1.19.1/lib/gsl_fit.ml000066400000000000000000000015201262311274100162050ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type linear_fit_coeffs = { c0 : float; c1 : float; cov00 : float ; cov01 : float ; cov11 : float; sumsq : float ; } external linear : ?weight:float array -> float array -> float array -> linear_fit_coeffs = "ml_gsl_fit_linear" external linear_est : float -> coeffs:linear_fit_coeffs -> Gsl_fun.result = "ml_gsl_fit_linear_est" type mul_fit_coeffs = { m_c1 : float ; m_cov11 : float ; m_sumsq : float ; } external mul : ?weight:float array -> float array -> float array -> mul_fit_coeffs = "ml_gsl_fit_mul" external mul_est : float -> coeffs:mul_fit_coeffs -> Gsl_fun.result = "ml_gsl_fit_mul_est" gsl-ocaml-1.19.1/lib/gsl_fit.mli000066400000000000000000000015411262311274100163610ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Least-Squares Fitting *) type linear_fit_coeffs = { c0 : float; c1 : float; cov00 : float ; cov01 : float ; cov11 : float; sumsq : float ; } external linear : ?weight:float array -> float array -> float array -> linear_fit_coeffs = "ml_gsl_fit_linear" external linear_est : float -> coeffs:linear_fit_coeffs -> Gsl_fun.result = "ml_gsl_fit_linear_est" type mul_fit_coeffs = { m_c1 : float ; m_cov11 : float ; m_sumsq : float ; } external mul : ?weight:float array -> float array -> float array -> mul_fit_coeffs = "ml_gsl_fit_mul" external mul_est : float -> coeffs:mul_fit_coeffs -> Gsl_fun.result = "ml_gsl_fit_mul_est" gsl-ocaml-1.19.1/lib/gsl_fun.ml000066400000000000000000000021231262311274100162130ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type result = { res : float ; err : float ; } type result_e10 = { res_e10 : float ; err_e10 : float ; e10 : int ; } type mode = | DOUBLE | SIMPLE | APPROX external smash : result_e10 -> result = "ml_gsl_sf_result_smash_e" type gsl_fun = float -> float type gsl_fun_fdf = { f : float -> float ; df : float -> float ; fdf : float -> float * float ; } type monte_fun = float array -> float open Gsl_vector type multi_fun = x:vector -> f:vector -> unit type multi_fun_fdf = { multi_f : x:vector -> f:vector -> unit ; multi_df : x:vector -> j:Gsl_matrix.matrix -> unit ; multi_fdf : x:vector -> f:vector -> j:Gsl_matrix.matrix -> unit ; } type multim_fun = x:vector -> float type multim_fun_fdf = { multim_f : x:vector -> float ; multim_df : x:vector -> g:vector -> unit ; multim_fdf : x:vector -> g:vector -> float ; } gsl-ocaml-1.19.1/lib/gsl_fun.mli000066400000000000000000000032021262311274100163630ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Callbacks and types for error estimates *) (** {3 Types for special functions} *) (** These type are used by module {! Sf} *) type result = { res : float ; err : float ; } (** The result of a computation : [res] is the value and [err] an estimate of the absolute error in the value. *) type result_e10 = { res_e10 : float ; err_e10 : float ; e10 : int ; } (** Result of computation with a scaling exponent. Actual result is obtained as [res *. 10. ** e10]. *) type mode = | DOUBLE (** Double precision : 2 * 10^-16 *) | SIMPLE (** Single precision : 10^-7 *) | APPROX (** Approximate values : 5 * 10^-4 *) (** Reduce the accuracy of some evaluations to speed up computations. *) external smash : result_e10 -> result = "ml_gsl_sf_result_smash_e" (** {3 Callbacks} *) type gsl_fun = float -> float type gsl_fun_fdf = { f : float -> float ; df : float -> float ; fdf : float -> float * float ; } type monte_fun = float array -> float open Gsl_vector type multi_fun = x:vector -> f:vector -> unit type multi_fun_fdf = { multi_f : x:vector -> f:vector -> unit ; multi_df : x:vector -> j:Gsl_matrix.matrix -> unit ; multi_fdf : x:vector -> f:vector -> j:Gsl_matrix.matrix -> unit ; } type multim_fun = x:vector -> float type multim_fun_fdf = { multim_f : x:vector -> float ; multim_df : x:vector -> g:vector -> unit ; multim_fdf : x:vector -> g:vector -> float ; } gsl-ocaml-1.19.1/lib/gsl_histo.ml000066400000000000000000000051271262311274100165600ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Histograms *) (** The histogram type *) type t = { n : int ; range : float array ; bin : float array ; } let check h = h.n > 0 && Array.length h.range = succ h.n && Array.length h.bin = h.n (** {3 Allocating histograms} *) let make n = { n = n ; range = Array.make (succ n) 0. ; bin = Array.make n 0. ; } let copy h = { n = h.n ; range = Array.copy h.range ; bin = Array.copy h.bin ; } external set_ranges : t -> float array -> unit = "ml_gsl_histogram_set_ranges" external set_ranges_uniform : t -> xmin:float -> xmax:float -> unit = "ml_gsl_histogram_set_ranges_uniform" (** {3 Updating and accessing histogram elements} *) external accumulate : t -> ?w:float -> float -> unit = "ml_gsl_histogram_accumulate" let get h i = h.bin.(i) let get_range h i = (h.range.(i), h.range.(succ i)) let h_max h = h.range.(h.n) let h_min h = h.range.(0) let bins h = h.n let reset h = Array.fill h.bin 0 h.n 0. (** {3 Searching histogram ranges} *) external find : t -> float -> int = "ml_gsl_histogram_find" (** {3 Histograms statistics } *) external max_val : t -> float = "ml_gsl_histogram_max_val" external max_bin : t -> int = "ml_gsl_histogram_max_bin" external min_val : t -> float = "ml_gsl_histogram_min_val" external min_bin : t -> int = "ml_gsl_histogram_min_bin" external mean : t -> float = "ml_gsl_histogram_mean" external sigma : t -> float = "ml_gsl_histogram_sigma" external sum : t -> float = "ml_gsl_histogram_sum" (** {3 Histogram operations} *) external equal_bins_p : t -> t -> bool = "ml_gsl_histogram_equal_bins_p" external add : t -> t -> unit = "ml_gsl_histogram_add" external sub : t -> t -> unit = "ml_gsl_histogram_sub" external mul : t -> t -> unit = "ml_gsl_histogram_mul" external div : t -> t -> unit = "ml_gsl_histogram_div" external scale : t -> float -> unit = "ml_gsl_histogram_scale" external shift : t -> float -> unit = "ml_gsl_histogram_shift" (** {3 Resampling} *) type histo_pdf = { pdf_n : int ; pdf_range : float array ; pdf_sum : float array ; } external _init : histo_pdf -> t -> unit = "ml_gsl_histogram_pdf_init" let init h = let p = { pdf_n = h.n ; pdf_range = Array.copy h.range ; pdf_sum = Array.copy h.bin ; } in _init p h ; p external sample : histo_pdf -> float -> float = "ml_gsl_histogram_pdf_sample" gsl-ocaml-1.19.1/lib/gsl_histo.mli000066400000000000000000000042741262311274100167330ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Histograms *) (** The histogram type *) type t = private { n : int; (** number of histogram bins *) range : float array; (** ranges of the bins ; n+1 elements *) bin : float array; (** counts for each bin ; n elements *) } val check : t -> bool (** {3 Allocating histograms} *) val make : int -> t val copy : t -> t external set_ranges : t -> float array -> unit = "ml_gsl_histogram_set_ranges" external set_ranges_uniform : t -> xmin:float -> xmax:float -> unit = "ml_gsl_histogram_set_ranges_uniform" (** {3 Updating and accessing histogram elements} *) external accumulate : t -> ?w:float -> float -> unit = "ml_gsl_histogram_accumulate" val get : t -> int -> float val get_range : t -> int -> float * float val h_max : t -> float val h_min : t -> float val bins : t -> int val reset : t -> unit (** {3 Searching histogram ranges} *) external find : t -> float -> int = "ml_gsl_histogram_find" (** {3 Histograms statistics } *) external max_val : t -> float = "ml_gsl_histogram_max_val" external max_bin : t -> int = "ml_gsl_histogram_max_bin" external min_val : t -> float = "ml_gsl_histogram_min_val" external min_bin : t -> int = "ml_gsl_histogram_min_bin" external mean : t -> float = "ml_gsl_histogram_mean" external sigma : t -> float = "ml_gsl_histogram_sigma" external sum : t -> float = "ml_gsl_histogram_sum" (** {3 Histogram operations} *) external equal_bins_p : t -> t -> bool = "ml_gsl_histogram_equal_bins_p" external add : t -> t -> unit = "ml_gsl_histogram_add" external sub : t -> t -> unit = "ml_gsl_histogram_sub" external mul : t -> t -> unit = "ml_gsl_histogram_mul" external div : t -> t -> unit = "ml_gsl_histogram_div" external scale : t -> float -> unit = "ml_gsl_histogram_scale" external shift : t -> float -> unit = "ml_gsl_histogram_shift" (** {3 Resampling} *) type histo_pdf = private { pdf_n : int; pdf_range : float array; pdf_sum : float array; } val init : t -> histo_pdf external sample : histo_pdf -> float -> float = "ml_gsl_histogram_pdf_sample" gsl-ocaml-1.19.1/lib/gsl_ieee.ml000066400000000000000000000032431262311274100163360ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type ieee_type = | NAN | INF | NORMAL | DENORMAL | ZERO type float_rep = { sign : int ; mantissa : string ; exponent : int ; ieee_type : ieee_type ; } external rep_of_float : float -> float_rep = "ml_gsl_ieee_double_to_rep" external env_setup : unit -> unit = "ml_gsl_ieee_env_setup" type precision = | SINGLE | DOUBLE | EXTENDED type rounding = | TO_NEAREST | DOWN | UP | TO_ZERO type exceptions = | MASK_INVALID | MASK_DENORMALIZED | MASK_DIVISION_BY_ZERO | MASK_OVERFLOW | MASK_UNDERFLOW | MASK_ALL | TRAP_INEXACT external set_mode : ?precision:precision -> ?rounding:rounding -> exceptions list -> unit = "ml_gsl_ieee_set_mode" let print f = let rep = rep_of_float f in match rep.ieee_type with | NAN -> "NaN" | INF when rep.sign = 0 -> "Inf" | INF -> "-Inf" | ZERO when rep.sign = 0 -> "0" | ZERO -> "-0" | DENORMAL -> (if rep.sign = 0 then "" else "-") ^ "0." ^ rep.mantissa ^ (if rep.exponent = 0 then "" else string_of_int rep.exponent) | NORMAL -> (if rep.sign = 0 then "" else "-") ^ "1." ^ rep.mantissa ^ (if rep.exponent = 0 then "" else ("*2^" ^ (string_of_int rep.exponent))) type excepts = | FE_INEXACT | FE_DIVBYZERO | FE_UNDERFLOW | FE_OVERFLOW | FE_INVALID | FE_ALL_EXCEPT external clear_except : excepts list -> unit = "ml_feclearexcept" external test_except : excepts list -> excepts list = "ml_fetestexcept" gsl-ocaml-1.19.1/lib/gsl_ieee.mli000066400000000000000000000024141262311274100165060ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** IEEE floating-point arithmetic *) (** {3 Representation of floating point numbers} *) type ieee_type = | NAN | INF | NORMAL | DENORMAL | ZERO type float_rep = { sign : int; mantissa : string; exponent : int; ieee_type : ieee_type; } external rep_of_float : float -> float_rep = "ml_gsl_ieee_double_to_rep" val print : float -> string (** {3 IEEE environment} *) type precision = | SINGLE | DOUBLE | EXTENDED type rounding = | TO_NEAREST | DOWN | UP | TO_ZERO type exceptions = | MASK_INVALID | MASK_DENORMALIZED | MASK_DIVISION_BY_ZERO | MASK_OVERFLOW | MASK_UNDERFLOW | MASK_ALL | TRAP_INEXACT external set_mode : ?precision:precision -> ?rounding:rounding -> exceptions list -> unit = "ml_gsl_ieee_set_mode" external env_setup : unit -> unit = "ml_gsl_ieee_env_setup" (** {3 FPU status word} *) type excepts = | FE_INEXACT | FE_DIVBYZERO | FE_UNDERFLOW | FE_OVERFLOW | FE_INVALID | FE_ALL_EXCEPT external clear_except : excepts list -> unit = "ml_feclearexcept" external test_except : excepts list -> excepts list = "ml_fetestexcept" gsl-ocaml-1.19.1/lib/gsl_integration.ml000066400000000000000000000077131262311274100177600ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_fun external qng : gsl_fun -> a:float -> b:float -> epsabs:float -> epsrel:float -> float * float * int = "ml_gsl_integration_qng" type workspace external alloc_ws : int -> workspace = "ml_gsl_integration_workspace_alloc" external free_ws : workspace -> unit = "ml_gsl_integration_workspace_free" let make_ws size = let ws = alloc_ws size in Gc.finalise free_ws ws ; ws external size : workspace -> int = "ml_gsl_integration_ws_size" type key = | GAUSS15 | GAUSS21 | GAUSS31 | GAUSS41 | GAUSS51 | GAUSS61 external qag : gsl_fun -> a:float -> b:float -> epsabs:float -> epsrel:float -> ?limit:int -> key -> workspace -> result = "ml_gsl_integration_qag_bc" "ml_gsl_integration_qag" external qags : gsl_fun -> a:float -> b:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qags_bc" "ml_gsl_integration_qags" external qagp : gsl_fun -> pts:float array -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qagp_bc" "ml_gsl_integration_qagp" external qagi : gsl_fun -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qagi" external qagiu : gsl_fun -> a:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qagiu_bc" "ml_gsl_integration_qagiu" external qagil : gsl_fun -> b:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qagil_bc" "ml_gsl_integration_qagil" let qag_sing gslfun ~a ~b ?pts ?(limit=1000) ~epsabs ~epsrel () = if b < a then invalid_arg "qag_sing" ; let ws = make_ws limit in begin if b = infinity then begin if a = neg_infinity then qagi gslfun ~epsabs ~epsrel ws else qagiu gslfun ~a ~epsabs ~epsrel ws end else begin if a = neg_infinity then qagil gslfun ~b ~epsabs ~epsrel ws else begin match pts with | None -> qags gslfun ~a ~b ~epsabs ~epsrel ws | Some farr -> let len = Array.length farr in let arr = Array.make (2 + len) a in Array.blit farr 0 arr 1 len ; arr.(len + 1) <- b ; qagp gslfun ~pts:arr ~epsabs ~epsrel ws end end end external qawc : gsl_fun -> a:float -> b:float -> c:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qawc_bc" "ml_gsl_integration_qawc" type qaws_table external alloc_qaws : alpha:float -> beta:float -> mu:int -> nu:int -> qaws_table = "ml_gsl_integration_qaws_table_alloc" external set_qaws : qaws_table -> alpha:float -> beta:float -> mu:int -> nu:int -> unit = "ml_gsl_integration_qaws_table_set" external free_qaws : qaws_table -> unit = "ml_gsl_integration_qaws_table_free" external qaws : gsl_fun -> a:float -> b:float -> qaws_table -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qaws_bc" "ml_gsl_integration_qaws" type qawo_table type qawo_sine = | QAWO_COSINE | QAWO_SINE external alloc_qawo : omega:float -> l:float -> qawo_sine -> n:int -> qawo_table = "ml_gsl_integration_qawo_table_alloc" external set_qawo : qawo_table -> omega:float -> l:float -> qawo_sine -> unit = "ml_gsl_integration_qawo_table_set" external free_qawo : qawo_table -> unit = "ml_gsl_integration_qawo_table_free" external qawo : gsl_fun -> a:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> qawo_table -> result = "ml_gsl_integration_qawo_bc" "ml_gsl_integration_qawo" external qawf : gsl_fun -> a:float -> epsabs:float -> ?limit:int -> workspace -> workspace -> qawo_table -> result = "ml_gsl_integration_qawf_bc" "ml_gsl_integration_qawf" gsl-ocaml-1.19.1/lib/gsl_integration.mli000066400000000000000000000063421262311274100201260ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Numerical Integration *) open Gsl_fun external qng : gsl_fun -> a:float -> b:float -> epsabs:float -> epsrel:float -> float * float * int = "ml_gsl_integration_qng" type workspace val make_ws : int -> workspace external size : workspace -> int = "ml_gsl_integration_ws_size" type key = | GAUSS15 | GAUSS21 | GAUSS31 | GAUSS41 | GAUSS51 | GAUSS61 external qag : gsl_fun -> a:float -> b:float -> epsabs:float -> epsrel:float -> ?limit:int -> key -> workspace -> result = "ml_gsl_integration_qag_bc" "ml_gsl_integration_qag" external qags : gsl_fun -> a:float -> b:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qags_bc" "ml_gsl_integration_qags" external qagp : gsl_fun -> pts:float array -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qagp_bc" "ml_gsl_integration_qagp" external qagi : gsl_fun -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qagi" external qagiu : gsl_fun -> a:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qagiu_bc" "ml_gsl_integration_qagiu" external qagil : gsl_fun -> b:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qagil_bc" "ml_gsl_integration_qagil" val qag_sing : gsl_fun -> a:float -> b:float -> ?pts:float array -> ?limit:int -> epsabs:float -> epsrel:float -> unit -> result external qawc : gsl_fun -> a:float -> b:float -> c:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qawc_bc" "ml_gsl_integration_qawc" type qaws_table external alloc_qaws : alpha:float -> beta:float -> mu:int -> nu:int -> qaws_table = "ml_gsl_integration_qaws_table_alloc" external set_qaws : qaws_table -> alpha:float -> beta:float -> mu:int -> nu:int -> unit = "ml_gsl_integration_qaws_table_set" external free_qaws : qaws_table -> unit = "ml_gsl_integration_qaws_table_free" external qaws : gsl_fun -> a:float -> b:float -> qaws_table -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> result = "ml_gsl_integration_qaws_bc" "ml_gsl_integration_qaws" type qawo_table type qawo_sine = | QAWO_COSINE | QAWO_SINE external alloc_qawo : omega:float -> l:float -> qawo_sine -> n:int -> qawo_table = "ml_gsl_integration_qawo_table_alloc" external set_qawo : qawo_table -> omega:float -> l:float -> qawo_sine -> unit = "ml_gsl_integration_qawo_table_set" external free_qawo : qawo_table -> unit = "ml_gsl_integration_qawo_table_free" external qawo : gsl_fun -> a:float -> epsabs:float -> epsrel:float -> ?limit:int -> workspace -> qawo_table -> result = "ml_gsl_integration_qawo_bc" "ml_gsl_integration_qawo" external qawf : gsl_fun -> a:float -> epsabs:float -> ?limit:int -> workspace -> workspace -> qawo_table -> result = "ml_gsl_integration_qawf_bc" "ml_gsl_integration_qawf" gsl-ocaml-1.19.1/lib/gsl_interp.ml000066400000000000000000000050721262311274100167320ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type t type accel type interp_type = | LINEAR | POLYNOMIAL | CSPLINE | CSPLINE_PERIODIC | AKIMA | AKIMA_PERIODIC external _alloc : interp_type -> int -> t = "ml_gsl_interp_alloc" external _free : t -> unit = "ml_gsl_interp_free" let make t s = let i = _alloc t s in Gc.finalise _free i ; i external _init : t -> float array -> float array -> int -> unit = "ml_gsl_interp_init" let init i x y = let lx = Array.length x in let ly = Array.length y in if lx <> ly then invalid_arg "Interp: init" ; _init i x y lx external name : t -> string = "ml_gsl_interp_name" external min_size : t -> int = "ml_gsl_interp_min_size" external _accel_alloc : unit -> accel = "ml_gsl_interp_accel_alloc" external _accel_free : accel -> unit = "ml_gsl_interp_accel_free" let make_accel () = let a = _accel_alloc () in Gc.finalise _accel_free a ; a external i_eval : t -> float array -> float array -> float -> accel -> float = "ml_gsl_interp_eval" external i_eval_deriv : t -> float array -> float array -> float -> accel -> float = "ml_gsl_interp_eval_deriv" external i_eval_deriv2 : t -> float array -> float array -> float -> accel -> float = "ml_gsl_interp_eval_deriv2" external i_eval_integ : t -> float array -> float array -> float -> float -> accel -> float = "ml_gsl_interp_eval_integ_bc" "ml_gsl_interp_eval_integ" (* Higher level functions *) type interp = { interp : t ; accel : accel ; xa : float array ; ya : float array ; size : int ; i_type : interp_type ; } let make_interp i_type x y = let len = Array.length x in let ly = Array.length y in if len <> ly then invalid_arg "Interp.make" ; let t = _alloc i_type len in let a = _accel_alloc () in let v = { interp=t; accel = a ; xa=x; ya=y; size=len; i_type=i_type } in Gc.finalise (fun v -> _free v.interp ; _accel_free v.accel) v ; init t x y ; v let eval interp x = i_eval interp.interp interp.xa interp.ya x interp.accel external eval_array : interp -> float array -> float array -> unit = "ml_gsl_interp_eval_array" let eval_deriv interp x = i_eval_deriv interp.interp interp.xa interp.ya x interp.accel let eval_deriv2 interp x = i_eval_deriv2 interp.interp interp.xa interp.ya x interp.accel let eval_integ interp a b = i_eval_integ interp.interp interp.xa interp.ya a b interp.accel gsl-ocaml-1.19.1/lib/gsl_interp.mli000066400000000000000000000034541262311274100171050ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Interpolation *) type t type accel type interp_type = | LINEAR | POLYNOMIAL | CSPLINE | CSPLINE_PERIODIC | AKIMA | AKIMA_PERIODIC val make : interp_type -> int -> t val init : t -> float array -> float array -> unit external name : t -> string = "ml_gsl_interp_name" external min_size : t -> int = "ml_gsl_interp_min_size" val make_accel : unit -> accel external i_eval : t -> float array -> float array -> float -> accel -> float = "ml_gsl_interp_eval" external i_eval_deriv : t -> float array -> float array -> float -> accel -> float = "ml_gsl_interp_eval_deriv" external i_eval_deriv2 : t -> float array -> float array -> float -> accel -> float = "ml_gsl_interp_eval_deriv2" external i_eval_integ : t -> float array -> float array -> float -> float -> accel -> float = "ml_gsl_interp_eval_integ_bc" "ml_gsl_interp_eval_integ" (** {3 Higher level functions} *) type interp = { interp : t ; accel : accel ; xa : float array ; ya : float array ; size : int ; i_type : interp_type ; } val make_interp : interp_type -> float array -> float array -> interp val eval : interp -> float -> float (** [eval_array interp x_a y_a] fills the array [y_a] with the evaluation of the interpolation function [interp] for each point of array [x_a]. [x_a] and [y_a] must have the same length. *) external eval_array : interp -> float array -> float array -> unit = "ml_gsl_interp_eval_array" val eval_deriv : interp -> float -> float val eval_deriv2 : interp -> float -> float val eval_integ : interp -> float -> float -> float gsl-ocaml-1.19.1/lib/gsl_linalg.ml000066400000000000000000000247341262311274100167050ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_vectmat open Gsl_complex (* Simple matrix multiplication *) external matmult : a:mat -> ?transpa:bool -> b:mat -> ?transpb:bool -> mat -> unit = "ml_gsl_linalg_matmult_mod" (* LU decomposition *) (* Low-level functions *) external _LU_decomp : mat -> Gsl_permut.permut -> int = "ml_gsl_linalg_LU_decomp" external _LU_solve : mat -> Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LU_solve" external _LU_svx : mat -> Gsl_permut.permut -> vec -> unit = "ml_gsl_linalg_LU_svx" external _LU_refine : a:mat -> lu:mat -> Gsl_permut.permut -> b:vec -> x:vec -> res:vec -> unit = "ml_gsl_linalg_LU_refine_bc" "ml_gsl_linalg_LU_refine" external _LU_invert : mat -> Gsl_permut.permut -> mat -> unit = "ml_gsl_linalg_LU_invert" external _LU_det : mat -> int -> float = "ml_gsl_linalg_LU_det" external _LU_lndet : mat -> float = "ml_gsl_linalg_LU_lndet" external _LU_sgndet : mat -> int -> int = "ml_gsl_linalg_LU_sgndet" (* Higher-level functions *) (* With these, the arguments are protected (copied) and necessary intermediate datastructures are allocated; *) let decomp_LU ?(protect=true) mat = let mA = mat_convert ~protect mat in let (len, _) = Gsl_vectmat.dims mA in let p = Gsl_permut.create len in let sign = _LU_decomp mA p in (mA, p, sign) let solve_LU ?(protect=true) mat b = let mA = mat_convert ~protect mat in let vB = vec_convert b in let (len, _) = Gsl_vectmat.dims mA in let p = Gsl_permut.create len in let _ = _LU_decomp mA p in let x = Gsl_vector_flat.create len in _LU_solve mA p ~b:vB ~x:(`VF x) ; x.Gsl_vector_flat.data let det_LU ?(protect=true) mat = let (lu, _, sign) = decomp_LU ~protect mat in _LU_det lu sign let invert_LU ?(protect=true) ?result mat = let (lu, lu_p, _) = decomp_LU ~protect mat in let result = match result with | Some r -> r | None -> Gsl_vectmat.tmp lu in _LU_invert lu lu_p result ; result (* Complex LU decomposition *) external complex_LU_decomp : cmat -> Gsl_permut.permut -> int = "ml_gsl_linalg_complex_LU_decomp" external complex_LU_solve : cmat -> Gsl_permut.permut -> b:cvec -> x:cvec -> unit = "ml_gsl_linalg_complex_LU_solve" external complex_LU_svx : cmat -> Gsl_permut.permut -> cvec -> unit = "ml_gsl_linalg_complex_LU_svx" external complex_LU_refine : a:cmat -> lu:cmat -> Gsl_permut.permut -> b:cvec -> x:cvec -> res:cvec -> unit = "ml_gsl_linalg_complex_LU_refine_bc" "ml_gsl_linalg_complex_LU_refine" external complex_LU_invert : cmat -> Gsl_permut.permut -> cmat -> unit = "ml_gsl_linalg_complex_LU_invert" external complex_LU_det : cmat -> int -> complex = "ml_gsl_linalg_complex_LU_det" external complex_LU_lndet : cmat -> float = "ml_gsl_linalg_complex_LU_lndet" external complex_LU_sgndet : cmat -> int -> complex = "ml_gsl_linalg_complex_LU_sgndet" (* QR decomposition *) external _QR_decomp : mat -> vec -> unit = "ml_gsl_linalg_QR_decomp" external _QR_solve : mat -> vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QR_solve" external _QR_svx : mat -> vec -> x:vec -> unit = "ml_gsl_linalg_QR_svx" external _QR_lssolve : mat -> vec -> b:vec -> x:vec -> res:vec -> unit = "ml_gsl_linalg_QR_lssolve" external _QR_QTvec : mat -> vec -> v:vec -> unit = "ml_gsl_linalg_QR_QTvec" external _QR_Qvec : mat -> vec -> v:vec -> unit = "ml_gsl_linalg_QR_Qvec" external _QR_Rsolve : mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QR_Rsolve" external _QR_Rsvx : mat -> x:vec -> unit = "ml_gsl_linalg_QR_Rsvx" external _QR_unpack : mat -> tau:vec -> q:mat -> r:mat -> unit = "ml_gsl_linalg_QR_unpack" external _QR_QRsolve : mat -> r:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QR_QRsolve" external _QR_update : mat -> r:mat -> w:vec -> v:vec -> unit = "ml_gsl_linalg_QR_update" external _R_solve : r:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_R_solve" (* external _R_svx : r:mat -> x:vec -> unit*) (* = "ml_gsl_linalg_R_svx"*) (* QR Decomposition with Column Pivoting *) external _QRPT_decomp : a:mat -> tau:vec -> p:Gsl_permut.permut -> norm:vec -> int = "ml_gsl_linalg_QRPT_decomp" external _QRPT_decomp2 : a:mat -> q:mat -> r:mat -> tau:vec -> p:Gsl_permut.permut -> norm:vec -> int = "ml_gsl_linalg_QRPT_decomp2_bc" "ml_gsl_linalg_QRPT_decomp2" external _QRPT_solve : qr:mat -> tau:vec -> p:Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_solve" external _QRPT_svx : qr:mat -> tau:vec -> p:Gsl_permut.permut -> x:vec -> unit = "ml_gsl_linalg_QRPT_svx" external _QRPT_QRsolve : q:mat -> r:mat -> p:Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_QRsolve" external _QRPT_update : q:mat -> r:mat -> p:Gsl_permut.permut -> u:vec -> v:vec -> unit = "ml_gsl_linalg_QRPT_update" external _QRPT_Rsolve : qr:mat -> p:Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_Rsolve" external _QRPT_Rsvx : qr:mat -> p:Gsl_permut.permut -> x:vec -> unit = "ml_gsl_linalg_QRPT_Rsolve" (* Singular Value Decomposition *) external _SV_decomp : a:mat -> v:mat -> s:vec -> work:vec -> unit = "ml_gsl_linalg_SV_decomp" external _SV_decomp_mod : a:mat -> x:mat -> v:mat -> s:vec -> work:vec -> unit = "ml_gsl_linalg_SV_decomp_mod" external _SV_decomp_jacobi : a:mat -> v:mat -> s:vec -> unit = "ml_gsl_linalg_SV_decomp_jacobi" external _SV_solve : u:mat -> v:mat -> s:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_SV_solve" (* LQ decomposition *) external _LQ_decomp : a:mat -> tau:vec -> unit = "ml_gsl_linalg_LQ_decomp" external _LQ_solve_T : lq:mat -> tau:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LQ_solve_T" external _LQ_svx_T : lq:mat -> tau:vec -> x:vec -> unit = "ml_gsl_linalg_LQ_svx_T" external _LQ_lssolve_T : lq:mat -> tau:vec -> b:vec -> x:vec -> res:vec -> unit = "ml_gsl_linalg_LQ_lssolve_T" external _LQ_Lsolve_T : lq:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LQ_Lsolve_T" external _LQ_Lsvx_T : lq:mat -> x:vec -> unit = "ml_gsl_linalg_LQ_Lsvx_T" external _L_solve_T : l:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_L_solve_T" external _LQ_vecQ : lq:mat -> tau:vec -> v:vec -> unit = "ml_gsl_linalg_LQ_vecQ" external _LQ_vecQT : lq:mat -> tau:vec -> v:vec -> unit = "ml_gsl_linalg_LQ_vecQT" external _LQ_unpack : lq:mat -> tau:vec -> q:mat -> l:mat -> unit = "ml_gsl_linalg_LQ_unpack" external _LQ_update : q:mat -> r:mat -> v:vec -> w:vec -> unit = "ml_gsl_linalg_LQ_update" external _LQ_LQsolve : q:mat -> l:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LQ_LQsolve" (* P^T L Q decomposition *) external _PTLQ_decomp : a:mat -> tau:vec -> Gsl_permut.permut -> norm:vec -> int = "ml_gsl_linalg_PTLQ_decomp" external _PTLQ_decomp2 : a:mat -> q:mat -> r:mat -> tau:vec -> Gsl_permut.permut -> norm:vec -> int = "ml_gsl_linalg_PTLQ_decomp2_bc" "ml_gsl_linalg_PTLQ_decomp2" external _PTLQ_solve_T : qr:mat -> tau:vec -> Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_solve_T" external _PTLQ_svx_T : lq:mat -> tau:vec -> Gsl_permut.permut -> x:vec -> unit = "ml_gsl_linalg_PTLQ_svx_T" external _PTLQ_LQsolve_T : q:mat -> l:mat -> Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_LQsolve_T" external _PTLQ_Lsolve_T : lq:mat -> Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_Lsolve_T" external _PTLQ_Lsvx_T : lq:mat -> Gsl_permut.permut -> x:vec -> unit = "ml_gsl_linalg_PTLQ_Lsvx_T" external _PTLQ_update : q:mat -> l:mat -> Gsl_permut.permut -> v:vec -> w:vec -> unit = "ml_gsl_linalg_PTLQ_update" (* Cholesky decomposition *) external cho_decomp : mat -> unit = "ml_gsl_linalg_cholesky_decomp" external cho_solve : mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_cholesky_solve" external cho_svx : mat -> vec -> unit = "ml_gsl_linalg_cholesky_svx" external cho_decomp_unit : mat -> vec -> unit = "ml_gsl_linalg_cholesky_decomp_unit" (* Tridiagonal Decomposition of Real Symmetric Matrices *) external symmtd_decomp : a:mat -> tau:vec -> unit = "ml_gsl_linalg_symmtd_decomp" external symmtd_unpack : a:mat -> tau:vec -> q:mat -> diag:vec -> subdiag:vec -> unit = "ml_gsl_linalg_symmtd_unpack" external symmtd_unpack_T : a:mat -> diag:vec -> subdiag:vec -> unit = "ml_gsl_linalg_symmtd_unpack_T" (* Tridiagonal Decomposition of Hermitian Matrices *) external hermtd_decomp : a:cmat -> tau:cvec -> unit = "ml_gsl_linalg_hermtd_decomp" external hermtd_unpack : a:cmat -> tau:cvec -> q:cmat -> diag:vec -> subdiag:vec -> unit = "ml_gsl_linalg_hermtd_unpack" external hermtd_unpack_T : a:cmat -> diag:vec -> subdiag:vec -> unit = "ml_gsl_linalg_hermtd_unpack_T" (* Bidiagonalization *) external bidiag_decomp : a:mat -> tau_u:vec -> tau_v:vec -> unit = "ml_gsl_linalg_bidiag_decomp" external bidiag_unpack : a:mat -> tau_u:vec -> u:mat -> tau_v:vec -> v:mat -> diag:vec -> superdiag:vec -> unit = "ml_gsl_linalg_bidiag_unpack_bc" "ml_gsl_linalg_bidiag_unpack" external bidiag_unpack2 : a:mat -> tau_u:vec -> tau_v:vec -> v:mat -> unit = "ml_gsl_linalg_bidiag_unpack2" external bidiag_unpack_B : a:mat -> diag:vec -> superdiag:vec -> unit = "ml_gsl_linalg_bidiag_unpack_B" (* Householder solver *) external _HH_solve : mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_HH_solve" external _HH_svx : mat -> vec -> unit = "ml_gsl_linalg_HH_svx" let solve_HH ?(protect=true) mat b = let mA = mat_convert ~protect mat in let vB = vec_convert b in let vX = Gsl_vector_flat.create (Gsl_vectmat.length vB) in _HH_solve mA ~b:vB ~x:(`VF vX) ; vX.Gsl_vector_flat.data (* Tridiagonal Systems *) external solve_symm_tridiag : diag:vec -> offdiag:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_solve_symm_tridiag" external solve_tridiag : diag:vec -> abovediag:vec -> belowdiag:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_solve_tridiag" external solve_symm_cyc_tridiag : diag:vec -> offdiag:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_solve_symm_cyc_tridiag" external solve_cyc_tridiag : diag:vec -> abovediag:vec -> belowdiag:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_solve_cyc_tridiag" (* exponential *) external _exponential : mat -> mat -> Gsl_fun.mode -> unit = "ml_gsl_linalg_exponential_ss" let exponential ?(mode=Gsl_fun.DOUBLE) mat = let mA = Gsl_vectmat.mat_convert mat in let eA = Gsl_vectmat.tmp mA in _exponential mA (eA : [`M of Gsl_matrix.matrix] :> mat) mode ; eA gsl-ocaml-1.19.1/lib/gsl_linalg.mli000066400000000000000000000256111262311274100170510ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Simple linear algebra operations *) open Gsl_vectmat open Gsl_complex (** {3 Simple matrix multiplication} *) (** [matmult a ~transpa b ~transpb c] stores in matrix [c] the product of matrices [a] and [b]. [transpa] or [transpb] allow transposition of either matrix, so it can compute a.b or Trans(a).b or a.Trans(b) or Trans(a).Trans(b) . See also {!Gsl.Blas.gemm}. *) external matmult : a:mat -> ?transpa:bool -> b:mat -> ?transpb:bool -> mat -> unit = "ml_gsl_linalg_matmult_mod" (** {3 LU decomposition} *) (** {4 Low-level functions } *) external _LU_decomp : mat -> Gsl_permut.permut -> int = "ml_gsl_linalg_LU_decomp" external _LU_solve : mat -> Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LU_solve" external _LU_svx : mat -> Gsl_permut.permut -> vec -> unit = "ml_gsl_linalg_LU_svx" external _LU_refine : a:mat -> lu:mat -> Gsl_permut.permut -> b:vec -> x:vec -> res:vec -> unit = "ml_gsl_linalg_LU_refine_bc" "ml_gsl_linalg_LU_refine" external _LU_invert : mat -> Gsl_permut.permut -> mat -> unit = "ml_gsl_linalg_LU_invert" external _LU_det : mat -> int -> float = "ml_gsl_linalg_LU_det" external _LU_lndet : mat -> float = "ml_gsl_linalg_LU_lndet" external _LU_sgndet : mat -> int -> int = "ml_gsl_linalg_LU_sgndet" (** {4 Higher-level functions} *) (** With these, the arguments are protected (copied) and necessary intermediate datastructures are allocated; *) val decomp_LU : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> mat * Gsl_permut.permut * int val solve_LU : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> [< `A of float array | `VF of Gsl_vector_flat.vector | `V of Gsl_vector.vector] -> float array val det_LU : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> float val invert_LU : ?protect:bool -> ?result:mat -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> mat (** {3 Complex LU decomposition} *) external complex_LU_decomp : cmat -> Gsl_permut.permut -> int = "ml_gsl_linalg_complex_LU_decomp" external complex_LU_solve : cmat -> Gsl_permut.permut -> b:cvec -> x:cvec -> unit = "ml_gsl_linalg_complex_LU_solve" external complex_LU_svx : cmat -> Gsl_permut.permut -> cvec -> unit = "ml_gsl_linalg_complex_LU_svx" external complex_LU_refine : a:cmat -> lu:cmat -> Gsl_permut.permut -> b:cvec -> x:cvec -> res:cvec -> unit = "ml_gsl_linalg_complex_LU_refine_bc" "ml_gsl_linalg_complex_LU_refine" external complex_LU_invert : cmat -> Gsl_permut.permut -> cmat -> unit = "ml_gsl_linalg_complex_LU_invert" external complex_LU_det : cmat -> int -> complex = "ml_gsl_linalg_complex_LU_det" external complex_LU_lndet : cmat -> float = "ml_gsl_linalg_complex_LU_lndet" external complex_LU_sgndet : cmat -> int -> complex = "ml_gsl_linalg_complex_LU_sgndet" (** {3 QR decomposition} *) external _QR_decomp : mat -> vec -> unit = "ml_gsl_linalg_QR_decomp" external _QR_solve : mat -> vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QR_solve" external _QR_svx : mat -> vec -> x:vec -> unit = "ml_gsl_linalg_QR_svx" external _QR_lssolve : mat -> vec -> b:vec -> x:vec -> res:vec -> unit = "ml_gsl_linalg_QR_lssolve" external _QR_QTvec : mat -> vec -> v:vec -> unit = "ml_gsl_linalg_QR_QTvec" external _QR_Qvec : mat -> vec -> v:vec -> unit = "ml_gsl_linalg_QR_Qvec" external _QR_Rsolve : mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QR_Rsolve" external _QR_Rsvx : mat -> x:vec -> unit = "ml_gsl_linalg_QR_Rsvx" external _QR_unpack : mat -> tau:vec -> q:mat -> r:mat -> unit = "ml_gsl_linalg_QR_unpack" external _QR_QRsolve : mat -> r:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QR_QRsolve" external _QR_update : mat -> r:mat -> w:vec -> v:vec -> unit = "ml_gsl_linalg_QR_update" external _R_solve : r:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_R_solve" (* external _R_svx : r:mat -> x:vec -> unit*) (* = "ml_gsl_linalg_R_svx"*) (** {3 QR Decomposition with Column Pivoting} *) external _QRPT_decomp : a:mat -> tau:vec -> p:Gsl_permut.permut -> norm:vec -> int = "ml_gsl_linalg_QRPT_decomp" external _QRPT_decomp2 : a:mat -> q:mat -> r:mat -> tau:vec -> p:Gsl_permut.permut -> norm:vec -> int = "ml_gsl_linalg_QRPT_decomp2_bc" "ml_gsl_linalg_QRPT_decomp2" external _QRPT_solve : qr:mat -> tau:vec -> p:Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_solve" external _QRPT_svx : qr:mat -> tau:vec -> p:Gsl_permut.permut -> x:vec -> unit = "ml_gsl_linalg_QRPT_svx" external _QRPT_QRsolve : q:mat -> r:mat -> p:Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_QRsolve" external _QRPT_update : q:mat -> r:mat -> p:Gsl_permut.permut -> u:vec -> v:vec -> unit = "ml_gsl_linalg_QRPT_update" external _QRPT_Rsolve : qr:mat -> p:Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_Rsolve" external _QRPT_Rsvx : qr:mat -> p:Gsl_permut.permut -> x:vec -> unit = "ml_gsl_linalg_QRPT_Rsolve" (** {3 Singular Value Decomposition} *) external _SV_decomp : a:mat -> v:mat -> s:vec -> work:vec -> unit = "ml_gsl_linalg_SV_decomp" external _SV_decomp_mod : a:mat -> x:mat -> v:mat -> s:vec -> work:vec -> unit = "ml_gsl_linalg_SV_decomp_mod" external _SV_decomp_jacobi : a:mat -> v:mat -> s:vec -> unit = "ml_gsl_linalg_SV_decomp_jacobi" external _SV_solve : u:mat -> v:mat -> s:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_SV_solve" (** {3 LQ decomposition} *) external _LQ_decomp : a:mat -> tau:vec -> unit = "ml_gsl_linalg_LQ_decomp" external _LQ_solve_T : lq:mat -> tau:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LQ_solve_T" external _LQ_svx_T : lq:mat -> tau:vec -> x:vec -> unit = "ml_gsl_linalg_LQ_svx_T" external _LQ_lssolve_T : lq:mat -> tau:vec -> b:vec -> x:vec -> res:vec -> unit = "ml_gsl_linalg_LQ_lssolve_T" external _LQ_Lsolve_T : lq:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LQ_Lsolve_T" external _LQ_Lsvx_T : lq:mat -> x:vec -> unit = "ml_gsl_linalg_LQ_Lsvx_T" external _L_solve_T : l:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_L_solve_T" external _LQ_vecQ : lq:mat -> tau:vec -> v:vec -> unit = "ml_gsl_linalg_LQ_vecQ" external _LQ_vecQT : lq:mat -> tau:vec -> v:vec -> unit = "ml_gsl_linalg_LQ_vecQT" external _LQ_unpack : lq:mat -> tau:vec -> q:mat -> l:mat -> unit = "ml_gsl_linalg_LQ_unpack" external _LQ_update : q:mat -> r:mat -> v:vec -> w:vec -> unit = "ml_gsl_linalg_LQ_update" external _LQ_LQsolve : q:mat -> l:mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LQ_LQsolve" (** {3 P^T L Q decomposition} *) external _PTLQ_decomp : a:mat -> tau:vec -> Gsl_permut.permut -> norm:vec -> int = "ml_gsl_linalg_PTLQ_decomp" external _PTLQ_decomp2 : a:mat -> q:mat -> r:mat -> tau:vec -> Gsl_permut.permut -> norm:vec -> int = "ml_gsl_linalg_PTLQ_decomp2_bc" "ml_gsl_linalg_PTLQ_decomp2" external _PTLQ_solve_T : qr:mat -> tau:vec -> Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_solve_T" external _PTLQ_svx_T : lq:mat -> tau:vec -> Gsl_permut.permut -> x:vec -> unit = "ml_gsl_linalg_PTLQ_svx_T" external _PTLQ_LQsolve_T : q:mat -> l:mat -> Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_LQsolve_T" external _PTLQ_Lsolve_T : lq:mat -> Gsl_permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_Lsolve_T" external _PTLQ_Lsvx_T : lq:mat -> Gsl_permut.permut -> x:vec -> unit = "ml_gsl_linalg_PTLQ_Lsvx_T" external _PTLQ_update : q:mat -> l:mat -> Gsl_permut.permut -> v:vec -> w:vec -> unit = "ml_gsl_linalg_PTLQ_update" (** {3 Cholesky decomposition} *) external cho_decomp : mat -> unit = "ml_gsl_linalg_cholesky_decomp" external cho_solve : mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_cholesky_solve" external cho_svx : mat -> vec -> unit = "ml_gsl_linalg_cholesky_svx" external cho_decomp_unit : mat -> vec -> unit = "ml_gsl_linalg_cholesky_decomp_unit" (** {3 Tridiagonal Decomposition of Real Symmetric Matrices} *) external symmtd_decomp : a:mat -> tau:vec -> unit = "ml_gsl_linalg_symmtd_decomp" external symmtd_unpack : a:mat -> tau:vec -> q:mat -> diag:vec -> subdiag:vec -> unit = "ml_gsl_linalg_symmtd_unpack" external symmtd_unpack_T : a:mat -> diag:vec -> subdiag:vec -> unit = "ml_gsl_linalg_symmtd_unpack_T" (** {3 Tridiagonal Decomposition of Hermitian Matrices} *) external hermtd_decomp : a:cmat -> tau:cvec -> unit = "ml_gsl_linalg_hermtd_decomp" external hermtd_unpack : a:cmat -> tau:cvec -> q:cmat -> diag:vec -> subdiag:vec -> unit = "ml_gsl_linalg_hermtd_unpack" external hermtd_unpack_T : a:cmat -> diag:vec -> subdiag:vec -> unit = "ml_gsl_linalg_hermtd_unpack_T" (** {3 Bidiagonalization} *) external bidiag_decomp : a:mat -> tau_u:vec -> tau_v:vec -> unit = "ml_gsl_linalg_bidiag_decomp" external bidiag_unpack : a:mat -> tau_u:vec -> u:mat -> tau_v:vec -> v:mat -> diag:vec -> superdiag:vec -> unit = "ml_gsl_linalg_bidiag_unpack_bc" "ml_gsl_linalg_bidiag_unpack" external bidiag_unpack2 : a:mat -> tau_u:vec -> tau_v:vec -> v:mat -> unit = "ml_gsl_linalg_bidiag_unpack2" external bidiag_unpack_B : a:mat -> diag:vec -> superdiag:vec -> unit = "ml_gsl_linalg_bidiag_unpack_B" (** {3 Householder solver} *) external _HH_solve : mat -> b:vec -> x:vec -> unit = "ml_gsl_linalg_HH_solve" external _HH_svx : mat -> vec -> unit = "ml_gsl_linalg_HH_svx" val solve_HH : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> [< `A of float array | `VF of Gsl_vector_flat.vector | `V of Gsl_vector.vector] -> float array (** {3 Tridiagonal Systems} *) external solve_symm_tridiag : diag:vec -> offdiag:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_solve_symm_tridiag" external solve_tridiag : diag:vec -> abovediag:vec -> belowdiag:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_solve_tridiag" external solve_symm_cyc_tridiag : diag:vec -> offdiag:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_solve_symm_cyc_tridiag" external solve_cyc_tridiag : diag:vec -> abovediag:vec -> belowdiag:vec -> b:vec -> x:vec -> unit = "ml_gsl_linalg_solve_cyc_tridiag" (** {3 Exponential} *) external _exponential : mat -> mat -> Gsl_fun.mode -> unit = "ml_gsl_linalg_exponential_ss" val exponential : ?mode:Gsl_fun.mode -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int] -> [ `M of Gsl_matrix.matrix] gsl-ocaml-1.19.1/lib/gsl_math.ml000066400000000000000000000040221262311274100163540ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let e = 2.71828182845904523536028747135 (* e *) let log2e = 1.44269504088896340735992468100 (* log_2 (e) *) let log10e = 0.43429448190325182765112891892 (* log_10 (e) *) let sqrt2 = 1.41421356237309504880168872421 (* sqrt(2) *) let sqrt1_2 = 0.70710678118654752440084436210 (* sqrt(1/2) *) let sqrt3 = 1.73205080756887729352744634151 (* sqrt(3) *) let pi = 3.14159265358979323846264338328 (* pi *) let pi_2 = 1.57079632679489661923132169164 (* pi/2 *) let pi_4 = 0.78539816339744830966156608458 (* pi/4 *) let sqrtpi = 1.77245385090551602729816748334 (* sqrt(pi) *) let i_2_sqrtpi = 1.12837916709551257389615890312 (* 2/sqrt(pi) *) let i_1_pi = 0.31830988618379067153776752675 (* 1/pi *) let i_2_pi = 0.63661977236758134307553505349 (* 2/pi *) let ln10 = 2.30258509299404568401799145468 (* ln(10) *) let ln2 = 0.69314718055994530941723212146 (* ln(2) *) let lnpi = 1.14472988584940017414342735135 (* ln(pi) *) let euler = 0.57721566490153286060651209008 (* Euler constant *) let rec unsafe_pow_int x = function | 1 -> x | n when n mod 2 = 0 -> unsafe_pow_int (x *. x) (n/2) | n -> x *. (unsafe_pow_int x (pred n)) let pow_int x = function | 0 -> 1. | n when n > 0 -> unsafe_pow_int x n | _ -> invalid_arg "pow_int" external log1p : float -> float = "ml_gsl_log1p" "gsl_log1p" "float" external expm1 : float -> float = "ml_gsl_expm1" "gsl_expm1" "float" external hypot : float -> float -> float = "ml_gsl_hypot" "gsl_hypot" "float" external acosh : float -> float = "ml_gsl_acosh" "gsl_acosh" "float" external asinh : float -> float = "ml_gsl_asinh" "gsl_asinh" "float" external atanh : float -> float = "ml_gsl_atanh" "gsl_atanh" "float" external fcmp : float -> float -> epsilon:float -> int = "ml_gsl_fcmp" gsl-ocaml-1.19.1/lib/gsl_math.mli000066400000000000000000000031621262311274100165310ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Mathematical constants and some simple functions *) (** {3 Constants} *) val e : float (** e *) val log2e : float (** log_2 (e) *) val log10e : float (** log_10 (e) *) val sqrt2 : float (** sqrt(2) *) val sqrt1_2 : float (** sqrt(1/2) *) val sqrt3 : float (** sqrt(3) *) val pi : float (** pi *) val pi_2 : float (** pi/2 *) val pi_4 : float (** pi/4 *) val sqrtpi : float (** sqrt(pi) *) val i_2_sqrtpi : float (** 2/sqrt(pi) *) val i_1_pi : float (** 1/pi *) val i_2_pi : float (** 2/pi *) val ln10 : float (** ln(10) *) val ln2 : float (** ln(2) *) val lnpi : float (** ln(pi) *) val euler : float (** Euler constant *) (** {3 Simple Functions} *) val pow_int : float -> int -> float external log1p : float -> float = "ml_gsl_log1p" "gsl_log1p" "float" external expm1 : float -> float = "ml_gsl_expm1" "gsl_expm1" "float" external hypot : float -> float -> float = "ml_gsl_hypot" "gsl_hypot" "float" external acosh : float -> float = "ml_gsl_acosh" "gsl_acosh" "float" external asinh : float -> float = "ml_gsl_asinh" "gsl_asinh" "float" external atanh : float -> float = "ml_gsl_atanh" "gsl_atanh" "float" external fcmp : float -> float -> epsilon:float -> int = "ml_gsl_fcmp" gsl-ocaml-1.19.1/lib/gsl_matrix.ml000066400000000000000000000117361262311274100167410ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Bigarray type double_mat_bigarr = (float, Bigarray.float64_elt, Bigarray.c_layout) Bigarray.Array2.t type matrix = double_mat_bigarr let create ?init dimx dimy = let barr = Array2.create float64 c_layout dimx dimy in begin match init with | None -> () | Some x -> Array2.fill barr x end ; barr let dims mat = (Array2.dim1 mat, Array2.dim2 mat) let of_array arr dim1 dim2 = let mat = create dim1 dim2 in for i=0 to pred dim1 do for j=0 to pred dim2 do mat.{i,j} <- arr.(dim2*i+j) done done ; mat let of_arrays arr = Array2.of_array float64 c_layout arr let to_array (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in Array.init (d1*d2) (fun i -> mat.{i/d2, i mod d2}) let to_arrays (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in let a = Array.init d1 (fun _ -> Array.make d2 0.) in for i=0 to pred d1 do for j=0 to pred d2 do a.(i).(j) <- mat.{i,j} done done ; a let get (m : matrix) i j = Array2.get m i j let set (m : matrix) i j x = Array2.set m i j x let set_all = Array2.fill let set_zero m = set_all m 0. let set_id m = set_zero m ; for i=0 to pred (min (Array2.dim1 m) (Array2.dim2 m)) do set m i i 1. done let memcpy ~src ~dst = Array2.blit src dst let copy m = let m' = create (Array2.dim1 m) (Array2.dim2 m) in Array2.blit m m' ; m' external add : matrix -> matrix -> unit = "ml_gsl_matrix_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_div" external scale : matrix -> float -> unit = "ml_gsl_matrix_scale" external add_constant : matrix -> float -> unit = "ml_gsl_matrix_add_constant" external add_diagonal : matrix -> float -> unit = "ml_gsl_matrix_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_transpose" let row = Array2.slice_left module Single = struct type float_mat_bigarr = (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array2.t type matrix = float_mat_bigarr let create ?init dimx dimy = let barr = Array2.create float32 c_layout dimx dimy in begin match init with | None -> () | Some x -> Array2.fill barr x end ; barr let dims = dims let of_array arr dim1 dim2 = let mat = create dim1 dim2 in for i=0 to pred dim1 do for j=0 to pred dim2 do mat.{i,j} <- arr.(dim2*i+j) done done ; mat let of_arrays arr = Array2.of_array float32 c_layout arr let to_array (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in Array.init (d1*d2) (fun i -> mat.{i/d2, i mod d2}) let to_arrays (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in let a = Array.init d1 (fun _ -> Array.make d2 0.) in for i=0 to pred d1 do for j=0 to pred d2 do a.(i).(j) <- mat.{i,j} done done ; a let get (m : matrix) i j = Array2.get m i j let set (m : matrix) i j x = Array2.set m i j x let set_all = set_all let set_zero = set_zero let set_id m = set_zero m ; for i=0 to pred (min (Array2.dim1 m) (Array2.dim2 m)) do set m i i 1. done let memcpy = memcpy let copy m = let m' = create (Array2.dim1 m) (Array2.dim2 m) in Array2.blit m m' ; m' let row = row external add : matrix -> matrix -> unit = "ml_gsl_matrix_float_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_float_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_float_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_float_div" external scale : matrix -> float -> unit = "ml_gsl_matrix_float_scale" external add_constant : matrix -> float -> unit = "ml_gsl_matrix_float_add_constant" external add_diagonal : matrix -> float -> unit = "ml_gsl_matrix_float_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_float_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_float_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_float_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_float_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_float_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_float_transpose" end gsl-ocaml-1.19.1/lib/gsl_matrix.mli000066400000000000000000000072121262311274100171040ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Matrices of floats implemented with [Bigarray] *) type double_mat_bigarr = (float, Bigarray.float64_elt, Bigarray.c_layout) Bigarray.Array2.t type matrix = double_mat_bigarr val create : ?init:float -> int -> int -> matrix val dims : matrix -> int * int val of_array : float array -> int -> int -> matrix val of_arrays : float array array -> matrix val to_array : matrix -> float array val to_arrays : matrix -> float array array val get : matrix -> int -> int -> float val set : matrix -> int -> int -> float -> unit val set_all : matrix -> float -> unit val set_zero : matrix -> unit val set_id : matrix -> unit val memcpy : src:matrix -> dst:matrix -> unit val copy : matrix -> matrix val row : matrix -> int -> Gsl_vector.vector external add : matrix -> matrix -> unit = "ml_gsl_matrix_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_div" external scale : matrix -> float -> unit = "ml_gsl_matrix_scale" external add_constant : matrix -> float -> unit = "ml_gsl_matrix_add_constant" external add_diagonal : matrix -> float -> unit = "ml_gsl_matrix_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_transpose" module Single : sig type float_mat_bigarr = (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array2.t type matrix = float_mat_bigarr val create : ?init:float -> int -> int -> matrix val dims : matrix -> int * int val of_array : float array -> int -> int -> matrix val of_arrays : float array array -> matrix val to_array : matrix -> float array val to_arrays : matrix -> float array array val get : matrix -> int -> int -> float val set : matrix -> int -> int -> float -> unit val set_all : matrix -> float -> unit val set_zero : matrix -> unit val set_id : matrix -> unit val memcpy : src:matrix -> dst:matrix -> unit val copy : matrix -> matrix val row : matrix -> int -> Gsl_vector.Single.vector external add : matrix -> matrix -> unit = "ml_gsl_matrix_float_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_float_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_float_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_float_div" external scale : matrix -> float -> unit = "ml_gsl_matrix_float_scale" external add_constant : matrix -> float -> unit = "ml_gsl_matrix_float_add_constant" external add_diagonal : matrix -> float -> unit = "ml_gsl_matrix_float_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_float_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_float_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_float_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_float_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_float_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_float_transpose" end gsl-ocaml-1.19.1/lib/gsl_matrix_complex.ml000066400000000000000000000144771262311274100204750ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Bigarray open Gsl_complex type complex_mat_bigarr = (Complex.t, Bigarray.complex64_elt, Bigarray.c_layout) Bigarray.Array2.t type matrix = complex_mat_bigarr let create ?init dimx dimy = let barr = Array2.create complex64 c_layout dimx dimy in begin match init with | None -> () | Some x -> Array2.fill barr x end ; barr let dims mat = (Array2.dim1 mat, Array2.dim2 mat) let of_array arr dim1 dim2 = let mat = create dim1 dim2 in for i=0 to pred dim1 do for j=0 to pred dim2 do mat.{i,j} <- arr.(dim2*i+j) done done ; mat let of_complex_array arr dim1 dim2 = let mat = create dim1 dim2 in for i=0 to pred dim1 do for j=0 to pred dim2 do let k = 2 * (dim2*i+j) in mat.{i,j} <- complex ~re:arr.(k) ~im:arr.(k+1) done done ; mat let of_arrays arr = Array2.of_array complex64 c_layout arr let to_array (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in Array.init (d1*d2) (fun i -> mat.{i/d2, i mod d2}) let to_complex_array (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in let arr = Array.make (2*d1*d2) 0. in for i=0 to pred (d1*d2) do let { re = re; im = im } = mat.{i/d2, i mod d2} in arr.(2*i) <- re ; arr.(2*i+1) <- im done ; arr let to_arrays (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in let a = Array.init d1 (fun _ -> Array.make d2 Complex.zero) in for i=0 to pred d1 do for j=0 to pred d2 do a.(i).(j) <- mat.{i,j} done done ; a let get (m : matrix) i j = Array2.get m i j let set (m : matrix) i j x = Array2.set m i j x let set_all = Array2.fill let set_zero m = set_all m Complex.zero let set_id m = set_zero m ; for i=0 to pred (min (Array2.dim1 m) (Array2.dim2 m)) do set m i i Complex.one done let memcpy ~src ~dst = Array2.blit src dst let copy m = let m' = create (Array2.dim1 m) (Array2.dim2 m) in Array2.blit m m' ; m' let row = Array2.slice_left external add : matrix -> matrix -> unit = "ml_gsl_matrix_complex_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_complex_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_div" external scale : matrix -> complex -> unit = "ml_gsl_matrix_complex_scale" external add_constant : matrix -> complex -> unit = "ml_gsl_matrix_complex_add_constant" external add_diagonal : matrix -> complex -> unit = "ml_gsl_matrix_complex_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_complex_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_complex_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_complex_transpose" module Single = struct type complex_float_mat_bigarr = (Complex.t, Bigarray.complex32_elt, Bigarray.c_layout) Bigarray.Array2.t type matrix = complex_float_mat_bigarr let create ?init dimx dimy = let barr = Array2.create complex32 c_layout dimx dimy in begin match init with | None -> () | Some x -> Array2.fill barr x end ; barr let dims = dims let of_array arr dim1 dim2 = let mat = create dim1 dim2 in for i=0 to pred dim1 do for j=0 to pred dim2 do mat.{i,j} <- arr.(dim2*i+j) done done ; mat let of_complex_array arr dim1 dim2 = let mat = create dim1 dim2 in for i=0 to pred dim1 do for j=0 to pred dim2 do let k = 2 * (dim2*i+j) in mat.{i,j} <- complex ~re:arr.(k) ~im:arr.(k+1) done done ; mat let of_arrays arr = Array2.of_array complex32 c_layout arr let to_array (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in Array.init (d1*d2) (fun i -> mat.{i/d2, i mod d2}) let to_complex_array (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in let arr = Array.make (2*d1*d2) 0. in for i=0 to pred (d1*d2) do let { re = re; im = im } = mat.{i/d2, i mod d2} in arr.(2*i) <- re ; arr.(2*i+1) <- im done ; arr let to_arrays (mat : matrix) = let d1 = Array2.dim1 mat in let d2 = Array2.dim2 mat in let a = Array.init d1 (fun _ -> Array.make d2 Complex.zero) in for i=0 to pred d1 do for j=0 to pred d2 do a.(i).(j) <- mat.{i,j} done done ; a let get (m : matrix) i j = Array2.get m i j let set (m : matrix) i j x = Array2.set m i j x let set_all = set_all let set_zero = set_zero let set_id m = set_zero m ; for i=0 to pred (min (Array2.dim1 m) (Array2.dim2 m)) do set m i i Complex.one done let memcpy = memcpy let copy m = let m' = create (Array2.dim1 m) (Array2.dim2 m) in Array2.blit m m' ; m' let row = row external add : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_div" external scale : matrix -> complex -> unit = "ml_gsl_matrix_complex_float_scale" external add_constant : matrix -> complex -> unit = "ml_gsl_matrix_complex_float_add_constant" external add_diagonal : matrix -> complex -> unit = "ml_gsl_matrix_complex_float_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_complex_float_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_float_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_float_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_float_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_complex_float_transpose" end gsl-ocaml-1.19.1/lib/gsl_matrix_complex.mli000066400000000000000000000102051262311274100206270ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Matrices of complex numbers implemented with [Bigarray] *) open Bigarray open Gsl_complex type complex_mat_bigarr = (Complex.t, complex64_elt, c_layout) Array2.t type matrix = complex_mat_bigarr val create : ?init:complex -> int -> int -> matrix val dims : matrix -> int * int val of_array : complex array -> int -> int -> matrix val of_arrays : complex array array -> matrix val to_array : matrix -> complex array val to_arrays : matrix -> complex array array val of_complex_array : complex_array -> int -> int -> matrix val to_complex_array : matrix -> complex_array val get : matrix -> int -> int -> complex val set : matrix -> int -> int -> complex -> unit val set_all : matrix -> complex -> unit val set_zero : matrix -> unit val set_id : matrix -> unit val memcpy : src:matrix -> dst:matrix -> unit val copy : matrix -> matrix val row : matrix -> int -> Gsl_vector_complex.vector external add : matrix -> matrix -> unit = "ml_gsl_matrix_complex_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_complex_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_div" external scale : matrix -> complex -> unit = "ml_gsl_matrix_complex_scale" external add_constant : matrix -> complex -> unit = "ml_gsl_matrix_complex_add_constant" external add_diagonal : matrix -> complex -> unit = "ml_gsl_matrix_complex_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_complex_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_complex_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_complex_transpose" module Single : sig type complex_float_mat_bigarr = (Complex.t, complex32_elt, c_layout) Array2.t type matrix = complex_float_mat_bigarr val create : ?init:complex -> int -> int -> matrix val dims : matrix -> int * int val of_array : complex array -> int -> int -> matrix val of_arrays : complex array array -> matrix val to_array : matrix -> complex array val to_arrays : matrix -> complex array array val of_complex_array : complex_array -> int -> int -> matrix val to_complex_array : matrix -> complex_array val get : matrix -> int -> int -> complex val set : matrix -> int -> int -> complex -> unit val set_all : matrix -> complex -> unit val set_zero : matrix -> unit val set_id : matrix -> unit val memcpy : src:matrix -> dst:matrix -> unit val copy : matrix -> matrix val row : matrix -> int -> Gsl_vector_complex.Single.vector external add : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_div" external scale : matrix -> complex -> unit = "ml_gsl_matrix_complex_float_scale" external add_constant : matrix -> complex -> unit = "ml_gsl_matrix_complex_float_add_constant" external add_diagonal : matrix -> complex -> unit = "ml_gsl_matrix_complex_float_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_complex_float_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_float_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_float_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_float_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_complex_float_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_complex_float_transpose" end gsl-ocaml-1.19.1/lib/gsl_matrix_complex_flat.ml000066400000000000000000000132621262311274100214720ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type complex_mat_flat = { data : float array ; off : int ; dim1 : int ; dim2 : int ; tda : int ; } type matrix = complex_mat_flat open Gsl_complex let create ?(init=Complex.zero) dim1 dim2 = let mat = { data = Array.make (2 * dim1 * dim2) init.Complex.re ; off = 0 ; dim1 = dim1 ; dim2 = dim2 ; tda = dim2 } in if init.Complex.im <> init.Complex.re then for i=0 to pred (dim1*dim2) do mat.data.(2*i+1) <- init.Complex.im done ; mat let dims mat = (mat.dim1, mat.dim2) let get m i j = let k = 2 * (m.off + i*m.tda + j) in complex ~re:m.data.(k) ~im:m.data.(k+1) let set m i j c = let k = 2 * (m.off + i*m.tda + j) in m.data.(k) <- c.re ; m.data.(k+1) <- c.im let of_arrays arr = let dim1 = Array.length arr in if dim1 = 0 then invalid_arg "of_arrays" ; let dim2 = Array.length arr.(0) in let tab = Array.make (2 * dim1 * dim2) 0. in let mat = { data = tab ; off = 0 ; dim1 = dim1 ; dim2 = dim2 ; tda = dim2 } in for i=0 to pred dim1 do let a = arr.(i) in for j=0 to pred dim2 do set mat i j a.(j) done done ; mat let to_arrays mat = let arr = Array.make_matrix mat.dim1 mat.dim2 Complex.zero in for i=0 to pred mat.dim1 do let a = arr.(i) in for j=0 to pred mat.dim2 do a.(j) <- get mat i j done done ; arr let of_array arr dim1 dim2 = let len = Array.length arr in if dim1 * dim2 <> len then invalid_arg "of_array" ; let tab = Array.make (2 * dim1 * dim2) 0. in let mat = { data = tab ; off = 0 ; dim1 = dim1 ; dim2 = dim2 ; tda = dim2 } in for i=0 to pred dim1 do for j=0 to pred dim2 do set mat i j arr.(i*dim2+j) done done ; mat let to_array mat = let arr = Array.make (mat.dim1 * mat.dim2) Complex.zero in for i=0 to pred mat.dim1 do for j=0 to pred mat.dim2 do arr.(i*mat.dim2+j) <- get mat i j done done ; arr let of_complex_array arr dim1 dim2 = let len = Array.length arr in if 2 * dim1 * dim2 <> len then invalid_arg "of_array" ; { data = Array.copy arr ; off = 0 ; dim1 = dim1 ; dim2 = dim2 ; tda = dim2 } let to_complex_array mat = if mat.tda = mat.dim2 && mat.off = 0 then Array.copy mat.data else begin let tab = Array.make (2*mat.dim1*mat.dim2) 0. in for i=0 to pred mat.dim1 do for j=0 to pred mat.dim2 do Gsl_complex.set tab (i*mat.dim2 + j) (get mat i j) done done ; tab end let set_all m c = for i=0 to pred m.dim1 do for j=0 to pred m.dim2 do set m i j c done done let set_zero m = set_all m Complex.zero let set_id m = set_zero m ; for i=0 to pred (min m.dim1 m.dim2) do set m i i Complex.one done let memcpy ~src:m ~dst:m' = if m.dim1 <> m'.dim1 || m.dim2 <> m'.dim2 then invalid_arg "wrong dimensions" ; for i=0 to pred m.dim1 do Array.blit m.data (2 * (m.off + i*m.tda)) m'.data (2 * (m'.off + i*m'.tda)) (2 * m.dim2) done let copy m = let m' = create m.dim1 m.dim2 in memcpy ~src:m ~dst:m'; m' let submatrix m ~k1 ~k2 ~n1 ~n2 = { m with off = m.off + (k1*m.tda)+k2 ; dim1 = n1 ; dim2 = n2 ; tda = m.tda ; } let view_complex_array arr ?(off=0) dim1 ?tda dim2 = let tda = match tda with | None -> dim2 | Some v -> v in let len = Array.length arr in if dim1 * tda > len/2 - off || dim2 > tda then invalid_arg "view_array" ; { data = arr; off = off; dim1 = dim1; dim2 = dim2; tda = tda } external add : matrix -> matrix -> unit = "ml_gsl_matrix_complex_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_complex_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_div" external scale : matrix -> float -> unit = "ml_gsl_matrix_complex_scale" external add_constant : matrix -> float -> unit = "ml_gsl_matrix_complex_add_constant" external add_diagonal : matrix -> complex -> unit = "ml_gsl_matrix_complex_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_complex_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_complex_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_complex_transpose" let row m i = Gsl_vector_complex_flat.view_complex_array ~off:(m.off + i * m.tda) ~len:m.dim2 m.data let column m j = Gsl_vector_complex_flat.view_complex_array ~stride:m.tda ~off:(m.off + j) ~len:m.dim1 m.data let diagonal m = Gsl_vector_complex_flat.view_complex_array ~stride:(m.tda + 1) ~off:m.off ~len:(min m.dim1 m.dim2) m.data let subdiagonal m k = Gsl_vector_complex_flat.view_complex_array ~stride:(m.tda + 1) ~off:(m.off + k * m.tda) ~len:(min (m.dim1 - k) m.dim2) m.data let superdiagonal m k = Gsl_vector_complex_flat.view_complex_array ~stride:(m.tda + 1) ~off:(m.off + k) ~len:(min m.dim1 (m.dim2 - k)) m.data let view_vector v ?(off=0) dim1 ?tda dim2 = let tda = match tda with | None -> dim2 | Some v -> v in let len = Gsl_vector_complex_flat.length v in if dim1 * tda > len - off || dim2 > tda then invalid_arg "view_vector" ; { data = v.Gsl_vector_complex_flat.data; off = v.Gsl_vector_complex_flat.off + off; dim1 = dim1; dim2 = dim2; tda = tda } gsl-ocaml-1.19.1/lib/gsl_matrix_complex_flat.mli000066400000000000000000000050541262311274100216430ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Matrices of complex number simplemented with [float array] *) type complex_mat_flat = private { data : float array; off : int; dim1 : int; dim2 : int; tda : int; } type matrix = complex_mat_flat open Gsl_complex val create : ?init:complex -> int -> int -> matrix val dims : matrix -> int * int val of_arrays : complex array array -> matrix val of_array : complex array -> int -> int -> matrix val to_arrays : matrix -> complex array array val to_array : matrix -> complex array val of_complex_array : float array -> int -> int -> matrix val to_complex_array : matrix -> complex_array val get : matrix -> int -> int -> complex val set : matrix -> int -> int -> complex -> unit val set_all : matrix -> complex -> unit val set_zero : matrix -> unit val set_id : matrix -> unit val memcpy : src:matrix -> dst:matrix -> unit val copy : matrix -> matrix external add : matrix -> matrix -> unit = "ml_gsl_matrix_complex_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_complex_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_complex_div" external scale : matrix -> float -> unit = "ml_gsl_matrix_complex_scale" external add_constant : matrix -> float -> unit = "ml_gsl_matrix_complex_add_constant" external add_diagonal : matrix -> complex -> unit = "ml_gsl_matrix_complex_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_complex_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_complex_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_complex_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_complex_transpose" open Gsl_vector_complex_flat val submatrix : matrix -> k1:int -> k2:int -> n1:int -> n2:int -> matrix val row : matrix -> int -> vector val column : matrix -> int -> vector val diagonal : matrix -> vector val subdiagonal : matrix -> int -> vector val superdiagonal : matrix -> int -> vector val view_complex_array : complex_array -> ?off:int -> int -> ?tda:int -> int -> matrix val view_vector : vector -> ?off:int -> int -> ?tda:int -> int -> matrix gsl-ocaml-1.19.1/lib/gsl_matrix_flat.ml000066400000000000000000000107671262311274100177520ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type double_mat_flat = { data : float array ; off : int ; dim1 : int ; dim2 : int ; tda : int ; } type matrix = double_mat_flat let create ?(init=0.) dim1 dim2 = { data = Array.make (dim1 * dim2) init ; off = 0 ; dim1 = dim1 ; dim2 = dim2 ; tda = dim2 } let dims mat = (mat.dim1, mat.dim2) let of_arrays arr = let dim1 = Array.length arr in if dim1 = 0 then invalid_arg "of_arrays" ; let dim2 = Array.length arr.(0) in let tab = Array.make (dim1 * dim2) 0. in Array.iteri (fun i a -> if Array.length a <> dim2 then invalid_arg "of_arrays" ; Array.blit a 0 tab (i * dim2) dim2) arr ; { data = tab ; off = 0 ; dim1 = dim1 ; dim2 = dim2 ; tda = dim2 } let to_array mat = if mat.tda = mat.dim2 && mat.off = 0 then Array.copy mat.data else begin let arr = Array.make (mat.dim1 * mat.dim2) 0. in for i=0 to pred mat.dim1 do Array.blit mat.data (mat.off + i * mat.tda) arr (i*mat.dim2) mat.dim2 done ; arr end let to_arrays mat = let arr = Array.make_matrix mat.dim1 mat.dim2 0. in for i=0 to pred mat.dim1 do Array.blit mat.data (mat.off + i * mat.tda) arr.(i) 0 mat.dim2 done ; arr let of_array arr dim1 dim2 = let len = Array.length arr in if dim1 * dim2 <> len then invalid_arg "of_array" ; { data = Array.copy arr; off = 0 ; dim1 = dim1 ; dim2 = dim2; tda = dim2 } let get m i j = m.data.(m.off + i*m.tda + j) let set m i j x = m.data.(m.off + i*m.tda + j) <- x let set_all m x = for i=0 to pred m.dim1 do Array.fill m.data (m.off + i*m.tda) m.dim2 x done let set_zero m = set_all m 0. let set_id m = set_zero m ; for i=0 to pred (min m.dim1 m.dim2) do set m i i 1. done let memcpy ~src:m ~dst:m' = if m.dim1 <> m'.dim1 || m.dim2 <> m'.dim2 then invalid_arg "wrong dimensions" ; for i=0 to pred m.dim1 do Array.blit m.data (m.off + i*m.tda) m'.data (m'.off + i*m'.tda) m.dim2 done let copy m = let m' = create m.dim1 m.dim2 in memcpy ~src:m ~dst:m'; m' let submatrix m ~k1 ~k2 ~n1 ~n2 = { m with off = m.off + (k1*m.tda)+k2 ; dim1 = n1 ; dim2 = n2 ; tda = m.tda ; } let row m i = Gsl_vector_flat.view_array ~off:(m.off + i * m.tda) ~len:m.dim2 m.data let column m j = Gsl_vector_flat.view_array ~stride:m.tda ~off:(m.off + j) ~len:m.dim1 m.data let diagonal m = Gsl_vector_flat.view_array ~stride:(m.tda + 1) ~off:m.off ~len:(min m.dim1 m.dim2) m.data let subdiagonal m k = Gsl_vector_flat.view_array ~stride:(m.tda + 1) ~off:(m.off + k * m.tda) ~len:(min (m.dim1 - k) m.dim2) m.data let superdiagonal m k = Gsl_vector_flat.view_array ~stride:(m.tda + 1) ~off:(m.off + k) ~len:(min m.dim1 (m.dim2 - k)) m.data let view_array arr ?(off=0) dim1 ?tda dim2 = let tda = match tda with | None -> dim2 | Some v -> v in let len = Array.length arr in if dim1 * tda > len - off || dim2 > tda then invalid_arg "view_array" ; { data = arr; off = off; dim1 = dim1; dim2 = dim2; tda = tda } let view_vector v ?(off=0) dim1 ?tda dim2 = let tda = match tda with | None -> dim2 | Some v -> v in let len = Gsl_vector_flat.length v in if dim1 * tda > len - off || dim2 > tda then invalid_arg "view_vector" ; { data = v.Gsl_vector_flat.data; off = v.Gsl_vector_flat.off + off; dim1 = dim1; dim2 = dim2; tda = tda } external add : matrix -> matrix -> unit = "ml_gsl_matrix_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_div" external scale : matrix -> float -> unit = "ml_gsl_matrix_scale" external add_constant : matrix -> float -> unit = "ml_gsl_matrix_add_constant" external add_diagonal : matrix -> float -> unit = "ml_gsl_matrix_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_transpose" gsl-ocaml-1.19.1/lib/gsl_matrix_flat.mli000066400000000000000000000044441262311274100201160ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Matrices of floats implemented with [float array] *) type double_mat_flat = private { data : float array ; off : int ; dim1 : int ; dim2 : int ; tda : int ; } type matrix = double_mat_flat val create : ?init:float -> int -> int -> matrix val dims : matrix -> int * int val of_array : float array -> int -> int -> matrix val of_arrays : float array array -> matrix val to_array : matrix -> float array val to_arrays : matrix -> float array array val get : matrix -> int -> int -> float val set : matrix -> int -> int -> float -> unit val set_all : matrix -> float -> unit val set_zero : matrix -> unit val set_id : matrix -> unit val memcpy : src:matrix -> dst:matrix -> unit val copy : matrix -> matrix external add : matrix -> matrix -> unit = "ml_gsl_matrix_add" external sub : matrix -> matrix -> unit = "ml_gsl_matrix_sub" external mul_elements : matrix -> matrix -> unit = "ml_gsl_matrix_mul" external div_elements : matrix -> matrix -> unit = "ml_gsl_matrix_div" external scale : matrix -> float -> unit = "ml_gsl_matrix_scale" external add_constant : matrix -> float -> unit = "ml_gsl_matrix_add_constant" external add_diagonal : matrix -> float -> unit = "ml_gsl_matrix_add_diagonal" external is_null : matrix -> bool = "ml_gsl_matrix_isnull" external swap_rows : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_rows" external swap_columns : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_columns" external swap_rowcol : matrix -> int -> int -> unit = "ml_gsl_matrix_swap_rowcol" external transpose : matrix -> matrix -> unit = "ml_gsl_matrix_transpose_memcpy" external transpose_in_place : matrix -> unit = "ml_gsl_matrix_transpose" open Gsl_vector_flat val submatrix : matrix -> k1:int -> k2:int -> n1:int -> n2:int -> matrix val row : matrix -> int -> vector val column : matrix -> int -> vector val diagonal : matrix -> vector val subdiagonal : matrix -> int -> vector val superdiagonal : matrix -> int -> vector val view_array : float array -> ?off:int -> int -> ?tda:int -> int -> matrix val view_vector : vector -> ?off:int -> int -> ?tda:int -> int -> matrix gsl-ocaml-1.19.1/lib/gsl_min.ml000066400000000000000000000017441262311274100162160ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type kind = | GOLDENSECTION | BRENT type t external _alloc : kind -> t = "ml_gsl_min_fminimizer_alloc" external _free : t -> unit = "ml_gsl_min_fminimizer_free" external _set : t -> Gsl_fun.gsl_fun -> min:float -> lo:float -> up:float -> unit = "ml_gsl_min_fminimizer_set" let make k f ~min ~lo ~up = let m = _alloc k in Gc.finalise _free m ; _set m f ~min ~lo ~up ; m external name : t -> string = "ml_gsl_min_fminimizer_name" external iterate : t -> unit = "ml_gsl_min_fminimizer_iterate" external minimum : t -> float = "ml_gsl_min_fminimizer_x_minimum" external interval : t -> float * float = "ml_gsl_min_fminimizer_x_interv" external test_interval : x_lo:float -> x_up:float -> epsabs:float -> epsrel:float -> bool = "ml_gsl_min_test_interval" gsl-ocaml-1.19.1/lib/gsl_min.mli000066400000000000000000000013701262311274100163620ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** One dimensional Minimization *) type kind = | GOLDENSECTION | BRENT type t val make : kind -> Gsl_fun.gsl_fun -> min:float -> lo:float -> up:float -> t external name : t -> string = "ml_gsl_min_fminimizer_name" external iterate : t -> unit = "ml_gsl_min_fminimizer_iterate" external minimum : t -> float = "ml_gsl_min_fminimizer_x_minimum" external interval : t -> float * float = "ml_gsl_min_fminimizer_x_interv" external test_interval : x_lo:float -> x_up:float -> epsabs:float -> epsrel:float -> bool = "ml_gsl_min_test_interval" gsl-ocaml-1.19.1/lib/gsl_misc.ml000066400000000000000000000007131262311274100163610ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let maybe_or_else o def = match o with | None -> def | Some v -> v let may vo f = match vo with | None -> () | Some v -> f v let may_apply fo v = match fo with | None -> () | Some f -> f v let is = function | None -> false | Some _ -> true gsl-ocaml-1.19.1/lib/gsl_monte.ml000066400000000000000000000070341262311274100165530ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_fun (* PLAIN algorithm *) type plain_state external _alloc_plain : int -> plain_state = "ml_gsl_monte_plain_alloc" external _free_plain : plain_state -> unit = "ml_gsl_monte_plain_free" let make_plain_state s = let state = _alloc_plain s in Gc.finalise _free_plain state ; state external init_plain : plain_state -> unit = "ml_gsl_monte_plain_init" external integrate_plain : monte_fun -> lo:float array -> up:float array -> int -> Gsl_rng.t -> plain_state -> Gsl_fun.result = "ml_gsl_monte_plain_integrate_bc" "ml_gsl_monte_plain_integrate" (* MISER algorithm *) type miser_state type miser_params = { estimate_frac : float ; (* 0.1 *) min_calls : int ; (* 16 * dim *) min_calls_per_bisection : int ; (* 32 * min_calls *) miser_alpha : float ; (* 2. *) dither : float ; (* 0. *) } external _alloc_miser : int -> miser_state = "ml_gsl_monte_miser_alloc" external _free_miser : miser_state -> unit = "ml_gsl_monte_miser_free" let make_miser_state s = let state = _alloc_miser s in Gc.finalise _free_miser state ; state external init_miser : miser_state -> unit = "ml_gsl_monte_miser_init" external integrate_miser : monte_fun -> lo:float array -> up:float array -> int -> Gsl_rng.t -> miser_state -> Gsl_fun.result = "ml_gsl_monte_miser_integrate_bc" "ml_gsl_monte_miser_integrate" external get_miser_params : miser_state -> miser_params = "ml_gsl_monte_miser_get_params" external set_miser_params : miser_state -> miser_params -> unit = "ml_gsl_monte_miser_set_params" (* VEGAS algorithm *) type vegas_state type vegas_info = { result : float ; sigma : float ; chisq : float ; } type vegas_mode = | STRATIFIED | IMPORTANCE_ONLY | IMPORTANCE type vegas_params = { vegas_alpha : float ; (* 1.5 *) iterations : int ; (* 5 *) stage : int ; mode : vegas_mode ; verbose : int ; (* 0 *) ostream : out_channel option ; (* stdout *) } external _alloc_vegas : int -> vegas_state = "ml_gsl_monte_vegas_alloc" external _free_vegas : vegas_state -> unit = "ml_gsl_monte_vegas_free" let make_vegas_state s = let state = _alloc_vegas s in Gc.finalise _free_vegas state ; state external init_vegas : vegas_state -> unit = "ml_gsl_monte_vegas_init" external integrate_vegas : monte_fun -> lo:float array -> up:float array -> int -> Gsl_rng.t -> vegas_state -> Gsl_fun.result = "ml_gsl_monte_vegas_integrate_bc" "ml_gsl_monte_vegas_integrate" external get_vegas_info : vegas_state -> vegas_info = "ml_gsl_monte_vegas_get_info" external get_vegas_params : vegas_state -> vegas_params = "ml_gsl_monte_vegas_get_params" external set_vegas_params : vegas_state -> vegas_params -> unit = "ml_gsl_monte_vegas_set_params" (* High-level version *) type kind = | PLAIN | MISER | VEGAS let integrate kind f ~lo ~up calls rng = let dim = Array.length lo in let with_state alloc free integ = let state = alloc dim in try let res = integ f ~lo ~up calls rng state in free state ; res with exn -> free state ; raise exn in match kind with | PLAIN -> with_state _alloc_plain _free_plain integrate_plain | MISER -> with_state _alloc_miser _free_miser integrate_miser | VEGAS -> with_state _alloc_vegas _free_vegas integrate_vegas gsl-ocaml-1.19.1/lib/gsl_monte.mli000066400000000000000000000050571262311274100167270ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Gsl_monte Carlo Integration *) open Gsl_fun (** {3 High-level interface} *) type kind = | PLAIN | MISER | VEGAS val integrate : kind -> monte_fun -> lo:float array -> up:float array -> int -> Gsl_rng.t -> Gsl_fun.result (** {3 Low-level interface} *) (** {4 PLAIN algorithm} *) type plain_state val make_plain_state : int -> plain_state external init_plain : plain_state -> unit = "ml_gsl_monte_plain_init" external integrate_plain : monte_fun -> lo:float array -> up:float array -> int -> Gsl_rng.t -> plain_state -> Gsl_fun.result = "ml_gsl_monte_plain_integrate_bc" "ml_gsl_monte_plain_integrate" (** {4 MISER algorithm} *) type miser_state type miser_params = { estimate_frac : float; min_calls : int; min_calls_per_bisection : int; miser_alpha : float; dither : float; } val make_miser_state : int -> miser_state external init_miser : miser_state -> unit = "ml_gsl_monte_miser_init" external integrate_miser : monte_fun -> lo:float array -> up:float array -> int -> Gsl_rng.t -> miser_state -> Gsl_fun.result = "ml_gsl_monte_miser_integrate_bc" "ml_gsl_monte_miser_integrate" external get_miser_params : miser_state -> miser_params = "ml_gsl_monte_miser_get_params" external set_miser_params : miser_state -> miser_params -> unit = "ml_gsl_monte_miser_set_params" (** {4 VEGAS algorithm} *) type vegas_state type vegas_info = { result : float ; sigma : float ; chisq : float ; } type vegas_mode = | STRATIFIED | IMPORTANCE_ONLY | IMPORTANCE type vegas_params = { vegas_alpha : float ; (** 1.5 *) iterations : int ; (** 5 *) stage : int ; mode : vegas_mode ; verbose : int ; ostream : out_channel option ; } val make_vegas_state : int -> vegas_state external init_vegas : vegas_state -> unit = "ml_gsl_monte_vegas_init" external integrate_vegas : monte_fun -> lo:float array -> up:float array -> int -> Gsl_rng.t -> vegas_state -> Gsl_fun.result = "ml_gsl_monte_vegas_integrate_bc" "ml_gsl_monte_vegas_integrate" external get_vegas_info : vegas_state -> vegas_info = "ml_gsl_monte_vegas_get_info" external get_vegas_params : vegas_state -> vegas_params = "ml_gsl_monte_vegas_get_params" external set_vegas_params : vegas_state -> vegas_params -> unit = "ml_gsl_monte_vegas_set_params" gsl-ocaml-1.19.1/lib/gsl_multifit.ml000066400000000000000000000033001262311274100172560ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_vectmat type ws external alloc_ws : int -> int -> ws = "ml_gsl_multifit_linear_alloc" external free_ws : ws -> unit = "ml_gsl_multifit_linear_free" let make ~n ~p = let ws = alloc_ws n p in Gc.finalise free_ws ws ; ws external _linear : ?weight:vec -> x:mat -> y:vec -> c:vec -> cov:mat -> ws -> float = "ml_gsl_multifit_linear_bc" "ml_gsl_multifit_linear" let linear ?weight x y = let (n,p) = Gsl_vectmat.dims x in let dy = Gsl_vectmat.length y in if dy <> n then invalid_arg "Gsl_multifit.linear: wrong dimensions" ; Gsl_misc.may weight (fun w -> if Gsl_vectmat.length w <> n then invalid_arg "Gsl_multifit.linear: wrong dimensions") ; let c = Gsl_vector.create p in let cov = Gsl_matrix.create p p in let ws = alloc_ws n p in try let chisq = _linear ?weight ~x ~y ~c:(`V c) ~cov:(`M cov) ws in free_ws ws ; (c, cov, chisq) with exn -> free_ws ws ; raise exn external linear_est : x:vec -> c:vec -> cov:mat -> Gsl_fun.result = "ml_gsl_multifit_linear_est" let fit_poly ?weight ~x ~y order = let n = Array.length y in let x_mat = Gsl_matrix.create n (succ order) in for i=0 to pred n do let xi = x.(i) in for j=0 to order do x_mat.{i, j} <- Gsl_math.pow_int xi j done done ; let weight = match weight with | None -> None | Some a -> Some (vec_convert (`A a)) in let (c, cov, chisq) = linear ?weight (`M x_mat) (vec_convert (`A y)) in (Gsl_vector.to_array c, Gsl_matrix.to_arrays cov, chisq) gsl-ocaml-1.19.1/lib/gsl_multifit.mli000066400000000000000000000014041262311274100174320ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Multi-parameter Least-Squares Fitting *) open Gsl_vectmat type ws val make : n:int -> p:int -> ws external _linear : ?weight:vec -> x:mat -> y:vec -> c:vec -> cov:mat -> ws -> float = "ml_gsl_multifit_linear_bc" "ml_gsl_multifit_linear" val linear : ?weight:vec -> mat -> vec -> Gsl_vector.vector * Gsl_matrix.matrix * float external linear_est : x:vec -> c:vec -> cov:mat -> Gsl_fun.result = "ml_gsl_multifit_linear_est" val fit_poly : ?weight:float array -> x:float array -> y:float array -> int -> float array * float array array * float gsl-ocaml-1.19.1/lib/gsl_multifit_nlin.ml000066400000000000000000000024161262311274100203050ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_fun open Gsl_vector type t type kind = | LMSDER | LMDER external _alloc : kind -> n:int -> p:int -> t = "ml_gsl_multifit_fdfsolver_alloc" external _free : t -> unit = "ml_gsl_multifit_fdfsolver_free" external _set : t -> multi_fun_fdf -> vector -> unit = "ml_gsl_multifit_fdfsolver_set" let make kind ~n ~p gf x = let s = _alloc kind ~n ~p in Gc.finalise _free s ; _set s gf x ; s external name : t -> string = "ml_gsl_multifit_fdfsolver_name" external iterate : t -> unit = "ml_gsl_multifit_fdfsolver_iterate" external position : t -> vector -> unit = "ml_gsl_multifit_fdfsolver_position" external get_state : t -> ?x:vector -> ?f:vector -> ?dx:vector -> unit -> unit = "ml_gsl_multifit_fdfsolver_get_state" external test_delta : t -> epsabs:float -> epsrel:float -> bool = "ml_gsl_multifit_test_delta" external test_gradient : t -> Gsl_matrix.matrix -> epsabs:float -> vector -> bool = "ml_gsl_multifit_test_gradient" external covar : Gsl_matrix.matrix -> epsrel:float -> Gsl_matrix.matrix -> unit = "ml_gsl_multifit_covar" gsl-ocaml-1.19.1/lib/gsl_multifit_nlin.mli000066400000000000000000000020351262311274100204530ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Nonlinear Least-Squares Fitting *) open Gsl_fun open Gsl_vector type t type kind = | LMSDER | LMDER val make : kind -> n:int -> p:int -> multi_fun_fdf -> vector -> t external name : t -> string = "ml_gsl_multifit_fdfsolver_name" external iterate : t -> unit = "ml_gsl_multifit_fdfsolver_iterate" external position : t -> vector -> unit = "ml_gsl_multifit_fdfsolver_position" external get_state : t -> ?x:vector -> ?f:vector -> ?dx:vector -> unit -> unit = "ml_gsl_multifit_fdfsolver_get_state" external test_delta : t -> epsabs:float -> epsrel:float -> bool = "ml_gsl_multifit_test_delta" external test_gradient : t -> Gsl_matrix.matrix -> epsabs:float -> vector -> bool = "ml_gsl_multifit_test_gradient" external covar : Gsl_matrix.matrix -> epsrel:float -> Gsl_matrix.matrix -> unit = "ml_gsl_multifit_covar" gsl-ocaml-1.19.1/lib/gsl_multimin.ml000066400000000000000000000037521262311274100172720ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_fun open Gsl_vector module Deriv = struct type kind = | CONJUGATE_FR | CONJUGATE_PR | VECTOR_BFGS | VECTOR_BFGS2 | STEEPEST_DESCENT type t external _alloc : kind -> int -> t = "ml_gsl_multimin_fdfminimizer_alloc" external _free : t -> unit = "ml_gsl_multimin_fdfminimizer_free" external _set : t -> multim_fun_fdf -> x:vector -> step:float -> tol:float -> unit = "ml_gsl_multimin_fdfminimizer_set" let make kind dim gf ~x ~step ~tol = let mini = _alloc kind dim in Gc.finalise _free mini ; _set mini gf ~x ~step ~tol ; mini external name : t -> string = "ml_gsl_multimin_fdfminimizer_name" external iterate : t -> unit = "ml_gsl_multimin_fdfminimizer_iterate" external restart : t -> unit = "ml_gsl_multimin_fdfminimizer_restart" external minimum : ?x:vector -> ?dx:vector -> ?g:vector -> t -> float = "ml_gsl_multimin_fdfminimizer_minimum" external test_gradient : t -> float -> bool = "ml_gsl_multimin_test_gradient" end module NoDeriv = struct type kind = | NM_SIMPLEX type t external _alloc : kind -> int -> t = "ml_gsl_multimin_fminimizer_alloc" external _free : t -> unit = "ml_gsl_multimin_fminimizer_free" external _set : t -> multim_fun -> x:vector -> step_size:vector -> unit = "ml_gsl_multimin_fminimizer_set" let make kind dim gf ~x ~step_size = let mini = _alloc kind dim in Gc.finalise _free mini ; _set mini gf ~x ~step_size ; mini external name : t -> string = "ml_gsl_multimin_fminimizer_name" external iterate : t -> unit = "ml_gsl_multimin_fminimizer_iterate" external minimum : ?x:vector -> t -> float = "ml_gsl_multimin_fminimizer_minimum" external size : t -> float = "ml_gsl_multimin_fminimizer_size" external test_size : t -> float -> bool = "ml_gsl_multimin_test_size" end gsl-ocaml-1.19.1/lib/gsl_multimin.mli000066400000000000000000000026061262311274100174400ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Multidimensional Minimization *) open Gsl_fun open Gsl_vector module Deriv : sig type kind = | CONJUGATE_FR | CONJUGATE_PR | VECTOR_BFGS | VECTOR_BFGS2 | STEEPEST_DESCENT type t val make : kind -> int -> multim_fun_fdf -> x:vector -> step:float -> tol:float -> t external name : t -> string = "ml_gsl_multimin_fdfminimizer_name" external iterate : t -> unit = "ml_gsl_multimin_fdfminimizer_iterate" external restart : t -> unit = "ml_gsl_multimin_fdfminimizer_restart" external minimum : ?x:vector -> ?dx:vector -> ?g:vector -> t -> float = "ml_gsl_multimin_fdfminimizer_minimum" external test_gradient : t -> float -> bool = "ml_gsl_multimin_test_gradient" end module NoDeriv : sig type kind = | NM_SIMPLEX type t val make : kind -> int -> multim_fun -> x:vector -> step_size:vector -> t external name : t -> string = "ml_gsl_multimin_fminimizer_name" external iterate : t -> unit = "ml_gsl_multimin_fminimizer_iterate" external minimum : ?x:vector -> t -> float = "ml_gsl_multimin_fminimizer_minimum" external size : t -> float = "ml_gsl_multimin_fminimizer_size" external test_size : t -> float -> bool = "ml_gsl_multimin_test_size" end gsl-ocaml-1.19.1/lib/gsl_multiroot.ml000066400000000000000000000042701262311274100174660ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_fun open Gsl_vector module NoDeriv = struct type kind = | HYBRIDS | HYBRID | DNEWTON | BROYDEN type t external _alloc : kind -> int -> t = "ml_gsl_multiroot_fsolver_alloc" external _free : t -> unit = "ml_gsl_multiroot_fsolver_free" external _set : t -> multi_fun -> vector -> unit = "ml_gsl_multiroot_fsolver_set" let make kind dim f x = let s = _alloc kind dim in Gc.finalise _free s ; _set s f x ; s external name : t -> string = "ml_gsl_multiroot_fsolver_name" external iterate : t -> unit = "ml_gsl_multiroot_fsolver_iterate" external root : t -> vector -> unit = "ml_gsl_multiroot_fsolver_root" external get_state : t -> ?x:vector -> ?f:vector -> ?dx:vector -> unit -> unit = "ml_gsl_multiroot_fsolver_get_state" external test_delta : t -> epsabs:float -> epsrel:float -> bool = "ml_gsl_multiroot_test_delta_f" external test_residual : t -> epsabs:float -> bool = "ml_gsl_multiroot_test_residual_f" end module Deriv = struct type kind = | HYBRIDSJ | HYBRIDJ | NEWTON | GNEWTON type t external _alloc : kind -> int -> t = "ml_gsl_multiroot_fdfsolver_alloc" external _free : t -> unit = "ml_gsl_multiroot_fdfsolver_free" external _set : t -> multi_fun_fdf -> vector -> unit = "ml_gsl_multiroot_fdfsolver_set" let make kind dim f x = let s = _alloc kind dim in Gc.finalise _free s ; _set s f x ; s external name : t -> string = "ml_gsl_multiroot_fdfsolver_name" external root : t -> vector -> unit = "ml_gsl_multiroot_fdfsolver_root" external iterate : t -> unit = "ml_gsl_multiroot_fdfsolver_iterate" external get_state : t -> ?x:vector -> ?f:vector -> ?j:Gsl_matrix.matrix -> ?dx:vector -> unit -> unit = "ml_gsl_multiroot_fdfsolver_get_state_bc" "ml_gsl_multiroot_fdfsolver_get_state" external test_delta : t -> epsabs:float -> epsrel:float -> bool = "ml_gsl_multiroot_test_delta_fdf" external test_residual : t -> epsabs:float -> bool = "ml_gsl_multiroot_test_residual_fdf" end gsl-ocaml-1.19.1/lib/gsl_multiroot.mli000066400000000000000000000032561262311274100176420ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Multidimensional Root-Finding *) open Gsl_fun open Gsl_vector module NoDeriv : sig type kind = | HYBRIDS | HYBRID | DNEWTON | BROYDEN type t val make : kind -> int -> multi_fun -> vector -> t external name : t -> string = "ml_gsl_multiroot_fsolver_name" external iterate : t -> unit = "ml_gsl_multiroot_fsolver_iterate" external root : t -> vector -> unit = "ml_gsl_multiroot_fsolver_root" external get_state : t -> ?x:vector -> ?f:vector -> ?dx:vector -> unit -> unit = "ml_gsl_multiroot_fsolver_get_state" external test_delta : t -> epsabs:float -> epsrel:float -> bool = "ml_gsl_multiroot_test_delta_f" external test_residual : t -> epsabs:float -> bool = "ml_gsl_multiroot_test_residual_f" end module Deriv : sig type kind = | HYBRIDSJ | HYBRIDJ | NEWTON | GNEWTON type t val make : kind -> int -> multi_fun_fdf -> vector -> t external name : t -> string = "ml_gsl_multiroot_fdfsolver_name" external iterate : t -> unit = "ml_gsl_multiroot_fdfsolver_iterate" external root : t -> vector -> unit = "ml_gsl_multiroot_fdfsolver_root" external get_state : t -> ?x:vector -> ?f:vector -> ?j:Gsl_matrix.matrix -> ?dx:vector -> unit -> unit = "ml_gsl_multiroot_fdfsolver_get_state_bc" "ml_gsl_multiroot_fdfsolver_get_state" external test_delta : t -> epsabs:float -> epsrel:float -> bool = "ml_gsl_multiroot_test_delta_fdf" external test_residual : t -> epsabs:float -> bool = "ml_gsl_multiroot_test_residual_fdf" end gsl-ocaml-1.19.1/lib/gsl_odeiv.ml000066400000000000000000000065011262311274100165350ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type system external _alloc : (float -> float array -> float array -> unit) -> ?jacobian:(float -> float array -> Gsl_matrix.matrix -> float array -> unit) -> int -> system = "ml_gsl_odeiv_alloc_system" external _free : system -> unit = "ml_gsl_odeiv_free_system" let make_system f ?jac dim = let s = _alloc f ?jacobian:jac dim in Gc.finalise _free s ; s type step type step_kind = | RK2 | RK4 | RKF45 | RKCK | RK8PD | RK2IMP | RK2SIMP | RK4IMP | BSIMP | GEAR1 | GEAR2 external _step_alloc : step_kind -> dim:int -> step = "ml_gsl_odeiv_step_alloc" external _step_free : step -> unit = "ml_gsl_odeiv_step_free" let make_step kind ~dim = let s = _step_alloc kind ~dim in Gc.finalise _step_free s ; s external step_reset : step -> unit = "ml_gsl_odeiv_step_reset" external step_name : step -> string = "ml_gsl_odeiv_step_name" external step_order : step -> int = "ml_gsl_odeiv_step_order" external step_apply : step -> t:float -> h:float -> y:float array -> yerr:float array -> ?dydt_in:float array -> ?dydt_out:float array -> system -> unit = "ml_gsl_odeiv_step_apply_bc" "ml_gsl_odeiv_step_apply" type control external _control_free : control -> unit = "ml_gsl_odeiv_control_free" external _control_standard_new : eps_abs:float -> eps_rel:float -> a_y:float -> a_dydt:float -> control = "ml_gsl_odeiv_control_standard_new" external _control_y_new : eps_abs:float -> eps_rel:float -> control = "ml_gsl_odeiv_control_y_new" external _control_yp_new : eps_abs:float -> eps_rel:float -> control = "ml_gsl_odeiv_control_yp_new" external _control_scaled_new : eps_abs:float -> eps_rel:float -> a_y:float -> a_dydt:float -> scale_abs:float array -> control = "ml_gsl_odeiv_control_scaled_new" let make_control_standard_new ~eps_abs ~eps_rel ~a_y ~a_dydt = let c = _control_standard_new ~eps_abs ~eps_rel ~a_y ~a_dydt in Gc.finalise _control_free c ; c let make_control_y_new ~eps_abs ~eps_rel = let c = _control_y_new ~eps_abs ~eps_rel in Gc.finalise _control_free c ; c let make_control_yp_new ~eps_abs ~eps_rel = let c = _control_yp_new ~eps_abs ~eps_rel in Gc.finalise _control_free c ; c let make_control_scaled_new ~eps_abs ~eps_rel ~a_y ~a_dydt ~scale_abs = let c = _control_scaled_new ~eps_abs ~eps_rel ~a_y ~a_dydt ~scale_abs in Gc.finalise _control_free c ; c external control_name : control -> string = "ml_gsl_odeiv_control_name" type hadjust = | HADJ_DEC | HADJ_NIL | HADJ_INC external control_hadjust : control -> step -> y:float array -> yerr:float array -> dydt:float array -> h:float -> hadjust * float = "ml_gsl_odeiv_control_hadjust_bc" "ml_gsl_odeiv_control_hadjust" type evolve external _evolve_alloc : int -> evolve = "ml_gsl_odeiv_evolve_alloc" external _evolve_free : evolve -> unit = "ml_gsl_odeiv_evolve_free" let make_evolve dim = let e = _evolve_alloc dim in Gc.finalise _evolve_free e ; e external evolve_reset : evolve -> unit = "ml_gsl_odeiv_evolve_reset" external evolve_apply : evolve -> control -> step -> system -> t:float -> t1:float -> h:float -> y:float array -> float * float = "ml_gsl_odeiv_evolve_apply_bc" "ml_gsl_odeiv_evolve_apply" gsl-ocaml-1.19.1/lib/gsl_odeiv.mli000066400000000000000000000037761262311274100167210ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Ordinary Differential Equations *) type system val make_system : (float -> float array -> float array -> unit) -> ?jac:(float -> float array -> Gsl_matrix.matrix -> float array -> unit) -> int -> system type step type step_kind = | RK2 | RK4 | RKF45 | RKCK | RK8PD | RK2IMP | RK2SIMP | RK4IMP | BSIMP | GEAR1 | GEAR2 val make_step : step_kind -> dim:int -> step external step_reset : step -> unit = "ml_gsl_odeiv_step_reset" external step_name : step -> string = "ml_gsl_odeiv_step_name" external step_order : step -> int = "ml_gsl_odeiv_step_order" external step_apply : step -> t:float -> h:float -> y:float array -> yerr:float array -> ?dydt_in:float array -> ?dydt_out:float array -> system -> unit = "ml_gsl_odeiv_step_apply_bc" "ml_gsl_odeiv_step_apply" type control val make_control_standard_new : eps_abs:float -> eps_rel:float -> a_y:float -> a_dydt:float -> control val make_control_y_new : eps_abs:float -> eps_rel:float -> control val make_control_yp_new : eps_abs:float -> eps_rel:float -> control val make_control_scaled_new : eps_abs:float -> eps_rel:float -> a_y:float -> a_dydt:float -> scale_abs:float array -> control external control_name : control -> string = "ml_gsl_odeiv_control_name" type hadjust = | HADJ_DEC | HADJ_NIL | HADJ_INC external control_hadjust : control -> step -> y:float array -> yerr:float array -> dydt:float array -> h:float -> hadjust * float = "ml_gsl_odeiv_control_hadjust_bc" "ml_gsl_odeiv_control_hadjust" type evolve val make_evolve : int -> evolve external evolve_reset : evolve -> unit = "ml_gsl_odeiv_evolve_reset" external evolve_apply : evolve -> control -> step -> system -> t:float -> t1:float -> h:float -> y:float array -> float * float = "ml_gsl_odeiv_evolve_apply_bc" "ml_gsl_odeiv_evolve_apply" gsl-ocaml-1.19.1/lib/gsl_permut.ml000066400000000000000000000047211262311274100167450ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Bigarray type permut = (int, int_elt, c_layout) Array1.t let of_array arr = Array1.of_array int c_layout arr let to_array perm = let len = Array1.dim perm in Array.init len (Array1.get perm) external init : permut -> unit = "ml_gsl_permutation_init" let create len = Array1.create int c_layout len let make len = let p = create len in init p ; p let swap p i j = let tmp_i = p.{i} in let tmp_j = p.{j} in p.{i} <- tmp_j ; p.{j} <- tmp_i let size = Array1.dim external _valid : permut -> bool = "ml_gsl_permutation_valid" let valid p = try _valid p with Gsl_error.Gsl_exn (Gsl_error.FAILURE, _) -> false external reverse : permut -> unit = "ml_gsl_permutation_reverse" external _inverse : src:permut -> dst:permut -> unit = "ml_gsl_permutation_inverse" let inverse p = let i = create (size p) in _inverse ~src:p ~dst:i ; i external next : permut -> unit = "ml_gsl_permutation_next" external prev : permut -> unit = "ml_gsl_permutation_prev" external permute : permut -> 'a array -> unit = "ml_gsl_permute" external permute_barr : permut -> ('a, 'b, 'c) Bigarray.Array1.t -> unit = "ml_gsl_permute_barr" external permute_complex : permut -> Gsl_complex.complex_array -> unit = "ml_gsl_permute_complex" external permute_inverse : permut -> 'a array -> unit = "ml_gsl_permute_inverse" external permute_inverse_barr : permut -> ('a, 'b, 'c) Bigarray.Array1.t -> unit = "ml_gsl_permute_inverse_barr" external permute_inverse_complex : permut -> Gsl_complex.complex_array -> unit = "ml_gsl_permute_inverse_complex" external _mul : permut -> permut -> permut -> unit = "ml_gsl_permute_mul" let mul pa pb = let p = create (size pa) in _mul p pa pb ; p external _lin_to_can : permut -> permut -> unit = "ml_gsl_permute_linear_to_canonical" let linear_to_canonical p = let q = create (size p) in _lin_to_can q p ; q external _can_to_lin : permut -> permut -> unit = "ml_gsl_permute_canonical_to_linear" let canonical_to_linear q = let p = create (size q) in _can_to_lin p q ; p external inversions : permut -> int = "ml_gsl_permute_inversions" external canonical_cycles : permut -> int = "ml_gsl_permute_canonical_cycles" external linear_cycles : permut -> int = "ml_gsl_permute_linear_cycles" gsl-ocaml-1.19.1/lib/gsl_permut.mli000066400000000000000000000032421262311274100171130ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Permutations *) type permut = (int, Bigarray.int_elt, Bigarray.c_layout) Bigarray.Array1.t val of_array : int array -> permut val to_array : permut -> int array val init : permut -> unit val create : int -> permut val make : int -> permut val swap : permut -> int -> int -> unit val size : permut -> int val valid : permut -> bool external reverse : permut -> unit = "ml_gsl_permutation_reverse" val inverse : permut -> permut external next : permut -> unit = "ml_gsl_permutation_next" external prev : permut -> unit = "ml_gsl_permutation_prev" external permute : permut -> 'a array -> unit = "ml_gsl_permute" external permute_barr : permut -> ('a, 'b, 'c) Bigarray.Array1.t -> unit = "ml_gsl_permute_barr" external permute_complex : permut -> Gsl_complex.complex_array -> unit = "ml_gsl_permute_complex" external permute_inverse : permut -> 'a array -> unit = "ml_gsl_permute_inverse" external permute_inverse_barr : permut -> ('a, 'b, 'c) Bigarray.Array1.t -> unit = "ml_gsl_permute_inverse_barr" external permute_inverse_complex : permut -> Gsl_complex.complex_array -> unit = "ml_gsl_permute_inverse_complex" val mul : permut -> permut -> permut val linear_to_canonical : permut -> permut val canonical_to_linear : permut -> permut external inversions : permut -> int = "ml_gsl_permute_inversions" external canonical_cycles : permut -> int = "ml_gsl_permute_canonical_cycles" external linear_cycles : permut -> int = "ml_gsl_permute_linear_cycles" gsl-ocaml-1.19.1/lib/gsl_poly.ml000066400000000000000000000025321262311274100164120ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_complex type poly = float array external eval : poly -> float -> float = "ml_gsl_poly_eval" type quad_sol = | Quad_0 | Quad_2 of float * float external solve_quadratic : a:float -> b:float -> c:float -> quad_sol = "ml_gsl_poly_solve_quadratic" external complex_solve_quadratic : a:float -> b:float -> c:float -> complex * complex = "ml_gsl_poly_complex_solve_quadratic" type cubic_sol = | Cubic_0 | Cubic_1 of float | Cubic_3 of float * float * float external solve_cubic : a:float -> b:float -> c:float -> cubic_sol = "ml_gsl_poly_solve_cubic" external complex_solve_cubic : a:float -> b:float -> c:float -> complex * complex * complex = "ml_gsl_poly_complex_solve_cubic" type ws external _alloc_ws : int -> ws = "ml_gsl_poly_complex_workspace_alloc" external _free_ws : ws -> unit= "ml_gsl_poly_complex_workspace_free" external _solve : poly -> ws -> complex_array -> unit = "ml_gsl_poly_complex_solve" let solve poly = let n = Array.length poly in let ws = _alloc_ws n in try let sol = Array.make (2*(n-1)) 0. in _solve poly ws sol ; _free_ws ws ; sol with exn -> _free_ws ws ; raise exn gsl-ocaml-1.19.1/lib/gsl_poly.mli000066400000000000000000000023051262311274100165610ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Polynomials *) open Gsl_complex type poly = float array (** {3 Polynomial Evaluation} *) external eval : poly -> float -> float = "ml_gsl_poly_eval" (** [eval p x] returns [p.(0) +. p.(1) *. x +. p.(2) *. x**2 +. ... +. p.(n) *. x**n] where [n = Array.length p]. *) (** {3 Quadratic Equations} *) type quad_sol = | Quad_0 | Quad_2 of float * float external solve_quadratic : a:float -> b:float -> c:float -> quad_sol = "ml_gsl_poly_solve_quadratic" external complex_solve_quadratic : a:float -> b:float -> c:float -> complex * complex = "ml_gsl_poly_complex_solve_quadratic" (** {3 Cubic Equations} *) type cubic_sol = | Cubic_0 | Cubic_1 of float | Cubic_3 of float * float * float external solve_cubic : a:float -> b:float -> c:float -> cubic_sol = "ml_gsl_poly_solve_cubic" external complex_solve_cubic : a:float -> b:float -> c:float -> complex * complex * complex = "ml_gsl_poly_complex_solve_cubic" (** {3 General Polynomial Equations} *) val solve : poly -> complex_array gsl-ocaml-1.19.1/lib/gsl_qrng.ml000066400000000000000000000015311262311274100163740ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type qrng_type = | NIEDERREITER_2 | SOBOL type t external _alloc : qrng_type -> int -> t = "ml_gsl_qrng_alloc" external _free : t -> unit = "ml_gsl_qrng_free" external init : t -> unit = "ml_gsl_qrng_init" let make t d = let qrng = _alloc t d in Gc.finalise _free qrng ; qrng external dimension : t -> int = "ml_gsl_qrng_dimension" external name : t -> string = "ml_gsl_qrng_name" external memcpy : src:t -> dst:t -> unit = "ml_gsl_qrng_memcpy" external clone : t -> t = "ml_gsl_qrng_clone" external get : t -> float array -> unit = "ml_gsl_qrng_get" external sample : t -> float array = "ml_gsl_qrng_sample" gsl-ocaml-1.19.1/lib/gsl_qrng.mli000066400000000000000000000013271262311274100165500ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Quasi-Random Sequences *) type qrng_type = | NIEDERREITER_2 | SOBOL type t val make : qrng_type -> int -> t external init : t -> unit = "ml_gsl_qrng_init" external get : t -> float array -> unit = "ml_gsl_qrng_get" external sample : t -> float array = "ml_gsl_qrng_sample" external name : t -> string = "ml_gsl_qrng_name" external dimension : t -> int = "ml_gsl_qrng_dimension" external memcpy : src:t -> dst:t -> unit = "ml_gsl_qrng_memcpy" external clone : t -> t = "ml_gsl_qrng_clone" gsl-ocaml-1.19.1/lib/gsl_randist.ml000066400000000000000000000217401262311274100170750ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (* GAUSSIAN *) external gaussian : Gsl_rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian" external gaussian_ratio_method : Gsl_rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian_ratio_method" external gaussian_ziggurat : Gsl_rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian_ziggurat" external gaussian_pdf : float -> sigma:float -> float = "ml_gsl_ran_gaussian_pdf" external ugaussian : Gsl_rng.t -> float = "ml_gsl_ran_ugaussian" external ugaussian_ratio_method : Gsl_rng.t -> float = "ml_gsl_ran_ugaussian_ratio_method" external ugaussian_pdf : float -> float = "ml_gsl_ran_ugaussian_pdf" (* GAUSSIAN TAIL *) external gaussian_tail : Gsl_rng.t -> a:float -> sigma:float -> float = "ml_gsl_ran_gaussian_tail" external gaussian_tail_pdf : float -> a:float -> sigma:float -> float = "ml_gsl_ran_gaussian_tail_pdf" external ugaussian_tail : Gsl_rng.t -> a:float -> float = "ml_gsl_ran_ugaussian_tail" external ugaussian_tail_pdf : float -> a:float -> float = "ml_gsl_ran_ugaussian_tail_pdf" (* BIVARIATE *) external bivariate_gaussian : Gsl_rng.t -> sigma_x:float -> sigma_y:float -> rho:float -> float * float = "ml_gsl_ran_bivariate_gaussian" external bivariate_gaussian_pdf : x:float -> y:float -> sigma_x:float -> sigma_y:float -> rho:float -> float = "ml_gsl_ran_bivariate_gaussian_pdf" (* EXPONENTIAL *) external exponential : Gsl_rng.t -> mu:float -> float = "ml_gsl_ran_exponential" external exponential_pdf : float -> mu:float -> float = "ml_gsl_ran_exponential_pdf" (* LAPLACE *) external laplace : Gsl_rng.t -> a:float -> float = "ml_gsl_ran_laplace" external laplace_pdf : float -> a:float -> float = "ml_gsl_ran_laplace_pdf" (* EXPPOW *) external exppow : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_exppow" external exppow_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_exppow_pdf" (* CAUCHY *) external cauchy : Gsl_rng.t -> a:float -> float = "ml_gsl_ran_cauchy" external cauchy_pdf : float -> a:float -> float = "ml_gsl_ran_cauchy_pdf" (* RAYLEIGH *) external rayleigh : Gsl_rng.t -> sigma:float -> float = "ml_gsl_ran_rayleigh" external rayleigh_pdf : float -> sigma:float -> float = "ml_gsl_ran_rayleigh_pdf" (* RAYLEIGH TAIL *) external rayleigh_tail : Gsl_rng.t -> a:float -> sigma:float -> float = "ml_gsl_ran_rayleigh_tail" external rayleigh_tail_pdf : float -> a:float -> sigma:float -> float = "ml_gsl_ran_rayleigh_tail_pdf" (* LANDAU *) external landau : Gsl_rng.t -> float = "ml_gsl_ran_landau" external landau_pdf : float -> float = "ml_gsl_ran_landau_pdf" (* LEVY ALPHA-STABLE *) external levy : Gsl_rng.t -> c:float -> alpha:float -> float = "ml_gsl_ran_levy" (* LEVY SKEW ALPHA-STABLE *) external levy_skew : Gsl_rng.t -> c:float -> alpha:float -> beta:float -> float = "ml_gsl_ran_levy_skew" (* GAMMA *) external gamma : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_gamma" external gamma_int : Gsl_rng.t -> a:int -> float = "ml_gsl_ran_gamma_int" external gamma_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_gamma_pdf" external gamma_mt : Gsl_rng.t -> a:int -> b:float -> float = "ml_gsl_ran_gamma_mt" external gamma_knuth : Gsl_rng.t -> a:int -> b:float -> float = "ml_gsl_ran_gamma_knuth" (* FLAT *) external flat : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_flat" external flat_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_flat_pdf" (* LOGNORMAL *) external lognormal : Gsl_rng.t -> zeta:float -> sigma:float -> float = "ml_gsl_ran_lognormal" external lognormal_pdf : float -> zeta:float -> sigma:float -> float = "ml_gsl_ran_lognormal_pdf" (* CHI-SQUARED *) external chisq : Gsl_rng.t -> nu:float -> float = "ml_gsl_ran_chisq" external chisq_pdf : float -> nu:float -> float = "ml_gsl_ran_chisq_pdf" (* DIRICHLET *) external dirichlet : Gsl_rng.t -> alpha:float array -> theta:float array -> unit = "ml_gsl_ran_dirichlet" external dirichlet_pdf : alpha:float array -> theta:float array -> float = "ml_gsl_ran_dirichlet_pdf" external dirichlet_lnpdf : alpha:float array -> theta:float array -> float = "ml_gsl_ran_dirichlet_lnpdf" (* F DISTRIBUTION *) external fdist : Gsl_rng.t -> nu1:float -> nu2:float -> float = "ml_gsl_ran_fdist" external fdist_pdf : float -> nu1:float -> nu2:float -> float = "ml_gsl_ran_fdist_pdf" (* T DISTRIBUTION *) external tdist : Gsl_rng.t -> nu:float -> float = "ml_gsl_ran_tdist" external tdist_pdf : float -> nu:float -> float = "ml_gsl_ran_tdist_pdf" (* BETA *) external beta : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_beta" external beta_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_beta_pdf" (* LOGISTIC *) external logistic : Gsl_rng.t -> a:float -> float = "ml_gsl_ran_logistic" external logistic_pdf : float -> a:float -> float = "ml_gsl_ran_logistic_pdf" (* PARETO *) external pareto : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_pareto" external pareto_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_pareto_pdf" (* SPHERICAL *) external dir_2d : Gsl_rng.t -> float * float = "ml_gsl_ran_dir_2d" external dir_2d_trig_method : Gsl_rng.t -> float * float = "ml_gsl_ran_dir_2d_trig_method" external dir_3d : Gsl_rng.t -> float * float * float = "ml_gsl_ran_dir_3d" external dir_nd : Gsl_rng.t -> float array -> unit = "ml_gsl_ran_dir_nd" (* WEIBULL *) external weibull : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_weibull" external weibull_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_weibull_pdf" (* TYPE 1 GUMBEL *) external gumbel1 : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_gumbel1" external gumbel1_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_gumbel1_pdf" (* TYPE 2 GUMBEL *) external gumbel2 : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_gumbel2" external gumbel2_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_gumbel2_pdf" (* DISCRETE *) type discrete external _discrete_preproc : float array -> discrete = "ml_gsl_ran_discrete_preproc" external discrete : Gsl_rng.t -> discrete -> int = "ml_gsl_ran_discrete" "noalloc" external discrete_pdf : int -> discrete -> float = "ml_gsl_ran_discrete_pdf" external discrete_free : discrete -> unit = "ml_gsl_ran_discrete_free" let discrete_preproc arr = let d = _discrete_preproc arr in Gc.finalise discrete_free d ; d (* POISSON *) external poisson : Gsl_rng.t -> mu:float -> int = "ml_gsl_ran_poisson" external poisson_pdf : int -> mu:float -> float = "ml_gsl_ran_poisson_pdf" (* BERNOULLI *) external bernoulli : Gsl_rng.t -> p:float -> int = "ml_gsl_ran_bernoulli" external bernoulli_pdf : int -> p:float -> float = "ml_gsl_ran_bernoulli_pdf" (* BINOMIAL *) external binomial : Gsl_rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial" external binomial_knuth : Gsl_rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial_knuth" external binomial_tpe : Gsl_rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial_tpe" external binomial_pdf : int -> p:float -> n:int -> float = "ml_gsl_ran_binomial_pdf" (* MULTINOMIAL *) external multinomial : Gsl_rng.t -> n:int -> p:float array -> int array = "ml_gsl_ran_multinomial" external multinomial_pdf : p:float array -> n:int array -> float = "ml_gsl_ran_multinomial_pdf" external multinomial_lnpdf : p:float array -> n:int array -> float = "ml_gsl_ran_multinomial_lnpdf" (* NEGATIVE BINOMIAL *) external negative_binomial : Gsl_rng.t -> p:float -> n:float -> int = "ml_gsl_ran_negative_binomial" external negative_binomial_pdf : int -> p:float -> n:float -> float = "ml_gsl_ran_negative_binomial_pdf" (* PASCAL *) external pascal : Gsl_rng.t -> p:float -> k:int -> int = "ml_gsl_ran_pascal" external pascal_pdf : int -> p:float -> n:int -> float = "ml_gsl_ran_pascal_pdf" (* GEOMETRIC *) external geometric : Gsl_rng.t -> p:float -> int = "ml_gsl_ran_geometric" external geometric_pdf : int -> p:float -> float = "ml_gsl_ran_geometric_pdf" (* HYPER GEOMETRIC *) external hypergeometric : Gsl_rng.t -> n1:int -> n2:int -> t:int -> int = "ml_gsl_ran_hypergeometric" external hypergeometric_pdf : int -> n1:int -> n2:int -> t:int -> float = "ml_gsl_ran_hypergeometric_pdf" (* LOGARITHMIC *) external logarithmic : Gsl_rng.t -> p:float -> int = "ml_gsl_ran_logarithmic" external logarithmic_pdf : int -> p:float -> float = "ml_gsl_ran_logarithmic_pdf" (* SHUFFLING *) external shuffle : Gsl_rng.t -> 'a array -> unit = "ml_gsl_ran_shuffle" external choose : Gsl_rng.t -> src:'a array -> dst:'a array -> unit = "ml_gsl_ran_choose" external sample : Gsl_rng.t -> src:'a array -> dst:'a array -> unit = "ml_gsl_ran_sample" gsl-ocaml-1.19.1/lib/gsl_randist.mli000066400000000000000000000200701262311274100172410ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Random Number Distributions *) external gaussian : Gsl_rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian" external gaussian_ratio_method : Gsl_rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian_ratio_method" external gaussian_ziggurat : Gsl_rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian_ziggurat" external gaussian_pdf : float -> sigma:float -> float = "ml_gsl_ran_gaussian_pdf" external ugaussian : Gsl_rng.t -> float = "ml_gsl_ran_ugaussian" external ugaussian_ratio_method : Gsl_rng.t -> float = "ml_gsl_ran_ugaussian_ratio_method" external ugaussian_pdf : float -> float = "ml_gsl_ran_ugaussian_pdf" external gaussian_tail : Gsl_rng.t -> a:float -> sigma:float -> float = "ml_gsl_ran_gaussian_tail" external gaussian_tail_pdf : float -> a:float -> sigma:float -> float = "ml_gsl_ran_gaussian_tail_pdf" external ugaussian_tail : Gsl_rng.t -> a:float -> float = "ml_gsl_ran_ugaussian_tail" external ugaussian_tail_pdf : float -> a:float -> float = "ml_gsl_ran_ugaussian_tail_pdf" external bivariate_gaussian : Gsl_rng.t -> sigma_x:float -> sigma_y:float -> rho:float -> float * float = "ml_gsl_ran_bivariate_gaussian" external bivariate_gaussian_pdf : x:float -> y:float -> sigma_x:float -> sigma_y:float -> rho:float -> float = "ml_gsl_ran_bivariate_gaussian_pdf" external exponential : Gsl_rng.t -> mu:float -> float = "ml_gsl_ran_exponential" external exponential_pdf : float -> mu:float -> float = "ml_gsl_ran_exponential_pdf" external laplace : Gsl_rng.t -> a:float -> float = "ml_gsl_ran_laplace" external laplace_pdf : float -> a:float -> float = "ml_gsl_ran_laplace_pdf" external exppow : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_exppow" external exppow_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_exppow_pdf" external cauchy : Gsl_rng.t -> a:float -> float = "ml_gsl_ran_cauchy" external cauchy_pdf : float -> a:float -> float = "ml_gsl_ran_cauchy_pdf" external rayleigh : Gsl_rng.t -> sigma:float -> float = "ml_gsl_ran_rayleigh" external rayleigh_pdf : float -> sigma:float -> float = "ml_gsl_ran_rayleigh_pdf" external rayleigh_tail : Gsl_rng.t -> a:float -> sigma:float -> float = "ml_gsl_ran_rayleigh_tail" external rayleigh_tail_pdf : float -> a:float -> sigma:float -> float = "ml_gsl_ran_rayleigh_tail_pdf" external landau : Gsl_rng.t -> float = "ml_gsl_ran_landau" external landau_pdf : float -> float = "ml_gsl_ran_landau_pdf" external levy : Gsl_rng.t -> c:float -> alpha:float -> float = "ml_gsl_ran_levy" external levy_skew : Gsl_rng.t -> c:float -> alpha:float -> beta:float -> float = "ml_gsl_ran_levy_skew" external gamma : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_gamma" external gamma_int : Gsl_rng.t -> a:int -> float = "ml_gsl_ran_gamma_int" external gamma_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_gamma_pdf" external gamma_mt : Gsl_rng.t -> a:int -> b:float -> float = "ml_gsl_ran_gamma_mt" external gamma_knuth : Gsl_rng.t -> a:int -> b:float -> float = "ml_gsl_ran_gamma_knuth" external flat : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_flat" external flat_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_flat_pdf" external lognormal : Gsl_rng.t -> zeta:float -> sigma:float -> float = "ml_gsl_ran_lognormal" external lognormal_pdf : float -> zeta:float -> sigma:float -> float = "ml_gsl_ran_lognormal_pdf" external chisq : Gsl_rng.t -> nu:float -> float = "ml_gsl_ran_chisq" external chisq_pdf : float -> nu:float -> float = "ml_gsl_ran_chisq_pdf" external dirichlet : Gsl_rng.t -> alpha:float array -> theta:float array -> unit = "ml_gsl_ran_dirichlet" external dirichlet_pdf : alpha:float array -> theta:float array -> float = "ml_gsl_ran_dirichlet_pdf" external dirichlet_lnpdf : alpha:float array -> theta:float array -> float = "ml_gsl_ran_dirichlet_lnpdf" external fdist : Gsl_rng.t -> nu1:float -> nu2:float -> float = "ml_gsl_ran_fdist" external fdist_pdf : float -> nu1:float -> nu2:float -> float = "ml_gsl_ran_fdist_pdf" external tdist : Gsl_rng.t -> nu:float -> float = "ml_gsl_ran_tdist" external tdist_pdf : float -> nu:float -> float = "ml_gsl_ran_tdist_pdf" external beta : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_beta" external beta_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_beta_pdf" external logistic : Gsl_rng.t -> a:float -> float = "ml_gsl_ran_logistic" external logistic_pdf : float -> a:float -> float = "ml_gsl_ran_logistic_pdf" external pareto : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_pareto" external pareto_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_pareto_pdf" external dir_2d : Gsl_rng.t -> float * float = "ml_gsl_ran_dir_2d" external dir_2d_trig_method : Gsl_rng.t -> float * float = "ml_gsl_ran_dir_2d_trig_method" external dir_3d : Gsl_rng.t -> float * float * float = "ml_gsl_ran_dir_3d" external dir_nd : Gsl_rng.t -> float array -> unit = "ml_gsl_ran_dir_nd" external weibull : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_weibull" external weibull_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_weibull_pdf" external gumbel1 : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_gumbel1" external gumbel1_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_gumbel1_pdf" external gumbel2 : Gsl_rng.t -> a:float -> b:float -> float = "ml_gsl_ran_gumbel2" external gumbel2_pdf : float -> a:float -> b:float -> float = "ml_gsl_ran_gumbel2_pdf" type discrete val discrete_preproc : float array -> discrete external discrete : Gsl_rng.t -> discrete -> int = "ml_gsl_ran_discrete" "noalloc" external discrete_pdf : int -> discrete -> float = "ml_gsl_ran_discrete_pdf" external poisson : Gsl_rng.t -> mu:float -> int = "ml_gsl_ran_poisson" external poisson_pdf : int -> mu:float -> float = "ml_gsl_ran_poisson_pdf" external bernoulli : Gsl_rng.t -> p:float -> int = "ml_gsl_ran_bernoulli" external bernoulli_pdf : int -> p:float -> float = "ml_gsl_ran_bernoulli_pdf" external binomial : Gsl_rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial" external binomial_knuth : Gsl_rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial_knuth" external binomial_tpe : Gsl_rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial_tpe" external binomial_pdf : int -> p:float -> n:int -> float = "ml_gsl_ran_binomial_pdf" external multinomial : Gsl_rng.t -> n:int -> p:float array -> int array = "ml_gsl_ran_multinomial" external multinomial_pdf : p:float array -> n:int array -> float = "ml_gsl_ran_multinomial_pdf" external multinomial_lnpdf : p:float array -> n:int array -> float = "ml_gsl_ran_multinomial_lnpdf" external negative_binomial : Gsl_rng.t -> p:float -> n:float -> int = "ml_gsl_ran_negative_binomial" external negative_binomial_pdf : int -> p:float -> n:float -> float = "ml_gsl_ran_negative_binomial_pdf" external pascal : Gsl_rng.t -> p:float -> k:int -> int = "ml_gsl_ran_pascal" external pascal_pdf : int -> p:float -> n:int -> float = "ml_gsl_ran_pascal_pdf" external geometric : Gsl_rng.t -> p:float -> int = "ml_gsl_ran_geometric" external geometric_pdf : int -> p:float -> float = "ml_gsl_ran_geometric_pdf" external hypergeometric : Gsl_rng.t -> n1:int -> n2:int -> t:int -> int = "ml_gsl_ran_hypergeometric" external hypergeometric_pdf : int -> n1:int -> n2:int -> t:int -> float = "ml_gsl_ran_hypergeometric_pdf" external logarithmic : Gsl_rng.t -> p:float -> int = "ml_gsl_ran_logarithmic" external logarithmic_pdf : int -> p:float -> float = "ml_gsl_ran_logarithmic_pdf" external shuffle : Gsl_rng.t -> 'a array -> unit = "ml_gsl_ran_shuffle" external choose : Gsl_rng.t -> src:'a array -> dst:'a array -> unit = "ml_gsl_ran_choose" external sample : Gsl_rng.t -> src:'a array -> dst:'a array -> unit = "ml_gsl_ran_sample" gsl-ocaml-1.19.1/lib/gsl_rng.ml000066400000000000000000000047631262311274100162250ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type rng_type = | BOROSH13 | COVEYOU | CMRG | FISHMAN18 | FISHMAN20 | FISHMAN2X | GFSR4 | KNUTHRAN | KNUTHRAN2 | KNUTHRAN2002 | LECUYER21 | MINSTD | MRG | MT19937 | MT19937_1999 | MT19937_1998 | R250 | RAN0 | RAN1 | RAN2 | RAN3 | RAND | RAND48 | RANDOM128_BSD | RANDOM128_GLIBC2 | RANDOM128_LIBC5 | RANDOM256_BSD | RANDOM256_GLIBC2 | RANDOM256_LIBC5 | RANDOM32_BSD | RANDOM32_GLIBC2 | RANDOM32_LIBC5 | RANDOM64_BSD | RANDOM64_GLIBC2 | RANDOM64_LIBC5 | RANDOM8_BSD | RANDOM8_GLIBC2 | RANDOM8_LIBC5 | RANDOM_BSD | RANDOM_GLIBC2 | RANDOM_LIBC5 | RANDU | RANF | RANLUX | RANLUX389 | RANLXD1 | RANLXD2 | RANLXS0 | RANLXS1 | RANLXS2 | RANMAR | SLATEC | TAUS | TAUS_2 | TAUS_113 | TRANSPUTER | TT800 | UNI | UNI32 | VAX | WATERMAN14 | ZUF type t external default : unit -> rng_type = "ml_gsl_rng_get_default" external default_seed : unit -> nativeint = "ml_gsl_rng_get_default_seed" external set_default : rng_type -> unit = "ml_gsl_rng_set_default" external set_default_seed : nativeint -> unit = "ml_gsl_rng_set_default_seed" external env_setup : unit -> unit = "ml_gsl_rng_env_setup" external create : rng_type -> t = "ml_gsl_rng_alloc" external delete : t -> unit = "ml_gsl_rng_free" let make rngtype = let rng = create rngtype in Gc.finalise delete rng ; rng external set : t -> nativeint -> unit = "ml_gsl_rng_set" external name : t -> string = "ml_gsl_rng_name" external max : t -> nativeint = "ml_gsl_rng_max" external min : t -> nativeint = "ml_gsl_rng_min" external get_type : t -> rng_type = "ml_gsl_rng_get_type" external memcpy : t -> t -> unit = "ml_gsl_rng_memcpy" external clone : t -> t = "ml_gsl_rng_clone" external dump_state : t -> string * string = "ml_gsl_rng_dump_state" external set_state : t -> string * string -> unit = "ml_gsl_rng_set_state" external get : t -> nativeint = "ml_gsl_rng_get" external uniform : t -> float = "ml_gsl_rng_uniform" external uniform_pos : t -> float = "ml_gsl_rng_uniform_pos" external uniform_int : t -> int -> int = "ml_gsl_rng_uniform_int" "noalloc" external uniform_arr : t -> float array -> unit = "ml_gsl_rng_uniform_arr" "noalloc" external uniform_pos_arr : t -> float array -> unit = "ml_gsl_rng_uniform_pos_arr" "noalloc" gsl-ocaml-1.19.1/lib/gsl_rng.mli000066400000000000000000000052451262311274100163720ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Random Number Generation *) type rng_type = | BOROSH13 | COVEYOU | CMRG | FISHMAN18 | FISHMAN20 | FISHMAN2X | GFSR4 | KNUTHRAN | KNUTHRAN2 | KNUTHRAN2002 | LECUYER21 | MINSTD | MRG | MT19937 | MT19937_1999 | MT19937_1998 | R250 | RAN0 | RAN1 | RAN2 | RAN3 | RAND | RAND48 | RANDOM128_BSD | RANDOM128_GLIBC2 | RANDOM128_LIBC5 | RANDOM256_BSD | RANDOM256_GLIBC2 | RANDOM256_LIBC5 | RANDOM32_BSD | RANDOM32_GLIBC2 | RANDOM32_LIBC5 | RANDOM64_BSD | RANDOM64_GLIBC2 | RANDOM64_LIBC5 | RANDOM8_BSD | RANDOM8_GLIBC2 | RANDOM8_LIBC5 | RANDOM_BSD | RANDOM_GLIBC2 | RANDOM_LIBC5 | RANDU | RANF | RANLUX | RANLUX389 | RANLXD1 | RANLXD2 | RANLXS0 | RANLXS1 | RANLXS2 | RANMAR | SLATEC | TAUS | TAUS_2 | TAUS_113 | TRANSPUTER | TT800 | UNI | UNI32 | VAX | WATERMAN14 | ZUF type t (** {3 Default values} *) external default : unit -> rng_type = "ml_gsl_rng_get_default" external default_seed : unit -> nativeint = "ml_gsl_rng_get_default_seed" external set_default : rng_type -> unit = "ml_gsl_rng_set_default" external set_default_seed : nativeint -> unit = "ml_gsl_rng_set_default_seed" external env_setup : unit -> unit = "ml_gsl_rng_env_setup" (** {3 Creating} *) val make : rng_type -> t external set : t -> nativeint -> unit = "ml_gsl_rng_set" external name : t -> string = "ml_gsl_rng_name" external get_type : t-> rng_type = "ml_gsl_rng_get_type" (** warning : the nativeint used for seeds are in fact unsigned but ocaml treats them as signed. But you can still print them using %nu with printf functions. *) external max : t -> nativeint = "ml_gsl_rng_max" external min : t -> nativeint = "ml_gsl_rng_min" external memcpy : t -> t -> unit = "ml_gsl_rng_memcpy" external clone : t -> t = "ml_gsl_rng_clone" external dump_state : t -> string * string = "ml_gsl_rng_dump_state" external set_state : t -> string * string -> unit = "ml_gsl_rng_set_state" (** {3 Sampling} *) external get : t -> nativeint = "ml_gsl_rng_get" external uniform : t -> float = "ml_gsl_rng_uniform" external uniform_pos : t -> float = "ml_gsl_rng_uniform_pos" external uniform_int : t -> int -> int = "ml_gsl_rng_uniform_int" "noalloc" (** These function fill the array with random numbers : *) external uniform_arr : t -> float array -> unit = "ml_gsl_rng_uniform_arr" "noalloc" external uniform_pos_arr : t -> float array -> unit = "ml_gsl_rng_uniform_pos_arr" "noalloc" gsl-ocaml-1.19.1/lib/gsl_root.ml000066400000000000000000000033641262311274100164160ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) module Bracket = struct type kind = | BISECTION | FALSEPOS | BRENT type t external _alloc : kind -> t = "ml_gsl_root_fsolver_alloc" external _free : t -> unit = "ml_gsl_root_fsolver_free" external _set : t -> Gsl_fun.gsl_fun -> float -> float -> unit = "ml_gsl_root_fsolver_set" let make kind f x y = let s = _alloc kind in Gc.finalise _free s ; _set s f x y ; s external name : t -> string = "ml_gsl_root_fsolver_name" external iterate : t -> unit = "ml_gsl_root_fsolver_iterate" external root : t -> float = "ml_gsl_root_fsolver_root" external interval : t -> float * float = "ml_gsl_root_fsolver_x_interv" end module Polish = struct type kind = | NEWTON | SECANT | STEFFENSON type t external _alloc : kind -> t = "ml_gsl_root_fdfsolver_alloc" external _free : t -> unit = "ml_gsl_root_fdfsolver_free" external _set : t -> Gsl_fun.gsl_fun_fdf -> float -> unit = "ml_gsl_root_fdfsolver_set" let make kind f r = let s = _alloc kind in Gc.finalise _free s ; _set s f r ; s external name : t -> string = "ml_gsl_root_fdfsolver_name" external iterate : t -> unit = "ml_gsl_root_fdfsolver_iterate" external root : t -> float = "ml_gsl_root_fdfsolver_root" end external test_interval : lo:float -> up:float -> epsabs:float -> epsrel:float -> bool = "ml_gsl_root_test_interval" external test_delta : x1:float -> x0:float -> epsabs:float -> epsrel:float -> bool = "ml_gsl_root_test_delta" external test_residual : f:float -> epsabs:float -> bool = "ml_gsl_root_test_residual" gsl-ocaml-1.19.1/lib/gsl_root.mli000066400000000000000000000024131262311274100165610ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** One dimensional Root-Finding *) module Bracket : sig type kind = | BISECTION | FALSEPOS | BRENT type t val make : kind -> Gsl_fun.gsl_fun -> float -> float -> t external name : t -> string = "ml_gsl_root_fsolver_name" external iterate : t -> unit = "ml_gsl_root_fsolver_iterate" external root : t -> float = "ml_gsl_root_fsolver_root" external interval : t -> float * float = "ml_gsl_root_fsolver_x_interv" end module Polish : sig type kind = | NEWTON | SECANT | STEFFENSON type t val make : kind -> Gsl_fun.gsl_fun_fdf -> float -> t external name : t -> string = "ml_gsl_root_fdfsolver_name" external iterate : t -> unit = "ml_gsl_root_fdfsolver_iterate" external root : t -> float = "ml_gsl_root_fdfsolver_root" end external test_interval : lo:float -> up:float -> epsabs:float -> epsrel:float -> bool = "ml_gsl_root_test_interval" external test_delta : x1:float -> x0:float -> epsabs:float -> epsrel:float -> bool = "ml_gsl_root_test_delta" external test_residual : f:float -> epsabs:float -> bool = "ml_gsl_root_test_residual" gsl-ocaml-1.19.1/lib/gsl_sf.ml000066400000000000000000000712671262311274100160520ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Special functions *) open Gsl_fun (* AIRY functions *) external airy_Ai : float -> mode -> float = "ml_gsl_sf_airy_Ai" external airy_Ai_e : float -> mode -> result = "ml_gsl_sf_airy_Ai_e" external airy_Bi : float -> mode -> float = "ml_gsl_sf_airy_Bi" external airy_Bi_e : float -> mode -> result = "ml_gsl_sf_airy_Bi_e" external airy_Ai_scaled : float -> mode -> float = "ml_gsl_sf_airy_Ai_scaled" external airy_Ai_scaled_e : float -> mode -> result = "ml_gsl_sf_airy_Ai_scaled_e" external airy_Bi_scaled : float -> mode -> float = "ml_gsl_sf_airy_Bi_scaled" external airy_Bi_scaled_e : float -> mode -> result = "ml_gsl_sf_airy_Bi_scaled_e" external airy_Ai_deriv : float -> mode -> float = "ml_gsl_sf_airy_Ai_deriv" external airy_Ai_deriv_e : float -> mode -> result = "ml_gsl_sf_airy_Ai_deriv_e" external airy_Bi_deriv : float -> mode -> float = "ml_gsl_sf_airy_Bi_deriv" external airy_Bi_deriv_e : float -> mode -> result = "ml_gsl_sf_airy_Bi_deriv_e" external airy_Ai_deriv_scaled : float -> mode -> float = "ml_gsl_sf_airy_Ai_deriv_scaled" external airy_Ai_deriv_scaled_e : float -> mode -> result = "ml_gsl_sf_airy_Ai_deriv_scaled_e" external airy_Bi_deriv_scaled : float -> mode -> float = "ml_gsl_sf_airy_Bi_deriv_scaled" external airy_Bi_deriv_scaled_e : float -> mode -> result = "ml_gsl_sf_airy_Bi_deriv_scaled_e" external airy_zero_Ai : int -> float = "ml_gsl_sf_airy_zero_Ai" external airy_zero_Ai_e : int -> result = "ml_gsl_sf_airy_zero_Ai_e" external airy_zero_Bi : int -> float = "ml_gsl_sf_airy_zero_Bi" external airy_zero_Bi_e : int -> result = "ml_gsl_sf_airy_zero_Bi_e" (* BESSEL functions *) external bessel_J0 : float -> float = "ml_gsl_sf_bessel_J0" external bessel_J0_e : float -> result = "ml_gsl_sf_bessel_J0_e" external bessel_J1 : float -> float = "ml_gsl_sf_bessel_J1" external bessel_J1_e : float -> result = "ml_gsl_sf_bessel_J1_e" external bessel_Jn : int -> float -> float = "ml_gsl_sf_bessel_Jn" external bessel_Jn_e : int -> float -> result = "ml_gsl_sf_bessel_Jn_e" external bessel_Jn_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_Jn_array" external bessel_Y0 : float -> float = "ml_gsl_sf_bessel_Y0" external bessel_Y0_e : float -> result = "ml_gsl_sf_bessel_Y0_e" external bessel_Y1 : float -> float = "ml_gsl_sf_bessel_Y1" external bessel_Y1_e : float -> result = "ml_gsl_sf_bessel_Y1_e" external bessel_Yn : int -> float -> float = "ml_gsl_sf_bessel_Yn" external bessel_Yn_e : int -> float -> result = "ml_gsl_sf_bessel_Yn_e" external bessel_Yn_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_Yn_array" external bessel_I0 : float -> float = "ml_gsl_sf_bessel_I0" external bessel_I0_e : float -> result = "ml_gsl_sf_bessel_I0_e" external bessel_I1 : float -> float = "ml_gsl_sf_bessel_I1" external bessel_I1_e : float -> result = "ml_gsl_sf_bessel_I1_e" external bessel_In : int -> float -> float = "ml_gsl_sf_bessel_In" external bessel_In_e : int -> float -> result = "ml_gsl_sf_bessel_In_e" external bessel_In_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_In_array" external bessel_K0 : float -> float = "ml_gsl_sf_bessel_K0" external bessel_K0_e : float -> result = "ml_gsl_sf_bessel_K0_e" external bessel_K1 : float -> float = "ml_gsl_sf_bessel_K1" external bessel_K1_e : float -> result = "ml_gsl_sf_bessel_K1_e" external bessel_Kn : int -> float -> float = "ml_gsl_sf_bessel_Kn" external bessel_Kn_e : int -> float -> result = "ml_gsl_sf_bessel_Kn_e" external bessel_Kn_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_Kn_array" external bessel_I0_scaled : float -> float = "ml_gsl_sf_bessel_I0_scaled" external bessel_I0_scaled_e : float -> result = "ml_gsl_sf_bessel_I0_scaled_e" external bessel_I1_scaled : float -> float = "ml_gsl_sf_bessel_I1_scaled" external bessel_I1_scaled_e : float -> result = "ml_gsl_sf_bessel_I1_scaled_e" external bessel_In_scaled : int -> float -> float = "ml_gsl_sf_bessel_In_scaled" external bessel_In_scaled_e : int -> float -> result = "ml_gsl_sf_bessel_In_scaled_e" external bessel_In_scaled_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_In_scaled_array" external bessel_K0_scaled : float -> float = "ml_gsl_sf_bessel_K0_scaled" external bessel_K0_scaled_e : float -> result = "ml_gsl_sf_bessel_K0_scaled_e" external bessel_K1_scaled : float -> float = "ml_gsl_sf_bessel_K1_scaled" external bessel_K1_scaled_e : float -> result = "ml_gsl_sf_bessel_K1_scaled_e" external bessel_Kn_scaled : int -> float -> float = "ml_gsl_sf_bessel_Kn_scaled" external bessel_Kn_scaled_e : int -> float -> result = "ml_gsl_sf_bessel_Kn_scaled_e" external bessel_Kn_scaled_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_Kn_scaled_array" external bessel_j0 : float -> float = "ml_gsl_sf_bessel_j0" external bessel_j0_e : float -> result = "ml_gsl_sf_bessel_j0_e" external bessel_j1 : float -> float = "ml_gsl_sf_bessel_j1" external bessel_j1_e : float -> result = "ml_gsl_sf_bessel_j1_e" external bessel_j2 : float -> float = "ml_gsl_sf_bessel_j2" external bessel_j2_e : float -> result = "ml_gsl_sf_bessel_j2_e" external bessel_jl : int -> float -> float = "ml_gsl_sf_bessel_jl" external bessel_jl_e : int -> float -> result = "ml_gsl_sf_bessel_jl_e" external bessel_jl_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_jl_array" external bessel_jl_steed_array : float -> float array -> unit = "ml_gsl_sf_bessel_jl_steed_array" external bessel_y0 : float -> float = "ml_gsl_sf_bessel_y0" external bessel_y0_e : float -> result = "ml_gsl_sf_bessel_y0_e" external bessel_y1 : float -> float = "ml_gsl_sf_bessel_y1" external bessel_y1_e : float -> result = "ml_gsl_sf_bessel_y1_e" external bessel_y2 : float -> float = "ml_gsl_sf_bessel_y2" external bessel_y2_e : float -> result = "ml_gsl_sf_bessel_y2_e" external bessel_yl : int -> float -> float = "ml_gsl_sf_bessel_yl" external bessel_yl_e : int -> float -> result = "ml_gsl_sf_bessel_yl_e" external bessel_yl_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_yl_array" external bessel_i0_scaled : float -> float = "ml_gsl_sf_bessel_i0_scaled" external bessel_i0_scaled_e : float -> result = "ml_gsl_sf_bessel_i0_scaled_e" external bessel_i1_scaled : float -> float = "ml_gsl_sf_bessel_i1_scaled" external bessel_i1_scaled_e : float -> result = "ml_gsl_sf_bessel_i1_scaled_e" external bessel_il_scaled : int -> float -> float = "ml_gsl_sf_bessel_il_scaled" external bessel_il_scaled_e : int -> float -> result = "ml_gsl_sf_bessel_il_scaled_e" external bessel_il_scaled_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_il_scaled_array" external bessel_k0_scaled : float -> float = "ml_gsl_sf_bessel_k0_scaled" external bessel_k0_scaled_e : float -> result = "ml_gsl_sf_bessel_k0_scaled_e" external bessel_k1_scaled : float -> float = "ml_gsl_sf_bessel_k1_scaled" external bessel_k1_scaled_e : float -> result = "ml_gsl_sf_bessel_k1_scaled_e" external bessel_kl_scaled : int -> float -> float = "ml_gsl_sf_bessel_kl_scaled" external bessel_kl_scaled_e : int -> float -> result = "ml_gsl_sf_bessel_kl_scaled_e" external bessel_kl_scaled_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_kl_scaled_array" external bessel_Jnu : float -> float -> float = "ml_gsl_sf_bessel_Jnu" external bessel_Jnu_e : float -> float -> result = "ml_gsl_sf_bessel_Jnu_e" external bessel_sequence_Jnu_e : float -> mode -> float array -> unit = "ml_gsl_sf_bessel_sequence_Jnu_e" external bessel_Ynu : float -> float -> float = "ml_gsl_sf_bessel_Ynu" external bessel_Ynu_e : float -> float -> result = "ml_gsl_sf_bessel_Ynu_e" external bessel_Inu : float -> float -> float = "ml_gsl_sf_bessel_Inu" external bessel_Inu_e : float -> float -> result = "ml_gsl_sf_bessel_Inu_e" external bessel_Inu_scaled : float -> float -> float = "ml_gsl_sf_bessel_Inu_scaled" external bessel_Inu_scaled_e : float -> float -> result = "ml_gsl_sf_bessel_Inu_scaled_e" external bessel_Knu : float -> float -> float = "ml_gsl_sf_bessel_Knu" external bessel_Knu_e : float -> float -> result = "ml_gsl_sf_bessel_Knu_e" external bessel_lnKnu : float -> float -> float = "ml_gsl_sf_bessel_lnKnu" external bessel_lnKnu_e : float -> float -> result = "ml_gsl_sf_bessel_lnKnu_e" external bessel_Knu_scaled : float -> float -> float = "ml_gsl_sf_bessel_Knu_scaled" external bessel_Knu_scaled_e : float -> float -> result = "ml_gsl_sf_bessel_Knu_scaled_e" external bessel_zero_J0 : int -> float = "ml_gsl_sf_bessel_zero_J0" external bessel_zero_J0_e : int -> result = "ml_gsl_sf_bessel_zero_J0_e" external bessel_zero_J1 : int -> float = "ml_gsl_sf_bessel_zero_J1" external bessel_zero_J1_e : int -> result = "ml_gsl_sf_bessel_zero_J1_e" external bessel_zero_Jnu : float -> int -> float = "ml_gsl_sf_bessel_zero_Jnu" external bessel_zero_Jnu_e : float -> int -> result = "ml_gsl_sf_bessel_zero_Jnu_e" (* CLAUSEN functions *) external clausen : float -> float = "ml_gsl_sf_clausen" external clausen_e : float -> result = "ml_gsl_sf_clausen_e" (* COULOMB functions *) external hydrogenicR_1 : float -> float -> float = "ml_gsl_sf_hydrogenicR_1" external hydrogenicR_1_e : float -> float -> result = "ml_gsl_sf_hydrogenicR_1_e" external hydrogenicR : int -> int -> float -> float -> float = "ml_gsl_sf_hydrogenicR" external hydrogenicR_e : int -> int -> float -> float -> result = "ml_gsl_sf_hydrogenicR_e" (* FIXME: COULOMB wave functions *) external coulomb_CL_e : float -> float -> result = "ml_gsl_sf_coulomb_CL_e" external coulomb_CL_array : float -> float -> float array -> unit = "ml_gsl_sf_coulomb_CL_array" (* FIXME: coupling coeffs *) (* DAWSON functions *) external dawson : float -> float = "ml_gsl_sf_dawson" external dawson_e : float -> result = "ml_gsl_sf_dawson_e" (* DEBYE functions *) external debye_1 : float -> float = "ml_gsl_sf_debye_1" external debye_1_e : float -> result = "ml_gsl_sf_debye_1_e" external debye_2 : float -> float = "ml_gsl_sf_debye_2" external debye_2_e : float -> result = "ml_gsl_sf_debye_2_e" external debye_3 : float -> float = "ml_gsl_sf_debye_3" external debye_3_e : float -> result = "ml_gsl_sf_debye_3_e" external debye_4 : float -> float = "ml_gsl_sf_debye_4" external debye_4_e : float -> result = "ml_gsl_sf_debye_4_e" external debye_5 : float -> float = "ml_gsl_sf_debye_5" external debye_5_e : float -> result = "ml_gsl_sf_debye_5_e" external debye_6 : float -> float = "ml_gsl_sf_debye_6" external debye_6_e : float -> result = "ml_gsl_sf_debye_6_e" (* DILOGARITHM *) external dilog : float -> float = "ml_gsl_sf_dilog" external dilog_e : float -> result = "ml_gsl_sf_dilog_e" external complex_dilog_xy_e : float -> float -> result * result = "ml_gsl_sf_complex_dilog_xy_e" external complex_dilog_e : float -> float -> result * result = "ml_gsl_sf_complex_dilog_e" external complex_spence_xy_e : float -> float -> result * result = "ml_gsl_sf_complex_spence_xy_e" (* ELEMENTARY operations *) external multiply_e : float -> float -> result = "ml_gsl_sf_multiply_e" external multiply_err_e : x:float -> dx:float -> y:float -> dy:float -> result = "ml_gsl_sf_multiply_err_e" (* ELLIPTIC integrals *) external ellint_Kcomp : float -> mode -> float = "ml_gsl_sf_ellint_Kcomp" external ellint_Kcomp_e : float -> mode -> result = "ml_gsl_sf_ellint_Kcomp_e" external ellint_Ecomp : float -> mode -> float = "ml_gsl_sf_ellint_Ecomp" external ellint_Ecomp_e : float -> mode -> result = "ml_gsl_sf_ellint_Ecomp_e" external ellint_Pcomp : float -> float -> mode -> float = "ml_gsl_sf_ellint_Pcomp" external ellint_Pcomp_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_Pcomp_e" external ellint_Dcomp : float -> mode -> float = "ml_gsl_sf_ellint_Dcomp" external ellint_Dcomp_e : float -> mode -> result = "ml_gsl_sf_ellint_Dcomp_e" external ellint_F : float -> float -> mode -> float = "ml_gsl_sf_ellint_F" external ellint_F_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_F_e" external ellint_E : float -> float -> mode -> float = "ml_gsl_sf_ellint_E" external ellint_E_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_E_e" external ellint_P : float -> float -> float -> mode -> float = "ml_gsl_sf_ellint_P" external ellint_P_e : float -> float -> float -> mode -> result = "ml_gsl_sf_ellint_P_e" external ellint_D : float -> float -> mode -> float = "ml_gsl_sf_ellint_D" external ellint_D_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_D_e" external ellint_RC : float -> float -> mode -> float = "ml_gsl_sf_ellint_RC" external ellint_RC_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_RC_e" external ellint_RD : float -> float -> float -> mode -> float = "ml_gsl_sf_ellint_RD" external ellint_RD_e : float -> float -> float -> mode -> result = "ml_gsl_sf_ellint_RD_e" external ellint_RF : float -> float -> float -> mode -> float = "ml_gsl_sf_ellint_RF" external ellint_RF_e : float -> float -> float -> mode -> result = "ml_gsl_sf_ellint_RF_e" external ellint_RJ : float -> float -> float -> float -> mode -> float = "ml_gsl_sf_ellint_RJ" external ellint_RJ_e : float -> float -> float -> float -> mode -> result = "ml_gsl_sf_ellint_RJ_e" (* FIXME: elljac_e *) (* ERROR function *) external erf : float -> float = "ml_gsl_sf_erf" "gsl_sf_erf" "float" external erf_e : float -> result = "ml_gsl_sf_erf_e" external erfc : float -> float = "ml_gsl_sf_erfc" "gsl_sf_erfc" "float" external erfc_e : float -> result = "ml_gsl_sf_erfc_e" external log_erfc : float -> float = "ml_gsl_sf_log_erfc" "gsl_sf_log_erfc" "float" external log_erfc_e : float -> result = "ml_gsl_sf_log_erfc_e" external erf_Z : float -> float = "ml_gsl_sf_erf_Z" "gsl_sf_erf_Z" "float" external erf_Z_e : float -> result = "ml_gsl_sf_erf_Z_e" external erf_Q : float -> float = "ml_gsl_sf_erf_Q" "gsl_sf_erf_Q" "float" external erf_Q_e : float -> result = "ml_gsl_sf_erf_Q_e" (* EXPONENTIAL functions *) external exp : float -> float = "ml_gsl_sf_exp" "gsl_sf_exp" "float" external exp_e : float -> result = "ml_gsl_sf_exp_e" external exp_e10 : float -> result_e10 = "ml_gsl_sf_exp_e10_e" external exp_mult : float -> float -> float = "ml_gsl_sf_exp_mult" external exp_mult_e : float -> float -> result = "ml_gsl_sf_exp_mult_e" external exp_mult_e10 : float -> float -> result_e10 = "ml_gsl_sf_exp_mult_e10_e" external expm1 : float -> float = "ml_gsl_sf_expm1" external expm1_e : float -> result = "ml_gsl_sf_expm1_e" external exprel : float -> float = "ml_gsl_sf_exprel" external exprel_e : float -> result = "ml_gsl_sf_exprel_e" external exprel_2 : float -> float = "ml_gsl_sf_exprel_2" external exprel_2_e : float -> result = "ml_gsl_sf_exprel_2_e" external exprel_n : int -> float -> float = "ml_gsl_sf_exprel_n" external exprel_n_e : int -> float -> result = "ml_gsl_sf_exprel_n_e" external exp_err_e : x:float -> dx:float -> result = "ml_gsl_sf_exp_err_e" external exp_err_e10 : x:float -> dx:float -> result_e10 = "ml_gsl_sf_exp_err_e10_e" external exp_mult_err_e : x:float -> dx:float -> y:float -> dy:float -> result = "ml_gsl_sf_exp_mult_err_e" external exp_mult_err_e10_e : x:float -> dx:float -> y:float -> dy:float -> result_e10 = "ml_gsl_sf_exp_mult_err_e10_e" (* EXPONENTIAL integrals *) external expint_E1 : float -> float = "ml_gsl_sf_expint_E1" external expint_E1_e : float -> result = "ml_gsl_sf_expint_E1_e" external expint_E2 : float -> float = "ml_gsl_sf_expint_E2" external expint_E2_e : float -> result = "ml_gsl_sf_expint_E2_e" external expint_E1_scaled : float -> float = "ml_gsl_sf_expint_E1_scaled" external expint_E1_scaled_e : float -> result = "ml_gsl_sf_expint_E1_scaled_e" external expint_E2_scaled : float -> float = "ml_gsl_sf_expint_E2_scaled" external expint_E2_scaled_e : float -> result = "ml_gsl_sf_expint_E2_scaled_e" external expint_Ei : float -> float = "ml_gsl_sf_expint_Ei" external expint_Ei_e : float -> result = "ml_gsl_sf_expint_Ei_e" external expint_Ei_scaled : float -> float = "ml_gsl_sf_expint_Ei_scaled" external expint_Ei_scaled_e : float -> result = "ml_gsl_sf_expint_Ei_scaled_e" external shi : float -> float = "ml_gsl_sf_Shi" external chi : float -> float = "ml_gsl_sf_Chi" external expint_3 : float -> float = "ml_gsl_sf_expint_3" external expint_3_e : float -> result = "ml_gsl_sf_expint_3_e" external si : float -> float = "ml_gsl_sf_Si" external ci : float -> float = "ml_gsl_sf_Ci" external atanint : float -> float = "ml_gsl_sf_atanint" external atanint_e : float -> result = "ml_gsl_sf_atanint_e" (* fermi-dirac *) external fermi_dirac_m1 : float -> float = "ml_gsl_sf_fermi_dirac_m1" external fermi_dirac_m1_e : float -> result = "ml_gsl_sf_fermi_dirac_m1_e" external fermi_dirac_0 : float -> float = "ml_gsl_sf_fermi_dirac_0" external fermi_dirac_0_e : float -> result = "ml_gsl_sf_fermi_dirac_0_e" external fermi_dirac_1 : float -> float = "ml_gsl_sf_fermi_dirac_1" external fermi_dirac_1_e : float -> result = "ml_gsl_sf_fermi_dirac_1_e" external fermi_dirac_2 : float -> float = "ml_gsl_sf_fermi_dirac_2" external fermi_dirac_2_e : float -> result = "ml_gsl_sf_fermi_dirac_2_e" external fermi_dirac_int : int -> float -> float = "ml_gsl_sf_fermi_dirac_int" external fermi_dirac_int_e : int -> float -> result = "ml_gsl_sf_fermi_dirac_int_e" external fermi_dirac_mhalf : float -> float = "ml_gsl_sf_fermi_dirac_mhalf" external fermi_dirac_mhalf_e : float -> result = "ml_gsl_sf_fermi_dirac_mhalf_e" external fermi_dirac_half : float -> float = "ml_gsl_sf_fermi_dirac_half" external fermi_dirac_half_e : float -> result = "ml_gsl_sf_fermi_dirac_half_e" external fermi_dirac_3half : float -> float = "ml_gsl_sf_fermi_dirac_3half" external fermi_dirac_3half_e : float -> result = "ml_gsl_sf_fermi_dirac_3half_e" external fermi_dirac_inc_0 : float -> float -> float = "ml_gsl_sf_fermi_dirac_inc_0" external fermi_dirac_inc_0_e : float -> float -> result = "ml_gsl_sf_fermi_dirac_inc_0_e" (* Gamma function *) external gamma : float -> float = "ml_gsl_sf_gamma" external gamma_e : float -> result = "ml_gsl_sf_gamma_e" external lngamma : float -> float = "ml_gsl_sf_lngamma" external lngamma_e : float -> result = "ml_gsl_sf_lngamma_e" external lngamma_sgn_e : float -> result * float = "ml_gsl_sf_lngamma_sgn_e" external gammastar : float -> float = "ml_gsl_sf_gammastar" external gammastar_e : float -> result = "ml_gsl_sf_gammastar_e" external gammainv : float -> float = "ml_gsl_sf_gammainv" external gammainv_e : float -> result = "ml_gsl_sf_gammainv_e" external lngamma_complex_e : float -> float -> result * result = "ml_gsl_sf_lngamma_complex_e" external taylorcoeff : int -> float -> float = "ml_gsl_sf_taylorcoeff" external taylorcoeff_e : int -> float -> result = "ml_gsl_sf_taylorcoeff_e" external fact : int -> float = "ml_gsl_sf_fact" external fact_e : int -> result = "ml_gsl_sf_fact_e" external doublefact : int -> float = "ml_gsl_sf_doublefact" external doublefact_e : int -> result = "ml_gsl_sf_doublefact_e" external lnfact : int -> float = "ml_gsl_sf_lnfact" external lnfact_e : int -> result = "ml_gsl_sf_lnfact_e" external lndoublefact : int -> float = "ml_gsl_sf_lndoublefact" external lndoublefact_e : int -> result = "ml_gsl_sf_lndoublefact_e" external choose : int -> int -> float = "ml_gsl_sf_choose" external choose_e : int -> int -> result = "ml_gsl_sf_choose_e" external lnchoose : int -> int -> float = "ml_gsl_sf_lnchoose" external lnchoose_e : int -> int -> result = "ml_gsl_sf_lnchoose_e" external poch : float -> float -> float = "ml_gsl_sf_poch" external poch_e : float -> float -> result = "ml_gsl_sf_poch_e" external lnpoch : float -> float -> float = "ml_gsl_sf_lnpoch" external lnpoch_e : float -> float -> result = "ml_gsl_sf_lnpoch_e" external lnpoch_sgn_e : float -> float -> result * float = "ml_gsl_sf_lngamma_sgn_e" external pochrel : float -> float -> float = "ml_gsl_sf_pochrel" external pochrel_e : float -> float -> result = "ml_gsl_sf_pochrel_e" external gamma_inc_Q : float -> float -> float = "ml_gsl_sf_gamma_inc_Q" external gamma_inc_Q_e : float -> float -> result = "ml_gsl_sf_gamma_inc_Q_e" external gamma_inc_P : float -> float -> float = "ml_gsl_sf_gamma_inc_P" external gamma_inc_P_e : float -> float -> result = "ml_gsl_sf_gamma_inc_P_e" external gamma_inc : float -> float -> float = "ml_gsl_sf_gamma_inc" external gamma_inc_e : float -> float -> result = "ml_gsl_sf_gamma_inc_e" external beta : float -> float -> float = "ml_gsl_sf_beta" external beta_e : float -> float -> result = "ml_gsl_sf_beta_e" external lnbeta : float -> float -> float = "ml_gsl_sf_lnbeta" external lnbeta_e : float -> float -> result = "ml_gsl_sf_lnbeta_e" external lnbeta_sgn_e : float -> float -> result * float = "ml_gsl_sf_lnbeta_sgn_e" external beta_inc : float -> float -> float -> float = "ml_gsl_sf_beta_inc" external beta_inc_e : float -> float -> float -> result = "ml_gsl_sf_beta_inc_e" (* GEGENBAUER functions *) external gegenpoly_1 : float -> float -> float = "ml_gsl_sf_gegenpoly_1" external gegenpoly_1_e : float -> float -> result = "ml_gsl_sf_gegenpoly_1_e" external gegenpoly_2 : float -> float -> float = "ml_gsl_sf_gegenpoly_2" external gegenpoly_2_e : float -> float -> result = "ml_gsl_sf_gegenpoly_2_e" external gegenpoly_3 : float -> float -> float = "ml_gsl_sf_gegenpoly_3" external gegenpoly_3_e : float -> float -> result = "ml_gsl_sf_gegenpoly_3_e" external gegenpoly_n : int -> float -> float -> float = "ml_gsl_sf_gegenpoly_n" external gegenpoly_n_e : int -> float -> float -> result = "ml_gsl_sf_gegenpoly_n_e" external gegenpoly_array : float -> float -> float array -> unit = "ml_gsl_sf_gegenpoly_array" (* HYPERGEOMETRIC functions *) (* FIXME *) (* LAGUERRE functions *) external laguerre_1 : float -> float -> float = "ml_gsl_sf_laguerre_1" external laguerre_1_e : float -> float -> result = "ml_gsl_sf_laguerre_1_e" external laguerre_2 : float -> float -> float = "ml_gsl_sf_laguerre_2" external laguerre_2_e : float -> float -> result = "ml_gsl_sf_laguerre_2_e" external laguerre_3 : float -> float -> float = "ml_gsl_sf_laguerre_3" external laguerre_3_e : float -> float -> result = "ml_gsl_sf_laguerre_3_e" external laguerre_n : int -> float -> float -> float = "ml_gsl_sf_laguerre_n" external laguerre_n_e : int -> float -> float -> result = "ml_gsl_sf_laguerre_n_e" (* LAMBERT W functions *) external lambert_W0 : float -> float = "ml_gsl_sf_lambert_W0" external lambert_W0_e : float -> result = "ml_gsl_sf_lambert_W0_e" external lambert_Wm1 : float -> float = "ml_gsl_sf_lambert_Wm1" external lambert_Wm1_e : float -> result = "ml_gsl_sf_lambert_Wm1_e" (* LEGENDRE functions *) external legendre_P1 : float -> float = "ml_gsl_sf_legendre_P1" external legendre_P1_e : float -> result = "ml_gsl_sf_legendre_P1_e" external legendre_P2 : float -> float = "ml_gsl_sf_legendre_P2" external legendre_P2_e : float -> result = "ml_gsl_sf_legendre_P2_e" external legendre_P3 : float -> float = "ml_gsl_sf_legendre_P3" external legendre_P3_e : float -> result = "ml_gsl_sf_legendre_P3_e" external legendre_Pl : int -> float -> float = "ml_gsl_sf_legendre_Pl" external legendre_Pl_e : int -> float -> result = "ml_gsl_sf_legendre_Pl_e" external legendre_Pl_array : float -> float array -> unit = "ml_gsl_sf_legendre_Pl_array" external legendre_Q0 : float -> float = "ml_gsl_sf_legendre_Q0" external legendre_Q0_e : float -> result = "ml_gsl_sf_legendre_Q0_e" external legendre_Q1 : float -> float = "ml_gsl_sf_legendre_Q1" external legendre_Q1_e : float -> result = "ml_gsl_sf_legendre_Q1_e" external legendre_Ql : int -> float -> float = "ml_gsl_sf_legendre_Ql" external legendre_Ql_e : int -> float -> result = "ml_gsl_sf_legendre_Ql_e" (* Associated LEGENDRE functions *) external legendre_Plm : int -> int -> float -> float = "ml_gsl_sf_legendre_Plm" external legendre_Plm_e : int -> int -> float -> result = "ml_gsl_sf_legendre_Plm_e" (* FIXME: linking problem with GSL 2.0 *) (* <:ext< legendre_Plm_array@ml_gsl_sf_legendre_Plm_array,int,int,float,float array,unit >> *) external legendre_sphPlm : int -> int -> float -> float = "ml_gsl_sf_legendre_sphPlm" external legendre_sphPlm_e : int -> int -> float -> result = "ml_gsl_sf_legendre_sphPlm_e" (* FIXME: linking problem with GSL 2.0 *) (* <:ext< legendre_sphPlm_array@ml_gsl_sf_legendre_sphPlm_array,int,int,float,float array,unit >> *) (* FIXME: linking problem with GSL 2.0 *) (* <:ext< legendre_array_size@ml_gsl_sf_legendre_array_size,int,int,int >> *) (* LOGARITHM and related functions *) external log : float -> float = "ml_gsl_sf_log" external log_e : float -> result = "ml_gsl_sf_log_e" external log_abs : float -> float = "ml_gsl_sf_log_abs" external log_abs_e : float -> result = "ml_gsl_sf_log_abs_e" external log_complex_e : float -> float -> result * result = "ml_gsl_sf_complex_log_e" external log_1plusx : float -> float = "ml_gsl_sf_log_1plusx" external log_1plusx_e : float -> result = "ml_gsl_sf_log_1plusx_e" external log_1plusx_mx : float -> float = "ml_gsl_sf_log_1plusx_mx" external log_1plusx_mx_e : float -> result = "ml_gsl_sf_log_1plusx_mx_e" (* POWER function *) external pow_int : float -> int -> float = "ml_gsl_sf_pow_int" external pow_int_e : float -> int -> result = "ml_gsl_sf_pow_int_e" (* PSI function *) external psi_int : int -> float = "ml_gsl_sf_psi_int" external psi_int_e : int -> result = "ml_gsl_sf_psi_int_e" external psi : float -> float = "ml_gsl_sf_psi" external psi_e : float -> result = "ml_gsl_sf_psi_e" external psi_1piy : float -> float = "ml_gsl_sf_psi_1piy" external psi_1piy_e : float -> result = "ml_gsl_sf_psi_1piy_e" external psi_complex_e : float -> float -> result * result = "ml_gsl_sf_complex_psi_e" external psi_1_int : int -> float = "ml_gsl_sf_psi_1_int" external psi_1_int_e : int -> result = "ml_gsl_sf_psi_1_int_e" external psi_1 : float -> float = "ml_gsl_sf_psi_1" external psi_1_e : float -> result = "ml_gsl_sf_psi_1_e" external psi_n : int -> float -> float = "ml_gsl_sf_psi_n" external psi_n_e : int -> float -> result = "ml_gsl_sf_psi_n_e" (* SYNCHROTRON functions *) external synchrotron_1 : float -> float = "ml_gsl_sf_synchrotron_1" external synchrotron_1_e : float -> result = "ml_gsl_sf_synchrotron_1_e" external synchrotron_2 : float -> float = "ml_gsl_sf_synchrotron_2" external synchrotron_2_e : float -> result = "ml_gsl_sf_synchrotron_2_e" (* TRANSPORT functions *) external transport_2 : float -> float = "ml_gsl_sf_transport_2" external transport_2_e : float -> result = "ml_gsl_sf_transport_2_e" external transport_3 : float -> float = "ml_gsl_sf_transport_3" external transport_3_e : float -> result = "ml_gsl_sf_transport_3_e" external transport_4 : float -> float = "ml_gsl_sf_transport_4" external transport_4_e : float -> result = "ml_gsl_sf_transport_4_e" external transport_5 : float -> float = "ml_gsl_sf_transport_5" external transport_5_e : float -> result = "ml_gsl_sf_transport_5_e" (* TRIGONOMETRIC functions *) external sin : float -> float = "ml_gsl_sf_sin" "gsl_sf_sin" "float" external sin_e : float -> result = "ml_gsl_sf_sin_e" external cos : float -> float = "ml_gsl_sf_cos" "gsl_sf_cos" "float" external cos_e : float -> result = "ml_gsl_sf_cos_e" external hypot : float -> float -> float = "ml_gsl_sf_hypot" external hypot_e : float -> float -> result = "ml_gsl_sf_hypot_e" external sinc : float -> float = "ml_gsl_sf_sinc" "gsl_sf_sinc" "float" external sinc_e : float -> result = "ml_gsl_sf_sinc_e" external complex_sin_e : float -> float -> result * result = "ml_gsl_sf_complex_sin_e" external complex_cos_e : float -> float -> result * result = "ml_gsl_sf_complex_cos_e" external complex_logsin_e : float -> float -> result * result = "ml_gsl_sf_complex_logsin_e" external lnsinh : float -> float = "ml_gsl_sf_lnsinh" external lnsinh_e : float -> result = "ml_gsl_sf_lnsinh_e" external lncosh : float -> float = "ml_gsl_sf_lncosh" external lncosh_e : float -> result = "ml_gsl_sf_lncosh_e" external rect_of_polar : r:float -> theta:float -> result * result = "ml_gsl_sf_polar_to_rect" external polar_of_rect : x:float -> y:float -> result * result = "ml_gsl_sf_rect_to_polar" external angle_restrict_symm : float -> float = "ml_gsl_sf_angle_restrict_symm" external angle_restrict_pos : float -> float = "ml_gsl_sf_angle_restrict_pos" external sin_err_e : float -> dx:float -> result = "ml_gsl_sf_sin_err_e" external cos_err_e : float -> dx:float -> result = "ml_gsl_sf_cos_err_e" (* ZETA functions *) external zeta_int : int -> float = "ml_gsl_sf_zeta_int" external zeta_int_e : int -> result = "ml_gsl_sf_zeta_int_e" external zeta : float -> float = "ml_gsl_sf_zeta" external zeta_e : float -> result = "ml_gsl_sf_zeta_e" external hzeta : float -> float -> float = "ml_gsl_sf_hzeta" external hzeta_e : float -> float -> result = "ml_gsl_sf_hzeta_e" external eta_int : int -> float = "ml_gsl_sf_eta_int" external eta_int_e : int -> result = "ml_gsl_sf_eta_int_e" external eta : float -> float = "ml_gsl_sf_eta" external eta_e : float -> result = "ml_gsl_sf_eta_e" gsl-ocaml-1.19.1/lib/gsl_sf.mli000066400000000000000000000712671262311274100162230ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Special functions *) open Gsl_fun (* AIRY functions *) external airy_Ai : float -> mode -> float = "ml_gsl_sf_airy_Ai" external airy_Ai_e : float -> mode -> result = "ml_gsl_sf_airy_Ai_e" external airy_Bi : float -> mode -> float = "ml_gsl_sf_airy_Bi" external airy_Bi_e : float -> mode -> result = "ml_gsl_sf_airy_Bi_e" external airy_Ai_scaled : float -> mode -> float = "ml_gsl_sf_airy_Ai_scaled" external airy_Ai_scaled_e : float -> mode -> result = "ml_gsl_sf_airy_Ai_scaled_e" external airy_Bi_scaled : float -> mode -> float = "ml_gsl_sf_airy_Bi_scaled" external airy_Bi_scaled_e : float -> mode -> result = "ml_gsl_sf_airy_Bi_scaled_e" external airy_Ai_deriv : float -> mode -> float = "ml_gsl_sf_airy_Ai_deriv" external airy_Ai_deriv_e : float -> mode -> result = "ml_gsl_sf_airy_Ai_deriv_e" external airy_Bi_deriv : float -> mode -> float = "ml_gsl_sf_airy_Bi_deriv" external airy_Bi_deriv_e : float -> mode -> result = "ml_gsl_sf_airy_Bi_deriv_e" external airy_Ai_deriv_scaled : float -> mode -> float = "ml_gsl_sf_airy_Ai_deriv_scaled" external airy_Ai_deriv_scaled_e : float -> mode -> result = "ml_gsl_sf_airy_Ai_deriv_scaled_e" external airy_Bi_deriv_scaled : float -> mode -> float = "ml_gsl_sf_airy_Bi_deriv_scaled" external airy_Bi_deriv_scaled_e : float -> mode -> result = "ml_gsl_sf_airy_Bi_deriv_scaled_e" external airy_zero_Ai : int -> float = "ml_gsl_sf_airy_zero_Ai" external airy_zero_Ai_e : int -> result = "ml_gsl_sf_airy_zero_Ai_e" external airy_zero_Bi : int -> float = "ml_gsl_sf_airy_zero_Bi" external airy_zero_Bi_e : int -> result = "ml_gsl_sf_airy_zero_Bi_e" (* BESSEL functions *) external bessel_J0 : float -> float = "ml_gsl_sf_bessel_J0" external bessel_J0_e : float -> result = "ml_gsl_sf_bessel_J0_e" external bessel_J1 : float -> float = "ml_gsl_sf_bessel_J1" external bessel_J1_e : float -> result = "ml_gsl_sf_bessel_J1_e" external bessel_Jn : int -> float -> float = "ml_gsl_sf_bessel_Jn" external bessel_Jn_e : int -> float -> result = "ml_gsl_sf_bessel_Jn_e" external bessel_Jn_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_Jn_array" external bessel_Y0 : float -> float = "ml_gsl_sf_bessel_Y0" external bessel_Y0_e : float -> result = "ml_gsl_sf_bessel_Y0_e" external bessel_Y1 : float -> float = "ml_gsl_sf_bessel_Y1" external bessel_Y1_e : float -> result = "ml_gsl_sf_bessel_Y1_e" external bessel_Yn : int -> float -> float = "ml_gsl_sf_bessel_Yn" external bessel_Yn_e : int -> float -> result = "ml_gsl_sf_bessel_Yn_e" external bessel_Yn_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_Yn_array" external bessel_I0 : float -> float = "ml_gsl_sf_bessel_I0" external bessel_I0_e : float -> result = "ml_gsl_sf_bessel_I0_e" external bessel_I1 : float -> float = "ml_gsl_sf_bessel_I1" external bessel_I1_e : float -> result = "ml_gsl_sf_bessel_I1_e" external bessel_In : int -> float -> float = "ml_gsl_sf_bessel_In" external bessel_In_e : int -> float -> result = "ml_gsl_sf_bessel_In_e" external bessel_In_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_In_array" external bessel_K0 : float -> float = "ml_gsl_sf_bessel_K0" external bessel_K0_e : float -> result = "ml_gsl_sf_bessel_K0_e" external bessel_K1 : float -> float = "ml_gsl_sf_bessel_K1" external bessel_K1_e : float -> result = "ml_gsl_sf_bessel_K1_e" external bessel_Kn : int -> float -> float = "ml_gsl_sf_bessel_Kn" external bessel_Kn_e : int -> float -> result = "ml_gsl_sf_bessel_Kn_e" external bessel_Kn_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_Kn_array" external bessel_I0_scaled : float -> float = "ml_gsl_sf_bessel_I0_scaled" external bessel_I0_scaled_e : float -> result = "ml_gsl_sf_bessel_I0_scaled_e" external bessel_I1_scaled : float -> float = "ml_gsl_sf_bessel_I1_scaled" external bessel_I1_scaled_e : float -> result = "ml_gsl_sf_bessel_I1_scaled_e" external bessel_In_scaled : int -> float -> float = "ml_gsl_sf_bessel_In_scaled" external bessel_In_scaled_e : int -> float -> result = "ml_gsl_sf_bessel_In_scaled_e" external bessel_In_scaled_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_In_scaled_array" external bessel_K0_scaled : float -> float = "ml_gsl_sf_bessel_K0_scaled" external bessel_K0_scaled_e : float -> result = "ml_gsl_sf_bessel_K0_scaled_e" external bessel_K1_scaled : float -> float = "ml_gsl_sf_bessel_K1_scaled" external bessel_K1_scaled_e : float -> result = "ml_gsl_sf_bessel_K1_scaled_e" external bessel_Kn_scaled : int -> float -> float = "ml_gsl_sf_bessel_Kn_scaled" external bessel_Kn_scaled_e : int -> float -> result = "ml_gsl_sf_bessel_Kn_scaled_e" external bessel_Kn_scaled_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_Kn_scaled_array" external bessel_j0 : float -> float = "ml_gsl_sf_bessel_j0" external bessel_j0_e : float -> result = "ml_gsl_sf_bessel_j0_e" external bessel_j1 : float -> float = "ml_gsl_sf_bessel_j1" external bessel_j1_e : float -> result = "ml_gsl_sf_bessel_j1_e" external bessel_j2 : float -> float = "ml_gsl_sf_bessel_j2" external bessel_j2_e : float -> result = "ml_gsl_sf_bessel_j2_e" external bessel_jl : int -> float -> float = "ml_gsl_sf_bessel_jl" external bessel_jl_e : int -> float -> result = "ml_gsl_sf_bessel_jl_e" external bessel_jl_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_jl_array" external bessel_jl_steed_array : float -> float array -> unit = "ml_gsl_sf_bessel_jl_steed_array" external bessel_y0 : float -> float = "ml_gsl_sf_bessel_y0" external bessel_y0_e : float -> result = "ml_gsl_sf_bessel_y0_e" external bessel_y1 : float -> float = "ml_gsl_sf_bessel_y1" external bessel_y1_e : float -> result = "ml_gsl_sf_bessel_y1_e" external bessel_y2 : float -> float = "ml_gsl_sf_bessel_y2" external bessel_y2_e : float -> result = "ml_gsl_sf_bessel_y2_e" external bessel_yl : int -> float -> float = "ml_gsl_sf_bessel_yl" external bessel_yl_e : int -> float -> result = "ml_gsl_sf_bessel_yl_e" external bessel_yl_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_yl_array" external bessel_i0_scaled : float -> float = "ml_gsl_sf_bessel_i0_scaled" external bessel_i0_scaled_e : float -> result = "ml_gsl_sf_bessel_i0_scaled_e" external bessel_i1_scaled : float -> float = "ml_gsl_sf_bessel_i1_scaled" external bessel_i1_scaled_e : float -> result = "ml_gsl_sf_bessel_i1_scaled_e" external bessel_il_scaled : int -> float -> float = "ml_gsl_sf_bessel_il_scaled" external bessel_il_scaled_e : int -> float -> result = "ml_gsl_sf_bessel_il_scaled_e" external bessel_il_scaled_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_il_scaled_array" external bessel_k0_scaled : float -> float = "ml_gsl_sf_bessel_k0_scaled" external bessel_k0_scaled_e : float -> result = "ml_gsl_sf_bessel_k0_scaled_e" external bessel_k1_scaled : float -> float = "ml_gsl_sf_bessel_k1_scaled" external bessel_k1_scaled_e : float -> result = "ml_gsl_sf_bessel_k1_scaled_e" external bessel_kl_scaled : int -> float -> float = "ml_gsl_sf_bessel_kl_scaled" external bessel_kl_scaled_e : int -> float -> result = "ml_gsl_sf_bessel_kl_scaled_e" external bessel_kl_scaled_array : int -> float -> float array -> unit = "ml_gsl_sf_bessel_kl_scaled_array" external bessel_Jnu : float -> float -> float = "ml_gsl_sf_bessel_Jnu" external bessel_Jnu_e : float -> float -> result = "ml_gsl_sf_bessel_Jnu_e" external bessel_sequence_Jnu_e : float -> mode -> float array -> unit = "ml_gsl_sf_bessel_sequence_Jnu_e" external bessel_Ynu : float -> float -> float = "ml_gsl_sf_bessel_Ynu" external bessel_Ynu_e : float -> float -> result = "ml_gsl_sf_bessel_Ynu_e" external bessel_Inu : float -> float -> float = "ml_gsl_sf_bessel_Inu" external bessel_Inu_e : float -> float -> result = "ml_gsl_sf_bessel_Inu_e" external bessel_Inu_scaled : float -> float -> float = "ml_gsl_sf_bessel_Inu_scaled" external bessel_Inu_scaled_e : float -> float -> result = "ml_gsl_sf_bessel_Inu_scaled_e" external bessel_Knu : float -> float -> float = "ml_gsl_sf_bessel_Knu" external bessel_Knu_e : float -> float -> result = "ml_gsl_sf_bessel_Knu_e" external bessel_lnKnu : float -> float -> float = "ml_gsl_sf_bessel_lnKnu" external bessel_lnKnu_e : float -> float -> result = "ml_gsl_sf_bessel_lnKnu_e" external bessel_Knu_scaled : float -> float -> float = "ml_gsl_sf_bessel_Knu_scaled" external bessel_Knu_scaled_e : float -> float -> result = "ml_gsl_sf_bessel_Knu_scaled_e" external bessel_zero_J0 : int -> float = "ml_gsl_sf_bessel_zero_J0" external bessel_zero_J0_e : int -> result = "ml_gsl_sf_bessel_zero_J0_e" external bessel_zero_J1 : int -> float = "ml_gsl_sf_bessel_zero_J1" external bessel_zero_J1_e : int -> result = "ml_gsl_sf_bessel_zero_J1_e" external bessel_zero_Jnu : float -> int -> float = "ml_gsl_sf_bessel_zero_Jnu" external bessel_zero_Jnu_e : float -> int -> result = "ml_gsl_sf_bessel_zero_Jnu_e" (* CLAUSEN functions *) external clausen : float -> float = "ml_gsl_sf_clausen" external clausen_e : float -> result = "ml_gsl_sf_clausen_e" (* COULOMB functions *) external hydrogenicR_1 : float -> float -> float = "ml_gsl_sf_hydrogenicR_1" external hydrogenicR_1_e : float -> float -> result = "ml_gsl_sf_hydrogenicR_1_e" external hydrogenicR : int -> int -> float -> float -> float = "ml_gsl_sf_hydrogenicR" external hydrogenicR_e : int -> int -> float -> float -> result = "ml_gsl_sf_hydrogenicR_e" (* FIXME: COULOMB wave functions *) external coulomb_CL_e : float -> float -> result = "ml_gsl_sf_coulomb_CL_e" external coulomb_CL_array : float -> float -> float array -> unit = "ml_gsl_sf_coulomb_CL_array" (* FIXME: coupling coeffs *) (* DAWSON functions *) external dawson : float -> float = "ml_gsl_sf_dawson" external dawson_e : float -> result = "ml_gsl_sf_dawson_e" (* DEBYE functions *) external debye_1 : float -> float = "ml_gsl_sf_debye_1" external debye_1_e : float -> result = "ml_gsl_sf_debye_1_e" external debye_2 : float -> float = "ml_gsl_sf_debye_2" external debye_2_e : float -> result = "ml_gsl_sf_debye_2_e" external debye_3 : float -> float = "ml_gsl_sf_debye_3" external debye_3_e : float -> result = "ml_gsl_sf_debye_3_e" external debye_4 : float -> float = "ml_gsl_sf_debye_4" external debye_4_e : float -> result = "ml_gsl_sf_debye_4_e" external debye_5 : float -> float = "ml_gsl_sf_debye_5" external debye_5_e : float -> result = "ml_gsl_sf_debye_5_e" external debye_6 : float -> float = "ml_gsl_sf_debye_6" external debye_6_e : float -> result = "ml_gsl_sf_debye_6_e" (* DILOGARITHM *) external dilog : float -> float = "ml_gsl_sf_dilog" external dilog_e : float -> result = "ml_gsl_sf_dilog_e" external complex_dilog_xy_e : float -> float -> result * result = "ml_gsl_sf_complex_dilog_xy_e" external complex_dilog_e : float -> float -> result * result = "ml_gsl_sf_complex_dilog_e" external complex_spence_xy_e : float -> float -> result * result = "ml_gsl_sf_complex_spence_xy_e" (* ELEMENTARY operations *) external multiply_e : float -> float -> result = "ml_gsl_sf_multiply_e" external multiply_err_e : x:float -> dx:float -> y:float -> dy:float -> result = "ml_gsl_sf_multiply_err_e" (* ELLIPTIC integrals *) external ellint_Kcomp : float -> mode -> float = "ml_gsl_sf_ellint_Kcomp" external ellint_Kcomp_e : float -> mode -> result = "ml_gsl_sf_ellint_Kcomp_e" external ellint_Ecomp : float -> mode -> float = "ml_gsl_sf_ellint_Ecomp" external ellint_Ecomp_e : float -> mode -> result = "ml_gsl_sf_ellint_Ecomp_e" external ellint_Pcomp : float -> float -> mode -> float = "ml_gsl_sf_ellint_Pcomp" external ellint_Pcomp_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_Pcomp_e" external ellint_Dcomp : float -> mode -> float = "ml_gsl_sf_ellint_Dcomp" external ellint_Dcomp_e : float -> mode -> result = "ml_gsl_sf_ellint_Dcomp_e" external ellint_F : float -> float -> mode -> float = "ml_gsl_sf_ellint_F" external ellint_F_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_F_e" external ellint_E : float -> float -> mode -> float = "ml_gsl_sf_ellint_E" external ellint_E_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_E_e" external ellint_P : float -> float -> float -> mode -> float = "ml_gsl_sf_ellint_P" external ellint_P_e : float -> float -> float -> mode -> result = "ml_gsl_sf_ellint_P_e" external ellint_D : float -> float -> mode -> float = "ml_gsl_sf_ellint_D" external ellint_D_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_D_e" external ellint_RC : float -> float -> mode -> float = "ml_gsl_sf_ellint_RC" external ellint_RC_e : float -> float -> mode -> result = "ml_gsl_sf_ellint_RC_e" external ellint_RD : float -> float -> float -> mode -> float = "ml_gsl_sf_ellint_RD" external ellint_RD_e : float -> float -> float -> mode -> result = "ml_gsl_sf_ellint_RD_e" external ellint_RF : float -> float -> float -> mode -> float = "ml_gsl_sf_ellint_RF" external ellint_RF_e : float -> float -> float -> mode -> result = "ml_gsl_sf_ellint_RF_e" external ellint_RJ : float -> float -> float -> float -> mode -> float = "ml_gsl_sf_ellint_RJ" external ellint_RJ_e : float -> float -> float -> float -> mode -> result = "ml_gsl_sf_ellint_RJ_e" (* FIXME: elljac_e *) (* ERROR function *) external erf : float -> float = "ml_gsl_sf_erf" "gsl_sf_erf" "float" external erf_e : float -> result = "ml_gsl_sf_erf_e" external erfc : float -> float = "ml_gsl_sf_erfc" "gsl_sf_erfc" "float" external erfc_e : float -> result = "ml_gsl_sf_erfc_e" external log_erfc : float -> float = "ml_gsl_sf_log_erfc" "gsl_sf_log_erfc" "float" external log_erfc_e : float -> result = "ml_gsl_sf_log_erfc_e" external erf_Z : float -> float = "ml_gsl_sf_erf_Z" "gsl_sf_erf_Z" "float" external erf_Z_e : float -> result = "ml_gsl_sf_erf_Z_e" external erf_Q : float -> float = "ml_gsl_sf_erf_Q" "gsl_sf_erf_Q" "float" external erf_Q_e : float -> result = "ml_gsl_sf_erf_Q_e" (* EXPONENTIAL functions *) external exp : float -> float = "ml_gsl_sf_exp" "gsl_sf_exp" "float" external exp_e : float -> result = "ml_gsl_sf_exp_e" external exp_e10 : float -> result_e10 = "ml_gsl_sf_exp_e10_e" external exp_mult : float -> float -> float = "ml_gsl_sf_exp_mult" external exp_mult_e : float -> float -> result = "ml_gsl_sf_exp_mult_e" external exp_mult_e10 : float -> float -> result_e10 = "ml_gsl_sf_exp_mult_e10_e" external expm1 : float -> float = "ml_gsl_sf_expm1" external expm1_e : float -> result = "ml_gsl_sf_expm1_e" external exprel : float -> float = "ml_gsl_sf_exprel" external exprel_e : float -> result = "ml_gsl_sf_exprel_e" external exprel_2 : float -> float = "ml_gsl_sf_exprel_2" external exprel_2_e : float -> result = "ml_gsl_sf_exprel_2_e" external exprel_n : int -> float -> float = "ml_gsl_sf_exprel_n" external exprel_n_e : int -> float -> result = "ml_gsl_sf_exprel_n_e" external exp_err_e : x:float -> dx:float -> result = "ml_gsl_sf_exp_err_e" external exp_err_e10 : x:float -> dx:float -> result_e10 = "ml_gsl_sf_exp_err_e10_e" external exp_mult_err_e : x:float -> dx:float -> y:float -> dy:float -> result = "ml_gsl_sf_exp_mult_err_e" external exp_mult_err_e10_e : x:float -> dx:float -> y:float -> dy:float -> result_e10 = "ml_gsl_sf_exp_mult_err_e10_e" (* EXPONENTIAL integrals *) external expint_E1 : float -> float = "ml_gsl_sf_expint_E1" external expint_E1_e : float -> result = "ml_gsl_sf_expint_E1_e" external expint_E2 : float -> float = "ml_gsl_sf_expint_E2" external expint_E2_e : float -> result = "ml_gsl_sf_expint_E2_e" external expint_E1_scaled : float -> float = "ml_gsl_sf_expint_E1_scaled" external expint_E1_scaled_e : float -> result = "ml_gsl_sf_expint_E1_scaled_e" external expint_E2_scaled : float -> float = "ml_gsl_sf_expint_E2_scaled" external expint_E2_scaled_e : float -> result = "ml_gsl_sf_expint_E2_scaled_e" external expint_Ei : float -> float = "ml_gsl_sf_expint_Ei" external expint_Ei_e : float -> result = "ml_gsl_sf_expint_Ei_e" external expint_Ei_scaled : float -> float = "ml_gsl_sf_expint_Ei_scaled" external expint_Ei_scaled_e : float -> result = "ml_gsl_sf_expint_Ei_scaled_e" external shi : float -> float = "ml_gsl_sf_Shi" external chi : float -> float = "ml_gsl_sf_Chi" external expint_3 : float -> float = "ml_gsl_sf_expint_3" external expint_3_e : float -> result = "ml_gsl_sf_expint_3_e" external si : float -> float = "ml_gsl_sf_Si" external ci : float -> float = "ml_gsl_sf_Ci" external atanint : float -> float = "ml_gsl_sf_atanint" external atanint_e : float -> result = "ml_gsl_sf_atanint_e" (* fermi-dirac *) external fermi_dirac_m1 : float -> float = "ml_gsl_sf_fermi_dirac_m1" external fermi_dirac_m1_e : float -> result = "ml_gsl_sf_fermi_dirac_m1_e" external fermi_dirac_0 : float -> float = "ml_gsl_sf_fermi_dirac_0" external fermi_dirac_0_e : float -> result = "ml_gsl_sf_fermi_dirac_0_e" external fermi_dirac_1 : float -> float = "ml_gsl_sf_fermi_dirac_1" external fermi_dirac_1_e : float -> result = "ml_gsl_sf_fermi_dirac_1_e" external fermi_dirac_2 : float -> float = "ml_gsl_sf_fermi_dirac_2" external fermi_dirac_2_e : float -> result = "ml_gsl_sf_fermi_dirac_2_e" external fermi_dirac_int : int -> float -> float = "ml_gsl_sf_fermi_dirac_int" external fermi_dirac_int_e : int -> float -> result = "ml_gsl_sf_fermi_dirac_int_e" external fermi_dirac_mhalf : float -> float = "ml_gsl_sf_fermi_dirac_mhalf" external fermi_dirac_mhalf_e : float -> result = "ml_gsl_sf_fermi_dirac_mhalf_e" external fermi_dirac_half : float -> float = "ml_gsl_sf_fermi_dirac_half" external fermi_dirac_half_e : float -> result = "ml_gsl_sf_fermi_dirac_half_e" external fermi_dirac_3half : float -> float = "ml_gsl_sf_fermi_dirac_3half" external fermi_dirac_3half_e : float -> result = "ml_gsl_sf_fermi_dirac_3half_e" external fermi_dirac_inc_0 : float -> float -> float = "ml_gsl_sf_fermi_dirac_inc_0" external fermi_dirac_inc_0_e : float -> float -> result = "ml_gsl_sf_fermi_dirac_inc_0_e" (* Gamma function *) external gamma : float -> float = "ml_gsl_sf_gamma" external gamma_e : float -> result = "ml_gsl_sf_gamma_e" external lngamma : float -> float = "ml_gsl_sf_lngamma" external lngamma_e : float -> result = "ml_gsl_sf_lngamma_e" external lngamma_sgn_e : float -> result * float = "ml_gsl_sf_lngamma_sgn_e" external gammastar : float -> float = "ml_gsl_sf_gammastar" external gammastar_e : float -> result = "ml_gsl_sf_gammastar_e" external gammainv : float -> float = "ml_gsl_sf_gammainv" external gammainv_e : float -> result = "ml_gsl_sf_gammainv_e" external lngamma_complex_e : float -> float -> result * result = "ml_gsl_sf_lngamma_complex_e" external taylorcoeff : int -> float -> float = "ml_gsl_sf_taylorcoeff" external taylorcoeff_e : int -> float -> result = "ml_gsl_sf_taylorcoeff_e" external fact : int -> float = "ml_gsl_sf_fact" external fact_e : int -> result = "ml_gsl_sf_fact_e" external doublefact : int -> float = "ml_gsl_sf_doublefact" external doublefact_e : int -> result = "ml_gsl_sf_doublefact_e" external lnfact : int -> float = "ml_gsl_sf_lnfact" external lnfact_e : int -> result = "ml_gsl_sf_lnfact_e" external lndoublefact : int -> float = "ml_gsl_sf_lndoublefact" external lndoublefact_e : int -> result = "ml_gsl_sf_lndoublefact_e" external choose : int -> int -> float = "ml_gsl_sf_choose" external choose_e : int -> int -> result = "ml_gsl_sf_choose_e" external lnchoose : int -> int -> float = "ml_gsl_sf_lnchoose" external lnchoose_e : int -> int -> result = "ml_gsl_sf_lnchoose_e" external poch : float -> float -> float = "ml_gsl_sf_poch" external poch_e : float -> float -> result = "ml_gsl_sf_poch_e" external lnpoch : float -> float -> float = "ml_gsl_sf_lnpoch" external lnpoch_e : float -> float -> result = "ml_gsl_sf_lnpoch_e" external lnpoch_sgn_e : float -> float -> result * float = "ml_gsl_sf_lngamma_sgn_e" external pochrel : float -> float -> float = "ml_gsl_sf_pochrel" external pochrel_e : float -> float -> result = "ml_gsl_sf_pochrel_e" external gamma_inc_Q : float -> float -> float = "ml_gsl_sf_gamma_inc_Q" external gamma_inc_Q_e : float -> float -> result = "ml_gsl_sf_gamma_inc_Q_e" external gamma_inc_P : float -> float -> float = "ml_gsl_sf_gamma_inc_P" external gamma_inc_P_e : float -> float -> result = "ml_gsl_sf_gamma_inc_P_e" external gamma_inc : float -> float -> float = "ml_gsl_sf_gamma_inc" external gamma_inc_e : float -> float -> result = "ml_gsl_sf_gamma_inc_e" external beta : float -> float -> float = "ml_gsl_sf_beta" external beta_e : float -> float -> result = "ml_gsl_sf_beta_e" external lnbeta : float -> float -> float = "ml_gsl_sf_lnbeta" external lnbeta_e : float -> float -> result = "ml_gsl_sf_lnbeta_e" external lnbeta_sgn_e : float -> float -> result * float = "ml_gsl_sf_lnbeta_sgn_e" external beta_inc : float -> float -> float -> float = "ml_gsl_sf_beta_inc" external beta_inc_e : float -> float -> float -> result = "ml_gsl_sf_beta_inc_e" (* GEGENBAUER functions *) external gegenpoly_1 : float -> float -> float = "ml_gsl_sf_gegenpoly_1" external gegenpoly_1_e : float -> float -> result = "ml_gsl_sf_gegenpoly_1_e" external gegenpoly_2 : float -> float -> float = "ml_gsl_sf_gegenpoly_2" external gegenpoly_2_e : float -> float -> result = "ml_gsl_sf_gegenpoly_2_e" external gegenpoly_3 : float -> float -> float = "ml_gsl_sf_gegenpoly_3" external gegenpoly_3_e : float -> float -> result = "ml_gsl_sf_gegenpoly_3_e" external gegenpoly_n : int -> float -> float -> float = "ml_gsl_sf_gegenpoly_n" external gegenpoly_n_e : int -> float -> float -> result = "ml_gsl_sf_gegenpoly_n_e" external gegenpoly_array : float -> float -> float array -> unit = "ml_gsl_sf_gegenpoly_array" (* HYPERGEOMETRIC functions *) (* FIXME *) (* LAGUERRE functions *) external laguerre_1 : float -> float -> float = "ml_gsl_sf_laguerre_1" external laguerre_1_e : float -> float -> result = "ml_gsl_sf_laguerre_1_e" external laguerre_2 : float -> float -> float = "ml_gsl_sf_laguerre_2" external laguerre_2_e : float -> float -> result = "ml_gsl_sf_laguerre_2_e" external laguerre_3 : float -> float -> float = "ml_gsl_sf_laguerre_3" external laguerre_3_e : float -> float -> result = "ml_gsl_sf_laguerre_3_e" external laguerre_n : int -> float -> float -> float = "ml_gsl_sf_laguerre_n" external laguerre_n_e : int -> float -> float -> result = "ml_gsl_sf_laguerre_n_e" (* LAMBERT W functions *) external lambert_W0 : float -> float = "ml_gsl_sf_lambert_W0" external lambert_W0_e : float -> result = "ml_gsl_sf_lambert_W0_e" external lambert_Wm1 : float -> float = "ml_gsl_sf_lambert_Wm1" external lambert_Wm1_e : float -> result = "ml_gsl_sf_lambert_Wm1_e" (* LEGENDRE functions *) external legendre_P1 : float -> float = "ml_gsl_sf_legendre_P1" external legendre_P1_e : float -> result = "ml_gsl_sf_legendre_P1_e" external legendre_P2 : float -> float = "ml_gsl_sf_legendre_P2" external legendre_P2_e : float -> result = "ml_gsl_sf_legendre_P2_e" external legendre_P3 : float -> float = "ml_gsl_sf_legendre_P3" external legendre_P3_e : float -> result = "ml_gsl_sf_legendre_P3_e" external legendre_Pl : int -> float -> float = "ml_gsl_sf_legendre_Pl" external legendre_Pl_e : int -> float -> result = "ml_gsl_sf_legendre_Pl_e" external legendre_Pl_array : float -> float array -> unit = "ml_gsl_sf_legendre_Pl_array" external legendre_Q0 : float -> float = "ml_gsl_sf_legendre_Q0" external legendre_Q0_e : float -> result = "ml_gsl_sf_legendre_Q0_e" external legendre_Q1 : float -> float = "ml_gsl_sf_legendre_Q1" external legendre_Q1_e : float -> result = "ml_gsl_sf_legendre_Q1_e" external legendre_Ql : int -> float -> float = "ml_gsl_sf_legendre_Ql" external legendre_Ql_e : int -> float -> result = "ml_gsl_sf_legendre_Ql_e" (* Associated LEGENDRE functions *) external legendre_Plm : int -> int -> float -> float = "ml_gsl_sf_legendre_Plm" external legendre_Plm_e : int -> int -> float -> result = "ml_gsl_sf_legendre_Plm_e" (* FIXME: linking problem with GSL 2.0 *) (* <:ext< legendre_Plm_array@ml_gsl_sf_legendre_Plm_array,int,int,float,float array,unit >> *) external legendre_sphPlm : int -> int -> float -> float = "ml_gsl_sf_legendre_sphPlm" external legendre_sphPlm_e : int -> int -> float -> result = "ml_gsl_sf_legendre_sphPlm_e" (* FIXME: linking problem with GSL 2.0 *) (* <:ext< legendre_sphPlm_array@ml_gsl_sf_legendre_sphPlm_array,int,int,float,float array,unit >> *) (* FIXME: linking problem with GSL 2.0 *) (* <:ext< legendre_array_size@ml_gsl_sf_legendre_array_size,int,int,int >> *) (* LOGARITHM and related functions *) external log : float -> float = "ml_gsl_sf_log" external log_e : float -> result = "ml_gsl_sf_log_e" external log_abs : float -> float = "ml_gsl_sf_log_abs" external log_abs_e : float -> result = "ml_gsl_sf_log_abs_e" external log_complex_e : float -> float -> result * result = "ml_gsl_sf_complex_log_e" external log_1plusx : float -> float = "ml_gsl_sf_log_1plusx" external log_1plusx_e : float -> result = "ml_gsl_sf_log_1plusx_e" external log_1plusx_mx : float -> float = "ml_gsl_sf_log_1plusx_mx" external log_1plusx_mx_e : float -> result = "ml_gsl_sf_log_1plusx_mx_e" (* POWER function *) external pow_int : float -> int -> float = "ml_gsl_sf_pow_int" external pow_int_e : float -> int -> result = "ml_gsl_sf_pow_int_e" (* PSI function *) external psi_int : int -> float = "ml_gsl_sf_psi_int" external psi_int_e : int -> result = "ml_gsl_sf_psi_int_e" external psi : float -> float = "ml_gsl_sf_psi" external psi_e : float -> result = "ml_gsl_sf_psi_e" external psi_1piy : float -> float = "ml_gsl_sf_psi_1piy" external psi_1piy_e : float -> result = "ml_gsl_sf_psi_1piy_e" external psi_complex_e : float -> float -> result * result = "ml_gsl_sf_complex_psi_e" external psi_1_int : int -> float = "ml_gsl_sf_psi_1_int" external psi_1_int_e : int -> result = "ml_gsl_sf_psi_1_int_e" external psi_1 : float -> float = "ml_gsl_sf_psi_1" external psi_1_e : float -> result = "ml_gsl_sf_psi_1_e" external psi_n : int -> float -> float = "ml_gsl_sf_psi_n" external psi_n_e : int -> float -> result = "ml_gsl_sf_psi_n_e" (* SYNCHROTRON functions *) external synchrotron_1 : float -> float = "ml_gsl_sf_synchrotron_1" external synchrotron_1_e : float -> result = "ml_gsl_sf_synchrotron_1_e" external synchrotron_2 : float -> float = "ml_gsl_sf_synchrotron_2" external synchrotron_2_e : float -> result = "ml_gsl_sf_synchrotron_2_e" (* TRANSPORT functions *) external transport_2 : float -> float = "ml_gsl_sf_transport_2" external transport_2_e : float -> result = "ml_gsl_sf_transport_2_e" external transport_3 : float -> float = "ml_gsl_sf_transport_3" external transport_3_e : float -> result = "ml_gsl_sf_transport_3_e" external transport_4 : float -> float = "ml_gsl_sf_transport_4" external transport_4_e : float -> result = "ml_gsl_sf_transport_4_e" external transport_5 : float -> float = "ml_gsl_sf_transport_5" external transport_5_e : float -> result = "ml_gsl_sf_transport_5_e" (* TRIGONOMETRIC functions *) external sin : float -> float = "ml_gsl_sf_sin" "gsl_sf_sin" "float" external sin_e : float -> result = "ml_gsl_sf_sin_e" external cos : float -> float = "ml_gsl_sf_cos" "gsl_sf_cos" "float" external cos_e : float -> result = "ml_gsl_sf_cos_e" external hypot : float -> float -> float = "ml_gsl_sf_hypot" external hypot_e : float -> float -> result = "ml_gsl_sf_hypot_e" external sinc : float -> float = "ml_gsl_sf_sinc" "gsl_sf_sinc" "float" external sinc_e : float -> result = "ml_gsl_sf_sinc_e" external complex_sin_e : float -> float -> result * result = "ml_gsl_sf_complex_sin_e" external complex_cos_e : float -> float -> result * result = "ml_gsl_sf_complex_cos_e" external complex_logsin_e : float -> float -> result * result = "ml_gsl_sf_complex_logsin_e" external lnsinh : float -> float = "ml_gsl_sf_lnsinh" external lnsinh_e : float -> result = "ml_gsl_sf_lnsinh_e" external lncosh : float -> float = "ml_gsl_sf_lncosh" external lncosh_e : float -> result = "ml_gsl_sf_lncosh_e" external rect_of_polar : r:float -> theta:float -> result * result = "ml_gsl_sf_polar_to_rect" external polar_of_rect : x:float -> y:float -> result * result = "ml_gsl_sf_rect_to_polar" external angle_restrict_symm : float -> float = "ml_gsl_sf_angle_restrict_symm" external angle_restrict_pos : float -> float = "ml_gsl_sf_angle_restrict_pos" external sin_err_e : float -> dx:float -> result = "ml_gsl_sf_sin_err_e" external cos_err_e : float -> dx:float -> result = "ml_gsl_sf_cos_err_e" (* ZETA functions *) external zeta_int : int -> float = "ml_gsl_sf_zeta_int" external zeta_int_e : int -> result = "ml_gsl_sf_zeta_int_e" external zeta : float -> float = "ml_gsl_sf_zeta" external zeta_e : float -> result = "ml_gsl_sf_zeta_e" external hzeta : float -> float -> float = "ml_gsl_sf_hzeta" external hzeta_e : float -> float -> result = "ml_gsl_sf_hzeta_e" external eta_int : int -> float = "ml_gsl_sf_eta_int" external eta_int_e : int -> result = "ml_gsl_sf_eta_int_e" external eta : float -> float = "ml_gsl_sf_eta" external eta_e : float -> result = "ml_gsl_sf_eta_e" gsl-ocaml-1.19.1/lib/gsl_sf.mli.q000066400000000000000000000173771262311274100164640ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Special functions *) open Gsl_fun (* AIRY functions *) << airy_Ai float mode >> << airy_Bi float mode >> << airy_Ai_scaled float mode >> << airy_Bi_scaled float mode >> << airy_Ai_deriv float mode >> << airy_Bi_deriv float mode >> << airy_Ai_deriv_scaled float mode >> << airy_Bi_deriv_scaled float mode >> << airy_zero_Ai int >> << airy_zero_Bi int >> (* BESSEL functions *) <:bessel< cyl J >> <:bessel< cyl Y >> <:bessel< cyl I >> <:bessel< cyl K >> <:bessel< cyl_scaled I >> <:bessel< cyl_scaled K >> <:bessel< sph j >> <:ext< bessel_jl_steed_array@ml_gsl_sf_bessel_jl_steed_array,float,float array,unit >> <:bessel< sph y >> <:bessel< sph_scaled i >> <:bessel< sph_scaled k >> << bessel_Jnu float float >> <:ext< bessel_sequence_Jnu_e@ml_gsl_sf_bessel_sequence_Jnu_e,float,mode,float array,unit>> << bessel_Ynu float float >> << bessel_Inu float float >> << bessel_Inu_scaled float float >> << bessel_Knu float float >> << bessel_lnKnu float float >> << bessel_Knu_scaled float float >> << bessel_zero_J0 int >> << bessel_zero_J1 int >> << bessel_zero_Jnu float int >> (* CLAUSEN functions *) << clausen float >> (* COULOMB functions *) << hydrogenicR_1 float float >> << hydrogenicR int int float float >> (* FIXME: COULOMB wave functions *) <:ext< coulomb_CL_e@ml_gsl_sf_coulomb_CL_e,float,float,result >> <:ext< coulomb_CL_array@ml_gsl_sf_coulomb_CL_array,float,float,float array,unit >> (* FIXME: coupling coeffs *) (* DAWSON functions *) << dawson float >> (* DEBYE functions *) << debye_1 float >> << debye_2 float >> << debye_3 float >> << debye_4 float >> << debye_5 float >> << debye_6 float >> (* DILOGARITHM *) << dilog float >> <:ext< complex_dilog_xy_e@ml_gsl_sf_complex_dilog_xy_e,float,float,result * result >> <:ext< complex_dilog_e@ml_gsl_sf_complex_dilog_e,float,float,result * result >> <:ext< complex_spence_xy_e@ml_gsl_sf_complex_spence_xy_e,float,float,result * result >> (* ELEMENTARY operations *) <:ext< multiply_e@ml_gsl_sf_multiply_e,float,float,result >> <:ext< multiply_err_e@ml_gsl_sf_multiply_err_e,x:float,dx:float,y:float,dy:float,result >> (* ELLIPTIC integrals *) << ellint_Kcomp float mode >> << ellint_Ecomp float mode >> << ellint_Pcomp float float mode >> << ellint_Dcomp float mode >> << ellint_F float float mode >> << ellint_E float float mode >> << ellint_P float float float mode >> << ellint_D float float mode >> << ellint_RC float float mode >> << ellint_RD float float float mode >> << ellint_RF float float float mode >> << ellint_RJ float float float float mode >> (* FIXME: elljac_e *) (* ERROR function *) << erf float @float >> << erfc float @float >> << log_erfc float @float >> << erf_Z float @float >> << erf_Q float @float >> (* EXPONENTIAL functions *) << exp float @float >> <:ext< exp_e10@ml_gsl_sf_exp_e10_e,float,result_e10 >> << exp_mult float float >> <:ext< exp_mult_e10@ml_gsl_sf_exp_mult_e10_e,float,float,result_e10 >> << expm1 float >> << exprel float >> << exprel_2 float >> << exprel_n int float >> <:ext< exp_err_e@ml_gsl_sf_exp_err_e,x:float,dx:float,result >> <:ext< exp_err_e10@ml_gsl_sf_exp_err_e10_e,x:float,dx:float,result_e10 >> <:ext< exp_mult_err_e@ml_gsl_sf_exp_mult_err_e,x:float,dx:float,y:float,dy:float,result >> <:ext< exp_mult_err_e10_e@ml_gsl_sf_exp_mult_err_e10_e,x:float,dx:float,y:float,dy:float,result_e10 >> (* EXPONENTIAL integrals *) << expint_E1 float >> << expint_E2 float >> << expint_E1_scaled float >> << expint_E2_scaled float >> << expint_Ei float >> << expint_Ei_scaled float >> <:ext< shi@ml_gsl_sf_Shi,float,float >> <:ext< chi@ml_gsl_sf_Chi,float,float >> << expint_3 float >> <:ext< si@ml_gsl_sf_Si,float,float >> <:ext< ci@ml_gsl_sf_Ci,float,float >> << atanint float >> (* fermi-dirac *) << fermi_dirac_m1 float >> << fermi_dirac_0 float >> << fermi_dirac_1 float >> << fermi_dirac_2 float >> << fermi_dirac_int int float >> << fermi_dirac_mhalf float >> << fermi_dirac_half float >> << fermi_dirac_3half float >> << fermi_dirac_inc_0 float float >> (* Gamma function *) <:ext< gamma@ml_gsl_sf_gamma,float,float >> <:ext< gamma_e@ml_gsl_sf_gamma_e,float,result >> << lngamma float >> <:ext< lngamma_sgn_e@ml_gsl_sf_lngamma_sgn_e,float,result * float >> << gammastar float >> << gammainv float >> <:ext< lngamma_complex_e@ml_gsl_sf_lngamma_complex_e,float,float,result * result >> << taylorcoeff int float >> << fact int >> << doublefact int >> << lnfact int >> << lndoublefact int >> << choose int int >> << lnchoose int int >> << poch float float >> << lnpoch float float >> <:ext< lnpoch_sgn_e@ml_gsl_sf_lngamma_sgn_e,float,float,result * float >> << pochrel float float >> << gamma_inc_Q float float >> << gamma_inc_P float float >> << gamma_inc float float >> << beta float float >> << lnbeta float float >> <:ext< lnbeta_sgn_e@ml_gsl_sf_lnbeta_sgn_e,float,float,result * float >> << beta_inc float float float >> (* GEGENBAUER functions *) << gegenpoly_1 float float >> << gegenpoly_2 float float >> << gegenpoly_3 float float >> << gegenpoly_n int float float >> <:ext< gegenpoly_array@ml_gsl_sf_gegenpoly_array,float,float,float array,unit >> (* HYPERGEOMETRIC functions *) (* FIXME *) (* LAGUERRE functions *) << laguerre_1 float float >> << laguerre_2 float float >> << laguerre_3 float float >> << laguerre_n int float float >> (* LAMBERT W functions *) << lambert_W0 float >> << lambert_Wm1 float >> (* LEGENDRE functions *) << legendre_P1 float >> << legendre_P2 float >> << legendre_P3 float >> << legendre_Pl int float >> <:ext< legendre_Pl_array@ml_gsl_sf_legendre_Pl_array,float,float array,unit >> << legendre_Q0 float >> << legendre_Q1 float >> << legendre_Ql int float >> (* Associated LEGENDRE functions *) << legendre_Plm int int float >> (* FIXME: linking problem with GSL 2.0 *) (* <:ext< legendre_Plm_array@ml_gsl_sf_legendre_Plm_array,int,int,float,float array,unit >> *) << legendre_sphPlm int int float >> (* FIXME: linking problem with GSL 2.0 *) (* <:ext< legendre_sphPlm_array@ml_gsl_sf_legendre_sphPlm_array,int,int,float,float array,unit >> *) (* FIXME: linking problem with GSL 2.0 *) (* <:ext< legendre_array_size@ml_gsl_sf_legendre_array_size,int,int,int >> *) (* LOGARITHM and related functions *) << log float >> << log_abs float >> <:ext< log_complex_e@ml_gsl_sf_complex_log_e,float,float,result * result >> << log_1plusx float >> << log_1plusx_mx float >> (* POWER function *) << pow_int float int >> (* PSI function *) << psi_int int >> << psi float >> << psi_1piy float >> <:ext< psi_complex_e@ml_gsl_sf_complex_psi_e,float,float,result * result >> << psi_1_int int >> << psi_1 float >> << psi_n int float >> (* SYNCHROTRON functions *) << synchrotron_1 float >> << synchrotron_2 float >> (* TRANSPORT functions *) << transport_2 float >> << transport_3 float >> << transport_4 float >> << transport_5 float >> (* TRIGONOMETRIC functions *) << sin float @float >> << cos float @float >> << hypot float float >> << sinc float @float >> <:ext< complex_sin_e@ml_gsl_sf_complex_sin_e,float,float,result * result >> <:ext< complex_cos_e@ml_gsl_sf_complex_cos_e,float,float,result * result >> <:ext< complex_logsin_e@ml_gsl_sf_complex_logsin_e,float,float,result * result >> << lnsinh float >> << lncosh float >> <:ext< rect_of_polar@ml_gsl_sf_polar_to_rect,r:float,theta:float,result * result >> <:ext< polar_of_rect@ml_gsl_sf_rect_to_polar,x:float,y:float,result * result >> <:ext< angle_restrict_symm@ml_gsl_sf_angle_restrict_symm,float,float >> <:ext< angle_restrict_pos@ml_gsl_sf_angle_restrict_pos,float,float >> <:ext< sin_err_e@ml_gsl_sf_sin_err_e,float,dx:float,result >> <:ext< cos_err_e@ml_gsl_sf_cos_err_e,float,dx:float,result >> (* ZETA functions *) << zeta_int int >> << zeta float >> << hzeta float float >> << eta_int int >> << eta float >> gsl-ocaml-1.19.1/lib/gsl_siman.ml000066400000000000000000000030171262311274100165350ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type params = { iters_fixed_T : int ; step_size : float ; k : float ; t_initial : float ; mu_t : float ; t_min : float ; } open Gsl_misc let solve rng conf0 ~energ_func ~step_func ?print_func params = let best_energ = ref (energ_func conf0) in let best_x = ref conf0 in let energ = ref !best_energ in let x = ref !best_x in let t = ref params.t_initial in let n_iter = ref 0 in let n_eval = ref 1 in if is print_func then print_string "#-iter #-evals temperature position energy\n" ; while !t >= params.t_min do for _i=1 to params.iters_fixed_T do let new_x = step_func rng !x params.step_size in let new_energ = energ_func new_x in incr n_eval ; if new_energ <= !best_energ then begin best_energ := new_energ ; best_x := new_x end ; if new_energ < !energ || ( let lim = exp (~-. (new_energ -. !energ) /. (!t *. params.k)) in Gsl_rng.uniform rng < lim ) then begin energ := new_energ ; x := new_x ; end done ; if is print_func then begin Printf.printf "%5d %7d %12g" !n_iter !n_eval !t ; may_apply print_func !x ; Printf.printf " %12g\n" !energ end ; t := !t /. params.mu_t ; incr n_iter ; done ; !best_x gsl-ocaml-1.19.1/lib/gsl_siman.mli000066400000000000000000000017261262311274100167130ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Simulated Annealing *) (** NB: This module is not interfaced to GSL, it is implemented in OCaml. It is quite simple in fact, so rather than using it you may want to copy the code and tweak the algorithm in your own program. *) type params = { iters_fixed_T : int; (** The number of iterations at each temperature *) step_size : float; (** The maximum step size in the random walk *) k : float; (** parameter of the Boltzmann distribution *) t_initial : float; (** initial temperature *) mu_t : float; (** cooling factor *) t_min : float; (** minimum temperature *) } val solve : Gsl_rng.t -> 'a -> energ_func:('a -> float) -> step_func:(Gsl_rng.t -> 'a -> float -> 'a) -> ?print_func:('a -> unit) -> params -> 'a gsl-ocaml-1.19.1/lib/gsl_sort.ml000066400000000000000000000043771262311274100164270ustar00rootroot00000000000000 external vector : Gsl_vector.vector -> unit = "ml_gsl_sort_vector" external _vector_index : Gsl_permut.permut -> Gsl_vector.vector -> unit = "ml_gsl_sort_vector_index" let vector_index v = let p = Gsl_permut.create (Gsl_vector.length v) in _vector_index p v ; p external _vector_smallest : float array -> Gsl_vector.vector -> unit = "ml_gsl_sort_vector_smallest" external _vector_largest : float array -> Gsl_vector.vector -> unit = "ml_gsl_sort_vector_largest" let vector_smallest k v = let dest = Array.make k 0. in _vector_smallest dest v ; dest let vector_largest k v = let dest = Array.make k 0. in _vector_largest dest v ; dest external _vector_smallest_index : Gsl_permut.permut -> Gsl_vector.vector -> unit = "ml_gsl_sort_vector_smallest_index" external _vector_largest_index : Gsl_permut.permut -> Gsl_vector.vector -> unit = "ml_gsl_sort_vector_largest_index" let vector_smallest_index k v = let p = Gsl_permut.create k in _vector_smallest_index p v ; p let vector_largest_index k v = let p = Gsl_permut.create k in _vector_largest_index p v ; p external vector_flat : Gsl_vector_flat.vector -> unit = "ml_gsl_sort_vector" external _vector_flat_index : Gsl_permut.permut -> Gsl_vector_flat.vector -> unit = "ml_gsl_sort_vector_index" let vector_flat_index v = let p = Gsl_permut.create (Gsl_vector_flat.length v) in _vector_flat_index p v ; p external _vector_flat_smallest : float array -> Gsl_vector_flat.vector -> unit = "ml_gsl_sort_vector_smallest" external _vector_flat_largest : float array -> Gsl_vector_flat.vector -> unit = "ml_gsl_sort_vector_largest" let vector_flat_smallest k v = let dest = Array.make k 0. in _vector_flat_smallest dest v ; dest let vector_flat_largest k v = let dest = Array.make k 0. in _vector_flat_largest dest v ; dest external _vector_flat_smallest_index : Gsl_permut.permut -> Gsl_vector_flat.vector -> unit = "ml_gsl_sort_vector_smallest_index" external _vector_flat_largest_index : Gsl_permut.permut -> Gsl_vector_flat.vector -> unit = "ml_gsl_sort_vector_largest_index" let vector_flat_smallest_index k v = let p = Gsl_permut.create k in _vector_flat_smallest_index p v ; p let vector_flat_largest_index k v = let p = Gsl_permut.create k in _vector_flat_largest_index p v ; p gsl-ocaml-1.19.1/lib/gsl_sort.mli000066400000000000000000000015701262311274100165700ustar00rootroot00000000000000(** Sorting *) val vector : Gsl_vector.vector -> unit val vector_index : Gsl_vector.vector -> Gsl_permut.permut val vector_smallest : int -> Gsl_vector.vector -> float array val vector_largest : int -> Gsl_vector.vector -> float array val vector_smallest_index : int -> Gsl_vector.vector -> Gsl_permut.permut val vector_largest_index : int -> Gsl_vector.vector -> Gsl_permut.permut val vector_flat : Gsl_vector_flat.vector -> unit val vector_flat_index : Gsl_vector_flat.vector -> Gsl_permut.permut val vector_flat_smallest : int -> Gsl_vector_flat.vector -> float array val vector_flat_largest : int -> Gsl_vector_flat.vector -> float array val vector_flat_smallest_index : int -> Gsl_vector_flat.vector -> Gsl_permut.permut val vector_flat_largest_index : int -> Gsl_vector_flat.vector -> Gsl_permut.permut gsl-ocaml-1.19.1/lib/gsl_stats.ml000066400000000000000000000042771262311274100165750ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) external mean : ?w:float array -> float array -> float = "ml_gsl_stats_mean" external variance : ?w:float array -> ?mean:float -> float array -> float = "ml_gsl_stats_variance" external sd : ?w:float array -> ?mean:float -> float array -> float = "ml_gsl_stats_sd" external variance_with_fixed_mean : ?w:float array -> mean:float -> float array -> float = "ml_gsl_stats_variance_with_fixed_mean" external sd_with_fixed_mean : ?w:float array -> mean:float -> float array -> float = "ml_gsl_stats_sd_with_fixed_mean" external absdev : ?w:float array -> ?mean:float -> float array -> float = "ml_gsl_stats_absdev" external skew : ?w:float array -> float array -> float = "ml_gsl_stats_skew" external skew_m_sd : ?w:float array -> mean:float -> sd:float -> float array -> float = "ml_gsl_stats_skew_m_sd" external kurtosis : ?w:float array -> float array -> float = "ml_gsl_stats_kurtosis" external kurtosis_m_sd : ?w:float array -> mean:float -> sd:float -> float array -> float = "ml_gsl_stats_kurtosis_m_sd" external lag1_autocorrelation : ?mean:float -> float array -> float = "ml_gsl_stats_lag1_autocorrelation" external covariance : float array -> float array -> float = "ml_gsl_stats_covariance" external covariance_m : mean1:float -> float array -> mean2:float -> float array -> float = "ml_gsl_stats_covariance_m" external max : float array -> float = "ml_gsl_stats_max" external min : float array -> float = "ml_gsl_stats_min" external minmax : float array -> float * float = "ml_gsl_stats_minmax" external max_index : float array -> int = "ml_gsl_stats_max_index" external min_index : float array -> int = "ml_gsl_stats_min_index" external minmax_index : float array -> int * int = "ml_gsl_stats_minmax_index" external quantile_from_sorted_data : float array -> float -> float = "ml_gsl_stats_quantile_from_sorted_data" external correlation : float array -> float array -> float = "ml_gsl_stats_correlation" gsl-ocaml-1.19.1/lib/gsl_stats.mli000066400000000000000000000041671262311274100167440ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Statistics *) external mean : ?w:float array -> float array -> float = "ml_gsl_stats_mean" external variance : ?w:float array -> ?mean:float -> float array -> float = "ml_gsl_stats_variance" external sd : ?w:float array -> ?mean:float -> float array -> float = "ml_gsl_stats_sd" external variance_with_fixed_mean : ?w:float array -> mean:float -> float array -> float = "ml_gsl_stats_variance_with_fixed_mean" external sd_with_fixed_mean : ?w:float array -> mean:float -> float array -> float = "ml_gsl_stats_sd_with_fixed_mean" external absdev : ?w:float array -> ?mean:float -> float array -> float = "ml_gsl_stats_absdev" external skew : ?w:float array -> float array -> float = "ml_gsl_stats_skew" external skew_m_sd : ?w:float array -> mean:float -> sd:float -> float array -> float = "ml_gsl_stats_skew_m_sd" external kurtosis : ?w:float array -> float array -> float = "ml_gsl_stats_kurtosis" external kurtosis_m_sd : ?w:float array -> mean:float -> sd:float -> float array -> float = "ml_gsl_stats_kurtosis_m_sd" external lag1_autocorrelation : ?mean:float -> float array -> float = "ml_gsl_stats_lag1_autocorrelation" external covariance : float array -> float array -> float = "ml_gsl_stats_covariance" external covariance_m : mean1:float -> float array -> mean2:float -> float array -> float = "ml_gsl_stats_covariance_m" external max : float array -> float = "ml_gsl_stats_max" external min : float array -> float = "ml_gsl_stats_min" external minmax : float array -> float * float = "ml_gsl_stats_minmax" external max_index : float array -> int = "ml_gsl_stats_max_index" external min_index : float array -> int = "ml_gsl_stats_min_index" external minmax_index : float array -> int * int = "ml_gsl_stats_minmax_index" external quantile_from_sorted_data : float array -> float -> float = "ml_gsl_stats_quantile_from_sorted_data" external correlation : float array -> float array -> float = "ml_gsl_stats_correlation" gsl-ocaml-1.19.1/lib/gsl_sum.ml000066400000000000000000000022041262311274100162270ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type ws external _alloc : int -> ws = "ml_gsl_sum_levin_u_alloc" external _free : ws -> unit = "ml_gsl_sum_levin_u_free" let make size = let ws = _alloc size in Gc.finalise _free ws ; ws external accel : float array -> ws -> Gsl_fun.result = "ml_gsl_sum_levin_u_accel" type ws_info = { size : int ; terms_used : int ; sum_plain : float ; } external get_info : ws -> ws_info = "ml_gsl_sum_levin_u_getinfo" module Trunc = struct type ws external _alloc : int -> ws = "ml_gsl_sum_levin_utrunc_alloc" external _free : ws -> unit = "ml_gsl_sum_levin_utrunc_free" let make size = let ws = _alloc size in Gc.finalise _free ws ; ws external accel : float array -> ws -> Gsl_fun.result = "ml_gsl_sum_levin_utrunc_accel" type ws_info = { size : int ; terms_used : int ; sum_plain : float ; } external get_info : ws -> ws_info = "ml_gsl_sum_levin_utrunc_getinfo" end gsl-ocaml-1.19.1/lib/gsl_sum.mli000066400000000000000000000014551262311274100164070ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Series Acceleration *) type ws val make : int -> ws external accel : float array -> ws -> Gsl_fun.result = "ml_gsl_sum_levin_u_accel" type ws_info = { size : int ; terms_used : int ; sum_plain : float ; } external get_info : ws -> ws_info = "ml_gsl_sum_levin_u_getinfo" module Trunc : sig type ws val make : int -> ws external accel : float array -> ws -> Gsl_fun.result = "ml_gsl_sum_levin_utrunc_accel" type ws_info = { size : int ; terms_used : int ; sum_plain : float ; } external get_info : ws -> ws_info = "ml_gsl_sum_levin_utrunc_getinfo" end gsl-ocaml-1.19.1/lib/gsl_vectmat.ml000066400000000000000000000131571262311274100170770ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type vec = [ | `V of Gsl_vector.vector | `VF of Gsl_vector_flat.vector ] let vec_convert ?(protect=false) = function | `A arr when protect -> `VF (Gsl_vector_flat.of_array arr) | `A arr -> `VF (Gsl_vector_flat.view_array arr) | `VF vec when protect -> `VF (Gsl_vector_flat.copy vec) | `VF _ as v -> v | `V vec when protect -> `V (Gsl_vector.copy vec) | `V _ as v -> v type mat = [ | `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix ] let mat_convert ?(protect=false) = function | `M mat when protect -> `M (Gsl_matrix.copy mat) | `M _ as m -> m | `MF mat when protect -> `MF (Gsl_matrix_flat.copy mat) | `MF _ as m -> m | `A (arr, d1, d2) when protect -> `MF (Gsl_matrix_flat.of_array arr d1 d2) | `A (arr, d1, d2) -> `MF (Gsl_matrix_flat.view_array arr d1 d2) | `AA arr -> `MF (Gsl_matrix_flat.of_arrays arr) let mat_flat ?(protect=false) = function | `M mat -> let (d1, d2) = Gsl_matrix.dims mat in let arr = Gsl_matrix.to_array mat in Gsl_matrix_flat.view_array arr d1 d2 | `MF mat when protect -> Gsl_matrix_flat.copy mat | `MF mat -> mat | `A (arr, d1, d2) when protect -> Gsl_matrix_flat.of_array arr d1 d2 | `A (arr, d1, d2) -> Gsl_matrix_flat.view_array arr d1 d2 | `AA arr -> Gsl_matrix_flat.of_arrays arr (* Complex values *) type cvec = [ | `CV of Gsl_vector_complex.vector | `CVF of Gsl_vector_complex_flat.vector ] type cmat = [ | `CM of Gsl_matrix_complex.matrix | `CMF of Gsl_matrix_complex_flat.matrix ] let cmat_convert ?(protect=false) = function | `CM mat when protect -> `CM (Gsl_matrix_complex.copy mat) | `CM _ as m -> m | `CMF mat when protect -> `CMF (Gsl_matrix_complex_flat.copy mat) | `CMF _ as m -> m | `CA (arr, d1, d2) when protect -> `CMF (Gsl_matrix_complex_flat.of_complex_array arr d1 d2) | `CA (arr, d1, d2) -> `CMF (Gsl_matrix_complex_flat.view_complex_array arr d1 d2) (* Generic vector operations *) let length = function | `VF v -> Gsl_vector_flat.length v | `V v -> Gsl_vector.length v | `CV v -> Gsl_vector_complex.length v | `CVF v -> Gsl_vector_complex_flat.length v let to_array = function | `VF v -> Gsl_vector_flat.to_array v | `V v -> Gsl_vector.to_array v let v_copy = function | `VF v -> `VF (Gsl_vector_flat.copy v) | `V v -> `V (Gsl_vector.copy v) let subvector v ~off ~len = match v with | `VF v -> `VF (Gsl_vector_flat.subvector v ~off ~len) | `V v -> `V (Gsl_vector.subvector v ~off ~len) external v_memcpy : [< vec]-> [< vec]-> unit = "ml_gsl_vector_memcpy" external v_add : [< vec]-> [< vec]-> unit = "ml_gsl_vector_add" external v_sub : [< vec]-> [< vec]-> unit = "ml_gsl_vector_sub" external v_mul : [< vec]-> [< vec]-> unit = "ml_gsl_vector_mul" external v_div : [< vec]-> [< vec]-> unit = "ml_gsl_vector_div" external v_scale : [< vec]-> float -> unit = "ml_gsl_vector_scale" external v_add_constant : [< vec]-> float -> unit = "ml_gsl_vector_add_constant" external v_is_null : [< vec]-> bool = "ml_gsl_vector_isnull" external v_max : [< vec]-> float = "ml_gsl_vector_max" external v_min : [< vec]-> float = "ml_gsl_vector_min" external v_minmax : [< vec]-> float * float = "ml_gsl_vector_minmax" external v_max_index : [< vec]-> int = "ml_gsl_vector_maxindex" external v_min_index : [< vec]-> int = "ml_gsl_vector_minindex" external v_minmax_index : [< vec]-> int * int = "ml_gsl_vector_minmaxindex" (* Generic matrix operations *) let dims = function | `MF v -> Gsl_matrix_flat.dims v | `M v -> Gsl_matrix.dims v | `CM m -> Gsl_matrix_complex.dims m | `CMF m -> Gsl_matrix_complex_flat.dims m let to_arrays = function | `M mat -> Gsl_matrix.to_arrays mat | `MF mat -> Gsl_matrix_flat.to_arrays mat let tmp mat = let (d1, d2) = dims mat in `M (Gsl_matrix.create d1 d2) let m_copy = function | `MF v -> `MF (Gsl_matrix_flat.copy v) | `M v -> `M (Gsl_matrix.copy v) external m_memcpy : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_memcpy" external m_add : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_add" external m_sub : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_sub" external m_mul : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_mul" external m_div : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_div" external m_scale : [< mat] -> float -> unit = "ml_gsl_matrix_scale" external m_add_constant : [< mat] -> float -> unit = "ml_gsl_matrix_add_constant" external m_add_diagonal : [< mat] -> float -> unit = "ml_gsl_matrix_add_diagonal" external m_is_null : [< mat] -> bool = "ml_gsl_matrix_isnull" external swap_rows : [< mat] -> int -> int -> unit = "ml_gsl_matrix_swap_rows" external swap_columns : [< mat] -> int -> int -> unit = "ml_gsl_matrix_swap_columns" external swap_rowcol : [< mat] -> int -> int -> unit = "ml_gsl_matrix_swap_rowcol" external transpose : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_transpose_memcpy" external transpose_in_place : [< mat] -> unit = "ml_gsl_matrix_transpose" let is_null x = match x with | `VF _ | `V _ as v -> v_is_null v | `MF _ | `M _ as m -> m_is_null m let scale x c = match x with | `VF _ | `V _ as v -> v_scale v c | `MF _ | `M _ as m -> m_scale m c let add_constant x c = match x with | `VF _ | `V _ as v -> v_add_constant v c | `MF _ | `M _ as m -> m_add_constant m c gsl-ocaml-1.19.1/lib/gsl_vectmat.mli000066400000000000000000000070351262311274100172460ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Generic variant types for vectors and matrices *) (** {3 Real values} *) type vec = [ | `V of Gsl_vector.vector | `VF of Gsl_vector_flat.vector ] val vec_convert : ?protect:bool -> [< `A of float array | `VF of Gsl_vector_flat.vector | `V of Gsl_vector.vector] -> [> vec] type mat = [ | `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix ] val mat_convert : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> [> mat] val mat_flat : ?protect:bool -> [< `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> Gsl_matrix_flat.matrix (** {3 Complex values} *) type cvec = [ | `CV of Gsl_vector_complex.vector | `CVF of Gsl_vector_complex_flat.vector ] type cmat = [ | `CM of Gsl_matrix_complex.matrix | `CMF of Gsl_matrix_complex_flat.matrix ] val cmat_convert : ?protect:bool -> [< `CM of Gsl_matrix_complex.matrix | `CMF of Gsl_matrix_complex_flat.matrix | `CA of Gsl_complex.complex_array * int * int ] -> [> cmat] (** {3 Generic vector operations} *) val length : [< vec| cvec] -> int val to_array : [< vec] -> float array val v_copy : [< vec] -> [> vec] val subvector : [< vec] -> off:int -> len:int -> [> vec] external v_memcpy : [< vec] -> [< vec] -> unit = "ml_gsl_vector_memcpy" external v_add : [< vec] -> [< vec] -> unit = "ml_gsl_vector_add" external v_sub : [< vec] -> [< vec] -> unit = "ml_gsl_vector_sub" external v_mul : [< vec] -> [< vec] -> unit = "ml_gsl_vector_mul" external v_div : [< vec] -> [< vec] -> unit = "ml_gsl_vector_div" external v_max : [< vec] -> float = "ml_gsl_vector_max" external v_min : [< vec] -> float = "ml_gsl_vector_min" external v_minmax : [< vec] -> float * float = "ml_gsl_vector_minmax" external v_max_index : [< vec] -> int = "ml_gsl_vector_maxindex" external v_min_index : [< vec] -> int = "ml_gsl_vector_minindex" external v_minmax_index : [< vec] -> int * int = "ml_gsl_vector_minmaxindex" (** {3 Generic matrix operations} *) val dims : [< mat| cmat] -> int * int val tmp : [< mat] -> [> `M of Gsl_matrix.matrix] val to_arrays : [< mat] -> float array array val m_copy : [< mat] -> [> mat] external m_memcpy : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_memcpy" external m_add : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_add" external m_sub : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_sub" external m_mul : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_mul" external m_div : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_div" external m_add_diagonal : [< mat] -> float -> unit = "ml_gsl_matrix_add_diagonal" external swap_rows : [< mat] -> int -> int -> unit = "ml_gsl_matrix_swap_rows" external swap_columns : [< mat] -> int -> int -> unit = "ml_gsl_matrix_swap_columns" external swap_rowcol : [< mat] -> int -> int -> unit = "ml_gsl_matrix_swap_rowcol" external transpose : [< mat] -> [< mat] -> unit = "ml_gsl_matrix_transpose_memcpy" external transpose_in_place : [< mat] -> unit = "ml_gsl_matrix_transpose" (** {3 Other generic operations} *) val is_null : [< vec | mat] -> bool val scale : [< vec | mat] -> float -> unit val add_constant : [< vec | mat] -> float -> unit gsl-ocaml-1.19.1/lib/gsl_vector.ml000066400000000000000000000101501262311274100167240ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Bigarray type double_vector_bigarr = (float, float64_elt, c_layout) Bigarray.Array1.t type vector = double_vector_bigarr let create ?init len = let barr = Array1.create float64 c_layout len in begin match init with | None -> () | Some x -> Array1.fill barr x end ; barr let length = Array1.dim let of_array arr = Array1.of_array float64 c_layout arr let to_array v = Array.init (Array1.dim v) (Array1.get v) let get (v : vector) i = Array1.get v i let set (v : vector) i x = Array1.set v i x let set_all = Array1.fill let set_zero v = set_all v 0. let set_basis v i = set_zero v ; set v i 1. let subvector v ~off ~len = Array1.sub v off len let memcpy ~src:v ~dst:w = if length v <> length w then invalid_arg "Vector.memcpy" ; Array1.blit v w let copy v = let w = create (length v) in memcpy ~src:v ~dst:w; w let swap_element v i j = let d = get v i in let d' = get v j in set v j d ; set v i d' let reverse v = let len = length v in for i=0 to pred (len/2) do swap_element v i (pred len - i) done external add : vector -> vector -> unit = "ml_gsl_vector_add" external sub : vector -> vector -> unit = "ml_gsl_vector_sub" external mul : vector -> vector -> unit = "ml_gsl_vector_mul" external div : vector -> vector -> unit = "ml_gsl_vector_div" external scale : vector -> float -> unit = "ml_gsl_vector_scale" external add_constant : vector -> float -> unit = "ml_gsl_vector_add_constant" external is_null : vector -> bool = "ml_gsl_vector_isnull" external max : vector -> float = "ml_gsl_vector_max" external min : vector -> float = "ml_gsl_vector_min" external minmax : vector -> float * float = "ml_gsl_vector_minmax" external max_index : vector -> int = "ml_gsl_vector_maxindex" external min_index : vector -> int = "ml_gsl_vector_minindex" external minmax_index : vector -> int * int = "ml_gsl_vector_minmaxindex" module Single = struct type float_vector_bigarr = (float, float32_elt, c_layout) Bigarray.Array1.t type vector = float_vector_bigarr let create ?init len = let barr = Array1.create float32 c_layout len in begin match init with | None -> () | Some x -> Array1.fill barr x end ; barr let length = length let of_array arr = Array1.of_array float32 c_layout arr let to_array = to_array let get (v : vector) i = Array1.get v i let set (v : vector) i x = Array1.set v i x let set_all = set_all let set_zero = set_zero let set_basis v i = set_zero v ; set v i 1. let subvector = subvector let memcpy = memcpy let copy v = let w = create (length v) in memcpy ~src:v ~dst:w; w let swap_element v i j = let d = get v i in let d' = get v j in set v j d ; set v i d' let reverse v = let len = length v in for i=0 to pred (len/2) do swap_element v i (pred len - i) done external add : vector -> vector -> unit = "ml_gsl_vector_float_add" external sub : vector -> vector -> unit = "ml_gsl_vector_float_sub" external mul : vector -> vector -> unit = "ml_gsl_vector_float_mul" external div : vector -> vector -> unit = "ml_gsl_vector_float_div" external scale : vector -> float -> unit = "ml_gsl_vector_float_scale" external add_constant : vector -> float -> unit = "ml_gsl_vector_float_add_constant" external is_null : vector -> bool = "ml_gsl_vector_float_isnull" external max : vector -> float = "ml_gsl_vector_float_max" external min : vector -> float = "ml_gsl_vector_float_min" external minmax : vector -> float * float = "ml_gsl_vector_float_minmax" external max_index : vector -> int = "ml_gsl_vector_float_maxindex" external min_index : vector -> int = "ml_gsl_vector_float_minindex" external minmax_index : vector -> int * int = "ml_gsl_vector_float_minmaxindex" end gsl-ocaml-1.19.1/lib/gsl_vector.mli000066400000000000000000000071671262311274100171130ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Vector of floats implemented with [Bigarray] *) (** {3 Double precision} *) type double_vector_bigarr = (float, Bigarray.float64_elt, Bigarray.c_layout) Bigarray.Array1.t type vector = double_vector_bigarr (** {4 Operations} *) val create : ?init:float -> int -> vector val of_array : float array -> vector val to_array : vector -> float array val length : vector -> int val get : vector -> int -> float val set : vector -> int -> float -> unit val set_all : vector -> float -> unit val set_zero : vector -> unit val set_basis : vector -> int -> unit val memcpy : src:vector -> dst:vector -> unit val copy : vector -> vector val swap_element : vector -> int -> int -> unit val reverse : vector -> unit external add : vector -> vector -> unit = "ml_gsl_vector_add" external sub : vector -> vector -> unit = "ml_gsl_vector_sub" external mul : vector -> vector -> unit = "ml_gsl_vector_mul" external div : vector -> vector -> unit = "ml_gsl_vector_div" external scale : vector -> float -> unit = "ml_gsl_vector_scale" external add_constant : vector -> float -> unit = "ml_gsl_vector_add_constant" external is_null : vector -> bool = "ml_gsl_vector_isnull" external max : vector -> float = "ml_gsl_vector_max" external min : vector -> float = "ml_gsl_vector_min" external minmax : vector -> float * float = "ml_gsl_vector_minmax" external max_index : vector -> int = "ml_gsl_vector_maxindex" external min_index : vector -> int = "ml_gsl_vector_minindex" external minmax_index : vector -> int * int = "ml_gsl_vector_minmaxindex" (** {4 No-copy operations} *) val subvector : vector -> off:int -> len:int -> vector (** {3 Single precision} *) module Single : sig type float_vector_bigarr = (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t type vector = float_vector_bigarr val create : ?init:float -> int -> vector val of_array : float array -> vector val to_array : vector -> float array val length : vector -> int val get : vector -> int -> float val set : vector -> int -> float -> unit val set_all : vector -> float -> unit val set_zero : vector -> unit val set_basis : vector -> int -> unit val memcpy : src:vector -> dst:vector -> unit val copy : vector -> vector val swap_element : vector -> int -> int -> unit val reverse : vector -> unit external add : vector -> vector -> unit = "ml_gsl_vector_float_add" external sub : vector -> vector -> unit = "ml_gsl_vector_float_sub" external mul : vector -> vector -> unit = "ml_gsl_vector_float_mul" external div : vector -> vector -> unit = "ml_gsl_vector_float_div" external scale : vector -> float -> unit = "ml_gsl_vector_float_scale" external add_constant : vector -> float -> unit = "ml_gsl_vector_float_add_constant" external is_null : vector -> bool = "ml_gsl_vector_float_isnull" external max : vector -> float = "ml_gsl_vector_float_max" external min : vector -> float = "ml_gsl_vector_float_min" external minmax : vector -> float * float = "ml_gsl_vector_float_minmax" external max_index : vector -> int = "ml_gsl_vector_float_maxindex" external min_index : vector -> int = "ml_gsl_vector_float_minindex" external minmax_index : vector -> int * int = "ml_gsl_vector_float_minmaxindex" (** {4 No-copy operations} *) val subvector : vector -> off:int -> len:int -> vector end gsl-ocaml-1.19.1/lib/gsl_vector_complex.ml000066400000000000000000000060141262311274100204570ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Bigarray type complex_double_vector_bigarr = (Complex.t, complex64_elt, c_layout) Bigarray.Array1.t type vector = complex_double_vector_bigarr let create ?init len = let barr = Array1.create complex64 c_layout len in begin match init with | None -> () | Some x -> Array1.fill barr x end ; barr let length = Array1.dim let of_array arr = Array1.of_array complex64 c_layout arr let to_array v = Array.init (Array1.dim v) (Array1.get v) let of_complex_array arr = let n = (Array.length arr) / 2 in let barr = create n in for i=0 to pred n do barr.{i} <- Gsl_complex.get arr i done ; barr let to_complex_array barr = let n = Array1.dim barr in let arr = Array.make (2*n) 0. in for i=0 to pred n do Gsl_complex.set arr i barr.{i} done ; arr let get (v : vector) i = Array1.get v i let set (v : vector) i x = Array1.set v i x let set_all = Array1.fill let set_zero v = set_all v Complex.zero let set_basis v i = set_zero v ; set v i Complex.one let subvector v ~off ~len = Array1.sub v off len let memcpy ~src:v ~dst:w = if length v <> length w then invalid_arg "Vector.memcpy" ; Array1.blit v w let copy v = let w = create (length v) in memcpy ~src:v ~dst:w; w let swap_element v i j = let d = get v i in let d' = get v j in set v j d ; set v i d' let reverse v = let len = length v in for i=0 to pred (len/2) do swap_element v i (pred len - i) done module Single = struct type complex_float_vector_bigarr = (Complex.t, complex32_elt, c_layout) Bigarray.Array1.t type vector = complex_float_vector_bigarr let create ?init len = let barr = Array1.create complex32 c_layout len in begin match init with | None -> () | Some x -> Array1.fill barr x end ; barr let length = length let of_array arr = Array1.of_array complex32 c_layout arr let to_array = to_array let of_complex_array arr = let n = (Array.length arr) / 2 in let barr = create n in for i=0 to pred n do barr.{i} <- Gsl_complex.get arr i done ; barr let to_complex_array barr = let n = Array1.dim barr in let arr = Array.make (2*n) 0. in for i=0 to pred n do Gsl_complex.set arr i barr.{i} done ; arr let get (v : vector) i = Array1.get v i let set (v : vector) i x = Array1.set v i x let set_all = set_all let set_zero = set_zero let set_basis v i = set_zero v ; set v i Complex.one let subvector = subvector let memcpy = memcpy let copy v = let w = create (length v) in memcpy ~src:v ~dst:w; w let swap_element v i j = let d = get v i in let d' = get v j in set v j d ; set v i d' let reverse v = let len = length v in for i=0 to pred (len/2) do swap_element v i (pred len - i) done end gsl-ocaml-1.19.1/lib/gsl_vector_complex.mli000066400000000000000000000036361262311274100206370ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Vector of complex numbers implemented with a [Bigarray] *) open Bigarray open Gsl_complex type complex_double_vector_bigarr = (Complex.t, complex64_elt, c_layout) Array1.t type vector = complex_double_vector_bigarr val create : ?init:complex -> int -> vector val of_array : complex array -> vector val to_array : vector -> complex array val of_complex_array : complex_array -> vector val to_complex_array : vector -> complex_array val length : vector -> int val get : vector -> int -> complex val set : vector -> int -> complex -> unit val set_all : vector -> complex -> unit val set_zero : vector -> unit val set_basis : vector -> int -> unit val memcpy : src:vector -> dst:vector -> unit val copy : vector -> vector val swap_element : vector -> int -> int -> unit val reverse : vector -> unit val subvector : vector -> off:int -> len:int -> vector module Single : sig type complex_float_vector_bigarr = (Complex.t, complex32_elt, c_layout) Array1.t type vector = complex_float_vector_bigarr val create : ?init:complex -> int -> vector val of_array : complex array -> vector val to_array : vector -> complex array val of_complex_array : complex_array -> vector val to_complex_array : vector -> complex_array val length : vector -> int val get : vector -> int -> complex val set : vector -> int -> complex -> unit val set_all : vector -> complex -> unit val set_zero : vector -> unit val set_basis : vector -> int -> unit val memcpy : src:vector -> dst:vector -> unit val copy : vector -> vector val swap_element : vector -> int -> int -> unit val reverse : vector -> unit val subvector : vector -> off:int -> len:int -> vector end gsl-ocaml-1.19.1/lib/gsl_vector_complex_flat.ml000066400000000000000000000046411262311274100214710ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type complex_vector_flat = { data : float array ; off : int ; len : int ; stride : int ; } type vector = complex_vector_flat let create ?(init=Complex.zero) len = let arr = { data = Array.make (2*len) init.Complex.re ; off = 0; len = len; stride = 1; } in if init.Complex.im <> init.Complex.re then for i=0 to pred len do arr.data.(2*i+1) <- init.Complex.im done ; arr let of_array arr = let carr = Gsl_complex.pack arr in { data = carr; off = 0; len = Array.length arr; stride = 1; } let length { len = len } = len let get v i = Gsl_complex.get v.data (v.off + i*v.stride) let set v i d = Gsl_complex.set v.data (v.off + i*v.stride) d let set_all v d = for i=0 to pred v.len do set v i d done let set_zero v = set_all v Complex.zero let set_basis v i = set_zero v ; set v i Complex.one let to_array v = Array.init v.len (get v) let of_complex_array carr = { data = Array.copy carr; off = 0; len = (Array.length carr)/2; stride = 1; } let to_complex_array arr = let carr = Array.make (2*arr.len) 0. in for i=0 to pred arr.len do Gsl_complex.set carr i (get arr i) done ; carr let real carr = Gsl_vector_flat.view_array ~stride:(2 * carr.stride) ~off:(2 * carr.off) ~len:carr.len carr.data let imag carr = Gsl_vector_flat.view_array ~stride:(2 * carr.stride) ~off:(2 * carr.off + 1) ~len:carr.len carr.data let subvector ?(stride=1) v ~off ~len = { v with off = off * v.stride + v.off ; len = len ; stride = stride * v.stride ; } let view_complex_array ?(stride=1) ?(off=0) ?len arr = let alen = Array.length arr in if alen mod 2 <> 0 then invalid_arg "complex_array dim" ; let len = match len with | None -> alen / 2 | Some l -> l in { data = arr ; off = off ; stride = stride ; len = len } let memcpy v w = if v.len <> w.len then invalid_arg "Vector.memcpy" ; for i=0 to pred v.len do set w i (get v i) done let copy v = { v with data = Array.copy v.data } let swap_element v i j = let d = get v i in let d' = get v j in set v j d ; set v i d' let reverse v = for i=0 to pred (v.len/2) do swap_element v i (pred v.len - i) done gsl-ocaml-1.19.1/lib/gsl_vector_complex_flat.mli000066400000000000000000000024601262311274100216370ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Vector of complex numbers implemented with a [float array] *) type complex_vector_flat = private { data : float array ; off : int ; len : int ; stride : int ; } type vector = complex_vector_flat (** {3 Operations} *) open Gsl_complex val create : ?init:complex -> int -> vector val of_array : complex array -> vector val to_array : vector -> complex array val of_complex_array : complex_array -> vector val to_complex_array : vector -> complex_array val length : vector -> int val get : vector -> int -> complex val set : vector -> int -> complex -> unit val set_all : vector -> complex -> unit val set_zero : vector -> unit val set_basis : vector -> int -> unit val memcpy : vector -> vector -> unit val copy : vector -> vector val swap_element : vector -> int -> int -> unit val reverse : vector -> unit (** {3 No-copy operations} *) val subvector : ?stride:int -> vector -> off:int -> len:int -> vector val view_complex_array : ?stride:int -> ?off:int -> ?len:int -> complex_array -> vector val real : vector -> Gsl_vector_flat.vector val imag : vector -> Gsl_vector_flat.vector gsl-ocaml-1.19.1/lib/gsl_vector_flat.ml000066400000000000000000000052121262311274100177350ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type double_vector_flat = { data : float array ; off : int ; len : int ; stride : int ; } type vector = double_vector_flat let check v = let size = Array.length v.data in if v.off < 0 || v.len < 0 || v.stride < 1 || v.off + (v.len - 1) * v.stride >= size then failwith "Vector_flat.check" ; v let create ?(init=0.) len = { data = Array.make len init; off = 0; len = len; stride = 1; } let of_array arr = { data = Array.copy arr; off = 0; len = Array.length arr; stride = 1; } let length { len = len } = len let get v i = v.data.(v.off + i*v.stride) let set v i d = v.data.(v.off + i*v.stride) <- d let set_all v d = for i=0 to pred v.len do set v i d done let set_zero v = set_all v 0. let set_basis v i = set_zero v ; set v i 1. let to_array v = Array.init v.len (get v) let subvector ?(stride=1) v ~off ~len = check { v with off = off * v.stride + v.off ; len = len ; stride = stride * v.stride ; } let view_array ?(stride=1) ?(off=0) ?len arr = let len = match len with | None -> Array.length arr | Some l -> l in check { data = arr ; off = off ; stride = stride ; len = len } let memcpy ~src:v ~dst:w = if v.len <> w.len then invalid_arg "Vector.memcpy" ; for i=0 to pred v.len do set w i (get v i) done let copy v = { v with data = Array.copy v.data } let swap_element v i j = let d = get v i in let d' = get v j in set v j d ; set v i d' let reverse v = for i=0 to pred (v.len/2) do swap_element v i (pred v.len - i) done external add : vector -> vector -> unit = "ml_gsl_vector_add" external sub : vector -> vector -> unit = "ml_gsl_vector_sub" external mul : vector -> vector -> unit = "ml_gsl_vector_mul" external div : vector -> vector -> unit = "ml_gsl_vector_div" external scale : vector -> float -> unit = "ml_gsl_vector_scale" external add_constant : vector -> float -> unit = "ml_gsl_vector_add_constant" external is_null : vector -> bool = "ml_gsl_vector_isnull" external max : vector -> float = "ml_gsl_vector_max" external min : vector -> float = "ml_gsl_vector_min" external minmax : vector -> float * float = "ml_gsl_vector_minmax" external max_index : vector -> int = "ml_gsl_vector_maxindex" external min_index : vector -> int = "ml_gsl_vector_minindex" external minmax_index : vector -> int * int = "ml_gsl_vector_minmaxindex" gsl-ocaml-1.19.1/lib/gsl_vector_flat.mli000066400000000000000000000040611262311274100201070ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Vector of floats implemented with a [float array] *) type double_vector_flat = private { data : float array; off : int; len : int; stride : int; } type vector = double_vector_flat val check : vector -> vector (** @raise Failure if [off], [len] or [stride] designate an invalid subvector of [data] *) (** {3 Operations} *) val create : ?init:float -> int -> vector val of_array : float array -> vector val to_array : vector -> float array val length : vector -> int val get : vector -> int -> float val set : vector -> int -> float -> unit val set_all : vector -> float -> unit val set_zero : vector -> unit val set_basis : vector -> int -> unit val memcpy : src:vector -> dst:vector -> unit val copy : vector -> vector val swap_element : vector -> int -> int -> unit val reverse : vector -> unit external add : vector -> vector -> unit = "ml_gsl_vector_add" external sub : vector -> vector -> unit = "ml_gsl_vector_sub" external mul : vector -> vector -> unit = "ml_gsl_vector_mul" external div : vector -> vector -> unit = "ml_gsl_vector_div" external scale : vector -> float -> unit = "ml_gsl_vector_scale" external add_constant : vector -> float -> unit = "ml_gsl_vector_add_constant" external is_null : vector -> bool = "ml_gsl_vector_isnull" external max : vector -> float = "ml_gsl_vector_max" external min : vector -> float = "ml_gsl_vector_min" external minmax : vector -> float * float = "ml_gsl_vector_minmax" external max_index : vector -> int = "ml_gsl_vector_maxindex" external min_index : vector -> int = "ml_gsl_vector_minindex" external minmax_index : vector -> int * int = "ml_gsl_vector_minmaxindex" (** {3 No-copy operations} *) val subvector : ?stride:int -> vector -> off:int -> len:int -> vector val view_array : ?stride:int -> ?off:int -> ?len:int -> float array -> vector gsl-ocaml-1.19.1/lib/gsl_version.ml000066400000000000000000000015701262311274100171150ustar00rootroot00000000000000(* File: version.ml Copyright (C) 2014- Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let version = "1.19.1" gsl-ocaml-1.19.1/lib/gsl_version.ml.ab000066400000000000000000000016001262311274100174700ustar00rootroot00000000000000(* File: version.ml Copyright (C) 2014- Markus Mottl email: markus.mottl@gmail.com WWW: http://www.ocaml.info This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let version = "$(pkg_version)" gsl-ocaml-1.19.1/lib/gsl_wavelet.ml000066400000000000000000000052741262311274100171040ustar00rootroot00000000000000type t type ws type kind = | DAUBECHIES | DAUBECHIES_CENTERED | HAAR | HAAR_CENTERED | BSPLINE | BSPLINE_CENTERED type direction = | FORWARD | BACKWARD external _alloc : kind -> int -> t = "ml_gsl_wavelet_alloc" external _free : t -> unit = "ml_gsl_wavelet_free" let make kind size = let w = _alloc kind size in Gc.finalise _free w ; w external name : t -> string = "ml_gsl_wavelet_name" external _workspace_alloc : int -> ws = "ml_gsl_wavelet_workspace_alloc" external _workspace_free : ws -> unit = "ml_gsl_wavelet_workspace_free" let workspace_make size = let ws = _workspace_alloc size in Gc.finalise _workspace_free ws ; ws external workspace_size : ws -> int = "ml_gsl_wavelet_workspace_size" external _transform : t -> direction -> Gsl_vector_flat.vector -> ws -> unit = "ml_gsl_wavelet_transform" external _transform_bigarray : t -> direction -> Gsl_vector.vector -> ws -> unit = "ml_gsl_wavelet_transform_bigarray" let with_workspace ws length f arg = let workspace = match ws with | Some ws -> ws | None -> _workspace_alloc (length arg) in try f arg workspace ; if ws = None then _workspace_free workspace with exn -> if ws = None then _workspace_free workspace ; raise exn let transform_vector_flat w dir ?ws = with_workspace ws Gsl_vector_flat.length (_transform w dir) let transform_vector w dir ?ws = with_workspace ws Gsl_vector.length (_transform_bigarray w dir) let transform_gen w dir ?ws = function | `V v -> transform_vector w dir ?ws v | `VF v -> transform_vector_flat w dir ?ws v let transform_array w dir ?ws ?stride ?off ?len arr = transform_vector_flat w dir ?ws (Gsl_vector_flat.view_array ?stride ?off ?len arr) let transform_forward w = transform_array w FORWARD let transform_inverse w = transform_array w BACKWARD type ordering = | STANDARD | NON_STANDARD external _transform_2d : t -> ordering -> direction -> Gsl_matrix_flat.matrix -> ws -> unit = "ml_gsl_wavelet2d_transform_matrix" external _transform_2d_bigarray : t -> ordering -> direction -> Gsl_matrix.matrix -> ws -> unit = "ml_gsl_wavelet2d_transform_matrix" external _transform_2d_gen : t -> ordering -> direction -> [< Gsl_vectmat.mat] -> ws -> unit = "ml_gsl_wavelet2d_transform_matrix" let transform_matrix_flat w order dir ?ws = with_workspace ws (fun m -> fst (Gsl_matrix_flat.dims m)) (_transform_2d w order dir) let transform_matrix w order dir ?ws = with_workspace ws (fun m -> fst (Gsl_matrix.dims m)) (_transform_2d_bigarray w order dir) let transform_matrix_gen w order dir ?ws = with_workspace ws (fun m -> fst (Gsl_vectmat.dims m)) (_transform_2d_gen w order dir) gsl-ocaml-1.19.1/lib/gsl_wavelet.mli000066400000000000000000000024511262311274100172470ustar00rootroot00000000000000(** Wavelet Transforms *) type t type ws type kind = | DAUBECHIES | DAUBECHIES_CENTERED | HAAR | HAAR_CENTERED | BSPLINE | BSPLINE_CENTERED type direction = FORWARD | BACKWARD val make : kind -> int -> t external name : t -> string = "ml_gsl_wavelet_name" val workspace_make : int -> ws external workspace_size : ws -> int = "ml_gsl_wavelet_workspace_size" (** {3 1D transforms} *) val transform_array : t -> direction -> ?ws:ws -> ?stride:int -> ?off:int -> ?len:int -> float array -> unit val transform_forward : t -> ?ws:ws -> ?stride:int -> ?off:int -> ?len:int -> float array -> unit val transform_inverse : t -> ?ws:ws -> ?stride:int -> ?off:int -> ?len:int -> float array -> unit val transform_vector_flat : t -> direction -> ?ws:ws -> Gsl_vector_flat.vector -> unit val transform_vector : t -> direction -> ?ws:ws -> Gsl_vector.vector -> unit val transform_gen : t -> direction -> ?ws:ws -> [< Gsl_vectmat.vec] -> unit (** {3 2D transforms} *) type ordering = | STANDARD | NON_STANDARD val transform_matrix_flat : t -> ordering -> direction -> ?ws:ws -> Gsl_matrix_flat.matrix -> unit val transform_matrix : t -> ordering -> direction -> ?ws:ws -> Gsl_matrix.matrix -> unit val transform_matrix_gen : t -> ordering -> direction -> ?ws:ws -> [< Gsl_vectmat.mat] -> unit gsl-ocaml-1.19.1/lib/io.h000066400000000000000000000112031262311274100150030ustar00rootroot00000000000000/***********************************************************************/ /* */ /* OCaml */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file ../LICENSE. */ /* */ /***********************************************************************/ /* Buffered input/output */ #ifndef CAML_IO_H #define CAML_IO_H #include #include #ifndef IO_BUFFER_SIZE #define IO_BUFFER_SIZE 65536 #endif #if defined(_WIN32) typedef __int64 file_offset; #elif defined(HAS_OFF_T) #include typedef off_t file_offset; #else typedef long file_offset; #endif struct channel { int fd; /* Unix file descriptor */ file_offset offset; /* Absolute position of fd in the file */ char * end; /* Physical end of the buffer */ char * curr; /* Current position in the buffer */ char * max; /* Logical end of the buffer (for input) */ void * mutex; /* Placeholder for mutex (for systhreads) */ struct channel * next, * prev;/* Double chaining of channels (flush_all) */ int revealed; /* For Cash only */ int old_revealed; /* For Cash only */ int refcount; /* For flush_all and for Cash */ int flags; /* Bitfield */ char buff[IO_BUFFER_SIZE]; /* The buffer itself */ }; enum { CHANNEL_FLAG_FROM_SOCKET = 1 /* For Windows */ }; /* For an output channel: [offset] is the absolute position of the beginning of the buffer [buff]. For an input channel: [offset] is the absolute position of the logical end of the buffer, [max]. */ /* Functions and macros that can be called from C. Take arguments of type struct channel *. No locking is performed. */ #define putch(channel, ch) do{ \ if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \ *((channel)->curr)++ = (ch); \ }while(0) #define getch(channel) \ ((channel)->curr >= (channel)->max \ ? caml_refill(channel) \ : (unsigned char) *((channel)->curr)++) CAMLextern struct channel * caml_open_descriptor_in (int); CAMLextern struct channel * caml_open_descriptor_out (int); CAMLextern void caml_close_channel (struct channel *); CAMLextern int caml_channel_binary_mode (struct channel *); CAMLextern value caml_alloc_channel(struct channel *chan); CAMLextern int caml_flush_partial (struct channel *); CAMLextern void caml_flush (struct channel *); CAMLextern void caml_putword (struct channel *, uint32_t); CAMLextern int caml_putblock (struct channel *, char *, intnat); CAMLextern void caml_really_putblock (struct channel *, char *, intnat); CAMLextern unsigned char caml_refill (struct channel *); CAMLextern uint32_t caml_getword (struct channel *); CAMLextern int caml_getblock (struct channel *, char *, intnat); CAMLextern int caml_really_getblock (struct channel *, char *, intnat); /* Extract a struct channel * from the heap object representing it */ #define Channel(v) (*((struct channel **) (Data_custom_val(v)))) /* The locking machinery */ CAMLextern void (*caml_channel_mutex_free) (struct channel *); CAMLextern void (*caml_channel_mutex_lock) (struct channel *); CAMLextern void (*caml_channel_mutex_unlock) (struct channel *); CAMLextern void (*caml_channel_mutex_unlock_exn) (void); CAMLextern struct channel * caml_all_opened_channels; #define Lock(channel) \ if (caml_channel_mutex_lock != NULL) (*caml_channel_mutex_lock)(channel) #define Unlock(channel) \ if (caml_channel_mutex_unlock != NULL) (*caml_channel_mutex_unlock)(channel) #define Unlock_exn() \ if (caml_channel_mutex_unlock_exn != NULL) (*caml_channel_mutex_unlock_exn)() /* Conversion between file_offset and int64_t */ #define Val_file_offset(fofs) caml_copy_int64(fofs) #define File_offset_val(v) ((file_offset) Int64_val(v)) #endif /* CAML_IO_H */ gsl-ocaml-1.19.1/lib/libgsl_stubs.clib000066400000000000000000000014461262311274100175620ustar00rootroot00000000000000# OASIS_START # DO NOT EDIT (digest: ed754c8d7d248f374d490c5e4f80764f) mlgsl_blas.o mlgsl_blas_complex.o mlgsl_blas_complex_float.o mlgsl_blas_float.o mlgsl_bspline.o mlgsl_cdf.o mlgsl_cheb.o mlgsl_combi.o mlgsl_complex.o mlgsl_deriv.o mlgsl_eigen.o mlgsl_error.o mlgsl_fft.o mlgsl_fit.o mlgsl_fun.o mlgsl_histo.o mlgsl_ieee.o mlgsl_integration.o mlgsl_interp.o mlgsl_linalg.o mlgsl_linalg_complex.o mlgsl_math.o mlgsl_matrix_complex.o mlgsl_matrix_complex_float.o mlgsl_matrix_double.o mlgsl_matrix_float.o mlgsl_min.o mlgsl_monte.o mlgsl_multifit.o mlgsl_multimin.o mlgsl_multiroots.o mlgsl_odeiv.o mlgsl_permut.o mlgsl_poly.o mlgsl_qrng.o mlgsl_randist.o mlgsl_rng.o mlgsl_roots.o mlgsl_sf.o mlgsl_sort.o mlgsl_stats.o mlgsl_sum.o mlgsl_vector_double.o mlgsl_vector_float.o mlgsl_wavelet.o # OASIS_STOP gsl-ocaml-1.19.1/lib/mlgsl_blas.c000066400000000000000000000157741262311274100165270ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include "mlgsl_vector_double.h" #include "mlgsl_matrix_double.h" #include "mlgsl_blas.h" /* LEVEL1 double */ CAMLprim value ml_gsl_blas_ddot(value X, value Y) { double r; _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_ddot(&v_X, &v_Y, &r); return copy_double(r); } CAMLprim value ml_gsl_blas_dnrm2(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return copy_double(gsl_blas_dnrm2(&v_X)); } CAMLprim value ml_gsl_blas_dasum(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return copy_double(gsl_blas_dasum(&v_X)); } CAMLprim value ml_gsl_blas_idamax(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return Val_int(gsl_blas_idamax(&v_X)); } CAMLprim value ml_gsl_blas_dswap(value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_dswap(&v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_dcopy(value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_dcopy(&v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_daxpy(value alpha, value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_daxpy(Double_val(alpha), &v_X, &v_Y); return Val_unit; } /* FIXME: drotg drotmg drotm */ CAMLprim value ml_gsl_blas_drot(value X, value Y, value c, value s) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_drot(&v_X, &v_Y, Double_val(c), Double_val(s)); return Val_unit; } CAMLprim value ml_gsl_blas_dscal(value alpha, value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); gsl_blas_dscal(Double_val(alpha), &v_X); return Val_unit; } /* LEVEL2 double */ CAMLprim value ml_gsl_blas_dgemv(value transa, value alpha, value A, value X, value beta, value Y) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X, Y); gsl_blas_dgemv(CBLAS_TRANS_val(transa), Double_val(alpha), &m_A, &v_X, Double_val(beta), &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_dgemv_bc(value *argv, int argc) { return ml_gsl_blas_dgemv(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_dtrmv(value uplo, value transa, value diag, value A, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_dtrmv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), &m_A, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_dtrsv(value uplo, value transa, value diag, value A, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_dtrsv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), &m_A, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_dsymv(value uplo, value alpha, value A, value X, value beta, value Y) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X, Y); gsl_blas_dsymv(CBLAS_UPLO_val(uplo), Double_val(alpha), &m_A, &v_X, Double_val(beta), &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_dsymv_bc(value *argv, int argc) { return ml_gsl_blas_dsymv(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_dger(value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X, Y); gsl_blas_dger(Double_val(alpha), &v_X, &v_Y, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_dsyr(value uplo ,value alpha, value X, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_dsyr(CBLAS_UPLO_val(uplo), Double_val(alpha), &v_X, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_dsyr2(value uplo ,value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X, Y); gsl_blas_dsyr2(CBLAS_UPLO_val(uplo), Double_val(alpha), &v_X, &v_Y, &m_A); return Val_unit; } /* LEVEL3 double */ CAMLprim value ml_gsl_blas_dgemm(value transa, value transb, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _CONVERT_MATRIX3(A, B, C); gsl_blas_dgemm(CBLAS_TRANS_val(transa), CBLAS_TRANS_val(transb), Double_val(alpha), &m_A, &m_B, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_dgemm_bc(value *argv, int argc) { return ml_gsl_blas_dgemm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_dsymm(value side, value uplo, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _CONVERT_MATRIX3(A, B, C); gsl_blas_dsymm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), Double_val(alpha), &m_A, &m_B, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_dsymm_bc(value *argv, int argc) { return ml_gsl_blas_dsymm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_dtrmm(value side, value uplo, value transa, value diag, value alpha, value A, value B) { _DECLARE_MATRIX2(A, B); _CONVERT_MATRIX2(A, B); gsl_blas_dtrmm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), Double_val(alpha), &m_A, &m_B); return Val_unit; } CAMLprim value ml_gsl_blas_dtrmm_bc(value *argv, int argc) { return ml_gsl_blas_dtrmm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_dtrsm(value side, value uplo, value transa, value diag, value alpha, value A, value B) { _DECLARE_MATRIX2(A, B); _CONVERT_MATRIX2(A, B); gsl_blas_dtrsm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), Double_val(alpha), &m_A, &m_B); return Val_unit; } CAMLprim value ml_gsl_blas_dtrsm_bc(value *argv, int argc) { return ml_gsl_blas_dtrsm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_dsyrk(value uplo, value trans, value alpha, value A, value beta, value C) { _DECLARE_MATRIX2(A, C); _CONVERT_MATRIX2(A, C); gsl_blas_dsyrk(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), Double_val(alpha), &m_A, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_dsyrk_bc(value *argv, int argc) { return ml_gsl_blas_dsyrk(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_dsyr2k(value uplo, value trans, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _CONVERT_MATRIX3(A, B, C); gsl_blas_dsyr2k(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), Double_val(alpha), &m_A, &m_B, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_dsyr2k_bc(value *argv, int argc) { return ml_gsl_blas_dsyr2k(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } gsl-ocaml-1.19.1/lib/mlgsl_blas.h000066400000000000000000000015631262311274100165230ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ static inline CBLAS_ORDER_t CBLAS_ORDER_val(v) { CBLAS_ORDER_t conv[] = { CblasRowMajor, CblasColMajor }; return conv[ Int_val(v) ]; } static inline CBLAS_TRANSPOSE_t CBLAS_TRANS_val(v) { CBLAS_TRANSPOSE_t conv[] = { CblasNoTrans, CblasTrans, CblasConjTrans }; return conv[ Int_val(v) ]; } static inline CBLAS_UPLO_t CBLAS_UPLO_val(v) { CBLAS_UPLO_t conv[] = { CblasUpper, CblasLower }; return conv[ Int_val(v) ]; } static inline CBLAS_DIAG_t CBLAS_DIAG_val(v) { CBLAS_DIAG_t conv[] = { CblasNonUnit, CblasUnit }; return conv[ Int_val(v) ]; } static inline CBLAS_SIDE_t CBLAS_SIDE_val(v) { CBLAS_SIDE_t conv[] = { CblasLeft, CblasRight }; return conv[ Int_val(v) ]; } gsl-ocaml-1.19.1/lib/mlgsl_blas_complex.c000066400000000000000000000227261262311274100202510ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include "mlgsl_complex.h" #include "mlgsl_vector_complex.h" #include "mlgsl_matrix_complex.h" #include "mlgsl_blas.h" /* LEVEL1 complex */ CAMLprim value ml_gsl_blas_zdotu(value X, value Y) { gsl_complex r; _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_zdotu(&v_X, &v_Y, &r); return copy_complex(&r); } CAMLprim value ml_gsl_blas_zdotc(value X, value Y) { gsl_complex r; _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_zdotc(&v_X, &v_Y, &r); return copy_complex(&r); } CAMLprim value ml_gsl_blas_znrm2(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return copy_double(gsl_blas_dznrm2(&v_X)); } CAMLprim value ml_gsl_blas_zasum(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return copy_double(gsl_blas_dzasum(&v_X)); } CAMLprim value ml_gsl_blas_izamax(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return Val_int(gsl_blas_izamax(&v_X)); } CAMLprim value ml_gsl_blas_zswap(value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_zswap(&v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_zcopy(value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_zcopy(&v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_zaxpy(value alpha, value X, value Y) { _DECLARE_VECTOR2(X, Y); _DECLARE_COMPLEX(alpha); _CONVERT_VECTOR2(X, Y); _CONVERT_COMPLEX(alpha); gsl_blas_zaxpy(z_alpha, &v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_zscal(value alpha, value X) { _DECLARE_VECTOR(X); _DECLARE_COMPLEX(alpha); _CONVERT_VECTOR(X); _CONVERT_COMPLEX(alpha); gsl_blas_zscal(z_alpha, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_zdscal(value alpha, value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); gsl_blas_zdscal(Double_val(alpha), &v_X); return Val_unit; } /* LEVEL2 complex */ CAMLprim value ml_gsl_blas_zgemv(value transa, value alpha, value A, value X, value beta, value Y) { _DECLARE_MATRIX(A); _DECLARE_COMPLEX2(alpha, beta); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_COMPLEX2(alpha, beta); _CONVERT_VECTOR2(X, Y); gsl_blas_zgemv(CBLAS_TRANS_val(transa), z_alpha, &m_A, &v_X, z_beta, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_zgemv_bc(value *argv, int argc) { return ml_gsl_blas_zgemv(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_ztrmv(value uplo, value transa, value diag, value A, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_ztrmv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), &m_A, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_ztrsv(value uplo, value transa, value diag, value A, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_ztrsv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), &m_A, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_zhemv(value uplo, value alpha, value A, value X, value beta, value Y) { _DECLARE_MATRIX(A); _DECLARE_COMPLEX2(alpha, beta); _DECLARE_VECTOR2(X,Y); _CONVERT_MATRIX(A); _CONVERT_COMPLEX2(alpha, beta); _CONVERT_VECTOR2(X,Y); gsl_blas_zhemv(CBLAS_UPLO_val(uplo), z_alpha, &m_A, &v_X, z_beta, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_zhemv_bc(value *argv, int argc) { return ml_gsl_blas_zhemv(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_zgeru(value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X,Y); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X,Y); _CONVERT_COMPLEX(alpha); gsl_blas_zgeru(z_alpha, &v_X, &v_Y, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_zgerc(value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X,Y); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X,Y); _CONVERT_COMPLEX(alpha); gsl_blas_zgerc(z_alpha, &v_X, &v_Y, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_zher(value uplo, value alpha, value X, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_zher(CBLAS_UPLO_val(uplo), Double_val(alpha), &v_X, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_zher2(value uplo, value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X,Y); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X,Y); _CONVERT_COMPLEX(alpha); gsl_blas_zher2(CBLAS_UPLO_val(uplo), z_alpha, &v_X, &v_Y, &m_A); return Val_unit; } /* LEVEL3 complex */ CAMLprim value ml_gsl_blas_zgemm(value transa, value transb, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_zgemm(CBLAS_TRANS_val(transa), CBLAS_TRANS_val(transb), z_alpha, &m_A, &m_B, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_zgemm_bc(value *argv, int argc) { return ml_gsl_blas_zgemm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_zsymm(value side, value uplo, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_zsymm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), z_alpha, &m_A, &m_B, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_zsymm_bc(value *argv, int argc) { return ml_gsl_blas_zsymm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_zsyrk(value uplo, value trans, value alpha, value A, value beta, value C) { _DECLARE_MATRIX2(A, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX2(A, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_zsyrk(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), z_alpha, &m_A, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_zsyrk_bc(value *argv, int argc) { return ml_gsl_blas_zsyrk(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_zsyr2k(value uplo, value trans, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_zsyr2k(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), z_alpha, &m_A, &m_B, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_zsyr2k_bc(value *argv, int argc) { return ml_gsl_blas_zsyr2k(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_ztrmm(value side, value uplo, value transa, value diag, value alpha, value A, value B) { _DECLARE_MATRIX2(A, B); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX2(A, B); _CONVERT_COMPLEX(alpha); gsl_blas_ztrmm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), z_alpha, &m_A, &m_B); return Val_unit; } CAMLprim value ml_gsl_blas_ztrmm_bc(value *argv, int argc) { return ml_gsl_blas_ztrmm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_ztrsm(value side, value uplo, value transa, value diag, value alpha, value A, value B) { _DECLARE_MATRIX2(A, B); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX2(A, B); _CONVERT_COMPLEX(alpha); gsl_blas_ztrsm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), z_alpha, &m_A, &m_B); return Val_unit; } CAMLprim value ml_gsl_blas_ztrsm_bc(value *argv, int argc) { return ml_gsl_blas_ztrsm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_zhemm(value side, value uplo, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_zhemm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), z_alpha, &m_A, &m_B, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_zhemm_bc(value *argv, int argc) { return ml_gsl_blas_zhemm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_zherk(value uplo, value trans, value alpha, value A, value beta, value C) { _DECLARE_MATRIX2(A, C); _CONVERT_MATRIX2(A, C); gsl_blas_zherk(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), Double_val(alpha), &m_A, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_zherk_bc(value *argv, int argc) { return ml_gsl_blas_zherk(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_zher2k(value uplo, value trans, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX(alpha); gsl_blas_zher2k(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), z_alpha, &m_A, &m_B, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_zher2k_bc(value *argv, int argc) { return ml_gsl_blas_zher2k(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } gsl-ocaml-1.19.1/lib/mlgsl_blas_complex_float.c000066400000000000000000000230311262311274100214240ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #define FLOAT_COMPLEX #include "mlgsl_complex.h" #include "mlgsl_vector_complex_float.h" #include "mlgsl_matrix_complex_float.h" #include "mlgsl_blas.h" /* LEVEL1 complex float */ CAMLprim value ml_gsl_blas_cdotu(value X, value Y) { gsl_complex_float r; _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_cdotu(&v_X, &v_Y, &r); return copy_complex(&r); } CAMLprim value ml_gsl_blas_cdotc(value X, value Y) { gsl_complex_float r; _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_cdotc(&v_X, &v_Y, &r); return copy_complex(&r); } CAMLprim value ml_gsl_blas_scnrm2(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return copy_double(gsl_blas_scnrm2(&v_X)); } CAMLprim value ml_gsl_blas_scasum(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return copy_double(gsl_blas_scasum(&v_X)); } CAMLprim value ml_gsl_blas_icamax(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return Val_int(gsl_blas_icamax(&v_X)); } CAMLprim value ml_gsl_blas_cswap(value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_cswap(&v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_ccopy(value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_ccopy(&v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_caxpy(value alpha, value X, value Y) { _DECLARE_VECTOR2(X, Y); _DECLARE_COMPLEX(alpha); _CONVERT_VECTOR2(X, Y); _CONVERT_COMPLEX(alpha); gsl_blas_caxpy(z_alpha, &v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_cscal(value alpha, value X) { _DECLARE_VECTOR(X); _DECLARE_COMPLEX(alpha); _CONVERT_VECTOR(X); _CONVERT_COMPLEX(alpha); gsl_blas_cscal(z_alpha, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_csscal(value alpha, value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); gsl_blas_csscal(Double_val(alpha), &v_X); return Val_unit; } /* LEVEL2 complex float */ CAMLprim value ml_gsl_blas_cgemv(value transa, value alpha, value A, value X, value beta, value Y) { _DECLARE_MATRIX(A); _DECLARE_COMPLEX2(alpha, beta); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_COMPLEX2(alpha, beta); _CONVERT_VECTOR2(X, Y); gsl_blas_cgemv(CBLAS_TRANS_val(transa), z_alpha, &m_A, &v_X, z_beta, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_cgemv_bc(value *argv, int argc) { return ml_gsl_blas_cgemv(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_ctrmv(value uplo, value transa, value diag, value A, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_ctrmv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), &m_A, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_ctrsv(value uplo, value transa, value diag, value A, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_ctrsv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), &m_A, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_chemv(value uplo, value alpha, value A, value X, value beta, value Y) { _DECLARE_MATRIX(A); _DECLARE_COMPLEX2(alpha, beta); _DECLARE_VECTOR2(X,Y); _CONVERT_MATRIX(A); _CONVERT_COMPLEX2(alpha, beta); _CONVERT_VECTOR2(X,Y); gsl_blas_chemv(CBLAS_UPLO_val(uplo), z_alpha, &m_A, &v_X, z_beta, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_chemv_bc(value *argv, int argc) { return ml_gsl_blas_chemv(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_cgeru(value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X,Y); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X,Y); _CONVERT_COMPLEX(alpha); gsl_blas_cgeru(z_alpha, &v_X, &v_Y, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_cgerc(value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X,Y); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X,Y); _CONVERT_COMPLEX(alpha); gsl_blas_cgerc(z_alpha, &v_X, &v_Y, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_cher(value uplo, value alpha, value X, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_cher(CBLAS_UPLO_val(uplo), Double_val(alpha), &v_X, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_cher2(value uplo, value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X,Y); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X,Y); _CONVERT_COMPLEX(alpha); gsl_blas_cher2(CBLAS_UPLO_val(uplo), z_alpha, &v_X, &v_Y, &m_A); return Val_unit; } /* LEVEL3 complex float */ CAMLprim value ml_gsl_blas_cgemm(value transa, value transb, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_cgemm(CBLAS_TRANS_val(transa), CBLAS_TRANS_val(transb), z_alpha, &m_A, &m_B, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_cgemm_bc(value *argv, int argc) { return ml_gsl_blas_cgemm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_csymm(value side, value uplo, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_csymm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), z_alpha, &m_A, &m_B, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_csymm_bc(value *argv, int argc) { return ml_gsl_blas_csymm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_csyrk(value uplo, value trans, value alpha, value A, value beta, value C) { _DECLARE_MATRIX2(A, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX2(A, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_csyrk(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), z_alpha, &m_A, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_csyrk_bc(value *argv, int argc) { return ml_gsl_blas_csyrk(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_csyr2k(value uplo, value trans, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_csyr2k(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), z_alpha, &m_A, &m_B, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_csyr2k_bc(value *argv, int argc) { return ml_gsl_blas_csyr2k(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_ctrmm(value side, value uplo, value transa, value diag, value alpha, value A, value B) { _DECLARE_MATRIX2(A, B); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX2(A, B); _CONVERT_COMPLEX(alpha); gsl_blas_ctrmm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), z_alpha, &m_A, &m_B); return Val_unit; } CAMLprim value ml_gsl_blas_ctrmm_bc(value *argv, int argc) { return ml_gsl_blas_ctrmm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_ctrsm(value side, value uplo, value transa, value diag, value alpha, value A, value B) { _DECLARE_MATRIX2(A, B); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX2(A, B); _CONVERT_COMPLEX(alpha); gsl_blas_ctrsm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), z_alpha, &m_A, &m_B); return Val_unit; } CAMLprim value ml_gsl_blas_ctrsm_bc(value *argv, int argc) { return ml_gsl_blas_ctrsm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_chemm(value side, value uplo, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX2(alpha, beta); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX2(alpha, beta); gsl_blas_chemm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), z_alpha, &m_A, &m_B, z_beta, &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_chemm_bc(value *argv, int argc) { return ml_gsl_blas_chemm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_cherk(value uplo, value trans, value alpha, value A, value beta, value C) { _DECLARE_MATRIX2(A, C); _CONVERT_MATRIX2(A, C); gsl_blas_cherk(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), Double_val(alpha), &m_A, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_cherk_bc(value *argv, int argc) { return ml_gsl_blas_cherk(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_cher2k(value uplo, value trans, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _DECLARE_COMPLEX(alpha); _CONVERT_MATRIX3(A, B, C); _CONVERT_COMPLEX(alpha); gsl_blas_cher2k(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), z_alpha, &m_A, &m_B, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_cher2k_bc(value *argv, int argc) { return ml_gsl_blas_cher2k(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } gsl-ocaml-1.19.1/lib/mlgsl_blas_float.c000066400000000000000000000165351262311274100177100ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include "mlgsl_vector_float.h" #include "mlgsl_matrix_float.h" #include "mlgsl_blas.h" /* LEVEL1 float */ CAMLprim value ml_gsl_blas_sdsdot(value alpha, value X, value Y) { float r; _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_sdsdot(Double_val(alpha), &v_X, &v_Y, &r); return copy_double(r); } CAMLprim value ml_gsl_blas_dsdot(value X, value Y) { double r; _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_dsdot(&v_X, &v_Y, &r); return copy_double(r); } CAMLprim value ml_gsl_blas_sdot(value X, value Y) { float r; _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_sdot(&v_X, &v_Y, &r); return copy_double(r); } CAMLprim value ml_gsl_blas_snrm2(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return copy_double(gsl_blas_snrm2(&v_X)); } CAMLprim value ml_gsl_blas_sasum(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return copy_double(gsl_blas_sasum(&v_X)); } CAMLprim value ml_gsl_blas_isamax(value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); return Val_int(gsl_blas_isamax(&v_X)); } CAMLprim value ml_gsl_blas_sswap(value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_sswap(&v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_scopy(value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_scopy(&v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_saxpy(value alpha, value X, value Y) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_saxpy(Double_val(alpha), &v_X, &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_srot(value X, value Y, value c, value s) { _DECLARE_VECTOR2(X, Y); _CONVERT_VECTOR2(X, Y); gsl_blas_srot(&v_X, &v_Y, Double_val(c), Double_val(s)); return Val_unit; } CAMLprim value ml_gsl_blas_sscal(value alpha, value X) { _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); gsl_blas_sscal(Double_val(alpha), &v_X); return Val_unit; } /* LEVEL2 float */ CAMLprim value ml_gsl_blas_sgemv(value transa, value alpha, value A, value X, value beta, value Y) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X, Y); gsl_blas_sgemv(CBLAS_TRANS_val(transa), Double_val(alpha), &m_A, &v_X, Double_val(beta), &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_sgemv_bc(value *argv, int argc) { return ml_gsl_blas_sgemv(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_strmv(value uplo, value transa, value diag, value A, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_strmv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), &m_A, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_strsv(value uplo, value transa, value diag, value A, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_strsv(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), &m_A, &v_X); return Val_unit; } CAMLprim value ml_gsl_blas_ssymv(value uplo, value alpha, value A, value X, value beta, value Y) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X, Y); gsl_blas_ssymv(CBLAS_UPLO_val(uplo), Double_val(alpha), &m_A, &v_X, Double_val(beta), &v_Y); return Val_unit; } CAMLprim value ml_gsl_blas_ssymv_bc(value *argv, int argc) { return ml_gsl_blas_ssymv(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_sger(value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X, Y); gsl_blas_sger(Double_val(alpha), &v_X, &v_Y, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_ssyr(value uplo ,value alpha, value X, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_blas_ssyr(CBLAS_UPLO_val(uplo), Double_val(alpha), &v_X, &m_A); return Val_unit; } CAMLprim value ml_gsl_blas_ssyr2(value uplo ,value alpha, value X, value Y, value A) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(X, Y); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(X, Y); gsl_blas_ssyr2(CBLAS_UPLO_val(uplo), Double_val(alpha), &v_X, &v_Y, &m_A); return Val_unit; } /* LEVEL3 float */ CAMLprim value ml_gsl_blas_sgemm(value transa, value transb, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _CONVERT_MATRIX3(A, B, C); gsl_blas_sgemm(CBLAS_TRANS_val(transa), CBLAS_TRANS_val(transb), Double_val(alpha), &m_A, &m_B, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_sgemm_bc(value *argv, int argc) { return ml_gsl_blas_sgemm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_ssymm(value side, value uplo, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _CONVERT_MATRIX3(A, B, C); gsl_blas_ssymm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), Double_val(alpha), &m_A, &m_B, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_ssymm_bc(value *argv, int argc) { return ml_gsl_blas_ssymm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_ssyrk(value uplo, value trans, value alpha, value A, value beta, value C) { _DECLARE_MATRIX2(A, C); _CONVERT_MATRIX2(A, C); gsl_blas_ssyrk(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), Double_val(alpha), &m_A, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_ssyrk_bc(value *argv, int argc) { return ml_gsl_blas_ssyrk(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_blas_ssyr2k(value uplo, value trans, value alpha, value A, value B, value beta, value C) { _DECLARE_MATRIX3(A, B, C); _CONVERT_MATRIX3(A, B, C); gsl_blas_ssyr2k(CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(trans), Double_val(alpha), &m_A, &m_B, Double_val(beta), &m_C); return Val_unit; } CAMLprim value ml_gsl_blas_ssyr2k_bc(value *argv, int argc) { return ml_gsl_blas_ssyr2k(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_strmm(value side, value uplo, value transa, value diag, value alpha, value A, value B) { _DECLARE_MATRIX2(A, B); _CONVERT_MATRIX2(A, B); gsl_blas_strmm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), Double_val(alpha), &m_A, &m_B); return Val_unit; } CAMLprim value ml_gsl_blas_strmm_bc(value *argv, int argc) { return ml_gsl_blas_strmm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_blas_strsm(value side, value uplo, value transa, value diag, value alpha, value A, value B) { _DECLARE_MATRIX2(A, B); _CONVERT_MATRIX2(A, B); gsl_blas_strsm(CBLAS_SIDE_val(side), CBLAS_UPLO_val(uplo), CBLAS_TRANS_val(transa), CBLAS_DIAG_val(diag), Double_val(alpha), &m_A, &m_B); return Val_unit; } CAMLprim value ml_gsl_blas_strsm_bc(value *argv, int argc) { return ml_gsl_blas_strsm(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } gsl-ocaml-1.19.1/lib/mlgsl_bspline.c000066400000000000000000000021201262311274100172170ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2007 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include "wrappers.h" CAMLprim value ml_gsl_bspline_alloc(value k, value nbreak) { value r; gsl_bspline_workspace *w = gsl_bspline_alloc (Long_val(k), Long_val(nbreak)); Abstract_ptr(r, w); return r; } #define Bspline_val(v) ((gsl_bspline_workspace *)(Field((v), 0))) ML1(gsl_bspline_free, Bspline_val, Unit) ML1(gsl_bspline_ncoeffs, Bspline_val, Val_long) #include "mlgsl_vector_double.h" CAMLprim value ml_gsl_bspline_knots (value b, value w) { _DECLARE_VECTOR(b); _CONVERT_VECTOR(b); gsl_bspline_knots(&v_b, Bspline_val(w)); return Val_unit; } ML3(gsl_bspline_knots_uniform, Double_val, Double_val, Bspline_val, Unit) CAMLprim value ml_gsl_bspline_eval (value x, value B, value w) { _DECLARE_VECTOR(B); _CONVERT_VECTOR(B); gsl_bspline_eval(Double_val(x), &v_B, Bspline_val(w)); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_cdf.c000066400000000000000000000136761262311274100163410ustar00rootroot00000000000000#include #include "wrappers.h" ML1(gsl_cdf_ugaussian_P, Double_val, copy_double) ML1(gsl_cdf_ugaussian_Q, Double_val, copy_double) ML1(gsl_cdf_ugaussian_Pinv, Double_val, copy_double) ML1(gsl_cdf_ugaussian_Qinv, Double_val, copy_double) ML2(gsl_cdf_gaussian_P, Double_val, Double_val, copy_double) ML2(gsl_cdf_gaussian_Q, Double_val, Double_val, copy_double) ML2(gsl_cdf_gaussian_Pinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_gaussian_Qinv, Double_val, Double_val, copy_double) ML3(gsl_cdf_gamma_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gamma_Q, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gamma_Pinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gamma_Qinv, Double_val, Double_val, Double_val, copy_double) ML2(gsl_cdf_cauchy_P, Double_val, Double_val, copy_double) ML2(gsl_cdf_cauchy_Q, Double_val, Double_val, copy_double) ML2(gsl_cdf_cauchy_Pinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_cauchy_Qinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_laplace_P, Double_val, Double_val, copy_double) ML2(gsl_cdf_laplace_Q, Double_val, Double_val, copy_double) ML2(gsl_cdf_laplace_Pinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_laplace_Qinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_rayleigh_P, Double_val, Double_val, copy_double) ML2(gsl_cdf_rayleigh_Q, Double_val, Double_val, copy_double) ML2(gsl_cdf_rayleigh_Pinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_rayleigh_Qinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_chisq_P, Double_val, Double_val, copy_double) ML2(gsl_cdf_chisq_Q, Double_val, Double_val, copy_double) ML2(gsl_cdf_chisq_Pinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_chisq_Qinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_exponential_P, Double_val, Double_val, copy_double) ML2(gsl_cdf_exponential_Q, Double_val, Double_val, copy_double) ML2(gsl_cdf_exponential_Pinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_exponential_Qinv, Double_val, Double_val, copy_double) ML3(gsl_cdf_exppow_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_exppow_Q, Double_val, Double_val, Double_val, copy_double) ML2(gsl_cdf_tdist_P, Double_val, Double_val, copy_double) ML2(gsl_cdf_tdist_Q, Double_val, Double_val, copy_double) ML2(gsl_cdf_tdist_Pinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_tdist_Qinv, Double_val, Double_val, copy_double) ML3(gsl_cdf_fdist_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_fdist_Q, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_fdist_Pinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_fdist_Qinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_beta_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_beta_Q, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_beta_Pinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_beta_Qinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_flat_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_flat_Q, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_flat_Pinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_flat_Qinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_lognormal_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_lognormal_Q, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_lognormal_Pinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_lognormal_Qinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gumbel1_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gumbel1_Q, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gumbel1_Pinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gumbel1_Qinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gumbel2_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gumbel2_Q, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gumbel2_Pinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_gumbel2_Qinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_weibull_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_weibull_Q, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_weibull_Pinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_weibull_Qinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_pareto_P, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_pareto_Q, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_pareto_Pinv, Double_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_pareto_Qinv, Double_val, Double_val, Double_val, copy_double) ML2(gsl_cdf_logistic_P, Double_val, Double_val, copy_double) ML2(gsl_cdf_logistic_Q, Double_val, Double_val, copy_double) ML2(gsl_cdf_logistic_Pinv, Double_val, Double_val, copy_double) ML2(gsl_cdf_logistic_Qinv, Double_val, Double_val, copy_double) ML3(gsl_cdf_binomial_P, Unsigned_int_val, Double_val, Unsigned_int_val, copy_double) ML3(gsl_cdf_binomial_Q, Unsigned_int_val, Double_val, Unsigned_int_val, copy_double) ML2(gsl_cdf_poisson_P, Unsigned_int_val, Double_val, copy_double) ML2(gsl_cdf_poisson_Q, Unsigned_int_val, Double_val, copy_double) ML2(gsl_cdf_geometric_P, Unsigned_int_val, Double_val, copy_double) ML2(gsl_cdf_geometric_Q, Unsigned_int_val, Double_val, copy_double) ML3(gsl_cdf_negative_binomial_P, Unsigned_int_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_negative_binomial_Q, Unsigned_int_val, Double_val, Double_val, copy_double) ML3(gsl_cdf_pascal_P, Unsigned_int_val, Double_val, Unsigned_int_val, copy_double) ML3(gsl_cdf_pascal_Q, Unsigned_int_val, Double_val, Unsigned_int_val, copy_double) ML4(gsl_cdf_hypergeometric_P, Unsigned_int_val, Unsigned_int_val, Unsigned_int_val, Unsigned_int_val, copy_double) ML4(gsl_cdf_hypergeometric_Q, Unsigned_int_val, Unsigned_int_val, Unsigned_int_val, Unsigned_int_val, copy_double) gsl-ocaml-1.19.1/lib/mlgsl_cheb.c000066400000000000000000000032151262311274100164720ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include "wrappers.h" #include "mlgsl_fun.h" #define CHEB_VAL(v) ((gsl_cheb_series *)Field((v), 0)) ML1_alloc(gsl_cheb_alloc, Int_val, Abstract_ptr) ML1(gsl_cheb_free, CHEB_VAL, Unit) CAMLprim value ml_gsl_cheb_order(value c) { return Val_int(CHEB_VAL(c)->order); } CAMLprim value ml_gsl_cheb_coefs(value c) { CAMLparam1(c); CAMLlocal1(a); gsl_cheb_series *cs = CHEB_VAL(c); size_t len = cs->order + 1; a = alloc(len * Double_wosize, Double_array_tag); memcpy(Bp_val(a), cs->c, len * sizeof (double)); CAMLreturn(a); } CAMLprim value ml_gsl_cheb_init(value cs, value f, value a, value b) { CAMLparam2(cs, f); GSLFUN_CLOSURE(gf, f); gsl_cheb_init(CHEB_VAL(cs), &gf, Double_val(a), Double_val(b)); CAMLreturn(Val_unit); } ML2(gsl_cheb_eval, CHEB_VAL, Double_val, copy_double) CAMLprim value ml_gsl_cheb_eval_err(value cheb, value x) { double res,err; gsl_cheb_eval_err(CHEB_VAL(cheb), Double_val(x), &res, &err); return copy_two_double_arr(res, err); } ML3(gsl_cheb_eval_n, CHEB_VAL, Int_val, Double_val, copy_double) CAMLprim value ml_gsl_cheb_eval_n_err(value cheb, value order, value x) { double res,err; gsl_cheb_eval_n_err(CHEB_VAL(cheb), Int_val(order), Double_val(x), &res, &err); return copy_two_double_arr(res, err); } ML2(gsl_cheb_calc_deriv, CHEB_VAL, CHEB_VAL, Unit) ML2(gsl_cheb_calc_integ, CHEB_VAL, CHEB_VAL, Unit) gsl-ocaml-1.19.1/lib/mlgsl_combi.c000066400000000000000000000021221262311274100166560ustar00rootroot00000000000000#include #include #include #include static void combi_of_val(gsl_combination *c, value vc) { c->n = Int_val(Field(vc, 0)); c->k = Int_val(Field(vc, 1)); c->data = Data_bigarray_val(Field(vc, 2)); } CAMLprim value ml_gsl_combination_init_first(value vc) { gsl_combination c; combi_of_val(&c, vc); gsl_combination_init_first(&c); return Val_unit; } CAMLprim value ml_gsl_combination_init_last(value vc) { gsl_combination c; combi_of_val(&c, vc); gsl_combination_init_last(&c); return Val_unit; } CAMLprim value ml_gsl_combination_valid(value vc) { int r; gsl_combination c; combi_of_val(&c, vc); r = gsl_combination_valid(&c); return Val_not(Val_bool(r)); } CAMLprim value ml_gsl_combination_next(value vc) { gsl_combination c; combi_of_val(&c, vc); gsl_combination_next(&c); return Val_unit; } CAMLprim value ml_gsl_combination_prev(value vc) { gsl_combination c; combi_of_val(&c, vc); gsl_combination_prev(&c); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_complex.c000066400000000000000000000044341262311274100172440ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2003 - Paul Pelzl */ /* Distributed under the terms of the GPL version 3 */ #include #include #include "mlgsl_complex.h" #define _COMPLEX_HANDLER(funct) \ CAMLprim value ml_gsl_complex_##funct(value Z) { \ _DECLARE_COMPLEX2(Z,temp); \ _CONVERT_COMPLEX(Z); \ z_temp = gsl_complex_##funct(z_Z); \ return copy_complex(&z_temp); \ } #define _COMPLEX_HANDLER2(funct) \ CAMLprim value ml_gsl_complex_##funct(value Z, value A) { \ _DECLARE_COMPLEX3(Z, A, temp); \ _CONVERT_COMPLEX2(Z, A); \ z_temp = gsl_complex_##funct(z_Z, z_A); \ return copy_complex(&z_temp); \ } #define _COMPLEX_HANDLER_DOUBLE(funct) \ CAMLprim value ml_gsl_complex_##funct(value X) { \ gsl_complex temp; \ temp = gsl_complex_##funct(Double_val(X)); \ return copy_complex(&temp); \ } /* properties of complex numbers */ CAMLprim value ml_gsl_complex_logabs(value Z) { _DECLARE_COMPLEX(Z); _CONVERT_COMPLEX(Z); return copy_double(gsl_complex_logabs(z_Z)); } _COMPLEX_HANDLER(sqrt) _COMPLEX_HANDLER_DOUBLE(sqrt_real) _COMPLEX_HANDLER2(pow) CAMLprim value ml_gsl_complex_pow_real(value Z, value X) { _DECLARE_COMPLEX2(Z, temp); _CONVERT_COMPLEX(Z); z_temp = gsl_complex_pow_real(z_Z, Double_val(X)); return copy_complex(&z_temp); } _COMPLEX_HANDLER(exp) _COMPLEX_HANDLER(log) _COMPLEX_HANDLER(log10) _COMPLEX_HANDLER2(log_b) _COMPLEX_HANDLER(sin) _COMPLEX_HANDLER(cos) _COMPLEX_HANDLER(tan) _COMPLEX_HANDLER(sec) _COMPLEX_HANDLER(csc) _COMPLEX_HANDLER(cot) _COMPLEX_HANDLER(arcsin) _COMPLEX_HANDLER_DOUBLE(arcsin_real) _COMPLEX_HANDLER(arccos) _COMPLEX_HANDLER_DOUBLE(arccos_real) _COMPLEX_HANDLER(arctan) _COMPLEX_HANDLER(arcsec) _COMPLEX_HANDLER_DOUBLE(arcsec_real) _COMPLEX_HANDLER(arccsc) _COMPLEX_HANDLER_DOUBLE(arccsc_real) _COMPLEX_HANDLER(arccot) _COMPLEX_HANDLER(sinh) _COMPLEX_HANDLER(cosh) _COMPLEX_HANDLER(tanh) _COMPLEX_HANDLER(sech) _COMPLEX_HANDLER(csch) _COMPLEX_HANDLER(coth) _COMPLEX_HANDLER(arcsinh) _COMPLEX_HANDLER(arccosh) _COMPLEX_HANDLER_DOUBLE(arccosh_real) _COMPLEX_HANDLER(arctanh) _COMPLEX_HANDLER_DOUBLE(arctanh_real) _COMPLEX_HANDLER(arcsech) _COMPLEX_HANDLER(arccsch) _COMPLEX_HANDLER(arccoth) gsl-ocaml-1.19.1/lib/mlgsl_complex.h000066400000000000000000000016621262311274100172510ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include "wrappers.h" static inline value #ifndef FLOAT_COMPLEX copy_complex(gsl_complex * c) #else copy_complex(gsl_complex_float * c) #endif /* FLOAT_COMPLEX */ { return copy_two_double_arr(GSL_COMPLEX_P_REAL(c), GSL_COMPLEX_P_IMAG(c)); } #ifndef FLOAT_COMPLEX #define _DECLARE_COMPLEX(v) gsl_complex z_##v #else #define _DECLARE_COMPLEX(v) gsl_complex_float z_##v #endif /* FLOAT_COMPLEX */ #define _DECLARE_COMPLEX2(v1,v2) _DECLARE_COMPLEX(v1); _DECLARE_COMPLEX(v2) #define _DECLARE_COMPLEX3(v1,v2,v3) _DECLARE_COMPLEX2(v1,v2); _DECLARE_COMPLEX(v3) #define _CONVERT_COMPLEX(v) GSL_SET_COMPLEX(&z_##v,Double_field(v, 0), Double_field(v,1)) #define _CONVERT_COMPLEX2(v1,v2) _CONVERT_COMPLEX(v1); _CONVERT_COMPLEX(v2) gsl-ocaml-1.19.1/lib/mlgsl_deriv.c000066400000000000000000000021531262311274100167020ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include "wrappers.h" #include "mlgsl_fun.h" value ml_gsl_deriv_central(value f, value x, value h) { CAMLparam1(f); double result,abserr; GSLFUN_CLOSURE(gf, f); gsl_deriv_central(&gf, Double_val(x), Double_val(h), &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } value ml_gsl_deriv_forward(value f, value x, value h) { CAMLparam1(f); double result,abserr; GSLFUN_CLOSURE(gf, f); gsl_deriv_forward(&gf, Double_val(x), Double_val(h), &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } value ml_gsl_deriv_backward(value f, value x, value h) { CAMLparam1(f); double result,abserr; GSLFUN_CLOSURE(gf, f); gsl_deriv_backward(&gf, Double_val(x), Double_val(h), &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } gsl-ocaml-1.19.1/lib/mlgsl_eigen.c000066400000000000000000000132501262311274100166600ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include "wrappers.h" #include "mlgsl_permut.h" #include "mlgsl_complex.h" #include "mlgsl_vector_complex.h" #include "mlgsl_matrix_complex.h" #undef BASE_TYPE #undef TYPE #undef _DECLARE_BASE_TYPE #undef _CONVERT_BASE_TYPE #undef DECLARE_BASE_TYPE #undef FUNCTION #include "mlgsl_matrix_double.h" #include "mlgsl_vector_double.h" CAMLprim value ml_gsl_eigen_symm_alloc(value n) { value v; gsl_eigen_symm_workspace *ws = gsl_eigen_symm_alloc(Int_val(n)); Abstract_ptr(v, ws); return v; } #define SYMM_WS_val(v) ((gsl_eigen_symm_workspace *)Field(v, 0)) ML1(gsl_eigen_symm_free, SYMM_WS_val, Unit) CAMLprim value ml_gsl_eigen_symm(value A, value EVAL, value ws) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(EVAL); _CONVERT_MATRIX(A); _CONVERT_VECTOR(EVAL); gsl_eigen_symm(&m_A, &v_EVAL, SYMM_WS_val(ws)); return Val_unit; } CAMLprim value ml_gsl_eigen_symmv_alloc(value n) { value v; gsl_eigen_symmv_workspace *ws = gsl_eigen_symmv_alloc(Int_val(n)); Abstract_ptr(v, ws); return v; } #define SYMMV_WS_val(v) ((gsl_eigen_symmv_workspace *)Field(v, 0)) ML1(gsl_eigen_symmv_free, SYMMV_WS_val, Unit) CAMLprim value ml_gsl_eigen_symmv(value A, value EVAL, value EVEC, value ws) { _DECLARE_MATRIX2(A, EVEC); _DECLARE_VECTOR(EVAL); _CONVERT_MATRIX2(A, EVEC); _CONVERT_VECTOR(EVAL); gsl_eigen_symmv(&m_A, &v_EVAL, &m_EVEC, SYMMV_WS_val(ws)); return Val_unit; } static const gsl_eigen_sort_t eigen_sort_type[] = { GSL_EIGEN_SORT_VAL_ASC, GSL_EIGEN_SORT_VAL_DESC, GSL_EIGEN_SORT_ABS_ASC, GSL_EIGEN_SORT_ABS_DESC, }; CAMLprim value ml_gsl_eigen_symmv_sort(value E, value sort) { value EVAL = Field(E, 0); value EVEC = Field(E, 1); _DECLARE_MATRIX(EVEC); _DECLARE_VECTOR(EVAL); _CONVERT_MATRIX(EVEC); _CONVERT_VECTOR(EVAL); gsl_eigen_symmv_sort(&v_EVAL, &m_EVEC, eigen_sort_type[ Int_val(sort) ]); return Val_unit; } /* Hermitian matrices */ CAMLprim value ml_gsl_eigen_herm_alloc(value n) { value v; gsl_eigen_herm_workspace *ws = gsl_eigen_herm_alloc(Int_val(n)); Abstract_ptr(v, ws); return v; } #define HERM_WS_val(v) ((gsl_eigen_herm_workspace *)Field(v, 0)) ML1(gsl_eigen_herm_free, HERM_WS_val, Unit) CAMLprim value ml_gsl_eigen_herm(value A, value EVAL, value ws) { _DECLARE_COMPLEX_MATRIX(A); _DECLARE_VECTOR(EVAL); _CONVERT_COMPLEX_MATRIX(A); _CONVERT_VECTOR(EVAL); gsl_eigen_herm(&m_A, &v_EVAL, HERM_WS_val(ws)); return Val_unit; } CAMLprim value ml_gsl_eigen_hermv_alloc(value n) { value v; gsl_eigen_hermv_workspace *ws = gsl_eigen_hermv_alloc(Int_val(n)); Abstract_ptr(v, ws); return v; } #define HERMV_WS_val(v) ((gsl_eigen_hermv_workspace *)Field(v, 0)) ML1(gsl_eigen_hermv_free, HERMV_WS_val, Unit) CAMLprim value ml_gsl_eigen_hermv(value A, value EVAL, value EVEC, value ws) { _DECLARE_VECTOR(EVAL); _DECLARE_COMPLEX_MATRIX2(A, EVEC); _CONVERT_VECTOR(EVAL); _CONVERT_COMPLEX_MATRIX2(A, EVEC); gsl_eigen_hermv(&m_A, &v_EVAL, &m_EVEC, HERMV_WS_val(ws)); return Val_unit; } CAMLprim value ml_gsl_eigen_hermv_sort(value E, value sort) { value EVAL = Field(E, 0); value EVEC = Field(E, 1); _DECLARE_COMPLEX_MATRIX(EVEC); _DECLARE_VECTOR(EVAL); _CONVERT_COMPLEX_MATRIX(EVEC); _CONVERT_VECTOR(EVAL); gsl_eigen_hermv_sort(&v_EVAL, &m_EVEC, eigen_sort_type[ Int_val(sort) ]); return Val_unit; } /* Real Nonsymmetrix Matrices */ CAMLprim value ml_gsl_eigen_nonsymm_alloc(value n) { value v; gsl_eigen_nonsymm_workspace *ws = gsl_eigen_nonsymm_alloc(Int_val(n)); Abstract_ptr(v, ws); return v; } #define NONSYMM_WS_val(v) ((gsl_eigen_nonsymm_workspace *)Field(v, 0)) ML1(gsl_eigen_nonsymm_free, NONSYMM_WS_val, Unit) CAMLprim value ml_gsl_eigen_nonsymm(value A, value EVAL, value ws) { _DECLARE_MATRIX(A); _DECLARE_COMPLEX_VECTOR(EVAL); _CONVERT_MATRIX(A); _CONVERT_COMPLEX_VECTOR(EVAL); gsl_eigen_nonsymm(&m_A, &v_EVAL, NONSYMM_WS_val(ws)); return Val_unit; } CAMLprim value ml_gsl_eigen_nonsymm_Z(value A, value EVAL, value Z, value ws) { _DECLARE_MATRIX2(A,Z); _DECLARE_COMPLEX_VECTOR(EVAL); _CONVERT_MATRIX2(A,Z); _CONVERT_COMPLEX_VECTOR(EVAL); gsl_eigen_nonsymm_Z(&m_A, &v_EVAL, &m_Z, NONSYMM_WS_val(ws)); return Val_unit; } CAMLprim value ml_gsl_eigen_nonsymmv_alloc(value n) { value v; gsl_eigen_nonsymmv_workspace *ws = gsl_eigen_nonsymmv_alloc(Int_val(n)); Abstract_ptr(v, ws); return v; } #define NONSYMMV_WS_val(v) ((gsl_eigen_nonsymmv_workspace *)Field(v, 0)) ML1(gsl_eigen_nonsymmv_free, NONSYMMV_WS_val, Unit) CAMLprim value ml_gsl_eigen_nonsymmv(value A, value EVAL, value EVEC, value ws) { _DECLARE_MATRIX(A); _DECLARE_COMPLEX_VECTOR(EVAL); _DECLARE_COMPLEX_MATRIX(EVEC); _CONVERT_MATRIX(A); _CONVERT_COMPLEX_VECTOR(EVAL); _CONVERT_COMPLEX_MATRIX(EVEC); gsl_eigen_nonsymmv(&m_A, &v_EVAL, &m_EVEC, NONSYMMV_WS_val(ws)); return Val_unit; } CAMLprim value ml_gsl_eigen_nonsymmv_Z(value A, value EVAL, value EVEC, value Z, value ws) { _DECLARE_MATRIX2(A,Z); _DECLARE_COMPLEX_VECTOR(EVAL); _DECLARE_COMPLEX_MATRIX(EVEC); _CONVERT_MATRIX2(A,Z); _CONVERT_COMPLEX_VECTOR(EVAL); _CONVERT_COMPLEX_MATRIX(EVEC); gsl_eigen_nonsymmv_Z(&m_A, &v_EVAL, &m_EVEC, &m_Z, NONSYMMV_WS_val(ws)); return Val_unit; } CAMLprim value ml_gsl_eigen_nonsymmv_sort(value E, value sort) { value EVAL = Field(E, 0); value EVEC = Field(E, 1); _DECLARE_COMPLEX_VECTOR(EVAL); _DECLARE_COMPLEX_MATRIX(EVEC); _CONVERT_COMPLEX_VECTOR(EVAL); _CONVERT_COMPLEX_MATRIX(EVEC); gsl_eigen_nonsymmv_sort(&v_EVAL, &m_EVEC, eigen_sort_type[ Int_val(sort) ]); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_error.c000066400000000000000000000030751262311274100167260ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include CAMLprim value ml_gsl_version(value unit) { return caml_copy_string(gsl_version); } CAMLprim value ml_gsl_strerror(value ml_errno) { int c_errno = Int_val(ml_errno); int gsl_errno = (c_errno <= 1) ? (c_errno - 2) : (c_errno - 1) ; return caml_copy_string(gsl_strerror(gsl_errno)); } static value *ml_gsl_err_handler = NULL; static void ml_gsl_error_handler(const char *reason, const char *file, int line, int gsl_errno) { value exn_msg; int ml_errno; if (0 < gsl_errno && gsl_errno <= GSL_EOF) ml_errno = gsl_errno + 1; else if (GSL_CONTINUE <= gsl_errno && gsl_errno <= GSL_FAILURE) ml_errno = gsl_errno + 2; else failwith("invalid GSL error code"); exn_msg = caml_copy_string(reason); caml_callback2(Field(*ml_gsl_err_handler,0), Val_int(ml_errno), exn_msg); } CAMLprim value ml_gsl_error_init(value init) { static gsl_error_handler_t *old; if(ml_gsl_err_handler == NULL) ml_gsl_err_handler = caml_named_value("mlgsl_err_handler"); if (Bool_val(init)) { gsl_error_handler_t *prev; prev = gsl_set_error_handler(&ml_gsl_error_handler); if (prev != ml_gsl_error_handler) old = prev; } else gsl_set_error_handler(old); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_fft.c000066400000000000000000000227641262311274100163620ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include #include #include "wrappers.h" enum mlgsl_fft_array_layout { LAYOUT_REAL = 0 , LAYOUT_HC = 1 , LAYOUT_HC_RAD2 = 2 , LAYOUT_C = 3 , } ; static void check_layout(value fft_arr, enum mlgsl_fft_array_layout layout) { static value *layout_exn; if(Int_val(Field(fft_arr, 0)) != layout) { if(!layout_exn) { layout_exn = caml_named_value("mlgsl_layout_exn"); if(!layout_exn) /* Gromeleu */ invalid_argument("wrong fft_array layout"); } raise_constant(*layout_exn); } } static inline void update_layout(value fft_arr, enum mlgsl_fft_array_layout layout) { Store_field(fft_arr, 0, Val_int(layout)); } /* WORKSPACE AND WAVETABLES */ #define GSL_REAL_WS(v) ((gsl_fft_real_workspace *)Field((v),0)) #define GSL_COMPLEX_WS(v) ((gsl_fft_complex_workspace *)Field((v),0)) #define GSL_REAL_WT(v) ((gsl_fft_real_wavetable *)Field((v),0)) #define GSL_HALFCOMPLEX_WT(v) ((gsl_fft_halfcomplex_wavetable *)Field((v),0)) #define GSL_COMPLEX_WT(v) ((gsl_fft_complex_wavetable *)Field((v),0)) ML1_alloc(gsl_fft_real_workspace_alloc, Int_val, Abstract_ptr) ML1_alloc(gsl_fft_complex_workspace_alloc, Int_val, Abstract_ptr) ML1_alloc(gsl_fft_real_wavetable_alloc, Int_val, Abstract_ptr) ML1_alloc(gsl_fft_halfcomplex_wavetable_alloc, Int_val, Abstract_ptr) ML1_alloc(gsl_fft_complex_wavetable_alloc, Int_val, Abstract_ptr) ML1(gsl_fft_real_workspace_free, GSL_REAL_WS, Unit) ML1(gsl_fft_complex_workspace_free, GSL_COMPLEX_WS, Unit) ML1(gsl_fft_real_wavetable_free, GSL_REAL_WT, Unit) ML1(gsl_fft_halfcomplex_wavetable_free, GSL_HALFCOMPLEX_WT, Unit) ML1(gsl_fft_complex_wavetable_free, GSL_COMPLEX_WT, Unit) /* UNPACKING ROUTINES */ CAMLprim value ml_gsl_fft_real_unpack(value stride, value r, value c) { const size_t c_stride = Opt_arg(stride, Int_val, 1); const size_t n = Double_array_length(r); gsl_fft_real_unpack(Double_array_val(r), Double_array_val(c), c_stride, n) ; return Val_unit; } CAMLprim value ml_gsl_fft_halfcomplex_unpack(value stride, value hc, value c) { const size_t c_stride = Opt_arg(stride, Int_val, 1); const size_t n = Double_array_length(hc); gsl_fft_halfcomplex_unpack(Double_array_val(hc), Double_array_val(c), c_stride, n) ; return Val_unit; } CAMLprim value ml_gsl_fft_halfcomplex_unpack_rad2(value stride, value hc, value c) { const size_t c_stride = Opt_arg(stride, Int_val ,1); const size_t n = Double_array_length(hc); gsl_fft_halfcomplex_radix2_unpack(Double_array_val(hc), Double_array_val(c), c_stride, n) ; return Val_unit; } /* REAL AND HALFCOMPLEX MIXED-RADIX FFT */ CAMLprim value ml_gsl_fft_real_transform(value stride, value fft_arr, value wt, value ws) { value data = Field(fft_arr, 1); const size_t c_stride = Opt_arg(stride, Int_val, 1); const size_t n = Double_array_length(data); check_layout(fft_arr, LAYOUT_REAL); gsl_fft_real_transform(Double_array_val(data), c_stride, n, GSL_REAL_WT(wt), GSL_REAL_WS(ws)) ; update_layout(fft_arr, LAYOUT_HC); return Val_unit; } CAMLprim value ml_gsl_fft_halfcomplex_transform(value stride, value fft_arr, value wt, value ws) { value data = Field(fft_arr, 1); const size_t c_stride = Opt_arg(stride, Int_val, 1); const size_t n = Double_array_length(data); check_layout(fft_arr, LAYOUT_HC); gsl_fft_halfcomplex_transform(Double_array_val(data), c_stride, n, GSL_HALFCOMPLEX_WT(wt), GSL_REAL_WS(ws)) ; return Val_unit; } CAMLprim value ml_gsl_fft_halfcomplex_backward(value stride, value fft_arr, value wt, value ws) { value data = Field(fft_arr, 1); const size_t c_stride = Opt_arg(stride, Int_val, 1); const size_t n = Double_array_length(data); check_layout(fft_arr, LAYOUT_HC); gsl_fft_halfcomplex_backward(Double_array_val(data), c_stride, n, GSL_HALFCOMPLEX_WT(wt), GSL_REAL_WS(ws)) ; update_layout(fft_arr, LAYOUT_REAL); return Val_unit; } CAMLprim value ml_gsl_fft_halfcomplex_inverse(value stride, value fft_arr, value wt, value ws) { value data = Field(fft_arr, 1); const size_t c_stride = Opt_arg(stride, Int_val, 1); const size_t n = Double_array_length(data); check_layout(fft_arr, LAYOUT_HC); gsl_fft_halfcomplex_inverse(Double_array_val(data), c_stride, n, GSL_HALFCOMPLEX_WT(wt), GSL_REAL_WS(ws)) ; update_layout(fft_arr, LAYOUT_REAL); return Val_unit; } /* REAL AND HALFCOMPLEX RADIX2 FFT */ CAMLprim value ml_gsl_fft_real_radix2_transform(value stride, value fft_arr) { value data = Field(fft_arr, 1); size_t N = Double_array_length(data); size_t c_stride = Opt_arg(stride, Int_val, 1); check_layout(fft_arr, LAYOUT_REAL); gsl_fft_real_radix2_transform(Double_array_val(data), c_stride, N); update_layout(fft_arr, LAYOUT_HC_RAD2); return Val_unit; } CAMLprim value ml_gsl_fft_halfcomplex_radix2_transform(value stride, value fft_arr) { value data = Field(fft_arr, 1); size_t N = Double_array_length(data); size_t c_stride = Opt_arg(stride, Int_val, 1); check_layout(fft_arr, LAYOUT_HC_RAD2); gsl_fft_halfcomplex_radix2_transform(Double_array_val(data), c_stride, N); return Val_unit; } CAMLprim value ml_gsl_fft_halfcomplex_radix2_backward(value stride, value fft_arr) { value data = Field(fft_arr, 1); size_t N = Double_array_length(data); size_t c_stride = Opt_arg(stride, Int_val, 1); check_layout(fft_arr, LAYOUT_HC_RAD2); gsl_fft_halfcomplex_radix2_backward(Double_array_val(data), c_stride, N); update_layout(fft_arr, LAYOUT_REAL); return Val_unit; } CAMLprim value ml_gsl_fft_halfcomplex_radix2_inverse(value stride, value fft_arr) { value data = Field(fft_arr, 1); size_t N = Double_array_length(data); size_t c_stride = Opt_arg(stride, Int_val, 1); check_layout(fft_arr, LAYOUT_HC_RAD2); gsl_fft_halfcomplex_radix2_inverse(Double_array_val(data), c_stride, N); update_layout(fft_arr, LAYOUT_REAL); return Val_unit; } /* COMPLEX RADIX-2 FFT */ CAMLprim value ml_gsl_fft_complex_rad2_forward(value dif, value stride, value data) { size_t N = Double_array_length(data) / 2; size_t c_stride = Opt_arg(stride, Int_val, 1); int c_dif = Opt_arg(dif, Bool_val, 0); if(c_dif) gsl_fft_complex_radix2_dif_forward(Double_array_val(data), c_stride, N); else gsl_fft_complex_radix2_forward(Double_array_val(data), c_stride, N); return Val_unit; } CAMLprim value ml_gsl_fft_complex_rad2_transform(value dif, value stride, value data, value sign) { size_t N = Double_array_length(data) / 2; size_t c_stride = Opt_arg(stride, Int_val, 1); int c_dif = Opt_arg(dif, Bool_val, 0); gsl_fft_direction c_sign = (Int_val(sign)==0) ? gsl_fft_forward : gsl_fft_backward; if(c_dif) gsl_fft_complex_radix2_dif_transform(Double_array_val(data), c_stride, N, c_sign); else gsl_fft_complex_radix2_transform(Double_array_val(data), c_stride, N, c_sign); return Val_unit; } CAMLprim value ml_gsl_fft_complex_rad2_backward(value dif, value stride, value data) { size_t N = Double_array_length(data) / 2; size_t c_stride = Opt_arg(stride, Int_val, 1); int c_dif = Opt_arg(dif, Bool_val, 0); if(c_dif) gsl_fft_complex_radix2_dif_backward(Double_array_val(data), c_stride, N); else gsl_fft_complex_radix2_backward(Double_array_val(data), c_stride, N); return Val_unit; } CAMLprim value ml_gsl_fft_complex_rad2_inverse(value dif, value stride, value data) { size_t N = Double_array_length(data) / 2; size_t c_stride = Opt_arg(stride, Int_val, 1); int c_dif = Opt_arg(dif, Bool_val, 0); if(c_dif) gsl_fft_complex_radix2_dif_inverse(Double_array_val(data), c_stride, N); else gsl_fft_complex_radix2_inverse(Double_array_val(data), c_stride, N); return Val_unit; } /* COMPLEX MIXED RADIX FFT */ CAMLprim value ml_gsl_fft_complex_forward(value stride, value data, value wt, value ws) { const size_t c_stride = Opt_arg(stride, Int_val, 1); const size_t n = Double_array_length(data) / 2; gsl_fft_complex_forward(Double_array_val(data), c_stride, n, GSL_COMPLEX_WT(wt), GSL_COMPLEX_WS(ws)) ; return Val_unit; } CAMLprim value ml_gsl_fft_complex_transform(value stride, value data, value wt, value ws, value sign) { const size_t c_stride = Opt_arg(stride, Int_val, 1); const size_t n = Double_array_length(data) / 2; gsl_fft_direction c_sign = (Int_val(sign)==0) ? gsl_fft_forward : gsl_fft_backward; gsl_fft_complex_transform(Double_array_val(data), c_stride, n, GSL_COMPLEX_WT(wt), GSL_COMPLEX_WS(ws), c_sign) ; return Val_unit; } CAMLprim value ml_gsl_fft_complex_backward(value stride, value data, value wt, value ws) { const size_t c_stride = Opt_arg(stride, Int_val, 1); const size_t n = Double_array_length(data) / 2; gsl_fft_complex_backward(Double_array_val(data), c_stride, n, GSL_COMPLEX_WT(wt), GSL_COMPLEX_WS(ws)) ; return Val_unit; } CAMLprim value ml_gsl_fft_complex_inverse(value stride, value data, value wt, value ws) { const size_t c_stride = Opt_arg(stride, Int_val ,1); const size_t n = Double_array_length(data) / 2; gsl_fft_complex_inverse(Double_array_val(data), c_stride, n, GSL_COMPLEX_WT(wt), GSL_COMPLEX_WS(ws)) ; return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_fit.c000066400000000000000000000076141262311274100163620ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include "wrappers.h" #include "mlgsl_matrix_double.h" #include "mlgsl_vector_double.h" CAMLprim value ml_gsl_fit_linear(value wo, value x, value y) { value r; size_t N=Double_array_length(x); double c0,c1,cov00,cov01,cov11,sumsq; if(Double_array_length(y) != N) GSL_ERROR("array sizes differ", GSL_EBADLEN); if(wo == Val_none) gsl_fit_linear(Double_array_val(x), 1, Double_array_val(y), 1, N, &c0, &c1, &cov00, &cov01, &cov11, &sumsq); else { value w=Field(wo, 0); if(Double_array_length(w) != N) GSL_ERROR("array sizes differ", GSL_EBADLEN); gsl_fit_wlinear(Double_array_val(x), 1, Double_array_val(w), 1, Double_array_val(y), 1, N, &c0, &c1, &cov00, &cov01, &cov11, &sumsq); } r=alloc_small(6 * Double_wosize, Double_array_tag); Store_double_field(r, 0, c0); Store_double_field(r, 1, c1); Store_double_field(r, 2, cov00); Store_double_field(r, 3, cov01); Store_double_field(r, 4, cov11); Store_double_field(r, 5, sumsq); return r; } CAMLprim value ml_gsl_fit_linear_est(value x, value coeffs) { double y,y_err; gsl_fit_linear_est(Double_val(x), Double_field(coeffs, 0), Double_field(coeffs, 1), Double_field(coeffs, 2), Double_field(coeffs, 3), Double_field(coeffs, 4), &y, &y_err); return copy_two_double_arr(y, y_err); } CAMLprim value ml_gsl_fit_mul(value wo, value x, value y) { value r; size_t N=Double_array_length(x); double c1,cov11,sumsq; if(Double_array_length(y) != N) GSL_ERROR("array sizes differ", GSL_EBADLEN); if(wo == Val_none) gsl_fit_mul(Double_array_val(x), 1, Double_array_val(y), 1, N, &c1, &cov11, &sumsq); else { value w=Field(wo, 0); if(Double_array_length(w) != N) GSL_ERROR("array sizes differ", GSL_EBADLEN); gsl_fit_wmul(Double_array_val(x), 1, Double_array_val(w), 1, Double_array_val(y), 1, N, &c1, &cov11, &sumsq); } r=alloc_small(3 * Double_wosize, Double_array_tag); Store_double_field(r, 0, c1); Store_double_field(r, 1, cov11); Store_double_field(r, 2, sumsq); return r; } CAMLprim value ml_gsl_fit_mul_est(value x, value coeffs) { double y,y_err; gsl_fit_mul_est(Double_val(x), Double_field(coeffs, 0), Double_field(coeffs, 1), &y, &y_err); return copy_two_double_arr(y, y_err); } /* MULTIFIT */ CAMLprim value ml_gsl_multifit_linear_alloc(value n, value p) { value r; Abstract_ptr(r, gsl_multifit_linear_alloc(Int_val(n), Int_val(p))); return r; } #define MultifitWS_val(v) ((gsl_multifit_linear_workspace *)(Field((v), 0))) ML1(gsl_multifit_linear_free, MultifitWS_val, Unit) CAMLprim value ml_gsl_multifit_linear(value wo, value x, value y, value c, value cov, value ws) { double chisq; _DECLARE_MATRIX2(x,cov); _DECLARE_VECTOR2(y,c); _CONVERT_MATRIX2(x,cov); _CONVERT_VECTOR2(y,c); if(wo == Val_none) gsl_multifit_linear(&m_x, &v_y, &v_c, &m_cov, &chisq, MultifitWS_val(ws)); else { value w=Field(wo, 0); _DECLARE_VECTOR(w); _CONVERT_VECTOR(w); gsl_multifit_wlinear(&m_x, &v_w, &v_y, &v_c, &m_cov, &chisq, MultifitWS_val(ws)); } return copy_double(chisq); } CAMLprim value ml_gsl_multifit_linear_bc(value *args, int argc) { return ml_gsl_multifit_linear(args[0], args[1], args[2], args[3], args[4], args[5]); } CAMLprim value ml_gsl_multifit_linear_est (value x, value c, value cov) { double y, y_err; _DECLARE_VECTOR2(x, c); _DECLARE_MATRIX(cov); _CONVERT_VECTOR2(x, c); _CONVERT_MATRIX(cov); gsl_multifit_linear_est (&v_x, &v_c, &m_cov, &y, &y_err); return copy_two_double_arr (y, y_err); } gsl-ocaml-1.19.1/lib/mlgsl_fun.c000066400000000000000000000222741262311274100163670ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include #include #include "wrappers.h" #include "mlgsl_fun.h" /* CALLBACKS */ double gslfun_callback(double x, void *params) { struct callback_params *p=params; value res; value v_x = copy_double(x); res=callback(p->closure, v_x); return Double_val(res); } /* FDF CALLBACKS */ double gslfun_callback_indir(double x, void *params) { value res; value v_x = copy_double(x); value *closure = params; res=callback(*closure, v_x); return Double_val(res); } double gslfun_callback_f(double x, void *params) { struct callback_params *p=params; value res; value v_x=copy_double(x); res=callback(Field(p->closure, 0), v_x); return Double_val(res); } double gslfun_callback_df(double x, void *params) { struct callback_params *p=params; value res; value v_x=copy_double(x); res=callback(Field(p->closure, 1), v_x); return Double_val(res); } void gslfun_callback_fdf(double x, void *params, double *f, double *df) { struct callback_params *p=params; value res; value v_x=copy_double(x); res=callback(Field(p->closure, 2), v_x); *f =Double_val(Field(res, 0)); *df=Double_val(Field(res, 1)); } /* MONTE CALLBACKS */ double gsl_monte_callback(double *x_arr, size_t dim, void *params) { struct callback_params *p=params; value res; memcpy(Double_array_val(p->dbl), x_arr, dim*sizeof(double)); res=callback(p->closure, p->dbl); return Double_val(res); } double gsl_monte_callback_fast(double *x_arr, size_t dim, void *params) { struct callback_params *p=params; value res; res=callback(p->closure, (value)x_arr); return Double_val(res); } /* MULTIROOT CALLBACKS */ int gsl_multiroot_callback(const gsl_vector *x, void *params, gsl_vector *F) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *p=params; value x_barr, f_barr; int len = x->size; gsl_vector_view x_v, f_v; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); f_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len); f_v = gsl_vector_view_array(Data_bigarray_val(f_barr), len); gsl_vector_memcpy(&x_v.vector, x); callback2(p->closure, x_barr, f_barr); gsl_vector_memcpy(F, &f_v.vector); return GSL_SUCCESS; } int gsl_multiroot_callback_f(const gsl_vector *x, void *params, gsl_vector *F) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *p=params; value x_barr, f_barr; int len = x->size; gsl_vector_view x_v, f_v; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); f_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len); f_v = gsl_vector_view_array(Data_bigarray_val(f_barr), len); gsl_vector_memcpy(&x_v.vector, x); callback2(Field(p->closure, 0), x_barr, f_barr); gsl_vector_memcpy(F, &f_v.vector); return GSL_SUCCESS; } int gsl_multiroot_callback_df(const gsl_vector *x, void *params, gsl_matrix *J) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *p=params; value x_barr, j_barr; int len = x->size; gsl_vector_view x_v; gsl_matrix_view j_v; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); j_barr = alloc_bigarray_dims(barr_flags, 2, NULL, len, len); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len); j_v = gsl_matrix_view_array(Data_bigarray_val(j_barr), len, len); gsl_vector_memcpy(&x_v.vector, x); callback2(Field(p->closure, 1), x_barr, j_barr); gsl_matrix_memcpy(J, &j_v.matrix); return GSL_SUCCESS; } int gsl_multiroot_callback_fdf(const gsl_vector *x, void *params, gsl_vector *F, gsl_matrix *J) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *p=params; value x_barr, f_barr, j_barr; int len = x->size; gsl_vector_view x_v, f_v; gsl_matrix_view j_v; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); f_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); j_barr = alloc_bigarray_dims(barr_flags, 2, NULL, len, len); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len); f_v = gsl_vector_view_array(Data_bigarray_val(f_barr), len); j_v = gsl_matrix_view_array(Data_bigarray_val(j_barr), len, len); gsl_vector_memcpy(&x_v.vector, x); callback3(Field(p->closure, 2), x_barr, f_barr, j_barr); gsl_vector_memcpy(F, &f_v.vector); gsl_matrix_memcpy(J, &j_v.matrix); return GSL_SUCCESS; } /* MULTIMIN CALLBACKS */ double gsl_multimin_callback(const gsl_vector *x, void *params) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *p=params; value x_barr; int len = x->size; gsl_vector_view x_v; value res; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len); gsl_vector_memcpy(&x_v.vector, x); res=callback(p->closure, x_barr); return Double_val(res); } double gsl_multimin_callback_f(const gsl_vector *x, void *params) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *p=params; value x_barr; int len = x->size; gsl_vector_view x_v; value res; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len); gsl_vector_memcpy(&x_v.vector, x); res=callback(Field(p->closure, 0), x_barr); return Double_val(res); } void gsl_multimin_callback_df(const gsl_vector *x, void *params, gsl_vector *G) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *p=params; value x_barr, g_barr; int len = x->size; gsl_vector_view x_v, g_v; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); g_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len); g_v = gsl_vector_view_array(Data_bigarray_val(g_barr), len); gsl_vector_memcpy(&x_v.vector, x); callback2(Field(p->closure, 1), x_barr, g_barr); gsl_vector_memcpy(G, &g_v.vector); } void gsl_multimin_callback_fdf(const gsl_vector *x, void *params, double *f, gsl_vector *G) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *p=params; value x_barr, g_barr; int len = x->size; gsl_vector_view x_v, g_v; value res; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); g_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len); g_v = gsl_vector_view_array(Data_bigarray_val(g_barr), len); gsl_vector_memcpy(&x_v.vector, x); res=callback2(Field(p->closure, 2), x_barr, g_barr); gsl_vector_memcpy(G, &g_v.vector); *f=Double_val(res); } /* MULTIFIT CALLBACKS */ int gsl_multifit_callback_f(const gsl_vector *X, void *params, gsl_vector *F) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *parms=params; value x_barr, f_barr; size_t p = X->size; size_t n = F->size; gsl_vector_view x_v, f_v; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, p); f_barr = alloc_bigarray_dims(barr_flags, 1, NULL, n); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), p); f_v = gsl_vector_view_array(Data_bigarray_val(f_barr), n); gsl_vector_memcpy(&x_v.vector, X); callback2(Field(parms->closure, 0), x_barr, f_barr); gsl_vector_memcpy(F, &f_v.vector); return GSL_SUCCESS; } int gsl_multifit_callback_df(const gsl_vector *X, void *params, gsl_matrix *J) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *parms=params; value x_barr, j_barr; size_t p = X->size; size_t n = J->size1; gsl_vector_view x_v; gsl_matrix_view j_v; value res; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, p); j_barr = alloc_bigarray_dims(barr_flags, 2, NULL, n, p); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), p); j_v = gsl_matrix_view_array(Data_bigarray_val(j_barr), n, p); gsl_vector_memcpy(&x_v.vector, X); res=callback2(Field(parms->closure, 1), x_barr, j_barr); if(Is_exception_result(res)) return GSL_FAILURE; gsl_matrix_memcpy(J, &j_v.matrix); return GSL_SUCCESS; } int gsl_multifit_callback_fdf(const gsl_vector *X, void *params, gsl_vector *F, gsl_matrix *J) { int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT; struct callback_params *parms=params; value x_barr, f_barr, j_barr; size_t p = X->size; size_t n = F->size; gsl_vector_view x_v, f_v; gsl_matrix_view j_v; x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, p); f_barr = alloc_bigarray_dims(barr_flags, 1, NULL, n); j_barr = alloc_bigarray_dims(barr_flags, 2, NULL, n, p); x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), p); f_v = gsl_vector_view_array(Data_bigarray_val(f_barr), n); j_v = gsl_matrix_view_array(Data_bigarray_val(j_barr), n, p); gsl_vector_memcpy(&x_v.vector, X); callback3(Field(parms->closure, 2), x_barr, f_barr, j_barr); gsl_vector_memcpy(F, &f_v.vector); gsl_matrix_memcpy(J, &j_v.matrix); return GSL_SUCCESS; } gsl-ocaml-1.19.1/lib/mlgsl_fun.h000066400000000000000000000043521262311274100163710ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include #include struct callback_params { value closure ; /* the closure(s) for the caml callback */ value dbl; /* a preallocated caml float array for monte callbacks */ union { gsl_function gf; gsl_function_fdf gfdf; gsl_monte_function mf; gsl_multiroot_function mrf; gsl_multiroot_function_fdf mrfdf; gsl_multimin_function mmf; gsl_multimin_function_fdf mmfdf; gsl_multifit_function_fdf mffdf; } gslfun ; }; extern double gslfun_callback(double, void *); extern double gslfun_callback_indir(double, void *); extern double gslfun_callback_f(double, void *); extern double gslfun_callback_df(double, void *); extern void gslfun_callback_fdf(double, void *, double *, double*); extern double gsl_monte_callback(double *, size_t , void *); extern double gsl_monte_callback_fast(double *, size_t , void *); extern int gsl_multiroot_callback(const gsl_vector *, void *, gsl_vector *); extern int gsl_multiroot_callback_f(const gsl_vector *, void *, gsl_vector *); extern int gsl_multiroot_callback_df(const gsl_vector *, void *, gsl_matrix *); extern int gsl_multiroot_callback_fdf(const gsl_vector *, void *, gsl_vector *, gsl_matrix *); extern double gsl_multimin_callback(const gsl_vector *, void *); extern double gsl_multimin_callback_f(const gsl_vector *, void *); extern void gsl_multimin_callback_df(const gsl_vector *, void *, gsl_vector *); extern void gsl_multimin_callback_fdf(const gsl_vector *, void *, double *, gsl_vector *); extern int gsl_multifit_callback_f(const gsl_vector *, void *, gsl_vector *); extern int gsl_multifit_callback_df(const gsl_vector *, void *, gsl_matrix *); extern int gsl_multifit_callback_fdf(const gsl_vector *, void *, gsl_vector *, gsl_matrix *); #define GSLFUN_CLOSURE(gf,v) \ gsl_function gf = { \ /*.function =*/ &gslfun_callback_indir, \ /*.params =*/ &v } gsl-ocaml-1.19.1/lib/mlgsl_histo.c000066400000000000000000000103071262311274100167170ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include "wrappers.h" static inline void histo_of_val(gsl_histogram *h, value vh) { h->n = Int_val(Field(vh, 0)); h->range = Double_array_val(Field(vh, 1)); h->bin = Double_array_val(Field(vh, 2)); } CAMLprim value ml_gsl_histogram_set_ranges(value vh, value range) { gsl_histogram h; histo_of_val(&h, vh); gsl_histogram_set_ranges(&h, Double_array_val(range), Double_array_length(range)); return Val_unit; } CAMLprim value ml_gsl_histogram_set_ranges_uniform(value vh, value xmin, value xmax) { gsl_histogram h; histo_of_val(&h, vh); gsl_histogram_set_ranges_uniform(&h, Double_val(xmin), Double_val(xmax)); return Val_unit; } CAMLprim value ml_gsl_histogram_accumulate(value vh, value ow, value x) { gsl_histogram h; double w = Opt_arg(ow, Double_val, 1.); histo_of_val(&h, vh); gsl_histogram_accumulate(&h, Double_val(x), w); return Val_unit; } CAMLprim value ml_gsl_histogram_find(value vh, value x) { gsl_histogram h; size_t i; histo_of_val(&h, vh); gsl_histogram_find(&h, Double_val(x), &i); return Val_int(i); } CAMLprim value ml_gsl_histogram_max_val(value vh) { gsl_histogram h; histo_of_val(&h, vh); return copy_double(gsl_histogram_max_val(&h)); } CAMLprim value ml_gsl_histogram_max_bin(value vh) { gsl_histogram h; histo_of_val(&h, vh); return Val_int(gsl_histogram_max_bin(&h)); } CAMLprim value ml_gsl_histogram_min_val(value vh) { gsl_histogram h; histo_of_val(&h, vh); return copy_double(gsl_histogram_min_val(&h)); } CAMLprim value ml_gsl_histogram_min_bin(value vh) { gsl_histogram h; histo_of_val(&h, vh); return Val_int(gsl_histogram_min_bin(&h)); } CAMLprim value ml_gsl_histogram_mean(value vh) { gsl_histogram h; histo_of_val(&h, vh); return copy_double(gsl_histogram_mean(&h)); } CAMLprim value ml_gsl_histogram_sigma(value vh) { gsl_histogram h; histo_of_val(&h, vh); return copy_double(gsl_histogram_sigma(&h)); } CAMLprim value ml_gsl_histogram_sum(value vh) { gsl_histogram h; histo_of_val(&h, vh); return copy_double(gsl_histogram_sum(&h)); } CAMLprim value ml_gsl_histogram_equal_bins_p(value vh1, value vh2) { gsl_histogram h1, h2; histo_of_val(&h1, vh1); histo_of_val(&h2, vh2); return Val_bool(gsl_histogram_equal_bins_p(&h1, &h2)); } CAMLprim value ml_gsl_histogram_add(value vh1, value vh2) { gsl_histogram h1, h2; histo_of_val(&h1, vh1); histo_of_val(&h2, vh2); gsl_histogram_add(&h1, &h2); return Val_unit; } CAMLprim value ml_gsl_histogram_sub(value vh1, value vh2) { gsl_histogram h1, h2; histo_of_val(&h1, vh1); histo_of_val(&h2, vh2); gsl_histogram_sub(&h1, &h2); return Val_unit; } CAMLprim value ml_gsl_histogram_mul(value vh1, value vh2) { gsl_histogram h1, h2; histo_of_val(&h1, vh1); histo_of_val(&h2, vh2); gsl_histogram_mul(&h1, &h2); return Val_unit; } CAMLprim value ml_gsl_histogram_div(value vh1, value vh2) { gsl_histogram h1, h2; histo_of_val(&h1, vh1); histo_of_val(&h2, vh2); gsl_histogram_div(&h1, &h2); return Val_unit; } CAMLprim value ml_gsl_histogram_scale(value vh, value s) { gsl_histogram h; histo_of_val(&h, vh); gsl_histogram_scale(&h, Double_val(s)); return Val_unit; } CAMLprim value ml_gsl_histogram_shift(value vh, value s) { gsl_histogram h; histo_of_val(&h, vh); gsl_histogram_shift(&h, Double_val(s)); return Val_unit; } static inline void histopdf_of_val(gsl_histogram_pdf *p, value vh) { p->n = Int_val(Field(vh, 0)); p->range = Double_array_val(Field(vh, 1)); p->sum = Double_array_val(Field(vh, 2)); } CAMLprim value ml_gsl_histogram_pdf_init(value vp, value vh) { gsl_histogram_pdf p; gsl_histogram h; histopdf_of_val(&p, vp); histo_of_val(&h, vh); gsl_histogram_pdf_init(&p, &h); return Val_unit; } CAMLprim value ml_gsl_histogram_pdf_sample(value vp, value r) { gsl_histogram_pdf p; histopdf_of_val(&p, vp); return copy_double(gsl_histogram_pdf_sample(&p, r)); } gsl-ocaml-1.19.1/lib/mlgsl_ieee.c000066400000000000000000000056501262311274100165050ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include "wrappers.h" static value rep_val(const gsl_ieee_double_rep *r) { CAMLparam0(); CAMLlocal2(v, m); m=copy_string(r->mantissa); v=alloc_small(4, 0); Field(v, 0)= Val_int(r->sign); Field(v, 1)= m; Field(v, 2)= Val_int(r->exponent); Field(v, 3)= Val_int(r->type - 1); CAMLreturn(v); } CAMLprim value ml_gsl_ieee_double_to_rep(value x) { double d; gsl_ieee_double_rep r; d = Double_val(x); gsl_ieee_double_to_rep(&d, &r); return rep_val(&r); } CAMLprim value ml_gsl_ieee_env_setup(value unit) { gsl_ieee_env_setup(); return Val_unit; } CAMLprim value ml_gsl_ieee_set_mode(value oprecision, value orounding, value ex_list) { static const int precision_conv [] = { GSL_IEEE_SINGLE_PRECISION, GSL_IEEE_DOUBLE_PRECISION, GSL_IEEE_EXTENDED_PRECISION }; static const int round_conv [] = { GSL_IEEE_ROUND_TO_NEAREST, GSL_IEEE_ROUND_DOWN, GSL_IEEE_ROUND_UP, GSL_IEEE_ROUND_TO_ZERO }; static int mask_conv [] = { GSL_IEEE_MASK_INVALID, GSL_IEEE_MASK_DENORMALIZED, GSL_IEEE_MASK_DENORMALIZED, GSL_IEEE_MASK_OVERFLOW, GSL_IEEE_MASK_UNDERFLOW, GSL_IEEE_MASK_ALL, GSL_IEEE_TRAP_INEXACT } ; int mask = convert_flag_list(ex_list, mask_conv); #define Lookup_precision(v) precision_conv[ Int_val(v) ] #define Lookup_round(v) round_conv[ Int_val(v) ] gsl_ieee_set_mode(Opt_arg(oprecision, Lookup_precision, 0), Opt_arg(orounding, Lookup_round, 0), mask); return Val_unit; } #ifdef HAVE_FENV #include static int except_conv [] = { #ifdef FE_INEXACT FE_INEXACT, #else 0, #endif #ifdef FE_DIVBYZERO FE_DIVBYZERO, #else 0, #endif #ifdef FE_UNDERFLOW FE_UNDERFLOW, #else 0, #endif #ifdef FE_OVERFLOW FE_OVERFLOW, #else 0, #endif #ifdef FE_INVALID FE_INVALID, #else 0, #endif #ifdef FE_ALL_EXCEPT FE_ALL_EXCEPT, #else 0, #endif }; static int conv_excepts(value e) { return convert_flag_list(e, except_conv); } static value rev_conv_excepts(int e) { CAMLparam0(); CAMLlocal2(v, c); int i, tab_size = (sizeof except_conv / sizeof (int)) ; v = Val_emptylist; for(i = tab_size-2; i >= 0 ; i--) if(except_conv[i] & e) { c = alloc_small(2, Tag_cons); Field(c, 0) = Val_int(i); Field(c, 1) = v; v = c; } CAMLreturn(v); } CAMLprim value ml_feclearexcept(value e) { feclearexcept(conv_excepts(e)); return Val_unit; } CAMLprim value ml_fetestexcept(value e) { return rev_conv_excepts(fetestexcept(conv_excepts(e))); } #else /* HAVE_FENV */ CAMLprim value ml_feclearexcept(value e) { return Val_unit; } CAMLprim value ml_fetestexcept(value e) { return Val_emptylist; } #endif /* HAVE_FENV */ gsl-ocaml-1.19.1/lib/mlgsl_integration.c000066400000000000000000000236641262311274100201260ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include #include #include "mlgsl_fun.h" #include "wrappers.h" /* QNG integration */ CAMLprim value ml_gsl_integration_qng(value fun, value a, value b, value epsabs, value epsrel) { CAMLparam1(fun); CAMLlocal3(res, r, e); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t neval; gsl_integration_qng(&gf, Double_val(a), Double_val(b), Double_val(epsabs), Double_val(epsrel), &result, &abserr, &neval); r = copy_double(result); e = copy_double(abserr); res = alloc_small(3, 0); Field(res, 0) = r; Field(res, 1) = e; Field(res, 2) = Val_int(neval); CAMLreturn(res); } /* WORKSPACE */ #define GSL_WS(v) (gsl_integration_workspace *)(Field((v), 0)) ML1_alloc(gsl_integration_workspace_alloc, Int_val, Abstract_ptr) ML1(gsl_integration_workspace_free, GSL_WS, Unit) CAMLprim value ml_gsl_integration_ws_size(value ws) { return Val_int((GSL_WS(ws))->size); } /* QAG Integration */ CAMLprim value ml_gsl_integration_qag(value fun, value a, value b, value epsabs, value epsrel, value limit, value key, value ws) { CAMLparam2(fun, ws); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; static const int key_conv [] = { GSL_INTEG_GAUSS15, GSL_INTEG_GAUSS21, GSL_INTEG_GAUSS31, GSL_INTEG_GAUSS41, GSL_INTEG_GAUSS51, GSL_INTEG_GAUSS61 }; int c_key = key_conv [ Int_val(key) ]; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val, gslws->limit); gsl_integration_qag(&gf, Double_val(a), Double_val(b), Double_val(epsabs), Double_val(epsrel), c_limit, c_key, gslws, &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qag_bc(value *args, int nb) { return ml_gsl_integration_qag(args[0], args[1], args[2], args[3], args[4], args[5], args[6], args[7]); } CAMLprim value ml_gsl_integration_qags(value fun, value a, value b, value epsabs, value epsrel, value limit, value ws) { CAMLparam2(fun, ws); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val, gslws->limit); gsl_integration_qags(&gf, Double_val(a), Double_val(b), Double_val(epsabs), Double_val(epsrel), c_limit, gslws, &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qags_bc(value *args, int nb) { return ml_gsl_integration_qags(args[0], args[1], args[2], args[3], args[4], args[5], args[6]); } CAMLprim value ml_gsl_integration_qagp(value fun, value pts, value epsabs, value epsrel, value limit, value ws) { CAMLparam2(fun, ws); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val, gslws->limit); gsl_integration_qagp(&gf, Double_array_val(pts), Double_array_length(pts), Double_val(epsabs), Double_val(epsrel), c_limit, gslws, &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qagp_bc(value *args, int nb) { return ml_gsl_integration_qagp(args[0], args[1], args[2], args[3], args[4], args[5]); } CAMLprim value ml_gsl_integration_qagi(value fun, value epsabs, value epsrel, value limit, value ws) { CAMLparam2(fun, ws); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val,gslws->limit); gsl_integration_qagi(&gf, Double_val(epsabs), Double_val(epsrel), c_limit, gslws, &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qagiu(value fun, value a, value epsabs, value epsrel, value limit, value ws) { CAMLparam2(fun, ws); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val, gslws->limit); gsl_integration_qagiu(&gf, Double_val(a), Double_val(epsabs), Double_val(epsrel), c_limit, gslws, &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qagiu_bc(value *args, int nb) { return ml_gsl_integration_qagiu(args[0], args[1], args[2], args[3], args[4], args[5]); } CAMLprim value ml_gsl_integration_qagil(value fun, value b, value epsabs, value epsrel, value limit, value ws) { CAMLparam2(fun, ws); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val, gslws->limit); gsl_integration_qagil(&gf, Double_val(b), Double_val(epsabs), Double_val(epsrel), c_limit, gslws, &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qagil_bc(value *args, int nb) { return ml_gsl_integration_qagil(args[0], args[1], args[2], args[3], args[4], args[5]); } /* QAWC integration */ CAMLprim value ml_gsl_integration_qawc(value fun, value a, value b, value c, value epsabs, value epsrel, value limit, value ws) { CAMLparam2(fun, ws); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val, gslws->limit); gsl_integration_qawc(&gf, Double_val(a), Double_val(b), Double_val(c), Double_val(epsabs), Double_val(epsrel), c_limit, gslws, &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qawc_bc(value *args, int nb) { return ml_gsl_integration_qawc(args[0], args[1], args[2], args[3], args[4], args[5], args[6], args[7]); } /* QAWS integration */ CAMLprim value ml_gsl_integration_qaws_table_alloc(value alpha, value beta, value mu, value nu) { value res; Abstract_ptr(res, gsl_integration_qaws_table_alloc(Double_val(alpha), Double_val(beta), Int_val(mu), Int_val(nu))); return res; } #define QAWSTABLE_VAL(v) (gsl_integration_qaws_table *)Field((v), 0) ML5(gsl_integration_qaws_table_set, QAWSTABLE_VAL, Double_val, Double_val, Int_val, Int_val, Unit) ML1(gsl_integration_qaws_table_free, QAWSTABLE_VAL, Unit) CAMLprim value ml_gsl_integration_qaws(value fun, value a, value b, value table , value epsabs, value epsrel, value limit, value ws) { CAMLparam3(fun, ws, table); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val, gslws->limit); gsl_integration_qaws(&gf, Double_val(a), Double_val(b), QAWSTABLE_VAL(table), Double_val(epsabs), Double_val(epsrel), c_limit, gslws, &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qaws_bc(value *args, int nb) { return ml_gsl_integration_qaws(args[0], args[1], args[2], args[3], args[4], args[5], args[6], args[7]); } /* QAWO integration */ static inline enum gsl_integration_qawo_enum qawo_of_val(value sine) { static const enum gsl_integration_qawo_enum qawo_sine[] = { GSL_INTEG_COSINE, GSL_INTEG_SINE }; return qawo_sine[Int_val(sine)]; } CAMLprim value ml_gsl_integration_qawo_table_alloc(value omega, value l, value sine, value n) { value res; Abstract_ptr(res, gsl_integration_qawo_table_alloc(Double_val(omega), Double_val(l), qawo_of_val(sine), Int_val(n))); return res; } #define QAWOTABLE_VAL(v) (gsl_integration_qawo_table *)Field((v), 0) ML4(gsl_integration_qawo_table_set, QAWOTABLE_VAL, Double_val, Double_val, qawo_of_val, Unit) ML1(gsl_integration_qawo_table_free, QAWOTABLE_VAL, Unit) CAMLprim value ml_gsl_integration_qawo(value fun, value a, value epsabs, value epsrel, value limit, value ws, value table) { CAMLparam3(fun, ws, table); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val, gslws->limit); gsl_integration_qawo(&gf, Double_val(a), Double_val(epsabs), Double_val(epsrel), c_limit, gslws, QAWOTABLE_VAL(table), &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qawo_bc(value *args, int nb) { return ml_gsl_integration_qawo(args[0], args[1], args[2], args[3], args[4], args[5], args[6]); } CAMLprim value ml_gsl_integration_qawf(value fun, value a, value epsabs, value limit, value ws, value cyclews, value table) { CAMLparam4(fun, ws, cyclews, table); GSLFUN_CLOSURE(gf, fun); double result, abserr; size_t c_limit; gsl_integration_workspace *gslws = GSL_WS(ws); c_limit = Opt_arg(limit, Int_val, gslws->limit); gsl_integration_qawf(&gf, Double_val(a), Double_val(epsabs), c_limit, gslws, GSL_WS(cyclews), QAWOTABLE_VAL(table), &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_integration_qawf_bc(value *args, int nb) { return ml_gsl_integration_qawf(args[0], args[1], args[2], args[3], args[4], args[5], args[6]); } gsl-ocaml-1.19.1/lib/mlgsl_interp.c000066400000000000000000000067471262311274100171070ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include "wrappers.h" static const gsl_interp_type *interp_type_of_val(value t) { const gsl_interp_type* interp_type[] = { gsl_interp_linear, gsl_interp_polynomial, gsl_interp_cspline, gsl_interp_cspline_periodic, gsl_interp_akima, gsl_interp_akima_periodic }; return interp_type[Int_val(t)]; } #define Interp_val(v) ((gsl_interp *)Field((v), 0)) #define InterpAccel_val(v) ((gsl_interp_accel *)Field((v), 0)) CAMLprim value ml_gsl_interp_alloc(value type, value size) { value r; gsl_interp *i=gsl_interp_alloc(interp_type_of_val(type), Int_val(size)); Abstract_ptr(r, i); return r; } CAMLprim value ml_gsl_interp_free(value i) { gsl_interp_free(Interp_val(i)); return Val_unit; } CAMLprim value ml_gsl_interp_init(value i, value x, value y, value size) { gsl_interp_init(Interp_val(i), Double_array_val(x), Double_array_val(y), Int_val(size)); return Val_unit; } CAMLprim value ml_gsl_interp_name(value i) { return copy_string(gsl_interp_name(Interp_val(i))); } CAMLprim value ml_gsl_interp_min_size(value i) { return Val_int(gsl_interp_min_size(Interp_val(i))); } CAMLprim value ml_gsl_interp_accel_alloc(value unit) { value r; Abstract_ptr(r, gsl_interp_accel_alloc()); return r; } CAMLprim value ml_gsl_interp_accel_free(value ia) { gsl_interp_accel_free(InterpAccel_val(ia)); return Val_unit; } CAMLprim value ml_gsl_interp_eval(value i, value xa, value ya, value x, value A) { return copy_double(gsl_interp_eval(Interp_val(i), Double_array_val(xa), Double_array_val(ya), Double_val(x), InterpAccel_val(A))); } CAMLprim value ml_gsl_interp_eval_deriv(value i, value xa, value ya, value x, value A) { return copy_double(gsl_interp_eval_deriv(Interp_val(i), Double_array_val(xa), Double_array_val(ya), Double_val(x), InterpAccel_val(A))); } CAMLprim value ml_gsl_interp_eval_deriv2(value i, value xa, value ya, value x, value A) { return copy_double(gsl_interp_eval_deriv2(Interp_val(i), Double_array_val(xa), Double_array_val(ya), Double_val(x), InterpAccel_val(A))); } CAMLprim value ml_gsl_interp_eval_integ(value i, value xa, value ya, value a, value b, value A) { return copy_double(gsl_interp_eval_integ(Interp_val(i), Double_array_val(xa), Double_array_val(ya), Double_val(a), Double_val(b), InterpAccel_val(A))); } CAMLprim value ml_gsl_interp_eval_integ_bc(value *args, int nb) { return ml_gsl_interp_eval_integ(args[0], args[1], args[2], args[3], args[4], args[5]); } CAMLprim value ml_gsl_interp_eval_array(value i, value xa, value ya) { mlsize_t lx = Double_array_length(xa); mlsize_t ly = Double_array_length(ya); register int j; gsl_interp *c_i = Interp_val(Field(i, 0)); gsl_interp_accel *c_A = InterpAccel_val(Field(i, 1)); double *c_x = Double_array_val(Field(i, 2)); double *c_y = Double_array_val(Field(i, 3)); double *c_xa = Double_array_val(xa) ; double *c_ya = Double_array_val(ya) ; if(lx != ly) GSL_ERROR("array sizes differ", GSL_EBADLEN); for(j=0;j #include "mlgsl_matrix_double.h" #include "mlgsl_vector_double.h" #include "mlgsl_permut.h" /* simple matrix operations */ CAMLprim value ml_gsl_linalg_matmult_mod(value A, value omodA, value B, value omodB, value C) { gsl_linalg_matrix_mod_t modA = Opt_arg(omodA, Int_val, GSL_LINALG_MOD_NONE); gsl_linalg_matrix_mod_t modB = Opt_arg(omodB, Int_val, GSL_LINALG_MOD_NONE); _DECLARE_MATRIX3(A, B, C); _CONVERT_MATRIX3(A, B, C); gsl_linalg_matmult_mod(&m_A, modA, &m_B, modB, &m_C); return Val_unit; } /* LU decomposition */ CAMLprim value ml_gsl_linalg_LU_decomp(value A, value P) { int sign; GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(A); _CONVERT_MATRIX(A); gsl_linalg_LU_decomp(&m_A, &perm_P, &sign); return Val_int(sign); } CAMLprim value ml_gsl_linalg_LU_solve(value LU, value P, value B, value X) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(LU); _DECLARE_VECTOR2(B,X); _CONVERT_MATRIX(LU); _CONVERT_VECTOR2(B,X); gsl_linalg_LU_solve(&m_LU, &perm_P, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_LU_svx(value LU, value P, value X) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(LU); _DECLARE_VECTOR(X); _CONVERT_MATRIX(LU); _CONVERT_VECTOR(X); gsl_linalg_LU_svx(&m_LU, &perm_P, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_LU_refine(value A, value LU, value P, value B, value X, value RES) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX2(A, LU); _DECLARE_VECTOR3(B, X, RES); _CONVERT_MATRIX2(A, LU); _CONVERT_VECTOR3(B, X, RES); gsl_linalg_LU_refine(&m_A, &m_LU, &perm_P, &v_B, &v_X, &v_RES); return Val_unit; } CAMLprim value ml_gsl_linalg_LU_refine_bc(value *argv, int argc) { return ml_gsl_linalg_LU_refine(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_linalg_LU_invert(value LU, value P, value INV) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX2(LU, INV); _CONVERT_MATRIX2(LU, INV); gsl_linalg_LU_invert(&m_LU, &perm_P, &m_INV); return Val_unit; } CAMLprim value ml_gsl_linalg_LU_det(value LU, value sig) { _DECLARE_MATRIX(LU); _CONVERT_MATRIX(LU); return copy_double(gsl_linalg_LU_det(&m_LU, Int_val(sig))); } CAMLprim value ml_gsl_linalg_LU_lndet(value LU) { _DECLARE_MATRIX(LU); _CONVERT_MATRIX(LU); return copy_double(gsl_linalg_LU_lndet(&m_LU)); } CAMLprim value ml_gsl_linalg_LU_sgndet(value LU, value sig) { _DECLARE_MATRIX(LU); _CONVERT_MATRIX(LU); return Val_int(gsl_linalg_LU_sgndet(&m_LU, Int_val(sig))); } /* QR decomposition */ CAMLprim value ml_gsl_linalg_QR_decomp(value A, value TAU) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(TAU); _CONVERT_MATRIX(A); _CONVERT_VECTOR(TAU); gsl_linalg_QR_decomp(&m_A, &v_TAU); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_solve(value QR, value TAU, value B, value X) { _DECLARE_MATRIX(QR); _DECLARE_VECTOR3(B,X,TAU); _CONVERT_MATRIX(QR); _CONVERT_VECTOR3(B,X,TAU); gsl_linalg_QR_solve(&m_QR, &v_TAU, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_svx(value QR, value TAU, value X) { _DECLARE_MATRIX(QR); _DECLARE_VECTOR2(TAU, X); _CONVERT_MATRIX(QR); _CONVERT_VECTOR2(TAU, X); gsl_linalg_QR_svx(&m_QR, &v_TAU, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_lssolve(value QR, value TAU, value B, value X, value RES) { _DECLARE_MATRIX(QR); _DECLARE_VECTOR4(TAU, RES, B, X); _CONVERT_MATRIX(QR); _CONVERT_VECTOR4(TAU, RES, B, X); gsl_linalg_QR_lssolve(&m_QR, &v_TAU, &v_B, &v_X, &v_RES); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_QTvec(value QR, value TAU, value V) { _DECLARE_MATRIX(QR); _DECLARE_VECTOR2(TAU, V); _CONVERT_MATRIX(QR); _CONVERT_VECTOR2(TAU, V); gsl_linalg_QR_QTvec(&m_QR, &v_TAU, &v_V); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_Qvec(value QR, value TAU, value V) { _DECLARE_MATRIX(QR); _DECLARE_VECTOR2(TAU, V); _CONVERT_MATRIX(QR); _CONVERT_VECTOR2(TAU, V); gsl_linalg_QR_Qvec(&m_QR, &v_TAU, &v_V); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_Rsolve(value QR, value B, value X) { _DECLARE_MATRIX(QR); _DECLARE_VECTOR2(B,X); _CONVERT_MATRIX(QR); _CONVERT_VECTOR2(B,X); gsl_linalg_QR_Rsolve(&m_QR, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_Rsvx(value QR, value X) { _DECLARE_MATRIX(QR); _DECLARE_VECTOR(X); _CONVERT_MATRIX(QR); _CONVERT_VECTOR(X); gsl_linalg_QR_Rsvx(&m_QR, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_unpack(value QR, value TAU, value Q, value R) { _DECLARE_MATRIX3(QR, Q, R); _DECLARE_VECTOR(TAU); _CONVERT_MATRIX3(QR, Q, R); _CONVERT_VECTOR(TAU); gsl_linalg_QR_unpack(&m_QR, &v_TAU, &m_Q, &m_R); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_QRsolve(value Q, value R, value B, value X) { _DECLARE_MATRIX2(Q, R); _DECLARE_VECTOR2(B, X); _CONVERT_MATRIX2(Q, R); _CONVERT_VECTOR2(B, X); gsl_linalg_QR_QRsolve(&m_Q, &m_R, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_QR_update(value Q, value R, value W, value V) { _DECLARE_MATRIX2(Q, R); _DECLARE_VECTOR2(W, V); _CONVERT_MATRIX2(Q, R); _CONVERT_VECTOR2(W, V); gsl_linalg_QR_update(&m_Q, &m_R, &v_W, &v_V); return Val_unit; } CAMLprim value ml_gsl_linalg_R_solve(value R, value B, value X) { _DECLARE_MATRIX(R); _DECLARE_VECTOR2(B, X); _CONVERT_MATRIX(R); _CONVERT_VECTOR2(B, X); gsl_linalg_R_solve(&m_R, &v_B, &v_X); return Val_unit; } /* missing ? */ /* value ml_gsl_linalg_R_svx(value R, value X) */ /* { */ /* DECLARE_MATRIX(R); */ /* DECLARE_VECTOR(X); */ /* gsl_linalg_R_svx(&m_R, &v_X); */ /* return Val_unit; */ /* } */ /* QR Decomposition with Column Pivoting */ CAMLprim value ml_gsl_linalg_QRPT_decomp(value A, value TAU, value P, value NORM) { int signum; GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(A); _DECLARE_VECTOR2(TAU, NORM); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(TAU, NORM); gsl_linalg_QRPT_decomp(&m_A, &v_TAU, &perm_P, &signum, &v_NORM); return Val_int(signum); } CAMLprim value ml_gsl_linalg_QRPT_decomp2(value A, value Q, value R, value TAU, value P, value NORM) { int signum; GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX3(A, Q, R); _DECLARE_VECTOR2(TAU, NORM); _CONVERT_MATRIX3(A, Q, R); _CONVERT_VECTOR2(TAU, NORM); gsl_linalg_QRPT_decomp2(&m_A, &m_Q, &m_R, &v_TAU, &perm_P, &signum, &v_NORM); return Val_int(signum); } CAMLprim value ml_gsl_linalg_QRPT_decomp2_bc(value *argv, int argc) { return ml_gsl_linalg_QRPT_decomp2(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_linalg_QRPT_solve(value QR, value TAU, value P, value B, value X) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(QR); _DECLARE_VECTOR3(TAU, B, X); _CONVERT_MATRIX(QR); _CONVERT_VECTOR3(TAU, B, X); gsl_linalg_QRPT_solve(&m_QR, &v_TAU, &perm_P, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_QRPT_svx(value QR, value TAU, value P, value X) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(QR); _DECLARE_VECTOR2(TAU, X); _CONVERT_MATRIX(QR); _CONVERT_VECTOR2(TAU, X); gsl_linalg_QRPT_svx(&m_QR, &v_TAU, &perm_P, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_QRPT_QRsolve(value Q, value R, value P, value B, value X) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX2(Q, R); _DECLARE_VECTOR2(B, X); _CONVERT_MATRIX2(Q, R); _CONVERT_VECTOR2(B, X); gsl_linalg_QRPT_QRsolve(&m_Q, &m_R, &perm_P, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_QRPT_update(value Q, value R, value P, value U, value V) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX2(Q, R); _DECLARE_VECTOR2(U, V); _CONVERT_MATRIX2(Q, R); _CONVERT_VECTOR2(U, V); gsl_linalg_QRPT_update(&m_Q, &m_R, &perm_P, &v_U, &v_V); return Val_unit; } CAMLprim value ml_gsl_linalg_QRPT_Rsolve(value QR, value P, value B, value X) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(QR); _DECLARE_VECTOR2(B, X); _CONVERT_MATRIX(QR); _CONVERT_VECTOR2(B, X); gsl_linalg_QRPT_Rsolve(&m_QR, &perm_P, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_QRPT_Rsvx(value QR, value P, value X) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(QR); _DECLARE_VECTOR(X); _CONVERT_MATRIX(QR); _CONVERT_VECTOR(X); gsl_linalg_QRPT_Rsvx(&m_QR, &perm_P, &v_X); return Val_unit; } /* Singular Value Decomposition */ CAMLprim value ml_gsl_linalg_SV_decomp(value A, value V, value S, value WORK) { _DECLARE_MATRIX2(A, V); _DECLARE_VECTOR2(S, WORK); _CONVERT_MATRIX2(A, V); _CONVERT_VECTOR2(S, WORK); gsl_linalg_SV_decomp(&m_A, &m_V, &v_S, &v_WORK); return Val_unit; } CAMLprim value ml_gsl_linalg_SV_decomp_mod(value A, value X, value V, value S, value WORK) { _DECLARE_MATRIX3(A, V, X); _DECLARE_VECTOR2(S, WORK); _CONVERT_MATRIX3(A, V, X); _CONVERT_VECTOR2(S, WORK); gsl_linalg_SV_decomp_mod(&m_A, &m_X, &m_V, &v_S, &v_WORK); return Val_unit; } CAMLprim value ml_gsl_linalg_SV_decomp_jacobi(value A, value V, value S) { _DECLARE_MATRIX2(A, V); _DECLARE_VECTOR(S); _CONVERT_MATRIX2(A, V); _CONVERT_VECTOR(S); gsl_linalg_SV_decomp_jacobi(&m_A, &m_V, &v_S); return Val_unit; } CAMLprim value ml_gsl_linalg_SV_solve(value U, value V, value S, value B, value X) { _DECLARE_MATRIX2(U, V); _DECLARE_VECTOR3(S, B, X); _CONVERT_MATRIX2(U, V); _CONVERT_VECTOR3(S, B, X); gsl_linalg_SV_solve(&m_U, &m_V, &v_S, &v_B, &v_X); return Val_unit; } /* LQ decomposition */ CAMLprim value ml_gsl_linalg_LQ_decomp(value A, value TAU) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(TAU); _CONVERT_MATRIX(A); _CONVERT_VECTOR(TAU); gsl_linalg_LQ_decomp(&m_A, &v_TAU); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_solve_T(value LQ, value TAU, value B, value X) { _DECLARE_MATRIX(LQ); _DECLARE_VECTOR3(B,X,TAU); _CONVERT_MATRIX(LQ); _CONVERT_VECTOR3(B,X,TAU); gsl_linalg_LQ_solve_T(&m_LQ, &v_TAU, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_svx_T(value LQ, value TAU, value X) { _DECLARE_MATRIX(LQ); _DECLARE_VECTOR2(TAU, X); _CONVERT_MATRIX(LQ); _CONVERT_VECTOR2(TAU, X); gsl_linalg_LQ_svx_T(&m_LQ, &v_TAU, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_lssolve_T(value LQ, value TAU, value B, value X, value RES) { _DECLARE_MATRIX(LQ); _DECLARE_VECTOR4(TAU, RES, B, X); _CONVERT_MATRIX(LQ); _CONVERT_VECTOR4(TAU, RES, B, X); gsl_linalg_LQ_lssolve_T(&m_LQ, &v_TAU, &v_B, &v_X, &v_RES); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_Lsolve_T(value LQ, value B, value X) { _DECLARE_MATRIX(LQ); _DECLARE_VECTOR2(B,X); _CONVERT_MATRIX(LQ); _CONVERT_VECTOR2(B,X); gsl_linalg_LQ_Lsolve_T(&m_LQ, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_Lsvx_T(value LQ, value X) { _DECLARE_MATRIX(LQ); _DECLARE_VECTOR(X); _CONVERT_MATRIX(LQ); _CONVERT_VECTOR(X); gsl_linalg_LQ_Lsvx_T(&m_LQ, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_L_solve_T(value L, value B, value X) { _DECLARE_MATRIX(L); _DECLARE_VECTOR2(B,X); _CONVERT_MATRIX(L); _CONVERT_VECTOR2(B,X); gsl_linalg_L_solve_T(&m_L, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_vecQ(value LQ, value TAU, value V) { _DECLARE_MATRIX(LQ); _DECLARE_VECTOR2(V,TAU); _CONVERT_MATRIX(LQ); _CONVERT_VECTOR2(V,TAU); gsl_linalg_LQ_vecQ(&m_LQ, &v_TAU, &v_V); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_vecQT(value LQ, value TAU, value V) { _DECLARE_MATRIX(LQ); _DECLARE_VECTOR2(V,TAU); _CONVERT_MATRIX(LQ); _CONVERT_VECTOR2(V,TAU); gsl_linalg_LQ_vecQT(&m_LQ, &v_TAU, &v_V); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_unpack(value LQ, value TAU, value Q, value L) { _DECLARE_MATRIX3(LQ,Q,L); _DECLARE_VECTOR(TAU); _CONVERT_MATRIX3(LQ,Q,L); _CONVERT_VECTOR(TAU); gsl_linalg_LQ_unpack(&m_LQ, &v_TAU, &m_Q, &m_L); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_update(value LQ, value R, value V, value W) { _DECLARE_MATRIX2(LQ,R); _DECLARE_VECTOR2(V,W); _CONVERT_MATRIX2(LQ,R); _CONVERT_VECTOR2(V,W); gsl_linalg_LQ_update(&m_LQ, &m_R, &v_V, &v_W); return Val_unit; } CAMLprim value ml_gsl_linalg_LQ_LQsolve(value Q, value L, value B, value X) { _DECLARE_MATRIX2(Q,L); _DECLARE_VECTOR2(B,X); _CONVERT_MATRIX2(Q,L); _CONVERT_VECTOR2(B,X); gsl_linalg_LQ_LQsolve(&m_Q, &m_L, &v_B, &v_X); return Val_unit; } /* P^T L Q decomposition */ CAMLprim value ml_gsl_linalg_PTLQ_decomp (value A, value TAU, value P, value NORM) { int signum; _DECLARE_MATRIX(A); _DECLARE_VECTOR2(TAU,NORM); GSL_PERMUT_OF_BIGARRAY(P); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(TAU,NORM); gsl_linalg_PTLQ_decomp (&m_A, &v_TAU, &perm_P, &signum, &v_NORM); return Val_int (signum); } CAMLprim value ml_gsl_linalg_PTLQ_decomp2 (value A, value Q, value R, value TAU, value P, value NORM) { int signum; _DECLARE_MATRIX3(A,Q,R); _DECLARE_VECTOR2(TAU,NORM); GSL_PERMUT_OF_BIGARRAY(P); _CONVERT_MATRIX3(A,Q,R); _CONVERT_VECTOR2(TAU,NORM); gsl_linalg_PTLQ_decomp2 (&m_A, &m_Q, &m_R, &v_TAU, &perm_P, &signum, &v_NORM); return Val_int (signum); } CAMLprim value ml_gsl_linalg_PTLQ_decomp2_bc (value *argv, int argc) { return ml_gsl_linalg_PTLQ_decomp2 (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_linalg_PTLQ_solve_T (value QR, value TAU, value P, value B, value X) { _DECLARE_MATRIX(QR); _DECLARE_VECTOR3(TAU,B,X); GSL_PERMUT_OF_BIGARRAY(P); _CONVERT_MATRIX(QR); _CONVERT_VECTOR3(TAU,B,X); gsl_linalg_PTLQ_solve_T (&m_QR, &v_TAU, &perm_P, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_PTLQ_svx_T (value QR, value TAU, value P, value X) { _DECLARE_MATRIX(QR); _DECLARE_VECTOR2(TAU,X); GSL_PERMUT_OF_BIGARRAY(P); _CONVERT_MATRIX(QR); _CONVERT_VECTOR2(TAU,X); gsl_linalg_PTLQ_svx_T (&m_QR, &v_TAU, &perm_P, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_PTLQ_LQsolve_T (value Q, value L, value P, value B, value X) { _DECLARE_MATRIX2(Q,L); _DECLARE_VECTOR2(B,X); GSL_PERMUT_OF_BIGARRAY(P); _CONVERT_MATRIX2(Q,L); _CONVERT_VECTOR2(B,X); gsl_linalg_PTLQ_LQsolve_T (&m_Q, &m_L, &perm_P, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_PTLQ_Lsolve_T (value LQ, value P, value B, value X) { _DECLARE_MATRIX(LQ); _DECLARE_VECTOR2(B,X); GSL_PERMUT_OF_BIGARRAY(P); _CONVERT_MATRIX(LQ); _CONVERT_VECTOR2(B,X); gsl_linalg_PTLQ_Lsolve_T (&m_LQ, &perm_P, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_PTLQ_Lsvx_T (value LQ, value P, value X) { _DECLARE_MATRIX(LQ); _DECLARE_VECTOR(X); GSL_PERMUT_OF_BIGARRAY(P); _CONVERT_MATRIX(LQ); _CONVERT_VECTOR(X); gsl_linalg_PTLQ_Lsvx_T (&m_LQ, &perm_P, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_PTLQ_update (value Q, value L, value P, value V, value W) { _DECLARE_MATRIX2(Q,L); _DECLARE_VECTOR2(V,W); GSL_PERMUT_OF_BIGARRAY(P); _CONVERT_MATRIX2(Q,L); _CONVERT_VECTOR2(V,W); gsl_linalg_PTLQ_update (&m_Q, &m_L, &perm_P, &v_V, &v_W); return Val_unit; } /* Cholesky decomposition */ CAMLprim value ml_gsl_linalg_cholesky_decomp(value A) { _DECLARE_MATRIX(A); _CONVERT_MATRIX(A); gsl_linalg_cholesky_decomp(&m_A); return Val_unit; } CAMLprim value ml_gsl_linalg_cholesky_solve(value CHO, value B, value X) { _DECLARE_MATRIX(CHO); _DECLARE_VECTOR2(B, X); _CONVERT_MATRIX(CHO); _CONVERT_VECTOR2(B, X); gsl_linalg_cholesky_solve(&m_CHO, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_cholesky_svx(value CHO, value X) { _DECLARE_MATRIX(CHO); _DECLARE_VECTOR(X); _CONVERT_MATRIX(CHO); _CONVERT_VECTOR(X); gsl_linalg_cholesky_svx(&m_CHO, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_cholesky_decomp_unit(value CHO, value D) { _DECLARE_MATRIX(CHO); _DECLARE_VECTOR(D); _CONVERT_MATRIX(CHO); _CONVERT_VECTOR(D); gsl_linalg_cholesky_decomp_unit(&m_CHO, &v_D); return Val_unit; } /* Tridiagonal Decomposition of Real Symmetric Matrices */ CAMLprim value ml_gsl_linalg_symmtd_decomp(value A, value TAU) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(TAU); _CONVERT_MATRIX(A); _CONVERT_VECTOR(TAU); gsl_linalg_symmtd_decomp(&m_A, &v_TAU); return Val_unit; } CAMLprim value ml_gsl_linalg_symmtd_unpack(value A, value TAU, value Q, value DIAG, value SUBDIAG) { _DECLARE_MATRIX2(A, Q); _DECLARE_VECTOR3(TAU, DIAG, SUBDIAG); _CONVERT_MATRIX2(A, Q); _CONVERT_VECTOR3(TAU, DIAG, SUBDIAG); gsl_linalg_symmtd_unpack(&m_A, &v_TAU, &m_Q, &v_DIAG, &v_SUBDIAG); return Val_unit; } CAMLprim value ml_gsl_linalg_symmtd_unpack_T(value A, value DIAG, value SUBDIAG) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(DIAG, SUBDIAG); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(DIAG, SUBDIAG); gsl_linalg_symmtd_unpack_T(&m_A, &v_DIAG, &v_SUBDIAG); return Val_unit; } /* Tridiagonal Decomposition of Hermitian Matrices */ /* Bidiagonalization */ CAMLprim value ml_gsl_linalg_bidiag_decomp(value A, value TAU_U, value TAU_V) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(TAU_U, TAU_V); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(TAU_U, TAU_V); gsl_linalg_bidiag_decomp(&m_A, &v_TAU_U, &v_TAU_V); return Val_unit; } CAMLprim value ml_gsl_linalg_bidiag_unpack(value A, value TAU_U, value U, value TAU_V, value V, value DIAG, value SUPERDIAG) { _DECLARE_MATRIX3(A, U, V); _DECLARE_VECTOR4(TAU_U, TAU_V, DIAG, SUPERDIAG); _CONVERT_MATRIX3(A, U, V); _CONVERT_VECTOR4(TAU_U, TAU_V, DIAG, SUPERDIAG); gsl_linalg_bidiag_unpack(&m_A, &v_TAU_U, &m_U, &v_TAU_V, &m_V, &v_DIAG, &v_SUPERDIAG); return Val_unit; } CAMLprim value ml_gsl_linalg_bidiag_unpack_bc(value *argv, int argc) { return ml_gsl_linalg_bidiag_unpack(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); } CAMLprim value ml_gsl_linalg_bidiag_unpack2(value A, value TAU_U, value TAU_V, value V) { _DECLARE_MATRIX2(A, V); _DECLARE_VECTOR2(TAU_U, TAU_V); _CONVERT_MATRIX2(A, V); _CONVERT_VECTOR2(TAU_U, TAU_V); gsl_linalg_bidiag_unpack2(&m_A, &v_TAU_U, &v_TAU_V, &m_V); return Val_unit; } CAMLprim value ml_gsl_linalg_bidiag_unpack_B(value A, value DIAG, value SUPERDIAG) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(DIAG, SUPERDIAG); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(DIAG, SUPERDIAG); gsl_linalg_bidiag_unpack_B(&m_A, &v_DIAG, &v_SUPERDIAG); return Val_unit; } /* Householder solver */ CAMLprim value ml_gsl_linalg_HH_solve(value A, value B, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR2(B,X); _CONVERT_MATRIX(A); _CONVERT_VECTOR2(B,X); gsl_linalg_HH_solve(&m_A, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_HH_svx(value A, value X) { _DECLARE_MATRIX(A); _DECLARE_VECTOR(X); _CONVERT_MATRIX(A); _CONVERT_VECTOR(X); gsl_linalg_HH_svx(&m_A, &v_X); return Val_unit; } /* Tridiagonal Systems */ CAMLprim value ml_gsl_linalg_solve_symm_tridiag(value DIAG, value E, value B, value X) { _DECLARE_VECTOR4(DIAG, E, B, X); _CONVERT_VECTOR4(DIAG, E, B, X); gsl_linalg_solve_symm_tridiag(&v_DIAG, &v_E, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_solve_tridiag(value DIAG, value ABOVE, value BELOW, value B, value X) { _DECLARE_VECTOR5(DIAG, ABOVE, BELOW, B, X); _CONVERT_VECTOR5(DIAG, ABOVE, BELOW, B, X); gsl_linalg_solve_tridiag(&v_DIAG, &v_ABOVE, &v_BELOW, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_solve_symm_cyc_tridiag(value DIAG, value E, value B, value X) { _DECLARE_VECTOR4(DIAG, E, B, X); _CONVERT_VECTOR4(DIAG, E, B, X); gsl_linalg_solve_symm_cyc_tridiag(&v_DIAG, &v_E, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_solve_cyc_tridiag(value DIAG, value ABOVE, value BELOW, value B, value X) { _DECLARE_VECTOR5(DIAG, ABOVE, BELOW, B, X); _CONVERT_VECTOR5(DIAG, ABOVE, BELOW, B, X); gsl_linalg_solve_cyc_tridiag(&v_DIAG, &v_ABOVE, &v_BELOW, &v_B, &v_X); return Val_unit; } /* exponential */ #define GSL_MODE_val Int_val CAMLprim value ml_gsl_linalg_exponential_ss(value A, value eA, value mode) { _DECLARE_MATRIX2(A, eA); _CONVERT_MATRIX2(A, eA); gsl_linalg_exponential_ss(&m_A, &m_eA, GSL_MODE_val(mode)); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_linalg_complex.c000066400000000000000000000073421262311274100205730ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include "mlgsl_matrix_complex.h" #include "mlgsl_vector_complex.h" #include "mlgsl_permut.h" #include "mlgsl_complex.h" /* Complex LU decomposition */ CAMLprim value ml_gsl_linalg_complex_LU_decomp(value A, value P) { int sign; GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(A); _CONVERT_MATRIX(A); gsl_linalg_complex_LU_decomp(&m_A, &perm_P, &sign); return Val_int(sign); } CAMLprim value ml_gsl_linalg_complex_LU_solve(value LU, value P, value B, value X) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(LU); _DECLARE_VECTOR2(B,X); _CONVERT_MATRIX(LU); _CONVERT_VECTOR2(B,X); gsl_linalg_complex_LU_solve(&m_LU, &perm_P, &v_B, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_complex_LU_svx(value LU, value P, value X) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX(LU); _DECLARE_VECTOR(X); _CONVERT_MATRIX(LU); _CONVERT_VECTOR(X); gsl_linalg_complex_LU_svx(&m_LU, &perm_P, &v_X); return Val_unit; } CAMLprim value ml_gsl_linalg_complex_LU_refine(value A, value LU, value P, value B, value X, value RES) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX2(A, LU); _DECLARE_VECTOR3(B, X, RES); _CONVERT_MATRIX2(A, LU); _CONVERT_VECTOR3(B, X, RES); gsl_linalg_complex_LU_refine(&m_A, &m_LU, &perm_P, &v_B, &v_X, &v_RES); return Val_unit; } CAMLprim value ml_gsl_linalg_complex_LU_refine_bc(value *argv, int argc) { return ml_gsl_linalg_complex_LU_refine(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_linalg_complex_LU_invert(value LU, value P, value INV) { GSL_PERMUT_OF_BIGARRAY(P); _DECLARE_MATRIX2(LU, INV); _CONVERT_MATRIX2(LU, INV); gsl_linalg_complex_LU_invert(&m_LU, &perm_P, &m_INV); return Val_unit; } CAMLprim value ml_gsl_linalg_complex_LU_det(value LU, value sig) { gsl_complex z; _DECLARE_MATRIX(LU); _CONVERT_MATRIX(LU); z = gsl_linalg_complex_LU_det(&m_LU, Int_val(sig)); return copy_complex(&z); } CAMLprim value ml_gsl_linalg_complex_LU_lndet(value LU) { _DECLARE_MATRIX(LU); _CONVERT_MATRIX(LU); return copy_double(gsl_linalg_complex_LU_lndet(&m_LU)); } CAMLprim value ml_gsl_linalg_complex_LU_sgndet(value LU, value sig) { gsl_complex z; _DECLARE_MATRIX(LU); _CONVERT_MATRIX(LU); z = gsl_linalg_complex_LU_sgndet(&m_LU, Int_val(sig)) ; return copy_complex(&z); } /* Hermitian to symmetric tridiagonal decomposition */ /* Those are tricky 'coz they mix real & complex matrices ... */ #undef BASE_TYPE #undef TYPE #undef _DECLARE_BASE_TYPE #undef _CONVERT_BASE_TYPE #undef DECLARE_BASE_TYPE #undef FUNCTION #include "mlgsl_matrix_double.h" #include "mlgsl_vector_double.h" CAMLprim value ml_gsl_linalg_hermtd_decomp (value A, value tau) { _DECLARE_COMPLEX_MATRIX(A); _DECLARE_COMPLEX_VECTOR(tau); _CONVERT_COMPLEX_MATRIX(A); _CONVERT_COMPLEX_VECTOR(tau); gsl_linalg_hermtd_decomp(&m_A, &v_tau); return Val_unit; } CAMLprim value ml_gsl_linalg_hermtd_unpack (value A, value tau, value Q, value diag, value subdiag) { _DECLARE_COMPLEX_VECTOR(tau); _DECLARE_VECTOR2(diag,subdiag); _DECLARE_COMPLEX_MATRIX2(A,Q); _CONVERT_COMPLEX_VECTOR(tau); _CONVERT_VECTOR2(diag,subdiag); _CONVERT_COMPLEX_MATRIX2(A,Q); gsl_linalg_hermtd_unpack(&m_A, &v_tau, &m_Q, &v_diag, &v_subdiag); return Val_unit; } CAMLprim value ml_gsl_linalg_hermtd_unpack_T (value A, value diag, value subdiag) { _DECLARE_COMPLEX_MATRIX(A); _DECLARE_VECTOR2(diag,subdiag); _CONVERT_COMPLEX_MATRIX(A); _CONVERT_VECTOR2(diag,subdiag); gsl_linalg_hermtd_unpack_T(&m_A, &v_diag, &v_subdiag); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_math.c000066400000000000000000000011021262311274100165130ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include "wrappers.h" ML1(gsl_log1p, Double_val, copy_double) ML1(gsl_expm1, Double_val, copy_double) ML2(gsl_hypot, Double_val, Double_val, copy_double) ML1(gsl_acosh, Double_val, copy_double) ML1(gsl_asinh, Double_val, copy_double) ML1(gsl_atanh, Double_val, copy_double) ML3(gsl_fcmp, Double_val, Double_val, Double_val, Val_int) gsl-ocaml-1.19.1/lib/mlgsl_matrix.c000066400000000000000000000057221262311274100171020ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #ifndef FUNCTION #error pb with include files #endif CAMLprim value FUNCTION(ml_gsl_matrix,memcpy)(value A, value B) { _DECLARE_MATRIX2(A,B); _CONVERT_MATRIX2(A,B); FUNCTION(gsl_matrix,memcpy)(&m_B, &m_A); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,add)(value A, value B) { _DECLARE_MATRIX2(A,B); _CONVERT_MATRIX2(A,B); FUNCTION(gsl_matrix,add)(&m_A, &m_B); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,sub)(value A, value B) { _DECLARE_MATRIX2(A,B); _CONVERT_MATRIX2(A,B); FUNCTION(gsl_matrix,sub)(&m_A, &m_B); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,mul)(value A, value B) { _DECLARE_MATRIX2(A,B); _CONVERT_MATRIX2(A,B); FUNCTION(gsl_matrix,mul_elements)(&m_A, &m_B); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,div)(value A, value B) { _DECLARE_MATRIX2(A,B); _CONVERT_MATRIX2(A,B); FUNCTION(gsl_matrix,div_elements)(&m_A, &m_B); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,scale)(value A, value X) { _DECLARE_MATRIX(A); _DECLARE_BASE_TYPE(X); _CONVERT_MATRIX(A); _CONVERT_BASE_TYPE(X); FUNCTION(gsl_matrix,scale)(&m_A, conv_X); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,add_constant)(value A, value X) { _DECLARE_MATRIX(A); _DECLARE_BASE_TYPE(X); _CONVERT_MATRIX(A); _CONVERT_BASE_TYPE(X); FUNCTION(gsl_matrix,add_constant)(&m_A, conv_X); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,add_diagonal)(value A, value X) { _DECLARE_MATRIX(A); _DECLARE_BASE_TYPE(X); _CONVERT_MATRIX(A); _CONVERT_BASE_TYPE(X); FUNCTION(gsl_matrix,add_diagonal)(&m_A, conv_X); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,isnull)(value A) { int r; _DECLARE_MATRIX(A); _CONVERT_MATRIX(A); r = FUNCTION(gsl_matrix,isnull)(&m_A); return Val_bool(r); } CAMLprim value FUNCTION(ml_gsl_matrix,swap_rows)(value A, value i, value j) { _DECLARE_MATRIX(A); _CONVERT_MATRIX(A); FUNCTION(gsl_matrix,swap_rows)(&m_A, Int_val(i), Int_val(j)); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,swap_columns)(value A, value i, value j) { _DECLARE_MATRIX(A); _CONVERT_MATRIX(A); FUNCTION(gsl_matrix,swap_columns)(&m_A, Int_val(i), Int_val(j)); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,swap_rowcol)(value A, value i, value j) { _DECLARE_MATRIX(A); _CONVERT_MATRIX(A); FUNCTION(gsl_matrix,swap_rowcol)(&m_A, Int_val(i), Int_val(j)); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,transpose_memcpy)(value A, value B) { _DECLARE_MATRIX2(A, B); _CONVERT_MATRIX2(A, B); FUNCTION(gsl_matrix,transpose_memcpy)(&m_A, &m_B); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_matrix,transpose)(value A) { _DECLARE_MATRIX(A); _CONVERT_MATRIX(A); FUNCTION(gsl_matrix,transpose)(&m_A); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_matrix.h000066400000000000000000000034721262311274100171070ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include "wrappers.h" #ifndef TYPE #error pb with include files #endif static inline void TYPE(mlgsl_mat_of_bigarray)(TYPE(gsl_matrix) *cmat, value vmat){ struct caml_bigarray *bigarr = Bigarray_val(vmat); cmat->block = NULL; cmat->owner = 0; cmat->size1 = bigarr->dim[0]; cmat->size2 = bigarr->dim[1]; cmat->tda = bigarr->dim[1]; cmat->data = bigarr->data; } #ifdef CONV_FLAT static inline void TYPE(mlgsl_mat_of_floatarray)(TYPE(gsl_matrix) *cmat, value vmat){ cmat->block = NULL; cmat->owner = 0; cmat->size1 = Int_val(Field(vmat, 2)); cmat->size2 = Int_val(Field(vmat, 3)); cmat->tda = Int_val(Field(vmat, 4)); cmat->data = (double *) Field(vmat, 0) + Int_val(Field(vmat, 1)); } #endif static inline void TYPE(mlgsl_mat_of_value)(TYPE(gsl_matrix) *cmat, value vmat){ if(Tag_val(vmat) == 0 && Wosize_val(vmat) == 2) /* value is a polymorphic variant */ vmat = Field(vmat, 1); if(Tag_val(vmat) == Custom_tag) /* value is a bigarray */ TYPE(mlgsl_mat_of_bigarray)(cmat, vmat); #ifdef CONV_FLAT else /* value is a record wrapping a float array */ TYPE(mlgsl_mat_of_floatarray)(cmat, vmat); #endif } #define _DECLARE_MATRIX(a) TYPE(gsl_matrix) m_##a #define _DECLARE_MATRIX2(a,b) _DECLARE_MATRIX(a); _DECLARE_MATRIX(b) #define _DECLARE_MATRIX3(a,b,c) _DECLARE_MATRIX2(a,b); _DECLARE_MATRIX(c) #define _CONVERT_MATRIX(a) TYPE(mlgsl_mat_of_value)(&m_##a, a) #define _CONVERT_MATRIX2(a,b) _CONVERT_MATRIX(a); _CONVERT_MATRIX(b) #define _CONVERT_MATRIX3(a,b,c) _CONVERT_MATRIX2(a,b); _CONVERT_MATRIX(c) gsl-ocaml-1.19.1/lib/mlgsl_matrix_complex.c000066400000000000000000000000761262311274100206260ustar00rootroot00000000000000 #include "mlgsl_matrix_complex.h" #include "mlgsl_matrix.c" gsl-ocaml-1.19.1/lib/mlgsl_matrix_complex.h000066400000000000000000000012061262311274100206270ustar00rootroot00000000000000 #include "wrappers.h" #define BASE_TYPE complex #define CONV_FLAT #define TYPE(t) CONCAT2(t,BASE_TYPE) #define _DECLARE_BASE_TYPE(v) gsl_complex conv_##v #define _CONVERT_BASE_TYPE(v) GSL_SET_COMPLEX(&conv_##v,Double_field(v, 0), Double_field(v,1)) #define FUNCTION(a,b) CONCAT3(a,BASE_TYPE,b) #include "mlgsl_matrix.h" #define _DECLARE_COMPLEX_MATRIX(a) gsl_matrix_complex m_##a #define _DECLARE_COMPLEX_MATRIX2(a,b) _DECLARE_COMPLEX_MATRIX(a); _DECLARE_COMPLEX_MATRIX(b) #define _CONVERT_COMPLEX_MATRIX(a) mlgsl_mat_of_value_complex(&m_##a, a) #define _CONVERT_COMPLEX_MATRIX2(a,b) _CONVERT_COMPLEX_MATRIX(a); _CONVERT_COMPLEX_MATRIX(b) gsl-ocaml-1.19.1/lib/mlgsl_matrix_complex_float.c000066400000000000000000000001041262311274100220030ustar00rootroot00000000000000 #include "mlgsl_matrix_complex_float.h" #include "mlgsl_matrix.c" gsl-ocaml-1.19.1/lib/mlgsl_matrix_complex_float.h000066400000000000000000000005201262311274100220120ustar00rootroot00000000000000 #include "wrappers.h" #define BASE_TYPE complex_float #undef CONV_FLAT #define TYPE(t) CONCAT2(t,BASE_TYPE) #define _DECLARE_BASE_TYPE(v) gsl_complex_float conv_##v #define _CONVERT_BASE_TYPE(v) GSL_SET_COMPLEX(&conv_##v,Double_field(v, 0), Double_field(v,1)) #define FUNCTION(a,b) CONCAT3(a,BASE_TYPE,b) #include "mlgsl_matrix.h" gsl-ocaml-1.19.1/lib/mlgsl_matrix_double.c000066400000000000000000000000751262311274100204300ustar00rootroot00000000000000 #include "mlgsl_matrix_double.h" #include "mlgsl_matrix.c" gsl-ocaml-1.19.1/lib/mlgsl_matrix_double.h000066400000000000000000000003421262311274100204320ustar00rootroot00000000000000 #define BASE_TYPE double #define CONV_FLAT #define TYPE(t) t #define _DECLARE_BASE_TYPE(v) double conv_##v #define _CONVERT_BASE_TYPE(v) conv_##v = Double_val(v) #define FUNCTION(a,b) a ## _ ## b #include "mlgsl_matrix.h" gsl-ocaml-1.19.1/lib/mlgsl_matrix_float.c000066400000000000000000000000741262311274100202620ustar00rootroot00000000000000 #include "mlgsl_matrix_float.h" #include "mlgsl_matrix.c" gsl-ocaml-1.19.1/lib/mlgsl_matrix_float.h000066400000000000000000000004251262311274100202670ustar00rootroot00000000000000 #include "wrappers.h" #define BASE_TYPE float #undef CONV_FLAT #define TYPE(t) CONCAT2(t,BASE_TYPE) #define _DECLARE_BASE_TYPE(v) double conv_##v #define _CONVERT_BASE_TYPE(v) conv_##v = Double_val(v) #define FUNCTION(a,b) CONCAT3(a,BASE_TYPE,b) #include "mlgsl_matrix.h" gsl-ocaml-1.19.1/lib/mlgsl_min.c000066400000000000000000000042301262311274100163520ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include "wrappers.h" #include "mlgsl_fun.h" static const gsl_min_fminimizer_type *Minimizertype_val(value mini_type) { const gsl_min_fminimizer_type *minimizer[] = { gsl_min_fminimizer_goldensection, gsl_min_fminimizer_brent }; return minimizer[Int_val(mini_type)]; } CAMLprim value ml_gsl_min_fminimizer_alloc(value t) { CAMLparam0(); CAMLlocal1(res); struct callback_params *params; gsl_min_fminimizer *s; s=gsl_min_fminimizer_alloc(Minimizertype_val(t)); params=stat_alloc(sizeof *params); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)s; Field(res, 1) = (value)params; params->gslfun.gf.function = &gslfun_callback ; params->gslfun.gf.params = params; params->closure = Val_unit; params->dbl = Val_unit; register_global_root(&(params->closure)); CAMLreturn(res); } #define Minimizer_val(v) ((gsl_min_fminimizer *)Field((v), 0)) #define Mparams_val(v) ((struct callback_params *)Field((v), 1)) CAMLprim value ml_gsl_min_fminimizer_set(value s, value f, value min, value lo, value up) { CAMLparam1(s); Mparams_val(s)->closure = f; gsl_min_fminimizer_set(Minimizer_val(s), &(Mparams_val(s)->gslfun.gf), Double_val(min), Double_val(lo), Double_val(up)); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_min_fminimizer_free(value s) { remove_global_root(&(Mparams_val(s)->closure)); stat_free(Mparams_val(s)); gsl_min_fminimizer_free(Minimizer_val(s)); return Val_unit; } ML1(gsl_min_fminimizer_name, Minimizer_val, copy_string) ML1(gsl_min_fminimizer_iterate, Minimizer_val, Unit) ML1(gsl_min_fminimizer_x_minimum, Minimizer_val, copy_double) CAMLprim value ml_gsl_min_fminimizer_x_interv(value S) { return copy_two_double(gsl_min_fminimizer_x_lower(Minimizer_val(S)), gsl_min_fminimizer_x_upper(Minimizer_val(S))); } ML4(gsl_min_test_interval, Double_val, Double_val, Double_val, Double_val, Val_negbool) gsl-ocaml-1.19.1/lib/mlgsl_monte.c000066400000000000000000000235641262311274100167240ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #ifdef WIN32 #include #include #else #include #endif #include #include #include #include #include #include #include #include #include #include "wrappers.h" #include "mlgsl_fun.h" #include "mlgsl_rng.h" #include #include "io.h" #define CallbackParams_val(v) ((struct callback_params *)Field((v), 1)) /* PLAIN algorithm */ #define GSLPLAINSTATE_VAL(v) ((gsl_monte_plain_state *)Field((v), 0)) CAMLprim value ml_gsl_monte_plain_alloc(value d) { gsl_monte_plain_state *s; struct callback_params *params; int dim=Int_val(d); s=gsl_monte_plain_alloc(dim); params=stat_alloc(sizeof(*params)); { CAMLparam0(); CAMLlocal1(res); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)s; Field(res, 1) = (value)params; params->gslfun.mf.f = &gsl_monte_callback; params->gslfun.mf.dim = dim; params->gslfun.mf.params = params; params->closure = Val_unit; params->dbl = alloc(dim * Double_wosize, Double_array_tag); register_global_root(&(params->closure)); register_global_root(&(params->dbl)); CAMLreturn(res); } } ML1(gsl_monte_plain_init, GSLPLAINSTATE_VAL, Unit) CAMLprim value ml_gsl_monte_plain_free(value s) { remove_global_root(&(CallbackParams_val(s)->closure)); remove_global_root(&(CallbackParams_val(s)->dbl)); stat_free(CallbackParams_val(s)); gsl_monte_plain_free(GSLPLAINSTATE_VAL(s)); return Val_unit; } CAMLprim value ml_gsl_monte_plain_integrate(value fun, value xlo, value xup, value calls, value rng, value state) { CAMLparam2(rng, state); double result, abserr; size_t dim=Double_array_length(xlo); LOCALARRAY(double, c_xlo, dim); LOCALARRAY(double, c_xup, dim); struct callback_params *params=CallbackParams_val(state); if(params->gslfun.mf.dim != dim) GSL_ERROR("wrong number of dimensions for function", GSL_EBADLEN); if(Double_array_length(xup) != dim) GSL_ERROR("array sizes differ", GSL_EBADLEN); params->closure = fun; memcpy(c_xlo, Double_array_val(xlo), dim*sizeof(double)); memcpy(c_xup, Double_array_val(xup), dim*sizeof(double)); gsl_monte_plain_integrate(¶ms->gslfun.mf, c_xlo, c_xup, dim, Int_val(calls), Rng_val(rng), GSLPLAINSTATE_VAL(state), &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_monte_plain_integrate_bc(value *argv, int argc) { return ml_gsl_monte_plain_integrate(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } /* MISER algorithm */ #define GSLMISERSTATE_VAL(v) ((gsl_monte_miser_state *)Field((v), 0)) CAMLprim value ml_gsl_monte_miser_alloc(value d) { gsl_monte_miser_state *s; struct callback_params *params; int dim=Int_val(d); s=gsl_monte_miser_alloc(dim); params=stat_alloc(sizeof(*params)); { CAMLparam0(); CAMLlocal1(res); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)s; Field(res, 1) = (value)params; params->gslfun.mf.f = &gsl_monte_callback; params->gslfun.mf.dim = dim; params->gslfun.mf.params = params; params->closure = Val_unit; params->dbl = alloc(dim * Double_wosize, Double_array_tag); register_global_root(&(params->closure)); register_global_root(&(params->dbl)); CAMLreturn(res); } } ML1(gsl_monte_miser_init, GSLMISERSTATE_VAL, Unit) CAMLprim value ml_gsl_monte_miser_free(value s) { remove_global_root(&(CallbackParams_val(s)->closure)); remove_global_root(&(CallbackParams_val(s)->dbl)); stat_free(CallbackParams_val(s)); gsl_monte_miser_free(GSLMISERSTATE_VAL(s)); return Val_unit; } CAMLprim value ml_gsl_monte_miser_integrate(value fun, value xlo, value xup, value calls, value rng, value state) { CAMLparam2(rng, state); double result,abserr; size_t dim=Double_array_length(xlo); LOCALARRAY(double, c_xlo, dim); LOCALARRAY(double, c_xup, dim); struct callback_params *params=CallbackParams_val(state); if(params->gslfun.mf.dim != dim) GSL_ERROR("wrong number of dimensions for function", GSL_EBADLEN); if(Double_array_length(xup) != dim) GSL_ERROR("array sizes differ", GSL_EBADLEN); params->closure=fun; memcpy(c_xlo, Double_array_val(xlo), dim*sizeof(double)); memcpy(c_xup, Double_array_val(xup), dim*sizeof(double)); gsl_monte_miser_integrate(¶ms->gslfun.mf, c_xlo, c_xup, dim, Int_val(calls), Rng_val(rng), GSLMISERSTATE_VAL(state), &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_monte_miser_integrate_bc(value *argv, int argc) { return ml_gsl_monte_miser_integrate(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_monte_miser_get_params(value state) { CAMLparam0(); CAMLlocal1(r); gsl_monte_miser_state *s = GSLMISERSTATE_VAL(state); r=alloc_tuple(5); Store_field(r, 0, copy_double(s->estimate_frac)); Store_field(r, 1, Val_int(s->min_calls)); Store_field(r, 2, Val_int(s->min_calls_per_bisection)); Store_field(r, 3, copy_double(s->alpha)); Store_field(r, 4, copy_double(s->dither)); CAMLreturn(r); } CAMLprim value ml_gsl_monte_miser_set_params(value state, value params) { gsl_monte_miser_state *s = GSLMISERSTATE_VAL(state); s->estimate_frac = Double_val(Field(params, 0)); s->min_calls = Int_val(Field(params, 1)); s->min_calls_per_bisection = Int_val(Field(params, 2)); s->alpha = Double_val(Field(params, 3)); s->dither = Double_val(Field(params, 4)); return Val_unit; } /* VEGAS algorithm */ #define GSLVEGASSTATE_VAL(v) ((gsl_monte_vegas_state *)Field((v), 0)) #define GSLVEGASSTREAM_VAL(v) Field((v), 2) CAMLprim value ml_gsl_monte_vegas_alloc(value d) { gsl_monte_vegas_state *s; struct callback_params *params; int dim=Int_val(d); s=gsl_monte_vegas_alloc(dim); params=stat_alloc(sizeof(*params)); { CAMLparam0(); CAMLlocal1(res); res=alloc_small(3, Abstract_tag); Field(res, 0) = (value)s; Field(res, 1) = (value)params; Field(res, 2) = Val_none; params->gslfun.mf.f = &gsl_monte_callback; params->gslfun.mf.dim = dim; params->gslfun.mf.params = params; params->closure = Val_unit; params->dbl = alloc(dim * Double_wosize, Double_array_tag); register_global_root(&(params->closure)); register_global_root(&(params->dbl)); register_global_root(&(Field(res, 2))); CAMLreturn(res); } } ML1(gsl_monte_vegas_init, GSLVEGASSTATE_VAL, Unit) CAMLprim value ml_gsl_monte_vegas_free(value state) { gsl_monte_vegas_state *s=GSLVEGASSTATE_VAL(state); remove_global_root(&(CallbackParams_val(state)->closure)); remove_global_root(&(CallbackParams_val(state)->dbl)); stat_free(CallbackParams_val(state)); if(s->ostream != stdout && s->ostream != stderr) fclose(s->ostream); remove_global_root(&GSLVEGASSTREAM_VAL(state)); gsl_monte_vegas_free(s); return Val_unit; } CAMLprim value ml_gsl_monte_vegas_integrate(value fun, value xlo, value xup, value calls, value rng, value state) { CAMLparam2(rng, state); double result,abserr; size_t dim=Double_array_length(xlo); LOCALARRAY(double, c_xlo, dim); LOCALARRAY(double, c_xup, dim); struct callback_params *params=CallbackParams_val(state); if(params->gslfun.mf.dim != dim) GSL_ERROR("wrong number of dimensions for function", GSL_EBADLEN); if(Double_array_length(xup) != dim) GSL_ERROR("array sizes differ", GSL_EBADLEN); params->closure=fun; memcpy(c_xlo, Double_array_val(xlo), dim*sizeof(double)); memcpy(c_xup, Double_array_val(xup), dim*sizeof(double)); gsl_monte_vegas_integrate(¶ms->gslfun.mf, c_xlo, c_xup, dim, Int_val(calls), Rng_val(rng), GSLVEGASSTATE_VAL(state), &result, &abserr); CAMLreturn(copy_two_double_arr(result, abserr)); } CAMLprim value ml_gsl_monte_vegas_integrate_bc(value *argv, int argc) { return ml_gsl_monte_vegas_integrate(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_monte_vegas_get_info(value state) { value r; gsl_monte_vegas_state *s = GSLVEGASSTATE_VAL(state); r=alloc_small(3 * Double_wosize, Double_array_tag); Store_double_field(r, 0, s->result); Store_double_field(r, 1, s->sigma); Store_double_field(r, 2, s->chisq); return r; } CAMLprim value ml_gsl_monte_vegas_get_params(value state) { CAMLparam0(); CAMLlocal1(r); gsl_monte_vegas_state *s = GSLVEGASSTATE_VAL(state); r=alloc_tuple(6); Store_field(r, 0, copy_double(s->alpha)); Store_field(r, 1, Val_int(s->iterations)); Store_field(r, 2, Val_int(s->stage)); Store_field(r, 3, Val_int(s->mode + 1)); Store_field(r, 4, Val_int(s->verbose)); { value vchan; if(GSLVEGASSTREAM_VAL(state) != Val_none){ vchan=alloc_small(1, 0); Field(vchan, 0)=GSLVEGASSTREAM_VAL(state); } else vchan=Val_none; Store_field(r, 5, vchan); } CAMLreturn(r); } CAMLprim value ml_gsl_monte_vegas_set_params(value state, value params) { gsl_monte_vegas_state *s = GSLVEGASSTATE_VAL(state); s->alpha = Double_val(Field(params, 0)); s->iterations = Int_val(Field(params, 1)); s->stage = Int_val(Field(params, 2)); s->mode = Int_val(Field(params, 3)) - 1; s->verbose = Int_val(Field(params, 4)); { value vchan = Field(params, 5); if(Is_block(vchan)){ struct channel *chan=Channel(Field(vchan, 0)); if(s->ostream != stdout && s->ostream != stderr) fclose(s->ostream); flush(chan); s->ostream = fdopen(dup(chan->fd), "w"); GSLVEGASSTREAM_VAL(state) = vchan; } } return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_multifit.c000066400000000000000000000077141262311274100174360ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include "wrappers.h" #include "mlgsl_fun.h" #include "mlgsl_vector_double.h" #include "mlgsl_matrix_double.h" /* solvers */ static const gsl_multifit_fdfsolver_type *fdfsolver_of_value(value t) { const gsl_multifit_fdfsolver_type *solver_types[] = { gsl_multifit_fdfsolver_lmsder, gsl_multifit_fdfsolver_lmder, } ; return solver_types[Int_val(t)]; } CAMLprim value ml_gsl_multifit_fdfsolver_alloc(value type, value n, value p) { gsl_multifit_fdfsolver *S; struct callback_params *params; value res; S=gsl_multifit_fdfsolver_alloc(fdfsolver_of_value(type), Int_val(n), Int_val(p)); params=stat_alloc(sizeof(*params)); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)S; Field(res, 1) = (value)params; params->gslfun.mffdf.f = &gsl_multifit_callback_f; params->gslfun.mffdf.df = &gsl_multifit_callback_df; params->gslfun.mffdf.fdf = &gsl_multifit_callback_fdf; params->gslfun.mffdf.n = Int_val(n); params->gslfun.mffdf.p = Int_val(p); params->gslfun.mffdf.params = params; params->closure = Val_unit; params->dbl = Val_unit; register_global_root(&(params->closure)); return res; } #define FDFSOLVER_VAL(v) ((gsl_multifit_fdfsolver *)(Field(v, 0))) #define CALLBACKPARAMS_VAL(v) ((struct callback_params *)(Field(v, 1))) CAMLprim value ml_gsl_multifit_fdfsolver_set(value S, value fun, value x) { CAMLparam2(S, x); struct callback_params *p=CALLBACKPARAMS_VAL(S); _DECLARE_VECTOR(x); _CONVERT_VECTOR(x); p->closure = fun; gsl_multifit_fdfsolver_set(FDFSOLVER_VAL(S), &(p->gslfun.mffdf), &v_x); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_multifit_fdfsolver_free(value S) { struct callback_params *p=CALLBACKPARAMS_VAL(S); remove_global_root(&(p->closure)); stat_free(p); gsl_multifit_fdfsolver_free(FDFSOLVER_VAL(S)); return Val_unit; } ML1(gsl_multifit_fdfsolver_name, FDFSOLVER_VAL, copy_string) ML1(gsl_multifit_fdfsolver_iterate, FDFSOLVER_VAL, Unit) CAMLprim value ml_gsl_multifit_fdfsolver_position(value S, value x) { CAMLparam2(S, x); gsl_vector *pos; _DECLARE_VECTOR(x); _CONVERT_VECTOR(x); pos=gsl_multifit_fdfsolver_position(FDFSOLVER_VAL(S)); gsl_vector_memcpy(&v_x, pos); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_multifit_fdfsolver_get_state(value solv, value xo, value fo, value dxo, value unit) { gsl_multifit_fdfsolver *S=FDFSOLVER_VAL(solv); if(Is_block(xo)) { value x=Unoption(xo); _DECLARE_VECTOR(x); _CONVERT_VECTOR(x); gsl_vector_memcpy(&v_x, S->x); } if(Is_block(fo)) { value f=Unoption(fo); _DECLARE_VECTOR(f); _CONVERT_VECTOR(f); gsl_vector_memcpy(&v_f, S->f); } if(Is_block(dxo)) { value dx=Unoption(dxo); _DECLARE_VECTOR(dx); _CONVERT_VECTOR(dx); gsl_vector_memcpy(&v_dx, S->dx); } return Val_unit; } CAMLprim value ml_gsl_multifit_test_delta(value S, value epsabs, value epsrel) { gsl_multifit_fdfsolver *solv=FDFSOLVER_VAL(S); int status = gsl_multifit_test_delta(solv->dx, solv->x, Double_val(epsabs), Double_val(epsrel)); return Val_negbool(status); } CAMLprim value ml_gsl_multifit_test_gradient(value S, value J, value epsabs, value g) { int status; gsl_multifit_fdfsolver *solv=FDFSOLVER_VAL(S); _DECLARE_VECTOR(g); _CONVERT_VECTOR(g); _DECLARE_MATRIX(J); _CONVERT_MATRIX(J); gsl_multifit_gradient(&m_J, solv->f, &v_g); status = gsl_multifit_test_gradient(&v_g, Double_val(epsabs)); return Val_negbool(status); } CAMLprim value ml_gsl_multifit_covar(value J, value epsrel, value covar) { _DECLARE_MATRIX(J); _CONVERT_MATRIX(J); _DECLARE_MATRIX(covar); _CONVERT_MATRIX(covar); gsl_multifit_covar(&m_J, Double_val(epsrel), &m_covar); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_multimin.c000066400000000000000000000137031262311274100174320ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include "wrappers.h" #include "mlgsl_fun.h" #include "mlgsl_vector_double.h" #include "mlgsl_matrix_double.h" /* minimizers */ static const gsl_multimin_fdfminimizer_type *fdfminimizer_of_value(value t) { const gsl_multimin_fdfminimizer_type *minimizer_types[] = { gsl_multimin_fdfminimizer_conjugate_fr, gsl_multimin_fdfminimizer_conjugate_pr, gsl_multimin_fdfminimizer_vector_bfgs, gsl_multimin_fdfminimizer_vector_bfgs2, gsl_multimin_fdfminimizer_steepest_descent, } ; return minimizer_types[Int_val(t)]; } CAMLprim value ml_gsl_multimin_fdfminimizer_alloc(value type, value d) { int dim = Int_val(d); struct callback_params *params; gsl_multimin_fdfminimizer *T; value res; T=gsl_multimin_fdfminimizer_alloc(fdfminimizer_of_value(type), dim); params=stat_alloc(sizeof(*params)); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)T; Field(res, 1) = (value)params; params->gslfun.mmfdf.f = &gsl_multimin_callback_f; params->gslfun.mmfdf.df = &gsl_multimin_callback_df; params->gslfun.mmfdf.fdf = &gsl_multimin_callback_fdf; params->gslfun.mmfdf.n = dim; params->gslfun.mmfdf.params = params; params->closure = Val_unit; params->dbl = Val_unit; register_global_root(&(params->closure)); return res; } #define GSLMULTIMINFDFMINIMIZER_VAL(v) ((gsl_multimin_fdfminimizer *)(Field(v, 0))) #define CALLBACKPARAMS_VAL(v) ((struct callback_params *)(Field(v, 1))) CAMLprim value ml_gsl_multimin_fdfminimizer_set(value S, value fun, value X, value step, value tol) { CAMLparam2(S, X); struct callback_params *p=CALLBACKPARAMS_VAL(S); _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); p->closure = fun; gsl_multimin_fdfminimizer_set(GSLMULTIMINFDFMINIMIZER_VAL(S), &(p->gslfun.mmfdf), &v_X, Double_val(step), Double_val(tol)); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_multimin_fdfminimizer_free(value S) { struct callback_params *p=CALLBACKPARAMS_VAL(S); remove_global_root(&(p->closure)); stat_free(p); gsl_multimin_fdfminimizer_free(GSLMULTIMINFDFMINIMIZER_VAL(S)); return Val_unit; } ML1(gsl_multimin_fdfminimizer_name, GSLMULTIMINFDFMINIMIZER_VAL, copy_string) ML1(gsl_multimin_fdfminimizer_iterate, GSLMULTIMINFDFMINIMIZER_VAL, Unit) ML1(gsl_multimin_fdfminimizer_restart, GSLMULTIMINFDFMINIMIZER_VAL, Unit) CAMLprim value ml_gsl_multimin_fdfminimizer_minimum(value ox, value odx, value og, value T) { gsl_multimin_fdfminimizer *t=GSLMULTIMINFDFMINIMIZER_VAL(T); if(Is_block(ox)) { value x=Unoption(ox); _DECLARE_VECTOR(x); _CONVERT_VECTOR(x); gsl_vector_memcpy(&v_x, gsl_multimin_fdfminimizer_x(t)); } if(Is_block(odx)) { value dx=Unoption(odx); _DECLARE_VECTOR(dx); _CONVERT_VECTOR(dx); gsl_vector_memcpy(&v_dx, gsl_multimin_fdfminimizer_dx(t)); } if(Is_block(og)) { value g=Unoption(og); _DECLARE_VECTOR(g); _CONVERT_VECTOR(g); gsl_vector_memcpy(&v_g, gsl_multimin_fdfminimizer_gradient(t)); } return copy_double(gsl_multimin_fdfminimizer_minimum(t)); } CAMLprim value ml_gsl_multimin_test_gradient(value S, value epsabs) { int status; gsl_vector *g = gsl_multimin_fdfminimizer_gradient(GSLMULTIMINFDFMINIMIZER_VAL(S)); status = gsl_multimin_test_gradient(g, Double_val(epsabs)); return Val_negbool(status); } static const gsl_multimin_fminimizer_type *fminimizer_of_value(value t) { const gsl_multimin_fminimizer_type *minimizer_types[] = { gsl_multimin_fminimizer_nmsimplex, } ; return minimizer_types[Int_val(t)]; } CAMLprim value ml_gsl_multimin_fminimizer_alloc(value type, value d) { size_t dim = Int_val(d); struct callback_params *params; gsl_multimin_fminimizer *T; value res; T=gsl_multimin_fminimizer_alloc(fminimizer_of_value(type), dim); params=stat_alloc(sizeof(*params)); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)T; Field(res, 1) = (value)params; params->gslfun.mmf.f = &gsl_multimin_callback; params->gslfun.mmf.n = dim; params->gslfun.mmf.params = params; params->closure = Val_unit; params->dbl = Val_unit; register_global_root(&(params->closure)); return res; } #define GSLMULTIMINFMINIMIZER_VAL(v) ((gsl_multimin_fminimizer *)(Field(v, 0))) CAMLprim value ml_gsl_multimin_fminimizer_set(value S, value fun, value X, value step_size) { CAMLparam3(S, X, step_size); struct callback_params *p=CALLBACKPARAMS_VAL(S); _DECLARE_VECTOR2(X,step_size); _CONVERT_VECTOR2(X,step_size); p->closure = fun; gsl_multimin_fminimizer_set(GSLMULTIMINFMINIMIZER_VAL(S), &(p->gslfun.mmf), &v_X, &v_step_size); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_multimin_fminimizer_free(value S) { struct callback_params *p=CALLBACKPARAMS_VAL(S); remove_global_root(&(p->closure)); stat_free(p); gsl_multimin_fminimizer_free(GSLMULTIMINFMINIMIZER_VAL(S)); return Val_unit; } ML1(gsl_multimin_fminimizer_name, GSLMULTIMINFMINIMIZER_VAL, copy_string) ML1(gsl_multimin_fminimizer_iterate, GSLMULTIMINFMINIMIZER_VAL, Unit) CAMLprim value ml_gsl_multimin_fminimizer_minimum(value ox, value T) { gsl_multimin_fminimizer *t=GSLMULTIMINFMINIMIZER_VAL(T); if(Is_block(ox)) { value x=Unoption(ox); _DECLARE_VECTOR(x); _CONVERT_VECTOR(x); gsl_vector_memcpy(&v_x, gsl_multimin_fminimizer_x(t)); } return copy_double(gsl_multimin_fminimizer_minimum(t)); } ML1(gsl_multimin_fminimizer_size, GSLMULTIMINFMINIMIZER_VAL, copy_double) CAMLprim value ml_gsl_multimin_test_size(value S, value epsabs) { int status; double size = gsl_multimin_fminimizer_size(GSLMULTIMINFMINIMIZER_VAL(S)); status = gsl_multimin_test_size(size, Double_val(epsabs)); return Val_negbool(status); } gsl-ocaml-1.19.1/lib/mlgsl_multiroots.c000066400000000000000000000165331262311274100200210ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include "wrappers.h" #include "mlgsl_fun.h" #include "mlgsl_vector_double.h" #include "mlgsl_matrix_double.h" /* solvers */ static const gsl_multiroot_fsolver_type *fsolver_of_value(value t) { const gsl_multiroot_fsolver_type *solver_types[] = { gsl_multiroot_fsolver_hybrids, gsl_multiroot_fsolver_hybrid, gsl_multiroot_fsolver_dnewton, gsl_multiroot_fsolver_broyden, } ; return solver_types[Int_val(t)]; } static const gsl_multiroot_fdfsolver_type *fdfsolver_of_value(value t) { const gsl_multiroot_fdfsolver_type *solver_types[] = { gsl_multiroot_fdfsolver_hybridsj, gsl_multiroot_fdfsolver_hybridj, gsl_multiroot_fdfsolver_newton, gsl_multiroot_fdfsolver_gnewton, } ; return solver_types[Int_val(t)]; } #define CALLBACKPARAMS_VAL(v) ((struct callback_params *)(Field(v, 1))) CAMLprim value ml_gsl_multiroot_fsolver_alloc(value type, value d) { int dim = Int_val(d); gsl_multiroot_fsolver *S; struct callback_params *params; value res; S=gsl_multiroot_fsolver_alloc(fsolver_of_value(type), dim); params=stat_alloc(sizeof(*params)); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)S; Field(res, 1) = (value)params; params->gslfun.mrf.f = &gsl_multiroot_callback; params->gslfun.mrf.n = dim ; params->gslfun.mrf.params = params; params->closure = Val_unit; params->dbl = Val_unit; /* not needed actually */ register_global_root(&(params->closure)); return res; } #define GSLMULTIROOTSOLVER_VAL(v) ((gsl_multiroot_fsolver *)(Field(v, 0))) CAMLprim value ml_gsl_multiroot_fdfsolver_alloc(value type, value d) { int dim = Int_val(d); gsl_multiroot_fdfsolver *S; struct callback_params *params; value res; S=gsl_multiroot_fdfsolver_alloc(fdfsolver_of_value(type), dim); params=stat_alloc(sizeof(*params)); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)S; Field(res, 1) = (value)params; params->gslfun.mrfdf.f = &gsl_multiroot_callback_f; params->gslfun.mrfdf.df = &gsl_multiroot_callback_df; params->gslfun.mrfdf.fdf = &gsl_multiroot_callback_fdf; params->gslfun.mrfdf.n = dim ; params->gslfun.mrfdf.params = params; params->closure = Val_unit; params->dbl = Val_unit; /* not needed actually */ register_global_root(&(params->closure)); return res; } #define GSLMULTIROOTFDFSOLVER_VAL(v) ((gsl_multiroot_fdfsolver *)(Field(v, 0))) CAMLprim value ml_gsl_multiroot_fsolver_set(value S, value fun, value X) { CAMLparam2(S, X); struct callback_params *p=CALLBACKPARAMS_VAL(S); _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); p->closure = fun; if(v_X.size != p->gslfun.mrf.n) GSL_ERROR("wrong number of dimensions for function", GSL_EBADLEN); gsl_multiroot_fsolver_set(GSLMULTIROOTSOLVER_VAL(S), &(p->gslfun.mrf), &v_X); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_multiroot_fdfsolver_set(value S, value fun, value X) { CAMLparam2(S,X); struct callback_params *p=CALLBACKPARAMS_VAL(S); _DECLARE_VECTOR(X); _CONVERT_VECTOR(X); p->closure = fun; if(v_X.size != p->gslfun.mrfdf.n) GSL_ERROR("wrong number of dimensions for function", GSL_EBADLEN); gsl_multiroot_fdfsolver_set(GSLMULTIROOTFDFSOLVER_VAL(S), &(p->gslfun.mrfdf), &v_X); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_multiroot_fsolver_free(value S) { struct callback_params *p=CALLBACKPARAMS_VAL(S); remove_global_root(&(p->closure)); stat_free(p); gsl_multiroot_fsolver_free(GSLMULTIROOTSOLVER_VAL(S)); return Val_unit; } CAMLprim value ml_gsl_multiroot_fdfsolver_free(value S) { struct callback_params *p=CALLBACKPARAMS_VAL(S); remove_global_root(&(p->closure)); stat_free(p); gsl_multiroot_fdfsolver_free(GSLMULTIROOTFDFSOLVER_VAL(S)); return Val_unit; } ML1(gsl_multiroot_fsolver_name, GSLMULTIROOTSOLVER_VAL, copy_string) ML1(gsl_multiroot_fdfsolver_name, GSLMULTIROOTFDFSOLVER_VAL, copy_string) ML1(gsl_multiroot_fsolver_iterate, GSLMULTIROOTSOLVER_VAL, Unit) ML1(gsl_multiroot_fdfsolver_iterate, GSLMULTIROOTFDFSOLVER_VAL, Unit) CAMLprim value ml_gsl_multiroot_fsolver_root(value S, value r) { CAMLparam2(S,r); gsl_vector *root; _DECLARE_VECTOR(r); _CONVERT_VECTOR(r); root=gsl_multiroot_fsolver_root(GSLMULTIROOTSOLVER_VAL(S)); gsl_vector_memcpy(&v_r, root); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_multiroot_fdfsolver_root(value S, value r) { CAMLparam2(S,r); gsl_vector *root; _DECLARE_VECTOR(r); _CONVERT_VECTOR(r); root=gsl_multiroot_fdfsolver_root(GSLMULTIROOTFDFSOLVER_VAL(S)); gsl_vector_memcpy(&v_r, root); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_multiroot_fsolver_get_state(value S, value ox, value of, value odx, value unit) { gsl_multiroot_fsolver *s=GSLMULTIROOTSOLVER_VAL(S); if(Is_block(ox)) { value x=Unoption(ox); _DECLARE_VECTOR(x); _CONVERT_VECTOR(x); gsl_vector_memcpy(&v_x, s->x); } if(Is_block(of)) { value f=Unoption(of); _DECLARE_VECTOR(f); _CONVERT_VECTOR(f); gsl_vector_memcpy(&v_f, s->f); } if(Is_block(odx)) { value dx=Unoption(odx); _DECLARE_VECTOR(dx); _CONVERT_VECTOR(dx); gsl_vector_memcpy(&v_dx, s->dx); } return Val_unit; } CAMLprim value ml_gsl_multiroot_fdfsolver_get_state(value S, value ox, value of, value oj, value odx, value unit) { gsl_multiroot_fdfsolver *s=GSLMULTIROOTFDFSOLVER_VAL(S); if(Is_block(ox)) { value x=Unoption(ox); _DECLARE_VECTOR(x); _CONVERT_VECTOR(x); gsl_vector_memcpy(&v_x, s->x); } if(Is_block(of)) { value f=Unoption(of); _DECLARE_VECTOR(f); _CONVERT_VECTOR(f); gsl_vector_memcpy(&v_f, s->f); } if(Is_block(odx)) { value dx=Unoption(odx); _DECLARE_VECTOR(dx); _CONVERT_VECTOR(dx); gsl_vector_memcpy(&v_dx, s->dx); } if(Is_block(oj)) { value j=Unoption(oj); _DECLARE_MATRIX(j); _CONVERT_MATRIX(j); gsl_matrix_memcpy(&m_j, s->J); } return Val_unit; } CAMLprim value ml_gsl_multiroot_fdfsolver_get_state_bc(value *argv, int argc) { return ml_gsl_multiroot_fdfsolver_get_state(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_multiroot_test_delta_f(value S, value epsabs, value epsrel) { int status; status = gsl_multiroot_test_delta(GSLMULTIROOTSOLVER_VAL(S)->dx, GSLMULTIROOTSOLVER_VAL(S)->x, Double_val(epsabs), Double_val(epsrel)); return Val_negbool(status); } CAMLprim value ml_gsl_multiroot_test_delta_fdf(value S, value epsabs, value epsrel) { int status; status = gsl_multiroot_test_delta(GSLMULTIROOTFDFSOLVER_VAL(S)->dx, GSLMULTIROOTFDFSOLVER_VAL(S)->x, Double_val(epsabs), Double_val(epsrel)); return Val_negbool(status); } CAMLprim value ml_gsl_multiroot_test_residual_f(value S, value epsabs) { int status; status = gsl_multiroot_test_residual(GSLMULTIROOTSOLVER_VAL(S)->f, Double_val(epsabs)); return Val_negbool(status); } CAMLprim value ml_gsl_multiroot_test_residual_fdf(value S, value epsabs) { int status; status = gsl_multiroot_test_residual(GSLMULTIROOTFDFSOLVER_VAL(S)->f, Double_val(epsabs)); return Val_negbool(status); } gsl-ocaml-1.19.1/lib/mlgsl_odeiv.c000066400000000000000000000211641262311274100167020ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include #include #include #include "wrappers.h" struct mlgsl_odeiv_params { value closure; value jac_closure; value arr1; value arr2; value mat; size_t dim; }; static int ml_gsl_odeiv_func(double t, const double y[], double dydt[], void *params) { struct mlgsl_odeiv_params *p = params; value vt, res; vt = copy_double(t); memcpy(Double_array_val(p->arr1), y, p->dim * sizeof(double)); res = callback3_exn(p->closure, vt, p->arr1, p->arr2); if(Is_exception_result(res)) return GSL_FAILURE; memcpy(dydt, Double_array_val(p->arr2), p->dim * sizeof(double)); return GSL_SUCCESS; } static int ml_gsl_odeiv_jacobian(double t, const double y[], double *dfdy, double dfdt[], void *params) { struct mlgsl_odeiv_params *p = params; value res, args[4]; args[0] = copy_double(t); memcpy(Double_array_val(p->arr1), y, p->dim * sizeof(double)); args[1] = p->arr1; Data_bigarray_val(p->mat) = dfdy; args[2] = p->mat; args[3] = p->arr2; res = callbackN_exn(p->jac_closure, 4, args); if(Is_exception_result(res)) return GSL_FAILURE; memcpy(dfdt, Double_array_val(p->arr2), p->dim * sizeof(double)); return GSL_SUCCESS; } CAMLprim value ml_gsl_odeiv_alloc_system(value func, value ojac, value dim) { const int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT | BIGARRAY_EXTERNAL; struct mlgsl_odeiv_params *p; gsl_odeiv_system *syst; value res; p=stat_alloc(sizeof (*p)); p->dim = Int_val(dim); p->closure = func; register_global_root(&(p->closure)); p->jac_closure = (ojac == Val_none ? Val_unit : Unoption(ojac)); register_global_root(&(p->jac_closure)); p->arr1 = alloc(Int_val(dim) * Double_wosize, Double_array_tag); register_global_root(&(p->arr1)); p->arr2 = alloc(Int_val(dim) * Double_wosize, Double_array_tag); register_global_root(&(p->arr2)); p->mat = (ojac == Val_none) ? Val_unit : alloc_bigarray_dims(barr_flags, 2, NULL, Int_val(dim), Int_val(dim)); register_global_root(&(p->mat)); syst=stat_alloc(sizeof (*syst)); syst->function = ml_gsl_odeiv_func; syst->jacobian = ml_gsl_odeiv_jacobian; syst->dimension = Int_val(dim); syst->params = p; Abstract_ptr(res, syst); return res; } #define ODEIV_SYSTEM_VAL(v) ((gsl_odeiv_system *)Field((v), 0)) CAMLprim value ml_gsl_odeiv_free_system(value vsyst) { gsl_odeiv_system *syst = ODEIV_SYSTEM_VAL(vsyst); struct mlgsl_odeiv_params *p = syst->params; remove_global_root(&(p->closure)); remove_global_root(&(p->jac_closure)); remove_global_root(&(p->arr1)); remove_global_root(&(p->arr2)); remove_global_root(&(p->mat)); stat_free(p); stat_free(syst); return Val_unit; } CAMLprim value ml_gsl_odeiv_step_alloc(value step_type, value dim) { const gsl_odeiv_step_type *steppers[] = { gsl_odeiv_step_rk2, gsl_odeiv_step_rk4, gsl_odeiv_step_rkf45, gsl_odeiv_step_rkck, gsl_odeiv_step_rk8pd, gsl_odeiv_step_rk2imp, gsl_odeiv_step_rk2simp, gsl_odeiv_step_rk4imp, gsl_odeiv_step_bsimp, gsl_odeiv_step_gear1, gsl_odeiv_step_gear2, }; gsl_odeiv_step *step = gsl_odeiv_step_alloc(steppers[ Int_val(step_type) ], Int_val(dim)); value res; Abstract_ptr(res, step); return res; } #define ODEIV_STEP_VAL(v) ((gsl_odeiv_step *)Field((v), 0)) ML1(gsl_odeiv_step_free, ODEIV_STEP_VAL, Unit) ML1(gsl_odeiv_step_reset, ODEIV_STEP_VAL, Unit) ML1(gsl_odeiv_step_name, ODEIV_STEP_VAL, copy_string) ML1(gsl_odeiv_step_order, ODEIV_STEP_VAL, Val_int) CAMLprim value ml_gsl_odeiv_step_apply(value step, value t, value h, value y, value yerr, value odydt_in, value odydt_out, value syst) { CAMLparam5(step, syst, y, yerr, odydt_out); LOCALARRAY(double, y_copy, Double_array_length(y)); LOCALARRAY(double, yerr_copy, Double_array_length(yerr)); size_t len_dydt_in = odydt_in == Val_none ? 0 : Double_array_length(Unoption(odydt_in)) ; size_t len_dydt_out = odydt_out == Val_none ? 0 : Double_array_length(Unoption(odydt_out)) ; LOCALARRAY(double, dydt_in, len_dydt_in); LOCALARRAY(double, dydt_out, len_dydt_out); int status; if(len_dydt_in) memcpy(dydt_in, Double_array_val(Unoption(odydt_in)), Bosize_val(Unoption(odydt_in))); memcpy(y_copy, Double_array_val(y), Bosize_val(y)); memcpy(yerr_copy, Double_array_val(yerr), Bosize_val(yerr)); status = gsl_odeiv_step_apply(ODEIV_STEP_VAL(step), Double_val(t), Double_val(h), y_copy, yerr_copy, len_dydt_in ? dydt_in : NULL, len_dydt_out ? dydt_out : NULL, ODEIV_SYSTEM_VAL(syst)); /* GSL does not call the error handler for this function */ if (status) GSL_ERROR_VAL ("gsl_odeiv_step_apply", status, Val_unit); memcpy(Double_array_val(y), y_copy, sizeof(y_copy)); memcpy(Double_array_val(yerr), yerr_copy, sizeof(yerr_copy)); if(len_dydt_out) memcpy(Double_array_val(Unoption(odydt_out)), dydt_out, Bosize_val(Unoption(odydt_out))); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_odeiv_step_apply_bc(value argv[], int argc) { return ml_gsl_odeiv_step_apply(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7]); } CAMLprim value ml_gsl_odeiv_control_standard_new(value eps_abs, value eps_rel, value a_y, value a_dydt) { gsl_odeiv_control *c = gsl_odeiv_control_standard_new(Double_val(eps_abs), Double_val(eps_rel), Double_val(a_y), Double_val(a_dydt)); value res; Abstract_ptr(res, c); return res; } CAMLprim value ml_gsl_odeiv_control_y_new(value eps_abs, value eps_rel) { gsl_odeiv_control *c = gsl_odeiv_control_y_new(Double_val(eps_abs), Double_val(eps_rel)); value res; Abstract_ptr(res, c); return res; } CAMLprim value ml_gsl_odeiv_control_yp_new(value eps_abs, value eps_rel) { gsl_odeiv_control *c = gsl_odeiv_control_yp_new(Double_val(eps_abs), Double_val(eps_rel)); value res; Abstract_ptr(res, c); return res; } CAMLprim value ml_gsl_odeiv_control_scaled_new(value eps_abs, value eps_rel, value a_y, value a_dydt, value scale_abs) { gsl_odeiv_control *c = gsl_odeiv_control_scaled_new(Double_val(eps_abs), Double_val(eps_rel), Double_val(a_y), Double_val(a_dydt), Double_array_val(scale_abs), Double_array_length(scale_abs)); value res; Abstract_ptr(res, c); return res; } #define ODEIV_CONTROL_VAL(v) ((gsl_odeiv_control *)Field((v), 0)) ML1(gsl_odeiv_control_free, ODEIV_CONTROL_VAL, Unit) ML1(gsl_odeiv_control_name, ODEIV_CONTROL_VAL, copy_string) CAMLprim value ml_gsl_odeiv_control_hadjust(value c, value s, value y, value yerr, value dydt, value h) { double c_h = Double_val(h); int status = gsl_odeiv_control_hadjust(ODEIV_CONTROL_VAL(c), ODEIV_STEP_VAL(s), Double_array_val(y), Double_array_val(yerr), Double_array_val(dydt), &c_h); { CAMLparam0(); CAMLlocal2(vh, r); vh = copy_double(c_h); r = alloc_small(2, 0); Field(r, 0) = Val_int(status + 1); Field(r, 1) = vh; CAMLreturn(r); } } CAMLprim value ml_gsl_odeiv_control_hadjust_bc(value *argv, int argc) { return ml_gsl_odeiv_control_hadjust(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } CAMLprim value ml_gsl_odeiv_evolve_alloc(value dim) { gsl_odeiv_evolve *e = gsl_odeiv_evolve_alloc(Int_val(dim)); value res; Abstract_ptr(res, e); return res; } #define ODEIV_EVOLVE_VAL(v) ((gsl_odeiv_evolve *)Field((v), 0)) ML1(gsl_odeiv_evolve_free, ODEIV_EVOLVE_VAL, Unit) ML1(gsl_odeiv_evolve_reset, ODEIV_EVOLVE_VAL, Unit) CAMLprim value ml_gsl_odeiv_evolve_apply(value e, value c, value s, value syst, value t, value t1, value h, value y) { CAMLparam5(e, c, s, syst, y); double t_c = Double_val(t); double h_c = Double_val(h); LOCALARRAY(double, y_copy, Double_array_length(y)); int status; memcpy(y_copy, Double_array_val(y), Bosize_val(y)); status = gsl_odeiv_evolve_apply(ODEIV_EVOLVE_VAL(e), ODEIV_CONTROL_VAL(c), ODEIV_STEP_VAL(s), ODEIV_SYSTEM_VAL(syst), &t_c, Double_val(t1), &h_c, y_copy); /* GSL does not call the error handler for this function */ if (status) GSL_ERROR_VAL ("gsl_odeiv_evolve_apply", status, Val_unit); memcpy(Double_array_val(y), y_copy, Bosize_val(y)); CAMLreturn(copy_two_double(t_c, h_c)); } CAMLprim value ml_gsl_odeiv_evolve_apply_bc(value *argv, int argc) { return ml_gsl_odeiv_evolve_apply(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7]); } gsl-ocaml-1.19.1/lib/mlgsl_permut.c000066400000000000000000000137271262311274100171160ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include "wrappers.h" #include "mlgsl_permut.h" CAMLprim value ml_gsl_permutation_init(value p) { GSL_PERMUT_OF_BIGARRAY(p); gsl_permutation_init(&perm_p); return Val_unit; } CAMLprim value ml_gsl_permutation_valid(value p) { int r; GSL_PERMUT_OF_BIGARRAY(p); r = gsl_permutation_valid(&perm_p); return Val_negbool(r); } CAMLprim value ml_gsl_permutation_reverse(value p) { GSL_PERMUT_OF_BIGARRAY(p); gsl_permutation_reverse(&perm_p); return Val_unit; } CAMLprim value ml_gsl_permutation_inverse(value src, value dst) { GSL_PERMUT_OF_BIGARRAY(src); GSL_PERMUT_OF_BIGARRAY(dst); gsl_permutation_inverse(&perm_dst, &perm_src); return Val_unit; } CAMLprim value ml_gsl_permutation_next(value p) { GSL_PERMUT_OF_BIGARRAY(p); gsl_permutation_next(&perm_p); return Val_unit; } CAMLprim value ml_gsl_permutation_prev(value p) { GSL_PERMUT_OF_BIGARRAY(p); gsl_permutation_prev(&perm_p); return Val_unit; } CAMLprim value ml_gsl_permute(value p, value arr) { GSL_PERMUT_OF_BIGARRAY(p); if(Tag_val(arr) == Double_array_tag) gsl_permute(perm_p.data, Double_array_val(arr), 1, Double_array_length(arr)); else gsl_permute_long(perm_p.data, (value *)arr, 1, Array_length(arr)); return Val_unit; } CAMLprim value ml_gsl_permute_barr(value p, value arr) { GSL_PERMUT_OF_BIGARRAY(p); struct caml_bigarray *barr = Bigarray_val(arr); enum caml_bigarray_kind kind = (barr->flags) & BIGARRAY_KIND_MASK ; switch(kind){ case BIGARRAY_FLOAT32: gsl_permute_float(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_FLOAT64: gsl_permute(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_SINT8: gsl_permute_char(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_UINT8: gsl_permute_uchar(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_SINT16: gsl_permute_short(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_UINT16: gsl_permute_ushort(perm_p.data, barr->data, 1, barr->dim[0]); break; #ifdef ARCH_SIXTYFOUR case BIGARRAY_INT64: #else case BIGARRAY_INT32: #endif case BIGARRAY_CAML_INT: case BIGARRAY_NATIVE_INT: gsl_permute_long(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_COMPLEX32: gsl_permute_complex_float(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_COMPLEX64: gsl_permute_complex(perm_p.data, barr->data, 1, barr->dim[0]); break; default: GSL_ERROR("data type not supported", GSL_EUNIMPL); } return Val_unit; } CAMLprim value ml_gsl_permute_complex(value p, value arr) { GSL_PERMUT_OF_BIGARRAY(p); gsl_permute_complex(perm_p.data, Double_array_val(arr), 1, Double_array_length(arr)/2); return Val_unit; } CAMLprim value ml_gsl_permute_inverse(value p, value arr) { GSL_PERMUT_OF_BIGARRAY(p); if(Tag_val(arr) == Double_array_tag) gsl_permute_inverse(perm_p.data, Double_array_val(arr), 1, Double_array_length(arr)); else gsl_permute_long_inverse(perm_p.data, (value *)arr, 1, Array_length(arr)); return Val_unit; } CAMLprim value ml_gsl_permute_inverse_barr(value p, value arr) { GSL_PERMUT_OF_BIGARRAY(p); struct caml_bigarray *barr = Bigarray_val(arr); enum caml_bigarray_kind kind = (barr->flags) & BIGARRAY_KIND_MASK ; switch(kind){ case BIGARRAY_FLOAT32: gsl_permute_float_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_FLOAT64: gsl_permute_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_SINT8: gsl_permute_char_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_UINT8: gsl_permute_uchar_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_SINT16: gsl_permute_short_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_UINT16: gsl_permute_ushort_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break; #ifdef ARCH_SIXTYFOUR case BIGARRAY_INT64: #else case BIGARRAY_INT32: #endif case BIGARRAY_CAML_INT: case BIGARRAY_NATIVE_INT: gsl_permute_long_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_COMPLEX32: gsl_permute_complex_float_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break; case BIGARRAY_COMPLEX64: gsl_permute_complex_inverse(perm_p.data, barr->data, 1, barr->dim[0]); break; default: GSL_ERROR("data type not supported", GSL_EUNIMPL); } return Val_unit; } CAMLprim value ml_gsl_permute_inverse_complex(value p, value arr) { GSL_PERMUT_OF_BIGARRAY(p); gsl_permute_complex_inverse(perm_p.data, Double_array_val(arr), 1, Double_array_length(arr)/2); return Val_unit; } CAMLprim value ml_gsl_permute_mul(value p, value pa, value pb) { GSL_PERMUT_OF_BIGARRAY(p); GSL_PERMUT_OF_BIGARRAY(pa); GSL_PERMUT_OF_BIGARRAY(pb); gsl_permutation_mul(&perm_p, &perm_pa, &perm_pb); return Val_unit; } CAMLprim value ml_gsl_permute_linear_to_canonical(value q, value p) { GSL_PERMUT_OF_BIGARRAY(q); GSL_PERMUT_OF_BIGARRAY(p); gsl_permutation_linear_to_canonical (&perm_q, &perm_p); return Val_unit; } CAMLprim value ml_gsl_permute_canonical_to_linear(value p, value q) { GSL_PERMUT_OF_BIGARRAY(p); GSL_PERMUT_OF_BIGARRAY(q); gsl_permutation_canonical_to_linear (&perm_p, &perm_q); return Val_unit; } CAMLprim value ml_gsl_permute_inversions(value p) { size_t inv; GSL_PERMUT_OF_BIGARRAY(p); inv = gsl_permutation_inversions (&perm_p); return Val_long(inv); } CAMLprim value ml_gsl_permute_canonical_cycles(value q) { size_t c; GSL_PERMUT_OF_BIGARRAY(q); c = gsl_permutation_canonical_cycles (&perm_q); return Val_long(c); } CAMLprim value ml_gsl_permute_linear_cycles(value p) { size_t c; GSL_PERMUT_OF_BIGARRAY(p); c = gsl_permutation_linear_cycles (&perm_p); return Val_long(c); } gsl-ocaml-1.19.1/lib/mlgsl_permut.h000066400000000000000000000006631262311274100171160ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #define GSL_PERMUT_OF_BIGARRAY(arr) \ struct caml_bigarray *bigarr_##arr = Bigarray_val(arr); \ gsl_permutation perm_##arr = { \ /*.size =*/ bigarr_##arr->dim[0], \ /*.data =*/ bigarr_##arr->data } gsl-ocaml-1.19.1/lib/mlgsl_poly.c000066400000000000000000000065621262311274100165640ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include "wrappers.h" CAMLprim value ml_gsl_poly_eval(value c, value x) { int len = Double_array_length(c); return copy_double(gsl_poly_eval(Double_array_val(c), len, Double_val(x))); } CAMLprim value ml_gsl_poly_solve_quadratic(value a, value b, value c) { double x0, x1; int n ; n = gsl_poly_solve_quadratic(Double_val(a), Double_val(b), Double_val(c), &x0, &x1); { CAMLparam0(); CAMLlocal1(r); if(n == 0) r = Val_int(0); else{ r = alloc(2, 0); Store_field(r, 0, copy_double(x0)); Store_field(r, 1, copy_double(x1)); } ; CAMLreturn(r); } } CAMLprim value ml_gsl_poly_complex_solve_quadratic(value a, value b, value c) { gsl_complex z0, z1; gsl_poly_complex_solve_quadratic(Double_val(a), Double_val(b), Double_val(c), &z0, &z1); { CAMLparam0(); CAMLlocal3(r,rz0,rz1); rz0 = alloc_small(2 * Double_wosize, Double_array_tag); Store_double_field(rz0, 0, GSL_REAL(z0)); Store_double_field(rz0, 1, GSL_IMAG(z0)); rz1 = alloc_small(2 * Double_wosize, Double_array_tag); Store_double_field(rz1, 0, GSL_REAL(z1)); Store_double_field(rz1, 1, GSL_IMAG(z1)); r = alloc_small(2, 0); Field(r,0) = rz0 ; Field(r,1) = rz1 ; CAMLreturn(r); } } CAMLprim value ml_gsl_poly_solve_cubic(value a, value b, value c) { double x0, x1, x2; int n ; n = gsl_poly_solve_cubic(Double_val(a), Double_val(b), Double_val(c), &x0, &x1, &x2); { CAMLparam0(); CAMLlocal1(r); r = Val_int(0); /* to silence compiler warnings */ switch(n){ case 0: break; case 1: r = alloc(1, 0); Store_field(r, 0, copy_double(x0)); break; case 3: r = alloc(3, 1); Store_field(r, 0, copy_double(x0)); Store_field(r, 1, copy_double(x1)); Store_field(r, 2, copy_double(x2)); } ; CAMLreturn(r); }; } CAMLprim value ml_gsl_poly_complex_solve_cubic(value a, value b, value c) { gsl_complex z0, z1, z2; gsl_poly_complex_solve_cubic(Double_val(a), Double_val(b), Double_val(c), &z0, &z1, &z2); { CAMLparam0(); CAMLlocal4(r,rz0, rz1, rz2); rz0 = alloc_small(2 * Double_wosize, Double_array_tag); Store_double_field(rz0, 0, GSL_REAL(z0)); Store_double_field(rz0, 1, GSL_IMAG(z0)); rz1 = alloc_small(2 * Double_wosize, Double_array_tag); Store_double_field(rz1, 0, GSL_REAL(z1)); Store_double_field(rz1, 1, GSL_IMAG(z1)); rz2 = alloc_small(2 * Double_wosize, Double_array_tag); Store_double_field(rz2, 0, GSL_REAL(z2)); Store_double_field(rz2, 1, GSL_IMAG(z2)); r = alloc_small(3, 0); Field(r,0) = rz0 ; Field(r,1) = rz1 ; Field(r,2) = rz2 ; CAMLreturn(r); } } #define POLY_WS(v) (gsl_poly_complex_workspace *)Field((v), 0) ML1_alloc(gsl_poly_complex_workspace_alloc, Int_val, Abstract_ptr) ML1(gsl_poly_complex_workspace_free, POLY_WS, Unit) CAMLprim value ml_gsl_poly_complex_solve(value a, value ws, value r) { gsl_poly_complex_solve(Double_array_val(a), Double_array_length(a), POLY_WS(ws), (gsl_complex_packed_ptr) r); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_qrng.c000066400000000000000000000030041262311274100165340ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include "wrappers.h" static inline const gsl_qrng_type *qrngtype_val(value v) { const gsl_qrng_type *qrng_type[] = { gsl_qrng_niederreiter_2, gsl_qrng_sobol }; return qrng_type[Int_val(v)]; } #define Qrng_val(v) (gsl_qrng *)Field((v), 0) CAMLprim value ml_gsl_qrng_alloc(value type, value dim) { value r; Abstract_ptr(r, gsl_qrng_alloc(qrngtype_val(type), Int_val(dim))); return r; } ML1(gsl_qrng_free, Qrng_val, Unit) ML1(gsl_qrng_init, Qrng_val, Unit) CAMLprim value ml_gsl_qrng_dimension(value qrng) { return Val_int((Qrng_val(qrng))->dimension); } CAMLprim value ml_gsl_qrng_get(value qrng, value x) { if(Double_array_length(x) != (Qrng_val(qrng))->dimension) GSL_ERROR("wrong array size", GSL_EBADLEN); gsl_qrng_get(Qrng_val(qrng), Double_array_val(x)); return Val_unit; } CAMLprim value ml_gsl_qrng_sample(value qrng) { gsl_qrng * q = Qrng_val(qrng); value arr = alloc(q->dimension * Double_wosize, Double_array_tag); gsl_qrng_get(q, Double_array_val(arr)); return arr; } ML1(gsl_qrng_name, Qrng_val, copy_string) CAMLprim value ml_gsl_qrng_memcpy(value src, value dst) { gsl_qrng_memcpy(Qrng_val(dst), Qrng_val(src)); return Val_unit; } CAMLprim value ml_gsl_qrng_clone(value qrng) { value r; Abstract_ptr(r, gsl_qrng_clone(Qrng_val(qrng))); return r; } gsl-ocaml-1.19.1/lib/mlgsl_randist.c000066400000000000000000000242561262311274100172450ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include "wrappers.h" #include "mlgsl_rng.h" /* GAUSSIAN */ ML2(gsl_ran_gaussian, Rng_val, Double_val, copy_double) ML2(gsl_ran_gaussian_ratio_method, Rng_val, Double_val, copy_double) ML2(gsl_ran_gaussian_ziggurat, Rng_val, Double_val, copy_double) ML2(gsl_ran_gaussian_pdf, Double_val, Double_val, copy_double) ML1(gsl_ran_ugaussian, Rng_val, copy_double) ML1(gsl_ran_ugaussian_ratio_method, Rng_val, copy_double) ML1(gsl_ran_ugaussian_pdf, Double_val, copy_double) /* GAUSSIAN TAIL */ ML3(gsl_ran_gaussian_tail, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_gaussian_tail_pdf, Double_val, Double_val, Double_val ,copy_double) ML2(gsl_ran_ugaussian_tail, Rng_val, Double_val, copy_double) ML2(gsl_ran_ugaussian_tail_pdf, Double_val, Double_val, copy_double) /* BIVARIATE */ CAMLprim value ml_gsl_ran_bivariate_gaussian(value rng, value sigma_x, value sigma_y, value rho) { double x,y; gsl_ran_bivariate_gaussian(Rng_val(rng), Double_val(sigma_x), Double_val(sigma_y), Double_val(rho), &x, &y); return copy_two_double(x, y); } ML5(gsl_ran_bivariate_gaussian_pdf, Double_val, Double_val, Double_val, Double_val, Double_val, copy_double) /* EXPONENTIAL */ ML2(gsl_ran_exponential, Rng_val, Double_val, copy_double) ML2(gsl_ran_exponential_pdf, Double_val, Double_val, copy_double) /* LAPLACE */ ML2(gsl_ran_laplace, Rng_val, Double_val, copy_double) ML2(gsl_ran_laplace_pdf, Double_val, Double_val, copy_double) /* EXPONENTIAL POWER */ ML3(gsl_ran_exppow, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_exppow_pdf, Double_val, Double_val, Double_val, copy_double) /* CAUCHY */ ML2(gsl_ran_cauchy, Rng_val, Double_val, copy_double) ML2(gsl_ran_cauchy_pdf, Double_val, Double_val, copy_double) /* RAYLEIGH */ ML2(gsl_ran_rayleigh, Rng_val, Double_val, copy_double) ML2(gsl_ran_rayleigh_pdf, Double_val, Double_val, copy_double) /* RAYLEIGH TAIL */ ML3(gsl_ran_rayleigh_tail, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_rayleigh_tail_pdf, Double_val, Double_val, Double_val, copy_double) /* LANDAU */ ML1(gsl_ran_landau, Rng_val, copy_double) ML1(gsl_ran_landau_pdf, Double_val, copy_double) /* LEVY ALPHA-STABLE */ ML3(gsl_ran_levy, Rng_val, Double_val, Double_val, copy_double) /* LEVY SKEW ALPHA-STABLE */ ML4(gsl_ran_levy_skew, Rng_val, Double_val, Double_val, Double_val, copy_double) /* GAMMA */ ML3(gsl_ran_gamma, Rng_val, Double_val, Double_val, copy_double) ML2(gsl_ran_gamma_int, Rng_val, Unsigned_int_val, copy_double) ML3(gsl_ran_gamma_pdf, Double_val, Double_val, Double_val, copy_double) ML3(gsl_ran_gamma_mt, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_gamma_knuth, Rng_val, Double_val, Double_val, copy_double) /* FLAT */ ML3(gsl_ran_flat, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_flat_pdf, Double_val, Double_val, Double_val, copy_double) /* LOGNORMAL */ ML3(gsl_ran_lognormal, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_lognormal_pdf, Double_val, Double_val, Double_val, copy_double) /* CHISQ */ ML2(gsl_ran_chisq, Rng_val, Double_val, copy_double) ML2(gsl_ran_chisq_pdf, Double_val, Double_val, copy_double) /* DIRICHLET */ CAMLprim value ml_gsl_ran_dirichlet(value rng, value alpha, value theta) { const size_t K = Double_array_length(alpha); if(Double_array_length(theta) != K) GSL_ERROR("alpha and theta must have same size", GSL_EBADLEN); gsl_ran_dirichlet(Rng_val(rng), K, Double_array_val(alpha), Double_array_val(theta)); return Val_unit; } CAMLprim value ml_gsl_ran_dirichlet_pdf(value alpha, value theta) { const size_t K = Double_array_length(alpha); double r ; if(Double_array_length(theta) != K) GSL_ERROR("alpha and theta must have same size", GSL_EBADLEN); r = gsl_ran_dirichlet_pdf(K, Double_array_val(alpha), Double_array_val(theta)); return copy_double(r); } CAMLprim value ml_gsl_ran_dirichlet_lnpdf(value alpha, value theta) { const size_t K = Double_array_length(alpha); double r ; if(Double_array_length(theta) != K) GSL_ERROR("alpha and theta must have same size", GSL_EBADLEN); r = gsl_ran_dirichlet_lnpdf(K, Double_array_val(alpha), Double_array_val(theta)); return copy_double(r); } /* FDIST */ ML3(gsl_ran_fdist, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_fdist_pdf, Double_val, Double_val, Double_val, copy_double) /* TDIST */ ML2(gsl_ran_tdist, Rng_val, Double_val, copy_double) ML2(gsl_ran_tdist_pdf, Double_val, Double_val, copy_double) /* BETA */ ML3(gsl_ran_beta, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_beta_pdf, Double_val, Double_val, Double_val, copy_double) /* LOGISTIC */ ML2(gsl_ran_logistic, Rng_val, Double_val, copy_double) ML2(gsl_ran_logistic_pdf, Double_val, Double_val, copy_double) /* PARETO */ ML3(gsl_ran_pareto, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_pareto_pdf, Double_val, Double_val, Double_val, copy_double) /* SPHERICAL */ CAMLprim value ml_gsl_ran_dir_2d(value rng) { double x,y; gsl_ran_dir_2d(Rng_val(rng), &x, &y); return copy_two_double(x, y); } CAMLprim value ml_gsl_ran_dir_2d_trig_method(value rng) { double x,y; gsl_ran_dir_2d_trig_method(Rng_val(rng), &x, &y); return copy_two_double(x, y); } CAMLprim value ml_gsl_ran_dir_3d(value rng) { double x,y,z; gsl_ran_dir_3d(Rng_val(rng), &x, &y, &z); { CAMLparam0(); CAMLlocal1(r); r=alloc_tuple(3); Store_field(r, 0, copy_double(x)); Store_field(r, 1, copy_double(y)); Store_field(r, 2, copy_double(z)); CAMLreturn(r); } } CAMLprim value ml_gsl_ran_dir_nd(value rng, value x) { gsl_ran_dir_nd(Rng_val(rng), Double_array_length(x), Double_array_val(x)); return Val_unit; } /* WEIBULL */ ML3(gsl_ran_weibull, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_weibull_pdf, Double_val, Double_val, Double_val, copy_double) /* GUMBEL1 */ ML3(gsl_ran_gumbel1, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_gumbel1_pdf, Double_val, Double_val, Double_val, copy_double) /* GUMBEL2 */ ML3(gsl_ran_gumbel2, Rng_val, Double_val, Double_val, copy_double) ML3(gsl_ran_gumbel2_pdf, Double_val, Double_val, Double_val, copy_double) /* POISSON */ ML2(gsl_ran_poisson, Rng_val, Double_val, Val_int) ML2(gsl_ran_poisson_pdf, Int_val, Double_val, copy_double) /* BERNOULLI */ ML2(gsl_ran_bernoulli, Rng_val, Double_val, Val_int) ML2(gsl_ran_bernoulli_pdf, Int_val, Double_val, copy_double) /* BINOMIAL */ ML3(gsl_ran_binomial, Rng_val, Double_val, Int_val, Val_int) ML3(gsl_ran_binomial_knuth, Rng_val, Double_val, Int_val, Val_int) ML3(gsl_ran_binomial_tpe, Rng_val, Double_val, Int_val, Val_int) ML3(gsl_ran_binomial_pdf, Int_val, Double_val, Int_val, copy_double) /* MULTINOMIAL */ CAMLprim value ml_gsl_ran_multinomial(value rng, value n, value p) { const size_t K = Double_array_length(p); LOCALARRAY(unsigned int, N, K); value r; gsl_ran_multinomial(Rng_val(rng), K, Int_val(n), Double_array_val(p), N); { register int i; r = alloc(K, 0); for(i=0; i #include #include #include #include #include "wrappers.h" #include "mlgsl_rng.h" #define NB_RNG 62 const gsl_rng_type *rngtype_of_int(int i) { const gsl_rng_type *rngtypes[ NB_RNG ] = { gsl_rng_borosh13, gsl_rng_coveyou, gsl_rng_cmrg, gsl_rng_fishman18, gsl_rng_fishman20, gsl_rng_fishman2x, gsl_rng_gfsr4, gsl_rng_knuthran, gsl_rng_knuthran2, gsl_rng_knuthran2002, gsl_rng_lecuyer21, gsl_rng_minstd, gsl_rng_mrg, gsl_rng_mt19937, gsl_rng_mt19937_1999, gsl_rng_mt19937_1998, gsl_rng_r250, gsl_rng_ran0, gsl_rng_ran1, gsl_rng_ran2, gsl_rng_ran3, gsl_rng_rand, gsl_rng_rand48, gsl_rng_random128_bsd, gsl_rng_random128_glibc2, gsl_rng_random128_libc5, gsl_rng_random256_bsd, gsl_rng_random256_glibc2, gsl_rng_random256_libc5, gsl_rng_random32_bsd, gsl_rng_random32_glibc2, gsl_rng_random32_libc5, gsl_rng_random64_bsd, gsl_rng_random64_glibc2, gsl_rng_random64_libc5, gsl_rng_random8_bsd, gsl_rng_random8_glibc2, gsl_rng_random8_libc5, gsl_rng_random_bsd, gsl_rng_random_glibc2, gsl_rng_random_libc5, gsl_rng_randu, gsl_rng_ranf, gsl_rng_ranlux, gsl_rng_ranlux389, gsl_rng_ranlxd1, gsl_rng_ranlxd2, gsl_rng_ranlxs0, gsl_rng_ranlxs1, gsl_rng_ranlxs2, gsl_rng_ranmar, gsl_rng_slatec, gsl_rng_taus, gsl_rng_taus2, gsl_rng_taus113, gsl_rng_transputer, gsl_rng_tt800, gsl_rng_uni, gsl_rng_uni32, gsl_rng_vax, gsl_rng_waterman14, gsl_rng_zuf } ; return rngtypes[i]; } #define Rngtype_val(v) (rngtype_of_int(Int_val(v))) value ml_gsl_rng_env_setup(value unit) { gsl_rng_env_setup() ; return Val_unit; } static int int_of_rngtype(const gsl_rng_type *rngt) { unsigned int i, len = NB_RNG; for(i=0; itype)); } value ml_gsl_rng_memcpy(value src, value dst) { gsl_rng_memcpy(Rng_val(dst), Rng_val(src)); return Val_unit; } value ml_gsl_rng_clone(value rng) { value r; Abstract_ptr(r, gsl_rng_clone(Rng_val(rng))); return r; } value ml_gsl_rng_dump_state(value rng) { CAMLparam0(); CAMLlocal3(v, n, s); size_t len = gsl_rng_size(Rng_val(rng)); void *state = gsl_rng_state(Rng_val(rng)); const char *name = gsl_rng_name(Rng_val(rng)); n = copy_string(name); s = alloc_string(len); memcpy(Bp_val(s), state, len); v = alloc_small(2, 0); Field(v, 0) = n; Field(v, 1) = s; CAMLreturn(v); } value ml_gsl_rng_set_state(value rng, value v) { gsl_rng *r = Rng_val(rng); char *name = String_val(Field(v, 0)); value state = Field(v, 1); if(strcmp(name, gsl_rng_name(r)) != 0 || gsl_rng_size(r) != string_length(state) ) invalid_argument("Gsl_rng.set_state : wrong rng type"); memcpy(r->state, Bp_val(state), string_length(state)); return Val_unit; } /* sampling */ value ml_gsl_rng_get(value rng) { return copy_nativeint(gsl_rng_get(Rng_val(rng))) ; } value ml_gsl_rng_uniform(value rng) { return copy_double(gsl_rng_uniform(Rng_val(rng))) ; } value ml_gsl_rng_uniform_pos(value rng) { return copy_double(gsl_rng_uniform_pos(Rng_val(rng))) ; } value ml_gsl_rng_uniform_int(value rng, value n) { return Val_int(gsl_rng_uniform_int(Rng_val(rng), Int_val(n))) ; } value ml_gsl_rng_uniform_arr(value rng, value arr) { gsl_rng *c_rng = Rng_val(rng) ; mlsize_t len = Double_array_length(arr); register int i; for(i=0; i #include #define Rng_val(v) ((gsl_rng *)(Field(v, 0))) gsl-ocaml-1.19.1/lib/mlgsl_roots.c000066400000000000000000000076751262311274100167550ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include "wrappers.h" #include "mlgsl_fun.h" static const gsl_root_fsolver_type *Fsolvertype_val(value solver_type) { const gsl_root_fsolver_type *solvers[] = { gsl_root_fsolver_bisection, gsl_root_fsolver_falsepos, gsl_root_fsolver_brent }; return solvers[Int_val(solver_type)]; } static const gsl_root_fdfsolver_type *FDFsolvertype_val(value solver_type) { const gsl_root_fdfsolver_type *solvers[] = { gsl_root_fdfsolver_newton, gsl_root_fdfsolver_secant, gsl_root_fdfsolver_steffenson }; return solvers[Int_val(solver_type)]; } CAMLprim value ml_gsl_root_fsolver_alloc(value t) { struct callback_params *params; gsl_root_fsolver *s; s = gsl_root_fsolver_alloc(Fsolvertype_val(t)); params=stat_alloc(sizeof(*params)); { CAMLparam0(); CAMLlocal1(res); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)s; Field(res, 1) = (value)params; params->gslfun.gf.function = &gslfun_callback; params->gslfun.gf.params = params; params->closure = Val_unit; params->dbl = Val_unit; register_global_root(&(params->closure)); CAMLreturn(res); } } CAMLprim value ml_gsl_root_fdfsolver_alloc(value t) { struct callback_params *params; gsl_root_fdfsolver *s; s = gsl_root_fdfsolver_alloc(FDFsolvertype_val(t)); params=stat_alloc(sizeof(*params)); { CAMLparam0(); CAMLlocal1(res); res=alloc_small(2, Abstract_tag); Field(res, 0) = (value)s; Field(res, 1) = (value)params; params->gslfun.gfdf.f = &gslfun_callback_f; params->gslfun.gfdf.df = &gslfun_callback_df; params->gslfun.gfdf.fdf = &gslfun_callback_fdf; params->gslfun.gfdf.params = params; params->closure = Val_unit; params->dbl = Val_unit; register_global_root(&(params->closure)); CAMLreturn(res); } } #define Fsolver_val(v) ((gsl_root_fsolver *)Field((v), 0)) #define FDFsolver_val(v) ((gsl_root_fdfsolver *)Field((v), 0)) #define Fparams_val(v) ((struct callback_params *)Field((v), 1)) CAMLprim value ml_gsl_root_fsolver_set(value s, value f, value lo, value hi) { CAMLparam1(s); struct callback_params *p=Fparams_val(s); p->closure=f; gsl_root_fsolver_set(Fsolver_val(s), &(p->gslfun.gf), Double_val(lo), Double_val(hi)); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_root_fdfsolver_set(value s, value f, value r) { CAMLparam1(s); struct callback_params *p=Fparams_val(s); p->closure=f; gsl_root_fdfsolver_set(FDFsolver_val(s), &(p->gslfun.gfdf), Double_val(r)); CAMLreturn(Val_unit); } CAMLprim value ml_gsl_root_fsolver_free(value s) { struct callback_params *p=Fparams_val(s); remove_global_root(&(p->closure)); stat_free(p); gsl_root_fsolver_free(Fsolver_val(s)); return Val_unit; } CAMLprim value ml_gsl_root_fdfsolver_free(value s) { struct callback_params *p=Fparams_val(s); remove_global_root(&(p->closure)); stat_free(p); gsl_root_fdfsolver_free(FDFsolver_val(s)); return Val_unit; } ML1(gsl_root_fsolver_name, Fsolver_val, copy_string) ML1(gsl_root_fdfsolver_name, FDFsolver_val, copy_string) ML1(gsl_root_fsolver_iterate, Fsolver_val, Unit) ML1(gsl_root_fdfsolver_iterate, FDFsolver_val, Unit) ML1(gsl_root_fsolver_root, Fsolver_val, copy_double) ML1(gsl_root_fdfsolver_root, FDFsolver_val, copy_double) CAMLprim value ml_gsl_root_fsolver_x_interv(value S) { return copy_two_double(gsl_root_fsolver_x_lower(Fsolver_val(S)), gsl_root_fsolver_x_upper(Fsolver_val(S))); } ML4(gsl_root_test_interval, Double_val, Double_val, Double_val, Double_val, Val_negbool) ML4(gsl_root_test_delta, Double_val, Double_val, Double_val, Double_val, Val_negbool) ML2(gsl_root_test_residual, Double_val, Double_val, Val_negbool) gsl-ocaml-1.19.1/lib/mlgsl_sf.c000066400000000000000000000433511262311274100162060ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include #include "wrappers.h" static inline value val_of_result(gsl_sf_result *result) { return copy_two_double_arr(result->val, result->err); } static value val_of_result_pair (gsl_sf_result *re, gsl_sf_result *im) { CAMLparam0 (); CAMLlocal3 (v, v_re, v_im); v_re = val_of_result (re); v_im = val_of_result (im); v = alloc_small (2, 0); Field (v, 0) = v_re; Field (v, 1) = v_im; CAMLreturn (v); } static inline value val_of_result_e10(gsl_sf_result_e10 *result) { CAMLparam0(); CAMLlocal3(r, v, e) ; v = copy_double(result->val); e = copy_double(result->err); r = alloc_small(3, 0); Field(r, 0) = v; Field(r, 1) = e; Field(r, 2) = Val_int(result->e10); CAMLreturn(r); } CAMLprim value ml_gsl_sf_result_smash_e(value e10) { gsl_sf_result r; gsl_sf_result_e10 e = { /*.val =*/ Double_val(Field(e10, 0)), /*.err =*/ Double_val(Field(e10, 1)), /*.e10 =*/ Int_val(Field(e10, 2)) } ; gsl_sf_result_smash_e(&e, &r); return val_of_result(&r); } #define GSL_MODE_val Int_val #define ML1_res(name, conv1) \ CAMLprim value ml_##name(value arg1) \ { gsl_sf_result res; \ name(conv1(arg1), &res); \ return val_of_result(&res); } #define ML2_res(name, conv1, conv2) \ CAMLprim value ml_##name(value arg1, value arg2) \ { gsl_sf_result res; \ name(conv1(arg1), conv2(arg2), &res); \ return val_of_result(&res); } #define ML3_res(name, conv1, conv2, conv3) \ CAMLprim value ml_##name(value arg1, value arg2, value arg3) \ { gsl_sf_result res; \ name(conv1(arg1), conv2(arg2), conv3(arg3), &res); \ return val_of_result(&res); } #define ML4_res(name, conv1, conv2, conv3, conv4) \ CAMLprim value ml_##name(value arg1, value arg2, value arg3, value arg4) \ { gsl_sf_result res; \ name(conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), &res); \ return val_of_result(&res); } #define ML5_res(name, conv1, conv2, conv3, conv4, conv5) \ CAMLprim value ml_##name(value arg1, value arg2, value arg3, value arg4, value arg5) \ { gsl_sf_result res; \ name(conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5), &res); \ return val_of_result(&res); } #define SF1(name, conv1) \ ML1(gsl_sf_##name, conv1, copy_double) \ ML1_res(gsl_sf_##name##_e, conv1) #define SF2(name, conv1, conv2) \ ML2(gsl_sf_##name, conv1, conv2, copy_double) \ ML2_res(gsl_sf_##name##_e, conv1, conv2) #define SF3(name, conv1, conv2, conv3) \ ML3(gsl_sf_##name, conv1, conv2, conv3, copy_double) \ ML3_res(gsl_sf_##name##_e, conv1, conv2, conv3) #define SF4(name, conv1, conv2, conv3, conv4) \ ML4(gsl_sf_##name, conv1, conv2, conv3, conv4, copy_double) \ ML4_res(gsl_sf_##name##_e, conv1, conv2, conv3, conv4) #define SF5(name, conv1, conv2, conv3, conv4, conv5) \ ML5(gsl_sf_##name, conv1, conv2, conv3, conv4, conv5, copy_double) \ ML5_res(gsl_sf_##name##_e, conv1, conv2, conv3, conv4, conv5) /* AIRY functions */ SF2(airy_Ai, Double_val, GSL_MODE_val) SF2(airy_Bi, Double_val, GSL_MODE_val) SF2(airy_Ai_scaled, Double_val, GSL_MODE_val) SF2(airy_Bi_scaled, Double_val, GSL_MODE_val) SF2(airy_Ai_deriv, Double_val, GSL_MODE_val) SF2(airy_Bi_deriv, Double_val, GSL_MODE_val) SF2(airy_Ai_deriv_scaled, Double_val, GSL_MODE_val) SF2(airy_Bi_deriv_scaled, Double_val, GSL_MODE_val) SF1(airy_zero_Ai, Int_val) SF1(airy_zero_Bi, Int_val) SF1(airy_zero_Ai_deriv, Int_val) SF1(airy_zero_Bi_deriv, Int_val) /* BESSEL functions */ #define BESSEL_CYL(l) \ SF1(bessel_##l##0, Double_val) \ SF1(bessel_##l##1, Double_val) \ SF2(bessel_##l##n, Int_val, Double_val) \ value ml_gsl_sf_bessel_##l##n_array(value nmin, value x, value r_arr){\ int NMIN=Int_val(nmin); \ int NMAX=NMIN+Double_array_length(r_arr)-1; \ gsl_sf_bessel_##l##n_array(NMIN, NMAX, Double_val(x), Double_array_val(r_arr));\ return Val_unit; } #define BESSEL_CYL_SCALED(l) \ SF1(bessel_##l##0_scaled, Double_val) \ SF1(bessel_##l##1_scaled, Double_val) \ SF2(bessel_##l##n_scaled, Int_val, Double_val) \ value ml_gsl_sf_bessel_##l##n_scaled_array(value nmin, value x, value r_arr){\ int NMIN=Int_val(nmin); \ int NMAX=NMIN+Double_array_length(r_arr)-1; \ gsl_sf_bessel_##l##n_array(NMIN, NMAX, Double_val(x), Double_array_val(r_arr));\ return Val_unit; } BESSEL_CYL(J) BESSEL_CYL(Y) BESSEL_CYL(I) BESSEL_CYL_SCALED(I) BESSEL_CYL(K) BESSEL_CYL_SCALED(K) #define BESSEL_SPH(c) \ SF1(bessel_##c##0, Double_val) \ SF1(bessel_##c##1, Double_val) \ SF1(bessel_##c##2, Double_val) \ SF2(bessel_##c##l, Int_val, Double_val) \ value ml_gsl_sf_bessel_##c##l_array(value x, value r_arr){\ int LMAX=Double_array_length(r_arr)-1; \ gsl_sf_bessel_##c##l_array(LMAX, Double_val(x), Double_array_val(r_arr));\ return Val_unit; } #define BESSEL_SPH_SCALED(c) \ SF1(bessel_##c##0_scaled, Double_val) \ SF1(bessel_##c##1_scaled, Double_val) \ SF2(bessel_##c##l_scaled, Int_val, Double_val) \ value ml_gsl_sf_bessel_##c##l_scaled_array(value x, value r_arr){\ int LMAX=Double_array_length(r_arr)-1; \ gsl_sf_bessel_##c##l_scaled_array(LMAX, Double_val(x), Double_array_val(r_arr));\ return Val_unit; } BESSEL_SPH(j) CAMLprim value ml_gsl_sf_bessel_jl_steed_array(value x, value x_arr) { gsl_sf_bessel_jl_steed_array(Double_array_length(x_arr)-1, Double_val(x), Double_array_val(x_arr)); return Val_unit; } BESSEL_SPH(y) BESSEL_SPH_SCALED(i) BESSEL_SPH_SCALED(k) SF2(bessel_Jnu, Double_val, Double_val) CAMLprim value ml_gsl_sf_bessel_sequence_Jnu_e(value nu, value mode, value x) { gsl_sf_bessel_sequence_Jnu_e(Double_val(nu), GSL_MODE_val(mode), Double_array_length(x), Double_array_val(x)); return Val_unit; } SF2(bessel_Ynu, Double_val, Double_val) SF2(bessel_Inu, Double_val, Double_val) SF2(bessel_Inu_scaled, Double_val, Double_val) SF2(bessel_Knu, Double_val, Double_val) SF2(bessel_lnKnu, Double_val, Double_val) SF2(bessel_Knu_scaled, Double_val, Double_val) SF1(bessel_zero_J0, Int_val) SF1(bessel_zero_J1, Int_val) SF2(bessel_zero_Jnu, Double_val, Int_val) /* CLAUSEN functions */ SF1(clausen, Double_val) /* COULOMB functions */ SF2(hydrogenicR_1, Double_val, Double_val) SF4(hydrogenicR, Int_val, Int_val, Double_val, Double_val) /* FIXME: COULOMB wave functions */ ML2_res(gsl_sf_coulomb_CL_e, Double_val, Double_val) CAMLprim value ml_gsl_sf_coulomb_CL_array(value lmin, value eta, value c_arr) { gsl_sf_coulomb_CL_array(Double_val(lmin), Double_array_length(c_arr)-1, Double_val(eta), Double_array_val(c_arr)); return Val_unit; } /* FIXME: coupling coeffs */ /* DAWSON function */ SF1(dawson, Double_val) /* DEBYE functions */ SF1(debye_1, Double_val) SF1(debye_2, Double_val) SF1(debye_3, Double_val) SF1(debye_4, Double_val) SF1(debye_5, Double_val) SF1(debye_6, Double_val) /* DILOGARITHM */ SF1(dilog, Double_val) CAMLprim value ml_gsl_sf_complex_dilog_e(value r, value theta) { gsl_sf_result re,im; gsl_sf_complex_dilog_e(Double_val(r), Double_val(theta), &re, &im); return val_of_result_pair (&re, &im); } CAMLprim value ml_gsl_sf_complex_dilog_xy_e(value x, value y) { gsl_sf_result re, im; gsl_sf_complex_dilog_xy_e (Double_val(x), Double_val(y), &re, &im); return val_of_result_pair (&re, &im); } CAMLprim value ml_gsl_sf_complex_spence_xy_e(value x, value y) { gsl_sf_result re, im; gsl_sf_complex_spence_xy_e (Double_val(x), Double_val(y), &re, &im); return val_of_result_pair (&re, &im); } /* ELEMENTARY operations */ ML2_res(gsl_sf_multiply_e, Double_val, Double_val) ML4_res(gsl_sf_multiply_err_e, Double_val, Double_val, Double_val, Double_val) /* ELLIPTIC integrals */ SF2(ellint_Kcomp, Double_val, GSL_MODE_val) SF2(ellint_Ecomp, Double_val, GSL_MODE_val) SF3(ellint_Pcomp, Double_val, Double_val, GSL_MODE_val) SF2(ellint_Dcomp, Double_val, GSL_MODE_val) SF3(ellint_F, Double_val, Double_val, GSL_MODE_val) SF3(ellint_E, Double_val, Double_val, GSL_MODE_val) SF4(ellint_P, Double_val, Double_val, Double_val, GSL_MODE_val) #if GSL_MAJOR_VERSION > 1 || (GSL_MAJOR_VERSION >= 1 && GSL_MINOR_VERSION >= 17) SF3(ellint_D, Double_val, Double_val, GSL_MODE_val) #else CAMLprim value ml_gsl_sf_ellint_D(value arg1, value arg2, value arg3) { CAMLparam3(arg1, arg2, arg3); double dummy_n = 0; /* Ignored by old implementation anyway */ double res = gsl_sf_ellint_D( Double_val(arg1), Double_val(arg2), dummy_n, GSL_MODE_val(arg3)); CAMLreturn(caml_copy_double(res)); } CAMLprim value ml_gsl_sf_ellint_D_e(value arg1, value arg2, value arg3) { gsl_sf_result res; double dummy_n = 0; /* Ignored by old implementation anyway */ gsl_sf_ellint_D_e( Double_val(arg1), Double_val(arg2), dummy_n, GSL_MODE_val(arg3), &res); return val_of_result(&res); } #endif SF3(ellint_RC, Double_val, Double_val, GSL_MODE_val) SF4(ellint_RD, Double_val, Double_val, Double_val, GSL_MODE_val) SF4(ellint_RF, Double_val, Double_val, Double_val, GSL_MODE_val) SF5(ellint_RJ, Double_val, Double_val, Double_val, Double_val, GSL_MODE_val) /* FIXME: gsl_sf_elljac_e */ /* ERROR functions */ SF1(erf, Double_val) SF1(erfc, Double_val) SF1(log_erfc, Double_val) SF1(erf_Z, Double_val) SF1(erf_Q, Double_val) /* EXPONENTIAL functions */ SF1(exp, Double_val) CAMLprim value ml_gsl_sf_exp_e10_e(value x) { gsl_sf_result_e10 res; gsl_sf_exp_e10_e(Double_val(x), &res); return val_of_result_e10(&res); } SF2(exp_mult, Double_val, Double_val) CAMLprim value ml_gsl_sf_exp_mult_e10_e(value x, value y) { gsl_sf_result_e10 res; gsl_sf_exp_mult_e10_e(Double_val(x), Double_val(y), &res); return val_of_result_e10(&res); } SF1(expm1, Double_val) SF1(exprel, Double_val) SF1(exprel_2, Double_val) SF2(exprel_n, Int_val, Double_val) ML2_res(gsl_sf_exp_err_e, Double_val, Double_val) CAMLprim value ml_gsl_sf_exp_err_e10_e(value x, value dx) { gsl_sf_result_e10 res; gsl_sf_exp_err_e10_e(Double_val(x), Double_val(dx), &res); return val_of_result_e10(&res); } ML4_res(gsl_sf_exp_mult_err_e, Double_val, Double_val, Double_val, Double_val) CAMLprim value ml_gsl_sf_exp_mult_err_e10_e(value x, value dx, value y, value dy) { gsl_sf_result_e10 res; gsl_sf_exp_mult_err_e10_e(Double_val(x), Double_val(dx), Double_val(y), Double_val(dy), &res); return val_of_result_e10(&res); } /* EXPONENTIAL integrals */ SF1(expint_E1, Double_val) SF1(expint_E2, Double_val) SF1(expint_E1_scaled, Double_val) SF1(expint_E2_scaled, Double_val) SF1(expint_Ei, Double_val) SF1(expint_Ei_scaled, Double_val) SF1(Shi, Double_val) SF1(Chi, Double_val) SF1(expint_3, Double_val) SF1(Si, Double_val) SF1(Ci, Double_val) SF1(atanint, Double_val) /* FERMI-DIRAC functions */ SF1(fermi_dirac_m1, Double_val) SF1(fermi_dirac_0, Double_val) SF1(fermi_dirac_1, Double_val) SF1(fermi_dirac_2, Double_val) SF2(fermi_dirac_int, Int_val, Double_val) SF1(fermi_dirac_mhalf, Double_val) SF1(fermi_dirac_half, Double_val) SF1(fermi_dirac_3half, Double_val) SF2(fermi_dirac_inc_0, Double_val, Double_val) /* GAMMA function */ SF1(gamma, Double_val) SF1(lngamma, Double_val) CAMLprim value ml_gsl_sf_lngamma_sgn_e(value x) { gsl_sf_result res; double sgn; gsl_sf_lngamma_sgn_e(Double_val(x), &res, &sgn); { CAMLparam0(); CAMLlocal3(v,r,s); r=val_of_result(&res); s=copy_double(sgn); v=alloc_small(2, 0); Field(v, 0)=r; Field(v, 1)=s; CAMLreturn(v); } } SF1(gammastar, Double_val) SF1(gammainv, Double_val) CAMLprim value ml_gsl_sf_lngamma_complex_e(value zr, value zi) { gsl_sf_result lnr, arg; gsl_sf_lngamma_complex_e(Double_val(zr), Double_val(zi),&lnr, &arg); return val_of_result_pair (&lnr, &arg); } SF2(taylorcoeff, Int_val, Double_val) SF1(fact, Int_val) SF1(doublefact, Int_val) SF1(lnfact, Int_val) SF1(lndoublefact, Int_val) SF2(choose, Int_val, Int_val) SF2(lnchoose, Int_val, Int_val) SF2(poch, Double_val, Double_val) SF2(lnpoch, Double_val, Double_val) CAMLprim value ml_gsl_sf_lnpoch_sgn_e(value a, value x) { gsl_sf_result res; double sgn; gsl_sf_lnpoch_sgn_e(Double_val(a), Double_val(x), &res, &sgn); { CAMLparam0(); CAMLlocal3(v,r,s); r=val_of_result(&res); s=copy_double(sgn); v=alloc_small(2, 0); Field(v, 0)=r; Field(v, 1)=s; CAMLreturn(v); } } SF2(pochrel, Double_val, Double_val) SF2(gamma_inc_Q, Double_val, Double_val) SF2(gamma_inc_P, Double_val, Double_val) SF2(gamma_inc, Double_val, Double_val) SF2(beta, Double_val, Double_val) SF2(lnbeta, Double_val, Double_val) CAMLprim value ml_gsl_sf_lnbeta_sgn_e(value x, value y) { gsl_sf_result res; double sgn; gsl_sf_lnbeta_sgn_e(Double_val(x), Double_val(y), &res, &sgn); { CAMLparam0(); CAMLlocal3(v,r,s); r=val_of_result(&res); s=copy_double(sgn); v=alloc_small(2, 0); Field(v, 0)=r; Field(v, 1)=s; CAMLreturn(v); } } SF3(beta_inc, Double_val, Double_val, Double_val) /* GEGENBAUER functions */ SF2(gegenpoly_1, Double_val, Double_val) SF2(gegenpoly_2, Double_val, Double_val) SF2(gegenpoly_3, Double_val, Double_val) SF3(gegenpoly_n, Int_val, Double_val, Double_val) CAMLprim value ml_gsl_sf_gegenpoly_array(value lambda, value x, value r_arr) { gsl_sf_gegenpoly_array(Double_array_length(r_arr)-1, Double_val(lambda), Double_val(x), Double_array_val(r_arr)); return Val_unit; } /* HYPERGEOMETRIC functions */ /* FIXME */ /* LAGUERRE functions */ SF2(laguerre_1, Double_val, Double_val) SF2(laguerre_2, Double_val, Double_val) SF2(laguerre_3, Double_val, Double_val) SF3(laguerre_n, Int_val, Double_val, Double_val) /* LAMBERT W functions */ SF1(lambert_W0, Double_val) SF1(lambert_Wm1, Double_val) /* LEGENDRE functions */ SF1(legendre_P1, Double_val) SF1(legendre_P2, Double_val) SF1(legendre_P3, Double_val) SF2(legendre_Pl, Int_val, Double_val) CAMLprim value ml_gsl_sf_legendre_Pl_array(value x, value r_arr) { gsl_sf_legendre_Pl_array(Double_array_length(r_arr)-1, Double_val(x), Double_array_val(r_arr)); return Val_unit; } SF1(legendre_Q0, Double_val) SF1(legendre_Q1, Double_val) SF2(legendre_Ql, Int_val, Double_val) /* Associated Legendre Polynomials and Spherical Harmonics */ SF3(legendre_Plm, Int_val, Int_val, Double_val) /* FIXME: linking problem with GSL 2.0 */ #if 0 CAMLprim value ml_gsl_sf_legendre_Plm_array(value lmax, value m, value x, value result_array) { gsl_sf_legendre_Plm_array(Int_val(lmax), Int_val(m), Double_val(x), Double_array_val(result_array)); return Val_unit; } #endif SF3(legendre_sphPlm, Int_val, Int_val, Double_val) /* FIXME: linking problem with GSL 2.0 */ #if 0 CAMLprim value ml_gsl_sf_legendre_sphPlm_array(value lmax, value m, value x, value result_array) { gsl_sf_legendre_sphPlm_array(Int_val(lmax), Int_val(m), Double_val(x), Double_array_val(result_array)); return Val_unit; } #endif /* FIXME: linking problem with GSL 2.0 */ #if 0 CAMLprim value ml_gsl_sf_legendre_array_size(value lmax, value m) { CAMLparam2(lmax, m); CAMLlocal1(ret); int gsl_ret; gsl_ret = gsl_sf_legendre_array_size(Int_val(lmax), Int_val(m)); ret = Val_int(gsl_ret); CAMLreturn(ret); } #endif /* LOGARITHM and related functions */ SF1(log, Double_val) SF1(log_abs, Double_val) CAMLprim value ml_gsl_sf_complex_log_e(value zr, value zi) { gsl_sf_result lnr, theta; gsl_sf_complex_log_e(Double_val(zr), Double_val(zi), &lnr, &theta); return val_of_result_pair (&lnr, &theta); } SF1(log_1plusx, Double_val) SF1(log_1plusx_mx, Double_val) /* POWER function */ SF2(pow_int, Double_val, Int_val) /* PSI functions */ SF1(psi_int, Int_val) SF1(psi, Double_val) SF1(psi_1piy, Double_val) CAMLprim value ml_gsl_sf_complex_psi_e(value x, value y) { gsl_sf_result r_re, r_im; gsl_sf_complex_psi_e (Double_val(x), Double_val(y), &r_re, &r_im); return val_of_result_pair (&r_re, &r_im); } SF1(psi_1_int, Int_val) SF1(psi_1, Double_val) SF2(psi_n, Int_val, Double_val) /* SYNCHROTRON functions */ SF1(synchrotron_1, Double_val) SF1(synchrotron_2, Double_val) /* TRANSPORT functions */ SF1(transport_2, Double_val) SF1(transport_3, Double_val) SF1(transport_4, Double_val) SF1(transport_5, Double_val) /* TRIGONOMETRIC functions */ SF1(sin, Double_val) SF1(cos, Double_val) SF2(hypot, Double_val, Double_val) SF1(sinc, Double_val) CAMLprim value ml_gsl_sf_complex_sin_e(value zr, value zi) { gsl_sf_result szr, szi; gsl_sf_complex_sin_e(Double_val(zr), Double_val(zi), &szr, &szi); return val_of_result_pair (&szr, &szi); } CAMLprim value ml_gsl_sf_complex_cos_e(value zr, value zi) { gsl_sf_result szr, szi; gsl_sf_complex_cos_e(Double_val(zr), Double_val(zi), &szr, &szi); return val_of_result_pair (&szr, &szi); } CAMLprim value ml_gsl_sf_complex_logsin_e(value zr, value zi) { gsl_sf_result lszr, lszi; gsl_sf_complex_logsin_e(Double_val(zr), Double_val(zi), &lszr, &lszi); return val_of_result_pair (&lszr, &lszi); } SF1(lnsinh, Double_val) SF1(lncosh, Double_val) CAMLprim value ml_gsl_sf_polar_to_rect(value r, value theta) { gsl_sf_result x, y; gsl_sf_polar_to_rect(Double_val(r), Double_val(theta), &x, &y); return val_of_result_pair (&x, &y); } CAMLprim value ml_gsl_sf_rect_to_polar(value x, value y) { gsl_sf_result r, theta; gsl_sf_rect_to_polar(Double_val(x), Double_val(y), &r, &theta); return val_of_result_pair (&r, &theta); } ML1(gsl_sf_angle_restrict_symm, Double_val, copy_double) ML1(gsl_sf_angle_restrict_pos, Double_val, copy_double) ML2_res(gsl_sf_sin_err_e, Double_val, Double_val) ML2_res(gsl_sf_cos_err_e, Double_val, Double_val) /* ZETA functions */ SF1(zeta_int, Int_val) SF1(zeta, Double_val) SF2(hzeta, Double_val, Double_val) SF1(eta_int, Int_val) SF1(eta, Double_val) gsl-ocaml-1.19.1/lib/mlgsl_sort.c000066400000000000000000000031231262311274100165560ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2005-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include "wrappers.h" #include "mlgsl_vector_double.h" #include "mlgsl_permut.h" CAMLprim value ml_gsl_sort_vector (value v) { _DECLARE_VECTOR(v); _CONVERT_VECTOR(v); gsl_sort_vector (&v_v); return Val_unit; } CAMLprim value ml_gsl_sort_vector_index (value p, value v) { GSL_PERMUT_OF_BIGARRAY(p); _DECLARE_VECTOR(v); _CONVERT_VECTOR(v); gsl_sort_vector_index (&perm_p, &v_v); return Val_unit; } CAMLprim value ml_gsl_sort_vector_smallest (value dest, value v) { _DECLARE_VECTOR(v); _CONVERT_VECTOR(v); gsl_sort_vector_smallest (Double_array_val (dest), Double_array_length (dest), &v_v); return Val_unit; } CAMLprim value ml_gsl_sort_vector_largest (value dest, value v) { _DECLARE_VECTOR(v); _CONVERT_VECTOR(v); gsl_sort_vector_largest (Double_array_val (dest), Double_array_length (dest), &v_v); return Val_unit; } CAMLprim value ml_gsl_sort_vector_smallest_index (value p, value v) { GSL_PERMUT_OF_BIGARRAY(p); _DECLARE_VECTOR(v); _CONVERT_VECTOR(v); gsl_sort_vector_smallest_index (perm_p.data, perm_p.size, &v_v); return Val_unit; } CAMLprim value ml_gsl_sort_vector_largest_index (value p, value v) { GSL_PERMUT_OF_BIGARRAY(p); _DECLARE_VECTOR(v); _CONVERT_VECTOR(v); gsl_sort_vector_largest_index (perm_p.data, perm_p.size, &v_v); return Val_unit; } gsl-ocaml-1.19.1/lib/mlgsl_stats.c000066400000000000000000000212611262311274100167300ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include "wrappers.h" static inline void check_array_size(value a, value b) { if(Double_array_length(a) != Double_array_length(b)) GSL_ERROR_VOID("array sizes differ", GSL_EBADLEN); } CAMLprim value ml_gsl_stats_mean(value ow, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) result = gsl_stats_mean(Double_array_val(data), 1, len); else { value w = Unoption(ow); check_array_size(data, w); result = gsl_stats_wmean(Double_array_val(w), 1, Double_array_val(data), 1, len); } return copy_double(result); } CAMLprim value ml_gsl_stats_variance(value ow, value omean, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) if(omean == Val_none) result = gsl_stats_variance(Double_array_val(data), 1, len); else result = gsl_stats_variance_m(Double_array_val(data), 1, len, Double_val(Unoption(omean))); else { value w = Unoption(ow); check_array_size(data, w); if(omean == Val_none) result = gsl_stats_wvariance(Double_array_val(w), 1, Double_array_val(data), 1, len); else result = gsl_stats_wvariance_m(Double_array_val(w), 1, Double_array_val(data), 1, len, Double_val(Unoption(omean))); } return copy_double(result); } CAMLprim value ml_gsl_stats_sd(value ow, value omean, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) if(omean == Val_none) result = gsl_stats_sd(Double_array_val(data), 1, len); else result = gsl_stats_sd_m(Double_array_val(data), 1, len, Double_val(Unoption(omean))); else { value w = Unoption(ow); check_array_size(data, w); if(omean == Val_none) result = gsl_stats_wsd(Double_array_val(w), 1, Double_array_val(data), 1, len); else result = gsl_stats_wsd_m(Double_array_val(w), 1, Double_array_val(data), 1, len, Double_val(Unoption(omean))); } return copy_double(result); } CAMLprim value ml_gsl_stats_variance_with_fixed_mean(value ow, value mean, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) result = gsl_stats_variance_with_fixed_mean(Double_array_val(data), 1, len, Double_val(mean)); else { value w = Unoption(ow); check_array_size(data, w); result = gsl_stats_wvariance_with_fixed_mean(Double_array_val(w), 1, Double_array_val(data), 1, len, Double_val(mean)); } return copy_double(result); } CAMLprim value ml_gsl_stats_sd_with_fixed_mean(value ow, value mean, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) result = gsl_stats_sd_with_fixed_mean(Double_array_val(data), 1, len, Double_val(mean)); else { value w = Unoption(ow); check_array_size(data, w); result = gsl_stats_wsd_with_fixed_mean(Double_array_val(w), 1, Double_array_val(data), 1, len, Double_val(mean)); } return copy_double(result); } CAMLprim value ml_gsl_stats_absdev(value ow, value omean, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) if(omean == Val_none) result = gsl_stats_absdev(Double_array_val(data), 1, len); else result = gsl_stats_absdev_m(Double_array_val(data), 1, len, Double_val(Unoption(omean))); else { value w = Unoption(ow); check_array_size(data, w); if(omean == Val_none) result = gsl_stats_wabsdev(Double_array_val(w), 1, Double_array_val(data), 1, len); else result = gsl_stats_wabsdev_m(Double_array_val(w), 1, Double_array_val(data), 1, len, Double_val(Unoption(omean))); } return copy_double(result); } CAMLprim value ml_gsl_stats_skew(value ow, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) result = gsl_stats_skew(Double_array_val(data), 1, len); else { value w = Unoption(ow); check_array_size(data, w); result = gsl_stats_wskew(Double_array_val(w), 1, Double_array_val(data), 1, len); } return copy_double(result); } CAMLprim value ml_gsl_stats_skew_m_sd(value ow, value mean, value sd, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) result = gsl_stats_skew_m_sd(Double_array_val(data), 1, len, Double_val(mean), Double_val(sd)); else { value w = Unoption(ow); check_array_size(data, w); result = gsl_stats_wskew_m_sd(Double_array_val(w), 1, Double_array_val(data), 1, len, Double_val(mean), Double_val(sd)); } return copy_double(result); } CAMLprim value ml_gsl_stats_kurtosis(value ow, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) result = gsl_stats_kurtosis(Double_array_val(data), 1, len); else { value w = Unoption(ow); check_array_size(data, w); result = gsl_stats_wkurtosis(Double_array_val(w), 1, Double_array_val(data), 1, len); } return copy_double(result); } CAMLprim value ml_gsl_stats_kurtosis_m_sd(value ow, value mean, value sd, value data) { size_t len = Double_array_length(data); double result; if(ow == Val_none) result = gsl_stats_kurtosis_m_sd(Double_array_val(data), 1, len, Double_val(mean), Double_val(sd)); else { value w = Unoption(ow); check_array_size(data, w); result = gsl_stats_wkurtosis_m_sd(Double_array_val(w), 1, Double_array_val(data), 1, len, Double_val(mean), Double_val(sd)); } return copy_double(result); } CAMLprim value ml_gsl_stats_lag1_autocorrelation(value omean, value data) { size_t len = Double_array_length(data); double result; if(omean == Val_none) result = gsl_stats_lag1_autocorrelation(Double_array_val(data), 1, len); else result = gsl_stats_lag1_autocorrelation_m(Double_array_val(data), 1, len, Double_val(Unoption(omean))); return copy_double(result); } CAMLprim value ml_gsl_stats_covariance(value data1, value data2) { size_t len = Double_array_length(data1); double result; check_array_size(data1, data2); result = gsl_stats_covariance(Double_array_val(data1), 1, Double_array_val(data2), 1, len); return copy_double(result); } CAMLprim value ml_gsl_stats_covariance_m(value mean1, value data1, value mean2, value data2) { size_t len = Double_array_length(data1); double result; check_array_size(data1, data2); result = gsl_stats_covariance_m(Double_array_val(data1), 1, Double_array_val(data2), 1, len, Double_val(mean1), Double_val(mean2)); return copy_double(result); } CAMLprim value ml_gsl_stats_max(value data) { size_t len = Double_array_length(data); double result = gsl_stats_max(Double_array_val(data), 1, len); return copy_double(result); } CAMLprim value ml_gsl_stats_min(value data) { size_t len = Double_array_length(data); double result = gsl_stats_min(Double_array_val(data), 1, len); return copy_double(result); } CAMLprim value ml_gsl_stats_minmax(value data) { size_t len = Double_array_length(data); double mi, ma; gsl_stats_minmax(&mi, &ma, Double_array_val(data), 1, len); return copy_two_double(mi, ma); } CAMLprim value ml_gsl_stats_max_index(value data) { size_t len = Double_array_length(data); size_t result = gsl_stats_max_index(Double_array_val(data), 1, len); return Val_int(result); } CAMLprim value ml_gsl_stats_min_index(value data) { size_t len = Double_array_length(data); size_t result = gsl_stats_min_index(Double_array_val(data), 1, len); return Val_int(result); } CAMLprim value ml_gsl_stats_minmax_index(value data) { size_t len = Double_array_length(data); size_t mi, ma; value r; gsl_stats_minmax_index(&mi, &ma, Double_array_val(data), 1, len); r = alloc_small(2, 0); Field(r, 0) = Val_int(mi); Field(r, 1) = Val_int(ma); return r; } CAMLprim value ml_gsl_stats_quantile_from_sorted_data(value data, value f) { size_t len = Double_array_length(data); double r = gsl_stats_quantile_from_sorted_data(Double_array_val(data), 1, len, Double_val(f)); return copy_double(r); } CAMLprim value ml_gsl_stats_correlation(value data1, value data2) { size_t len = Double_array_length(data1); double r; check_array_size(data1, data2); r = gsl_stats_correlation(Double_array_val(data1), 1, Double_array_val(data2), 1, len); return copy_double(r); } gsl-ocaml-1.19.1/lib/mlgsl_sum.c000066400000000000000000000033521262311274100163770ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include "wrappers.h" #define WS_val(v) ((gsl_sum_levin_u_workspace *)(Field((v), 0))) ML1_alloc(gsl_sum_levin_u_alloc, Int_val, Abstract_ptr) ML1(gsl_sum_levin_u_free, WS_val, Unit) CAMLprim value ml_gsl_sum_levin_u_accel(value arr, value ws) { double sum_accel, abserr; gsl_sum_levin_u_accel(Double_array_val(arr), Double_array_length(arr), WS_val(ws), &sum_accel, &abserr); return copy_two_double_arr(sum_accel, abserr); } CAMLprim value ml_gsl_sum_levin_u_getinfo(value ws) { gsl_sum_levin_u_workspace *W=WS_val(ws); CAMLparam0(); CAMLlocal2(v, s); s=copy_double(W->sum_plain); v=alloc_small(3, 0); Field(v, 0)=Val_int(W->size); Field(v, 1)=Val_int(W->terms_used); Field(v, 2)=s; CAMLreturn(v); } #define WStrunc_val(v) ((gsl_sum_levin_utrunc_workspace *)(Field((v), 0))) ML1_alloc(gsl_sum_levin_utrunc_alloc, Int_val, Abstract_ptr) ML1(gsl_sum_levin_utrunc_free, WStrunc_val, Unit) CAMLprim value ml_gsl_sum_levin_utrunc_accel(value arr, value ws) { double sum_accel, abserr; gsl_sum_levin_utrunc_accel(Double_array_val(arr), Double_array_length(arr), WStrunc_val(ws), &sum_accel, &abserr); return copy_two_double_arr(sum_accel, abserr); } CAMLprim value ml_gsl_sum_levin_utrunc_getinfo(value ws) { gsl_sum_levin_utrunc_workspace *W=WStrunc_val(ws); CAMLparam0(); CAMLlocal2(v, s); s=copy_double(W->sum_plain); v=alloc_small(3, 0); Field(v, 0)=Val_int(W->size); Field(v, 1)=Val_int(W->terms_used); Field(v, 2)=s; CAMLreturn(v); } gsl-ocaml-1.19.1/lib/mlgsl_vector.c000066400000000000000000000053741262311274100171030ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #ifndef FUNCTION #error pb with include files #endif CAMLprim value FUNCTION(ml_gsl_vector,memcpy)(value a, value b) { _DECLARE_VECTOR2(a,b); _CONVERT_VECTOR2(a,b); FUNCTION(gsl_vector,memcpy)(&v_b, &v_a); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_vector,add)(value a, value b) { _DECLARE_VECTOR2(a,b); _CONVERT_VECTOR2(a,b); FUNCTION(gsl_vector,add)(&v_a, &v_b); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_vector,sub)(value a, value b) { _DECLARE_VECTOR2(a,b); _CONVERT_VECTOR2(a,b); FUNCTION(gsl_vector,sub)(&v_a, &v_b); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_vector,mul)(value a, value b) { _DECLARE_VECTOR2(a,b); _CONVERT_VECTOR2(a,b); FUNCTION(gsl_vector,mul)(&v_a, &v_b); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_vector,div)(value a, value b) { _DECLARE_VECTOR2(a,b); _CONVERT_VECTOR2(a,b); FUNCTION(gsl_vector,div)(&v_a, &v_b); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_vector,scale)(value a, value x) { _DECLARE_VECTOR(a); _CONVERT_VECTOR(a); FUNCTION(gsl_vector,scale)(&v_a, Double_val(x)); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_vector,add_constant)(value a, value x) { _DECLARE_VECTOR(a); _CONVERT_VECTOR(a); FUNCTION(gsl_vector,add_constant)(&v_a, Double_val(x)); return Val_unit; } CAMLprim value FUNCTION(ml_gsl_vector,isnull)(value a) { int r; _DECLARE_VECTOR(a); _CONVERT_VECTOR(a); r = FUNCTION(gsl_vector,isnull)(&v_a); return Val_bool(r); } CAMLprim value FUNCTION(ml_gsl_vector,max)(value a) { _DECLARE_VECTOR(a); _CONVERT_VECTOR(a); return copy_double(FUNCTION(gsl_vector,max)(&v_a)); } CAMLprim value FUNCTION(ml_gsl_vector,min)(value a) { _DECLARE_VECTOR(a); _CONVERT_VECTOR(a); return copy_double(FUNCTION(gsl_vector,min)(&v_a)); } CAMLprim value FUNCTION(ml_gsl_vector,minmax)(value a) { BASE_TYPE x,y; _DECLARE_VECTOR(a); _CONVERT_VECTOR(a); FUNCTION(gsl_vector,minmax)(&v_a, &x, &y); return copy_two_double(x, y); } CAMLprim value FUNCTION(ml_gsl_vector,maxindex)(value a) { _DECLARE_VECTOR(a); _CONVERT_VECTOR(a); return Val_int(FUNCTION(gsl_vector,max_index)(&v_a)); } CAMLprim value FUNCTION(ml_gsl_vector,minindex)(value a) { _DECLARE_VECTOR(a); _CONVERT_VECTOR(a); return Val_int(FUNCTION(gsl_vector,min_index)(&v_a)); } CAMLprim value FUNCTION(ml_gsl_vector,minmaxindex)(value a) { size_t x,y; value v; _DECLARE_VECTOR(a); _CONVERT_VECTOR(a); FUNCTION(gsl_vector,minmax_index)(&v_a, &x, &y); v=alloc_small(2, 0); Field(v, 0) = Val_int(x); Field(v, 1) = Val_int(y); return v; } gsl-ocaml-1.19.1/lib/mlgsl_vector.h000066400000000000000000000040471262311274100171040ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include "wrappers.h" #ifndef TYPE #error pb with include files #endif static inline void TYPE(mlgsl_vec_of_bigarray)(TYPE(gsl_vector) *cvec, value vvec){ struct caml_bigarray *bigarr = Bigarray_val(vvec); cvec->block = NULL; cvec->owner = 0; cvec->size = bigarr->dim[0]; cvec->stride = 1; cvec->data = bigarr->data; } #ifdef CONV_FLAT static inline void TYPE(mlgsl_vec_of_floatarray)(TYPE(gsl_vector) *cvec, value vvec){ cvec->block = NULL; cvec->owner = 0; cvec->size = Int_val(Field(vvec, 2)); cvec->stride = Int_val(Field(vvec, 3)); cvec->data = (double *)Field(vvec, 0) + Int_val(Field(vvec, 1)); } #endif static inline void TYPE(mlgsl_vec_of_value)(TYPE(gsl_vector) *cvec, value vvec){ if(Tag_val(vvec) == 0 && Wosize_val(vvec) == 2) /* value is a polymorphic variant */ vvec = Field(vvec, 1); if(Tag_val(vvec) == Custom_tag) /* value is a bigarray */ TYPE(mlgsl_vec_of_bigarray)(cvec, vvec); #ifdef CONV_FLAT else /* value is a record wrapping a float array */ TYPE(mlgsl_vec_of_floatarray)(cvec, vvec); #endif } #define _DECLARE_VECTOR(a) TYPE(gsl_vector) v_##a #define _DECLARE_VECTOR2(a,b) _DECLARE_VECTOR(a); _DECLARE_VECTOR(b) #define _DECLARE_VECTOR3(a,b,c) _DECLARE_VECTOR2(a,b); _DECLARE_VECTOR(c) #define _DECLARE_VECTOR4(a,b,c,d) _DECLARE_VECTOR2(a,b); _DECLARE_VECTOR2(c,d) #define _DECLARE_VECTOR5(a,b,c,d,e) _DECLARE_VECTOR4(a,b,c,d); _DECLARE_VECTOR(e) #define _CONVERT_VECTOR(a) TYPE(mlgsl_vec_of_value)(&v_##a, a) #define _CONVERT_VECTOR2(a,b) _CONVERT_VECTOR(a); _CONVERT_VECTOR(b) #define _CONVERT_VECTOR3(a,b,c) _CONVERT_VECTOR2(a,b); _CONVERT_VECTOR(c) #define _CONVERT_VECTOR4(a,b,c,d) _CONVERT_VECTOR2(a,b); _CONVERT_VECTOR2(c,d) #define _CONVERT_VECTOR5(a,b,c,d,e) _CONVERT_VECTOR4(a,b,c,d); _CONVERT_VECTOR(e) gsl-ocaml-1.19.1/lib/mlgsl_vector_complex.h000066400000000000000000000007641262311274100206350ustar00rootroot00000000000000 #include "wrappers.h" #define BASE_TYPE complex #define CONV_FLAT #define TYPE(t) CONCAT2(t,BASE_TYPE) #define FUNCTION(a,b) CONCAT3(a,BASE_TYPE,b) #include "mlgsl_vector.h" #define _DECLARE_COMPLEX_VECTOR(a) gsl_vector_complex v_##a #define _DECLARE_COMPLEX_VECTOR2(a,b) _DECLARE_COMPLEX_VECTOR(a); _DECLARE_COMPLEX_VECTOR(b) #define _CONVERT_COMPLEX_VECTOR(a) mlgsl_vec_of_value_complex(&v_##a, a) #define _CONVERT_COMPLEX_VECTOR2(a,b) _CONVERT_COMPLEX_VECTOR(a); _CONVERT_COMPLEX_VECTOR(b) gsl-ocaml-1.19.1/lib/mlgsl_vector_complex_float.h000066400000000000000000000002701262311274100220120ustar00rootroot00000000000000 #include "wrappers.h" #define BASE_TYPE complex_float #undef CONV_FLAT #define TYPE(t) CONCAT2(t,BASE_TYPE) #define FUNCTION(a,b) CONCAT3(a,BASE_TYPE,b) #include "mlgsl_vector.h" gsl-ocaml-1.19.1/lib/mlgsl_vector_double.c000066400000000000000000000000751262311274100204260ustar00rootroot00000000000000 #include "mlgsl_vector_double.h" #include "mlgsl_vector.c" gsl-ocaml-1.19.1/lib/mlgsl_vector_double.h000066400000000000000000000001751262311274100204340ustar00rootroot00000000000000 #define BASE_TYPE double #define CONV_FLAT #define TYPE(t) t #define FUNCTION(a,b) a ## _ ## b #include "mlgsl_vector.h" gsl-ocaml-1.19.1/lib/mlgsl_vector_float.c000066400000000000000000000000741262311274100202600ustar00rootroot00000000000000 #include "mlgsl_vector_float.h" #include "mlgsl_vector.c" gsl-ocaml-1.19.1/lib/mlgsl_vector_float.h000066400000000000000000000002571262311274100202700ustar00rootroot00000000000000#include "wrappers.h" #define BASE_TYPE float #undef CONV_FLAT #define TYPE(t) CONCAT2(t,BASE_TYPE) #define FUNCTION(a,b) CONCAT3(a,BASE_TYPE,b) #include "mlgsl_vector.h" gsl-ocaml-1.19.1/lib/mlgsl_wavelet.c000066400000000000000000000061271262311274100172450ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2005-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #include #include #include #include #include #include #include "mlgsl_matrix_double.h" #include "wrappers.h" static const gsl_wavelet_type * gslwavelettype_val (value v) { const gsl_wavelet_type *w_type[] = { gsl_wavelet_daubechies, gsl_wavelet_daubechies_centered, gsl_wavelet_haar, gsl_wavelet_haar_centered, gsl_wavelet_bspline, gsl_wavelet_bspline_centered }; return w_type [ Int_val (v) ] ; } CAMLprim value ml_gsl_wavelet_alloc (value ty, value k) { value r; gsl_wavelet *w; w = gsl_wavelet_alloc (gslwavelettype_val (ty), Long_val (k)); Abstract_ptr (r, w); return r; } #define Wavelet_val(v) (gsl_wavelet *)Field(v, 0) ML1 (gsl_wavelet_free, Wavelet_val, Unit) ML1 (gsl_wavelet_name, Wavelet_val, copy_string) CAMLprim value ml_gsl_wavelet_workspace_alloc (value n) { value r; gsl_wavelet_workspace *ws; ws = gsl_wavelet_workspace_alloc (Long_val (n)); Abstract_ptr (r, ws); return r; } #define WS_val(v) (gsl_wavelet_workspace *)Field(v, 0) CAMLprim value ml_gsl_wavelet_workspace_size (value ws) { return Val_long ((WS_val (ws))->n); } ML1 (gsl_wavelet_workspace_free, WS_val, Unit) static inline gsl_wavelet_direction gsl_direction_val (value v) { static const gsl_wavelet_direction conv[] = { gsl_wavelet_forward, gsl_wavelet_backward }; return conv [ Int_val (v) ]; } static void check_array (value vf) { mlsize_t len = Double_array_length (Field (vf, 0)); size_t off = Long_val (Field (vf, 1)); size_t n = Long_val (Field (vf, 2)); size_t stride = Long_val (Field (vf, 3)); if (off + (n - 1) * stride >= len) GSL_ERROR_VOID ("Inconsistent array specification", GSL_EBADLEN); } CAMLprim value ml_gsl_wavelet_transform (value w, value dir, value vf, value ws) { double *data = Double_array_val (Field (vf, 0)) + Long_val (Field (vf, 1)); size_t n = Long_val (Field (vf, 2)); size_t stride = Long_val (Field (vf, 3)); check_array (vf); gsl_wavelet_transform (Wavelet_val (w), data, stride, n, gsl_direction_val (dir), WS_val (ws)); return Val_unit; } CAMLprim value ml_gsl_wavelet_transform_bigarray (value w, value dir, value b, value ws) { struct caml_bigarray *bigarr = Bigarray_val(b); double *data = bigarr->data; size_t n = bigarr->dim[0]; gsl_wavelet_transform (Wavelet_val (w), data, 1, n, gsl_direction_val (dir), WS_val (ws)); return Val_unit; } /* 2D transforms */ CAMLprim value ml_gsl_wavelet2d_transform_matrix (value w, value ordering, value dir, value a, value ws) { _DECLARE_MATRIX(a); _CONVERT_MATRIX(a); if (Int_val (ordering) == 0) gsl_wavelet2d_transform_matrix (Wavelet_val (w), &m_a, gsl_direction_val (dir), WS_val (ws)); else gsl_wavelet2d_nstransform_matrix (Wavelet_val (w), &m_a, gsl_direction_val (dir), WS_val (ws)); return Val_unit; } gsl-ocaml-1.19.1/lib/wrappers.h000066400000000000000000000057731262311274100162560ustar00rootroot00000000000000/* gsl-ocaml - OCaml interface to GSL */ /* Copyright (©) 2002-2012 - Olivier Andrieu */ /* Distributed under the terms of the GPL version 3 */ #ifndef _MLGSL_WRAPPERS_ #define _MLGSL_WRAPPERS_ #include #include #include #ifdef ARCH_ALIGN_DOUBLE #error "Architectures with double-word alignment for doubles are not supported" #endif #define IS_CUSTOM(v) (Tag_val(v) == Custom_tag) #define Unoption(v) (Field((v), 0)) #define Opt_arg(v, conv, def) (Is_block(v) ? conv(Field((v),0)) : (def)) #define Val_none Val_int(0) #define Val_negbool(x) Val_not(Val_bool(x)) #define Array_length(v) (Wosize_val(v)) #define Double_array_length(v) (Wosize_val(v) / Double_wosize) #define Double_array_val(v) ((double *)v) #define Unit(v) ((v), Val_unit) static inline value copy_two_double(double a, double b) { CAMLparam0(); CAMLlocal3(r, va, vb); va = copy_double(a); vb = copy_double(b); r = alloc_small(2, 0); Field(r, 0) = va; Field(r, 1) = vb; CAMLreturn(r); } static inline value copy_two_double_arr(double a, double b) { value r; r=alloc_small(2 * Double_wosize, Double_array_tag); Store_double_field(r, 0, a); Store_double_field(r, 1, b); return r; } #define Abstract_ptr(v, p) \ ( v=alloc_small(1, Abstract_tag), Field(v, 0)=Val_bp(p) ) #define ML1(name, conv1, convr) \ CAMLprim value ml_##name(value arg1) \ { CAMLparam1(arg1); \ CAMLreturn(convr(name(conv1(arg1)))) ; } #define ML1_alloc(name, conv1, convr) \ CAMLprim value ml_##name(value arg1) \ { CAMLparam1(arg1); CAMLlocal1(res); \ convr(res, name(conv1(arg1))); \ CAMLreturn(res); } #define ML2(name, conv1, conv2, convr) \ CAMLprim value ml_##name(value arg1, value arg2) \ { CAMLparam2(arg1, arg2); \ CAMLreturn(convr(name(conv1(arg1), conv2(arg2)))) ; } #define ML3(name, conv1, conv2, conv3, convr) \ CAMLprim value ml_##name(value arg1, value arg2, value arg3) \ { CAMLparam3(arg1, arg2, arg3); \ CAMLreturn(convr(name(conv1(arg1), conv2(arg2), conv3(arg3)))) ; } #define ML4(name, conv1, conv2, conv3, conv4, convr) \ CAMLprim value ml_##name(value arg1, value arg2, value arg3, value arg4) \ { CAMLparam4(arg1, arg2, arg3, arg4); \ CAMLreturn(convr(name(conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4)))) ; } #define ML5(name, conv1, conv2, conv3, conv4, conv5, convr) \ CAMLprim value ml_##name(value arg1, value arg2, value arg3, value arg4, value arg5) \ { CAMLparam5(arg1, arg2, arg3, arg4, arg5); \ CAMLreturn(convr(name(conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5)))) ; } #define CONCAT2x(a,b) a ## _ ## b #define CONCAT2(a,b) CONCAT2x(a,b) #define CONCAT3x(a,b,c) a ## _ ## b ## _ ## c #define CONCAT3(a,b,c) CONCAT3x(a,b,c) #if defined (__GNUC__) || defined (DONT_USE_ALLOCA) #define LOCALARRAY(type, x, len) type x [(len)] #else #include #define LOCALARRAY(type, x, len) type * x = ( type *) alloca(sizeof( type ) * (len)) #endif #endif /* _MLGSL_WRAPPERS_ */ gsl-ocaml-1.19.1/myocamlbuild.ml000066400000000000000000000515031262311274100164770ustar00rootroot00000000000000(* OASIS_START *) (* DO NOT EDIT (digest: 2afff08725d1be8e5f521ef5d302046f) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) let ns_ str = str let s_ str = str let f_ (str: ('a, 'b, 'c, 'd) format4) = str let fn_ fmt1 fmt2 n = if n = 1 then fmt1^^"" else fmt2^^"" let init = [] end module OASISExpr = struct (* # 22 "src/oasis/OASISExpr.ml" *) open OASISGettext type test = string type flag = string type t = | EBool of bool | ENot of t | EAnd of t * t | EOr of t * t | EFlag of flag | ETest of test * string type 'a choices = (t * 'a) list let eval var_get t = let rec eval' = function | EBool b -> b | ENot e -> not (eval' e) | EAnd (e1, e2) -> (eval' e1) && (eval' e2) | EOr (e1, e2) -> (eval' e1) || (eval' e2) | EFlag nm -> let v = var_get nm in assert(v = "true" || v = "false"); (v = "true") | ETest (nm, vl) -> let v = var_get nm in (v = vl) in eval' t let choose ?printer ?name var_get lst = let rec choose_aux = function | (cond, vl) :: tl -> if eval var_get cond then vl else choose_aux tl | [] -> let str_lst = if lst = [] then s_ "" else String.concat (s_ ", ") (List.map (fun (cond, vl) -> match printer with | Some p -> p vl | None -> s_ "") lst) in match name with | Some nm -> failwith (Printf.sprintf (f_ "No result for the choice list '%s': %s") nm str_lst) | None -> failwith (Printf.sprintf (f_ "No result for a choice list: %s") str_lst) in choose_aux (List.rev lst) end # 132 "myocamlbuild.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) module MapString = Map.Make(String) type t = string MapString.t let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" let load ?(allow_empty=false) ?(filename=default_filename) () = if Sys.file_exists filename then begin let chn = open_in_bin filename in let st = Stream.of_channel chn in let line = ref 1 in let st_line = Stream.from (fun _ -> try match Stream.next st with | '\n' -> incr line; Some '\n' | c -> Some c with Stream.Failure -> None) in let lexer = Genlex.make_lexer ["="] st_line in let rec read_file mp = match Stream.npeek 3 lexer with | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> Stream.junk lexer; Stream.junk lexer; Stream.junk lexer; read_file (MapString.add nm value mp) | [] -> mp | _ -> failwith (Printf.sprintf "Malformed data file '%s' line %d" filename !line) in let mp = read_file MapString.empty in close_in chn; mp end else if allow_empty then begin MapString.empty end else begin failwith (Printf.sprintf "Unable to load environment, the file '%s' doesn't exist." filename) end let rec var_expand str env = let buff = Buffer.create ((String.length str) * 2) in Buffer.add_substitute buff (fun var -> try var_expand (MapString.find var env) env with Not_found -> failwith (Printf.sprintf "No variable %s defined when trying to expand %S." var str)) str; Buffer.contents buff let var_get name env = var_expand (MapString.find name env) env let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst end # 237 "myocamlbuild.ml" module MyOCamlbuildFindlib = struct (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) (** OCamlbuild extension, copied from * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild * by N. Pouillard and others * * Updated on 2009/02/28 * * Modified by Sylvain Le Gall *) open Ocamlbuild_plugin type conf = { no_automatic_syntax: bool; } (* these functions are not really officially exported *) let run_and_read = Ocamlbuild_pack.My_unix.run_and_read let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings let exec_from_conf exec = let exec = let env_filename = Pathname.basename BaseEnvLight.default_filename in let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in try BaseEnvLight.var_get exec env with Not_found -> Printf.eprintf "W: Cannot get variable %s\n" exec; exec in let fix_win32 str = if Sys.os_type = "Win32" then begin let buff = Buffer.create (String.length str) in (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'. *) String.iter (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c)) str; Buffer.contents buff end else begin str end in fix_win32 exec let split s ch = let buf = Buffer.create 13 in let x = ref [] in let flush () = x := (Buffer.contents buf) :: !x; Buffer.clear buf in String.iter (fun c -> if c = ch then flush () else Buffer.add_char buf c) s; flush (); List.rev !x let split_nl s = split s '\n' let before_space s = try String.before s (String.index s ' ') with Not_found -> s (* ocamlfind command *) let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x] (* This lists all supported packages. *) let find_packages () = List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list")) (* Mock to list available syntaxes. *) let find_syntaxes () = ["camlp4o"; "camlp4r"] let well_known_syntax = [ "camlp4.quotations.o"; "camlp4.quotations.r"; "camlp4.exceptiontracer"; "camlp4.extend"; "camlp4.foldgenerator"; "camlp4.listcomprehension"; "camlp4.locationstripper"; "camlp4.macro"; "camlp4.mapgenerator"; "camlp4.metagenerator"; "camlp4.profiler"; "camlp4.tracer" ] let dispatch conf = function | After_options -> (* By using Before_options one let command line options have an higher * priority on the contrary using After_options will guarantee to have * the higher priority override default commands by ocamlfind ones *) Options.ocamlc := ocamlfind & A"ocamlc"; Options.ocamlopt := ocamlfind & A"ocamlopt"; Options.ocamldep := ocamlfind & A"ocamldep"; Options.ocamldoc := ocamlfind & A"ocamldoc"; Options.ocamlmktop := ocamlfind & A"ocamlmktop"; Options.ocamlmklib := ocamlfind & A"ocamlmklib" | After_rules -> (* When one link an OCaml library/binary/package, one should use * -linkpkg *) flag ["ocaml"; "link"; "program"] & A"-linkpkg"; if not (conf.no_automatic_syntax) then begin (* For each ocamlfind package one inject the -package option when * compiling, computing dependencies, generating documentation and * linking. *) List.iter begin fun pkg -> let base_args = [A"-package"; A pkg] in (* TODO: consider how to really choose camlp4o or camlp4r. *) let syn_args = [A"-syntax"; A "camlp4o"] in let (args, pargs) = (* Heuristic to identify syntax extensions: whether they end in ".syntax"; some might not. *) if Filename.check_suffix pkg "syntax" || List.mem pkg well_known_syntax then (syn_args @ base_args, syn_args) else (base_args, []) in flag ["ocaml"; "compile"; "pkg_"^pkg] & S args; flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args; flag ["ocaml"; "doc"; "pkg_"^pkg] & S args; flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args; flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args; (* TODO: Check if this is allowed for OCaml < 3.12.1 *) flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs; flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs; flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs; flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs; end (find_packages ()); end; (* Like -package but for extensions syntax. Morover -syntax is useless * when linking. *) List.iter begin fun syntax -> flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; end (find_syntaxes ()); (* The default "thread" tag is not compatible with ocamlfind. * Indeed, the default rules add the "threads.cma" or "threads.cmxa" * options when using this tag. When using the "-linkpkg" option with * ocamlfind, this module will then be added twice on the command line. * * To solve this, one approach is to add the "-thread" option when using * the "threads" package using the previous plugin. *) flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]); flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]); flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]); flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]); flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]); | _ -> () end module MyOCamlbuildBase = struct (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) (** Base functions for writing myocamlbuild.ml @author Sylvain Le Gall *) open Ocamlbuild_plugin module OC = Ocamlbuild_pack.Ocaml_compiler type dir = string type file = string type name = string type tag = string (* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) type t = { lib_ocaml: (name * dir list * string list) list; lib_c: (name * dir * file list) list; flags: (tag list * (spec OASISExpr.choices)) list; (* Replace the 'dir: include' from _tags by a precise interdepends in * directory. *) includes: (dir * dir list) list; } let env_filename = Pathname.basename BaseEnvLight.default_filename let dispatch_combine lst = fun e -> List.iter (fun dispatch -> dispatch e) lst let tag_libstubs nm = "use_lib"^nm^"_stubs" let nm_libstubs nm = nm^"_stubs" let dispatch t e = let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in match e with | Before_options -> let no_trailing_dot s = if String.length s >= 1 && s.[0] = '.' then String.sub s 1 ((String.length s) - 1) else s in List.iter (fun (opt, var) -> try opt := no_trailing_dot (BaseEnvLight.var_get var env) with Not_found -> Printf.eprintf "W: Cannot get variable %s\n" var) [ Options.ext_obj, "ext_obj"; Options.ext_lib, "ext_lib"; Options.ext_dll, "ext_dll"; ] | After_rules -> (* Declare OCaml libraries *) List.iter (function | nm, [], intf_modules -> ocaml_lib nm; let cmis = List.map (fun m -> (String.uncapitalize m) ^ ".cmi") intf_modules in dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis | nm, dir :: tl, intf_modules -> ocaml_lib ~dir:dir (dir^"/"^nm); List.iter (fun dir -> List.iter (fun str -> flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) ["compile"; "infer_interface"; "doc"]) tl; let cmis = List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi") intf_modules in dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] cmis) t.lib_ocaml; (* Declare directories dependencies, replace "include" in _tags. *) List.iter (fun (dir, include_dirs) -> Pathname.define_context dir include_dirs) t.includes; (* Declare C libraries *) List.iter (fun (lib, dir, headers) -> (* Handle C part of library *) flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; A("-l"^(nm_libstubs lib))]); flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] (S[A"-cclib"; A("-l"^(nm_libstubs lib))]); flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib] (S[A"-dllib"; A("dll"^(nm_libstubs lib))]); (* When ocaml link something that use the C library, then one need that file to be up to date. This holds both for programs and for libraries. *) dep ["link"; "ocaml"; tag_libstubs lib] [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; dep ["compile"; "ocaml"; tag_libstubs lib] [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; (* TODO: be more specific about what depends on headers *) (* Depends on .h files *) dep ["compile"; "c"] headers; (* Setup search path for lib *) flag ["link"; "ocaml"; "use_"^lib] (S[A"-I"; P(dir)]); ) t.lib_c; (* Add flags *) List.iter (fun (tags, cond_specs) -> let spec = BaseEnvLight.var_choose cond_specs env in let rec eval_specs = function | S lst -> S (List.map eval_specs lst) | A str -> A (BaseEnvLight.var_expand str env) | spec -> spec in flag tags & (eval_specs spec)) t.flags | _ -> () let dispatch_default conf t = dispatch_combine [ dispatch t; MyOCamlbuildFindlib.dispatch conf; ] end # 606 "myocamlbuild.ml" open Ocamlbuild_plugin;; let package_default = { MyOCamlbuildBase.lib_ocaml = [("gsl", ["lib"], [])]; lib_c = [ ("gsl", "lib", [ "lib/io.h"; "lib/mlgsl_blas.h"; "lib/mlgsl_complex.h"; "lib/mlgsl_fun.h"; "lib/mlgsl_matrix.h"; "lib/mlgsl_matrix_complex.h"; "lib/mlgsl_matrix_complex_float.h"; "lib/mlgsl_matrix_double.h"; "lib/mlgsl_matrix_float.h"; "lib/mlgsl_permut.h"; "lib/mlgsl_rng.h"; "lib/mlgsl_vector.h"; "lib/mlgsl_vector_complex.h"; "lib/mlgsl_vector_complex_float.h"; "lib/mlgsl_vector_double.h"; "lib/mlgsl_vector_float.h"; "lib/wrappers.h" ]) ]; flags = [ (["oasis_library_gsl_ccopt"; "compile"], [ (OASISExpr.EBool true, S [ A "-ccopt"; A "-g"; A "-ccopt"; A "-O2"; A "-ccopt"; A "-fPIC"; A "-ccopt"; A "-DPIC" ]); (OASISExpr.EAnd (OASISExpr.EFlag "strict", OASISExpr.ETest ("ccomp_type", "cc")), S [ A "-ccopt"; A "-g"; A "-ccopt"; A "-O2"; A "-ccopt"; A "-fPIC"; A "-ccopt"; A "-DPIC"; A "-ccopt"; A "-Wall"; A "-ccopt"; A "-Wunused"; A "-ccopt"; A "-Wno-long-long" ]) ]); (["oasis_library_gsl_cclib"; "link"], [ (OASISExpr.EBool true, S []); (OASISExpr.ETest ("system", "macosx"), S [A "-cclib"; A "-framework"; A "-cclib"; A "Accelerate"]) ]); (["oasis_library_gsl_cclib"; "ocamlmklib"; "c"], [ (OASISExpr.EBool true, S []); (OASISExpr.ETest ("system", "macosx"), S [A "-framework"; A "Accelerate"]) ]) ]; includes = [("examples", ["lib"])] } ;; let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; # 694 "myocamlbuild.ml" (* OASIS_STOP *) let () = let additional_rules = function | After_rules -> (* Add correct GSL compilation and link flags *) let gsl_clibs, ogsl_cflags, ogsl_clibs = let ic = Unix.open_process_in "gsl-config --cflags --libs" in try let gsl_cflags = input_line ic in let gsl_clibs = input_line ic in (* TODO: remove once split-function in generated code is fixed *) let rec split_string s = match try Some (String.index s ' ') with Not_found -> None with | Some pos -> String.before s pos :: split_string (String.after s (pos + 1)) | None -> [s] in let ocamlify ~ocaml_flag flags = let chunks = split_string flags in let cnv flag = [A ocaml_flag; A flag] in List.concat (List.map cnv chunks) in let split_flags flags = let chunks = split_string flags in let cnv flag = A flag in List.map cnv chunks in close_in ic; S (split_flags gsl_clibs), S (ocamlify ~ocaml_flag:"-ccopt" gsl_cflags), S (ocamlify ~ocaml_flag:"-cclib" gsl_clibs) with exn -> close_in ic; raise exn in flag ["compile"; "c"] ogsl_cflags; flag ["link"; "ocaml"; "library"] ogsl_clibs; flag ["oasis_library_gsl_cclib"; "ocamlmklib"; "c"] gsl_clibs; flag ["oasis_library_gsl_cclib"; "link"] ogsl_clibs | _ -> () in dispatch ( MyOCamlbuildBase.dispatch_combine [dispatch_default; additional_rules]) gsl-ocaml-1.19.1/setup.ml000066400000000000000000006776431262311274100152010ustar00rootroot00000000000000(* setup.ml generated for the first time by OASIS v0.3.0~rc6 *) (* OASIS_START *) (* DO NOT EDIT (digest: e049c1e4aca5ea161da383c3b8c07211) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) let ns_ str = str let s_ str = str let f_ (str: ('a, 'b, 'c, 'd) format4) = str let fn_ fmt1 fmt2 n = if n = 1 then fmt1^^"" else fmt2^^"" let init = [] end module OASISContext = struct (* # 22 "src/oasis/OASISContext.ml" *) open OASISGettext type level = [ `Debug | `Info | `Warning | `Error] type t = { (* TODO: replace this by a proplist. *) quiet: bool; info: bool; debug: bool; ignore_plugins: bool; ignore_unknown_fields: bool; printf: level -> string -> unit; } let printf lvl str = let beg = match lvl with | `Error -> s_ "E: " | `Warning -> s_ "W: " | `Info -> s_ "I: " | `Debug -> s_ "D: " in prerr_endline (beg^str) let default = ref { quiet = false; info = false; debug = false; ignore_plugins = false; ignore_unknown_fields = false; printf = printf; } let quiet = {!default with quiet = true} let fspecs () = (* TODO: don't act on default. *) let ignore_plugins = ref false in ["-quiet", Arg.Unit (fun () -> default := {!default with quiet = true}), s_ " Run quietly"; "-info", Arg.Unit (fun () -> default := {!default with info = true}), s_ " Display information message"; "-debug", Arg.Unit (fun () -> default := {!default with debug = true}), s_ " Output debug message"; "-ignore-plugins", Arg.Set ignore_plugins, s_ " Ignore plugin's field."; "-C", (* TODO: remove this chdir. *) Arg.String (fun str -> Sys.chdir str), s_ "dir Change directory before running."], fun () -> {!default with ignore_plugins = !ignore_plugins} end module OASISString = struct (* # 22 "src/oasis/OASISString.ml" *) (** Various string utilities. Mostly inspired by extlib and batteries ExtString and BatString libraries. @author Sylvain Le Gall *) let nsplitf str f = if str = "" then [] else let buf = Buffer.create 13 in let lst = ref [] in let push () = lst := Buffer.contents buf :: !lst; Buffer.clear buf in let str_len = String.length str in for i = 0 to str_len - 1 do if f str.[i] then push () else Buffer.add_char buf str.[i] done; push (); List.rev !lst (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the separator. *) let nsplit str c = nsplitf str ((=) c) let find ~what ?(offset=0) str = let what_idx = ref 0 in let str_idx = ref offset in while !str_idx < String.length str && !what_idx < String.length what do if str.[!str_idx] = what.[!what_idx] then incr what_idx else what_idx := 0; incr str_idx done; if !what_idx <> String.length what then raise Not_found else !str_idx - !what_idx let sub_start str len = let str_len = String.length str in if len >= str_len then "" else String.sub str len (str_len - len) let sub_end ?(offset=0) str len = let str_len = String.length str in if len >= str_len then "" else String.sub str 0 (str_len - len) let starts_with ~what ?(offset=0) str = let what_idx = ref 0 in let str_idx = ref offset in let ok = ref true in while !ok && !str_idx < String.length str && !what_idx < String.length what do if str.[!str_idx] = what.[!what_idx] then incr what_idx else ok := false; incr str_idx done; if !what_idx = String.length what then true else false let strip_starts_with ~what str = if starts_with ~what str then sub_start str (String.length what) else raise Not_found let ends_with ~what ?(offset=0) str = let what_idx = ref ((String.length what) - 1) in let str_idx = ref ((String.length str) - 1) in let ok = ref true in while !ok && offset <= !str_idx && 0 <= !what_idx do if str.[!str_idx] = what.[!what_idx] then decr what_idx else ok := false; decr str_idx done; if !what_idx = -1 then true else false let strip_ends_with ~what str = if ends_with ~what str then sub_end str (String.length what) else raise Not_found let replace_chars f s = let buf = Buffer.create (String.length s) in String.iter (fun c -> Buffer.add_char buf (f c)) s; Buffer.contents buf end module OASISUtils = struct (* # 22 "src/oasis/OASISUtils.ml" *) open OASISGettext module MapExt = struct module type S = sig include Map.S val add_list: 'a t -> (key * 'a) list -> 'a t val of_list: (key * 'a) list -> 'a t val to_list: 'a t -> (key * 'a) list end module Make (Ord: Map.OrderedType) = struct include Map.Make(Ord) let rec add_list t = function | (k, v) :: tl -> add_list (add k v t) tl | [] -> t let of_list lst = add_list empty lst let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] end end module MapString = MapExt.Make(String) module SetExt = struct module type S = sig include Set.S val add_list: t -> elt list -> t val of_list: elt list -> t val to_list: t -> elt list end module Make (Ord: Set.OrderedType) = struct include Set.Make(Ord) let rec add_list t = function | e :: tl -> add_list (add e t) tl | [] -> t let of_list lst = add_list empty lst let to_list = elements end end module SetString = SetExt.Make(String) let compare_csl s1 s2 = String.compare (String.lowercase s1) (String.lowercase s2) module HashStringCsl = Hashtbl.Make (struct type t = string let equal s1 s2 = (String.lowercase s1) = (String.lowercase s2) let hash s = Hashtbl.hash (String.lowercase s) end) module SetStringCsl = SetExt.Make (struct type t = string let compare = compare_csl end) let varname_of_string ?(hyphen='_') s = if String.length s = 0 then begin invalid_arg "varname_of_string" end else begin let buf = OASISString.replace_chars (fun c -> if ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') || ('0' <= c && c <= '9') then c else hyphen) s; in let buf = (* Start with a _ if digit *) if '0' <= s.[0] && s.[0] <= '9' then "_"^buf else buf in String.lowercase buf end let varname_concat ?(hyphen='_') p s = let what = String.make 1 hyphen in let p = try OASISString.strip_ends_with ~what p with Not_found -> p in let s = try OASISString.strip_starts_with ~what s with Not_found -> s in p^what^s let is_varname str = str = varname_of_string str let failwithf fmt = Printf.ksprintf failwith fmt end module PropList = struct (* # 22 "src/oasis/PropList.ml" *) open OASISGettext type name = string exception Not_set of name * string option exception No_printer of name exception Unknown_field of name * name let () = Printexc.register_printer (function | Not_set (nm, Some rsn) -> Some (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn) | Not_set (nm, None) -> Some (Printf.sprintf (f_ "Field '%s' is not set") nm) | No_printer nm -> Some (Printf.sprintf (f_ "No default printer for value %s") nm) | Unknown_field (nm, schm) -> Some (Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm) | _ -> None) module Data = struct type t = (name, unit -> unit) Hashtbl.t let create () = Hashtbl.create 13 let clear t = Hashtbl.clear t (* # 78 "src/oasis/PropList.ml" *) end module Schema = struct type ('ctxt, 'extra) value = { get: Data.t -> string; set: Data.t -> ?context:'ctxt -> string -> unit; help: (unit -> string) option; extra: 'extra; } type ('ctxt, 'extra) t = { name: name; fields: (name, ('ctxt, 'extra) value) Hashtbl.t; order: name Queue.t; name_norm: string -> string; } let create ?(case_insensitive=false) nm = { name = nm; fields = Hashtbl.create 13; order = Queue.create (); name_norm = (if case_insensitive then String.lowercase else fun s -> s); } let add t nm set get extra help = let key = t.name_norm nm in if Hashtbl.mem t.fields key then failwith (Printf.sprintf (f_ "Field '%s' is already defined in schema '%s'") nm t.name); Hashtbl.add t.fields key { set = set; get = get; help = help; extra = extra; }; Queue.add nm t.order let mem t nm = Hashtbl.mem t.fields nm let find t nm = try Hashtbl.find t.fields (t.name_norm nm) with Not_found -> raise (Unknown_field (nm, t.name)) let get t data nm = (find t nm).get data let set t data nm ?context x = (find t nm).set data ?context x let fold f acc t = Queue.fold (fun acc k -> let v = find t k in f acc k v.extra v.help) acc t.order let iter f t = fold (fun () -> f) () t let name t = t.name end module Field = struct type ('ctxt, 'value, 'extra) t = { set: Data.t -> ?context:'ctxt -> 'value -> unit; get: Data.t -> 'value; sets: Data.t -> ?context:'ctxt -> string -> unit; gets: Data.t -> string; help: (unit -> string) option; extra: 'extra; } let new_id = let last_id = ref 0 in fun () -> incr last_id; !last_id let create ?schema ?name ?parse ?print ?default ?update ?help extra = (* Default value container *) let v = ref None in (* If name is not given, create unique one *) let nm = match name with | Some s -> s | None -> Printf.sprintf "_anon_%d" (new_id ()) in (* Last chance to get a value: the default *) let default () = match default with | Some d -> d | None -> raise (Not_set (nm, Some (s_ "no default value"))) in (* Get data *) let get data = (* Get value *) try (Hashtbl.find data nm) (); match !v with | Some x -> x | None -> default () with Not_found -> default () in (* Set data *) let set data ?context x = let x = match update with | Some f -> begin try f ?context (get data) x with Not_set _ -> x end | None -> x in Hashtbl.replace data nm (fun () -> v := Some x) in (* Parse string value, if possible *) let parse = match parse with | Some f -> f | None -> fun ?context s -> failwith (Printf.sprintf (f_ "Cannot parse field '%s' when setting value %S") nm s) in (* Set data, from string *) let sets data ?context s = set ?context data (parse ?context s) in (* Output value as string, if possible *) let print = match print with | Some f -> f | None -> fun _ -> raise (No_printer nm) in (* Get data, as a string *) let gets data = print (get data) in begin match schema with | Some t -> Schema.add t nm sets gets extra help | None -> () end; { set = set; get = get; sets = sets; gets = gets; help = help; extra = extra; } let fset data t ?context x = t.set data ?context x let fget data t = t.get data let fsets data t ?context s = t.sets data ?context s let fgets data t = t.gets data end module FieldRO = struct let create ?schema ?name ?parse ?print ?default ?update ?help extra = let fld = Field.create ?schema ?name ?parse ?print ?default ?update ?help extra in fun data -> Field.fget data fld end end module OASISMessage = struct (* # 22 "src/oasis/OASISMessage.ml" *) open OASISGettext open OASISContext let generic_message ~ctxt lvl fmt = let cond = if ctxt.quiet then false else match lvl with | `Debug -> ctxt.debug | `Info -> ctxt.info | _ -> true in Printf.ksprintf (fun str -> if cond then begin ctxt.printf lvl str end) fmt let debug ~ctxt fmt = generic_message ~ctxt `Debug fmt let info ~ctxt fmt = generic_message ~ctxt `Info fmt let warning ~ctxt fmt = generic_message ~ctxt `Warning fmt let error ~ctxt fmt = generic_message ~ctxt `Error fmt end module OASISVersion = struct (* # 22 "src/oasis/OASISVersion.ml" *) open OASISGettext type s = string type t = string type comparator = | VGreater of t | VGreaterEqual of t | VEqual of t | VLesser of t | VLesserEqual of t | VOr of comparator * comparator | VAnd of comparator * comparator (* Range of allowed characters *) let is_digit c = '0' <= c && c <= '9' let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false let rec version_compare v1 v2 = if v1 <> "" || v2 <> "" then begin (* Compare ascii string, using special meaning for version * related char *) let val_ascii c = if c = '~' then -1 else if is_digit c then 0 else if c = '\000' then 0 else if is_alpha c then Char.code c else (Char.code c) + 256 in let len1 = String.length v1 in let len2 = String.length v2 in let p = ref 0 in (** Compare ascii part *) let compare_vascii () = let cmp = ref 0 in while !cmp = 0 && !p < len1 && !p < len2 && not (is_digit v1.[!p] && is_digit v2.[!p]) do cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]); incr p done; if !cmp = 0 && !p < len1 && !p = len2 then val_ascii v1.[!p] else if !cmp = 0 && !p = len1 && !p < len2 then - (val_ascii v2.[!p]) else !cmp in (** Compare digit part *) let compare_digit () = let extract_int v p = let start_p = !p in while !p < String.length v && is_digit v.[!p] do incr p done; let substr = String.sub v !p ((String.length v) - !p) in let res = match String.sub v start_p (!p - start_p) with | "" -> 0 | s -> int_of_string s in res, substr in let i1, tl1 = extract_int v1 (ref !p) in let i2, tl2 = extract_int v2 (ref !p) in i1 - i2, tl1, tl2 in match compare_vascii () with | 0 -> begin match compare_digit () with | 0, tl1, tl2 -> if tl1 <> "" && is_digit tl1.[0] then 1 else if tl2 <> "" && is_digit tl2.[0] then -1 else version_compare tl1 tl2 | n, _, _ -> n end | n -> n end else begin 0 end let version_of_string str = str let string_of_version t = t let version_compare_string s1 s2 = version_compare (version_of_string s1) (version_of_string s2) let chop t = try let pos = String.rindex t '.' in String.sub t 0 pos with Not_found -> t let rec comparator_apply v op = match op with | VGreater cv -> (version_compare v cv) > 0 | VGreaterEqual cv -> (version_compare v cv) >= 0 | VLesser cv -> (version_compare v cv) < 0 | VLesserEqual cv -> (version_compare v cv) <= 0 | VEqual cv -> (version_compare v cv) = 0 | VOr (op1, op2) -> (comparator_apply v op1) || (comparator_apply v op2) | VAnd (op1, op2) -> (comparator_apply v op1) && (comparator_apply v op2) let rec string_of_comparator = function | VGreater v -> "> "^(string_of_version v) | VEqual v -> "= "^(string_of_version v) | VLesser v -> "< "^(string_of_version v) | VGreaterEqual v -> ">= "^(string_of_version v) | VLesserEqual v -> "<= "^(string_of_version v) | VOr (c1, c2) -> (string_of_comparator c1)^" || "^(string_of_comparator c2) | VAnd (c1, c2) -> (string_of_comparator c1)^" && "^(string_of_comparator c2) let rec varname_of_comparator = let concat p v = OASISUtils.varname_concat p (OASISUtils.varname_of_string (string_of_version v)) in function | VGreater v -> concat "gt" v | VLesser v -> concat "lt" v | VEqual v -> concat "eq" v | VGreaterEqual v -> concat "ge" v | VLesserEqual v -> concat "le" v | VOr (c1, c2) -> (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2) | VAnd (c1, c2) -> (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) let rec comparator_ge v' = let cmp v = version_compare v v' >= 0 in function | VEqual v | VGreaterEqual v | VGreater v -> cmp v | VLesserEqual _ | VLesser _ -> false | VOr (c1, c2) -> comparator_ge v' c1 || comparator_ge v' c2 | VAnd (c1, c2) -> comparator_ge v' c1 && comparator_ge v' c2 end module OASISLicense = struct (* # 22 "src/oasis/OASISLicense.ml" *) (** License for _oasis fields @author Sylvain Le Gall *) type license = string type license_exception = string type license_version = | Version of OASISVersion.t | VersionOrLater of OASISVersion.t | NoVersion type license_dep_5_unit = { license: license; excption: license_exception option; version: license_version; } type license_dep_5 = | DEP5Unit of license_dep_5_unit | DEP5Or of license_dep_5 list | DEP5And of license_dep_5 list type t = | DEP5License of license_dep_5 | OtherLicense of string (* URL *) end module OASISExpr = struct (* # 22 "src/oasis/OASISExpr.ml" *) open OASISGettext type test = string type flag = string type t = | EBool of bool | ENot of t | EAnd of t * t | EOr of t * t | EFlag of flag | ETest of test * string type 'a choices = (t * 'a) list let eval var_get t = let rec eval' = function | EBool b -> b | ENot e -> not (eval' e) | EAnd (e1, e2) -> (eval' e1) && (eval' e2) | EOr (e1, e2) -> (eval' e1) || (eval' e2) | EFlag nm -> let v = var_get nm in assert(v = "true" || v = "false"); (v = "true") | ETest (nm, vl) -> let v = var_get nm in (v = vl) in eval' t let choose ?printer ?name var_get lst = let rec choose_aux = function | (cond, vl) :: tl -> if eval var_get cond then vl else choose_aux tl | [] -> let str_lst = if lst = [] then s_ "" else String.concat (s_ ", ") (List.map (fun (cond, vl) -> match printer with | Some p -> p vl | None -> s_ "") lst) in match name with | Some nm -> failwith (Printf.sprintf (f_ "No result for the choice list '%s': %s") nm str_lst) | None -> failwith (Printf.sprintf (f_ "No result for a choice list: %s") str_lst) in choose_aux (List.rev lst) end module OASISText = struct (* # 22 "src/oasis/OASISText.ml" *) type elt = | Para of string | Verbatim of string | BlankLine type t = elt list end module OASISTypes = struct (* # 22 "src/oasis/OASISTypes.ml" *) type name = string type package_name = string type url = string type unix_dirname = string type unix_filename = string type host_dirname = string type host_filename = string type prog = string type arg = string type args = string list type command_line = (prog * arg list) type findlib_name = string type findlib_full = string type compiled_object = | Byte | Native | Best type dependency = | FindlibPackage of findlib_full * OASISVersion.comparator option | InternalLibrary of name type tool = | ExternalTool of name | InternalExecutable of name type vcs = | Darcs | Git | Svn | Cvs | Hg | Bzr | Arch | Monotone | OtherVCS of url type plugin_kind = [ `Configure | `Build | `Doc | `Test | `Install | `Extra ] type plugin_data_purpose = [ `Configure | `Build | `Install | `Clean | `Distclean | `Install | `Uninstall | `Test | `Doc | `Extra | `Other of string ] type 'a plugin = 'a * name * OASISVersion.t option type all_plugin = plugin_kind plugin type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list (* # 115 "src/oasis/OASISTypes.ml" *) type 'a conditional = 'a OASISExpr.choices type custom = { pre_command: (command_line option) conditional; post_command: (command_line option) conditional; } type common_section = { cs_name: name; cs_data: PropList.Data.t; cs_plugin_data: plugin_data; } type build_section = { bs_build: bool conditional; bs_install: bool conditional; bs_path: unix_dirname; bs_compiled_object: compiled_object; bs_build_depends: dependency list; bs_build_tools: tool list; bs_c_sources: unix_filename list; bs_data_files: (unix_filename * unix_filename option) list; bs_ccopt: args conditional; bs_cclib: args conditional; bs_dlllib: args conditional; bs_dllpath: args conditional; bs_byteopt: args conditional; bs_nativeopt: args conditional; } type library = { lib_modules: string list; lib_pack: bool; lib_internal_modules: string list; lib_findlib_parent: findlib_name option; lib_findlib_name: findlib_name option; lib_findlib_containers: findlib_name list; } type object_ = { obj_modules: string list; obj_findlib_fullname: findlib_name list option; } type executable = { exec_custom: bool; exec_main_is: unix_filename; } type flag = { flag_description: string option; flag_default: bool conditional; } type source_repository = { src_repo_type: vcs; src_repo_location: url; src_repo_browser: url option; src_repo_module: string option; src_repo_branch: string option; src_repo_tag: string option; src_repo_subdir: unix_filename option; } type test = { test_type: [`Test] plugin; test_command: command_line conditional; test_custom: custom; test_working_directory: unix_filename option; test_run: bool conditional; test_tools: tool list; } type doc_format = | HTML of unix_filename | DocText | PDF | PostScript | Info of unix_filename | DVI | OtherDoc type doc = { doc_type: [`Doc] plugin; doc_custom: custom; doc_build: bool conditional; doc_install: bool conditional; doc_install_dir: unix_filename; doc_title: string; doc_authors: string list; doc_abstract: string option; doc_format: doc_format; doc_data_files: (unix_filename * unix_filename option) list; doc_build_tools: tool list; } type section = | Library of common_section * build_section * library | Object of common_section * build_section * object_ | Executable of common_section * build_section * executable | Flag of common_section * flag | SrcRepo of common_section * source_repository | Test of common_section * test | Doc of common_section * doc type section_kind = [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ] type package = { oasis_version: OASISVersion.t; ocaml_version: OASISVersion.comparator option; findlib_version: OASISVersion.comparator option; alpha_features: string list; beta_features: string list; name: package_name; version: OASISVersion.t; license: OASISLicense.t; license_file: unix_filename option; copyrights: string list; maintainers: string list; authors: string list; homepage: url option; synopsis: string; description: OASISText.t option; categories: url list; conf_type: [`Configure] plugin; conf_custom: custom; build_type: [`Build] plugin; build_custom: custom; install_type: [`Install] plugin; install_custom: custom; uninstall_custom: custom; clean_custom: custom; distclean_custom: custom; files_ab: unix_filename list; sections: section list; plugins: [`Extra] plugin list; disable_oasis_section: unix_filename list; schema_data: PropList.Data.t; plugin_data: plugin_data; } end module OASISFeatures = struct (* # 22 "src/oasis/OASISFeatures.ml" *) open OASISTypes open OASISUtils open OASISGettext open OASISVersion module MapPlugin = Map.Make (struct type t = plugin_kind * name let compare = Pervasives.compare end) module Data = struct type t = { oasis_version: OASISVersion.t; plugin_versions: OASISVersion.t option MapPlugin.t; alpha_features: string list; beta_features: string list; } let create oasis_version alpha_features beta_features = { oasis_version = oasis_version; plugin_versions = MapPlugin.empty; alpha_features = alpha_features; beta_features = beta_features } let of_package pkg = create pkg.OASISTypes.oasis_version pkg.OASISTypes.alpha_features pkg.OASISTypes.beta_features let add_plugin (plugin_kind, plugin_name, plugin_version) t = {t with plugin_versions = MapPlugin.add (plugin_kind, plugin_name) plugin_version t.plugin_versions} let plugin_version plugin_kind plugin_name t = MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions let to_string t = Printf.sprintf "oasis_version: %s; alpha_features: %s; beta_features: %s; \ plugins_version: %s" (OASISVersion.string_of_version t.oasis_version) (String.concat ", " t.alpha_features) (String.concat ", " t.beta_features) (String.concat ", " (MapPlugin.fold (fun (_, plg) ver_opt acc -> (plg^ (match ver_opt with | Some v -> " "^(OASISVersion.string_of_version v) | None -> "")) :: acc) t.plugin_versions [])) end type origin = | Field of string * string | Section of string | NoOrigin type stage = Alpha | Beta let string_of_stage = function | Alpha -> "alpha" | Beta -> "beta" let field_of_stage = function | Alpha -> "AlphaFeatures" | Beta -> "BetaFeatures" type publication = InDev of stage | SinceVersion of OASISVersion.t type t = { name: string; plugin: all_plugin option; publication: publication; description: unit -> string; } (* TODO: mutex protect this. *) let all_features = Hashtbl.create 13 let since_version ver_str = SinceVersion (version_of_string ver_str) let alpha = InDev Alpha let beta = InDev Beta let to_string t = Printf.sprintf "feature: %s; plugin: %s; publication: %s" t.name (match t.plugin with | None -> "" | Some (_, nm, _) -> nm) (match t.publication with | InDev stage -> string_of_stage stage | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver)) let data_check t data origin = let no_message = "no message" in let check_feature features stage = let has_feature = List.mem t.name features in if not has_feature then match origin with | Field (fld, where) -> Some (Printf.sprintf (f_ "Field %s in %s is only available when feature %s \ is in field %s.") fld where t.name (field_of_stage stage)) | Section sct -> Some (Printf.sprintf (f_ "Section %s is only available when features %s \ is in field %s.") sct t.name (field_of_stage stage)) | NoOrigin -> Some no_message else None in let version_is_good ~min_version version fmt = let version_is_good = OASISVersion.comparator_apply version (OASISVersion.VGreaterEqual min_version) in Printf.ksprintf (fun str -> if version_is_good then None else Some str) fmt in match origin, t.plugin, t.publication with | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha | _, _, InDev Beta -> check_feature data.Data.beta_features Beta | Field(fld, where), None, SinceVersion min_version -> version_is_good ~min_version data.Data.oasis_version (f_ "Field %s in %s is only valid since OASIS v%s, update \ OASISFormat field from '%s' to '%s' after checking \ OASIS changelog.") fld where (string_of_version min_version) (string_of_version data.Data.oasis_version) (string_of_version min_version) | Field(fld, where), Some(plugin_knd, plugin_name, _), SinceVersion min_version -> begin try let plugin_version_current = try match Data.plugin_version plugin_knd plugin_name data with | Some ver -> ver | None -> failwithf (f_ "Field %s in %s is only valid for the OASIS \ plugin %s since v%s, but no plugin version is \ defined in the _oasis file, change '%s' to \ '%s (%s)' in your _oasis file.") fld where plugin_name (string_of_version min_version) plugin_name plugin_name (string_of_version min_version) with Not_found -> failwithf (f_ "Field %s in %s is only valid when the OASIS plugin %s \ is defined.") fld where plugin_name in version_is_good ~min_version plugin_version_current (f_ "Field %s in %s is only valid for the OASIS plugin %s \ since v%s, update your plugin from '%s (%s)' to \ '%s (%s)' after checking the plugin's changelog.") fld where plugin_name (string_of_version min_version) plugin_name (string_of_version plugin_version_current) plugin_name (string_of_version min_version) with Failure msg -> Some msg end | Section sct, None, SinceVersion min_version -> version_is_good ~min_version data.Data.oasis_version (f_ "Section %s is only valid for since OASIS v%s, update \ OASISFormat field from '%s' to '%s' after checking OASIS \ changelog.") sct (string_of_version min_version) (string_of_version data.Data.oasis_version) (string_of_version min_version) | Section sct, Some(plugin_knd, plugin_name, _), SinceVersion min_version -> begin try let plugin_version_current = try match Data.plugin_version plugin_knd plugin_name data with | Some ver -> ver | None -> failwithf (f_ "Section %s is only valid for the OASIS \ plugin %s since v%s, but no plugin version is \ defined in the _oasis file, change '%s' to \ '%s (%s)' in your _oasis file.") sct plugin_name (string_of_version min_version) plugin_name plugin_name (string_of_version min_version) with Not_found -> failwithf (f_ "Section %s is only valid when the OASIS plugin %s \ is defined.") sct plugin_name in version_is_good ~min_version plugin_version_current (f_ "Section %s is only valid for the OASIS plugin %s \ since v%s, update your plugin from '%s (%s)' to \ '%s (%s)' after checking the plugin's changelog.") sct plugin_name (string_of_version min_version) plugin_name (string_of_version plugin_version_current) plugin_name (string_of_version min_version) with Failure msg -> Some msg end | NoOrigin, None, SinceVersion min_version -> version_is_good ~min_version data.Data.oasis_version "%s" no_message | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version -> begin try let plugin_version_current = match Data.plugin_version plugin_knd plugin_name data with | Some ver -> ver | None -> raise Not_found in version_is_good ~min_version plugin_version_current "%s" no_message with Not_found -> Some no_message end let data_assert t data origin = match data_check t data origin with | None -> () | Some str -> failwith str let data_test t data = match data_check t data NoOrigin with | None -> true | Some str -> false let package_test t pkg = data_test t (Data.of_package pkg) let create ?plugin name publication description = let () = if Hashtbl.mem all_features name then failwithf "Feature '%s' is already declared." name in let t = { name = name; plugin = plugin; publication = publication; description = description; } in Hashtbl.add all_features name t; t let get_stage name = try (Hashtbl.find all_features name).publication with Not_found -> failwithf (f_ "Feature %s doesn't exist.") name let list () = Hashtbl.fold (fun _ v acc -> v :: acc) all_features [] (* * Real flags. *) let features = create "features_fields" (since_version "0.4") (fun () -> s_ "Enable to experiment not yet official features.") let flag_docs = create "flag_docs" (since_version "0.3") (fun () -> s_ "Building docs require '-docs' flag at configure.") let flag_tests = create "flag_tests" (since_version "0.3") (fun () -> s_ "Running tests require '-tests' flag at configure.") let pack = create "pack" (since_version "0.3") (fun () -> s_ "Allow to create packed library.") let section_object = create "section_object" beta (fun () -> s_ "Implement an object section.") let dynrun_for_release = create "dynrun_for_release" alpha (fun () -> s_ "Make '-setup-update dynamic' suitable for releasing project.") let compiled_setup_ml = create "compiled_setup_ml" alpha (fun () -> s_ "It compiles the setup.ml and speed-up actions done with it.") let disable_oasis_section = create "disable_oasis_section" alpha (fun () -> s_ "Allows the OASIS section comments and digest to be omitted in \ generated files.") let no_automatic_syntax = create "no_automatic_syntax" alpha (fun () -> s_ "Disable the automatic inclusion of -syntax camlp4o for packages \ that matches the internal heuristic (if a dependency ends with \ a .syntax or is a well known syntax).") end module OASISUnixPath = struct (* # 22 "src/oasis/OASISUnixPath.ml" *) type unix_filename = string type unix_dirname = string type host_filename = string type host_dirname = string let current_dir_name = "." let parent_dir_name = ".." let is_current_dir fn = fn = current_dir_name || fn = "" let concat f1 f2 = if is_current_dir f1 then f2 else let f1' = try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1 in f1'^"/"^f2 let make = function | hd :: tl -> List.fold_left (fun f p -> concat f p) hd tl | [] -> invalid_arg "OASISUnixPath.make" let dirname f = try String.sub f 0 (String.rindex f '/') with Not_found -> current_dir_name let basename f = try let pos_start = (String.rindex f '/') + 1 in String.sub f pos_start ((String.length f) - pos_start) with Not_found -> f let chop_extension f = try let last_dot = String.rindex f '.' in let sub = String.sub f 0 last_dot in try let last_slash = String.rindex f '/' in if last_slash < last_dot then sub else f with Not_found -> sub with Not_found -> f let capitalize_file f = let dir = dirname f in let base = basename f in concat dir (String.capitalize base) let uncapitalize_file f = let dir = dirname f in let base = basename f in concat dir (String.uncapitalize base) end module OASISHostPath = struct (* # 22 "src/oasis/OASISHostPath.ml" *) open Filename module Unix = OASISUnixPath let make = function | [] -> invalid_arg "OASISHostPath.make" | hd :: tl -> List.fold_left Filename.concat hd tl let of_unix ufn = if Sys.os_type = "Unix" then ufn else make (List.map (fun p -> if p = Unix.current_dir_name then current_dir_name else if p = Unix.parent_dir_name then parent_dir_name else p) (OASISString.nsplit ufn '/')) end module OASISSection = struct (* # 22 "src/oasis/OASISSection.ml" *) open OASISTypes let section_kind_common = function | Library (cs, _, _) -> `Library, cs | Object (cs, _, _) -> `Object, cs | Executable (cs, _, _) -> `Executable, cs | Flag (cs, _) -> `Flag, cs | SrcRepo (cs, _) -> `SrcRepo, cs | Test (cs, _) -> `Test, cs | Doc (cs, _) -> `Doc, cs let section_common sct = snd (section_kind_common sct) let section_common_set cs = function | Library (_, bs, lib) -> Library (cs, bs, lib) | Object (_, bs, obj) -> Object (cs, bs, obj) | Executable (_, bs, exec) -> Executable (cs, bs, exec) | Flag (_, flg) -> Flag (cs, flg) | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo) | Test (_, tst) -> Test (cs, tst) | Doc (_, doc) -> Doc (cs, doc) (** Key used to identify section *) let section_id sct = let k, cs = section_kind_common sct in k, cs.cs_name let string_of_section sct = let k, nm = section_id sct in (match k with | `Library -> "library" | `Object -> "object" | `Executable -> "executable" | `Flag -> "flag" | `SrcRepo -> "src repository" | `Test -> "test" | `Doc -> "doc") ^" "^nm let section_find id scts = List.find (fun sct -> id = section_id sct) scts module CSection = struct type t = section let id = section_id let compare t1 t2 = compare (id t1) (id t2) let equal t1 t2 = (id t1) = (id t2) let hash t = Hashtbl.hash (id t) end module MapSection = Map.Make(CSection) module SetSection = Set.Make(CSection) end module OASISBuildSection = struct (* # 22 "src/oasis/OASISBuildSection.ml" *) end module OASISExecutable = struct (* # 22 "src/oasis/OASISExecutable.ml" *) open OASISTypes let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = let dir = OASISUnixPath.concat bs.bs_path (OASISUnixPath.dirname exec.exec_main_is) in let is_native_exec = match bs.bs_compiled_object with | Native -> true | Best -> is_native () | Byte -> false in OASISUnixPath.concat dir (cs.cs_name^(suffix_program ())), if not is_native_exec && not exec.exec_custom && bs.bs_c_sources <> [] then Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ())) else None end module OASISLibrary = struct (* # 22 "src/oasis/OASISLibrary.ml" *) open OASISTypes open OASISUtils open OASISGettext open OASISSection (* Look for a module file, considering capitalization or not. *) let find_module source_file_exists bs modul = let possible_base_fn = List.map (OASISUnixPath.concat bs.bs_path) [modul; OASISUnixPath.uncapitalize_file modul; OASISUnixPath.capitalize_file modul] in (* TODO: we should be able to be able to determine the source for every * files. Hence we should introduce a Module(source: fn) for the fields * Modules and InternalModules *) List.fold_left (fun acc base_fn -> match acc with | `No_sources _ -> begin let file_found = List.fold_left (fun acc ext -> if source_file_exists (base_fn^ext) then (base_fn^ext) :: acc else acc) [] [".ml"; ".mli"; ".mll"; ".mly"] in match file_found with | [] -> acc | lst -> `Sources (base_fn, lst) end | `Sources _ -> acc) (`No_sources possible_base_fn) possible_base_fn let source_unix_files ~ctxt (cs, bs, lib) source_file_exists = List.fold_left (fun acc modul -> match find_module source_file_exists bs modul with | `Sources (base_fn, lst) -> (base_fn, lst) :: acc | `No_sources _ -> OASISMessage.warning ~ctxt (f_ "Cannot find source file matching \ module '%s' in library %s") modul cs.cs_name; acc) [] (lib.lib_modules @ lib.lib_internal_modules) let generated_unix_files ~ctxt ~is_native ~has_native_dynlink ~ext_lib ~ext_dll ~source_file_exists (cs, bs, lib) = let find_modules lst ext = let find_module modul = match find_module source_file_exists bs modul with | `Sources (base_fn, [fn]) when ext <> "cmi" && Filename.check_suffix fn ".mli" -> None (* No implementation files for pure interface. *) | `Sources (base_fn, _) -> Some [base_fn] | `No_sources lst -> OASISMessage.warning ~ctxt (f_ "Cannot find source file matching \ module '%s' in library %s") modul cs.cs_name; Some lst in List.fold_left (fun acc nm -> match find_module nm with | None -> acc | Some base_fns -> List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc) [] lst in (* The .cmx that be compiled along *) let cmxs = let should_be_built = match bs.bs_compiled_object with | Native -> true | Best -> is_native | Byte -> false in if should_be_built then if lib.lib_pack then find_modules [cs.cs_name] "cmx" else find_modules (lib.lib_modules @ lib.lib_internal_modules) "cmx" else [] in let acc_nopath = [] in (* The headers and annot/cmt files that should be compiled along *) let headers = let sufx = if lib.lib_pack then [".cmti"; ".cmt"; ".annot"] else [".cmi"; ".cmti"; ".cmt"; ".annot"] in List.map begin List.fold_left begin fun accu s -> let dot = String.rindex s '.' in let base = String.sub s 0 dot in List.map ((^) base) sufx @ accu end [] end (find_modules lib.lib_modules "cmi") in (* Compute what libraries should be built *) let acc_nopath = (* Add the packed header file if required *) let add_pack_header acc = if lib.lib_pack then [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc else acc in let byte acc = add_pack_header ([cs.cs_name^".cma"] :: acc) in let native acc = let acc = add_pack_header (if has_native_dynlink then [cs.cs_name^".cmxs"] :: acc else acc) in [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc in match bs.bs_compiled_object with | Native -> byte (native acc_nopath) | Best when is_native -> byte (native acc_nopath) | Byte | Best -> byte acc_nopath in (* Add C library to be built *) let acc_nopath = if bs.bs_c_sources <> [] then begin ["lib"^cs.cs_name^"_stubs"^ext_lib] :: ["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath end else acc_nopath in (* All the files generated *) List.rev_append (List.rev_map (List.rev_map (OASISUnixPath.concat bs.bs_path)) acc_nopath) (headers @ cmxs) end module OASISObject = struct (* # 22 "src/oasis/OASISObject.ml" *) open OASISTypes open OASISGettext let source_unix_files ~ctxt (cs, bs, obj) source_file_exists = List.fold_left (fun acc modul -> match OASISLibrary.find_module source_file_exists bs modul with | `Sources (base_fn, lst) -> (base_fn, lst) :: acc | `No_sources _ -> OASISMessage.warning ~ctxt (f_ "Cannot find source file matching \ module '%s' in object %s") modul cs.cs_name; acc) [] obj.obj_modules let generated_unix_files ~ctxt ~is_native ~source_file_exists (cs, bs, obj) = let find_module ext modul = match OASISLibrary.find_module source_file_exists bs modul with | `Sources (base_fn, _) -> [base_fn ^ ext] | `No_sources lst -> OASISMessage.warning ~ctxt (f_ "Cannot find source file matching \ module '%s' in object %s") modul cs.cs_name ; lst in let header, byte, native, c_object, f = match obj.obj_modules with | [ m ] -> (find_module ".cmi" m, find_module ".cmo" m, find_module ".cmx" m, find_module ".o" m, fun x -> x) | _ -> ([cs.cs_name ^ ".cmi"], [cs.cs_name ^ ".cmo"], [cs.cs_name ^ ".cmx"], [cs.cs_name ^ ".o"], OASISUnixPath.concat bs.bs_path) in List.map (List.map f) ( match bs.bs_compiled_object with | Native -> native :: c_object :: byte :: header :: [] | Best when is_native -> native :: c_object :: byte :: header :: [] | Byte | Best -> byte :: header :: []) end module OASISFindlib = struct (* # 22 "src/oasis/OASISFindlib.ml" *) open OASISTypes open OASISUtils open OASISGettext open OASISSection type library_name = name type findlib_part_name = name type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t exception InternalLibraryNotFound of library_name exception FindlibPackageNotFound of findlib_name type group_t = | Container of findlib_name * group_t list | Package of (findlib_name * common_section * build_section * [`Library of library | `Object of object_] * group_t list) type data = common_section * build_section * [`Library of library | `Object of object_] type tree = | Node of (data option) * (tree MapString.t) | Leaf of data let findlib_mapping pkg = (* Map from library name to either full findlib name or parts + parent. *) let fndlb_parts_of_lib_name = let fndlb_parts cs lib = let name = match lib.lib_findlib_name with | Some nm -> nm | None -> cs.cs_name in let name = String.concat "." (lib.lib_findlib_containers @ [name]) in name in List.fold_left (fun mp -> function | Library (cs, _, lib) -> begin let lib_name = cs.cs_name in let fndlb_parts = fndlb_parts cs lib in if MapString.mem lib_name mp then failwithf (f_ "The library name '%s' is used more than once.") lib_name; match lib.lib_findlib_parent with | Some lib_name_parent -> MapString.add lib_name (`Unsolved (lib_name_parent, fndlb_parts)) mp | None -> MapString.add lib_name (`Solved fndlb_parts) mp end | Object (cs, _, obj) -> begin let obj_name = cs.cs_name in if MapString.mem obj_name mp then failwithf (f_ "The object name '%s' is used more than once.") obj_name; let findlib_full_name = match obj.obj_findlib_fullname with | Some ns -> String.concat "." ns | None -> obj_name in MapString.add obj_name (`Solved findlib_full_name) mp end | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ -> mp) MapString.empty pkg.sections in (* Solve the above graph to be only library name to full findlib name. *) let fndlb_name_of_lib_name = let rec solve visited mp lib_name lib_name_child = if SetString.mem lib_name visited then failwithf (f_ "Library '%s' is involved in a cycle \ with regard to findlib naming.") lib_name; let visited = SetString.add lib_name visited in try match MapString.find lib_name mp with | `Solved fndlb_nm -> fndlb_nm, mp | `Unsolved (lib_nm_parent, post_fndlb_nm) -> let pre_fndlb_nm, mp = solve visited mp lib_nm_parent lib_name in let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp with Not_found -> failwithf (f_ "Library '%s', which is defined as the findlib parent of \ library '%s', doesn't exist.") lib_name lib_name_child in let mp = MapString.fold (fun lib_name status mp -> match status with | `Solved _ -> (* Solved initialy, no need to go further *) mp | `Unsolved _ -> let _, mp = solve SetString.empty mp lib_name "" in mp) fndlb_parts_of_lib_name fndlb_parts_of_lib_name in MapString.map (function | `Solved fndlb_nm -> fndlb_nm | `Unsolved _ -> assert false) mp in (* Convert an internal library name to a findlib name. *) let findlib_name_of_library_name lib_nm = try MapString.find lib_nm fndlb_name_of_lib_name with Not_found -> raise (InternalLibraryNotFound lib_nm) in (* Add a library to the tree. *) let add sct mp = let fndlb_fullname = let cs, _, _ = sct in let lib_name = cs.cs_name in findlib_name_of_library_name lib_name in let rec add_children nm_lst (children: tree MapString.t) = match nm_lst with | (hd :: tl) -> begin let node = try add_node tl (MapString.find hd children) with Not_found -> (* New node *) new_node tl in MapString.add hd node children end | [] -> (* Should not have a nameless library. *) assert false and add_node tl node = if tl = [] then begin match node with | Node (None, children) -> Node (Some sct, children) | Leaf (cs', _, _) | Node (Some (cs', _, _), _) -> (* TODO: allow to merge Package, i.e. * archive(byte) = "foo.cma foo_init.cmo" *) let cs, _, _ = sct in failwithf (f_ "Library '%s' and '%s' have the same findlib name '%s'") cs.cs_name cs'.cs_name fndlb_fullname end else begin match node with | Leaf data -> Node (Some data, add_children tl MapString.empty) | Node (data_opt, children) -> Node (data_opt, add_children tl children) end and new_node = function | [] -> Leaf sct | hd :: tl -> Node (None, MapString.add hd (new_node tl) MapString.empty) in add_children (OASISString.nsplit fndlb_fullname '.') mp in let rec group_of_tree mp = MapString.fold (fun nm node acc -> let cur = match node with | Node (Some (cs, bs, lib), children) -> Package (nm, cs, bs, lib, group_of_tree children) | Node (None, children) -> Container (nm, group_of_tree children) | Leaf (cs, bs, lib) -> Package (nm, cs, bs, lib, []) in cur :: acc) mp [] in let group_mp = List.fold_left (fun mp -> function | Library (cs, bs, lib) -> add (cs, bs, `Library lib) mp | Object (cs, bs, obj) -> add (cs, bs, `Object obj) mp | _ -> mp) MapString.empty pkg.sections in let groups = group_of_tree group_mp in let library_name_of_findlib_name = lazy begin (* Revert findlib_name_of_library_name. *) MapString.fold (fun k v mp -> MapString.add v k mp) fndlb_name_of_lib_name MapString.empty end in let library_name_of_findlib_name fndlb_nm = try MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name) with Not_found -> raise (FindlibPackageNotFound fndlb_nm) in groups, findlib_name_of_library_name, library_name_of_findlib_name let findlib_of_group = function | Container (fndlb_nm, _) | Package (fndlb_nm, _, _, _, _) -> fndlb_nm let root_of_group grp = let rec root_lib_aux = (* We do a DFS in the group. *) function | Container (_, children) -> List.fold_left (fun res grp -> if res = None then root_lib_aux grp else res) None children | Package (_, cs, bs, lib, _) -> Some (cs, bs, lib) in match root_lib_aux grp with | Some res -> res | None -> failwithf (f_ "Unable to determine root library of findlib library '%s'") (findlib_of_group grp) end module OASISFlag = struct (* # 22 "src/oasis/OASISFlag.ml" *) end module OASISPackage = struct (* # 22 "src/oasis/OASISPackage.ml" *) end module OASISSourceRepository = struct (* # 22 "src/oasis/OASISSourceRepository.ml" *) end module OASISTest = struct (* # 22 "src/oasis/OASISTest.ml" *) end module OASISDocument = struct (* # 22 "src/oasis/OASISDocument.ml" *) end module OASISExec = struct (* # 22 "src/oasis/OASISExec.ml" *) open OASISGettext open OASISUtils open OASISMessage (* TODO: I don't like this quote, it is there because $(rm) foo expands to * 'rm -f' foo... *) let run ~ctxt ?f_exit_code ?(quote=true) cmd args = let cmd = if quote then if Sys.os_type = "Win32" then if String.contains cmd ' ' then (* Double the 1st double quote... win32... sigh *) "\""^(Filename.quote cmd) else cmd else Filename.quote cmd else cmd in let cmdline = String.concat " " (cmd :: args) in info ~ctxt (f_ "Running command '%s'") cmdline; match f_exit_code, Sys.command cmdline with | None, 0 -> () | None, i -> failwithf (f_ "Command '%s' terminated with error code %d") cmdline i | Some f, i -> f i let run_read_output ~ctxt ?f_exit_code cmd args = let fn = Filename.temp_file "oasis-" ".txt" in try begin let () = run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn]) in let chn = open_in fn in let routput = ref [] in begin try while true do routput := (input_line chn) :: !routput done with End_of_file -> () end; close_in chn; Sys.remove fn; List.rev !routput end with e -> (try Sys.remove fn with _ -> ()); raise e let run_read_one_line ~ctxt ?f_exit_code cmd args = match run_read_output ~ctxt ?f_exit_code cmd args with | [fst] -> fst | lst -> failwithf (f_ "Command return unexpected output %S") (String.concat "\n" lst) end module OASISFileUtil = struct (* # 22 "src/oasis/OASISFileUtil.ml" *) open OASISGettext let file_exists_case fn = let dirname = Filename.dirname fn in let basename = Filename.basename fn in if Sys.file_exists dirname then if basename = Filename.current_dir_name then true else List.mem basename (Array.to_list (Sys.readdir dirname)) else false let find_file ?(case_sensitive=true) paths exts = (* Cardinal product of two list *) let ( * ) lst1 lst2 = List.flatten (List.map (fun a -> List.map (fun b -> a, b) lst2) lst1) in let rec combined_paths lst = match lst with | p1 :: p2 :: tl -> let acc = (List.map (fun (a, b) -> Filename.concat a b) (p1 * p2)) in combined_paths (acc :: tl) | [e] -> e | [] -> [] in let alternatives = List.map (fun (p, e) -> if String.length e > 0 && e.[0] <> '.' then p ^ "." ^ e else p ^ e) ((combined_paths paths) * exts) in List.find (fun file -> (if case_sensitive then file_exists_case file else Sys.file_exists file) && not (Sys.is_directory file) ) alternatives let which ~ctxt prg = let path_sep = match Sys.os_type with | "Win32" -> ';' | _ -> ':' in let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in let exec_ext = match Sys.os_type with | "Win32" -> "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep) | _ -> [""] in find_file ~case_sensitive:false [path_lst; [prg]] exec_ext (**/**) let rec fix_dir dn = (* Windows hack because Sys.file_exists "src\\" = false when * Sys.file_exists "src" = true *) let ln = String.length dn in if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then fix_dir (String.sub dn 0 (ln - 1)) else dn let q = Filename.quote (**/**) let cp ~ctxt ?(recurse=false) src tgt = if recurse then match Sys.os_type with | "Win32" -> OASISExec.run ~ctxt "xcopy" [q src; q tgt; "/E"] | _ -> OASISExec.run ~ctxt "cp" ["-r"; q src; q tgt] else OASISExec.run ~ctxt (match Sys.os_type with | "Win32" -> "copy" | _ -> "cp") [q src; q tgt] let mkdir ~ctxt tgt = OASISExec.run ~ctxt (match Sys.os_type with | "Win32" -> "md" | _ -> "mkdir") [q tgt] let rec mkdir_parent ~ctxt f tgt = let tgt = fix_dir tgt in if Sys.file_exists tgt then begin if not (Sys.is_directory tgt) then OASISUtils.failwithf (f_ "Cannot create directory '%s', a file of the same name already \ exists") tgt end else begin mkdir_parent ~ctxt f (Filename.dirname tgt); if not (Sys.file_exists tgt) then begin f tgt; mkdir ~ctxt tgt end end let rmdir ~ctxt tgt = if Sys.readdir tgt = [||] then begin match Sys.os_type with | "Win32" -> OASISExec.run ~ctxt "rd" [q tgt] | _ -> OASISExec.run ~ctxt "rm" ["-r"; q tgt] end else begin OASISMessage.error ~ctxt (f_ "Cannot remove directory '%s': not empty.") tgt end let glob ~ctxt fn = let basename = Filename.basename fn in if String.length basename >= 2 && basename.[0] = '*' && basename.[1] = '.' then begin let ext_len = (String.length basename) - 2 in let ext = String.sub basename 2 ext_len in let dirname = Filename.dirname fn in Array.fold_left (fun acc fn -> try let fn_ext = String.sub fn ((String.length fn) - ext_len) ext_len in if fn_ext = ext then (Filename.concat dirname fn) :: acc else acc with Invalid_argument _ -> acc) [] (Sys.readdir dirname) end else begin if file_exists_case fn then [fn] else [] end end # 2893 "setup.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) module MapString = Map.Make(String) type t = string MapString.t let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" let load ?(allow_empty=false) ?(filename=default_filename) () = if Sys.file_exists filename then begin let chn = open_in_bin filename in let st = Stream.of_channel chn in let line = ref 1 in let st_line = Stream.from (fun _ -> try match Stream.next st with | '\n' -> incr line; Some '\n' | c -> Some c with Stream.Failure -> None) in let lexer = Genlex.make_lexer ["="] st_line in let rec read_file mp = match Stream.npeek 3 lexer with | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> Stream.junk lexer; Stream.junk lexer; Stream.junk lexer; read_file (MapString.add nm value mp) | [] -> mp | _ -> failwith (Printf.sprintf "Malformed data file '%s' line %d" filename !line) in let mp = read_file MapString.empty in close_in chn; mp end else if allow_empty then begin MapString.empty end else begin failwith (Printf.sprintf "Unable to load environment, the file '%s' doesn't exist." filename) end let rec var_expand str env = let buff = Buffer.create ((String.length str) * 2) in Buffer.add_substitute buff (fun var -> try var_expand (MapString.find var env) env with Not_found -> failwith (Printf.sprintf "No variable %s defined when trying to expand %S." var str)) str; Buffer.contents buff let var_get name env = var_expand (MapString.find name env) env let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst end # 2998 "setup.ml" module BaseContext = struct (* # 22 "src/base/BaseContext.ml" *) (* TODO: get rid of this module. *) open OASISContext let args () = fst (fspecs ()) let default = default end module BaseMessage = struct (* # 22 "src/base/BaseMessage.ml" *) (** Message to user, overrid for Base @author Sylvain Le Gall *) open OASISMessage open BaseContext let debug fmt = debug ~ctxt:!default fmt let info fmt = info ~ctxt:!default fmt let warning fmt = warning ~ctxt:!default fmt let error fmt = error ~ctxt:!default fmt end module BaseEnv = struct (* # 22 "src/base/BaseEnv.ml" *) open OASISGettext open OASISUtils open PropList module MapString = BaseEnvLight.MapString type origin_t = | ODefault | OGetEnv | OFileLoad | OCommandLine type cli_handle_t = | CLINone | CLIAuto | CLIWith | CLIEnable | CLIUser of (Arg.key * Arg.spec * Arg.doc) list type definition_t = { hide: bool; dump: bool; cli: cli_handle_t; arg_help: string option; group: string option; } let schema = Schema.create "environment" (* Environment data *) let env = Data.create () (* Environment data from file *) let env_from_file = ref MapString.empty (* Lexer for var *) let var_lxr = Genlex.make_lexer [] let rec var_expand str = let buff = Buffer.create ((String.length str) * 2) in Buffer.add_substitute buff (fun var -> try (* TODO: this is a quick hack to allow calling Test.Command * without defining executable name really. I.e. if there is * an exec Executable toto, then $(toto) should be replace * by its real name. It is however useful to have this function * for other variable that depend on the host and should be * written better than that. *) let st = var_lxr (Stream.of_string var) in match Stream.npeek 3 st with | [Genlex.Ident "utoh"; Genlex.Ident nm] -> OASISHostPath.of_unix (var_get nm) | [Genlex.Ident "utoh"; Genlex.String s] -> OASISHostPath.of_unix s | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] -> String.escaped (var_get nm) | [Genlex.Ident "ocaml_escaped"; Genlex.String s] -> String.escaped s | [Genlex.Ident nm] -> var_get nm | _ -> failwithf (f_ "Unknown expression '%s' in variable expansion of %s.") var str with | Unknown_field (_, _) -> failwithf (f_ "No variable %s defined when trying to expand %S.") var str | Stream.Error e -> failwithf (f_ "Syntax error when parsing '%s' when trying to \ expand %S: %s") var str e) str; Buffer.contents buff and var_get name = let vl = try Schema.get schema env name with Unknown_field _ as e -> begin try MapString.find name !env_from_file with Not_found -> raise e end in var_expand vl let var_choose ?printer ?name lst = OASISExpr.choose ?printer ?name var_get lst let var_protect vl = let buff = Buffer.create (String.length vl) in String.iter (function | '$' -> Buffer.add_string buff "\\$" | c -> Buffer.add_char buff c) vl; Buffer.contents buff let var_define ?(hide=false) ?(dump=true) ?short_desc ?(cli=CLINone) ?arg_help ?group name (* TODO: type constraint on the fact that name must be a valid OCaml id *) dflt = let default = [ OFileLoad, (fun () -> MapString.find name !env_from_file); ODefault, dflt; OGetEnv, (fun () -> Sys.getenv name); ] in let extra = { hide = hide; dump = dump; cli = cli; arg_help = arg_help; group = group; } in (* Try to find a value that can be defined *) let var_get_low lst = let errors, res = List.fold_left (fun (errors, res) (o, v) -> if res = None then begin try errors, Some (v ()) with | Not_found -> errors, res | Failure rsn -> (rsn :: errors), res | e -> (Printexc.to_string e) :: errors, res end else errors, res) ([], None) (List.sort (fun (o1, _) (o2, _) -> Pervasives.compare o2 o1) lst) in match res, errors with | Some v, _ -> v | None, [] -> raise (Not_set (name, None)) | None, lst -> raise (Not_set (name, Some (String.concat (s_ ", ") lst))) in let help = match short_desc with | Some fs -> Some fs | None -> None in let var_get_lst = FieldRO.create ~schema ~name ~parse:(fun ?(context=ODefault) s -> [context, fun () -> s]) ~print:var_get_low ~default ~update:(fun ?context x old_x -> x @ old_x) ?help extra in fun () -> var_expand (var_get_low (var_get_lst env)) let var_redefine ?hide ?dump ?short_desc ?cli ?arg_help ?group name dflt = if Schema.mem schema name then begin (* TODO: look suspsicious, we want to memorize dflt not dflt () *) Schema.set schema env ~context:ODefault name (dflt ()); fun () -> var_get name end else begin var_define ?hide ?dump ?short_desc ?cli ?arg_help ?group name dflt end let var_ignore (e: unit -> string) = () let print_hidden = var_define ~hide:true ~dump:false ~cli:CLIAuto ~arg_help:"Print even non-printable variable. (debug)" "print_hidden" (fun () -> "false") let var_all () = List.rev (Schema.fold (fun acc nm def _ -> if not def.hide || bool_of_string (print_hidden ()) then nm :: acc else acc) [] schema) let default_filename = BaseEnvLight.default_filename let load ?allow_empty ?filename () = env_from_file := BaseEnvLight.load ?allow_empty ?filename () let unload () = env_from_file := MapString.empty; Data.clear env let dump ?(filename=default_filename) () = let chn = open_out_bin filename in let output nm value = Printf.fprintf chn "%s=%S\n" nm value in let mp_todo = (* Dump data from schema *) Schema.fold (fun mp_todo nm def _ -> if def.dump then begin try let value = Schema.get schema env nm in output nm value with Not_set _ -> () end; MapString.remove nm mp_todo) !env_from_file schema in (* Dump data defined outside of schema *) MapString.iter output mp_todo; (* End of the dump *) close_out chn let print () = let printable_vars = Schema.fold (fun acc nm def short_descr_opt -> if not def.hide || bool_of_string (print_hidden ()) then begin try let value = Schema.get schema env nm in let txt = match short_descr_opt with | Some s -> s () | None -> nm in (txt, value) :: acc with Not_set _ -> acc end else acc) [] schema in let max_length = List.fold_left max 0 (List.rev_map String.length (List.rev_map fst printable_vars)) in let dot_pad str = String.make ((max_length - (String.length str)) + 3) '.' in Printf.printf "\nConfiguration: \n"; List.iter (fun (name, value) -> Printf.printf "%s: %s %s\n" name (dot_pad name) value) (List.rev printable_vars); Printf.printf "\n%!" let args () = let arg_concat = OASISUtils.varname_concat ~hyphen:'-' in [ "--override", Arg.Tuple ( let rvr = ref "" in let rvl = ref "" in [ Arg.Set_string rvr; Arg.Set_string rvl; Arg.Unit (fun () -> Schema.set schema env ~context:OCommandLine !rvr !rvl) ] ), "var+val Override any configuration variable."; ] @ List.flatten (Schema.fold (fun acc name def short_descr_opt -> let var_set s = Schema.set schema env ~context:OCommandLine name s in let arg_name = OASISUtils.varname_of_string ~hyphen:'-' name in let hlp = match short_descr_opt with | Some txt -> txt () | None -> "" in let arg_hlp = match def.arg_help with | Some s -> s | None -> "str" in let default_value = try Printf.sprintf (f_ " [%s]") (Schema.get schema env name) with Not_set _ -> "" in let args = match def.cli with | CLINone -> [] | CLIAuto -> [ arg_concat "--" arg_name, Arg.String var_set, Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value ] | CLIWith -> [ arg_concat "--with-" arg_name, Arg.String var_set, Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value ] | CLIEnable -> let dflt = if default_value = " [true]" then s_ " [default: enabled]" else s_ " [default: disabled]" in [ arg_concat "--enable-" arg_name, Arg.Unit (fun () -> var_set "true"), Printf.sprintf (f_ " %s%s") hlp dflt; arg_concat "--disable-" arg_name, Arg.Unit (fun () -> var_set "false"), Printf.sprintf (f_ " %s%s") hlp dflt ] | CLIUser lst -> lst in args :: acc) [] schema) end module BaseArgExt = struct (* # 22 "src/base/BaseArgExt.ml" *) open OASISUtils open OASISGettext let parse argv args = (* Simulate command line for Arg *) let current = ref 0 in try Arg.parse_argv ~current:current (Array.concat [[|"none"|]; argv]) (Arg.align args) (failwithf (f_ "Don't know what to do with arguments: '%s'")) (s_ "configure options:") with | Arg.Help txt -> print_endline txt; exit 0 | Arg.Bad txt -> prerr_endline txt; exit 1 end module BaseCheck = struct (* # 22 "src/base/BaseCheck.ml" *) open BaseEnv open BaseMessage open OASISUtils open OASISGettext let prog_best prg prg_lst = var_redefine prg (fun () -> let alternate = List.fold_left (fun res e -> match res with | Some _ -> res | None -> try Some (OASISFileUtil.which ~ctxt:!BaseContext.default e) with Not_found -> None) None prg_lst in match alternate with | Some prg -> prg | None -> raise Not_found) let prog prg = prog_best prg [prg] let prog_opt prg = prog_best prg [prg^".opt"; prg] let ocamlfind = prog "ocamlfind" let version var_prefix cmp fversion () = (* Really compare version provided *) let var = var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp) in var_redefine ~hide:true var (fun () -> let version_str = match fversion () with | "[Distributed with OCaml]" -> begin try (var_get "ocaml_version") with Not_found -> warning (f_ "Variable ocaml_version not defined, fallback \ to default"); Sys.ocaml_version end | res -> res in let version = OASISVersion.version_of_string version_str in if OASISVersion.comparator_apply version cmp then version_str else failwithf (f_ "Cannot satisfy version constraint on %s: %s (version: %s)") var_prefix (OASISVersion.string_of_comparator cmp) version_str) () let package_version pkg = OASISExec.run_read_one_line ~ctxt:!BaseContext.default (ocamlfind ()) ["query"; "-format"; "%v"; pkg] let package ?version_comparator pkg () = let var = OASISUtils.varname_concat "pkg_" (OASISUtils.varname_of_string pkg) in let findlib_dir pkg = let dir = OASISExec.run_read_one_line ~ctxt:!BaseContext.default (ocamlfind ()) ["query"; "-format"; "%d"; pkg] in if Sys.file_exists dir && Sys.is_directory dir then dir else failwithf (f_ "When looking for findlib package %s, \ directory %s return doesn't exist") pkg dir in let vl = var_redefine var (fun () -> findlib_dir pkg) () in ( match version_comparator with | Some ver_cmp -> ignore (version var ver_cmp (fun _ -> package_version pkg) ()) | None -> () ); vl end module BaseOCamlcConfig = struct (* # 22 "src/base/BaseOCamlcConfig.ml" *) open BaseEnv open OASISUtils open OASISGettext module SMap = Map.Make(String) let ocamlc = BaseCheck.prog_opt "ocamlc" let ocamlc_config_map = (* Map name to value for ocamlc -config output (name ^": "^value) *) let rec split_field mp lst = match lst with | line :: tl -> let mp = try let pos_semicolon = String.index line ':' in if pos_semicolon > 1 then ( let name = String.sub line 0 pos_semicolon in let linelen = String.length line in let value = if linelen > pos_semicolon + 2 then String.sub line (pos_semicolon + 2) (linelen - pos_semicolon - 2) else "" in SMap.add name value mp ) else ( mp ) with Not_found -> ( mp ) in split_field mp tl | [] -> mp in let cache = lazy (var_protect (Marshal.to_string (split_field SMap.empty (OASISExec.run_read_output ~ctxt:!BaseContext.default (ocamlc ()) ["-config"])) [])) in var_redefine "ocamlc_config_map" ~hide:true ~dump:false (fun () -> (* TODO: update if ocamlc change !!! *) Lazy.force cache) let var_define nm = (* Extract data from ocamlc -config *) let avlbl_config_get () = Marshal.from_string (ocamlc_config_map ()) 0 in let chop_version_suffix s = try String.sub s 0 (String.index s '+') with _ -> s in let nm_config, value_config = match nm with | "ocaml_version" -> "version", chop_version_suffix | _ -> nm, (fun x -> x) in var_redefine nm (fun () -> try let map = avlbl_config_get () in let value = SMap.find nm_config map in value_config value with Not_found -> failwithf (f_ "Cannot find field '%s' in '%s -config' output") nm (ocamlc ())) end module BaseStandardVar = struct (* # 22 "src/base/BaseStandardVar.ml" *) open OASISGettext open OASISTypes open OASISExpr open BaseCheck open BaseEnv let ocamlfind = BaseCheck.ocamlfind let ocamlc = BaseOCamlcConfig.ocamlc let ocamlopt = prog_opt "ocamlopt" let ocamlbuild = prog "ocamlbuild" (**/**) let rpkg = ref None let pkg_get () = match !rpkg with | Some pkg -> pkg | None -> failwith (s_ "OASIS Package is not set") let var_cond = ref [] let var_define_cond ~since_version f dflt = let holder = ref (fun () -> dflt) in let since_version = OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version) in var_cond := (fun ver -> if OASISVersion.comparator_apply ver since_version then holder := f ()) :: !var_cond; fun () -> !holder () (**/**) let pkg_name = var_define ~short_desc:(fun () -> s_ "Package name") "pkg_name" (fun () -> (pkg_get ()).name) let pkg_version = var_define ~short_desc:(fun () -> s_ "Package version") "pkg_version" (fun () -> (OASISVersion.string_of_version (pkg_get ()).version)) let c = BaseOCamlcConfig.var_define let os_type = c "os_type" let system = c "system" let architecture = c "architecture" let ccomp_type = c "ccomp_type" let ocaml_version = c "ocaml_version" (* TODO: Check standard variable presence at runtime *) let standard_library_default = c "standard_library_default" let standard_library = c "standard_library" let standard_runtime = c "standard_runtime" let bytecomp_c_compiler = c "bytecomp_c_compiler" let native_c_compiler = c "native_c_compiler" let model = c "model" let ext_obj = c "ext_obj" let ext_asm = c "ext_asm" let ext_lib = c "ext_lib" let ext_dll = c "ext_dll" let default_executable_name = c "default_executable_name" let systhread_supported = c "systhread_supported" let flexlink = BaseCheck.prog "flexlink" let flexdll_version = var_define ~short_desc:(fun () -> "FlexDLL version (Win32)") "flexdll_version" (fun () -> let lst = OASISExec.run_read_output ~ctxt:!BaseContext.default (flexlink ()) ["-help"] in match lst with | line :: _ -> Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver) | [] -> raise Not_found) (**/**) let p name hlp dflt = var_define ~short_desc:hlp ~cli:CLIAuto ~arg_help:"dir" name dflt let (/) a b = if os_type () = Sys.os_type then Filename.concat a b else if os_type () = "Unix" then OASISUnixPath.concat a b else OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat") (os_type ()) (**/**) let prefix = p "prefix" (fun () -> s_ "Install architecture-independent files dir") (fun () -> match os_type () with | "Win32" -> let program_files = Sys.getenv "PROGRAMFILES" in program_files/(pkg_name ()) | _ -> "/usr/local") let exec_prefix = p "exec_prefix" (fun () -> s_ "Install architecture-dependent files in dir") (fun () -> "$prefix") let bindir = p "bindir" (fun () -> s_ "User executables") (fun () -> "$exec_prefix"/"bin") let sbindir = p "sbindir" (fun () -> s_ "System admin executables") (fun () -> "$exec_prefix"/"sbin") let libexecdir = p "libexecdir" (fun () -> s_ "Program executables") (fun () -> "$exec_prefix"/"libexec") let sysconfdir = p "sysconfdir" (fun () -> s_ "Read-only single-machine data") (fun () -> "$prefix"/"etc") let sharedstatedir = p "sharedstatedir" (fun () -> s_ "Modifiable architecture-independent data") (fun () -> "$prefix"/"com") let localstatedir = p "localstatedir" (fun () -> s_ "Modifiable single-machine data") (fun () -> "$prefix"/"var") let libdir = p "libdir" (fun () -> s_ "Object code libraries") (fun () -> "$exec_prefix"/"lib") let datarootdir = p "datarootdir" (fun () -> s_ "Read-only arch-independent data root") (fun () -> "$prefix"/"share") let datadir = p "datadir" (fun () -> s_ "Read-only architecture-independent data") (fun () -> "$datarootdir") let infodir = p "infodir" (fun () -> s_ "Info documentation") (fun () -> "$datarootdir"/"info") let localedir = p "localedir" (fun () -> s_ "Locale-dependent data") (fun () -> "$datarootdir"/"locale") let mandir = p "mandir" (fun () -> s_ "Man documentation") (fun () -> "$datarootdir"/"man") let docdir = p "docdir" (fun () -> s_ "Documentation root") (fun () -> "$datarootdir"/"doc"/"$pkg_name") let htmldir = p "htmldir" (fun () -> s_ "HTML documentation") (fun () -> "$docdir") let dvidir = p "dvidir" (fun () -> s_ "DVI documentation") (fun () -> "$docdir") let pdfdir = p "pdfdir" (fun () -> s_ "PDF documentation") (fun () -> "$docdir") let psdir = p "psdir" (fun () -> s_ "PS documentation") (fun () -> "$docdir") let destdir = p "destdir" (fun () -> s_ "Prepend a path when installing package") (fun () -> raise (PropList.Not_set ("destdir", Some (s_ "undefined by construct")))) let findlib_version = var_define "findlib_version" (fun () -> BaseCheck.package_version "findlib") let is_native = var_define "is_native" (fun () -> try let _s: string = ocamlopt () in "true" with PropList.Not_set _ -> let _s: string = ocamlc () in "false") let ext_program = var_define "suffix_program" (fun () -> match os_type () with | "Win32" | "Cygwin" -> ".exe" | _ -> "") let rm = var_define ~short_desc:(fun () -> s_ "Remove a file.") "rm" (fun () -> match os_type () with | "Win32" -> "del" | _ -> "rm -f") let rmdir = var_define ~short_desc:(fun () -> s_ "Remove a directory.") "rmdir" (fun () -> match os_type () with | "Win32" -> "rd" | _ -> "rm -rf") let debug = var_define ~short_desc:(fun () -> s_ "Turn ocaml debug flag on") ~cli:CLIEnable "debug" (fun () -> "true") let profile = var_define ~short_desc:(fun () -> s_ "Turn ocaml profile flag on") ~cli:CLIEnable "profile" (fun () -> "false") let tests = var_define_cond ~since_version:"0.3" (fun () -> var_define ~short_desc:(fun () -> s_ "Compile tests executable and library and run them") ~cli:CLIEnable "tests" (fun () -> "false")) "true" let docs = var_define_cond ~since_version:"0.3" (fun () -> var_define ~short_desc:(fun () -> s_ "Create documentations") ~cli:CLIEnable "docs" (fun () -> "true")) "true" let native_dynlink = var_define ~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.") ~cli:CLINone "native_dynlink" (fun () -> let res = let ocaml_lt_312 () = OASISVersion.comparator_apply (OASISVersion.version_of_string (ocaml_version ())) (OASISVersion.VLesser (OASISVersion.version_of_string "3.12.0")) in let flexdll_lt_030 () = OASISVersion.comparator_apply (OASISVersion.version_of_string (flexdll_version ())) (OASISVersion.VLesser (OASISVersion.version_of_string "0.30")) in let has_native_dynlink = let ocamlfind = ocamlfind () in try let fn = OASISExec.run_read_one_line ~ctxt:!BaseContext.default ocamlfind ["query"; "-predicates"; "native"; "dynlink"; "-format"; "%d/%a"] in Sys.file_exists fn with _ -> false in if not has_native_dynlink then false else if ocaml_lt_312 () then false else if (os_type () = "Win32" || os_type () = "Cygwin") && flexdll_lt_030 () then begin BaseMessage.warning (f_ ".cmxs generation disabled because FlexDLL needs to be \ at least 0.30. Please upgrade FlexDLL from %s to 0.30.") (flexdll_version ()); false end else true in string_of_bool res) let init pkg = rpkg := Some pkg; List.iter (fun f -> f pkg.oasis_version) !var_cond end module BaseFileAB = struct (* # 22 "src/base/BaseFileAB.ml" *) open BaseEnv open OASISGettext open BaseMessage let to_filename fn = let fn = OASISHostPath.of_unix fn in if not (Filename.check_suffix fn ".ab") then warning (f_ "File '%s' doesn't have '.ab' extension") fn; Filename.chop_extension fn let replace fn_lst = let buff = Buffer.create 13 in List.iter (fun fn -> let fn = OASISHostPath.of_unix fn in let chn_in = open_in fn in let chn_out = open_out (to_filename fn) in ( try while true do Buffer.add_string buff (var_expand (input_line chn_in)); Buffer.add_char buff '\n' done with End_of_file -> () ); Buffer.output_buffer chn_out buff; Buffer.clear buff; close_in chn_in; close_out chn_out) fn_lst end module BaseLog = struct (* # 22 "src/base/BaseLog.ml" *) open OASISUtils let default_filename = Filename.concat (Filename.dirname BaseEnv.default_filename) "setup.log" module SetTupleString = Set.Make (struct type t = string * string let compare (s11, s12) (s21, s22) = match String.compare s11 s21 with | 0 -> String.compare s12 s22 | n -> n end) let load () = if Sys.file_exists default_filename then begin let chn = open_in default_filename in let scbuf = Scanf.Scanning.from_file default_filename in let rec read_aux (st, lst) = if not (Scanf.Scanning.end_of_input scbuf) then begin let acc = try Scanf.bscanf scbuf "%S %S\n" (fun e d -> let t = e, d in if SetTupleString.mem t st then st, lst else SetTupleString.add t st, t :: lst) with Scanf.Scan_failure _ -> failwith (Scanf.bscanf scbuf "%l" (fun line -> Printf.sprintf "Malformed log file '%s' at line %d" default_filename line)) in read_aux acc end else begin close_in chn; List.rev lst end in read_aux (SetTupleString.empty, []) end else begin [] end let register event data = let chn_out = open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename in Printf.fprintf chn_out "%S %S\n" event data; close_out chn_out let unregister event data = if Sys.file_exists default_filename then begin let lst = load () in let chn_out = open_out default_filename in let write_something = ref false in List.iter (fun (e, d) -> if e <> event || d <> data then begin write_something := true; Printf.fprintf chn_out "%S %S\n" e d end) lst; close_out chn_out; if not !write_something then Sys.remove default_filename end let filter events = let st_events = List.fold_left (fun st e -> SetString.add e st) SetString.empty events in List.filter (fun (e, _) -> SetString.mem e st_events) (load ()) let exists event data = List.exists (fun v -> (event, data) = v) (load ()) end module BaseBuilt = struct (* # 22 "src/base/BaseBuilt.ml" *) open OASISTypes open OASISGettext open BaseStandardVar open BaseMessage type t = | BExec (* Executable *) | BExecLib (* Library coming with executable *) | BLib (* Library *) | BObj (* Library *) | BDoc (* Document *) let to_log_event_file t nm = "built_"^ (match t with | BExec -> "exec" | BExecLib -> "exec_lib" | BLib -> "lib" | BObj -> "obj" | BDoc -> "doc")^ "_"^nm let to_log_event_done t nm = "is_"^(to_log_event_file t nm) let register t nm lst = BaseLog.register (to_log_event_done t nm) "true"; List.iter (fun alt -> let registered = List.fold_left (fun registered fn -> if OASISFileUtil.file_exists_case fn then begin BaseLog.register (to_log_event_file t nm) (if Filename.is_relative fn then Filename.concat (Sys.getcwd ()) fn else fn); true end else registered) false alt in if not registered then warning (f_ "Cannot find an existing alternative files among: %s") (String.concat (s_ ", ") alt)) lst let unregister t nm = List.iter (fun (e, d) -> BaseLog.unregister e d) (BaseLog.filter [to_log_event_file t nm; to_log_event_done t nm]) let fold t nm f acc = List.fold_left (fun acc (_, fn) -> if OASISFileUtil.file_exists_case fn then begin f acc fn end else begin warning (f_ "File '%s' has been marked as built \ for %s but doesn't exist") fn (Printf.sprintf (match t with | BExec | BExecLib -> (f_ "executable %s") | BLib -> (f_ "library %s") | BObj -> (f_ "object %s") | BDoc -> (f_ "documentation %s")) nm); acc end) acc (BaseLog.filter [to_log_event_file t nm]) let is_built t nm = List.fold_left (fun is_built (_, d) -> (try bool_of_string d with _ -> false)) false (BaseLog.filter [to_log_event_done t nm]) let of_executable ffn (cs, bs, exec) = let unix_exec_is, unix_dll_opt = OASISExecutable.unix_exec_is (cs, bs, exec) (fun () -> bool_of_string (is_native ())) ext_dll ext_program in let evs = (BExec, cs.cs_name, [[ffn unix_exec_is]]) :: (match unix_dll_opt with | Some fn -> [BExecLib, cs.cs_name, [[ffn fn]]] | None -> []) in evs, unix_exec_is, unix_dll_opt let of_library ffn (cs, bs, lib) = let unix_lst = OASISLibrary.generated_unix_files ~ctxt:!BaseContext.default ~source_file_exists:(fun fn -> OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) ~is_native:(bool_of_string (is_native ())) ~has_native_dynlink:(bool_of_string (native_dynlink ())) ~ext_lib:(ext_lib ()) ~ext_dll:(ext_dll ()) (cs, bs, lib) in let evs = [BLib, cs.cs_name, List.map (List.map ffn) unix_lst] in evs, unix_lst let of_object ffn (cs, bs, obj) = let unix_lst = OASISObject.generated_unix_files ~ctxt:!BaseContext.default ~source_file_exists:(fun fn -> OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) ~is_native:(bool_of_string (is_native ())) (cs, bs, obj) in let evs = [BObj, cs.cs_name, List.map (List.map ffn) unix_lst] in evs, unix_lst end module BaseCustom = struct (* # 22 "src/base/BaseCustom.ml" *) open BaseEnv open BaseMessage open OASISTypes open OASISGettext let run cmd args extra_args = OASISExec.run ~ctxt:!BaseContext.default ~quote:false (var_expand cmd) (List.map var_expand (args @ (Array.to_list extra_args))) let hook ?(failsafe=false) cstm f e = let optional_command lst = let printer = function | Some (cmd, args) -> String.concat " " (cmd :: args) | None -> s_ "No command" in match var_choose ~name:(s_ "Pre/Post Command") ~printer lst with | Some (cmd, args) -> begin try run cmd args [||] with e when failsafe -> warning (f_ "Command '%s' fail with error: %s") (String.concat " " (cmd :: args)) (match e with | Failure msg -> msg | e -> Printexc.to_string e) end | None -> () in let res = optional_command cstm.pre_command; f e in optional_command cstm.post_command; res end module BaseDynVar = struct (* # 22 "src/base/BaseDynVar.ml" *) open OASISTypes open OASISGettext open BaseEnv open BaseBuilt let init pkg = (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *) (* TODO: provide compile option for library libary_byte_args_VARNAME... *) List.iter (function | Executable (cs, bs, exec) -> if var_choose bs.bs_build then var_ignore (var_redefine (* We don't save this variable *) ~dump:false ~short_desc:(fun () -> Printf.sprintf (f_ "Filename of executable '%s'") cs.cs_name) (OASISUtils.varname_of_string cs.cs_name) (fun () -> let fn_opt = fold BExec cs.cs_name (fun _ fn -> Some fn) None in match fn_opt with | Some fn -> fn | None -> raise (PropList.Not_set (cs.cs_name, Some (Printf.sprintf (f_ "Executable '%s' not yet built.") cs.cs_name))))) | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ -> ()) pkg.sections end module BaseTest = struct (* # 22 "src/base/BaseTest.ml" *) open BaseEnv open BaseMessage open OASISTypes open OASISExpr open OASISGettext let test lst pkg extra_args = let one_test (failure, n) (test_plugin, cs, test) = if var_choose ~name:(Printf.sprintf (f_ "test %s run") cs.cs_name) ~printer:string_of_bool test.test_run then begin let () = info (f_ "Running test '%s'") cs.cs_name in let back_cwd = match test.test_working_directory with | Some dir -> let cwd = Sys.getcwd () in let chdir d = info (f_ "Changing directory to '%s'") d; Sys.chdir d in chdir dir; fun () -> chdir cwd | None -> fun () -> () in try let failure_percent = BaseCustom.hook test.test_custom (test_plugin pkg (cs, test)) extra_args in back_cwd (); (failure_percent +. failure, n + 1) with e -> begin back_cwd (); raise e end end else begin info (f_ "Skipping test '%s'") cs.cs_name; (failure, n) end in let failed, n = List.fold_left one_test (0.0, 0) lst in let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in let msg = Printf.sprintf (f_ "Tests had a %.2f%% failure rate") (100. *. failure_percent) in if failure_percent > 0.0 then failwith msg else info "%s" msg; (* Possible explanation why the tests where not run. *) if OASISFeatures.package_test OASISFeatures.flag_tests pkg && not (bool_of_string (BaseStandardVar.tests ())) && lst <> [] then BaseMessage.warning "Tests are turned off, consider enabling with \ 'ocaml setup.ml -configure --enable-tests'" end module BaseDoc = struct (* # 22 "src/base/BaseDoc.ml" *) open BaseEnv open BaseMessage open OASISTypes open OASISGettext let doc lst pkg extra_args = let one_doc (doc_plugin, cs, doc) = if var_choose ~name:(Printf.sprintf (f_ "documentation %s build") cs.cs_name) ~printer:string_of_bool doc.doc_build then begin info (f_ "Building documentation '%s'") cs.cs_name; BaseCustom.hook doc.doc_custom (doc_plugin pkg (cs, doc)) extra_args end in List.iter one_doc lst; if OASISFeatures.package_test OASISFeatures.flag_docs pkg && not (bool_of_string (BaseStandardVar.docs ())) && lst <> [] then BaseMessage.warning "Docs are turned off, consider enabling with \ 'ocaml setup.ml -configure --enable-docs'" end module BaseSetup = struct (* # 22 "src/base/BaseSetup.ml" *) open BaseEnv open BaseMessage open OASISTypes open OASISSection open OASISGettext open OASISUtils type std_args_fun = package -> string array -> unit type ('a, 'b) section_args_fun = name * (package -> (common_section * 'a) -> string array -> 'b) type t = { configure: std_args_fun; build: std_args_fun; doc: ((doc, unit) section_args_fun) list; test: ((test, float) section_args_fun) list; install: std_args_fun; uninstall: std_args_fun; clean: std_args_fun list; clean_doc: (doc, unit) section_args_fun list; clean_test: (test, unit) section_args_fun list; distclean: std_args_fun list; distclean_doc: (doc, unit) section_args_fun list; distclean_test: (test, unit) section_args_fun list; package: package; oasis_fn: string option; oasis_version: string; oasis_digest: Digest.t option; oasis_exec: string option; oasis_setup_args: string list; setup_update: bool; } (* Associate a plugin function with data from package *) let join_plugin_sections filter_map lst = List.rev (List.fold_left (fun acc sct -> match filter_map sct with | Some e -> e :: acc | None -> acc) [] lst) (* Search for plugin data associated with a section name *) let lookup_plugin_section plugin action nm lst = try List.assoc nm lst with Not_found -> failwithf (f_ "Cannot find plugin %s matching section %s for %s action") plugin nm action let configure t args = (* Run configure *) BaseCustom.hook t.package.conf_custom (fun () -> (* Reload if preconf has changed it *) begin try unload (); load (); with _ -> () end; (* Run plugin's configure *) t.configure t.package args; (* Dump to allow postconf to change it *) dump ()) (); (* Reload environment *) unload (); load (); (* Save environment *) print (); (* Replace data in file *) BaseFileAB.replace t.package.files_ab let build t args = BaseCustom.hook t.package.build_custom (t.build t.package) args let doc t args = BaseDoc.doc (join_plugin_sections (function | Doc (cs, e) -> Some (lookup_plugin_section "documentation" (s_ "build") cs.cs_name t.doc, cs, e) | _ -> None) t.package.sections) t.package args let test t args = BaseTest.test (join_plugin_sections (function | Test (cs, e) -> Some (lookup_plugin_section "test" (s_ "run") cs.cs_name t.test, cs, e) | _ -> None) t.package.sections) t.package args let all t args = let rno_doc = ref false in let rno_test = ref false in let arg_rest = ref [] in Arg.parse_argv ~current:(ref 0) (Array.of_list ((Sys.executable_name^" all") :: (Array.to_list args))) [ "-no-doc", Arg.Set rno_doc, s_ "Don't run doc target"; "-no-test", Arg.Set rno_test, s_ "Don't run test target"; "--", Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest), s_ "All arguments for configure."; ] (failwithf (f_ "Don't know what to do with '%s'")) ""; info "Running configure step"; configure t (Array.of_list (List.rev !arg_rest)); info "Running build step"; build t [||]; (* Load setup.log dynamic variables *) BaseDynVar.init t.package; if not !rno_doc then begin info "Running doc step"; doc t [||]; end else begin info "Skipping doc step" end; if not !rno_test then begin info "Running test step"; test t [||] end else begin info "Skipping test step" end let install t args = BaseCustom.hook t.package.install_custom (t.install t.package) args let uninstall t args = BaseCustom.hook t.package.uninstall_custom (t.uninstall t.package) args let reinstall t args = uninstall t args; install t args let clean, distclean = let failsafe f a = try f a with e -> warning (f_ "Action fail with error: %s") (match e with | Failure msg -> msg | e -> Printexc.to_string e) in let generic_clean t cstm mains docs tests args = BaseCustom.hook ~failsafe:true cstm (fun () -> (* Clean section *) List.iter (function | Test (cs, test) -> let f = try List.assoc cs.cs_name tests with Not_found -> fun _ _ _ -> () in failsafe (f t.package (cs, test)) args | Doc (cs, doc) -> let f = try List.assoc cs.cs_name docs with Not_found -> fun _ _ _ -> () in failsafe (f t.package (cs, doc)) args | Library _ | Object _ | Executable _ | Flag _ | SrcRepo _ -> ()) t.package.sections; (* Clean whole package *) List.iter (fun f -> failsafe (f t.package) args) mains) () in let clean t args = generic_clean t t.package.clean_custom t.clean t.clean_doc t.clean_test args in let distclean t args = (* Call clean *) clean t args; (* Call distclean code *) generic_clean t t.package.distclean_custom t.distclean t.distclean_doc t.distclean_test args; (* Remove generated file *) List.iter (fun fn -> if Sys.file_exists fn then begin info (f_ "Remove '%s'") fn; Sys.remove fn end) (BaseEnv.default_filename :: BaseLog.default_filename :: (List.rev_map BaseFileAB.to_filename t.package.files_ab)) in clean, distclean let version t _ = print_endline t.oasis_version let update_setup_ml, no_update_setup_ml_cli = let b = ref true in b, ("-no-update-setup-ml", Arg.Clear b, s_ " Don't try to update setup.ml, even if _oasis has changed.") let default_oasis_fn = "_oasis" let update_setup_ml t = let oasis_fn = match t.oasis_fn with | Some fn -> fn | None -> default_oasis_fn in let oasis_exec = match t.oasis_exec with | Some fn -> fn | None -> "oasis" in let ocaml = Sys.executable_name in let setup_ml, args = match Array.to_list Sys.argv with | setup_ml :: args -> setup_ml, args | [] -> failwith (s_ "Expecting non-empty command line arguments.") in let ocaml, setup_ml = if Sys.executable_name = Sys.argv.(0) then (* We are not running in standard mode, probably the script * is precompiled. *) "ocaml", "setup.ml" else ocaml, setup_ml in let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in let do_update () = let oasis_exec_version = OASISExec.run_read_one_line ~ctxt:!BaseContext.default ~f_exit_code: (function | 0 -> () | 1 -> failwithf (f_ "Executable '%s' is probably an old version \ of oasis (< 0.3.0), please update to version \ v%s.") oasis_exec t.oasis_version | 127 -> failwithf (f_ "Cannot find executable '%s', please install \ oasis v%s.") oasis_exec t.oasis_version | n -> failwithf (f_ "Command '%s version' exited with code %d.") oasis_exec n) oasis_exec ["version"] in if OASISVersion.comparator_apply (OASISVersion.version_of_string oasis_exec_version) (OASISVersion.VGreaterEqual (OASISVersion.version_of_string t.oasis_version)) then begin (* We have a version >= for the executable oasis, proceed with * update. *) (* TODO: delegate this check to 'oasis setup'. *) if Sys.os_type = "Win32" then failwithf (f_ "It is not possible to update the running script \ setup.ml on Windows. Please update setup.ml by \ running '%s'.") (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args)) else begin OASISExec.run ~ctxt:!BaseContext.default ~f_exit_code: (function | 0 -> () | n -> failwithf (f_ "Unable to update setup.ml using '%s', \ please fix the problem and retry.") oasis_exec) oasis_exec ("setup" :: t.oasis_setup_args); OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args) end end else failwithf (f_ "The version of '%s' (v%s) doesn't match the version of \ oasis used to generate the %s file. Please install at \ least oasis v%s.") oasis_exec oasis_exec_version setup_ml t.oasis_version in if !update_setup_ml then begin try match t.oasis_digest with | Some dgst -> if Sys.file_exists oasis_fn && dgst <> Digest.file default_oasis_fn then begin do_update (); true end else false | None -> false with e -> error (f_ "Error when updating setup.ml. If you want to avoid this error, \ you can bypass the update of %s by running '%s %s %s %s'") setup_ml ocaml setup_ml no_update_setup_ml_cli (String.concat " " args); raise e end else false let setup t = let catch_exn = ref true in try let act_ref = ref (fun _ -> failwithf (f_ "No action defined, run '%s %s -help'") Sys.executable_name Sys.argv.(0)) in let extra_args_ref = ref [] in let allow_empty_env_ref = ref false in let arg_handle ?(allow_empty_env=false) act = Arg.Tuple [ Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref); Arg.Unit (fun () -> allow_empty_env_ref := allow_empty_env; act_ref := act); ] in Arg.parse (Arg.align ([ "-configure", arg_handle ~allow_empty_env:true configure, s_ "[options*] Configure the whole build process."; "-build", arg_handle build, s_ "[options*] Build executables and libraries."; "-doc", arg_handle doc, s_ "[options*] Build documents."; "-test", arg_handle test, s_ "[options*] Run tests."; "-all", arg_handle ~allow_empty_env:true all, s_ "[options*] Run configure, build, doc and test targets."; "-install", arg_handle install, s_ "[options*] Install libraries, data, executables \ and documents."; "-uninstall", arg_handle uninstall, s_ "[options*] Uninstall libraries, data, executables \ and documents."; "-reinstall", arg_handle reinstall, s_ "[options*] Uninstall and install libraries, data, \ executables and documents."; "-clean", arg_handle ~allow_empty_env:true clean, s_ "[options*] Clean files generated by a build."; "-distclean", arg_handle ~allow_empty_env:true distclean, s_ "[options*] Clean files generated by a build and configure."; "-version", arg_handle ~allow_empty_env:true version, s_ " Display version of OASIS used to generate this setup.ml."; "-no-catch-exn", Arg.Clear catch_exn, s_ " Don't catch exception, useful for debugging."; ] @ (if t.setup_update then [no_update_setup_ml_cli] else []) @ (BaseContext.args ()))) (failwithf (f_ "Don't know what to do with '%s'")) (s_ "Setup and run build process current package\n"); (* Build initial environment *) load ~allow_empty:!allow_empty_env_ref (); (** Initialize flags *) List.iter (function | Flag (cs, {flag_description = hlp; flag_default = choices}) -> begin let apply ?short_desc () = var_ignore (var_define ~cli:CLIEnable ?short_desc (OASISUtils.varname_of_string cs.cs_name) (fun () -> string_of_bool (var_choose ~name:(Printf.sprintf (f_ "default value of flag %s") cs.cs_name) ~printer:string_of_bool choices))) in match hlp with | Some hlp -> apply ~short_desc:(fun () -> hlp) () | None -> apply () end | _ -> ()) t.package.sections; BaseStandardVar.init t.package; BaseDynVar.init t.package; if t.setup_update && update_setup_ml t then () else !act_ref t (Array.of_list (List.rev !extra_args_ref)) with e when !catch_exn -> error "%s" (Printexc.to_string e); exit 1 end # 5409 "setup.ml" module InternalConfigurePlugin = struct (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) (** Configure using internal scheme @author Sylvain Le Gall *) open BaseEnv open OASISTypes open OASISUtils open OASISGettext open BaseMessage (** Configure build using provided series of check to be done * and then output corresponding file. *) let configure pkg argv = let var_ignore_eval var = let _s: string = var () in () in let errors = ref SetString.empty in let buff = Buffer.create 13 in let add_errors fmt = Printf.kbprintf (fun b -> errors := SetString.add (Buffer.contents b) !errors; Buffer.clear b) buff fmt in let warn_exception e = warning "%s" (Printexc.to_string e) in (* Check tools *) let check_tools lst = List.iter (function | ExternalTool tool -> begin try var_ignore_eval (BaseCheck.prog tool) with e -> warn_exception e; add_errors (f_ "Cannot find external tool '%s'") tool end | InternalExecutable nm1 -> (* Check that matching tool is built *) List.iter (function | Executable ({cs_name = nm2}, {bs_build = build}, _) when nm1 = nm2 -> if not (var_choose build) then add_errors (f_ "Cannot find buildable internal executable \ '%s' when checking build depends") nm1 | _ -> ()) pkg.sections) lst in let build_checks sct bs = if var_choose bs.bs_build then begin if bs.bs_compiled_object = Native then begin try var_ignore_eval BaseStandardVar.ocamlopt with e -> warn_exception e; add_errors (f_ "Section %s requires native compilation") (OASISSection.string_of_section sct) end; (* Check tools *) check_tools bs.bs_build_tools; (* Check depends *) List.iter (function | FindlibPackage (findlib_pkg, version_comparator) -> begin try var_ignore_eval (BaseCheck.package ?version_comparator findlib_pkg) with e -> warn_exception e; match version_comparator with | None -> add_errors (f_ "Cannot find findlib package %s") findlib_pkg | Some ver_cmp -> add_errors (f_ "Cannot find findlib package %s (%s)") findlib_pkg (OASISVersion.string_of_comparator ver_cmp) end | InternalLibrary nm1 -> (* Check that matching library is built *) List.iter (function | Library ({cs_name = nm2}, {bs_build = build}, _) when nm1 = nm2 -> if not (var_choose build) then add_errors (f_ "Cannot find buildable internal library \ '%s' when checking build depends") nm1 | _ -> ()) pkg.sections) bs.bs_build_depends end in (* Parse command line *) BaseArgExt.parse argv (BaseEnv.args ()); (* OCaml version *) begin match pkg.ocaml_version with | Some ver_cmp -> begin try var_ignore_eval (BaseCheck.version "ocaml" ver_cmp BaseStandardVar.ocaml_version) with e -> warn_exception e; add_errors (f_ "OCaml version %s doesn't match version constraint %s") (BaseStandardVar.ocaml_version ()) (OASISVersion.string_of_comparator ver_cmp) end | None -> () end; (* Findlib version *) begin match pkg.findlib_version with | Some ver_cmp -> begin try var_ignore_eval (BaseCheck.version "findlib" ver_cmp BaseStandardVar.findlib_version) with e -> warn_exception e; add_errors (f_ "Findlib version %s doesn't match version constraint %s") (BaseStandardVar.findlib_version ()) (OASISVersion.string_of_comparator ver_cmp) end | None -> () end; (* Make sure the findlib version is fine for the OCaml compiler. *) begin let ocaml_ge4 = OASISVersion.version_compare (OASISVersion.version_of_string (BaseStandardVar.ocaml_version())) (OASISVersion.version_of_string "4.0.0") >= 0 in if ocaml_ge4 then let findlib_lt132 = OASISVersion.version_compare (OASISVersion.version_of_string (BaseStandardVar.findlib_version())) (OASISVersion.version_of_string "1.3.2") < 0 in if findlib_lt132 then add_errors "OCaml >= 4.0.0 requires Findlib version >= 1.3.2" end; (* FlexDLL *) if BaseStandardVar.os_type () = "Win32" || BaseStandardVar.os_type () = "Cygwin" then begin try var_ignore_eval BaseStandardVar.flexlink with e -> warn_exception e; add_errors (f_ "Cannot find 'flexlink'") end; (* Check build depends *) List.iter (function | Executable (_, bs, _) | Library (_, bs, _) as sct -> build_checks sct bs | Doc (_, doc) -> if var_choose doc.doc_build then check_tools doc.doc_build_tools | Test (_, test) -> if var_choose test.test_run then check_tools test.test_tools | _ -> ()) pkg.sections; (* Check if we need native dynlink (presence of libraries that compile to * native) *) begin let has_cmxa = List.exists (function | Library (_, bs, _) -> var_choose bs.bs_build && (bs.bs_compiled_object = Native || (bs.bs_compiled_object = Best && bool_of_string (BaseStandardVar.is_native ()))) | _ -> false) pkg.sections in if has_cmxa then var_ignore_eval BaseStandardVar.native_dynlink end; (* Check errors *) if SetString.empty != !errors then begin List.iter (fun e -> error "%s" e) (SetString.elements !errors); failwithf (fn_ "%d configuration error" "%d configuration errors" (SetString.cardinal !errors)) (SetString.cardinal !errors) end end module InternalInstallPlugin = struct (* # 22 "src/plugins/internal/InternalInstallPlugin.ml" *) (** Install using internal scheme @author Sylvain Le Gall *) open BaseEnv open BaseStandardVar open BaseMessage open OASISTypes open OASISFindlib open OASISGettext open OASISUtils let exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec) let lib_hook = ref (fun (cs, bs, lib) -> cs, bs, lib, []) let obj_hook = ref (fun (cs, bs, obj) -> cs, bs, obj, []) let doc_hook = ref (fun (cs, doc) -> cs, doc) let install_file_ev = "install-file" let install_dir_ev = "install-dir" let install_findlib_ev = "install-findlib" let win32_max_command_line_length = 8000 let split_install_command ocamlfind findlib_name meta files = if Sys.os_type = "Win32" then (* Arguments for the first command: *) let first_args = ["install"; findlib_name; meta] in (* Arguments for remaining commands: *) let other_args = ["install"; findlib_name; "-add"] in (* Extract as much files as possible from [files], [len] is the current command line length: *) let rec get_files len acc files = match files with | [] -> (List.rev acc, []) | file :: rest -> let len = len + 1 + String.length file in if len > win32_max_command_line_length then (List.rev acc, files) else get_files len (file :: acc) rest in (* Split the command into several commands. *) let rec split args files = match files with | [] -> [] | _ -> (* Length of "ocamlfind install [META|-add]" *) let len = List.fold_left (fun len arg -> len + 1 (* for the space *) + String.length arg) (String.length ocamlfind) args in match get_files len [] files with | ([], _) -> failwith (s_ "Command line too long.") | (firsts, others) -> let cmd = args @ firsts in (* Use -add for remaining commands: *) let () = let findlib_ge_132 = OASISVersion.comparator_apply (OASISVersion.version_of_string (BaseStandardVar.findlib_version ())) (OASISVersion.VGreaterEqual (OASISVersion.version_of_string "1.3.2")) in if not findlib_ge_132 then failwithf (f_ "Installing the library %s require to use the \ flag '-add' of ocamlfind because the command \ line is too long. This flag is only available \ for findlib 1.3.2. Please upgrade findlib from \ %s to 1.3.2") findlib_name (BaseStandardVar.findlib_version ()) in let cmds = split other_args others in cmd :: cmds in (* The first command does not use -add: *) split first_args files else ["install" :: findlib_name :: meta :: files] let install pkg argv = let in_destdir = try let destdir = destdir () in (* Practically speaking destdir is prepended * at the beginning of the target filename *) fun fn -> destdir^fn with PropList.Not_set _ -> fun fn -> fn in let install_file ?tgt_fn src_file envdir = let tgt_dir = in_destdir (envdir ()) in let tgt_file = Filename.concat tgt_dir (match tgt_fn with | Some fn -> fn | None -> Filename.basename src_file) in (* Create target directory if needed *) OASISFileUtil.mkdir_parent ~ctxt:!BaseContext.default (fun dn -> info (f_ "Creating directory '%s'") dn; BaseLog.register install_dir_ev dn) tgt_dir; (* Really install files *) info (f_ "Copying file '%s' to '%s'") src_file tgt_file; OASISFileUtil.cp ~ctxt:!BaseContext.default src_file tgt_file; BaseLog.register install_file_ev tgt_file in (* Install data into defined directory *) let install_data srcdir lst tgtdir = let tgtdir = OASISHostPath.of_unix (var_expand tgtdir) in List.iter (fun (src, tgt_opt) -> let real_srcs = OASISFileUtil.glob ~ctxt:!BaseContext.default (Filename.concat srcdir src) in if real_srcs = [] then failwithf (f_ "Wildcard '%s' doesn't match any files") src; List.iter (fun fn -> install_file fn (fun () -> match tgt_opt with | Some s -> OASISHostPath.of_unix (var_expand s) | None -> tgtdir)) real_srcs) lst in let make_fnames modul sufx = List.fold_right begin fun sufx accu -> (String.capitalize modul ^ sufx) :: (String.uncapitalize modul ^ sufx) :: accu end sufx [] in (** Install all libraries *) let install_libs pkg = let files_of_library (f_data, acc) data_lib = let cs, bs, lib, lib_extra = !lib_hook data_lib in if var_choose bs.bs_install && BaseBuilt.is_built BaseBuilt.BLib cs.cs_name then begin let acc = (* Start with acc + lib_extra *) List.rev_append lib_extra acc in let acc = (* Add uncompiled header from the source tree *) let path = OASISHostPath.of_unix bs.bs_path in List.fold_left begin fun acc modul -> begin try [List.find OASISFileUtil.file_exists_case (List.map (Filename.concat path) (make_fnames modul [".mli"; ".ml"]))] with Not_found -> warning (f_ "Cannot find source header for module %s \ in library %s") modul cs.cs_name; [] end @ List.filter OASISFileUtil.file_exists_case (List.map (Filename.concat path) (make_fnames modul [".annot";".cmti";".cmt"])) @ acc end acc lib.lib_modules in let acc = (* Get generated files *) BaseBuilt.fold BaseBuilt.BLib cs.cs_name (fun acc fn -> fn :: acc) acc in let f_data () = (* Install data associated with the library *) install_data bs.bs_path bs.bs_data_files (Filename.concat (datarootdir ()) pkg.name); f_data () in (f_data, acc) end else begin (f_data, acc) end and files_of_object (f_data, acc) data_obj = let cs, bs, obj, obj_extra = !obj_hook data_obj in if var_choose bs.bs_install && BaseBuilt.is_built BaseBuilt.BObj cs.cs_name then begin let acc = (* Start with acc + obj_extra *) List.rev_append obj_extra acc in let acc = (* Add uncompiled header from the source tree *) let path = OASISHostPath.of_unix bs.bs_path in List.fold_left begin fun acc modul -> begin try [List.find OASISFileUtil.file_exists_case (List.map (Filename.concat path) (make_fnames modul [".mli"; ".ml"]))] with Not_found -> warning (f_ "Cannot find source header for module %s \ in object %s") modul cs.cs_name; [] end @ List.filter OASISFileUtil.file_exists_case (List.map (Filename.concat path) (make_fnames modul [".annot";".cmti";".cmt"])) @ acc end acc obj.obj_modules in let acc = (* Get generated files *) BaseBuilt.fold BaseBuilt.BObj cs.cs_name (fun acc fn -> fn :: acc) acc in let f_data () = (* Install data associated with the object *) install_data bs.bs_path bs.bs_data_files (Filename.concat (datarootdir ()) pkg.name); f_data () in (f_data, acc) end else begin (f_data, acc) end in (* Install one group of library *) let install_group_lib grp = (* Iterate through all group nodes *) let rec install_group_lib_aux data_and_files grp = let data_and_files, children = match grp with | Container (_, children) -> data_and_files, children | Package (_, cs, bs, `Library lib, children) -> files_of_library data_and_files (cs, bs, lib), children | Package (_, cs, bs, `Object obj, children) -> files_of_object data_and_files (cs, bs, obj), children in List.fold_left install_group_lib_aux data_and_files children in (* Findlib name of the root library *) let findlib_name = findlib_of_group grp in (* Determine root library *) let root_lib = root_of_group grp in (* All files to install for this library *) let f_data, files = install_group_lib_aux (ignore, []) grp in (* Really install, if there is something to install *) if files = [] then begin warning (f_ "Nothing to install for findlib library '%s'") findlib_name end else begin let meta = (* Search META file *) let _, bs, _ = root_lib in let res = Filename.concat bs.bs_path "META" in if not (OASISFileUtil.file_exists_case res) then failwithf (f_ "Cannot find file '%s' for findlib library %s") res findlib_name; res in let files = (* Make filename shorter to avoid hitting command max line length * too early, esp. on Windows. *) let remove_prefix p n = let plen = String.length p in let nlen = String.length n in if plen <= nlen && String.sub n 0 plen = p then begin let fn_sep = if Sys.os_type = "Win32" then '\\' else '/' in let cutpoint = plen + (if plen < nlen && n.[plen] = fn_sep then 1 else 0) in String.sub n cutpoint (nlen - cutpoint) end else n in List.map (remove_prefix (Sys.getcwd ())) files in info (f_ "Installing findlib library '%s'") findlib_name; let ocamlfind = ocamlfind () in let commands = split_install_command ocamlfind findlib_name meta files in List.iter (OASISExec.run ~ctxt:!BaseContext.default ocamlfind) commands; BaseLog.register install_findlib_ev findlib_name end; (* Install data files *) f_data (); in let group_libs, _, _ = findlib_mapping pkg in (* We install libraries in groups *) List.iter install_group_lib group_libs in let install_execs pkg = let install_exec data_exec = let cs, bs, exec = !exec_hook data_exec in if var_choose bs.bs_install && BaseBuilt.is_built BaseBuilt.BExec cs.cs_name then begin let exec_libdir () = Filename.concat (libdir ()) pkg.name in BaseBuilt.fold BaseBuilt.BExec cs.cs_name (fun () fn -> install_file ~tgt_fn:(cs.cs_name ^ ext_program ()) fn bindir) (); BaseBuilt.fold BaseBuilt.BExecLib cs.cs_name (fun () fn -> install_file fn exec_libdir) (); install_data bs.bs_path bs.bs_data_files (Filename.concat (datarootdir ()) pkg.name) end in List.iter (function | Executable (cs, bs, exec)-> install_exec (cs, bs, exec) | _ -> ()) pkg.sections in let install_docs pkg = let install_doc data = let cs, doc = !doc_hook data in if var_choose doc.doc_install && BaseBuilt.is_built BaseBuilt.BDoc cs.cs_name then begin let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in BaseBuilt.fold BaseBuilt.BDoc cs.cs_name (fun () fn -> install_file fn (fun () -> tgt_dir)) (); install_data Filename.current_dir_name doc.doc_data_files doc.doc_install_dir end in List.iter (function | Doc (cs, doc) -> install_doc (cs, doc) | _ -> ()) pkg.sections in install_libs pkg; install_execs pkg; install_docs pkg (* Uninstall already installed data *) let uninstall _ argv = List.iter (fun (ev, data) -> if ev = install_file_ev then begin if OASISFileUtil.file_exists_case data then begin info (f_ "Removing file '%s'") data; Sys.remove data end else begin warning (f_ "File '%s' doesn't exist anymore") data end end else if ev = install_dir_ev then begin if Sys.file_exists data && Sys.is_directory data then begin if Sys.readdir data = [||] then begin info (f_ "Removing directory '%s'") data; OASISFileUtil.rmdir ~ctxt:!BaseContext.default data end else begin warning (f_ "Directory '%s' is not empty (%s)") data (String.concat ", " (Array.to_list (Sys.readdir data))) end end else begin warning (f_ "Directory '%s' doesn't exist anymore") data end end else if ev = install_findlib_ev then begin info (f_ "Removing findlib library '%s'") data; OASISExec.run ~ctxt:!BaseContext.default (ocamlfind ()) ["remove"; data] end else failwithf (f_ "Unknown log event '%s'") ev; BaseLog.unregister ev data) (* We process event in reverse order *) (List.rev (BaseLog.filter [install_file_ev; install_dir_ev; install_findlib_ev])) end # 6273 "setup.ml" module OCamlbuildCommon = struct (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) (** Functions common to OCamlbuild build and doc plugin *) open OASISGettext open BaseEnv open BaseStandardVar open OASISTypes type extra_args = string list let ocamlbuild_clean_ev = "ocamlbuild-clean" let ocamlbuildflags = var_define ~short_desc:(fun () -> "OCamlbuild additional flags") "ocamlbuildflags" (fun () -> "") (** Fix special arguments depending on environment *) let fix_args args extra_argv = List.flatten [ if (os_type ()) = "Win32" then [ "-classic-display"; "-no-log"; "-no-links"; "-install-lib-dir"; (Filename.concat (standard_library ()) "ocamlbuild") ] else []; if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then [ "-byte-plugin" ] else []; args; if bool_of_string (debug ()) then ["-tag"; "debug"] else []; if bool_of_string (tests ()) then ["-tag"; "tests"] else []; if bool_of_string (profile ()) then ["-tag"; "profile"] else []; OASISString.nsplit (ocamlbuildflags ()) ' '; Array.to_list extra_argv; ] (** Run 'ocamlbuild -clean' if not already done *) let run_clean extra_argv = let extra_cli = String.concat " " (Array.to_list extra_argv) in (* Run if never called with these args *) if not (BaseLog.exists ocamlbuild_clean_ev extra_cli) then begin OASISExec.run ~ctxt:!BaseContext.default (ocamlbuild ()) (fix_args ["-clean"] extra_argv); BaseLog.register ocamlbuild_clean_ev extra_cli; at_exit (fun () -> try BaseLog.unregister ocamlbuild_clean_ev extra_cli with _ -> ()) end (** Run ocamlbuild, unregister all clean events *) let run_ocamlbuild args extra_argv = (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html *) OASISExec.run ~ctxt:!BaseContext.default (ocamlbuild ()) (fix_args args extra_argv); (* Remove any clean event, we must run it again *) List.iter (fun (e, d) -> BaseLog.unregister e d) (BaseLog.filter [ocamlbuild_clean_ev]) (** Determine real build directory *) let build_dir extra_argv = let rec search_args dir = function | "-build-dir" :: dir :: tl -> search_args dir tl | _ :: tl -> search_args dir tl | [] -> dir in search_args "_build" (fix_args [] extra_argv) end module OCamlbuildPlugin = struct (* # 22 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *) (** Build using ocamlbuild @author Sylvain Le Gall *) open OASISTypes open OASISGettext open OASISUtils open OASISString open BaseEnv open OCamlbuildCommon open BaseStandardVar open BaseMessage let cond_targets_hook = ref (fun lst -> lst) let build extra_args pkg argv = (* Return the filename in build directory *) let in_build_dir fn = Filename.concat (build_dir argv) fn in (* Return the unix filename in host build directory *) let in_build_dir_of_unix fn = in_build_dir (OASISHostPath.of_unix fn) in let cond_targets = List.fold_left (fun acc -> function | Library (cs, bs, lib) when var_choose bs.bs_build -> begin let evs, unix_files = BaseBuilt.of_library in_build_dir_of_unix (cs, bs, lib) in let tgts = List.flatten (List.filter (fun l -> l <> []) (List.map (List.filter (fun fn -> ends_with ~what:".cma" fn || ends_with ~what:".cmxs" fn || ends_with ~what:".cmxa" fn || ends_with ~what:(ext_lib ()) fn || ends_with ~what:(ext_dll ()) fn)) unix_files)) in match tgts with | _ :: _ -> (evs, tgts) :: acc | [] -> failwithf (f_ "No possible ocamlbuild targets for library %s") cs.cs_name end | Object (cs, bs, obj) when var_choose bs.bs_build -> begin let evs, unix_files = BaseBuilt.of_object in_build_dir_of_unix (cs, bs, obj) in let tgts = List.flatten (List.filter (fun l -> l <> []) (List.map (List.filter (fun fn -> ends_with ".cmo" fn || ends_with ".cmx" fn)) unix_files)) in match tgts with | _ :: _ -> (evs, tgts) :: acc | [] -> failwithf (f_ "No possible ocamlbuild targets for object %s") cs.cs_name end | Executable (cs, bs, exec) when var_choose bs.bs_build -> begin let evs, unix_exec_is, unix_dll_opt = BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec) in let target ext = let unix_tgt = (OASISUnixPath.concat bs.bs_path (OASISUnixPath.chop_extension exec.exec_main_is))^ext in let evs = (* Fix evs, we want to use the unix_tgt, without copying *) List.map (function | BaseBuilt.BExec, nm, lst when nm = cs.cs_name -> BaseBuilt.BExec, nm, [[in_build_dir_of_unix unix_tgt]] | ev -> ev) evs in evs, [unix_tgt] in (* Add executable *) let acc = match bs.bs_compiled_object with | Native -> (target ".native") :: acc | Best when bool_of_string (is_native ()) -> (target ".native") :: acc | Byte | Best -> (target ".byte") :: acc in acc end | Library _ | Object _ | Executable _ | Test _ | SrcRepo _ | Flag _ | Doc _ -> acc) [] (* Keep the pkg.sections ordered *) (List.rev pkg.sections); in (* Check and register built files *) let check_and_register (bt, bnm, lst) = List.iter (fun fns -> if not (List.exists OASISFileUtil.file_exists_case fns) then failwithf (fn_ "Expected built file %s doesn't exist." "None of expected built files %s exists." (List.length fns)) (String.concat (s_ " or ") (List.map (Printf.sprintf "'%s'") fns))) lst; (BaseBuilt.register bt bnm lst) in (* Run the hook *) let cond_targets = !cond_targets_hook cond_targets in (* Run a list of target... *) run_ocamlbuild (List.flatten (List.map snd cond_targets) @ extra_args) argv; (* ... and register events *) List.iter check_and_register (List.flatten (List.map fst cond_targets)) let clean pkg extra_args = run_clean extra_args; List.iter (function | Library (cs, _, _) -> BaseBuilt.unregister BaseBuilt.BLib cs.cs_name | Executable (cs, _, _) -> BaseBuilt.unregister BaseBuilt.BExec cs.cs_name; BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name | _ -> ()) pkg.sections end module OCamlbuildDocPlugin = struct (* # 22 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *) (* Create documentation using ocamlbuild .odocl files @author Sylvain Le Gall *) open OASISTypes open OASISGettext open OASISMessage open OCamlbuildCommon open BaseStandardVar type run_t = { extra_args: string list; run_path: unix_filename; } let doc_build run pkg (cs, doc) argv = let index_html = OASISUnixPath.make [ run.run_path; cs.cs_name^".docdir"; "index.html"; ] in let tgt_dir = OASISHostPath.make [ build_dir argv; OASISHostPath.of_unix run.run_path; cs.cs_name^".docdir"; ] in run_ocamlbuild (index_html :: run.extra_args) argv; List.iter (fun glb -> BaseBuilt.register BaseBuilt.BDoc cs.cs_name [OASISFileUtil.glob ~ctxt:!BaseContext.default (Filename.concat tgt_dir glb)]) ["*.html"; "*.css"] let doc_clean run pkg (cs, doc) argv = run_clean argv; BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name end # 6651 "setup.ml" open OASISTypes;; let setup_t = { BaseSetup.configure = InternalConfigurePlugin.configure; build = OCamlbuildPlugin.build []; test = []; doc = [ ("API", OCamlbuildDocPlugin.doc_build {OCamlbuildDocPlugin.extra_args = []; run_path = "."}) ]; install = InternalInstallPlugin.install; uninstall = InternalInstallPlugin.uninstall; clean = [OCamlbuildPlugin.clean]; clean_test = []; clean_doc = [ ("API", OCamlbuildDocPlugin.doc_clean {OCamlbuildDocPlugin.extra_args = []; run_path = "."}) ]; distclean = []; distclean_test = []; distclean_doc = []; package = { oasis_version = "0.4"; ocaml_version = Some (OASISVersion.VGreaterEqual "3.12"); findlib_version = Some (OASISVersion.VGreaterEqual "1.3.1"); alpha_features = []; beta_features = []; name = "gsl"; version = "1.19.1"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit { OASISLicense.license = "GPL"; excption = None; version = OASISLicense.VersionOrLater "3" }); license_file = Some "COPYING.txt"; copyrights = [ "(C) 2002-2012 Olivier Andrieu \n(C) 2009-2015 Markus Mottl " ]; maintainers = ["Markus Mottl "]; authors = [ "Olivier Andrieu "; "Markus Mottl " ]; homepage = Some "http://mmottl.github.io/gsl-ocaml"; synopsis = "GSL - Bindings to the GNU Scientific Library"; description = Some [ OASISText.Para "gsl-ocaml branched off from Olivier Andrieu's distribution (ocamlgsl) and includes bug fixes as well as numerous API improvements." ]; categories = []; conf_type = (`Configure, "internal", Some "0.4"); conf_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, Some (("make", ["post-conf"])))] }; build_type = (`Build, "ocamlbuild", Some "0.4"); build_custom = { pre_command = [ (OASISExpr.EBool true, Some (("mkdir", [ "-p"; "_build/lib;\ncp"; "lib/mlgsl_matrix.c"; "lib/mlgsl_vector.c"; "_build/lib" ]))) ]; post_command = [(OASISExpr.EBool true, None)] }; install_type = (`Install, "internal", Some "0.4"); install_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)] }; uninstall_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)] }; clean_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)] }; distclean_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)] }; files_ab = ["lib/gsl_version.ml.ab"]; sections = [ Flag ({ cs_name = "strict"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { flag_description = Some "Strict compile-time checks"; flag_default = [(OASISExpr.EBool true, true)] }); Library ({ cs_name = "gsl"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [(OASISExpr.EBool true, true)]; bs_install = [(OASISExpr.EBool true, true)]; bs_path = "lib"; bs_compiled_object = Best; bs_build_depends = [FindlibPackage ("bigarray", None)]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = [ "mlgsl_blas.c"; "mlgsl_blas_complex.c"; "mlgsl_blas_complex_float.c"; "mlgsl_blas_float.c"; "mlgsl_bspline.c"; "mlgsl_cdf.c"; "mlgsl_cheb.c"; "mlgsl_combi.c"; "mlgsl_complex.c"; "mlgsl_deriv.c"; "mlgsl_eigen.c"; "mlgsl_error.c"; "mlgsl_fft.c"; "mlgsl_fit.c"; "mlgsl_fun.c"; "mlgsl_histo.c"; "mlgsl_ieee.c"; "mlgsl_integration.c"; "mlgsl_interp.c"; "mlgsl_linalg.c"; "mlgsl_linalg_complex.c"; "mlgsl_math.c"; "mlgsl_matrix_complex.c"; "mlgsl_matrix_complex_float.c"; "mlgsl_matrix_double.c"; "mlgsl_matrix_float.c"; "mlgsl_min.c"; "mlgsl_monte.c"; "mlgsl_multifit.c"; "mlgsl_multimin.c"; "mlgsl_multiroots.c"; "mlgsl_odeiv.c"; "mlgsl_permut.c"; "mlgsl_poly.c"; "mlgsl_qrng.c"; "mlgsl_randist.c"; "mlgsl_rng.c"; "mlgsl_roots.c"; "mlgsl_sf.c"; "mlgsl_sort.c"; "mlgsl_stats.c"; "mlgsl_sum.c"; "mlgsl_vector_double.c"; "mlgsl_vector_float.c"; "mlgsl_wavelet.c"; "io.h"; "mlgsl_blas.h"; "mlgsl_complex.h"; "mlgsl_fun.h"; "mlgsl_matrix.h"; "mlgsl_matrix_complex.h"; "mlgsl_matrix_complex_float.h"; "mlgsl_matrix_double.h"; "mlgsl_matrix_float.h"; "mlgsl_permut.h"; "mlgsl_rng.h"; "mlgsl_vector.h"; "mlgsl_vector_complex.h"; "mlgsl_vector_complex_float.h"; "mlgsl_vector_double.h"; "mlgsl_vector_float.h"; "wrappers.h" ]; bs_data_files = []; bs_ccopt = [ (OASISExpr.EBool true, ["-g"; "-O2"; "-fPIC"; "-DPIC"]); (OASISExpr.EAnd (OASISExpr.EFlag "strict", OASISExpr.ETest ("ccomp_type", "cc")), [ "-g"; "-O2"; "-fPIC"; "-DPIC"; "-Wall"; "-Wunused"; "-Wno-long-long" ]) ]; bs_cclib = [ (OASISExpr.EBool true, []); (OASISExpr.ETest ("system", "macosx"), ["-framework"; "Accelerate"]) ]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, { lib_modules = [ "Gsl"; "Gsl_blas"; "Gsl_blas_flat"; "Gsl_blas_gen"; "Gsl_bspline"; "Gsl_cdf"; "Gsl_cheb"; "Gsl_combi"; "Gsl_const"; "Gsl_deriv"; "Gsl_eigen"; "Gsl_error"; "Gsl_fft"; "Gsl_fit"; "Gsl_fun"; "Gsl_complex"; "Gsl_sort"; "Gsl_histo"; "Gsl_ieee"; "Gsl_integration"; "Gsl_interp"; "Gsl_linalg"; "Gsl_math"; "Gsl_matrix"; "Gsl_matrix_complex"; "Gsl_matrix_complex_flat"; "Gsl_matrix_flat"; "Gsl_min"; "Gsl_misc"; "Gsl_monte"; "Gsl_multifit"; "Gsl_multifit_nlin"; "Gsl_multimin"; "Gsl_multiroot"; "Gsl_odeiv"; "Gsl_permut"; "Gsl_poly"; "Gsl_qrng"; "Gsl_randist"; "Gsl_rng"; "Gsl_root"; "Gsl_sf"; "Gsl_siman"; "Gsl_stats"; "Gsl_sum"; "Gsl_vectmat"; "Gsl_vector"; "Gsl_vector_complex"; "Gsl_vector_complex_flat"; "Gsl_vector_flat"; "Gsl_version"; "Gsl_wavelet" ]; lib_pack = false; lib_internal_modules = []; lib_findlib_parent = None; lib_findlib_name = None; lib_findlib_containers = [] }); Flag ({ cs_name = "examples"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { flag_description = Some "Build examples"; flag_default = [(OASISExpr.EBool true, true)] }); Flag ({ cs_name = "camlp4"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { flag_description = Some "Allow building of examples using camlp4"; flag_default = [(OASISExpr.EBool true, false)] }); Executable ({ cs_name = "blas_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "blas_ex.ml"}); Executable ({ cs_name = "blas_speed_test"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "blas_speed_test.ml"}); Executable ({ cs_name = "bspline_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "bspline_ex.ml"}); Executable ({ cs_name = "cheb_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "cheb_ex.ml"}); Executable ({ cs_name = "combi_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "combi_ex.ml"}); Executable ({ cs_name = "const_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "const_ex.ml"}); Executable ({ cs_name = "deriv_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "deriv_ex.ml"}); Executable ({ cs_name = "eigen_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "eigen_ex.ml"}); Executable ({ cs_name = "fft_c"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "fft_c.ml"}); Executable ({ cs_name = "fft_c2"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "fft_c2.ml"}); Executable ({ cs_name = "fft_hc"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "fft_hc.ml"}); Executable ({ cs_name = "fit_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "fit_ex.ml"}); Executable ({ cs_name = "histo_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "histo_ex.ml"}); Executable ({ cs_name = "integration_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "integration_ex.ml"}); Executable ({ cs_name = "interp_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "interp_ex.ml"}); Executable ({ cs_name = "linalg_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "linalg_ex.ml"}); Executable ({ cs_name = "min_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "min_ex.ml"}); Executable ({ cs_name = "monte_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "monte_ex.ml"}); Executable ({ cs_name = "multifit_data_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "multifit_data_ex.ml" }); Executable ({ cs_name = "multifit_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EAnd (OASISExpr.EFlag "examples", OASISExpr.EFlag "camlp4"), true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [ InternalLibrary "gsl"; FindlibPackage ("camlp4", None) ]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "multifit_ex.ml"}); Executable ({ cs_name = "multifit_nlin_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "multifit_nlin_ex.ml" }); Executable ({ cs_name = "multimin_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "multimin_ex.ml"}); Executable ({ cs_name = "multiroot_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "multiroot_ex.ml"}); Executable ({ cs_name = "odeiv_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "odeiv_ex.ml"}); Executable ({ cs_name = "permut_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "permut_ex.ml"}); Executable ({ cs_name = "qrng_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "qrng_ex.ml"}); Executable ({ cs_name = "rng_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "rng_ex.ml"}); Executable ({ cs_name = "root_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "root_ex.ml"}); Executable ({ cs_name = "siman_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "siman_ex.ml"}); Executable ({ cs_name = "siman_tsp_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "siman_tsp_ex.ml"}); Executable ({ cs_name = "stats_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "stats_ex.ml"}); Executable ({ cs_name = "sum_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "sum_ex.ml"}); Executable ({ cs_name = "wavelet_ex"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "examples", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "examples"; bs_compiled_object = Best; bs_build_depends = [InternalLibrary "gsl"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = false; exec_main_is = "wavelet_ex.ml"}); Doc ({ cs_name = "API"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { doc_type = (`Doc, "OCamlbuild", Some "0.4"); doc_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)] }; doc_build = [ (OASISExpr.ENot (OASISExpr.EFlag "docs"), false); (OASISExpr.EFlag "docs", true) ]; doc_install = [(OASISExpr.EBool true, true)]; doc_install_dir = "$docdir/api"; doc_title = "API reference for GSL"; doc_authors = []; doc_abstract = None; doc_format = OtherDoc; doc_data_files = []; doc_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"] }); SrcRepo ({ cs_name = "head"; cs_data = PropList.Data.create (); cs_plugin_data = [] }, { src_repo_type = Git; src_repo_location = "https://github.com/mmottl/gsl-ocaml.git"; src_repo_browser = Some "https://github.com/mmottl/gsl-ocaml"; src_repo_module = None; src_repo_branch = None; src_repo_tag = Some "v$(pkg_version)"; src_repo_subdir = None }) ]; plugins = [ (`Extra, "META", Some "0.4"); (`Extra, "StdFiles", Some "0.4"); (`Extra, "DevFiles", Some "0.4") ]; disable_oasis_section = []; schema_data = PropList.Data.create (); plugin_data = [] }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; oasis_digest = Some "1\015\011\145\157\156/ü¸Ð®Ì¤ÓÅ5"; oasis_exec = None; oasis_setup_args = []; setup_update = false };; let setup () = BaseSetup.setup setup_t;; # 7965 "setup.ml" (* OASIS_STOP *) let () = setup ();;