pax_global_header00006660000000000000000000000064137123756050014523gustar00rootroot0000000000000052 comment=ff812916e9ef209386d90df0a606729c7f09304d gsl-ocaml-1.24.3/000077500000000000000000000000001371237560500134705ustar00rootroot00000000000000gsl-ocaml-1.24.3/.gitattributes000066400000000000000000000000351371237560500163610ustar00rootroot00000000000000*.ml linguist-language=OCaml gsl-ocaml-1.24.3/.gitignore000066400000000000000000000000401371237560500154520ustar00rootroot00000000000000.*.swp .merlin *.install _build gsl-ocaml-1.24.3/CHANGES.md000066400000000000000000000022271371237560500150650ustar00rootroot00000000000000### 1.24.3 (2020-08-04) * Removed `base` and `stdio` build dependencies. ### 1.24.2 (2020-07-30) * Switched to OPAM file generation via `dune-project` * Added support for const char strings in stubs due to stricter handling in newer OCaml runtimes. This eliminates C-compiler warnings. ### 1.24.1 (2019-10-11) * Fixed warnings in C-stubs ### 1.24.0 (2018-10-24) * Updated to OPAM 2.0 ### 1.23.0 (2018-10-06) * Switched to dune and dune-release ### 1.22.0 (2018-06-11) * Fixed warnings and errors in configuration code due to upstream changes. ### 1.21.0 (2017-12-06) * Added `Randist.multivariate_gaussian`. Thanks to Ilias Garnier for this contribution! * Added hypergeometric functions. Thanks to Christophe Troestler for this contribution! * Fixed error handler initialization. ### 1.20.2 (2017-10-15) * Fixed a configuration bug leading to wrong include paths ### 1.20.1 (2017-10-10) * Fixed automatic generation of special functions * Improved documentation of configuration options * Improved automatic configuration of include paths ### 1.20.0 (2017-08-01) * Switched to jbuilder and topkg gsl-ocaml-1.24.3/LICENSE.md000066400000000000000000001044471371237560500151060ustar00rootroot00000000000000Copyright (c) 2002-2012 Olivier Andrieu Copyright (c) 2009- Markus Mottl --------------------------------------------------------------------------- ### 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.24.3/Makefile000066400000000000000000000001341371237560500151260ustar00rootroot00000000000000.PHONY: all clean doc all: dune build @install clean: dune clean doc: dune build @doc gsl-ocaml-1.24.3/NOTES.md000066400000000000000000000016451371237560500147100ustar00rootroot00000000000000### COMPLETE * 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.24.3/README.md000066400000000000000000000070751371237560500147600ustar00rootroot00000000000000## GSL-OCaml - GSL-Bindings for OCaml 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 ``. #### 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. 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 (e.g. before `opam install`): ```sh $ export GSL_CBLAS_LIB=-lopenblas ``` 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. If you do not wish to use Accelerate you can override it; for a Homebrew-installed OpenBlas in the usual place you then need to ```sh export GSL_CBLAS_LIB="-L/usr/local/opt/openblas/lib/ -lopenblas" ``` ### Documentation Read the [GSL manual](http://www.gnu.org/software/gsl/manual/html_node) to learn more about the GNU Scientific Library, and also the [GSL-OCaml API](http://mmottl.github.io/gsl-ocaml/api/gsl). ### 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. ### Contact Information and Contributing Please submit bugs reports, feature requests, contributions and similar to the [GitHub issue tracker](https://github.com/mmottl/gsl-ocaml/issues). Up-to-date information is available at: gsl-ocaml-1.24.3/TODO.md000066400000000000000000000007731371237560500145660ustar00rootroot00000000000000### TODO * 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.24.3/dune000066400000000000000000000002401371237560500143420ustar00rootroot00000000000000(env (dev (flags (:standard -w -9 -principal)) (c_flags (:standard -Wall -pedantic -Wextra -Wunused))) (release (ocamlopt_flags (:standard -O3))) ) gsl-ocaml-1.24.3/dune-project000066400000000000000000000015331371237560500160140ustar00rootroot00000000000000(lang dune 1.10) (name gsl) (generate_opam_files true) (source (github mmottl/gsl-ocaml)) (license "GPL-3+") (homepage "https://mmottl.github.io/gsl-ocaml") (documentation "https://mmottl.github.io/gsl-ocaml/api") (maintainers "Markus Mottl ") (authors "Olivier Andrieu " "Markus Mottl " ) (package (name gsl) (synopsis "GSL - Bindings to the GNU Scientific Library") (description "\ gsl-ocaml interfaces the GSL (GNU Scientific Library), providing many of the most frequently used functions for scientific computation including algorithms for optimization, differential equations, statistics, random number generation, linear algebra, etc.") (depends (ocaml (>= 4.08)) (dune (>= 1.10)) dune-configurator (conf-gsl :build) (conf-pkg-config :build) ) ) gsl-ocaml-1.24.3/examples/000077500000000000000000000000001371237560500153065ustar00rootroot00000000000000gsl-ocaml-1.24.3/examples/Makefile000066400000000000000000000002201371237560500167400ustar00rootroot00000000000000EXAMPLES = $(wildcard *.ml) TARGETS = $(patsubst %.ml, %.bc, $(EXAMPLES)) .PHONY: all clean all: @dune build $(TARGETS) clean: @dune clean gsl-ocaml-1.24.3/examples/blas_ex.ml000066400000000000000000000014341371237560500172570ustar00rootroot00000000000000open 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.24.3/examples/blas_speed_test.ml000066400000000000000000000012001371237560500207710ustar00rootroot00000000000000open 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.24.3/examples/bspline_ex.ml000066400000000000000000000027231371237560500177740ustar00rootroot00000000000000open 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.24.3/examples/cheb_ex.ml000066400000000000000000000010331371237560500172320ustar00rootroot00000000000000open 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.24.3/examples/combi_ex.ml000066400000000000000000000004211371237560500174220ustar00rootroot00000000000000open 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.24.3/examples/const_ex.ml000066400000000000000000000006371371237560500174700ustar00rootroot00000000000000open 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.24.3/examples/deriv_ex.ml000066400000000000000000000012451371237560500174470ustar00rootroot00000000000000open 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.24.3/examples/dune000066400000000000000000000007721371237560500161720ustar00rootroot00000000000000(executables (names blas_ex blas_speed_test bspline_ex cheb_ex combi_ex const_ex deriv_ex eigen_ex fft_c fft_c2 fft_hc fit_ex histo_ex integration_ex interp_ex linalg_ex min_ex monte_ex multifit_data_ex multifit_ex multifit_nlin_ex multimin_ex multiroot_ex odeiv_ex permut_ex qrng_ex rng_ex root_ex siman_ex siman_tsp_ex stats_ex sum_ex wavelet_ex ) (libraries gsl) ) gsl-ocaml-1.24.3/examples/ecg.dat000066400000000000000000000052521371237560500165420ustar00rootroot000000000000000.0462458 0.0462458 0.0512458 0.0712458 0.0712458 0.0662458 0.0962458 0.1012458 0.1162458 0.1212458 0.1162458 0.1062458 0.0912458 0.1012458 0.0962458 0.0962458 0.0962458 0.0912458 0.0862458 0.0812458 0.0862458 0.1012458 0.1112458 0.1162458 0.0762458 0.0362458 0.0362458 0.0212458 0.0112458 -0.0087542 -0.0087542 -0.0037542 0.0062458 0.0012458 0.0062458 -0.0037542 -0.0187542 -0.0237542 -0.0187542 -0.0187542 -0.0287542 -0.0237542 -0.0337542 -0.0087542 -0.0137542 -0.0087542 0.0012458 -0.0237542 -0.0337542 -0.0187542 -0.0087542 -0.0037542 -0.0087542 -0.0287542 -0.0437542 -0.0387542 -0.0587542 -0.1037542 -0.1237542 -0.1537542 -0.1887542 -0.2137542 -0.1837542 -0.0937542 0.0212458 0.1612458 0.3062458 0.5562458 0.8112458 1.0412458 1.1962458 1.2612458 1.2262458 1.0762458 0.8112458 0.4862458 0.2112458 0.0512458 -0.0687542 -0.1287542 -0.1537542 -0.1337542 -0.1037542 -0.0687542 -0.0687542 -0.0637542 -0.0687542 -0.0587542 -0.0587542 -0.0587542 -0.0737542 -0.0637542 -0.0637542 -0.0637542 -0.0537542 -0.0737542 -0.0887542 -0.0887542 -0.0787542 -0.0737542 -0.0687542 -0.0837542 -0.0737542 -0.0637542 -0.0537542 -0.0687542 -0.0687542 -0.0837542 -0.0887542 -0.0887542 -0.0687542 -0.0687542 -0.0737542 -0.0837542 -0.0937542 -0.0787542 -0.0887542 -0.0837542 -0.0887542 -0.0937542 -0.0887542 -0.0787542 -0.0787542 -0.0737542 -0.0687542 -0.0837542 -0.0887542 -0.0687542 -0.0687542 -0.0637542 -0.0637542 -0.0887542 -0.0837542 -0.0737542 -0.0687542 -0.0537542 -0.0687542 -0.0737542 -0.0887542 -0.0787542 -0.0687542 -0.0687542 -0.0637542 -0.0837542 -0.0937542 -0.0937542 -0.0787542 -0.0737542 -0.0837542 -0.0937542 -0.0987542 -0.0987542 -0.0887542 -0.0937542 -0.1037542 -0.0987542 -0.1137542 -0.1087542 -0.1087542 -0.0987542 -0.1087542 -0.1287542 -0.1337542 -0.1287542 -0.1137542 -0.1237542 -0.1287542 -0.1337542 -0.1487542 -0.1387542 -0.1337542 -0.1287542 -0.1337542 -0.1487542 -0.1537542 -0.1387542 -0.1287542 -0.1237542 -0.1187542 -0.1137542 -0.1187542 -0.0887542 -0.0737542 -0.0487542 -0.0437542 -0.0387542 -0.0437542 -0.0187542 -0.0037542 0.0062458 0.0012458 -0.0087542 -0.0087542 0.0012458 0.0112458 0.0212458 0.0212458 0.0012458 0.0012458 0.0062458 0.0162458 0.0162458 0.0262458 0.0012458 -0.0087542 0.0162458 0.0112458 0.0212458 0.0212458 0.0012458 -0.0037542 0.0112458 0.0162458 0.0062458 0.0162458 0.0062458 0.0062458 0.0112458 0.0262458 0.0312458 0.0162458 0.0112458 0.0012458 0.0062458 0.0212458 0.0062458 0.0062458 0.0062458 -0.0087542 0.0062458 0.0012458 0.0062458 -0.0037542 -0.0137542 -0.0187542 -0.0137542 -0.0137542 -0.0087542 -0.0037542 -0.0237542 -0.0287542 -0.0237542 -0.0137542 -0.0087542 -0.0087542 -0.0237542 -0.0237542 -0.0237542 0.0012458 -0.0087542 -0.0137542 -0.0187542 -0.0337542 -0.0137542 -0.0087542 -0.0087542 gsl-ocaml-1.24.3/examples/eigen_ex.ml000066400000000000000000000021361371237560500174250ustar00rootroot00000000000000open 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.24.3/examples/fft_c.ml000066400000000000000000000012011371237560500167130ustar00rootroot00000000000000open 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.24.3/examples/fft_c2.ml000066400000000000000000000012361371237560500170050ustar00rootroot00000000000000open 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.24.3/examples/fft_hc.ml000066400000000000000000000011631371237560500170720ustar00rootroot00000000000000open 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.24.3/examples/fit_ex.ml000066400000000000000000000015711371237560500171220ustar00rootroot00000000000000open 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.24.3/examples/histo_ex.ml000066400000000000000000000014141371237560500174620ustar00rootroot00000000000000open 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.24.3/examples/integration_ex.ml000066400000000000000000000011431371237560500206560ustar00rootroot00000000000000open 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.24.3/examples/interp_ex.ml000066400000000000000000000015721371237560500176420ustar00rootroot00000000000000open 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.24.3/examples/linalg_ex.ml000066400000000000000000000005351371237560500176050ustar00rootroot00000000000000open 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.24.3/examples/min_ex.ml000066400000000000000000000017661371237560500171310ustar00rootroot00000000000000open 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.24.3/examples/monte_ex.ml000066400000000000000000000040731371237560500174620ustar00rootroot00000000000000open 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.24.3/examples/multifit_data_ex.ml000066400000000000000000000005001371237560500211550ustar00rootroot00000000000000open 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.24.3/examples/multifit_ex.ml000066400000000000000000000035531371237560500201770ustar00rootroot00000000000000open 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 line = Scanf.sscanf line "%f %f %f" (fun a b c -> a, b, c) 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.24.3/examples/multifit_nlin_ex.ml000066400000000000000000000063331371237560500212160ustar00rootroot00000000000000open 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.24.3/examples/multimin_ex.ml000066400000000000000000000053251371237560500201770ustar00rootroot00000000000000open 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.24.3/examples/multiroot_ex.ml000066400000000000000000000051111371237560500203700ustar00rootroot00000000000000open 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.24.3/examples/odeiv_ex.ml000066400000000000000000000061611371237560500174460ustar00rootroot00000000000000open 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.24.3/examples/permut_ex.ml000066400000000000000000000013251371237560500176510ustar00rootroot00000000000000open 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.24.3/examples/qrng_ex.ml000066400000000000000000000003001371237560500172740ustar00rootroot00000000000000open 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.24.3/examples/rng_ex.ml000066400000000000000000000012651371237560500171260ustar00rootroot00000000000000open 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.24.3/examples/root_ex.ml000066400000000000000000000040131371237560500173150ustar00rootroot00000000000000open 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.24.3/examples/siman_ex.ml000066400000000000000000000012131371237560500174400ustar00rootroot00000000000000open 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.24.3/examples/siman_tsp_ex.ml000066400000000000000000000076371371237560500203460ustar00rootroot00000000000000open 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.24.3/examples/stats_ex.ml000066400000000000000000000022301371237560500174670ustar00rootroot00000000000000open 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.24.3/examples/sum_ex.ml000066400000000000000000000025101371237560500171360ustar00rootroot00000000000000open 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.24.3/examples/wavelet_ex.ml000066400000000000000000000017731371237560500200130ustar00rootroot00000000000000open 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.24.3/gsl.opam000066400000000000000000000021061371237560500151320ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" build: [ ["dune" "subst"] {pinned} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ["dune" "build" "-p" name "@doc"] {with-doc} ] maintainer: ["Markus Mottl "] authors: [ "Olivier Andrieu " "Markus Mottl " ] bug-reports: "https://github.com/mmottl/gsl-ocaml/issues" homepage: "https://mmottl.github.io/gsl-ocaml" doc: "https://mmottl.github.io/gsl-ocaml/api" license: "GPL-3+" dev-repo: "git+https://github.com/mmottl/gsl-ocaml.git" synopsis: "GSL - Bindings to the GNU Scientific Library" description: """ gsl-ocaml interfaces the GSL (GNU Scientific Library), providing many of the most frequently used functions for scientific computation including algorithms for optimization, differential equations, statistics, random number generation, linear algebra, etc.""" depends: [ "ocaml" {>= "4.08"} "dune" {>= "1.10"} "dune-configurator" "conf-gsl" {build} "conf-pkg-config" {build} ] gsl-ocaml-1.24.3/pre-v1.20.0-CHANGES.txt000066400000000000000000000142261371237560500167740ustar00rootroot00000000000000in 1.19.3 (gsl-ocaml fork) - Fixed build problem on platforms with GSL versions older than 2.0 in 1.19.2 (gsl-ocaml fork) - Link to Accelerate Framework on Mac OS X in 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.24.3/src/000077500000000000000000000000001371237560500142575ustar00rootroot00000000000000gsl-ocaml-1.24.3/src/Makefile000066400000000000000000000001471371237560500157210ustar00rootroot00000000000000TARGETS = gsl.cma libgsl_stubs.a .PHONY: all clean all: @dune build $(TARGETS) clean: @dune clean gsl-ocaml-1.24.3/src/blas.ml000066400000000000000000000270351371237560500155410ustar00rootroot00000000000000let () = Error.init () (** BLAS support *) type order = | RowMajor | ColMajor type transpose = | NoTrans | Trans | ConjTrans type uplo = | Upper | Lower type diag = | NonUnit | Unit type side = | Left | Right open Matrix open 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 Vector.Single open 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 Vector_complex open 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 Vector_complex.Single open 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.24.3/src/blas.mli000066400000000000000000000267751371237560500157240ustar00rootroot00000000000000 (** BLAS support *) type order = | RowMajor | ColMajor type transpose = | NoTrans | Trans | ConjTrans type uplo = | Upper | Lower type diag = | NonUnit | Unit type side = | Left | Right open Matrix open 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 Vector.Single open 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 Vector_complex open 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 Vector_complex.Single open 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.24.3/src/blas_flat.ml000066400000000000000000000136341371237560500165470ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () type order = Blas.order = | RowMajor | ColMajor type transpose = Blas.transpose = | NoTrans | Trans | ConjTrans type uplo = Blas.uplo = | Upper | Lower type diag = Blas.diag = | NonUnit | Unit type side = Blas.side = | Left | Right open Matrix_flat open 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 Vector_complex_flat open 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.24.3/src/blas_flat.mli000066400000000000000000000136011371237560500167120ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type order = Blas.order = | RowMajor | ColMajor type transpose = Blas.transpose = | NoTrans | Trans | ConjTrans type uplo = Blas.uplo = | Upper | Lower type diag = Blas.diag = | NonUnit | Unit type side = Blas.side = | Left | Right open Matrix_flat open 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 Vector_complex_flat open 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.24.3/src/blas_gen.ml000066400000000000000000000137721371237560500163750ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () type order = Blas.order = | RowMajor | ColMajor type transpose = Blas.transpose = | NoTrans | Trans | ConjTrans type uplo = Blas.uplo = | Upper | Lower type diag = Blas.diag = | NonUnit | Unit type side = Blas.side = | Left | Right open 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.24.3/src/blas_gen.mli000066400000000000000000000137371371237560500165470ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) type order = Blas.order = | RowMajor | ColMajor type transpose = Blas.transpose = | NoTrans | Trans | ConjTrans type uplo = Blas.uplo = | Upper | Lower type diag = Blas.diag = | NonUnit | Unit type side = Blas.side = | Left | Right open 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.24.3/src/bspline.ml000066400000000000000000000015071371237560500162500ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2007 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 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 (Vector.create n) in _eval x v ws ; v gsl-ocaml-1.24.3/src/bspline.mli000066400000000000000000000011341371237560500164150ustar00rootroot00000000000000(* 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 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.24.3/src/cheb.ml000066400000000000000000000025361371237560500155200ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 -> 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 -> 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 -> 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.24.3/src/cheb.mli000066400000000000000000000011221371237560500156570ustar00rootroot00000000000000(* 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 -> 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 -> Fun.result val deriv : t -> t val integ : t -> t gsl-ocaml-1.24.3/src/combi.ml000066400000000000000000000013161371237560500157030ustar00rootroot00000000000000open Bigarray let () = Error.init () 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 Error.Gsl_exn (Error.FAILURE, _) -> false gsl-ocaml-1.24.3/src/combi.mli000066400000000000000000000006701371237560500160560ustar00rootroot00000000000000open 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.24.3/src/config/000077500000000000000000000000001371237560500155245ustar00rootroot00000000000000gsl-ocaml-1.24.3/src/config/Makefile000066400000000000000000000001621371237560500171630ustar00rootroot00000000000000TARGETS = discover.bc do_cdf.bc do_const.bc .PHONY: all clean all: @dune build $(TARGETS) clean: @dune clean gsl-ocaml-1.24.3/src/config/discover.ml000066400000000000000000000037751371237560500177100ustar00rootroot00000000000000module Option = struct include Option let value_map ~default ~f = function | Some x -> f x | None -> default end (* Option *) module List = struct include List let find_map t ~f = let rec loop = function | [] -> None | x :: l -> match f x with | None -> loop l | Some _ as r -> r in loop t end (* List *) let () = let module C = Configurator.V1 in let open C.Pkg_config in C.main ~name:"gsl" (fun c -> let conf = let default = { libs = ["-lgsl"; "-lgslcblas"; "-lm"]; cflags = [] } in let write_gsl_include = C.Flags.write_lines "gsl_include.sexp" in let default_gsl_include = ["/usr/include"] in match C.Pkg_config.get c with | None -> write_gsl_include default_gsl_include; default | Some pc -> Option.value_map ~default (C.Pkg_config.query pc ~package:"gsl") ~f:(fun conf -> let gsl_include = Option.value ~default:default_gsl_include @@ List.find_map conf.cflags ~f:(fun cflag -> let len = String.length cflag in if len >= 2 && cflag.[0] = '-' && cflag.[1] = 'I' then Some [String.sub cflag 2 (len - 2)] else None) in write_gsl_include gsl_include; conf) in let conf = let without_cblas () = List.filter (fun x -> not (String.equal x "-lgslcblas")) conf.libs in match Sys.getenv_opt "GSL_CBLAS_LIB" with | Some alt_blas -> { conf with libs = alt_blas :: without_cblas () } | None -> Option.value_map ~default:conf (C.ocaml_config_var c "system") ~f:(function | "macosx" -> let libs = "-framework" :: "Accelerate" :: without_cblas () in { conf with libs } | _ -> conf) in C.Flags.write_sexp "c_flags.sexp" conf.cflags; C.Flags.write_sexp "c_library_flags.sexp" conf.libs) gsl-ocaml-1.24.3/src/config/do_cdf.ml000066400000000000000000000066461371237560500173100ustar00rootroot00000000000000open Printf open Do_common type arg_type = FLOAT | UINT let parse_fun = 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 ic s = if not (Str.string_match regexp_full s 0) then if not (Str.string_match regexp_partial s 0) then parse_fun ic else match input_line ic with | line -> loop ic (s ^ " " ^ line) | exception End_of_file -> eprintf "partial line at EOF\n"; raise End_of_file else 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 ignore (Str.search_forward regexp_arg s !i); 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 fun_name, args else begin eprintf "functions `%s' has more than 5 arguments, this is unsupported\n%!" fun_name; parse_fun ic end and parse_fun ic = loop ic (input_line ic) in parse_fun let all_float args = List.for_all (function (FLOAT, _) -> true | _ -> false) args let print_all_float fun_name buf args = if all_float args then bprintf buf " \"gsl_cdf_%s\" [@@unboxed] [@@noalloc]" fun_name let print_ml_args buf args = List.iter (fun (ty, a) -> let l = String.lowercase_ascii a in match ty with | FLOAT -> bprintf buf "%s:float -> " l | UINT -> bprintf buf "%s:int -> " l) args let print_ml buf (fun_name, args) = bprintf buf "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 buf args = List.iter (fun (ty, _) -> match ty with | FLOAT -> output_string buf " Double_val," | UINT -> output_string buf " Unsigned_int_val,") args let print_c oc (fun_name, args) = fprintf oc "ML%d(gsl_cdf_%s,%a copy_double)\n" (List.length args) fun_name print_c_args args let () = let gsl_header = Filename.concat gsl_include_dir "gsl_cdf.h" in In_channel.with_file gsl_header ~f:(fun ic -> Out_channel.with_file "cdf.mli" ~f:(fun cdfi_oc -> Out_channel.with_file "cdf.ml" ~f:(fun cdf_oc -> Out_channel.with_file "mlgsl_cdf.c" ~f:(fun cdfc_oc -> let print_both str = output_string cdfi_oc str; output_string cdf_oc str in output_string cdfc_oc "#include \n#include \"wrappers.h\"\n\n"; print_both "(** Cumulative distribution functions *)\n\n"; try while true do let fn = parse_fun ic in let buf = Buffer.create 256 in print_ml buf fn; Buffer.output_buffer cdfi_oc buf; Buffer.output_buffer cdf_oc buf; print_c cdfc_oc fn done with End_of_file -> ()); output_string cdf_oc "\nlet () = Error.init ()\n"))) gsl-ocaml-1.24.3/src/config/do_common.ml000066400000000000000000000012771371237560500200370ustar00rootroot00000000000000let channel_with_file open_ch close_ch name ~f = let ch = open_ch name in Fun.protect ~finally:(fun () -> close_ch ch) (fun () -> f ch) module In_channel = struct let with_file file = channel_with_file open_in close_in file let rec iter_lines ic ~f = match input_line ic with | line -> f line; iter_lines ic ~f | exception End_of_file -> () end (* In_channel *) module Out_channel = struct let with_file file = channel_with_file open_out close_out file end (* Out_channel *) let gsl_include_dir = let gsl_include = let ic = open_in "gsl_include.sexp"in Fun.protect ~finally:(fun () -> close_in ic) (fun () -> input_line ic) in Filename.concat gsl_include "gsl" gsl-ocaml-1.24.3/src/config/do_const.ml000066400000000000000000000030531371237560500176670ustar00rootroot00000000000000open Printf open Do_common let () = let rex = Str.regexp "^#define GSL_CONST_[^_]+_\\(.*\\)\\b.*(\\(.*\\))" in let get_name line = String.lowercase_ascii (Str.matched_group 1 line) in let get_data line = String.lowercase_ascii (Str.matched_group 2 line) in Out_channel.with_file "const.mli" ~f:(fun mli_oc -> Out_channel.with_file "const.ml" ~f:(fun ml_oc -> let act const = let print_both str = output_string mli_oc str; output_string ml_oc str in print_both "(** Values of physical constants *)\n"; let upper_const = String.uppercase_ascii const in fprintf mli_oc "\nmodule %s : sig\n" (String.uppercase_ascii const); fprintf ml_oc "\nmodule %s = struct\n" upper_const; let gsl_path = Filename.concat gsl_include_dir (sprintf "gsl_const_%s.h" const) in In_channel.with_file gsl_path ~f:(fun ic -> let rec loop () = match input_line ic with | line -> if Str.string_match rex line 0 then begin let name = get_name line in let data = get_data line in fprintf mli_oc " val %s : float\n" name; fprintf ml_oc " let %s = %s\n" name data end; loop () | exception End_of_file -> print_both "end\n" in loop ()) in let gsl_consts = [| "cgs"; "cgsm"; "mks"; "mksa"; "num" |] in Array.iter act gsl_consts; output_string ml_oc "\nlet () = Error.init ()\n")) gsl-ocaml-1.24.3/src/config/do_sf.ml000066400000000000000000000142471371237560500171600ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2017- - Markus Mottl *) (* Copyright (©) 2002-2005 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Printf open Do_common let split ?(collapse=false) c s = let len = String.length s in let rec proc accu n = let n' = match String.index_from s n c with | i -> i | exception 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' (n' + 1) in proc [] 0 let words_list s = split ~collapse:true ' ' s (** 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 String.split_on_char '@' 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" (String.trim name) (String.trim arg1); List.iter (fun a -> Format.fprintf bh " -> %s" (String.trim a)) argr; Format.fprintf bh "@ = "; if List.length args > 6 then Format.fprintf bh "\"%s_bc\"" name_c; if (* List.for_all ~f:((=) "float") args && *) (name_float <> "") then begin if List.length args <= 6 then Format.fprintf bh "\"%s\"" name_c; Format.fprintf bh " \"%s\" [%@%@unboxed] [%@%@noalloc]" name_float end else Format.fprintf bh "\"%s\"" name_c; Format.fprintf bh "@]%!"; Buffer.contents b (** << fun1 arg1 arg2 >> → << fun1@ml_gsl_sf_fun1,arg1,arg2,float >> → << fun1_e@ml_gsl_sf_fun1_e,arg1,arg2,result >> *) let sf_quot = let b = Buffer.create 256 in fun str -> let wl = words_list str in let flt, wl = List.partition ((=) "@float") wl in let has_float = not (flt = []) 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 has_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 "\n" (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 not (Str.string_match quotation l 0) then l else 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 *)" let () = In_channel.with_file "sf.mli.q" ~f:(fun ic -> Out_channel.with_file "sf.mli" ~f:(fun mli_oc -> Out_channel.with_file "sf.ml" ~f:(fun ml_oc -> In_channel.iter_lines ic ~f:(fun l -> let nl = process_line l in output_string mli_oc nl; output_string ml_oc nl; output_char mli_oc '\n'; output_char ml_oc '\n'); output_string ml_oc "\nlet () = Error.init ()\n"))) gsl-ocaml-1.24.3/src/config/dune000066400000000000000000000005661371237560500164110ustar00rootroot00000000000000(library (name do_common) (modules do_common) ) (executable (name discover) (modules discover) (libraries dune.configurator) ) (executable (name do_cdf) (modules do_cdf) (libraries do_common str) ) (executable (name do_const) (modules do_const) (libraries do_common str) ) (executable (name do_sf) (modules do_sf) (libraries do_common str) ) gsl-ocaml-1.24.3/src/deriv.ml000066400000000000000000000010521371237560500157200ustar00rootroot00000000000000(* 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 *) let () = Error.init () external central : f:(float -> float) -> x:float -> h:float -> Fun.result = "ml_gsl_deriv_central" external forward : f:(float -> float) -> x:float -> h:float -> Fun.result = "ml_gsl_deriv_forward" external backward : f:(float -> float) -> x:float -> h:float -> Fun.result = "ml_gsl_deriv_backward" gsl-ocaml-1.24.3/src/deriv.mli000066400000000000000000000034411371237560500160750ustar00rootroot00000000000000(* 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 -> 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 -> 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 -> 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.24.3/src/dune000066400000000000000000000030701371237560500151350ustar00rootroot00000000000000(library (public_name gsl) (c_names mlgsl_blas mlgsl_blas_complex mlgsl_blas_complex_float mlgsl_blas_float mlgsl_bspline mlgsl_cdf mlgsl_cheb mlgsl_combi mlgsl_complex mlgsl_deriv mlgsl_eigen mlgsl_error mlgsl_fft mlgsl_fit mlgsl_fun mlgsl_histo mlgsl_ieee mlgsl_integration mlgsl_interp mlgsl_linalg mlgsl_linalg_complex mlgsl_math mlgsl_matrix_complex mlgsl_matrix_complex_float mlgsl_matrix_double mlgsl_matrix_float mlgsl_min mlgsl_monte mlgsl_multifit mlgsl_multimin mlgsl_multiroots mlgsl_odeiv mlgsl_permut mlgsl_poly mlgsl_qrng mlgsl_randist mlgsl_rng mlgsl_roots mlgsl_sf mlgsl_sort mlgsl_stats mlgsl_sum mlgsl_vector_double mlgsl_vector_float mlgsl_wavelet ) (c_flags (:standard) (:include c_flags.sexp) -fPIC -DPIC ; NOTE: for limiting excessive warning about unused parameters -Wno-unused-parameter ) (c_library_flags (:include c_library_flags.sexp)) (libraries bigarray) ) (rule (targets c_flags.sexp c_library_flags.sexp gsl_include.sexp) (deps (:discover config/discover.exe)) (action (run %{discover})) ) (rule (targets cdf.mli cdf.ml mlgsl_cdf.c) (deps config/do_cdf.exe gsl_include.sexp) (action (run config/do_cdf.exe)) ) (rule (targets const.mli const.ml) (deps config/do_const.exe gsl_include.sexp) (action (run config/do_const.exe)) ) (rule (targets sf.mli sf.ml) (deps config/do_sf.exe sf.mli.q) (action (run config/do_sf.exe)) ) gsl-ocaml-1.24.3/src/eigen.ml000066400000000000000000000112621371237560500157020ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Vectmat let () = Error.init () 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' = Vectmat.mat_convert ?protect a in let (n, _) = Vectmat.dims a' in let v = 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' = Vectmat.mat_convert ?protect a in let (n, _) = Vectmat.dims a' in let v = Vector.create n in let evec = 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 : Vector.vector * 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' = Vectmat.cmat_convert ?protect a in let (n, _) = Vectmat.dims a' in let v = 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' = Vectmat.cmat_convert ?protect a in let (n, _) = Vectmat.dims a' in let v = Vector.create n in let evec = 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 : Vector.vector * 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' = Vectmat.mat_convert ?protect a in let (n, _) = Vectmat.dims a' in let v = 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' = Vectmat.mat_convert ?protect a in let (n, _) = Vectmat.dims a' in let v = Vector_complex.create n in let evec = 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 : Vector_complex.vector * Matrix_complex.matrix -> sort -> unit = "ml_gsl_eigen_nonsymmv_sort" gsl-ocaml-1.24.3/src/eigen.mli000066400000000000000000000055221371237560500160550ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Eigensystems *) open 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 Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> 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 Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> Vector.vector * Matrix.matrix type sort = | VAL_ASC | VAL_DESC | ABS_ASC | ABS_DESC external symmv_sort : Vector.vector * 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 Matrix_complex.matrix | `CMF of Matrix_complex_flat.matrix | `CA of Gsl_complex.complex_array * int * int ] -> 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 Matrix_complex.matrix | `CMF of Matrix_complex_flat.matrix | `CA of Gsl_complex.complex_array * int * int ] -> Vector.vector * Matrix_complex.matrix external hermv_sort : Vector.vector * 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 Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> 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 Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> Vector_complex.vector * Matrix_complex.matrix external nonsymmv_sort : Vector_complex.vector * Matrix_complex.matrix -> sort -> unit = "ml_gsl_eigen_nonsymmv_sort" gsl-ocaml-1.24.3/src/error.ml000066400000000000000000000072461371237560500157530ustar00rootroot00000000000000(* 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" 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 registered = ref false let register () = if not !registered then begin registered := true; Callback.register "mlgsl_err_handler" handler; Printexc.register_printer printer; end let initialized = ref false let init () = if not !initialized then begin initialized := true; register (); setup_caml_error_handler true; end let uninit () = if !initialized then begin setup_caml_error_handler false; initialized := false; end let () = init () gsl-ocaml-1.24.3/src/error.mli000066400000000000000000000063351371237560500161220ustar00rootroot00000000000000(* 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 ()] sets up 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.24.3/src/fft.ml000066400000000000000000000150641371237560500153760ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Gsl_complex let () = Error.init () 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.24.3/src/fft.mli000066400000000000000000000061631371237560500155470ustar00rootroot00000000000000(* 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.24.3/src/fit.ml000066400000000000000000000015401371237560500153730ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 -> 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 -> Fun.result = "ml_gsl_fit_mul_est" gsl-ocaml-1.24.3/src/fit.mli000066400000000000000000000015311371237560500155440ustar00rootroot00000000000000(* 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 -> 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 -> Fun.result = "ml_gsl_fit_mul_est" gsl-ocaml-1.24.3/src/fun.ml000066400000000000000000000021331371237560500154000ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 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:Matrix.matrix -> unit ; multi_fdf : x:vector -> f:vector -> j: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.24.3/src/fun.mli000066400000000000000000000031661371237560500155600ustar00rootroot00000000000000(* 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 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:Matrix.matrix -> unit ; multi_fdf : x:vector -> f:vector -> j: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.24.3/src/gsl_complex.ml000066400000000000000000000112071371237560500171260ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012, 2003 - Olivier Andrieu, Paul Pelzl *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/gsl_complex.mli000066400000000000000000000104741371237560500173040ustar00rootroot00000000000000(* 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.24.3/src/gsl_sort.ml000066400000000000000000000042561371237560500164540ustar00rootroot00000000000000let () = Error.init () external vector : Vector.vector -> unit = "ml_gsl_sort_vector" external _vector_index : Permut.permut -> Vector.vector -> unit = "ml_gsl_sort_vector_index" let vector_index v = let p = Permut.create (Vector.length v) in _vector_index p v ; p external _vector_smallest : float array -> Vector.vector -> unit = "ml_gsl_sort_vector_smallest" external _vector_largest : float array -> 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 : Permut.permut -> Vector.vector -> unit = "ml_gsl_sort_vector_smallest_index" external _vector_largest_index : Permut.permut -> Vector.vector -> unit = "ml_gsl_sort_vector_largest_index" let vector_smallest_index k v = let p = Permut.create k in _vector_smallest_index p v ; p let vector_largest_index k v = let p = Permut.create k in _vector_largest_index p v ; p external vector_flat : Vector_flat.vector -> unit = "ml_gsl_sort_vector" external _vector_flat_index : Permut.permut -> Vector_flat.vector -> unit = "ml_gsl_sort_vector_index" let vector_flat_index v = let p = Permut.create (Vector_flat.length v) in _vector_flat_index p v ; p external _vector_flat_smallest : float array -> Vector_flat.vector -> unit = "ml_gsl_sort_vector_smallest" external _vector_flat_largest : float array -> 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 : Permut.permut -> Vector_flat.vector -> unit = "ml_gsl_sort_vector_smallest_index" external _vector_flat_largest_index : Permut.permut -> Vector_flat.vector -> unit = "ml_gsl_sort_vector_largest_index" let vector_flat_smallest_index k v = let p = Permut.create k in _vector_flat_smallest_index p v ; p let vector_flat_largest_index k v = let p = Permut.create k in _vector_flat_largest_index p v ; p gsl-ocaml-1.24.3/src/gsl_sort.mli000066400000000000000000000014601371237560500166170ustar00rootroot00000000000000(** Sorting *) val vector : Vector.vector -> unit val vector_index : Vector.vector -> Permut.permut val vector_smallest : int -> Vector.vector -> float array val vector_largest : int -> Vector.vector -> float array val vector_smallest_index : int -> Vector.vector -> Permut.permut val vector_largest_index : int -> Vector.vector -> Permut.permut val vector_flat : Vector_flat.vector -> unit val vector_flat_index : Vector_flat.vector -> Permut.permut val vector_flat_smallest : int -> Vector_flat.vector -> float array val vector_flat_largest : int -> Vector_flat.vector -> float array val vector_flat_smallest_index : int -> Vector_flat.vector -> Permut.permut val vector_flat_largest_index : int -> Vector_flat.vector -> Permut.permut gsl-ocaml-1.24.3/src/histo.ml000066400000000000000000000051571371237560500157470ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () (** 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.24.3/src/histo.mli000066400000000000000000000042741371237560500161170ustar00rootroot00000000000000(* 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.24.3/src/ieee.ml000066400000000000000000000032731371237560500155250ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/ieee.mli000066400000000000000000000024141371237560500156720ustar00rootroot00000000000000(* 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.24.3/src/integration.ml000066400000000000000000000077371371237560500171520ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) open Fun let () = Error.init () 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.24.3/src/integration.mli000066400000000000000000000063361371237560500173150ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Numerical Integration *) open 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.24.3/src/interp.ml000066400000000000000000000051221371237560500161120ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/interp.mli000066400000000000000000000034541371237560500162710ustar00rootroot00000000000000(* 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.24.3/src/io.h000066400000000000000000000112031371237560500150340ustar00rootroot00000000000000/***********************************************************************/ /* */ /* 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.24.3/src/linalg.ml000066400000000000000000000245141371237560500160650ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () open 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 -> Permut.permut -> int = "ml_gsl_linalg_LU_decomp" external _LU_solve : mat -> Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LU_solve" external _LU_svx : mat -> Permut.permut -> vec -> unit = "ml_gsl_linalg_LU_svx" external _LU_refine : a:mat -> lu:mat -> Permut.permut -> b:vec -> x:vec -> res:vec -> unit = "ml_gsl_linalg_LU_refine_bc" "ml_gsl_linalg_LU_refine" external _LU_invert : mat -> 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, _) = Vectmat.dims mA in let p = 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, _) = Vectmat.dims mA in let p = Permut.create len in let _ = _LU_decomp mA p in let x = Vector_flat.create len in _LU_solve mA p ~b:vB ~x:(`VF x) ; x.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 -> Vectmat.tmp lu in _LU_invert lu lu_p result ; result (* Complex LU decomposition *) external complex_LU_decomp : cmat -> Permut.permut -> int = "ml_gsl_linalg_complex_LU_decomp" external complex_LU_solve : cmat -> Permut.permut -> b:cvec -> x:cvec -> unit = "ml_gsl_linalg_complex_LU_solve" external complex_LU_svx : cmat -> Permut.permut -> cvec -> unit = "ml_gsl_linalg_complex_LU_svx" external complex_LU_refine : a:cmat -> lu:cmat -> 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 -> 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:Permut.permut -> norm:vec -> int = "ml_gsl_linalg_QRPT_decomp" external _QRPT_decomp2 : a:mat -> q:mat -> r:mat -> tau:vec -> p:Permut.permut -> norm:vec -> int = "ml_gsl_linalg_QRPT_decomp2_bc" "ml_gsl_linalg_QRPT_decomp2" external _QRPT_solve : qr:mat -> tau:vec -> p:Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_solve" external _QRPT_svx : qr:mat -> tau:vec -> p:Permut.permut -> x:vec -> unit = "ml_gsl_linalg_QRPT_svx" external _QRPT_QRsolve : q:mat -> r:mat -> p:Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_QRsolve" external _QRPT_update : q:mat -> r:mat -> p:Permut.permut -> u:vec -> v:vec -> unit = "ml_gsl_linalg_QRPT_update" external _QRPT_Rsolve : qr:mat -> p:Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_Rsolve" external _QRPT_Rsvx : qr:mat -> p: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 -> Permut.permut -> norm:vec -> int = "ml_gsl_linalg_PTLQ_decomp" external _PTLQ_decomp2 : a:mat -> q:mat -> r:mat -> tau:vec -> Permut.permut -> norm:vec -> int = "ml_gsl_linalg_PTLQ_decomp2_bc" "ml_gsl_linalg_PTLQ_decomp2" external _PTLQ_solve_T : qr:mat -> tau:vec -> Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_solve_T" external _PTLQ_svx_T : lq:mat -> tau:vec -> Permut.permut -> x:vec -> unit = "ml_gsl_linalg_PTLQ_svx_T" external _PTLQ_LQsolve_T : q:mat -> l:mat -> Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_LQsolve_T" external _PTLQ_Lsolve_T : lq:mat -> Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_Lsolve_T" external _PTLQ_Lsvx_T : lq:mat -> Permut.permut -> x:vec -> unit = "ml_gsl_linalg_PTLQ_Lsvx_T" external _PTLQ_update : q:mat -> l:mat -> 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 = Vector_flat.create (Vectmat.length vB) in _HH_solve mA ~b:vB ~x:(`VF vX) ; vX.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 -> Fun.mode -> unit = "ml_gsl_linalg_exponential_ss" let exponential ?(mode=Fun.DOUBLE) mat = let mA = Vectmat.mat_convert mat in let eA = Vectmat.tmp mA in _exponential mA (eA : [`M of Matrix.matrix] :> mat) mode ; eA gsl-ocaml-1.24.3/src/linalg.mli000066400000000000000000000253151371237560500162360ustar00rootroot00000000000000(* 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 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 -> Permut.permut -> int = "ml_gsl_linalg_LU_decomp" external _LU_solve : mat -> Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_LU_solve" external _LU_svx : mat -> Permut.permut -> vec -> unit = "ml_gsl_linalg_LU_svx" external _LU_refine : a:mat -> lu:mat -> Permut.permut -> b:vec -> x:vec -> res:vec -> unit = "ml_gsl_linalg_LU_refine_bc" "ml_gsl_linalg_LU_refine" external _LU_invert : mat -> 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 Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> mat * Permut.permut * int val solve_LU : ?protect:bool -> [< `M of Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> [< `A of float array | `VF of Vector_flat.vector | `V of Vector.vector] -> float array val det_LU : ?protect:bool -> [< `M of Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> float val invert_LU : ?protect:bool -> ?result:mat -> [< `M of Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> mat (** {3 Complex LU decomposition} *) external complex_LU_decomp : cmat -> Permut.permut -> int = "ml_gsl_linalg_complex_LU_decomp" external complex_LU_solve : cmat -> Permut.permut -> b:cvec -> x:cvec -> unit = "ml_gsl_linalg_complex_LU_solve" external complex_LU_svx : cmat -> Permut.permut -> cvec -> unit = "ml_gsl_linalg_complex_LU_svx" external complex_LU_refine : a:cmat -> lu:cmat -> 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 -> 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:Permut.permut -> norm:vec -> int = "ml_gsl_linalg_QRPT_decomp" external _QRPT_decomp2 : a:mat -> q:mat -> r:mat -> tau:vec -> p:Permut.permut -> norm:vec -> int = "ml_gsl_linalg_QRPT_decomp2_bc" "ml_gsl_linalg_QRPT_decomp2" external _QRPT_solve : qr:mat -> tau:vec -> p:Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_solve" external _QRPT_svx : qr:mat -> tau:vec -> p:Permut.permut -> x:vec -> unit = "ml_gsl_linalg_QRPT_svx" external _QRPT_QRsolve : q:mat -> r:mat -> p:Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_QRsolve" external _QRPT_update : q:mat -> r:mat -> p:Permut.permut -> u:vec -> v:vec -> unit = "ml_gsl_linalg_QRPT_update" external _QRPT_Rsolve : qr:mat -> p:Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_QRPT_Rsolve" external _QRPT_Rsvx : qr:mat -> p: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 -> Permut.permut -> norm:vec -> int = "ml_gsl_linalg_PTLQ_decomp" external _PTLQ_decomp2 : a:mat -> q:mat -> r:mat -> tau:vec -> Permut.permut -> norm:vec -> int = "ml_gsl_linalg_PTLQ_decomp2_bc" "ml_gsl_linalg_PTLQ_decomp2" external _PTLQ_solve_T : qr:mat -> tau:vec -> Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_solve_T" external _PTLQ_svx_T : lq:mat -> tau:vec -> Permut.permut -> x:vec -> unit = "ml_gsl_linalg_PTLQ_svx_T" external _PTLQ_LQsolve_T : q:mat -> l:mat -> Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_LQsolve_T" external _PTLQ_Lsolve_T : lq:mat -> Permut.permut -> b:vec -> x:vec -> unit = "ml_gsl_linalg_PTLQ_Lsolve_T" external _PTLQ_Lsvx_T : lq:mat -> Permut.permut -> x:vec -> unit = "ml_gsl_linalg_PTLQ_Lsvx_T" external _PTLQ_update : q:mat -> l:mat -> 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 Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> [< `A of float array | `VF of Vector_flat.vector | `V of 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 -> Fun.mode -> unit = "ml_gsl_linalg_exponential_ss" val exponential : ?mode:Fun.mode -> [< `M of Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int] -> [ `M of Matrix.matrix] gsl-ocaml-1.24.3/src/math.ml000066400000000000000000000041761371237560500155520ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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" [@@unboxed] [@@noalloc] external expm1 : float -> float = "ml_gsl_expm1" "gsl_expm1" [@@unboxed] [@@noalloc] external hypot : float -> float -> float = "ml_gsl_hypot" "gsl_hypot" [@@unboxed] [@@noalloc] external acosh : float -> float = "ml_gsl_acosh" "gsl_acosh" [@@unboxed] [@@noalloc] external asinh : float -> float = "ml_gsl_asinh" "gsl_asinh" [@@unboxed] [@@noalloc] external atanh : float -> float = "ml_gsl_atanh" "gsl_atanh" [@@unboxed] [@@noalloc] external fcmp : float -> float -> epsilon:float -> int = "ml_gsl_fcmp" gsl-ocaml-1.24.3/src/math.mli000066400000000000000000000033201371237560500157110ustar00rootroot00000000000000(* 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" [@@unboxed] [@@noalloc] external expm1 : float -> float = "ml_gsl_expm1" "gsl_expm1" [@@unboxed] [@@noalloc] external hypot : float -> float -> float = "ml_gsl_hypot" "gsl_hypot" [@@unboxed] [@@noalloc] external acosh : float -> float = "ml_gsl_acosh" "gsl_acosh" [@@unboxed] [@@noalloc] external asinh : float -> float = "ml_gsl_asinh" "gsl_asinh" [@@unboxed] [@@noalloc] external atanh : float -> float = "ml_gsl_atanh" "gsl_atanh" [@@unboxed] [@@noalloc] external fcmp : float -> float -> epsilon:float -> int = "ml_gsl_fcmp" gsl-ocaml-1.24.3/src/matrix.ml000066400000000000000000000117661371237560500161300ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/matrix.mli000066400000000000000000000072021371237560500162670ustar00rootroot00000000000000(* 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 -> 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 -> 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.24.3/src/matrix_complex.ml000066400000000000000000000145271371237560500176550ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/matrix_complex.mli000066400000000000000000000101751371237560500200210ustar00rootroot00000000000000(* 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 -> 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 -> 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.24.3/src/matrix_complex_flat.ml000066400000000000000000000132521371237560500206550ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 = Vector_complex_flat.view_complex_array ~off:(m.off + i * m.tda) ~len:m.dim2 m.data let column m j = Vector_complex_flat.view_complex_array ~stride:m.tda ~off:(m.off + j) ~len:m.dim1 m.data let diagonal m = 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 = 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 = 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 = Vector_complex_flat.length v in if dim1 * tda > len - off || dim2 > tda then invalid_arg "view_vector" ; { data = v.Vector_complex_flat.data; off = v.Vector_complex_flat.off + off; dim1 = dim1; dim2 = dim2; tda = tda } gsl-ocaml-1.24.3/src/matrix_complex_flat.mli000066400000000000000000000050501371237560500210230ustar00rootroot00000000000000(* 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 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.24.3/src/matrix_flat.ml000066400000000000000000000107571371237560500171350ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 = Vector_flat.view_array ~off:(m.off + i * m.tda) ~len:m.dim2 m.data let column m j = Vector_flat.view_array ~stride:m.tda ~off:(m.off + j) ~len:m.dim1 m.data let diagonal m = Vector_flat.view_array ~stride:(m.tda + 1) ~off:m.off ~len:(min m.dim1 m.dim2) m.data let subdiagonal m k = 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 = 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 = Vector_flat.length v in if dim1 * tda > len - off || dim2 > tda then invalid_arg "view_vector" ; { data = v.Vector_flat.data; off = v.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.24.3/src/matrix_flat.mli000066400000000000000000000044401371237560500172760ustar00rootroot00000000000000(* 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 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.24.3/src/min.ml000066400000000000000000000017701371237560500154010ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 -> 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.24.3/src/min.mli000066400000000000000000000013641371237560500155510ustar00rootroot00000000000000(* 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 -> 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.24.3/src/misc.ml000066400000000000000000000007431371237560500155500ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/mlgsl_blas.c000066400000000000000000000157741371237560500165600ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_blas.h000066400000000000000000000016211371237560500165470ustar00rootroot00000000000000/* 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(value v) { CBLAS_ORDER_t conv[] = { CblasRowMajor, CblasColMajor }; return conv[ Int_val(v) ]; } static inline CBLAS_TRANSPOSE_t CBLAS_TRANS_val(value v) { CBLAS_TRANSPOSE_t conv[] = { CblasNoTrans, CblasTrans, CblasConjTrans }; return conv[ Int_val(v) ]; } static inline CBLAS_UPLO_t CBLAS_UPLO_val(value v) { CBLAS_UPLO_t conv[] = { CblasUpper, CblasLower }; return conv[ Int_val(v) ]; } static inline CBLAS_DIAG_t CBLAS_DIAG_val(value v) { CBLAS_DIAG_t conv[] = { CblasNonUnit, CblasUnit }; return conv[ Int_val(v) ]; } static inline CBLAS_SIDE_t CBLAS_SIDE_val(value v) { CBLAS_SIDE_t conv[] = { CblasLeft, CblasRight }; return conv[ Int_val(v) ]; } gsl-ocaml-1.24.3/src/mlgsl_blas_complex.c000066400000000000000000000227261371237560500203020ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_blas_complex_float.c000066400000000000000000000230311371237560500214550ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_blas_float.c000066400000000000000000000165351371237560500177410ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_bspline.c000066400000000000000000000021201371237560500172500ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_cheb.c000066400000000000000000000032151371237560500165230ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_combi.c000066400000000000000000000021221371237560500167070ustar00rootroot00000000000000#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.24.3/src/mlgsl_complex.c000066400000000000000000000044341371237560500172750ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_complex.h000066400000000000000000000016621371237560500173020ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_deriv.c000066400000000000000000000021531371237560500167330ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_eigen.c000066400000000000000000000132501371237560500167110ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_error.c000066400000000000000000000031051371237560500167510ustar00rootroot00000000000000/* 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 const 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.24.3/src/mlgsl_fft.c000066400000000000000000000230301371237560500163760ustar00rootroot00000000000000/* 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 const value *layout_exn; if((enum mlgsl_fft_array_layout) 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.24.3/src/mlgsl_fit.c000066400000000000000000000076141371237560500164130ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_fun.c000066400000000000000000000222741371237560500164200ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_fun.h000066400000000000000000000043521371237560500164220ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_histo.c000066400000000000000000000103071371237560500167500ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_ieee.c000066400000000000000000000056501371237560500165360ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_integration.c000066400000000000000000000236641371237560500201570ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_interp.c000066400000000000000000000067431371237560500171340ustar00rootroot00000000000000/* 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); mlsize_t 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.24.3/src/mlgsl_linalg_complex.c000066400000000000000000000073421371237560500206240ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_math.c000066400000000000000000000011021371237560500165440ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_matrix.h000066400000000000000000000034721371237560500171400ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_matrix_complex.c000066400000000000000000000001031371237560500206460ustar00rootroot00000000000000 #include "mlgsl_matrix_complex.h" #include "mlgsl_matrix_impl.h" gsl-ocaml-1.24.3/src/mlgsl_matrix_complex.h000066400000000000000000000012061371237560500206600ustar00rootroot00000000000000 #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.24.3/src/mlgsl_matrix_complex_float.c000066400000000000000000000001111371237560500220320ustar00rootroot00000000000000 #include "mlgsl_matrix_complex_float.h" #include "mlgsl_matrix_impl.h" gsl-ocaml-1.24.3/src/mlgsl_matrix_complex_float.h000066400000000000000000000005201371237560500220430ustar00rootroot00000000000000 #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.24.3/src/mlgsl_matrix_double.c000066400000000000000000000001021371237560500204500ustar00rootroot00000000000000 #include "mlgsl_matrix_double.h" #include "mlgsl_matrix_impl.h" gsl-ocaml-1.24.3/src/mlgsl_matrix_double.h000066400000000000000000000003421371237560500204630ustar00rootroot00000000000000 #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.24.3/src/mlgsl_matrix_float.c000066400000000000000000000001011371237560500203020ustar00rootroot00000000000000 #include "mlgsl_matrix_float.h" #include "mlgsl_matrix_impl.h" gsl-ocaml-1.24.3/src/mlgsl_matrix_float.h000066400000000000000000000004251371237560500203200ustar00rootroot00000000000000 #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.24.3/src/mlgsl_matrix_impl.h000066400000000000000000000057221371237560500201610ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_min.c000066400000000000000000000042301371237560500164030ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_monte.c000066400000000000000000000235641371237560500167550ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_multifit.c000066400000000000000000000077141371237560500174670ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_multimin.c000066400000000000000000000137031371237560500174630ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_multiroots.c000066400000000000000000000165331371237560500200520ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_odeiv.c000066400000000000000000000211641371237560500167330ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_permut.c000066400000000000000000000137271371237560500171470ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_permut.h000066400000000000000000000006631371237560500171470ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_poly.c000066400000000000000000000065621371237560500166150ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_qrng.c000066400000000000000000000030041371237560500165650ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_randist.c000066400000000000000000000254031371237560500172710ustar00rootroot00000000000000/* 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_rng.h" #include "mlgsl_vector_double.h" #include "mlgsl_matrix_double.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) /* MULTIVARIATE */ CAMLprim value ml_gsl_ran_multivariate_gaussian(value rng, value mu, value l, value out) { #if GSL_MAJOR_VERSION > 2 || (GSL_MAJOR_VERSION >= 2 && GSL_MINOR_VERSION >= 2) gsl_vector v_mu, v_out; gsl_matrix m_l; mlgsl_vec_of_value(&v_mu, mu); mlgsl_vec_of_value(&v_out, out); mlgsl_mat_of_value(&m_l, l); gsl_ran_multivariate_gaussian(Rng_val(rng), &v_mu, &m_l, &v_out); return Val_unit; #else caml_failwith( "Gsl.Randist.multivariate_gaussian: not supported by this GSL version"); #endif } /* 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) { mlsize_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); { mlsize_t 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 = caml_alloc_initialized_string(len, state); 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); const 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); mlsize_t i; for(i=0; i #include #define Rng_val(v) ((gsl_rng *)(Field(v, 0))) gsl-ocaml-1.24.3/src/mlgsl_roots.c000066400000000000000000000076751371237560500170060ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_sf.c000066400000000000000000000454371371237560500162460ustar00rootroot00000000000000/* 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" 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 */ SF2(hyperg_0F1, Double_val, Double_val) SF3(hyperg_1F1_int, Int_val, Int_val, Double_val) SF3(hyperg_1F1, Double_val, Double_val, Double_val) SF3(hyperg_U_int, Int_val, Int_val, Double_val) CAMLprim value ml_gsl_sf_hyperg_U_int_e10_e(value m, value n, value x) { gsl_sf_result_e10 res; gsl_sf_hyperg_U_int_e10_e(Int_val(m), Int_val(n), Double_val(x), &res); return val_of_result_e10(&res); } SF3(hyperg_U, Double_val, Double_val, Double_val) CAMLprim value ml_gsl_sf_hyperg_U_e10_e(value a, value b, value x) { gsl_sf_result_e10 res; gsl_sf_hyperg_U_e10_e(Double_val(a), Double_val(b), Double_val(x), &res); return val_of_result_e10(&res); } SF4(hyperg_2F1 , Double_val, Double_val, Double_val, Double_val) SF4(hyperg_2F1_conj, Double_val, Double_val, Double_val, Double_val) SF4(hyperg_2F1_renorm, Double_val, Double_val, Double_val, Double_val) SF4(hyperg_2F1_conj_renorm, Double_val, Double_val, Double_val, Double_val) SF3(hyperg_2F0, Double_val, Double_val, Double_val) /* 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 */ #if GSL_MAJOR_VERSION > 1 CAMLprim value ml_gsl_sf_legendre_array(value norm, value vlmax, value m, value x, value result_array) { const size_t lmax = Int_val(vlmax); if (Double_array_length(result_array) < gsl_sf_legendre_array_n(lmax)) { caml_invalid_argument("Gsl.Sf.legendre_array: array too small"); } gsl_sf_legendre_array(Int_val(norm), lmax, Double_val(x), Double_array_val(result_array)); return Val_unit; } ML1(gsl_sf_legendre_array_n, Int_val, Val_int) ML2(gsl_sf_legendre_array_index, Int_val, Int_val, Val_int) #else CAMLprim value ml_gsl_sf_legendre_array(value norm, value vlmax, value m, value x, value result_array) { caml_failwith("Gsl.Sf.legendre_array: not supported by GSL version 1"); } CAMLprim value ml_gsl_sf_legendre_array_n(value arg1) { caml_failwith("Gsl.Sf.legendre_array_n: not supported by GSL version 1"); } CAMLprim value ml_gsl_sf_legendre_array_index(value arg1, value arg2) { caml_failwith("Gsl.Sf.legendre_array_index: not supported by GSL version 1"); } #endif SF3(legendre_Plm, Int_val, Int_val, Double_val) SF3(legendre_sphPlm, Int_val, Int_val, Double_val) /* 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.24.3/src/mlgsl_sort.c000066400000000000000000000031231371237560500166070ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_stats.c000066400000000000000000000212611371237560500167610ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_sum.c000066400000000000000000000033521371237560500164300ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_vector.h000066400000000000000000000040471371237560500171350ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_vector_complex.h000066400000000000000000000007641371237560500206660ustar00rootroot00000000000000 #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.24.3/src/mlgsl_vector_complex_float.h000066400000000000000000000002701371237560500220430ustar00rootroot00000000000000 #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.24.3/src/mlgsl_vector_double.c000066400000000000000000000001021371237560500204460ustar00rootroot00000000000000 #include "mlgsl_vector_double.h" #include "mlgsl_vector_impl.h" gsl-ocaml-1.24.3/src/mlgsl_vector_double.h000066400000000000000000000001751371237560500204650ustar00rootroot00000000000000 #define BASE_TYPE double #define CONV_FLAT #define TYPE(t) t #define FUNCTION(a,b) a ## _ ## b #include "mlgsl_vector.h" gsl-ocaml-1.24.3/src/mlgsl_vector_float.c000066400000000000000000000001011371237560500203000ustar00rootroot00000000000000 #include "mlgsl_vector_float.h" #include "mlgsl_vector_impl.h" gsl-ocaml-1.24.3/src/mlgsl_vector_float.h000066400000000000000000000002571371237560500203210ustar00rootroot00000000000000#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.24.3/src/mlgsl_vector_impl.h000066400000000000000000000053741371237560500201620ustar00rootroot00000000000000/* 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.24.3/src/mlgsl_wavelet.c000066400000000000000000000061271371237560500172760ustar00rootroot00000000000000/* 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.24.3/src/monte.ml000066400000000000000000000070301371237560500157330ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () open 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 -> Rng.t -> plain_state -> 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 -> Rng.t -> miser_state -> 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 -> Rng.t -> vegas_state -> 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.24.3/src/monte.mli000066400000000000000000000050071371237560500161060ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Monte Carlo Integration *) open Fun (** {3 High-level interface} *) type kind = | PLAIN | MISER | VEGAS val integrate : kind -> monte_fun -> lo:float array -> up:float array -> int -> Rng.t -> 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 -> Rng.t -> plain_state -> 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 -> Rng.t -> miser_state -> 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 -> Rng.t -> vegas_state -> 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.24.3/src/multifit.ml000066400000000000000000000032401371237560500164450ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () open 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) = Vectmat.dims x in let dy = Vectmat.length y in if dy <> n then invalid_arg "Multifit.linear: wrong dimensions" ; Misc.may weight (fun w -> if Vectmat.length w <> n then invalid_arg "Multifit.linear: wrong dimensions") ; let c = Vector.create p in let cov = 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 -> Fun.result = "ml_gsl_multifit_linear_est" let fit_poly ?weight ~x ~y order = let n = Array.length y in let x_mat = 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} <- 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 (Vector.to_array c, Matrix.to_arrays cov, chisq) gsl-ocaml-1.24.3/src/multifit.mli000066400000000000000000000013641371237560500166230ustar00rootroot00000000000000(* 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 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 -> Vector.vector * Matrix.matrix * float external linear_est : x:vec -> c:vec -> cov:mat -> 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.24.3/src/multifit_nlin.ml000066400000000000000000000024221371237560500174660ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () open Fun open 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 -> Matrix.matrix -> epsabs:float -> vector -> bool = "ml_gsl_multifit_test_gradient" external covar : Matrix.matrix -> epsrel:float -> Matrix.matrix -> unit = "ml_gsl_multifit_covar" gsl-ocaml-1.24.3/src/multifit_nlin.mli000066400000000000000000000020111371237560500176310ustar00rootroot00000000000000(* 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 Fun open 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 -> Matrix.matrix -> epsabs:float -> vector -> bool = "ml_gsl_multifit_test_gradient" external covar : Matrix.matrix -> epsrel:float -> Matrix.matrix -> unit = "ml_gsl_multifit_covar" gsl-ocaml-1.24.3/src/multimin.ml000066400000000000000000000037721371237560500164600ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () open Fun open 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.24.3/src/multimin.mli000066400000000000000000000025761371237560500166320ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Multidimensional Minimization *) open Fun open 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.24.3/src/multiroot.ml000066400000000000000000000043041371237560500166500ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () open Fun open 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: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.24.3/src/multiroot.mli000066400000000000000000000032421371237560500170210ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** Multidimensional Root-Finding *) open Fun open 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: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.24.3/src/odeiv.ml000066400000000000000000000065251371237560500157270ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () type system external _alloc : (float -> float array -> float array -> unit) -> ?jacobian:(float -> float array -> 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.24.3/src/odeiv.mli000066400000000000000000000037721371237560500161010ustar00rootroot00000000000000(* 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 -> 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.24.3/src/permut.ml000066400000000000000000000047411371237560500161330ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 Error.Gsl_exn (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.24.3/src/permut.mli000066400000000000000000000032421371237560500162770ustar00rootroot00000000000000(* 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.24.3/src/poly.ml000066400000000000000000000025621371237560500156010ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/poly.mli000066400000000000000000000023051371237560500157450ustar00rootroot00000000000000(* 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.24.3/src/qrng.ml000066400000000000000000000015611371237560500155630ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/qrng.mli000066400000000000000000000013271371237560500157340ustar00rootroot00000000000000(* 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.24.3/src/randist.ml000066400000000000000000000217221371237560500162610ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (* GAUSSIAN *) let () = Error.init () external gaussian : Rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian" external gaussian_ratio_method : Rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian_ratio_method" external gaussian_ziggurat : Rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian_ziggurat" external gaussian_pdf : float -> sigma:float -> float = "ml_gsl_ran_gaussian_pdf" external ugaussian : Rng.t -> float = "ml_gsl_ran_ugaussian" external ugaussian_ratio_method : Rng.t -> float = "ml_gsl_ran_ugaussian_ratio_method" external ugaussian_pdf : float -> float = "ml_gsl_ran_ugaussian_pdf" (* GAUSSIAN TAIL *) external gaussian_tail : 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 : 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 : 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" (* MULTIVARIATE *) external multivariate_gaussian : Rng.t -> mu:Vector.vector -> l:Matrix.matrix -> out:Vector.vector -> unit = "ml_gsl_ran_multivariate_gaussian" (* EXPONENTIAL *) external exponential : Rng.t -> mu:float -> float = "ml_gsl_ran_exponential" external exponential_pdf : float -> mu:float -> float = "ml_gsl_ran_exponential_pdf" (* LAPLACE *) external laplace : Rng.t -> a:float -> float = "ml_gsl_ran_laplace" external laplace_pdf : float -> a:float -> float = "ml_gsl_ran_laplace_pdf" (* EXPPOW *) external exppow : 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 : Rng.t -> a:float -> float = "ml_gsl_ran_cauchy" external cauchy_pdf : float -> a:float -> float = "ml_gsl_ran_cauchy_pdf" (* RAYLEIGH *) external rayleigh : 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 : 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 : Rng.t -> float = "ml_gsl_ran_landau" external landau_pdf : float -> float = "ml_gsl_ran_landau_pdf" (* LEVY ALPHA-STABLE *) external levy : Rng.t -> c:float -> alpha:float -> float = "ml_gsl_ran_levy" (* LEVY SKEW ALPHA-STABLE *) external levy_skew : Rng.t -> c:float -> alpha:float -> beta:float -> float = "ml_gsl_ran_levy_skew" (* GAMMA *) external gamma : Rng.t -> a:float -> b:float -> float = "ml_gsl_ran_gamma" external gamma_int : 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 : Rng.t -> a:int -> b:float -> float = "ml_gsl_ran_gamma_mt" external gamma_knuth : Rng.t -> a:int -> b:float -> float = "ml_gsl_ran_gamma_knuth" (* FLAT *) external flat : 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 : 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 : Rng.t -> nu:float -> float = "ml_gsl_ran_chisq" external chisq_pdf : float -> nu:float -> float = "ml_gsl_ran_chisq_pdf" (* DIRICHLET *) external dirichlet : 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 : 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 : Rng.t -> nu:float -> float = "ml_gsl_ran_tdist" external tdist_pdf : float -> nu:float -> float = "ml_gsl_ran_tdist_pdf" (* BETA *) external beta : 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 : Rng.t -> a:float -> float = "ml_gsl_ran_logistic" external logistic_pdf : float -> a:float -> float = "ml_gsl_ran_logistic_pdf" (* PARETO *) external pareto : 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 : Rng.t -> float * float = "ml_gsl_ran_dir_2d" external dir_2d_trig_method : Rng.t -> float * float = "ml_gsl_ran_dir_2d_trig_method" external dir_3d : Rng.t -> float * float * float = "ml_gsl_ran_dir_3d" external dir_nd : Rng.t -> float array -> unit = "ml_gsl_ran_dir_nd" (* WEIBULL *) external weibull : 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 : 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 : 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 : 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 : Rng.t -> mu:float -> int = "ml_gsl_ran_poisson" external poisson_pdf : int -> mu:float -> float = "ml_gsl_ran_poisson_pdf" (* BERNOULLI *) external bernoulli : Rng.t -> p:float -> int = "ml_gsl_ran_bernoulli" external bernoulli_pdf : int -> p:float -> float = "ml_gsl_ran_bernoulli_pdf" (* BINOMIAL *) external binomial : Rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial" external binomial_knuth : Rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial_knuth" external binomial_tpe : 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 : 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 : 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 : 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 : 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 : 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 : Rng.t -> p:float -> int = "ml_gsl_ran_logarithmic" external logarithmic_pdf : int -> p:float -> float = "ml_gsl_ran_logarithmic_pdf" (* SHUFFLING *) external shuffle : Rng.t -> 'a array -> unit = "ml_gsl_ran_shuffle" external choose : Rng.t -> src:'a array -> dst:'a array -> unit = "ml_gsl_ran_choose" external sample : Rng.t -> src:'a array -> dst:'a array -> unit = "ml_gsl_ran_sample" gsl-ocaml-1.24.3/src/randist.mli000066400000000000000000000177761371237560500164500ustar00rootroot00000000000000(* 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 : Rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian" external gaussian_ratio_method : Rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian_ratio_method" external gaussian_ziggurat : Rng.t -> sigma:float -> float = "ml_gsl_ran_gaussian_ziggurat" external gaussian_pdf : float -> sigma:float -> float = "ml_gsl_ran_gaussian_pdf" external ugaussian : Rng.t -> float = "ml_gsl_ran_ugaussian" external ugaussian_ratio_method : Rng.t -> float = "ml_gsl_ran_ugaussian_ratio_method" external ugaussian_pdf : float -> float = "ml_gsl_ran_ugaussian_pdf" external gaussian_tail : 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 : 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 : 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 multivariate_gaussian : Rng.t -> mu:Vector.vector -> l:Matrix.matrix -> out:Vector.vector -> unit = "ml_gsl_ran_multivariate_gaussian" external exponential : Rng.t -> mu:float -> float = "ml_gsl_ran_exponential" external exponential_pdf : float -> mu:float -> float = "ml_gsl_ran_exponential_pdf" external laplace : Rng.t -> a:float -> float = "ml_gsl_ran_laplace" external laplace_pdf : float -> a:float -> float = "ml_gsl_ran_laplace_pdf" external exppow : 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 : Rng.t -> a:float -> float = "ml_gsl_ran_cauchy" external cauchy_pdf : float -> a:float -> float = "ml_gsl_ran_cauchy_pdf" external rayleigh : Rng.t -> sigma:float -> float = "ml_gsl_ran_rayleigh" external rayleigh_pdf : float -> sigma:float -> float = "ml_gsl_ran_rayleigh_pdf" external rayleigh_tail : 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 : Rng.t -> float = "ml_gsl_ran_landau" external landau_pdf : float -> float = "ml_gsl_ran_landau_pdf" external levy : Rng.t -> c:float -> alpha:float -> float = "ml_gsl_ran_levy" external levy_skew : Rng.t -> c:float -> alpha:float -> beta:float -> float = "ml_gsl_ran_levy_skew" external gamma : Rng.t -> a:float -> b:float -> float = "ml_gsl_ran_gamma" external gamma_int : 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 : Rng.t -> a:int -> b:float -> float = "ml_gsl_ran_gamma_mt" external gamma_knuth : Rng.t -> a:int -> b:float -> float = "ml_gsl_ran_gamma_knuth" external flat : 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 : 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 : Rng.t -> nu:float -> float = "ml_gsl_ran_chisq" external chisq_pdf : float -> nu:float -> float = "ml_gsl_ran_chisq_pdf" external dirichlet : 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 : 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 : Rng.t -> nu:float -> float = "ml_gsl_ran_tdist" external tdist_pdf : float -> nu:float -> float = "ml_gsl_ran_tdist_pdf" external beta : 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 : Rng.t -> a:float -> float = "ml_gsl_ran_logistic" external logistic_pdf : float -> a:float -> float = "ml_gsl_ran_logistic_pdf" external pareto : 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 : Rng.t -> float * float = "ml_gsl_ran_dir_2d" external dir_2d_trig_method : Rng.t -> float * float = "ml_gsl_ran_dir_2d_trig_method" external dir_3d : Rng.t -> float * float * float = "ml_gsl_ran_dir_3d" external dir_nd : Rng.t -> float array -> unit = "ml_gsl_ran_dir_nd" external weibull : 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 : 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 : 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 : Rng.t -> discrete -> int = "ml_gsl_ran_discrete" [@@noalloc] external discrete_pdf : int -> discrete -> float = "ml_gsl_ran_discrete_pdf" external poisson : Rng.t -> mu:float -> int = "ml_gsl_ran_poisson" external poisson_pdf : int -> mu:float -> float = "ml_gsl_ran_poisson_pdf" external bernoulli : Rng.t -> p:float -> int = "ml_gsl_ran_bernoulli" external bernoulli_pdf : int -> p:float -> float = "ml_gsl_ran_bernoulli_pdf" external binomial : Rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial" external binomial_knuth : Rng.t -> p:float -> n:int -> int = "ml_gsl_ran_binomial_knuth" external binomial_tpe : 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 : 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 : 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 : 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 : Rng.t -> p:float -> int = "ml_gsl_ran_geometric" external geometric_pdf : int -> p:float -> float = "ml_gsl_ran_geometric_pdf" external hypergeometric : 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 : Rng.t -> p:float -> int = "ml_gsl_ran_logarithmic" external logarithmic_pdf : int -> p:float -> float = "ml_gsl_ran_logarithmic_pdf" external shuffle : Rng.t -> 'a array -> unit = "ml_gsl_ran_shuffle" external choose : Rng.t -> src:'a array -> dst:'a array -> unit = "ml_gsl_ran_choose" external sample : Rng.t -> src:'a array -> dst:'a array -> unit = "ml_gsl_ran_sample" gsl-ocaml-1.24.3/src/rng.ml000066400000000000000000000050211371237560500153750ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/rng.mli000066400000000000000000000052531371237560500155550ustar00rootroot00000000000000(* 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.24.3/src/root.ml000066400000000000000000000034041371237560500155750ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 -> 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 -> 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.24.3/src/root.mli000066400000000000000000000024031371237560500157440ustar00rootroot00000000000000(* 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 -> 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 -> 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.24.3/src/sf.mli.q000066400000000000000000000373571371237560500156500ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) (** {1 Special functions} *) (** The library includes routines for calculating the values of {!Airy}, {!Bessel}, {!Clausen}, {!Coulomb}, {!Coupling}, {!Dawson}, {!Debye}, {!Dilogarithms}, {!Elliptic}, {!Jacobi}, {!Error}, {!Exponential}, {!ExponentialI}, {!FermiDirac}, {!Gamma}, {!Gegenbauer}, {!Hermite}, {!Hypergeometric}, {!Laguerre}, {!Lambert}, {!Legendre} and {!SphericalH}, {!log}, {!pow}, {!Psi}, {!Synchrotron}, {!Transport}, {!Trigonometric} and {!Zeta}. Each routine also computes an estimate of the numerical error in the calculated value of the function. *) open Fun (** {2:Airy 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 >> (** {2:Bessel 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 >> (** {2:Clausen Clausen functions} *) << clausen float >> (** {2:Coulomb 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 >> (** {2:Coupling Coupling coefficients} *) (* FIXME: coupling coeffs *) (** {2:Dawson The Dawson function} *) << dawson float >> (** {2:Debye Debye functions} *) << debye_1 float >> << debye_2 float >> << debye_3 float >> << debye_4 float >> << debye_5 float >> << debye_6 float >> (** {2:Dilogarithms Dilogarithms} *) << 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 >> (** {2:elem 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 >> (** {2:Elliptic 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 *) (** {2:Error Error function} *) << erf float @float >> << erfc float @float >> << log_erfc float @float >> << erf_Z float @float >> << erf_Q float @float >> (** {2:Exponential Exponential functions} *) << exp float @float >> (** [exp x] computes the exponential function eˣ using GSL semantics and error checking. *) <:ext< exp_e10@ml_gsl_sf_exp_e10_e,float,result_e10 >> (** [exp_e10 x] computes the exponential eˣ and returns a result with extended range. This function may be useful if the value of eˣ would overflow the numeric range of double. *) << exp_mult float float >> (** [exp_mult x y] exponentiate [x] and multiply by the factor [y] to return the product y eˣ. *) <:ext< exp_mult_e10@ml_gsl_sf_exp_mult_e10_e,float,float,result_e10 >> (** Same as {!exp_e10} but return a result with extended numeric range. *) << expm1 float >> (** [expm1 x] compute the quantity eˣ-1 using an algorithm that is accurate for small [x]. *) << exprel float >> (** [exprel x] compute the quantity (eˣ-1)/x using an algorithm that is accurate for small [x]. For small [x] the algorithm is based on the expansion (eˣ-1)/x = 1 + x/2 + x²/(2*3) + x³/(2*3*4) + ⋯ *) << exprel_2 float >> (** [exprel_2 x] compute the quantity 2(eˣ-1-x)/x² using an algorithm that is accurate for small [x]. For small x the algorithm is based on the expansion 2(eˣ-1-x)/x^2 = 1 + x/3 + x²/(3*4) + x³/(3*4*5) + ⋯ *) << exprel_n int float >> (** [exprel_n x] compute the [n]-relative exponential, which is the n-th generalization of the functions {!exprel} and {!exprel_2}. The N-relative exponential is given by, {[ n-1 exprel_n x = n!/xⁿ (aˣ - ∑ xᵏ/k!) k=0 = 1 + x/(N+1) + x²/((N+1)(N+2)) + ⋯ ]}*) <: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 >> (** {2:ExponentialI 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 >> (** {2:FermiDirac Fermi-Dirac function} *) << 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 >> (** {2:Gamma 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 >> (** {2:Gegenbauer Gegenbauer functions aka Ultraspherical polynomials} Gegenbauer functions are defined in {{:http://dlmf.nist.gov/18.3} DLMF}. *) << gegenpoly_1 float float >> (** [gegenpoly_1 l x] = C₁⁽ˡ⁾(x). *) << gegenpoly_2 float float >> (** [gegenpoly_2 l x] = C₂⁽ˡ⁾(x). *) << gegenpoly_3 float float >> (** [gegenpoly_3 l x] = C₃⁽ˡ⁾(x). *) << gegenpoly_n int float float >> (** [gegenpoly_n n l x] = Cₙ⁽ˡ⁾(x). Constraints: l > -1/2, n ≥ 0. *) <:ext< gegenpoly_array@ml_gsl_sf_gegenpoly_array,float,float,float array,unit >> (** [gegenpoly_array l x c] computes an array of Gegenbauer polynomials c.(n) = Cₙ⁽ˡ⁾(x) for n = 0, 1, 2,̣..., [Array.length c - 1]. Constraints: l > -1/2. *) (** {2:Hypergeometric Hypergeometric functions} *) << hyperg_0F1 c:float float >> (** [hyperg_0F1 c x] computes the hypergeometric function ₀F₁(c; x).*) << hyperg_1F1_int m:int n:int float >> (** [hyperg_1F1_int m n x] computes the confluent hypergeometric function ₁F₁(m;n;x) = M(m,n,x) for integer parameters [m], [n]. *) << hyperg_1F1 a:float b:float float >> (** [hyperg_1F1 a b x] computes the confluent hypergeometric function ₁F₁(a;b;x) = M(a,b,x) for general parameters [a], [b]. *) << hyperg_U_int m:int n:int float >> (** [hyperg_U_int m n x] computes the confluent hypergeometric function U(m,n,x) for integer parameters [m], [n]. *) <:ext< hyperg_U_int_e10@ml_gsl_sf_hyperg_U_int_e10_e,m:int,n:int,float,result_e10 >> (** [hyperg_U_int_e10 m n x] computes the confluent hypergeometric function U(m,n,x) for integer parameters [m], [n] with extended range. *) << hyperg_U a:float b:float float >> (** [hyperg_U a b x] computes the confluent hypergeometric function U(a,b,x). *) <:ext< hyperg_U_e10@ml_gsl_sf_hyperg_U_e10_e,a:float,b:float,float,result_e10 >> (** [hyperg_U_e10 a b x] computes the confluent hypergeometric function U(a,b,x) with extended range. *) << hyperg_2F1 a:float b:float c:float float >> (** [hyperg_2F1 a b c x] computes the Gauss hypergeometric function ₂F₁(a,b,c,x) = F(a,b,c,x) for |x| < 1. If the arguments (a,b,c,x) are too close to a singularity then the function can raise the exception [Error.Gsl_exn(Error.EMAXITER, _)] when the series approximation converges too slowly. This occurs in the region of [x]=1, [c - a - b] ∈ ℤ. *) << hyperg_2F1_conj aR:float aI:float c:float float >> (** [hyperg_2F1_conj aR aI c x] computes the Gauss hypergeometric function ₂F₁(aR + i aI, aR - i aI, c, x) with complex parameters for |x| < 1. *) << hyperg_2F1_renorm a:float b:float c:float float >> (** [hyperg_2F1_renorm a b c x] computes the renormalized Gauss hypergeometric function ₂F₁(a,b,c,x) / Γ(c) for |x| < 1. *) << hyperg_2F1_conj_renorm aR:float aI:float c:float float >> (** [hyperg_2F1_conj_renorm aR aI c x] computes the renormalized Gauss hypergeometric function ₂F₁(aR + i aI, aR - i aI, c, x) / Γ(c) for |x| < 1. *) << hyperg_2F0 a:float b:float float >> (** [hyperg_2F0 a b x] computes the hypergeometric function ₂F₀(a,b,x). The series representation is a divergent hypergeometric series. However, for x < 0 we have ₂F₀(a,b,x) = (-1/x)ᵃ U(a,1+a-b,-1/x) *) (** {2:Laguerre Laguerre functions} *) << laguerre_1 a:float float >> << laguerre_2 a:float float >> << laguerre_3 a:float float >> << laguerre_n n:int a:float float >> (** {2:Lambert Lambert W functions} *) << lambert_W0 float >> << lambert_Wm1 float >> (** {2:Legendre 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 >> (** {2:SphericalH Associated Legendre functions and Spherical Harmonics} *) (** Normalization of Legendre functions. See {{:https://www.gnu.org/software/gsl/doc/html/specfunc.html#associated-legendre-polynomials-and-spherical-harmonics} the GSL documentation}. *) type legendre_t = | Schmidt (** Specifies the computation of the Schmidt semi-normalized associated Legendre polynomials Sₗᵐ(x). *) | Spharm (** Specifies the computation of the spherical harmonic associated Legendre polynomials Yₗᵐ(x). *) | Full (** Specifies the computation of the fully normalized associated Legendre polynomials Nₗᵐ(x). *) | None (** Specifies the computation of the unnormalized associated Legendre polynomials Pₗᵐ(x). *) (* FIXME: keep in the same order as the C definition in gsl_sf_legendre.h *) (* FIXME: to avoid repetitive checks on the length of the array, it would be better to structure the code in a more abstract way. *) <:ext< legendre_array@ml_gsl_sf_legendre_array,legendre_t,int,float,float array,unit >> (** [legendre_array norm lmax x result] calculate all normalized associated Legendre polynomials for 0 ≤ [l] ≤ [lmax] and [0 ≤ m ≤ l] for [|x| ≤ 1]. The [norm] parameter specifies which normalization is used. The normalized Pₗᵐ(x) values are stored in [result], whose minimum size can be obtained from calling {!legendre_array_n}. The array index of Pₗᵐ(x) is obtained from calling {!legendre_array_index}[(l, m)]. To include or exclude the Condon-Shortley phase factor of (-1)ᵐ, set the parameter csphase to either -1 or 1 respectively in the _e function. This factor is included by default. *) (* FIXME: more associated Legendre functions to bind. *) <:ext< legendre_array_n@ml_gsl_sf_legendre_array_n,int,int >> (** [legendre_array_n lmax] returns the minimum array size for maximum degree lmax needed for the array versions of the associated Legendre functions. Size is calculated as the total number of Pₗᵐ(x) functions, plus extra space for precomputing multiplicative factors used in the recurrence relations. *) <:ext< legendre_array_index@ml_gsl_sf_legendre_array_index,int,int,int >> (** [legendre_array_index l m] returns the index into the [result] array of {!legendre_array}, {!legendre_deriv_array}, {!legendre_deriv_alt_array}, {!legendre_deriv2_array}, and {!legendre_deriv2_alt_array} corresponding to Pₗᵐ(x), ∂ₓPₗᵐ(x), or ∂ₓ²Pₗₗᵐ(x). The index is given by l(l+1)/2 + m. *) (* FIXME: it would likely be more efficient to implement this function directly in OCaml. *) << legendre_Plm int int float >> (** [legendre_Plm l m x] and [legendre_Plm_e l m x] compute the associated Legendre polynomial Pₗᵐ(x) for [m ≥ 0], [l ≥ m], [|x| ≤ 1]. *) << legendre_sphPlm int int float >> (** [legendre_sphPlm l m x] and [legendre_Plm_e] compute the normalized associated Legendre polynomial √((2l+1)/(4\pi)) √((l-m)!/(l+m)!) Pₗᵐ(x) suitable for use in spherical harmonics. The parameters must satisfy [m ≥ 0], [l ≥ m], [|x| ≤ 1]. Theses routines avoid the overflows that occur for the standard normalization of Pₗᵐ(x). *) (** {2:log 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 >> (** {2:pow Power function} *) << pow_int float int >> (** {2:Psi Psi (Digamma) 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 >> (** {2:Synchrotron Synchrotron functions} *) << synchrotron_1 float >> << synchrotron_2 float >> (** {2:Transport Transport functions} *) << transport_2 float >> << transport_3 float >> << transport_4 float >> << transport_5 float >> (** {2:Trigonometric 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 >> (** {2:Zeta Zeta functions} *) << zeta_int int >> << zeta float >> << hzeta float float >> << eta_int int >> << eta float >> gsl-ocaml-1.24.3/src/siman.ml000066400000000000000000000030371371237560500157230ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () type params = { iters_fixed_T : int ; step_size : float ; k : float ; t_initial : float ; mu_t : float ; t_min : float ; } open 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 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.24.3/src/siman.mli000066400000000000000000000017161371237560500160760ustar00rootroot00000000000000(* 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 : Rng.t -> 'a -> energ_func:('a -> float) -> step_func:(Rng.t -> 'a -> float -> 'a) -> ?print_func:('a -> unit) -> params -> 'a gsl-ocaml-1.24.3/src/stats.ml000066400000000000000000000043271371237560500157550ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/stats.mli000066400000000000000000000041671371237560500161300ustar00rootroot00000000000000(* 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.24.3/src/sum.ml000066400000000000000000000022241371237560500154150ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 -> 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 -> 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.24.3/src/sum.mli000066400000000000000000000014451371237560500155720ustar00rootroot00000000000000(* 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 -> 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 -> 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.24.3/src/vectmat.ml000066400000000000000000000127131371237560500162600ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () type vec = [ | `V of Vector.vector | `VF of Vector_flat.vector ] let vec_convert ?(protect=false) = function | `A arr when protect -> `VF (Vector_flat.of_array arr) | `A arr -> `VF (Vector_flat.view_array arr) | `VF vec when protect -> `VF (Vector_flat.copy vec) | `VF _ as v -> v | `V vec when protect -> `V (Vector.copy vec) | `V _ as v -> v type mat = [ | `M of Matrix.matrix | `MF of Matrix_flat.matrix ] let mat_convert ?(protect=false) = function | `M mat when protect -> `M (Matrix.copy mat) | `M _ as m -> m | `MF mat when protect -> `MF (Matrix_flat.copy mat) | `MF _ as m -> m | `A (arr, d1, d2) when protect -> `MF (Matrix_flat.of_array arr d1 d2) | `A (arr, d1, d2) -> `MF (Matrix_flat.view_array arr d1 d2) | `AA arr -> `MF (Matrix_flat.of_arrays arr) let mat_flat ?(protect=false) = function | `M mat -> let (d1, d2) = Matrix.dims mat in let arr = Matrix.to_array mat in Matrix_flat.view_array arr d1 d2 | `MF mat when protect -> Matrix_flat.copy mat | `MF mat -> mat | `A (arr, d1, d2) when protect -> Matrix_flat.of_array arr d1 d2 | `A (arr, d1, d2) -> Matrix_flat.view_array arr d1 d2 | `AA arr -> Matrix_flat.of_arrays arr (* Complex values *) type cvec = [ | `CV of Vector_complex.vector | `CVF of Vector_complex_flat.vector ] type cmat = [ | `CM of Matrix_complex.matrix | `CMF of Matrix_complex_flat.matrix ] let cmat_convert ?(protect=false) = function | `CM mat when protect -> `CM (Matrix_complex.copy mat) | `CM _ as m -> m | `CMF mat when protect -> `CMF (Matrix_complex_flat.copy mat) | `CMF _ as m -> m | `CA (arr, d1, d2) when protect -> `CMF (Matrix_complex_flat.of_complex_array arr d1 d2) | `CA (arr, d1, d2) -> `CMF (Matrix_complex_flat.view_complex_array arr d1 d2) (* Generic vector operations *) let length = function | `VF v -> Vector_flat.length v | `V v -> Vector.length v | `CV v -> Vector_complex.length v | `CVF v -> Vector_complex_flat.length v let to_array = function | `VF v -> Vector_flat.to_array v | `V v -> Vector.to_array v let v_copy = function | `VF v -> `VF (Vector_flat.copy v) | `V v -> `V (Vector.copy v) let subvector v ~off ~len = match v with | `VF v -> `VF (Vector_flat.subvector v ~off ~len) | `V v -> `V (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 -> Matrix_flat.dims v | `M v -> Matrix.dims v | `CM m -> Matrix_complex.dims m | `CMF m -> Matrix_complex_flat.dims m let to_arrays = function | `M mat -> Matrix.to_arrays mat | `MF mat -> Matrix_flat.to_arrays mat let tmp mat = let (d1, d2) = dims mat in `M (Matrix.create d1 d2) let m_copy = function | `MF v -> `MF (Matrix_flat.copy v) | `M v -> `M (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.24.3/src/vectmat.mli000066400000000000000000000067251371237560500164370ustar00rootroot00000000000000(* 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 Vector.vector | `VF of Vector_flat.vector ] val vec_convert : ?protect:bool -> [< `A of float array | `VF of Vector_flat.vector | `V of Vector.vector] -> [> vec] type mat = [ | `M of Matrix.matrix | `MF of Matrix_flat.matrix ] val mat_convert : ?protect:bool -> [< `M of Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> [> mat] val mat_flat : ?protect:bool -> [< `M of Matrix.matrix | `MF of Matrix_flat.matrix | `A of float array * int * int | `AA of float array array] -> Matrix_flat.matrix (** {3 Complex values} *) type cvec = [ | `CV of Vector_complex.vector | `CVF of Vector_complex_flat.vector ] type cmat = [ | `CM of Matrix_complex.matrix | `CMF of Matrix_complex_flat.matrix ] val cmat_convert : ?protect:bool -> [< `CM of Matrix_complex.matrix | `CMF of 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 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.24.3/src/vector.ml000066400000000000000000000102001371237560500161040ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/vector.mli000066400000000000000000000071671371237560500162770ustar00rootroot00000000000000(* 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.24.3/src/vector_complex.ml000066400000000000000000000060441371237560500176460ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/vector_complex.mli000066400000000000000000000036361371237560500200230ustar00rootroot00000000000000(* 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.24.3/src/vector_complex_flat.ml000066400000000000000000000046611371237560500206570ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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 = Vector_flat.view_array ~stride:(2 * carr.stride) ~off:(2 * carr.off) ~len:carr.len carr.data let imag carr = 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.24.3/src/vector_complex_flat.mli000066400000000000000000000024501371237560500210220ustar00rootroot00000000000000(* 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 -> Vector_flat.vector val imag : vector -> Vector_flat.vector gsl-ocaml-1.24.3/src/vector_flat.ml000066400000000000000000000052421371237560500171240ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2002-2012 - Olivier Andrieu *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () 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.24.3/src/vector_flat.mli000066400000000000000000000040611371237560500172730ustar00rootroot00000000000000(* 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.24.3/src/version.ml000066400000000000000000000003671371237560500163040ustar00rootroot00000000000000(* gsl-ocaml - OCaml interface to GSL *) (* Copyright (©) 2014- - Markus Mottl *) (* Distributed under the terms of the GPL version 3 *) let () = Error.init () let version = "%%VERSION_NUM%%" gsl-ocaml-1.24.3/src/wavelet.ml000066400000000000000000000052501371237560500162620ustar00rootroot00000000000000type t type ws let () = Error.init () 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 -> Vector_flat.vector -> ws -> unit = "ml_gsl_wavelet_transform" external _transform_bigarray : t -> direction -> 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 Vector_flat.length (_transform w dir) let transform_vector w dir ?ws = with_workspace ws 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 (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 -> Matrix_flat.matrix -> ws -> unit = "ml_gsl_wavelet2d_transform_matrix" external _transform_2d_bigarray : t -> ordering -> direction -> Matrix.matrix -> ws -> unit = "ml_gsl_wavelet2d_transform_matrix" external _transform_2d_gen : t -> ordering -> direction -> [< Vectmat.mat] -> ws -> unit = "ml_gsl_wavelet2d_transform_matrix" let transform_matrix_flat w order dir ?ws = with_workspace ws (fun m -> fst (Matrix_flat.dims m)) (_transform_2d w order dir) let transform_matrix w order dir ?ws = with_workspace ws (fun m -> fst (Matrix.dims m)) (_transform_2d_bigarray w order dir) let transform_matrix_gen w order dir ?ws = with_workspace ws (fun m -> fst (Vectmat.dims m)) (_transform_2d_gen w order dir) gsl-ocaml-1.24.3/src/wavelet.mli000066400000000000000000000024211371237560500164300ustar00rootroot00000000000000(** 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 -> Vector_flat.vector -> unit val transform_vector : t -> direction -> ?ws:ws -> Vector.vector -> unit val transform_gen : t -> direction -> ?ws:ws -> [< Vectmat.vec] -> unit (** {3 2D transforms} *) type ordering = | STANDARD | NON_STANDARD val transform_matrix_flat : t -> ordering -> direction -> ?ws:ws -> Matrix_flat.matrix -> unit val transform_matrix : t -> ordering -> direction -> ?ws:ws -> Matrix.matrix -> unit val transform_matrix_gen : t -> ordering -> direction -> ?ws:ws -> [< Vectmat.mat] -> unit gsl-ocaml-1.24.3/src/wrappers.h000066400000000000000000000057731371237560500163070ustar00rootroot00000000000000/* 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_ */