hmatrix-gsl-0.17.0.0/0000755000000000000000000000000012575776767012417 5ustar0000000000000000hmatrix-gsl-0.17.0.0/Setup.lhs0000644000000000000000000000011712575776767014226 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hmatrix-gsl-0.17.0.0/LICENSE0000644000000000000000000010451312575776767013430 0ustar0000000000000000 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 . hmatrix-gsl-0.17.0.0/hmatrix-gsl.cabal0000644000000000000000000000531412575776767015645 0ustar0000000000000000Name: hmatrix-gsl Version: 0.17.0.0 License: GPL License-file: LICENSE Author: Alberto Ruiz Maintainer: Alberto Ruiz Stability: provisional Homepage: https://github.com/albertoruiz/hmatrix Synopsis: Numerical computation Description: Purely functional interface to selected numerical computations, internally implemented using GSL. Category: Math tested-with: GHC ==7.8 cabal-version: >=1.8 build-type: Simple extra-source-files: src/Numeric/GSL/gsl-ode.c flag onlygsl description: don't link gslcblas default: False library Build-Depends: base<5, hmatrix>=0.17, array, vector, process, random Extensions: ForeignFunctionInterface, CPP hs-source-dirs: src Exposed-modules: Numeric.GSL.Differentiation, Numeric.GSL.Integration, Numeric.GSL.Fourier, Numeric.GSL.Polynomials, Numeric.GSL.Minimization, Numeric.GSL.Root, Numeric.GSL.Fitting, Numeric.GSL.ODE, Numeric.GSL, Numeric.GSL.LinearAlgebra, Numeric.GSL.Interpolation, Numeric.GSL.SimulatedAnnealing, Graphics.Plot other-modules: Numeric.GSL.Internal, Numeric.GSL.Vector, Numeric.GSL.IO, Numeric.GSL.Random C-sources: src/Numeric/GSL/gsl-aux.c cc-options: -O4 -Wall if arch(x86_64) cc-options: -msse2 if arch(i386) cc-options: -msse2 ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-unused-binds if os(OSX) extra-lib-dirs: /opt/local/lib/ include-dirs: /opt/local/include/ extra-lib-dirs: /usr/local/lib/ include-dirs: /usr/local/include/ extra-libraries: gsl if arch(i386) cc-options: -arch i386 frameworks: Accelerate if os(freebsd) extra-lib-dirs: /usr/local/lib include-dirs: /usr/local/include extra-libraries: gsl if os(windows) extra-libraries: gsl-0 if os(linux) if arch(x86_64) cc-options: -fPIC if flag(onlygsl) extra-libraries: gsl else pkgconfig-depends: gsl source-repository head type: git location: https://github.com/albertoruiz/hmatrix hmatrix-gsl-0.17.0.0/src/0000755000000000000000000000000012575776767013206 5ustar0000000000000000hmatrix-gsl-0.17.0.0/src/Numeric/0000755000000000000000000000000012575776767014610 5ustar0000000000000000hmatrix-gsl-0.17.0.0/src/Numeric/GSL.hs0000644000000000000000000000224412575776767015573 0ustar0000000000000000{- | Module : Numeric.GSL Copyright : (c) Alberto Ruiz 2006-14 License : GPL Maintainer : Alberto Ruiz Stability : provisional This module reexports all available GSL functions. The GSL special functions are in the separate package hmatrix-special. -} module Numeric.GSL ( module Numeric.GSL.Integration , module Numeric.GSL.Differentiation , module Numeric.GSL.Fourier , module Numeric.GSL.Polynomials , module Numeric.GSL.Minimization , module Numeric.GSL.Root , module Numeric.GSL.ODE , module Numeric.GSL.Fitting , module Numeric.GSL.Interpolation , module Data.Complex , setErrorHandlerOff ) where import Numeric.GSL.Integration import Numeric.GSL.Differentiation import Numeric.GSL.Fourier import Numeric.GSL.Polynomials import Numeric.GSL.Minimization import Numeric.GSL.Root import Numeric.GSL.ODE import Numeric.GSL.Fitting import Numeric.GSL.Interpolation import Data.Complex -- | This action removes the GSL default error handler (which aborts the program), so that -- GSL errors can be handled by Haskell (using Control.Exception) and ghci doesn't abort. foreign import ccall unsafe "GSL/gsl-aux.h no_abort_on_error" setErrorHandlerOff :: IO () hmatrix-gsl-0.17.0.0/src/Numeric/GSL/0000755000000000000000000000000012575776767015235 5ustar0000000000000000hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Fourier.hs0000644000000000000000000000220412575776767017202 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} {- | Module : Numeric.GSL.Fourier Copyright : (c) Alberto Ruiz 2006 License : GPL Maintainer : Alberto Ruiz Stability : provisional Fourier Transform. -} module Numeric.GSL.Fourier ( fft, ifft ) where import Numeric.LinearAlgebra.HMatrix import Numeric.GSL.Internal import Foreign.C.Types import System.IO.Unsafe (unsafePerformIO) genfft code v = unsafePerformIO $ do r <- createVector (size v) c_fft code # v # r #|"fft" return r foreign import ccall unsafe "gsl-aux.h fft" c_fft :: CInt -> TCV (TCV Res) {- | Fast 1D Fourier transform of a 'Vector' @(@'Complex' 'Double'@)@ using /gsl_fft_complex_forward/. It uses the same scaling conventions as GNU Octave. >>> fft (fromList [1,2,3,4]) fromList [10.0 :+ 0.0,(-2.0) :+ 2.0,(-2.0) :+ 0.0,(-2.0) :+ (-2.0)] -} fft :: Vector (Complex Double) -> Vector (Complex Double) fft = genfft 0 -- | The inverse of 'fft', using /gsl_fft_complex_inverse/. ifft :: Vector (Complex Double) -> Vector (Complex Double) ifft = genfft 1 hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Internal.hs0000644000000000000000000000671312575776767017354 0ustar0000000000000000-- | -- Module : Numeric.GSL.Internal -- Copyright : (c) Alberto Ruiz 2009 -- License : GPL -- Maintainer : Alberto Ruiz -- Stability : provisional -- -- -- Auxiliary functions. -- module Numeric.GSL.Internal( iv, mkVecfun, mkVecVecfun, mkDoubleVecVecfun, mkDoublefun, aux_vTov, mkVecMatfun, mkDoubleVecMatfun, aux_vTom, createV, createMIO, module Numeric.LinearAlgebra.Devel, check,(#),vec, ww2, Res,TV,TM,TCV,TCM ) where import Numeric.LinearAlgebra.HMatrix import Numeric.LinearAlgebra.Devel hiding (check) import Foreign.Marshal.Array(copyArray) import Foreign.Ptr(Ptr, FunPtr) import Foreign.C.Types import Foreign.C.String(peekCString) import System.IO.Unsafe(unsafePerformIO) import Data.Vector.Storable as V (unsafeWith,length) import Control.Monad(when) iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double) iv f n p = f (createV (fromIntegral n) copy "iv") where copy n' q = do copyArray q p (fromIntegral n') return 0 -- | conversion of Haskell functions into function pointers that can be used in the C side foreign import ccall safe "wrapper" mkVecfun :: (CInt -> Ptr Double -> Double) -> IO( FunPtr (CInt -> Ptr Double -> Double)) foreign import ccall safe "wrapper" mkVecVecfun :: TVV -> IO (FunPtr TVV) foreign import ccall safe "wrapper" mkDoubleVecVecfun :: (Double -> TVV) -> IO (FunPtr (Double -> TVV)) foreign import ccall safe "wrapper" mkDoublefun :: (Double -> Double) -> IO (FunPtr (Double -> Double)) aux_vTov :: (Vector Double -> Vector Double) -> TVV aux_vTov f n p nr r = g where v = f x x = createV (fromIntegral n) copy "aux_vTov" copy n' q = do copyArray q p (fromIntegral n') return 0 g = do unsafeWith v $ \p' -> copyArray r p' (fromIntegral nr) return 0 foreign import ccall safe "wrapper" mkVecMatfun :: TVM -> IO (FunPtr TVM) foreign import ccall safe "wrapper" mkDoubleVecMatfun :: (Double -> TVM) -> IO (FunPtr (Double -> TVM)) aux_vTom :: (Vector Double -> Matrix Double) -> TVM aux_vTom f n p rr cr r = g where v = flatten $ f x x = createV (fromIntegral n) copy "aux_vTov" copy n' q = do copyArray q p (fromIntegral n') return 0 g = do unsafeWith v $ \p' -> copyArray r p' (fromIntegral $ rr*cr) return 0 createV n fun msg = unsafePerformIO $ do r <- createVector n fun # r #| msg return r createMIO r c fun msg = do res <- createMatrix RowMajor r c fun # res #| msg return res -------------------------------------------------------------------------------- -- | check the error code check :: String -> IO CInt -> IO () check msg f = do err <- f when (err/=0) $ do ps <- gsl_strerror err s <- peekCString ps error (msg++": "++s) return () -- | description of GSL error codes foreign import ccall unsafe "gsl_strerror" gsl_strerror :: CInt -> IO (Ptr CChar) type PF = Ptr Float type PD = Ptr Double type PQ = Ptr (Complex Float) type PC = Ptr (Complex Double) type Res = IO CInt type TV x = CInt -> PD -> x type TM x = CInt -> CInt -> PD -> x type TCV x = CInt -> PC -> x type TCM x = CInt -> CInt -> PC -> x type TVV = TV (TV Res) type TVM = TV (TM Res) ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 vec x f = unsafeWith x $ \p -> do let v g = do g (fi $ V.length x) p f v {-# INLINE vec #-} infixl 1 # a # b = applyRaw a b {-# INLINE (#) #-} hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Differentiation.hs0000644000000000000000000000650012575776767020704 0ustar0000000000000000{- | Module : Numeric.GSL.Differentiation Copyright : (c) Alberto Ruiz 2006 License : GPL Maintainer : Alberto Ruiz Stability : provisional Numerical differentiation. From the GSL manual: \"The functions described in this chapter compute numerical derivatives by finite differencing. An adaptive algorithm is used to find the best choice of finite difference and to estimate the error in the derivative.\" -} module Numeric.GSL.Differentiation ( derivCentral, derivForward, derivBackward ) where import Foreign.C.Types import Foreign.Marshal.Alloc(malloc, free) import Foreign.Ptr(Ptr, FunPtr, freeHaskellFunPtr) import Foreign.Storable(peek) import Numeric.GSL.Internal import System.IO.Unsafe(unsafePerformIO) derivGen :: CInt -- ^ type: 0 central, 1 forward, 2 backward -> Double -- ^ initial step size -> (Double -> Double) -- ^ function -> Double -- ^ point where the derivative is taken -> (Double, Double) -- ^ result and error derivGen c h f x = unsafePerformIO $ do r <- malloc e <- malloc fp <- mkfun (\y _ -> f y) c_deriv c fp x h r e // check "deriv" vr <- peek r ve <- peek e let result = (vr,ve) free r free e freeHaskellFunPtr fp return result foreign import ccall safe "gsl-aux.h deriv" c_deriv :: CInt -> FunPtr (Double -> Ptr () -> Double) -> Double -> Double -> Ptr Double -> Ptr Double -> IO CInt {- | Adaptive central difference algorithm, /gsl_deriv_central/. For example: >>> let deriv = derivCentral 0.01 >>> deriv sin (pi/4) (0.7071067812000676,1.0600063101654055e-10) >>> cos (pi/4) 0.7071067811865476 -} derivCentral :: Double -- ^ initial step size -> (Double -> Double) -- ^ function -> Double -- ^ point where the derivative is taken -> (Double, Double) -- ^ result and absolute error derivCentral = derivGen 0 -- | Adaptive forward difference algorithm, /gsl_deriv_forward/. The function is evaluated only at points greater than x, and never at x itself. The derivative is returned in result and an estimate of its absolute error is returned in abserr. This function should be used if f(x) has a discontinuity at x, or is undefined for values less than x. A backward derivative can be obtained using a negative step. derivForward :: Double -- ^ initial step size -> (Double -> Double) -- ^ function -> Double -- ^ point where the derivative is taken -> (Double, Double) -- ^ result and absolute error derivForward = derivGen 1 -- | Adaptive backward difference algorithm, /gsl_deriv_backward/. derivBackward ::Double -- ^ initial step size -> (Double -> Double) -- ^ function -> Double -- ^ point where the derivative is taken -> (Double, Double) -- ^ result and absolute error derivBackward = derivGen 2 {- | conversion of Haskell functions into function pointers that can be used in the C side -} foreign import ccall safe "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double)) hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Minimization.hs0000644000000000000000000002251312575776767020243 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {- | Module : Numeric.GSL.Minimization Copyright : (c) Alberto Ruiz 2006-9 License : GPL Maintainer : Alberto Ruiz Stability : provisional Minimization of a multidimensional function using some of the algorithms described in: The example in the GSL manual: @ f [x,y] = 10*(x-1)^2 + 20*(y-2)^2 + 30 main = do let (s,p) = minimize NMSimplex2 1E-2 30 [1,1] f [5,7] print s print p @ >>> main [0.9920430849306288,1.9969168063253182] 0.000 512.500 1.130 6.500 5.000 1.000 290.625 1.409 5.250 4.000 2.000 290.625 1.409 5.250 4.000 3.000 252.500 1.409 5.500 1.000 ... 22.000 30.001 0.013 0.992 1.997 23.000 30.001 0.008 0.992 1.997 The path to the solution can be graphically shown by means of: @'Graphics.Plot.mplot' $ drop 3 ('toColumns' p)@ Taken from the GSL manual: The vector Broyden-Fletcher-Goldfarb-Shanno (BFGS) algorithm is a quasi-Newton method which builds up an approximation to the second derivatives of the function f using the difference between successive gradient vectors. By combining the first and second derivatives the algorithm is able to take Newton-type steps towards the function minimum, assuming quadratic behavior in that region. The bfgs2 version of this minimizer is the most efficient version available, and is a faithful implementation of the line minimization scheme described in Fletcher's Practical Methods of Optimization, Algorithms 2.6.2 and 2.6.4. It supercedes the original bfgs routine and requires substantially fewer function and gradient evaluations. The user-supplied tolerance tol corresponds to the parameter \sigma used by Fletcher. A value of 0.1 is recommended for typical use (larger values correspond to less accurate line searches). The nmsimplex2 version is a new O(N) implementation of the earlier O(N^2) nmsimplex minimiser. It calculates the size of simplex as the rms distance of each vertex from the center rather than the mean distance, which has the advantage of allowing a linear update. -} module Numeric.GSL.Minimization ( minimize, minimizeV, MinimizeMethod(..), minimizeD, minimizeVD, MinimizeMethodD(..), uniMinimize, UniMinimizeMethod(..), minimizeNMSimplex, minimizeConjugateGradient, minimizeVectorBFGS2 ) where import Numeric.LinearAlgebra.HMatrix hiding(step) import Numeric.GSL.Internal import Foreign.Ptr(Ptr, FunPtr, freeHaskellFunPtr) import Foreign.C.Types import System.IO.Unsafe(unsafePerformIO) ------------------------------------------------------------------------ {-# DEPRECATED minimizeNMSimplex "use minimize NMSimplex2 eps maxit sizes f xi" #-} minimizeNMSimplex f xi szs eps maxit = minimize NMSimplex eps maxit szs f xi {-# DEPRECATED minimizeConjugateGradient "use minimizeD ConjugateFR eps maxit step tol f g xi" #-} minimizeConjugateGradient step tol eps maxit f g xi = minimizeD ConjugateFR eps maxit step tol f g xi {-# DEPRECATED minimizeVectorBFGS2 "use minimizeD VectorBFGS2 eps maxit step tol f g xi" #-} minimizeVectorBFGS2 step tol eps maxit f g xi = minimizeD VectorBFGS2 eps maxit step tol f g xi ------------------------------------------------------------------------- data UniMinimizeMethod = GoldenSection | BrentMini | QuadGolden deriving (Enum, Eq, Show, Bounded) -- | Onedimensional minimization. uniMinimize :: UniMinimizeMethod -- ^ The method used. -> Double -- ^ desired precision of the solution -> Int -- ^ maximum number of iterations allowed -> (Double -> Double) -- ^ function to minimize -> Double -- ^ guess for the location of the minimum -> Double -- ^ lower bound of search interval -> Double -- ^ upper bound of search interval -> (Double, Matrix Double) -- ^ solution and optimization path uniMinimize method epsrel maxit fun xmin xl xu = uniMinimizeGen (fi (fromEnum method)) fun xmin xl xu epsrel maxit uniMinimizeGen m f xmin xl xu epsrel maxit = unsafePerformIO $ do fp <- mkDoublefun f rawpath <- createMIO maxit 4 (c_uniMinize m fp epsrel (fi maxit) xmin xl xu) "uniMinimize" let it = round (rawpath `atIndex` (maxit-1,0)) path = takeRows it rawpath [sol] = toLists $ dropRows (it-1) path freeHaskellFunPtr fp return (sol !! 1, path) foreign import ccall safe "uniMinimize" c_uniMinize:: CInt -> FunPtr (Double -> Double) -> Double -> CInt -> Double -> Double -> Double -> TM Res data MinimizeMethod = NMSimplex | NMSimplex2 deriving (Enum,Eq,Show,Bounded) -- | Minimization without derivatives minimize :: MinimizeMethod -> Double -- ^ desired precision of the solution (size test) -> Int -- ^ maximum number of iterations allowed -> [Double] -- ^ sizes of the initial search box -> ([Double] -> Double) -- ^ function to minimize -> [Double] -- ^ starting point -> ([Double], Matrix Double) -- ^ solution vector and optimization path -- | Minimization without derivatives (vector version) minimizeV :: MinimizeMethod -> Double -- ^ desired precision of the solution (size test) -> Int -- ^ maximum number of iterations allowed -> Vector Double -- ^ sizes of the initial search box -> (Vector Double -> Double) -- ^ function to minimize -> Vector Double -- ^ starting point -> (Vector Double, Matrix Double) -- ^ solution vector and optimization path minimize method eps maxit sz f xi = v2l $ minimizeV method eps maxit (fromList sz) (f.toList) (fromList xi) where v2l (v,m) = (toList v, m) minimizeV method eps maxit szv f xiv = unsafePerformIO $ do let n = size xiv fp <- mkVecfun (iv f) rawpath <- ww2 vec xiv vec szv $ \xiv' szv' -> createMIO maxit (n+3) (c_minimize (fi (fromEnum method)) fp eps (fi maxit) // xiv' // szv') "minimize" let it = round (rawpath `atIndex` (maxit-1,0)) path = takeRows it rawpath sol = flatten $ dropColumns 3 $ dropRows (it-1) path freeHaskellFunPtr fp return (sol, path) foreign import ccall safe "gsl-aux.h minimize" c_minimize:: CInt -> FunPtr (CInt -> Ptr Double -> Double) -> Double -> CInt -> TV(TV(TM Res)) ---------------------------------------------------------------------------------- data MinimizeMethodD = ConjugateFR | ConjugatePR | VectorBFGS | VectorBFGS2 | SteepestDescent deriving (Enum,Eq,Show,Bounded) -- | Minimization with derivatives. minimizeD :: MinimizeMethodD -> Double -- ^ desired precision of the solution (gradient test) -> Int -- ^ maximum number of iterations allowed -> Double -- ^ size of the first trial step -> Double -- ^ tol (precise meaning depends on method) -> ([Double] -> Double) -- ^ function to minimize -> ([Double] -> [Double]) -- ^ gradient -> [Double] -- ^ starting point -> ([Double], Matrix Double) -- ^ solution vector and optimization path -- | Minimization with derivatives (vector version) minimizeVD :: MinimizeMethodD -> Double -- ^ desired precision of the solution (gradient test) -> Int -- ^ maximum number of iterations allowed -> Double -- ^ size of the first trial step -> Double -- ^ tol (precise meaning depends on method) -> (Vector Double -> Double) -- ^ function to minimize -> (Vector Double -> Vector Double) -- ^ gradient -> Vector Double -- ^ starting point -> (Vector Double, Matrix Double) -- ^ solution vector and optimization path minimizeD method eps maxit istep tol f df xi = v2l $ minimizeVD method eps maxit istep tol (f.toList) (fromList.df.toList) (fromList xi) where v2l (v,m) = (toList v, m) minimizeVD method eps maxit istep tol f df xiv = unsafePerformIO $ do let n = size xiv f' = f df' = (checkdim1 n . df) fp <- mkVecfun (iv f') dfp <- mkVecVecfun (aux_vTov df') rawpath <- vec xiv $ \xiv' -> createMIO maxit (n+2) (c_minimizeD (fi (fromEnum method)) fp dfp istep tol eps (fi maxit) // xiv') "minimizeD" let it = round (rawpath `atIndex` (maxit-1,0)) path = takeRows it rawpath sol = flatten $ dropColumns 2 $ dropRows (it-1) path freeHaskellFunPtr fp freeHaskellFunPtr dfp return (sol,path) foreign import ccall safe "gsl-aux.h minimizeD" c_minimizeD :: CInt -> FunPtr (CInt -> Ptr Double -> Double) -> FunPtr (TV (TV Res)) -> Double -> Double -> Double -> CInt -> TV (TM Res) --------------------------------------------------------------------- checkdim1 n v | size v == n = v | otherwise = error $ "Error: "++ show n ++ " components expected in the result of the gradient supplied to minimizeD" hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Interpolation.hs0000644000000000000000000002555012575776767020427 0ustar0000000000000000{- | Module : Numeric.GSL.Interpolation Copyright : (c) Matthew Peddie 2015 License : GPL Maintainer : Alberto Ruiz Stability : provisional Interpolation routines. The GSL routines @gsl_spline_eval@ and friends are used, but in spite of the names, they are not restricted to spline interpolation. The functions in this module will work for any 'InterpolationMethod'. -} module Numeric.GSL.Interpolation ( -- * Interpolation methods InterpolationMethod(..) -- * Evaluation of interpolated functions , evaluate , evaluateV -- * Evaluation of derivatives of interpolated functions , evaluateDerivative , evaluateDerivative2 , evaluateDerivativeV , evaluateDerivative2V -- * Evaluation of integrals of interpolated functions , evaluateIntegral , evaluateIntegralV ) where import Numeric.LinearAlgebra(Vector, fromList, size, Numeric) import Foreign.C.Types import Foreign.Marshal.Alloc(alloca) import Foreign.Ptr(Ptr) import Foreign.Storable(peek) import Numeric.GSL.Internal import System.IO.Unsafe(unsafePerformIO) data InterpolationMethod = Linear | Polynomial | CSpline | CSplinePeriodic | Akima | AkimaPeriodic deriving (Eq, Show, Read) methodToInt :: Integral a => InterpolationMethod -> a methodToInt Linear = 0 methodToInt Polynomial = 1 methodToInt CSpline = 2 methodToInt CSplinePeriodic = 3 methodToInt Akima = 4 methodToInt AkimaPeriodic = 5 dim :: Numeric t => Vector t -> Int dim = size applyCFun hsname cname fun mth xs ys x | dim xs /= dim ys = error $ "Error: Vectors of unequal sizes " ++ show (dim xs) ++ " and " ++ show (dim ys) ++ " supplied to " ++ hsname | otherwise = unsafePerformIO $ flip appVector xs $ \xs' -> flip appVector ys $ \ys' -> alloca $ \y' -> do fun xs' ys' (fromIntegral $ dim xs) x (methodToInt mth) y' // check cname peek y' foreign import ccall safe "spline_eval" c_spline_eval :: Ptr Double -> Ptr Double -> CUInt -> Double -> CInt -> Ptr Double -> IO CInt -------------------------------------------------------------------- {- | Evaluate a function by interpolating within the given dataset. For example: >>> let xs = vector [1..10] >>> let ys = vector $ map (**2) [1..10] >>> evaluateV CSpline xs ys 2.2 4.818867924528303 To successfully @evaluateV xs ys x@, the vectors of corresponding domain-range values @xs@ and @ys@ must have identical lengths, and @xs@ must be monotonically increasing. The evaluation point @x@ must lie between the smallest and largest values in @xs@. -} evaluateV :: InterpolationMethod -- ^ What method to use to interpolate -> Vector Double -- ^ Data points sampling the domain of the function -> Vector Double -- ^ Data points sampling the range of the function -> Double -- ^ Point at which to evaluate the function -> Double -- ^ Interpolated result evaluateV = applyCFun "evaluateV" "spline_eval" c_spline_eval {- | Evaluate a function by interpolating within the given dataset. For example: >>> let xs = [1..10] >>> let ys map (**2) [1..10] >>> evaluate Akima (zip xs ys) 2.2 4.840000000000001 To successfully @evaluate points x@, the domain (@x@) values in @points@ must be monotonically increasing. The evaluation point @x@ must lie between the smallest and largest values in the sampled domain. -} evaluate :: InterpolationMethod -- ^ What method to use to interpolate -> [(Double, Double)] -- ^ (domain, range) values sampling the function -> Double -- ^ Point at which to evaluate the function -> Double -- ^ Interpolated result evaluate mth pts = applyCFun "evaluate" "spline_eval" c_spline_eval mth (fromList xs) (fromList ys) where (xs, ys) = unzip pts foreign import ccall safe "spline_eval_deriv" c_spline_eval_deriv :: Ptr Double -> Ptr Double -> CUInt -> Double -> CInt -> Ptr Double -> IO CInt {- | Evaluate the derivative of a function by interpolating within the given dataset. For example: >>> let xs = vector [1..10] >>> let ys = vector $ map (**2) [1..10] >>> evaluateDerivativeV CSpline xs ys 2.2 4.338867924528302 To successfully @evaluateDerivativeV xs ys x@, the vectors of corresponding domain-range values @xs@ and @ys@ must have identical lengths, and @xs@ must be monotonically increasing. The interpolation point @x@ must lie between the smallest and largest values in @xs@. -} evaluateDerivativeV :: InterpolationMethod -- ^ What method to use to interpolate -> Vector Double -- ^ Data points @xs@ sampling the domain of the function -> Vector Double -- ^ Data points @ys@ sampling the range of the function -> Double -- ^ Point @x@ at which to evaluate the derivative -> Double -- ^ Interpolated result evaluateDerivativeV = applyCFun "evaluateDerivativeV" "spline_eval_deriv" c_spline_eval_deriv {- | Evaluate the derivative of a function by interpolating within the given dataset. For example: >>> let xs = [1..10] >>> let ys map (**2) [1..10] >>> evaluateDerivative Akima (zip xs ys) 2.2 4.4 To successfully @evaluateDerivative points x@, the domain (@x@) values in @points@ must be monotonically increasing. The evaluation point @x@ must lie between the smallest and largest values in the sampled domain. -} evaluateDerivative :: InterpolationMethod -- ^ What method to use to interpolate -> [(Double, Double)] -- ^ (domain, range) points sampling the function -> Double -- ^ Point @x@ at which to evaluate the derivative -> Double -- ^ Interpolated result evaluateDerivative mth pts = applyCFun "evaluateDerivative" "spline_eval_deriv" c_spline_eval_deriv mth (fromList xs) (fromList ys) where (xs, ys) = unzip pts foreign import ccall safe "spline_eval_deriv2" c_spline_eval_deriv2 :: Ptr Double -> Ptr Double -> CUInt -> Double -> CInt -> Ptr Double -> IO CInt {- | Evaluate the second derivative of a function by interpolating within the given dataset. For example: >>> let xs = vector [1..10] >>> let ys = vector $ map (**2) [1..10] >>> evaluateDerivative2V CSpline xs ys 2.2 2.4 To successfully @evaluateDerivative2V xs ys x@, the vectors @xs@ and @ys@ must have identical lengths, and @xs@ must be monotonically increasing. The evaluation point @x@ must lie between the smallest and largest values in @xs@. -} evaluateDerivative2V :: InterpolationMethod -- ^ What method to use to interpolate -> Vector Double -- ^ Data points @xs@ sampling the domain of the function -> Vector Double -- ^ Data points @ys@ sampling the range of the function -> Double -- ^ Point @x@ at which to evaluate the second derivative -> Double -- ^ Interpolated result evaluateDerivative2V = applyCFun "evaluateDerivative2V" "spline_eval_deriv2" c_spline_eval_deriv2 {- | Evaluate the second derivative of a function by interpolating within the given dataset. For example: >>> let xs = [1..10] >>> let ys map (**2) [1..10] >>> evaluateDerivative2 Akima (zip xs ys) 2.2 2.0 To successfully @evaluateDerivative2 points x@, the domain (@x@) values in @points@ must be monotonically increasing. The evaluation point @x@ must lie between the smallest and largest values in the sampled domain. -} evaluateDerivative2 :: InterpolationMethod -- ^ What method to use to interpolate -> [(Double, Double)] -- ^ (domain, range) points sampling the function -> Double -- ^ Point @x@ at which to evaluate the second derivative -> Double -- ^ Interpolated result evaluateDerivative2 mth pts = applyCFun "evaluateDerivative2" "spline_eval_deriv2" c_spline_eval_deriv2 mth (fromList xs) (fromList ys) where (xs, ys) = unzip pts foreign import ccall safe "spline_eval_integ" c_spline_eval_integ :: Ptr Double -> Ptr Double -> CUInt -> Double -> Double -> CInt -> Ptr Double -> IO CInt applyCIntFun hsname cname fun mth xs ys a b | dim xs /= dim ys = error $ "Error: Vectors of unequal sizes " ++ show (dim xs) ++ " and " ++ show (dim ys) ++ " supplied to " ++ hsname | otherwise = unsafePerformIO $ flip appVector xs $ \xs' -> flip appVector ys $ \ys' -> alloca $ \y' -> do fun xs' ys' (fromIntegral $ dim xs) a b (methodToInt mth) y' // check cname peek y' {- | Evaluate the definite integral of a function by interpolating within the given dataset. For example: >>> let xs = vector [1..10] >>> let ys = vector $ map (**2) [1..10] >>> evaluateIntegralV CSpline xs ys 2.2 5.5 51.89853207547169 To successfully @evaluateIntegralV xs ys a b@, the vectors @xs@ and @ys@ must have identical lengths, and @xs@ must be monotonically increasing. The integration bounds @a@ and @b@ must lie between the smallest and largest values in @xs@. -} evaluateIntegralV :: InterpolationMethod -- ^ What method to use to interpolate -> Vector Double -- ^ Data points @xs@ sampling the domain of the function -> Vector Double -- ^ Data points @ys@ sampling the range of the function -> Double -- ^ Lower integration bound @a@ -> Double -- ^ Upper integration bound @b@ -> Double -- ^ Resulting area evaluateIntegralV = applyCIntFun "evaluateIntegralV" "spline_eval_integ" c_spline_eval_integ {- | Evaluate the definite integral of a function by interpolating within the given dataset. For example: >>> let xs = [1..10] >>> let ys = map (**2) [1..10] >>> evaluateIntegralV CSpline (zip xs ys) (2.2, 5.5) 51.909 To successfully @evaluateIntegral points (a, b)@, the domain (@x@) values of @points@ must be monotonically increasing. The integration bounds @a@ and @b@ must lie between the smallest and largest values in the sampled domain.. -} evaluateIntegral :: InterpolationMethod -- ^ What method to use to interpolate -> [(Double, Double)] -- ^ (domain, range) points sampling the function -> (Double, Double) -- ^ Integration bounds (@a@, @b@) -> Double -- ^ Resulting area evaluateIntegral mth pts (a, b) = applyCIntFun "evaluateIntegral" "spline_eval_integ" c_spline_eval_integ mth (fromList xs) (fromList ys) a b where (xs, ys) = unzip pts hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Fitting.hs0000644000000000000000000001673512575776767017211 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {- | Module : Numeric.GSL.Fitting Copyright : (c) Alberto Ruiz 2010 License : GPL Maintainer : Alberto Ruiz Stability : provisional Nonlinear Least-Squares Fitting The example program in the GSL manual (see examples/fitting.hs): @ dat = [ ([0.0],([6.0133918608118675],0.1)), ([1.0],([5.5153769909966535],0.1)), ([2.0],([5.261094606015287],0.1)), ... ([39.0],([1.0619821710802808],0.1))] expModel [a,lambda,b] [t] = [a * exp (-lambda * t) + b] expModelDer [a,lambda,b] [t] = [[exp (-lambda * t), -t * a * exp(-lambda*t) , 1]] (sol,path) = fitModelScaled 1E-4 1E-4 20 (expModel, expModelDer) dat [1,0,0] @ >>> path (6><5) [ 1.0, 76.45780563978782, 1.6465931240727802, 1.8147715267618197e-2, 0.6465931240727797 , 2.0, 37.683816318260355, 2.858760367632973, 8.092094813253975e-2, 1.4479636296208662 , 3.0, 9.5807893736187, 4.948995119561291, 0.11942927999921617, 1.0945766509238248 , 4.0, 5.630494933603935, 5.021755718065913, 0.10287787128056883, 1.0338835440862608 , 5.0, 5.443976278682909, 5.045204331329302, 0.10405523433131504, 1.019416067207375 , 6.0, 5.4439736648994685, 5.045357818922331, 0.10404905846029407, 1.0192487112786812 ] >>> sol [(5.045357818922331,6.027976702418132e-2), (0.10404905846029407,3.157045047172834e-3), (1.0192487112786812,3.782067731353722e-2)] -} module Numeric.GSL.Fitting ( -- * Levenberg-Marquardt nlFitting, FittingMethod(..), -- * Utilities fitModelScaled, fitModel ) where import Numeric.LinearAlgebra.HMatrix import Numeric.GSL.Internal import Foreign.Ptr(FunPtr, freeHaskellFunPtr) import Foreign.C.Types import System.IO.Unsafe(unsafePerformIO) ------------------------------------------------------------------------- type TVV = TV (TV Res) type TVM = TV (TM Res) data FittingMethod = LevenbergMarquardtScaled -- ^ Interface to gsl_multifit_fdfsolver_lmsder. This is a robust and efficient version of the Levenberg-Marquardt algorithm as implemented in the scaled lmder routine in minpack. Minpack was written by Jorge J. More, Burton S. Garbow and Kenneth E. Hillstrom. | LevenbergMarquardt -- ^ This is an unscaled version of the lmder algorithm. The elements of the diagonal scaling matrix D are set to 1. This algorithm may be useful in circumstances where the scaled version of lmder converges too slowly, or the function is already scaled appropriately. deriving (Enum,Eq,Show,Bounded) -- | Nonlinear multidimensional least-squares fitting. nlFitting :: FittingMethod -> Double -- ^ absolute tolerance -> Double -- ^ relative tolerance -> Int -- ^ maximum number of iterations allowed -> (Vector Double -> Vector Double) -- ^ function to be minimized -> (Vector Double -> Matrix Double) -- ^ Jacobian -> Vector Double -- ^ starting point -> (Vector Double, Matrix Double) -- ^ solution vector and optimization path nlFitting method epsabs epsrel maxit fun jac xinit = nlFitGen (fi (fromEnum method)) fun jac xinit epsabs epsrel maxit nlFitGen m f jac xiv epsabs epsrel maxit = unsafePerformIO $ do let p = size xiv n = size (f xiv) fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f)) jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac)) rawpath <- createMatrix RowMajor maxit (2+p) c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n) # xiv # rawpath #|"c_nlfit" let it = round (rawpath `atIndex` (maxit-1,0)) path = takeRows it rawpath [sol] = toRows $ dropRows (it-1) path freeHaskellFunPtr fp freeHaskellFunPtr jp return (subVector 2 p sol, path) foreign import ccall safe "nlfit" c_nlfit:: CInt -> FunPtr TVV -> FunPtr TVM -> Double -> Double -> CInt -> CInt -> TVM ------------------------------------------------------- checkdim1 n _p v | size v == n = v | otherwise = error $ "Error: "++ show n ++ " components expected in the result of the function supplied to nlFitting" checkdim2 n p m | rows m == n && cols m == p = m | otherwise = error $ "Error: "++ show n ++ "x" ++ show p ++ " Jacobian expected in nlFitting" ------------------------------------------------------------ err (model,deriv) dat vsol = zip sol errs where sol = toList vsol c = max 1 (chi/sqrt (fromIntegral dof)) dof = length dat - (rows cov) chi = norm_2 (fromList $ cost (resMs model) dat sol) js = fromLists $ jacobian (resDs deriv) dat sol cov = inv $ tr js <> js errs = toList $ scalar c * sqrt (takeDiag cov) -- | Higher level interface to 'nlFitting' 'LevenbergMarquardtScaled'. The optimization function and -- Jacobian are automatically built from a model f vs x = y and its derivatives, and a list of -- instances (x, (y,sigma)) to be fitted. fitModelScaled :: Double -- ^ absolute tolerance -> Double -- ^ relative tolerance -> Int -- ^ maximum number of iterations allowed -> ([Double] -> x -> [Double], [Double] -> x -> [[Double]]) -- ^ (model, derivatives) -> [(x, ([Double], Double))] -- ^ instances -> [Double] -- ^ starting point -> ([(Double, Double)], Matrix Double) -- ^ (solution, error) and optimization path fitModelScaled epsabs epsrel maxit (model,deriv) dt xin = (err (model,deriv) dt sol, path) where (sol,path) = nlFitting LevenbergMarquardtScaled epsabs epsrel maxit (fromList . cost (resMs model) dt . toList) (fromLists . jacobian (resDs deriv) dt . toList) (fromList xin) -- | Higher level interface to 'nlFitting' 'LevenbergMarquardt'. The optimization function and -- Jacobian are automatically built from a model f vs x = y and its derivatives, and a list of -- instances (x,y) to be fitted. fitModel :: Double -- ^ absolute tolerance -> Double -- ^ relative tolerance -> Int -- ^ maximum number of iterations allowed -> ([Double] -> x -> [Double], [Double] -> x -> [[Double]]) -- ^ (model, derivatives) -> [(x, [Double])] -- ^ instances -> [Double] -- ^ starting point -> ([Double], Matrix Double) -- ^ solution and optimization path fitModel epsabs epsrel maxit (model,deriv) dt xin = (toList sol, path) where (sol,path) = nlFitting LevenbergMarquardt epsabs epsrel maxit (fromList . cost (resM model) dt . toList) (fromLists . jacobian (resD deriv) dt . toList) (fromList xin) cost model ds vs = concatMap (model vs) ds jacobian modelDer ds vs = concatMap (modelDer vs) ds -- | Model-to-residual for association pairs with sigma, to be used with 'fitModel'. resMs :: ([Double] -> x -> [Double]) -> [Double] -> (x, ([Double], Double)) -> [Double] resMs m v = \(x,(ys,s)) -> zipWith (g s) (m v x) ys where g s a b = (a-b)/s -- | Associated derivative for 'resMs'. resDs :: ([Double] -> x -> [[Double]]) -> [Double] -> (x, ([Double], Double)) -> [[Double]] resDs m v = \(x,(_,s)) -> map (map (/s)) (m v x) -- | Model-to-residual for association pairs, to be used with 'fitModel'. It is equivalent -- to 'resMs' with all sigmas = 1. resM :: ([Double] -> x -> [Double]) -> [Double] -> (x, [Double]) -> [Double] resM m v = \(x,ys) -> zipWith g (m v x) ys where g a b = a-b -- | Associated derivative for 'resM'. resD :: ([Double] -> x -> [[Double]]) -> [Double] -> (x, [Double]) -> [[Double]] resD m v = \(x,_) -> m v x hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Vector.hs0000644000000000000000000000735412575776767017044 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Numeric.GSL.Vector -- Copyright : (c) Alberto Ruiz 2007-14 -- License : GPL -- Maintainer : Alberto Ruiz -- Stability : provisional -- ----------------------------------------------------------------------------- module Numeric.GSL.Vector ( randomVector, saveMatrix, fwriteVector, freadVector, fprintfVector, fscanfVector ) where import Numeric.LinearAlgebra.HMatrix hiding(randomVector, saveMatrix) import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) import Foreign.Marshal.Alloc(free) import Foreign.Ptr(Ptr) import Foreign.C.Types import Foreign.C.String(newCString) import System.IO.Unsafe(unsafePerformIO) fromei x = fromIntegral (fromEnum x) :: CInt ----------------------------------------------------------------------- -- | Obtains a vector of pseudorandom elements from the the mt19937 generator in GSL, with a given seed. Use randomIO to get a random seed. randomVector :: Int -- ^ seed -> RandDist -- ^ distribution -> Int -- ^ vector size -> Vector Double randomVector seed dist n = unsafePerformIO $ do r <- createVector n c_random_vector_GSL (fi seed) ((fi.fromEnum) dist) # r #|"randomVectorGSL" return r foreign import ccall unsafe "random_vector_GSL" c_random_vector_GSL :: CInt -> CInt -> TV -------------------------------------------------------------------------------- -- | Saves a matrix as 2D ASCII table. saveMatrix :: FilePath -> String -- ^ format (%f, %g, %e) -> Matrix Double -> IO () saveMatrix filename fmt m = do charname <- newCString filename charfmt <- newCString fmt let o = if orderOf m == RowMajor then 1 else 0 matrix_fprintf charname charfmt o # m #|"matrix_fprintf" free charname free charfmt foreign import ccall unsafe "matrix_fprintf" matrix_fprintf :: Ptr CChar -> Ptr CChar -> CInt -> TM -------------------------------------------------------------------------------- -- | Loads a vector from an ASCII file (the number of elements must be known in advance). fscanfVector :: FilePath -> Int -> IO (Vector Double) fscanfVector filename n = do charname <- newCString filename res <- createVector n gsl_vector_fscanf charname # res #|"gsl_vector_fscanf" free charname return res foreign import ccall unsafe "vector_fscanf" gsl_vector_fscanf:: Ptr CChar -> TV -- | Saves the elements of a vector, with a given format (%f, %e, %g), to an ASCII file. fprintfVector :: FilePath -> String -> Vector Double -> IO () fprintfVector filename fmt v = do charname <- newCString filename charfmt <- newCString fmt gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf" free charname free charfmt foreign import ccall unsafe "vector_fprintf" gsl_vector_fprintf :: Ptr CChar -> Ptr CChar -> TV -- | Loads a vector from a binary file (the number of elements must be known in advance). freadVector :: FilePath -> Int -> IO (Vector Double) freadVector filename n = do charname <- newCString filename res <- createVector n gsl_vector_fread charname # res #|"gsl_vector_fread" free charname return res foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV -- | Saves the elements of a vector to a binary file. fwriteVector :: FilePath -> Vector Double -> IO () fwriteVector filename v = do charname <- newCString filename gsl_vector_fwrite charname # v #|"gsl_vector_fwrite" free charname foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV type PD = Ptr Double -- type TV = CInt -> PD -> IO CInt -- type TM = CInt -> CInt -> PD -> IO CInt -- hmatrix-gsl-0.17.0.0/src/Numeric/GSL/gsl-ode.c0000644000000000000000000001346712575776767016746 0ustar0000000000000000 #ifdef GSLODE1 ////////////////////////////// ODE V1 ////////////////////////////////////////// #include typedef struct {int n; int (*f)(double,int, const double*, int, double *); int (*j)(double,int, const double*, int, int, double*);} Tode; int odefunc (double t, const double y[], double f[], void *params) { Tode * P = (Tode*) params; (P->f)(t,P->n,y,P->n,f); return GSL_SUCCESS; } int odejac (double t, const double y[], double *dfdy, double dfdt[], void *params) { Tode * P = ((Tode*) params); (P->j)(t,P->n,y,P->n,P->n,dfdy); int j; for (j=0; j< P->n; j++) dfdt[j] = 0.0; return GSL_SUCCESS; } int ode(int method, int control, double h, double eps_abs, double eps_rel, double a_y, double a_dydt, int f(double, int, const double*, int, double*), int jac(double, int, const double*, int, int, double*), KRVEC(sc), KRVEC(xi), KRVEC(ts), RMAT(sol)) { const gsl_odeiv_step_type * T; switch(method) { case 0 : {T = gsl_odeiv_step_rk2; break; } case 1 : {T = gsl_odeiv_step_rk4; break; } case 2 : {T = gsl_odeiv_step_rkf45; break; } case 3 : {T = gsl_odeiv_step_rkck; break; } case 4 : {T = gsl_odeiv_step_rk8pd; break; } case 5 : {T = gsl_odeiv_step_rk2imp; break; } case 6 : {T = gsl_odeiv_step_rk4imp; break; } case 7 : {T = gsl_odeiv_step_bsimp; break; } case 8 : { printf("Sorry: ODE rk1imp not available in this GSL version\n"); exit(0); } case 9 : { printf("Sorry: ODE msadams not available in this GSL version\n"); exit(0); } case 10: { printf("Sorry: ODE msbdf not available in this GSL version\n"); exit(0); } default: ERROR(BAD_CODE); } gsl_odeiv_step * s = gsl_odeiv_step_alloc (T, xin); gsl_odeiv_evolve * e = gsl_odeiv_evolve_alloc (xin); gsl_odeiv_control * c; switch(control) { case 0: { c = gsl_odeiv_control_standard_new (eps_abs, eps_rel, a_y, a_dydt); break; } case 1: { c = gsl_odeiv_control_scaled_new (eps_abs, eps_rel, a_y, a_dydt, scp, scn); break; } default: ERROR(BAD_CODE); } Tode P; P.f = f; P.j = jac; P.n = xin; gsl_odeiv_system sys = {odefunc, odejac, xin, &P}; double t = tsp[0]; double* y = (double*)calloc(xin,sizeof(double)); int i,j; for(i=0; i< xin; i++) { y[i] = xip[i]; solp[i] = xip[i]; } for (i = 1; i < tsn ; i++) { double ti = tsp[i]; while (t < ti) { gsl_odeiv_evolve_apply (e, c, s, &sys, &t, ti, &h, y); // if (h < hmin) h = hmin; } for(j=0; j typedef struct {int n; int (*f)(double,int, const double*, int, double *); int (*j)(double,int, const double*, int, int, double*);} Tode; int odefunc (double t, const double y[], double f[], void *params) { Tode * P = (Tode*) params; (P->f)(t,P->n,y,P->n,f); return GSL_SUCCESS; } int odejac (double t, const double y[], double *dfdy, double dfdt[], void *params) { Tode * P = ((Tode*) params); (P->j)(t,P->n,y,P->n,P->n,dfdy); int j; for (j=0; j< P->n; j++) dfdt[j] = 0.0; return GSL_SUCCESS; } int ode(int method, int control, double h, double eps_abs, double eps_rel, double a_y, double a_dydt, int f(double, int, const double*, int, double*), int jac(double, int, const double*, int, int, double*), KRVEC(sc), KRVEC(xi), KRVEC(ts), RMAT(sol)) { const gsl_odeiv2_step_type * T; switch(method) { case 0 : {T = gsl_odeiv2_step_rk2; break; } case 1 : {T = gsl_odeiv2_step_rk4; break; } case 2 : {T = gsl_odeiv2_step_rkf45; break; } case 3 : {T = gsl_odeiv2_step_rkck; break; } case 4 : {T = gsl_odeiv2_step_rk8pd; break; } case 5 : {T = gsl_odeiv2_step_rk2imp; break; } case 6 : {T = gsl_odeiv2_step_rk4imp; break; } case 7 : {T = gsl_odeiv2_step_bsimp; break; } case 8 : {T = gsl_odeiv2_step_rk1imp; break; } case 9 : {T = gsl_odeiv2_step_msadams; break; } case 10: {T = gsl_odeiv2_step_msbdf; break; } default: ERROR(BAD_CODE); } Tode P; P.f = f; P.j = jac; P.n = xin; gsl_odeiv2_system sys = {odefunc, odejac, xin, &P}; gsl_odeiv2_driver * d; switch(control) { case 0: { d = gsl_odeiv2_driver_alloc_standard_new (&sys, T, h, eps_abs, eps_rel, a_y, a_dydt); break; } case 1: { d = gsl_odeiv2_driver_alloc_scaled_new (&sys, T, h, eps_abs, eps_rel, a_y, a_dydt, scp); break; } default: ERROR(BAD_CODE); } double t = tsp[0]; double* y = (double*)calloc(xin,sizeof(double)); int i,j; int status=0; for(i=0; i< xin; i++) { y[i] = xip[i]; solp[i] = xip[i]; } for (i = 1; i < tsn ; i++) { double ti = tsp[i]; status = gsl_odeiv2_driver_apply (d, &t, ti, y); if (status != GSL_SUCCESS) { printf ("error in ode, return value=%d\n", status); break; } // printf ("%.5e %.5e %.5e\n", t, y[0], y[1]); for(j=0; j The example in the GSL manual: >>> let rosenbrock a b [x,y] = [ a*(1-x), b*(y-x^2) ] >>> let (sol,path) = root Hybrids 1E-7 30 (rosenbrock 1 10) [-10,-5] >>> sol [1.0,1.0] >>> disp 3 path 11x5 1.000 -10.000 -5.000 11.000 -1050.000 2.000 -3.976 24.827 4.976 90.203 3.000 -3.976 24.827 4.976 90.203 4.000 -3.976 24.827 4.976 90.203 5.000 -1.274 -5.680 2.274 -73.018 6.000 -1.274 -5.680 2.274 -73.018 7.000 0.249 0.298 0.751 2.359 8.000 0.249 0.298 0.751 2.359 9.000 1.000 0.878 -0.000 -1.218 10.000 1.000 0.989 -0.000 -0.108 11.000 1.000 1.000 0.000 0.000 -} ----------------------------------------------------------------------------- module Numeric.GSL.Root ( uniRoot, UniRootMethod(..), uniRootJ, UniRootMethodJ(..), root, RootMethod(..), rootJ, RootMethodJ(..), ) where import Numeric.LinearAlgebra.HMatrix import Numeric.GSL.Internal import Foreign.Ptr(FunPtr, freeHaskellFunPtr) import Foreign.C.Types import System.IO.Unsafe(unsafePerformIO) ------------------------------------------------------------------------- type TVV = TV (TV Res) type TVM = TV (TM Res) data UniRootMethod = Bisection | FalsePos | Brent deriving (Enum, Eq, Show, Bounded) uniRoot :: UniRootMethod -> Double -> Int -> (Double -> Double) -> Double -> Double -> (Double, Matrix Double) uniRoot method epsrel maxit fun xl xu = uniRootGen (fi (fromEnum method)) fun xl xu epsrel maxit uniRootGen m f xl xu epsrel maxit = unsafePerformIO $ do fp <- mkDoublefun f rawpath <- createMIO maxit 4 (c_root m fp epsrel (fi maxit) xl xu) "root" let it = round (rawpath `atIndex` (maxit-1,0)) path = takeRows it rawpath [sol] = toLists $ dropRows (it-1) path freeHaskellFunPtr fp return (sol !! 1, path) foreign import ccall safe "root" c_root:: CInt -> FunPtr (Double -> Double) -> Double -> CInt -> Double -> Double -> TM Res ------------------------------------------------------------------------- data UniRootMethodJ = UNewton | Secant | Steffenson deriving (Enum, Eq, Show, Bounded) uniRootJ :: UniRootMethodJ -> Double -> Int -> (Double -> Double) -> (Double -> Double) -> Double -> (Double, Matrix Double) uniRootJ method epsrel maxit fun dfun x = uniRootJGen (fi (fromEnum method)) fun dfun x epsrel maxit uniRootJGen m f df x epsrel maxit = unsafePerformIO $ do fp <- mkDoublefun f dfp <- mkDoublefun df rawpath <- createMIO maxit 2 (c_rootj m fp dfp epsrel (fi maxit) x) "rootj" let it = round (rawpath `atIndex` (maxit-1,0)) path = takeRows it rawpath [sol] = toLists $ dropRows (it-1) path freeHaskellFunPtr fp return (sol !! 1, path) foreign import ccall safe "rootj" c_rootj :: CInt -> FunPtr (Double -> Double) -> FunPtr (Double -> Double) -> Double -> CInt -> Double -> TM Res ------------------------------------------------------------------------- data RootMethod = Hybrids | Hybrid | DNewton | Broyden deriving (Enum,Eq,Show,Bounded) -- | Nonlinear multidimensional root finding using algorithms that do not require -- any derivative information to be supplied by the user. -- Any derivatives needed are approximated by finite differences. root :: RootMethod -> Double -- ^ maximum residual -> Int -- ^ maximum number of iterations allowed -> ([Double] -> [Double]) -- ^ function to minimize -> [Double] -- ^ starting point -> ([Double], Matrix Double) -- ^ solution vector and optimization path root method epsabs maxit fun xinit = rootGen (fi (fromEnum method)) fun xinit epsabs maxit rootGen m f xi epsabs maxit = unsafePerformIO $ do let xiv = fromList xi n = size xiv fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) rawpath <- vec xiv $ \xiv' -> createMIO maxit (2*n+1) (c_multiroot m fp epsabs (fi maxit) // xiv') "multiroot" let it = round (rawpath `atIndex` (maxit-1,0)) path = takeRows it rawpath [sol] = toLists $ dropRows (it-1) path freeHaskellFunPtr fp return (take n $ drop 1 sol, path) foreign import ccall safe "multiroot" c_multiroot:: CInt -> FunPtr TVV -> Double -> CInt -> TVM ------------------------------------------------------------------------- data RootMethodJ = HybridsJ | HybridJ | Newton | GNewton deriving (Enum,Eq,Show,Bounded) -- | Nonlinear multidimensional root finding using both the function and its derivatives. rootJ :: RootMethodJ -> Double -- ^ maximum residual -> Int -- ^ maximum number of iterations allowed -> ([Double] -> [Double]) -- ^ function to minimize -> ([Double] -> [[Double]]) -- ^ Jacobian -> [Double] -- ^ starting point -> ([Double], Matrix Double) -- ^ solution vector and optimization path rootJ method epsabs maxit fun jac xinit = rootJGen (fi (fromEnum method)) fun jac xinit epsabs maxit rootJGen m f jac xi epsabs maxit = unsafePerformIO $ do let xiv = fromList xi n = size xiv fp <- mkVecVecfun (aux_vTov (checkdim1 n . fromList . f . toList)) jp <- mkVecMatfun (aux_vTom (checkdim2 n . fromLists . jac . toList)) rawpath <- vec xiv $ \xiv' -> createMIO maxit (2*n+1) (c_multirootj m fp jp epsabs (fi maxit) // xiv') "multiroot" let it = round (rawpath `atIndex` (maxit-1,0)) path = takeRows it rawpath [sol] = toLists $ dropRows (it-1) path freeHaskellFunPtr fp freeHaskellFunPtr jp return (take n $ drop 1 sol, path) foreign import ccall safe "multirootj" c_multirootj:: CInt -> FunPtr TVV -> FunPtr TVM -> Double -> CInt -> TVM ------------------------------------------------------- checkdim1 n v | size v == n = v | otherwise = error $ "Error: "++ show n ++ " components expected in the result of the function supplied to root" checkdim2 n m | rows m == n && cols m == n = m | otherwise = error $ "Error: "++ show n ++ "x" ++ show n ++ " Jacobian expected in rootJ" hmatrix-gsl-0.17.0.0/src/Numeric/GSL/SimulatedAnnealing.hs0000644000000000000000000002245512575776767021345 0ustar0000000000000000{- | Module : Numeric.GSL.Interpolation Copyright : (c) Matthew Peddie 2015 License : GPL Maintainer : Alberto Ruiz Stability : provisional Simulated annealing routines. Here is a translation of the simple example given in : > import Numeric.GSL.SimulatedAnnealing > import Numeric.LinearAlgebra.HMatrix > > main = print $ simanSolve 0 1 exampleParams 15.5 exampleE exampleM exampleS (Just show) > > exampleParams = SimulatedAnnealingParams 200 1000 1.0 1.0 0.008 1.003 2.0e-6 > > exampleE x = exp (-(x - 1)**2) * sin (8 * x) > > exampleM x y = abs $ x - y > > exampleS rands stepSize current = (rands ! 0) * 2 * stepSize - stepSize + current The manual states: > The first example, in one dimensional Cartesian space, sets up an > energy function which is a damped sine wave; this has many local > minima, but only one global minimum, somewhere between 1.0 and > 1.5. The initial guess given is 15.5, which is several local minima > away from the global minimum. This global minimum is around 1.36. -} {-# OPTIONS_GHC -Wall #-} module Numeric.GSL.SimulatedAnnealing ( -- * Searching for minima simanSolve -- * Configuring the annealing process , SimulatedAnnealingParams(..) ) where import Numeric.GSL.Internal import Numeric.LinearAlgebra.HMatrix hiding(step) import Data.Vector.Storable(generateM) import Foreign.Storable(Storable(..)) import Foreign.Marshal.Utils(with) import Foreign.Ptr(Ptr, FunPtr, nullFunPtr) import Foreign.StablePtr(StablePtr, newStablePtr, deRefStablePtr, freeStablePtr) import Foreign.C.Types import System.IO.Unsafe(unsafePerformIO) import System.IO (hFlush, stdout) import Data.IORef (IORef, newIORef, writeIORef, readIORef, modifyIORef') -- | 'SimulatedAnnealingParams' is a translation of the -- @gsl_siman_params_t@ structure documented in -- , -- which controls the simulated annealing algorithm. -- -- The annealing process is parameterized by the Boltzmann -- distribution and the /cooling schedule/. For more details, see -- . data SimulatedAnnealingParams = SimulatedAnnealingParams { n_tries :: CInt -- ^ The number of points to try for each step. , iters_fixed_T :: CInt -- ^ The number of iterations at each temperature , step_size :: Double -- ^ The maximum step size in the random walk , boltzmann_k :: Double -- ^ Boltzmann distribution parameter , cooling_t_initial :: Double -- ^ Initial temperature , cooling_mu_t :: Double -- ^ Cooling rate parameter , cooling_t_min :: Double -- ^ Final temperature } deriving (Eq, Show, Read) instance Storable SimulatedAnnealingParams where sizeOf p = sizeOf (n_tries p) + sizeOf (iters_fixed_T p) + sizeOf (step_size p) + sizeOf (boltzmann_k p) + sizeOf (cooling_t_initial p) + sizeOf (cooling_mu_t p) + sizeOf (cooling_t_min p) -- TODO(MP): is this safe? alignment p = alignment (step_size p) -- TODO(MP): Is there a more automatic way to write these? peek ptr = SimulatedAnnealingParams <$> peekByteOff ptr 0 <*> peekByteOff ptr i <*> peekByteOff ptr (2*i) <*> peekByteOff ptr (2*i + d) <*> peekByteOff ptr (2*i + 2*d) <*> peekByteOff ptr (2*i + 3*d) <*> peekByteOff ptr (2*i + 4*d) where i = sizeOf (0 :: CInt) d = sizeOf (0 :: Double) poke ptr sap = do pokeByteOff ptr 0 (n_tries sap) pokeByteOff ptr i (iters_fixed_T sap) pokeByteOff ptr (2*i) (step_size sap) pokeByteOff ptr (2*i + d) (boltzmann_k sap) pokeByteOff ptr (2*i + 2*d) (cooling_t_initial sap) pokeByteOff ptr (2*i + 3*d) (cooling_mu_t sap) pokeByteOff ptr (2*i + 4*d) (cooling_t_min sap) where i = sizeOf (0 :: CInt) d = sizeOf (0 :: Double) -- We use a StablePtr to an IORef so that we can keep hold of -- StablePtr values but mutate their contents. A simple 'StablePtr a' -- won't work, since we'd have no way to write 'copyConfig'. type P a = StablePtr (IORef a) copyConfig :: P a -> P a -> IO () copyConfig src' dest' = do dest <- deRefStablePtr dest' src <- deRefStablePtr src' readIORef src >>= writeIORef dest copyConstructConfig :: P a -> IO (P a) copyConstructConfig x = do conf <- deRefRead x newconf <- newIORef conf newStablePtr newconf destroyConfig :: P a -> IO () destroyConfig p = do freeStablePtr p deRefRead :: P a -> IO a deRefRead p = deRefStablePtr p >>= readIORef wrapEnergy :: (a -> Double) -> P a -> Double wrapEnergy f p = unsafePerformIO $ f <$> deRefRead p wrapMetric :: (a -> a -> Double) -> P a -> P a -> Double wrapMetric f x y = unsafePerformIO $ f <$> deRefRead x <*> deRefRead y wrapStep :: Int -> (Vector Double -> Double -> a -> a) -> GSLRNG -> P a -> Double -> IO () wrapStep nrand f (GSLRNG rng) confptr stepSize = do v <- generateM nrand (\_ -> gslRngUniform rng) conf <- deRefStablePtr confptr modifyIORef' conf $ f v stepSize wrapPrint :: (a -> String) -> P a -> IO () wrapPrint pf ptr = deRefRead ptr >>= putStr . pf >> hFlush stdout foreign import ccall safe "wrapper" mkEnergyFun :: (P a -> Double) -> IO (FunPtr (P a -> Double)) foreign import ccall safe "wrapper" mkMetricFun :: (P a -> P a -> Double) -> IO (FunPtr (P a -> P a -> Double)) foreign import ccall safe "wrapper" mkStepFun :: (GSLRNG -> P a -> Double -> IO ()) -> IO (FunPtr (GSLRNG -> P a -> Double -> IO ())) foreign import ccall safe "wrapper" mkCopyFun :: (P a -> P a -> IO ()) -> IO (FunPtr (P a -> P a -> IO ())) foreign import ccall safe "wrapper" mkCopyConstructorFun :: (P a -> IO (P a)) -> IO (FunPtr (P a -> IO (P a))) foreign import ccall safe "wrapper" mkDestructFun :: (P a -> IO ()) -> IO (FunPtr (P a -> IO ())) newtype GSLRNG = GSLRNG (Ptr GSLRNG) foreign import ccall safe "gsl_rng.h gsl_rng_uniform" gslRngUniform :: Ptr GSLRNG -> IO Double foreign import ccall safe "gsl-aux.h siman" siman :: CInt -- ^ RNG seed (for repeatability) -> Ptr SimulatedAnnealingParams -- ^ params -> P a -- ^ Configuration -> FunPtr (P a -> Double) -- ^ Energy functional -> FunPtr (P a -> P a -> Double) -- ^ Metric definition -> FunPtr (GSLRNG -> P a -> Double -> IO ()) -- ^ Step evaluation -> FunPtr (P a -> P a -> IO ()) -- ^ Copy config -> FunPtr (P a -> IO (P a)) -- ^ Copy constructor for config -> FunPtr (P a -> IO ()) -- ^ Destructor for config -> FunPtr (P a -> IO ()) -- ^ Print function -> IO CInt -- | -- Calling -- -- > simanSolve seed nrand params x0 e m step print -- -- performs a simulated annealing search through a given space. So -- that any configuration type may be used, the space is specified by -- providing the functions @e@ (the energy functional) and @m@ (the -- metric definition). @x0@ is the initial configuration of the -- system. The simulated annealing steps are generated using the -- user-provided function @step@, which should randomly construct a -- new system configuration. -- -- If 'Nothing' is passed instead of a printing function, no -- incremental output will be generated. Otherwise, the GSL-formatted -- output, including the configuration description the user function -- generates, will be printed to stdout. -- -- Each time the step function is called, it is supplied with a random -- vector containing @nrand@ 'Double' values, uniformly distributed in -- @[0, 1)@. It should use these values to generate its new -- configuration. simanSolve :: Int -- ^ Seed for the random number generator -> Int -- ^ @nrand@, the number of random 'Double's the -- step function requires -> SimulatedAnnealingParams -- ^ Parameters to configure the solver -> a -- ^ Initial configuration @x0@ -> (a -> Double) -- ^ Energy functional @e@ -> (a -> a -> Double) -- ^ Metric definition @m@ -> (Vector Double -> Double -> a -> a) -- ^ Stepping function @step@ -> Maybe (a -> String) -- ^ Optional printing function -> a -- ^ Best configuration the solver has found simanSolve seed nrand params conf e m step printfun = unsafePerformIO $ with params $ \paramptr -> do ewrap <- mkEnergyFun $ wrapEnergy e mwrap <- mkMetricFun $ wrapMetric m stepwrap <- mkStepFun $ wrapStep nrand step confptr <- newIORef conf >>= newStablePtr cpwrap <- mkCopyFun copyConfig ccwrap <- mkCopyConstructorFun copyConstructConfig dwrap <- mkDestructFun destroyConfig pwrap <- case printfun of Nothing -> return nullFunPtr Just pf -> mkDestructFun $ wrapPrint pf siman (fromIntegral seed) paramptr confptr ewrap mwrap stepwrap cpwrap ccwrap dwrap pwrap // check "siman" result <- deRefRead confptr freeStablePtr confptr return result hmatrix-gsl-0.17.0.0/src/Numeric/GSL/ODE.hs0000644000000000000000000001771412575776767016212 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {- | Module : Numeric.GSL.ODE Copyright : (c) Alberto Ruiz 2010 License : GPL Maintainer : Alberto Ruiz Stability : provisional Solution of ordinary differential equation (ODE) initial value problems. A simple example: @ import Numeric.GSL.ODE import Numeric.LinearAlgebra import Numeric.LinearAlgebra.Util(mplot) xdot t [x,v] = [v, -0.95*x - 0.1*v] ts = linspace 100 (0,20 :: Double) sol = odeSolve xdot [10,0] ts main = mplot (ts : toColumns sol) @ -} ----------------------------------------------------------------------------- module Numeric.GSL.ODE ( odeSolve, odeSolveV, odeSolveVWith, ODEMethod(..), Jacobian, StepControl(..) ) where import Numeric.LinearAlgebra.HMatrix import Numeric.GSL.Internal import Foreign.Ptr(FunPtr, nullFunPtr, freeHaskellFunPtr) import Foreign.C.Types import System.IO.Unsafe(unsafePerformIO) ------------------------------------------------------------------------- type TVV = TV (TV Res) type TVM = TV (TM Res) type TVVM = TV (TV (TM Res)) type TVVVM = TV (TV (TV (TM Res))) type Jacobian = Double -> Vector Double -> Matrix Double -- | Stepping functions data ODEMethod = RK2 -- ^ Embedded Runge-Kutta (2, 3) method. | RK4 -- ^ 4th order (classical) Runge-Kutta. The error estimate is obtained by halving the step-size. For more efficient estimate of the error, use the embedded methods. | RKf45 -- ^ Embedded Runge-Kutta-Fehlberg (4, 5) method. This method is a good general-purpose integrator. | RKck -- ^ Embedded Runge-Kutta Cash-Karp (4, 5) method. | RK8pd -- ^ Embedded Runge-Kutta Prince-Dormand (8,9) method. | RK2imp Jacobian -- ^ Implicit 2nd order Runge-Kutta at Gaussian points. | RK4imp Jacobian -- ^ Implicit 4th order Runge-Kutta at Gaussian points. | BSimp Jacobian -- ^ Implicit Bulirsch-Stoer method of Bader and Deuflhard. The method is generally suitable for stiff problems. | RK1imp Jacobian -- ^ Implicit Gaussian first order Runge-Kutta. Also known as implicit Euler or backward Euler method. Error estimation is carried out by the step doubling method. | MSAdams -- ^ A variable-coefficient linear multistep Adams method in Nordsieck form. This stepper uses explicit Adams-Bashforth (predictor) and implicit Adams-Moulton (corrector) methods in P(EC)^m functional iteration mode. Method order varies dynamically between 1 and 12. | MSBDF Jacobian -- ^ A variable-coefficient linear multistep backward differentiation formula (BDF) method in Nordsieck form. This stepper uses the explicit BDF formula as predictor and implicit BDF formula as corrector. A modified Newton iteration method is used to solve the system of non-linear equations. Method order varies dynamically between 1 and 5. The method is generally suitable for stiff problems. -- | Adaptive step-size control functions data StepControl = X Double Double -- ^ abs. and rel. tolerance for x(t) | X' Double Double -- ^ abs. and rel. tolerance for x'(t) | XX' Double Double Double Double -- ^ include both via rel. tolerance scaling factors a_x, a_x' | ScXX' Double Double Double Double (Vector Double) -- ^ scale abs. tolerance of x(t) components -- | A version of 'odeSolveV' with reasonable default parameters and system of equations defined using lists. odeSolve :: (Double -> [Double] -> [Double]) -- ^ x'(t,x) -> [Double] -- ^ initial conditions -> Vector Double -- ^ desired solution times -> Matrix Double -- ^ solution odeSolve xdot xi ts = odeSolveV RKf45 hi epsAbs epsRel (l2v xdot) (fromList xi) ts where hi = (ts!1 - ts!0)/100 epsAbs = 1.49012e-08 epsRel = epsAbs l2v f = \t -> fromList . f t . toList -- | A version of 'odeSolveVWith' with reasonable default step control. odeSolveV :: ODEMethod -> Double -- ^ initial step size -> Double -- ^ absolute tolerance for the state vector -> Double -- ^ relative tolerance for the state vector -> (Double -> Vector Double -> Vector Double) -- ^ x'(t,x) -> Vector Double -- ^ initial conditions -> Vector Double -- ^ desired solution times -> Matrix Double -- ^ solution odeSolveV meth hi epsAbs epsRel = odeSolveVWith meth (XX' epsAbs epsRel 1 1) hi -- | Evolution of the system with adaptive step-size control. odeSolveVWith :: ODEMethod -> StepControl -> Double -- ^ initial step size -> (Double -> Vector Double -> Vector Double) -- ^ x'(t,x) -> Vector Double -- ^ initial conditions -> Vector Double -- ^ desired solution times -> Matrix Double -- ^ solution odeSolveVWith method control = odeSolveVWith' m mbj c epsAbs epsRel aX aX' mbsc where (m, mbj) = case method of RK2 -> (0 , Nothing ) RK4 -> (1 , Nothing ) RKf45 -> (2 , Nothing ) RKck -> (3 , Nothing ) RK8pd -> (4 , Nothing ) RK2imp jac -> (5 , Just jac) RK4imp jac -> (6 , Just jac) BSimp jac -> (7 , Just jac) RK1imp jac -> (8 , Just jac) MSAdams -> (9 , Nothing ) MSBDF jac -> (10, Just jac) (c, epsAbs, epsRel, aX, aX', mbsc) = case control of X ea er -> (0, ea, er, 1 , 0 , Nothing) X' ea er -> (0, ea, er, 0 , 1 , Nothing) XX' ea er ax ax' -> (0, ea, er, ax, ax', Nothing) ScXX' ea er ax ax' sc -> (1, ea, er, ax, ax', Just sc) odeSolveVWith' :: CInt -- ^ stepping function -> Maybe (Double -> Vector Double -> Matrix Double) -- ^ optional jacobian -> CInt -- ^ step-size control function -> Double -- ^ absolute tolerance for step-size control -> Double -- ^ relative tolerance for step-size control -> Double -- ^ scaling factor for relative tolerance of x(t) -> Double -- ^ scaling factor for relative tolerance of x'(t) -> Maybe (Vector Double) -- ^ optional scaling for absolute error -> Double -- ^ initial step size -> (Double -> Vector Double -> Vector Double) -- ^ x'(t,x) -> Vector Double -- ^ initial conditions -> Vector Double -- ^ desired solution times -> Matrix Double -- ^ solution odeSolveVWith' method mbjac control epsAbs epsRel aX aX' mbsc h f xiv ts = unsafePerformIO $ do let n = size xiv sc = case mbsc of Just scv -> checkdim1 n scv Nothing -> xiv fp <- mkDoubleVecVecfun (\t -> aux_vTov (checkdim1 n . f t)) jp <- case mbjac of Just jac -> mkDoubleVecMatfun (\t -> aux_vTom (checkdim2 n . jac t)) Nothing -> return nullFunPtr sol <- vec sc $ \sc' -> vec xiv $ \xiv' -> vec (checkTimes ts) $ \ts' -> createMIO (size ts) n (ode_c method control h epsAbs epsRel aX aX' fp jp // sc' // xiv' // ts' ) "ode" freeHaskellFunPtr fp return sol foreign import ccall safe "ode" ode_c :: CInt -> CInt -> Double -> Double -> Double -> Double -> Double -> FunPtr (Double -> TVV) -> FunPtr (Double -> TVM) -> TVVVM ------------------------------------------------------- checkdim1 n v | size v == n = v | otherwise = error $ "Error: "++ show n ++ " components expected in the result of the function supplied to odeSolve" checkdim2 n m | rows m == n && cols m == n = m | otherwise = error $ "Error: "++ show n ++ "x" ++ show n ++ " Jacobian expected in odeSolve" checkTimes ts | size ts > 1 && all (>0) (zipWith subtract ts' (tail ts')) = ts | otherwise = error "odeSolve requires increasing times" where ts' = toList ts hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Integration.hs0000644000000000000000000002072112575776767020056 0ustar0000000000000000{- | Module : Numeric.GSL.Integration Copyright : (c) Alberto Ruiz 2006 License : GPL Maintainer : Alberto Ruiz Stability : provisional Numerical integration routines. -} module Numeric.GSL.Integration ( integrateQNG, integrateQAGS, integrateQAGI, integrateQAGIU, integrateQAGIL, integrateCQUAD ) where import Foreign.C.Types import Foreign.Marshal.Alloc(malloc, free) import Foreign.Ptr(Ptr, FunPtr, freeHaskellFunPtr) import Foreign.Storable(peek) import Numeric.GSL.Internal import System.IO.Unsafe(unsafePerformIO) eps = 1e-12 {- | conversion of Haskell functions into function pointers that can be used in the C side -} foreign import ccall safe "wrapper" mkfun:: (Double -> Ptr() -> Double) -> IO( FunPtr (Double -> Ptr() -> Double)) -------------------------------------------------------------------- {- | Numerical integration using /gsl_integration_qags/ (adaptive integration with singularities). For example: >>> let quad = integrateQAGS 1E-9 1000 >>> let f a x = x**(-0.5) * log (a*x) >>> quad (f 1) 0 1 (-3.999999999999974,4.871658632055187e-13) -} integrateQAGS :: Double -- ^ precision (e.g. 1E-9) -> Int -- ^ size of auxiliary workspace (e.g. 1000) -> (Double -> Double) -- ^ function to be integrated on the interval (a,b) -> Double -- ^ a -> Double -- ^ b -> (Double, Double) -- ^ result of the integration and error integrateQAGS prec n f a b = unsafePerformIO $ do r <- malloc e <- malloc fp <- mkfun (\x _ -> f x) c_integrate_qags fp a b eps prec (fromIntegral n) r e // check "integrate_qags" vr <- peek r ve <- peek e let result = (vr,ve) free r free e freeHaskellFunPtr fp return result foreign import ccall safe "integrate_qags" c_integrate_qags :: FunPtr (Double-> Ptr() -> Double) -> Double -> Double -> Double -> Double -> CInt -> Ptr Double -> Ptr Double -> IO CInt ----------------------------------------------------------------- {- | Numerical integration using /gsl_integration_qng/ (useful for fast integration of smooth functions). For example: >>> let quad = integrateQNG 1E-6 >>> quad (\x -> 4/(1+x*x)) 0 1 (3.141592653589793,3.487868498008632e-14) -} integrateQNG :: Double -- ^ precision (e.g. 1E-9) -> (Double -> Double) -- ^ function to be integrated on the interval (a,b) -> Double -- ^ a -> Double -- ^ b -> (Double, Double) -- ^ result of the integration and error integrateQNG prec f a b = unsafePerformIO $ do r <- malloc e <- malloc fp <- mkfun (\x _ -> f x) c_integrate_qng fp a b eps prec r e // check "integrate_qng" vr <- peek r ve <- peek e let result = (vr,ve) free r free e freeHaskellFunPtr fp return result foreign import ccall safe "integrate_qng" c_integrate_qng :: FunPtr (Double-> Ptr() -> Double) -> Double -> Double -> Double -> Double -> Ptr Double -> Ptr Double -> IO CInt -------------------------------------------------------------------- {- | Numerical integration using /gsl_integration_qagi/ (integration over the infinite integral -Inf..Inf using QAGS). For example: >>> let quad = integrateQAGI 1E-9 1000 >>> let f a x = exp(-a * x^2) >>> quad (f 0.5) (2.5066282746310002,6.229215880648858e-11) -} integrateQAGI :: Double -- ^ precision (e.g. 1E-9) -> Int -- ^ size of auxiliary workspace (e.g. 1000) -> (Double -> Double) -- ^ function to be integrated on the interval (-Inf,Inf) -> (Double, Double) -- ^ result of the integration and error integrateQAGI prec n f = unsafePerformIO $ do r <- malloc e <- malloc fp <- mkfun (\x _ -> f x) c_integrate_qagi fp eps prec (fromIntegral n) r e // check "integrate_qagi" vr <- peek r ve <- peek e let result = (vr,ve) free r free e freeHaskellFunPtr fp return result foreign import ccall safe "integrate_qagi" c_integrate_qagi :: FunPtr (Double-> Ptr() -> Double) -> Double -> Double -> CInt -> Ptr Double -> Ptr Double -> IO CInt -------------------------------------------------------------------- {- | Numerical integration using /gsl_integration_qagiu/ (integration over the semi-infinite integral a..Inf). For example: >>> let quad = integrateQAGIU 1E-9 1000 >>> let f a x = exp(-a * x^2) >>> quad (f 0.5) 0 (1.2533141373155001,3.114607940324429e-11) -} integrateQAGIU :: Double -- ^ precision (e.g. 1E-9) -> Int -- ^ size of auxiliary workspace (e.g. 1000) -> (Double -> Double) -- ^ function to be integrated on the interval (a,Inf) -> Double -- ^ a -> (Double, Double) -- ^ result of the integration and error integrateQAGIU prec n f a = unsafePerformIO $ do r <- malloc e <- malloc fp <- mkfun (\x _ -> f x) c_integrate_qagiu fp a eps prec (fromIntegral n) r e // check "integrate_qagiu" vr <- peek r ve <- peek e let result = (vr,ve) free r free e freeHaskellFunPtr fp return result foreign import ccall safe "integrate_qagiu" c_integrate_qagiu :: FunPtr (Double-> Ptr() -> Double) -> Double -> Double -> Double -> CInt -> Ptr Double -> Ptr Double -> IO CInt -------------------------------------------------------------------- {- | Numerical integration using /gsl_integration_qagil/ (integration over the semi-infinite integral -Inf..b). For example: >>> let quad = integrateQAGIL 1E-9 1000 >>> let f a x = exp(-a * x^2) >>> quad (f 0.5) 0 (1.2533141373155001,3.114607940324429e-11) -} integrateQAGIL :: Double -- ^ precision (e.g. 1E-9) -> Int -- ^ size of auxiliary workspace (e.g. 1000) -> (Double -> Double) -- ^ function to be integrated on the interval (a,Inf) -> Double -- ^ b -> (Double, Double) -- ^ result of the integration and error integrateQAGIL prec n f b = unsafePerformIO $ do r <- malloc e <- malloc fp <- mkfun (\x _ -> f x) c_integrate_qagil fp b eps prec (fromIntegral n) r e // check "integrate_qagil" vr <- peek r ve <- peek e let result = (vr,ve) free r free e freeHaskellFunPtr fp return result foreign import ccall safe "gsl-aux.h integrate_qagil" c_integrate_qagil :: FunPtr (Double-> Ptr() -> Double) -> Double -> Double -> Double -> CInt -> Ptr Double -> Ptr Double -> IO CInt -------------------------------------------------------------------- {- | Numerical integration using /gsl_integration_cquad/ (quadrature for general integrands). From the GSL manual: @CQUAD is a new doubly-adaptive general-purpose quadrature routine which can handle most types of singularities, non-numerical function values such as Inf or NaN, as well as some divergent integrals. It generally requires more function evaluations than the integration routines in QUADPACK, yet fails less often for difficult integrands.@ For example: >>> let quad = integrateCQUAD 1E-12 1000 >>> let f a x = exp(-a * x^2) >>> quad (f 0.5) 2 5 (5.7025405463957006e-2,9.678874441303705e-16,95) Unlike other quadrature methods, integrateCQUAD also returns the number of function evaluations required. -} integrateCQUAD :: Double -- ^ precision (e.g. 1E-9) -> Int -- ^ size of auxiliary workspace (e.g. 1000) -> (Double -> Double) -- ^ function to be integrated on the interval (a, b) -> Double -- ^ a -> Double -- ^ b -> (Double, Double, Int) -- ^ result of the integration, error and number of function evaluations performed integrateCQUAD prec n f a b = unsafePerformIO $ do r <- malloc e <- malloc neval <- malloc fp <- mkfun (\x _ -> f x) c_integrate_cquad fp a b eps prec (fromIntegral n) r e neval // check "integrate_cquad" vr <- peek r ve <- peek e vneval <- peek neval let result = (vr,ve,vneval) free r free e free neval freeHaskellFunPtr fp return result foreign import ccall safe "integrate_cquad" c_integrate_cquad :: FunPtr (Double-> Ptr() -> Double) -> Double -> Double -> Double -> Double -> CInt -> Ptr Double -> Ptr Double -> Ptr Int -> IO CInt hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Random.hs0000644000000000000000000000453312575776767017016 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Numeric.GSL.Random -- Copyright : (c) Alberto Ruiz 2009-14 -- License : GPL -- -- Maintainer : Alberto Ruiz -- Stability : provisional -- -- Random vectors and matrices. -- ----------------------------------------------------------------------------- module Numeric.GSL.Random ( Seed, RandDist(..), randomVector, gaussianSample, uniformSample, rand, randn ) where import Numeric.GSL.Vector import Numeric.LinearAlgebra.HMatrix hiding ( randomVector, gaussianSample, uniformSample, Seed, rand, randn ) import System.Random(randomIO) type Seed = Int -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate -- Gaussian distribution. gaussianSample :: Seed -> Int -- ^ number of rows -> Vector Double -- ^ mean vector -> Matrix Double -- ^ covariance matrix -> Matrix Double -- ^ result gaussianSample seed n med cov = m where c = size med meds = konst 1 n `outer` med rs = reshape c $ randomVector seed Gaussian (c * n) m = rs <> cholSH cov + meds -- | Obtains a matrix whose rows are pseudorandom samples from a multivariate -- uniform distribution. uniformSample :: Seed -> Int -- ^ number of rows -> [(Double,Double)] -- ^ ranges for each column -> Matrix Double -- ^ result uniformSample seed n rgs = m where (as,bs) = unzip rgs a = fromList as cs = zipWith subtract as bs d = size a dat = toRows $ reshape n $ randomVector seed Uniform (n*d) am = konst 1 n `outer` a m = fromColumns (zipWith scale cs dat) + am -- | pseudorandom matrix with uniform elements between 0 and 1 randm :: RandDist -> Int -- ^ rows -> Int -- ^ columns -> IO (Matrix Double) randm d r c = do seed <- randomIO return (reshape c $ randomVector seed d (r*c)) -- | pseudorandom matrix with uniform elements between 0 and 1 rand :: Int -> Int -> IO (Matrix Double) rand = randm Uniform {- | pseudorandom matrix with normal elements >>> x <- randn 3 5 >>> disp 3 x 3x5 0.386 -1.141 0.491 -0.510 1.512 0.069 -0.919 1.022 -0.181 0.745 0.313 -0.670 -0.097 -1.575 -0.583 -} randn :: Int -> Int -> IO (Matrix Double) randn = randm Gaussian hmatrix-gsl-0.17.0.0/src/Numeric/GSL/Polynomials.hs0000644000000000000000000000273312575776767020104 0ustar0000000000000000{- | Module : Numeric.GSL.Polynomials Copyright : (c) Alberto Ruiz 2006 License : GPL Maintainer : Alberto Ruiz Stability : provisional Polynomials. -} module Numeric.GSL.Polynomials ( polySolve ) where import Numeric.LinearAlgebra.HMatrix import Numeric.GSL.Internal import System.IO.Unsafe (unsafePerformIO) #if __GLASGOW_HASKELL__ >= 704 import Foreign.C.Types (CInt(..)) #endif {- | Solution of general polynomial equations, using /gsl_poly_complex_solve/. For example, the three solutions of x^3 + 8 = 0 >>> polySolve [8,0,0,1] [(-2.0) :+ 0.0,1.0 :+ 1.7320508075688776,1.0 :+ (-1.7320508075688776)] The example in the GSL manual: To find the roots of x^5 -1 = 0: >>> polySolve [-1, 0, 0, 0, 0, 1] [(-0.8090169943749472) :+ 0.5877852522924731, (-0.8090169943749472) :+ (-0.5877852522924731), 0.30901699437494756 :+ 0.9510565162951535, 0.30901699437494756 :+ (-0.9510565162951535), 1.0000000000000002 :+ 0.0] -} polySolve :: [Double] -> [Complex Double] polySolve = toList . polySolve' . fromList polySolve' :: Vector Double -> Vector (Complex Double) polySolve' v | size v > 1 = unsafePerformIO $ do r <- createVector (size v-1) c_polySolve # v # r #| "polySolve" return r | otherwise = error "polySolve on a polynomial of degree zero" foreign import ccall unsafe "gsl-aux.h polySolve" c_polySolve:: TV (TCV Res) hmatrix-gsl-0.17.0.0/src/Numeric/GSL/LinearAlgebra.hs0000644000000000000000000001165612575776767020272 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Numeric.GSL.LinearAlgebra -- Copyright : (c) Alberto Ruiz 2007-14 -- License : GPL -- Maintainer : Alberto Ruiz -- Stability : provisional -- ----------------------------------------------------------------------------- module Numeric.GSL.LinearAlgebra ( RandDist(..), randomVector, saveMatrix, fwriteVector, freadVector, fprintfVector, fscanfVector, fileDimensions, loadMatrix, fromFile ) where import Numeric.LinearAlgebra.HMatrix hiding (RandDist,randomVector,saveMatrix,loadMatrix) import Numeric.GSL.Internal hiding (TV,TM,TCV,TCM) import Foreign.Marshal.Alloc(free) import Foreign.Ptr(Ptr) import Foreign.C.Types import Foreign.C.String(newCString) import System.IO.Unsafe(unsafePerformIO) import System.Process(readProcess) fromei x = fromIntegral (fromEnum x) :: CInt ----------------------------------------------------------------------- data RandDist = Uniform -- ^ uniform distribution in [0,1) | Gaussian -- ^ normal distribution with mean zero and standard deviation one deriving Enum -- | Obtains a vector of pseudorandom elements from the the mt19937 generator in GSL, with a given seed. Use randomIO to get a random seed. randomVector :: Int -- ^ seed -> RandDist -- ^ distribution -> Int -- ^ vector size -> Vector Double randomVector seed dist n = unsafePerformIO $ do r <- createVector n c_random_vector (fi seed) ((fi.fromEnum) dist) # r #|"randomVector" return r foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> TV -------------------------------------------------------------------------------- -- | Saves a matrix as 2D ASCII table. saveMatrix :: FilePath -> String -- ^ format (%f, %g, %e) -> Matrix Double -> IO () saveMatrix filename fmt m = do charname <- newCString filename charfmt <- newCString fmt let o = if orderOf m == RowMajor then 1 else 0 matrix_fprintf charname charfmt o # m #|"matrix_fprintf" free charname free charfmt foreign import ccall unsafe "matrix_fprintf" matrix_fprintf :: Ptr CChar -> Ptr CChar -> CInt -> TM -------------------------------------------------------------------------------- -- | Loads a vector from an ASCII file (the number of elements must be known in advance). fscanfVector :: FilePath -> Int -> IO (Vector Double) fscanfVector filename n = do charname <- newCString filename res <- createVector n gsl_vector_fscanf charname # res #|"gsl_vector_fscanf" free charname return res foreign import ccall unsafe "vector_fscanf" gsl_vector_fscanf:: Ptr CChar -> TV -- | Saves the elements of a vector, with a given format (%f, %e, %g), to an ASCII file. fprintfVector :: FilePath -> String -> Vector Double -> IO () fprintfVector filename fmt v = do charname <- newCString filename charfmt <- newCString fmt gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf" free charname free charfmt foreign import ccall unsafe "vector_fprintf" gsl_vector_fprintf :: Ptr CChar -> Ptr CChar -> TV -- | Loads a vector from a binary file (the number of elements must be known in advance). freadVector :: FilePath -> Int -> IO (Vector Double) freadVector filename n = do charname <- newCString filename res <- createVector n gsl_vector_fread charname # res #| "gsl_vector_fread" free charname return res foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV -- | Saves the elements of a vector to a binary file. fwriteVector :: FilePath -> Vector Double -> IO () fwriteVector filename v = do charname <- newCString filename gsl_vector_fwrite charname # v #|"gsl_vector_fwrite" free charname foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV type PD = Ptr Double -- type TV = CInt -> PD -> IO CInt -- type TM = CInt -> CInt -> PD -> IO CInt -- -------------------------------------------------------------------------------- {- | obtains the number of rows and columns in an ASCII data file (provisionally using unix's wc). -} fileDimensions :: FilePath -> IO (Int,Int) fileDimensions fname = do wcres <- readProcess "wc" ["-w",fname] "" contents <- readFile fname let tot = read . head . words $ wcres c = length . head . dropWhile null . map words . lines $ contents if tot > 0 then return (tot `div` c, c) else return (0,0) -- | Loads a matrix from an ASCII file formatted as a 2D table. loadMatrix :: FilePath -> IO (Matrix Double) loadMatrix file = fromFile file =<< fileDimensions file -- | Loads a matrix from an ASCII file (the number of rows and columns must be known in advance). fromFile :: FilePath -> (Int,Int) -> IO (Matrix Double) fromFile filename (r,c) = reshape c `fmap` fscanfVector filename (r*c) hmatrix-gsl-0.17.0.0/src/Numeric/GSL/IO.hs0000644000000000000000000000265112575776767016104 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Numeric.GSL.IO -- Copyright : (c) Alberto Ruiz 2007-14 -- License : GPL -- Maintainer : Alberto Ruiz -- Stability : provisional -- ----------------------------------------------------------------------------- module Numeric.GSL.IO ( saveMatrix, fwriteVector, freadVector, fprintfVector, fscanfVector, fileDimensions, loadMatrix, fromFile ) where import Numeric.LinearAlgebra.HMatrix hiding(saveMatrix, loadMatrix) import Numeric.GSL.Vector import System.Process(readProcess) {- | obtains the number of rows and columns in an ASCII data file (provisionally using unix's wc). -} fileDimensions :: FilePath -> IO (Int,Int) fileDimensions fname = do wcres <- readProcess "wc" ["-w",fname] "" contents <- readFile fname let tot = read . head . words $ wcres c = length . head . dropWhile null . map words . lines $ contents if tot > 0 then return (tot `div` c, c) else return (0,0) -- | Loads a matrix from an ASCII file formatted as a 2D table. loadMatrix :: FilePath -> IO (Matrix Double) loadMatrix file = fromFile file =<< fileDimensions file -- | Loads a matrix from an ASCII file (the number of rows and columns must be known in advance). fromFile :: FilePath -> (Int,Int) -> IO (Matrix Double) fromFile filename (r,c) = reshape c `fmap` fscanfVector filename (r*c) hmatrix-gsl-0.17.0.0/src/Numeric/GSL/gsl-aux.c0000644000000000000000000010022112575776767016755 0ustar0000000000000000#include #define RVEC(A) int A##n, double*A##p #define RMAT(A) int A##r, int A##c, double* A##p #define KRVEC(A) int A##n, const double*A##p #define KRMAT(A) int A##r, int A##c, const double* A##p #define CVEC(A) int A##n, gsl_complex*A##p #define CMAT(A) int A##r, int A##c, gsl_complex* A##p #define KCVEC(A) int A##n, const gsl_complex*A##p #define KCMAT(A) int A##r, int A##c, const gsl_complex* A##p #define FVEC(A) int A##n, float*A##p #define FMAT(A) int A##r, int A##c, float* A##p #define KFVEC(A) int A##n, const float*A##p #define KFMAT(A) int A##r, int A##c, const float* A##p #define QVEC(A) int A##n, gsl_complex_float*A##p #define QMAT(A) int A##r, int A##c, gsl_complex_float* A##p #define KQVEC(A) int A##n, const gsl_complex_float*A##p #define KQMAT(A) int A##r, int A##c, const gsl_complex_float* A##p #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #define MACRO(B) do {B} while (0) #define ERROR(CODE) MACRO(return CODE;) #define REQUIRES(COND, CODE) MACRO(if(!(COND)) {ERROR(CODE);}) #define OK return 0; #define MIN(A,B) ((A)<(B)?(A):(B)) #define MAX(A,B) ((A)>(B)?(A):(B)) #ifdef DBG #define DEBUGMSG(M) printf("*** calling aux C function: %s\n",M); #else #define DEBUGMSG(M) #endif #define CHECK(RES,CODE) MACRO(if(RES) return CODE;) #ifdef DBG #define DEBUGMAT(MSG,X) printf(MSG" = \n"); gsl_matrix_fprintf(stdout,X,"%f"); printf("\n"); #else #define DEBUGMAT(MSG,X) #endif #ifdef DBG #define DEBUGVEC(MSG,X) printf(MSG" = \n"); gsl_vector_fprintf(stdout,X,"%f"); printf("\n"); #else #define DEBUGVEC(MSG,X) #endif #define DVVIEW(A) gsl_vector_view A = gsl_vector_view_array(A##p,A##n) #define DMVIEW(A) gsl_matrix_view A = gsl_matrix_view_array(A##p,A##r,A##c) #define CVVIEW(A) gsl_vector_complex_view A = gsl_vector_complex_view_array((double*)A##p,A##n) #define CMVIEW(A) gsl_matrix_complex_view A = gsl_matrix_complex_view_array((double*)A##p,A##r,A##c) #define KDVVIEW(A) gsl_vector_const_view A = gsl_vector_const_view_array(A##p,A##n) #define KDMVIEW(A) gsl_matrix_const_view A = gsl_matrix_const_view_array(A##p,A##r,A##c) #define KCVVIEW(A) gsl_vector_complex_const_view A = gsl_vector_complex_const_view_array((double*)A##p,A##n) #define KCMVIEW(A) gsl_matrix_complex_const_view A = gsl_matrix_complex_const_view_array((double*)A##p,A##r,A##c) #define FVVIEW(A) gsl_vector_float_view A = gsl_vector_float_view_array(A##p,A##n) #define FMVIEW(A) gsl_matrix_float_view A = gsl_matrix_float_view_array(A##p,A##r,A##c) #define QVVIEW(A) gsl_vector_complex_float_view A = gsl_vector_float_complex_view_array((float*)A##p,A##n) #define QMVIEW(A) gsl_matrix_complex_float_view A = gsl_matrix_float_complex_view_array((float*)A##p,A##r,A##c) #define KFVVIEW(A) gsl_vector_float_const_view A = gsl_vector_float_const_view_array(A##p,A##n) #define KFMVIEW(A) gsl_matrix_float_const_view A = gsl_matrix_float_const_view_array(A##p,A##r,A##c) #define KQVVIEW(A) gsl_vector_complex_float_const_view A = gsl_vector_complex_float_const_view_array((float*)A##p,A##n) #define KQMVIEW(A) gsl_matrix_complex_float_const_view A = gsl_matrix_complex_float_const_view_array((float*)A##p,A##r,A##c) #define V(a) (&a.vector) #define M(a) (&a.matrix) #define GCVEC(A) int A##n, gsl_complex*A##p #define KGCVEC(A) int A##n, const gsl_complex*A##p #define GQVEC(A) int A##n, gsl_complex_float*A##p #define KGQVEC(A) int A##n, const gsl_complex_float*A##p #define BAD_SIZE 2000 #define BAD_CODE 2001 #define MEM 2002 #define BAD_FILE 2003 void no_abort_on_error() { gsl_set_error_handler_off(); } int fft(int code, KCVEC(X), CVEC(R)) { REQUIRES(Xn == Rn,BAD_SIZE); DEBUGMSG("fft"); int s = Xn; gsl_fft_complex_wavetable * wavetable = gsl_fft_complex_wavetable_alloc (s); gsl_fft_complex_workspace * workspace = gsl_fft_complex_workspace_alloc (s); gsl_vector_const_view X = gsl_vector_const_view_array((double*)Xp, 2*Xn); gsl_vector_view R = gsl_vector_view_array((double*)Rp, 2*Rn); gsl_blas_dcopy(&X.vector,&R.vector); if(code==0) { gsl_fft_complex_forward ((double*)Rp, 1, s, wavetable, workspace); } else { gsl_fft_complex_inverse ((double*)Rp, 1, s, wavetable, workspace); } gsl_fft_complex_wavetable_free (wavetable); gsl_fft_complex_workspace_free (workspace); OK } int deriv(int code, double f(double, void*), double x, double h, double * result, double * abserr) { gsl_function F; F.function = f; F.params = 0; if(code==0) return gsl_deriv_central (&F, x, h, result, abserr); if(code==1) return gsl_deriv_forward (&F, x, h, result, abserr); if(code==2) return gsl_deriv_backward (&F, x, h, result, abserr); return 0; } int spline_eval(const double xa[], const double ya[], unsigned int size, double x, int method, double *y) { DEBUGMSG("spline_eval"); const gsl_interp_type *T; switch (method) { case 0: { T = gsl_interp_linear; break; } case 1: { T = gsl_interp_polynomial; break; } case 2: { T = gsl_interp_cspline; break; } case 3: { T = gsl_interp_cspline_periodic; break; } case 4: { T = gsl_interp_akima; break; } case 5: { T = gsl_interp_akima_periodic; break; } default: ERROR(BAD_CODE); } gsl_spline *spline = gsl_spline_alloc(T, size); if (NULL == spline) ERROR(MEM); const int initres = gsl_spline_init(spline, xa, ya, size); CHECK(initres,initres); gsl_interp_accel *acc = gsl_interp_accel_alloc(); if (NULL == acc) { gsl_spline_free(spline); ERROR(MEM); }; const int res = gsl_spline_eval_e(spline, x, acc, y); CHECK(res,res); gsl_interp_accel_free(acc); gsl_spline_free(spline); OK } int spline_eval_deriv(const double xa[], const double ya[], unsigned int size, double x, int method, double *y) { DEBUGMSG("spline_eval_deriv"); const gsl_interp_type *T; switch (method) { case 0: { T = gsl_interp_linear; break; } case 1: { T = gsl_interp_polynomial; break; } case 2: { T = gsl_interp_cspline; break; } case 3: { T = gsl_interp_cspline_periodic; break; } case 4: { T = gsl_interp_akima; break; } case 5: { T = gsl_interp_akima_periodic; break; } default: ERROR(BAD_CODE); } gsl_spline *spline = gsl_spline_alloc(T, size); if (NULL == spline) ERROR(MEM); const int initres = gsl_spline_init(spline, xa, ya, size); CHECK(initres,initres); gsl_interp_accel *acc = gsl_interp_accel_alloc(); if (NULL == acc) { gsl_spline_free(spline); ERROR(MEM); }; const int res = gsl_spline_eval_deriv_e(spline, x, acc, y); CHECK(res,res); gsl_interp_accel_free(acc); gsl_spline_free(spline); OK } int spline_eval_deriv2(const double xa[], const double ya[], unsigned int size, double x, int method, double *y) { DEBUGMSG("spline_eval_deriv2"); const gsl_interp_type *T; switch (method) { case 0: { T = gsl_interp_linear; break; } case 1: { T = gsl_interp_polynomial; break; } case 2: { T = gsl_interp_cspline; break; } case 3: { T = gsl_interp_cspline_periodic; break; } case 4: { T = gsl_interp_akima; break; } case 5: { T = gsl_interp_akima_periodic; break; } default: ERROR(BAD_CODE); } gsl_spline *spline = gsl_spline_alloc(T, size); if (NULL == spline) ERROR(MEM); const int initres = gsl_spline_init(spline, xa, ya, size); CHECK(initres,initres); gsl_interp_accel *acc = gsl_interp_accel_alloc(); if (NULL == acc) { gsl_spline_free(spline); ERROR(MEM); }; const int res = gsl_spline_eval_deriv2_e(spline, x, acc, y); CHECK(res,res); gsl_interp_accel_free(acc); gsl_spline_free(spline); OK } int spline_eval_integ(const double xa[], const double ya[], unsigned int size, double a, double b, int method, double *y) { DEBUGMSG("spline_eval_integ"); const gsl_interp_type *T; switch (method) { case 0: { T = gsl_interp_linear; break; } case 1: { T = gsl_interp_polynomial; break; } case 2: { T = gsl_interp_cspline; break; } case 3: { T = gsl_interp_cspline_periodic; break; } case 4: { T = gsl_interp_akima; break; } case 5: { T = gsl_interp_akima_periodic; break; } default: ERROR(BAD_CODE); } gsl_spline *spline = gsl_spline_alloc(T, size); if (NULL == spline) ERROR(MEM); const int initres = gsl_spline_init(spline, xa, ya, size); CHECK(initres,initres); gsl_interp_accel *acc = gsl_interp_accel_alloc(); if (NULL == acc) { gsl_spline_free(spline); ERROR(MEM); }; const int res = gsl_spline_eval_integ_e(spline, a, b, acc, y); CHECK(res,res); gsl_interp_accel_free(acc); gsl_spline_free(spline); OK } int integrate_qng(double f(double, void*), double a, double b, double aprec, double prec, double *result, double*error) { DEBUGMSG("integrate_qng"); gsl_function F; F.function = f; F.params = NULL; size_t neval; int res = gsl_integration_qng (&F, a,b, aprec, prec, result, error, &neval); CHECK(res,res); OK } int integrate_qags(double f(double,void*), double a, double b, double aprec, double prec, int w, double *result, double* error) { DEBUGMSG("integrate_qags"); gsl_integration_workspace * wk = gsl_integration_workspace_alloc (w); gsl_function F; F.function = f; F.params = NULL; int res = gsl_integration_qags (&F, a,b, aprec, prec, w,wk, result, error); CHECK(res,res); gsl_integration_workspace_free (wk); OK } int integrate_qagi(double f(double,void*), double aprec, double prec, int w, double *result, double* error) { DEBUGMSG("integrate_qagi"); gsl_integration_workspace * wk = gsl_integration_workspace_alloc (w); gsl_function F; F.function = f; F.params = NULL; int res = gsl_integration_qagi (&F, aprec, prec, w,wk, result, error); CHECK(res,res); gsl_integration_workspace_free (wk); OK } int integrate_qagiu(double f(double,void*), double a, double aprec, double prec, int w, double *result, double* error) { DEBUGMSG("integrate_qagiu"); gsl_integration_workspace * wk = gsl_integration_workspace_alloc (w); gsl_function F; F.function = f; F.params = NULL; int res = gsl_integration_qagiu (&F, a, aprec, prec, w,wk, result, error); CHECK(res,res); gsl_integration_workspace_free (wk); OK } int integrate_qagil(double f(double,void*), double b, double aprec, double prec, int w, double *result, double* error) { DEBUGMSG("integrate_qagil"); gsl_integration_workspace * wk = gsl_integration_workspace_alloc (w); gsl_function F; F.function = f; F.params = NULL; int res = gsl_integration_qagil (&F, b, aprec, prec, w,wk, result, error); CHECK(res,res); gsl_integration_workspace_free (wk); OK } int integrate_cquad(double f(double,void*), double a, double b, double aprec, double prec, int w, double *result, double* error, int *neval) { DEBUGMSG("integrate_cquad"); gsl_integration_cquad_workspace * wk = gsl_integration_cquad_workspace_alloc (w); gsl_function F; F.function = f; F.params = NULL; size_t * sneval = NULL; int res = gsl_integration_cquad (&F, a, b, aprec, prec, wk, result, error, sneval); *neval = *sneval; CHECK(res,res); gsl_integration_cquad_workspace_free (wk); OK } int polySolve(KRVEC(a), CVEC(z)) { DEBUGMSG("polySolve"); REQUIRES(an>1,BAD_SIZE); gsl_poly_complex_workspace * w = gsl_poly_complex_workspace_alloc (an); int res = gsl_poly_complex_solve ((double*)ap, an, w, (double*)zp); CHECK(res,res); gsl_poly_complex_workspace_free (w); OK; } int vector_fscanf(char*filename, RVEC(a)) { DEBUGMSG("gsl_vector_fscanf"); DVVIEW(a); FILE * f = fopen(filename,"r"); CHECK(!f,BAD_FILE); int res = gsl_vector_fscanf(f,V(a)); CHECK(res,res); fclose (f); OK } int vector_fprintf(char*filename, char*fmt, RVEC(a)) { DEBUGMSG("gsl_vector_fprintf"); DVVIEW(a); FILE * f = fopen(filename,"w"); CHECK(!f,BAD_FILE); int res = gsl_vector_fprintf(f,V(a),fmt); CHECK(res,res); fclose (f); OK } int vector_fread(char*filename, RVEC(a)) { DEBUGMSG("gsl_vector_fread"); DVVIEW(a); FILE * f = fopen(filename,"r"); CHECK(!f,BAD_FILE); int res = gsl_vector_fread(f,V(a)); CHECK(res,res); fclose (f); OK } int vector_fwrite(char*filename, RVEC(a)) { DEBUGMSG("gsl_vector_fwrite"); DVVIEW(a); FILE * f = fopen(filename,"w"); CHECK(!f,BAD_FILE); int res = gsl_vector_fwrite(f,V(a)); CHECK(res,res); fclose (f); OK } int matrix_fprintf(char*filename, char*fmt, int ro, RMAT(m)) { DEBUGMSG("matrix_fprintf"); FILE * f = fopen(filename,"w"); CHECK(!f,BAD_FILE); int i,j,sr,sc; if (ro==1) { sr = mc; sc = 1;} else { sr = 1; sc = mr;} #define AT(M,r,c) (M##p[(r)*sr+(c)*sc]) for (i=0; isize,sizeof(double)); int k; for(k=0;ksize;k++) { p[k] = gsl_vector_get(x,k); } double res = f(x->size,p); free(p); return res; } double only_f_aux_root(double x, void *pars); int uniMinimize(int method, double f(double), double epsrel, int maxit, double min, double xl, double xu, RMAT(sol)) { REQUIRES(solr == maxit && solc == 4,BAD_SIZE); DEBUGMSG("minimize_only_f"); gsl_function my_func; my_func.function = only_f_aux_root; my_func.params = f; size_t iter = 0; int status; const gsl_min_fminimizer_type *T; gsl_min_fminimizer *s; // Starting point switch(method) { case 0 : {T = gsl_min_fminimizer_goldensection; break; } case 1 : {T = gsl_min_fminimizer_brent; break; } case 2 : {T = gsl_min_fminimizer_quad_golden; break; } default: ERROR(BAD_CODE); } s = gsl_min_fminimizer_alloc (T); gsl_min_fminimizer_set (s, &my_func, min, xl, xu); do { double current_min, current_lo, current_hi; status = gsl_min_fminimizer_iterate (s); current_min = gsl_min_fminimizer_x_minimum (s); current_lo = gsl_min_fminimizer_x_lower (s); current_hi = gsl_min_fminimizer_x_upper (s); solp[iter*solc] = iter + 1; solp[iter*solc+1] = current_min; solp[iter*solc+2] = current_lo; solp[iter*solc+3] = current_hi; iter++; if (status) /* check if solver is stuck */ break; status = gsl_min_test_interval (current_lo, current_hi, 0, epsrel); } while (status == GSL_CONTINUE && iter < maxit); int i; for (i=iter; ifval; solp[iter*solc+2] = size; int k; for(k=0;kx,k); } iter++; if (status) break; status = gsl_multimin_test_size (size, tolsize); } while (status == GSL_CONTINUE && iter < maxit); int i,j; for (i=iter; isize,sizeof(double)); int k; for(k=0;ksize;k++) { p[k] = gsl_vector_get(x,k); } double res = fdf->f(x->size,p); free(p); return res; } void df_aux_min(const gsl_vector * x, void * pars, gsl_vector * g) { Tfdf * fdf = ((Tfdf*) pars); double* p = (double*)calloc(x->size,sizeof(double)); double* q = (double*)calloc(g->size,sizeof(double)); int k; for(k=0;ksize;k++) { p[k] = gsl_vector_get(x,k); } fdf->df(x->size,p,g->size,q); for(k=0;ksize;k++) { gsl_vector_set(g,k,q[k]); } free(p); free(q); } void fdf_aux_min(const gsl_vector * x, void * pars, double * f, gsl_vector * g) { *f = f_aux_min(x,pars); df_aux_min(x,pars,g); } int minimizeD(int method, double f(int, double*), int df(int, double*, int, double*), double initstep, double minimpar, double tolgrad, int maxit, KRVEC(xi), RMAT(sol)) { REQUIRES(solr == maxit && solc == 2+xin,BAD_SIZE); DEBUGMSG("minimizeWithDeriv (conjugate_fr)"); gsl_multimin_function_fdf my_func; // extract function from pars my_func.f = f_aux_min; my_func.df = df_aux_min; my_func.fdf = fdf_aux_min; my_func.n = xin; Tfdf stfdf; stfdf.f = f; stfdf.df = df; my_func.params = &stfdf; size_t iter = 0; int status; const gsl_multimin_fdfminimizer_type *T; gsl_multimin_fdfminimizer *s = NULL; // Starting point KDVVIEW(xi); // conjugate gradient fr switch(method) { case 0 : {T = gsl_multimin_fdfminimizer_conjugate_fr; break; } case 1 : {T = gsl_multimin_fdfminimizer_conjugate_pr; break; } case 2 : {T = gsl_multimin_fdfminimizer_vector_bfgs; break; } case 3 : {T = gsl_multimin_fdfminimizer_vector_bfgs2; break; } case 4 : {T = gsl_multimin_fdfminimizer_steepest_descent; break; } default: ERROR(BAD_CODE); } s = gsl_multimin_fdfminimizer_alloc (T, my_func.n); gsl_multimin_fdfminimizer_set (s, &my_func, V(xi), initstep, minimpar); do { status = gsl_multimin_fdfminimizer_iterate (s); solp[iter*solc+0] = iter+1; solp[iter*solc+1] = s->f; int k; for(k=0;kx,k); } iter++; if (status) break; status = gsl_multimin_test_gradient (s->gradient, tolgrad); } while (status == GSL_CONTINUE && iter < maxit); int i,j; for (i=iter; if)(x); } double jf_aux_uni(double x, void * pars) { uniTfjf * fjf = ((uniTfjf*) pars); return (fjf->jf)(x); } void fjf_aux_uni(double x, void * pars, double * f, double * g) { *f = f_aux_uni(x,pars); *g = jf_aux_uni(x,pars); } int rootj(int method, double f(double), double df(double), double epsrel, int maxit, double x, RMAT(sol)) { REQUIRES(solr == maxit && solc == 2,BAD_SIZE); DEBUGMSG("root_fjf"); gsl_function_fdf my_func; // extract function from pars my_func.f = f_aux_uni; my_func.df = jf_aux_uni; my_func.fdf = fjf_aux_uni; uniTfjf stfjf; stfjf.f = f; stfjf.jf = df; my_func.params = &stfjf; size_t iter = 0; int status; const gsl_root_fdfsolver_type *T; gsl_root_fdfsolver *s; // Starting point switch(method) { case 0 : {T = gsl_root_fdfsolver_newton;; break; } case 1 : {T = gsl_root_fdfsolver_secant; break; } case 2 : {T = gsl_root_fdfsolver_steffenson; break; } default: ERROR(BAD_CODE); } s = gsl_root_fdfsolver_alloc (T); gsl_root_fdfsolver_set (s, &my_func, x); do { double x0; status = gsl_root_fdfsolver_iterate (s); x0 = x; x = gsl_root_fdfsolver_root(s); solp[iter*solc+0] = iter+1; solp[iter*solc+1] = x; iter++; if (status) /* check if solver is stuck */ break; status = gsl_root_test_delta (x, x0, 0, epsrel); } while (status == GSL_CONTINUE && iter < maxit); int i; for (i=iter; isize,sizeof(double)); double* q = (double*)calloc(y->size,sizeof(double)); int k; for(k=0;ksize;k++) { p[k] = gsl_vector_get(x,k); } f(x->size,p,y->size,q); for(k=0;ksize;k++) { gsl_vector_set(y,k,q[k]); } free(p); free(q); return 0; //hmmm } int multiroot(int method, void f(int, double*, int, double*), double epsabs, int maxit, KRVEC(xi), RMAT(sol)) { REQUIRES(solr == maxit && solc == 1+2*xin,BAD_SIZE); DEBUGMSG("root_only_f"); gsl_multiroot_function my_func; // extract function from pars my_func.f = only_f_aux_multiroot; my_func.n = xin; my_func.params = f; size_t iter = 0; int status; const gsl_multiroot_fsolver_type *T; gsl_multiroot_fsolver *s; // Starting point KDVVIEW(xi); switch(method) { case 0 : {T = gsl_multiroot_fsolver_hybrids;; break; } case 1 : {T = gsl_multiroot_fsolver_hybrid; break; } case 2 : {T = gsl_multiroot_fsolver_dnewton; break; } case 3 : {T = gsl_multiroot_fsolver_broyden; break; } default: ERROR(BAD_CODE); } s = gsl_multiroot_fsolver_alloc (T, my_func.n); gsl_multiroot_fsolver_set (s, &my_func, V(xi)); do { status = gsl_multiroot_fsolver_iterate (s); solp[iter*solc+0] = iter+1; int k; for(k=0;kx,k); } for(k=xin;k<2*xin;k++) { solp[iter*solc+k+1] = gsl_vector_get(s->f,k-xin); } iter++; if (status) /* check if solver is stuck */ break; status = gsl_multiroot_test_residual (s->f, epsabs); } while (status == GSL_CONTINUE && iter < maxit); int i,j; for (i=iter; isize,sizeof(double)); double* q = (double*)calloc(y->size,sizeof(double)); int k; for(k=0;ksize;k++) { p[k] = gsl_vector_get(x,k); } (fjf->f)(x->size,p,y->size,q); for(k=0;ksize;k++) { gsl_vector_set(y,k,q[k]); } free(p); free(q); return 0; } int jf_aux(const gsl_vector * x, void * pars, gsl_matrix * jac) { Tfjf * fjf = ((Tfjf*) pars); double* p = (double*)calloc(x->size,sizeof(double)); double* q = (double*)calloc((jac->size1)*(jac->size2),sizeof(double)); int i,j,k; for(k=0;ksize;k++) { p[k] = gsl_vector_get(x,k); } (fjf->jf)(x->size,p,jac->size1,jac->size2,q); k=0; for(i=0;isize1;i++) { for(j=0;jsize2;j++){ gsl_matrix_set(jac,i,j,q[k++]); } } free(p); free(q); return 0; } int fjf_aux(const gsl_vector * x, void * pars, gsl_vector * f, gsl_matrix * g) { f_aux(x,pars,f); jf_aux(x,pars,g); return 0; } int multirootj(int method, int f(int, double*, int, double*), int jac(int, double*, int, int, double*), double epsabs, int maxit, KRVEC(xi), RMAT(sol)) { REQUIRES(solr == maxit && solc == 1+2*xin,BAD_SIZE); DEBUGMSG("root_fjf"); gsl_multiroot_function_fdf my_func; // extract function from pars my_func.f = f_aux; my_func.df = jf_aux; my_func.fdf = fjf_aux; my_func.n = xin; Tfjf stfjf; stfjf.f = f; stfjf.jf = jac; my_func.params = &stfjf; size_t iter = 0; int status; const gsl_multiroot_fdfsolver_type *T; gsl_multiroot_fdfsolver *s; // Starting point KDVVIEW(xi); switch(method) { case 0 : {T = gsl_multiroot_fdfsolver_hybridsj;; break; } case 1 : {T = gsl_multiroot_fdfsolver_hybridj; break; } case 2 : {T = gsl_multiroot_fdfsolver_newton; break; } case 3 : {T = gsl_multiroot_fdfsolver_gnewton; break; } default: ERROR(BAD_CODE); } s = gsl_multiroot_fdfsolver_alloc (T, my_func.n); gsl_multiroot_fdfsolver_set (s, &my_func, V(xi)); do { status = gsl_multiroot_fdfsolver_iterate (s); solp[iter*solc+0] = iter+1; int k; for(k=0;kx,k); } for(k=xin;k<2*xin;k++) { solp[iter*solc+k+1] = gsl_vector_get(s->f,k-xin); } iter++; if (status) /* check if solver is stuck */ break; status = gsl_multiroot_test_residual (s->f, epsabs); } while (status == GSL_CONTINUE && iter < maxit); int i,j; for (i=iter; if); int k; for(k=0;kx,k); } iter++; if (status) /* check if solver is stuck */ break; status = gsl_multifit_test_delta (s->dx, s->x, epsabs, epsrel); } while (status == GSL_CONTINUE && iter < maxit); int i,j; for (i=iter; iJ, 0.0, M(cov)); gsl_multifit_fdfsolver_free (s); OK } ////////////////////////////////////////////////////// #define RAN(C,F) case C: { for(k=0;k Vector Double -> (Matrix Double , Matrix Double) meshdom r1 r2 = (outer r1 (konst 1 (size r2)), outer (konst 1 (size r1)) r2) {- | Draws a 3D surface representation of a real matrix. > > mesh $ build (10,10) (\\i j -> i + (j-5)^2) In certain versions you can interactively rotate the graphic using the mouse. -} mesh :: Matrix Double -> IO () mesh m = gnuplotX (command++dat) where command = "splot "++datafollows++" matrix with lines\n" dat = prep $ toLists m {- | Draws the surface represented by the function f in the desired ranges and number of points, internally using 'mesh'. > > let f x y = cos (x + y) > > splot f (0,pi) (0,2*pi) 50 -} splot :: (Matrix Double->Matrix Double->Matrix Double) -> (Double,Double) -> (Double,Double) -> Int -> IO () splot f rx ry n = mesh z where (x,y) = meshdom (linspace n rx) (linspace n ry) z = f x y {- | plots several vectors against the first one > > let t = linspace 100 (-3,3) in mplot [t, sin t, exp (-t^2)] -} mplot :: [Vector Double] -> IO () mplot m = gnuplotX (commands++dats) where commands = if length m == 1 then command1 else commandmore command1 = "plot "++datafollows++" with lines\n" ++ dat commandmore = "plot " ++ plots ++ "\n" plots = concat $ intersperse ", " (map cmd [2 .. length m]) cmd k = datafollows++" using 1:"++show k++" with lines" dat = prep $ toLists $ fromColumns m dats = concat (replicate (length m-1) dat) {- | Draws a list of functions over a desired range and with a desired number of points > > plot [sin, cos, sin.(3*)] (0,2*pi) 1000 -} plot :: [Vector Double->Vector Double] -> (Double,Double) -> Int -> IO () plot fs rx n = mplot (x: mapf fs x) where x = linspace n rx mapf gs y = map ($ y) gs {- | Draws a parametric curve. For instance, to draw a spiral we can do something like: > > parametricPlot (\t->(t * sin t, t * cos t)) (0,10*pi) 1000 -} parametricPlot :: (Vector Double->(Vector Double,Vector Double)) -> (Double, Double) -> Int -> IO () parametricPlot f rt n = mplot [fx, fy] where t = linspace n rt (fx,fy) = f t -- | writes a matrix to pgm image file matrixToPGM :: Matrix Double -> String matrixToPGM m = header ++ unlines (map unwords ll) where c = cols m r = rows m header = "P2 "++show c++" "++show r++" "++show (round maxgray :: Int)++"\n" maxgray = 255.0 maxval = maxElement m minval = minElement m scale' = if maxval == minval then 0.0 else maxgray / (maxval - minval) f x = show ( round ( scale' *(x - minval) ) :: Int ) ll = map (map f) (toLists m) -- | imshow shows a representation of a matrix as a gray level image using ImageMagick's display. imshow :: Matrix Double -> IO () imshow m = do _ <- system $ "echo \""++ matrixToPGM m ++"\"| display -antialias -resize 300 - &" return () ---------------------------------------------------- gnuplotX :: String -> IO () gnuplotX command = do { _ <- system cmdstr; return()} where cmdstr = "echo \""++command++"\" | gnuplot -persist" datafollows = "\\\"-\\\"" prep = (++"e\n\n") . unlines . map (unwords . map show) gnuplotpdf :: String -> String -> [([[Double]], String)] -> IO () gnuplotpdf title command ds = gnuplot (prelude ++ command ++" "++ draw) >> postproc where prelude = "set terminal epslatex color; set output '"++title++".tex';" (dats,defs) = unzip ds draw = concat (intersperse ", " (map ("\"-\" "++) defs)) ++ "\n" ++ concatMap pr dats postproc = do _ <- system $ "epstopdf "++title++".eps" mklatex _ <- system $ "pdflatex "++title++"aux.tex > /dev/null" _ <- system $ "pdfcrop "++title++"aux.pdf > /dev/null" _ <- system $ "mv "++title++"aux-crop.pdf "++title++".pdf" _ <- system $ "rm "++title++"aux.* "++title++".eps "++title++".tex" return () mklatex = writeFile (title++"aux.tex") $ "\\documentclass{article}\n"++ "\\usepackage{graphics}\n"++ "\\usepackage{nopageno}\n"++ "\\usepackage{txfonts}\n"++ "\\renewcommand{\\familydefault}{phv}\n"++ "\\usepackage[usenames]{color}\n"++ "\\begin{document}\n"++ "\\begin{center}\n"++ " \\input{./"++title++".tex}\n"++ "\\end{center}\n"++ "\\end{document}" pr = (++"e\n") . unlines . map (unwords . map show) gnuplot cmd = do writeFile "gnuplotcommand" cmd _ <- system "gnuplot gnuplotcommand" _ <- system "rm gnuplotcommand" return () gnuplotWin :: String -> String -> [([[Double]], String)] -> IO () gnuplotWin title command ds = gnuplot (prelude ++ command ++" "++ draw) where (dats,defs) = unzip ds draw = concat (intersperse ", " (map ("\"-\" "++) defs)) ++ "\n" ++ concatMap pr dats pr = (++"e\n") . unlines . map (unwords . map show) prelude = "set title \""++title++"\";" gnuplot cmd = do writeFile "gnuplotcommand" cmd _ <- system "gnuplot -persist gnuplotcommand" _ <- system "rm gnuplotcommand" return ()