dynamic-plot (empty) → 0.1.0.0
raw patch · 8 files changed
+2223/−0 lines, 8 filesdep +MemoTriedep +MonadRandomdep +asyncsetup-changedbinary-added
Dependencies added: MemoTrie, MonadRandom, async, base, colour, constrained-categories, containers, deepseq, diagrams-cairo, diagrams-core, diagrams-gtk, diagrams-lib, glib, gtk, lens, manifolds, mtl, process, random, semigroups, time, transformers, vector, vector-space
Files
- COPYING +674/−0
- Data/LinearMap/HerMetric.hs +86/−0
- Graphics/Dynamic/Plot/Colour.hs +84/−0
- Graphics/Dynamic/Plot/R2.hs +1297/−0
- Setup.hs +6/−0
- dynamic-plot.cabal +76/−0
- images/examples/cos-encircle-points-far.png binary
- images/examples/cos-encircle-points.png binary
+ COPYING view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ 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.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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 <http://www.gnu.org/licenses/>.++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:++ <program> Copyright (C) <year> <name of author>+ 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+<http://www.gnu.org/licenses/>.++ 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+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Data/LinearMap/HerMetric.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ConstraintKinds #-}+++++module Data.LinearMap.HerMetric (+ HasMetric(..)+ , (^<.>)+ , HerMetric+ , projector+ , metricSq, metric, metrics+ , metriScale+ ) where+ ++ ++import Data.VectorSpace+import Data.LinearMap+import Data.Basis+import Data.MemoTrie++ +import Diagrams.Prelude+++infixr 7 <.>^, ^<.>++class ( HasBasis v, RealFloat (Scalar v), HasTrie (Basis v)+ , VectorSpace (DualSpace v), HasBasis (DualSpace v)+ , Scalar v ~ Scalar (DualSpace v), Basis v ~ Basis (DualSpace v) )+ => HasMetric v where+ type DualSpace v :: *+ type DualSpace v = v+ (<.>^) :: DualSpace v -> v -> Scalar v+ ++(^<.>) :: HasMetric v => v -> DualSpace v -> Scalar v+ket ^<.> bra = bra <.>^ ket++instance HasMetric Double where+ (<.>^) = (<.>)+instance (HasMetric v, HasMetric w, Scalar v ~ Scalar w) => HasMetric (v,w) where+ type DualSpace (v,w) = (DualSpace v, DualSpace w)+ (v,w)<.>^(v',w') = v<.>^v' + w<.>^w'+instance HasMetric R2 where+ (<.>^) = (<.>)+++-- | 'HerMetric' is a portmanteau of /Hermitian/ and /metric/ (in the sense as used+-- in e.g. general relativity).+newtype HerMetric v = HerMetric { getHerMetric :: DualSpace v :-* v }++instance HasMetric v => AdditiveGroup (HerMetric v) where+ zeroV = HerMetric zeroV+ negateV (HerMetric m) = HerMetric $ negateV m+ HerMetric m ^+^ HerMetric n = HerMetric $ m ^+^ n+instance HasMetric v => VectorSpace (HerMetric v) where+ type Scalar (HerMetric v) = Scalar v+ s *^ (HerMetric m) = HerMetric $ s *^ m ++projector :: HasMetric v => v -> HerMetric v+projector v = HerMetric (linear $ \u -> v ^* (v^<.>u))+++metricSq, metric :: HasMetric v => HerMetric v -> DualSpace v -> Scalar v+metricSq (HerMetric m) v = v <.>^ lapply m v+metric (HerMetric m) v = sqrt $ v <.>^ lapply m v+++metriScale :: HasMetric v => HerMetric v -> DualSpace v -> DualSpace v+metriScale m v = metric m v *^ v+++metrics :: HasMetric v => HerMetric v -> [DualSpace v] -> Scalar v+metrics m vs = sqrt . sum $ metricSq m <$> vs++++
+ Graphics/Dynamic/Plot/Colour.hs view
@@ -0,0 +1,84 @@+-- |+-- Module : Graphics.Dynamic.Plot.Colour +-- Copyright : (c) Justus Sagemüller 2013+-- License : GPL v3+-- +-- Maintainer : (@) sagemuej $ smail.uni-koeln.de+-- Stability : experimental+-- Portability : requires GHC>6 extensions++module Graphics.Dynamic.Plot.Colour where+++import qualified Data.Colour as DCol+import Data.Colour (opaque)+import qualified Data.Colour.Names as N+import Data.Colour.CIE hiding (Colour)+import qualified Data.Colour.CIE.Illuminant as Illum+++type FColour = DCol.Colour Double+type AColour = DCol.AlphaColour Double++-- | Unlike the typical types such as 'Draw.Color', this one has /semantic/ +-- more than physical meaning.+data Colour = BaseColour BaseColour+ | Contrast BaseColour+ | Paler Colour+ | CustomColour FColour+ deriving (Eq)+data BaseColour = Neutral -- ^ Either black or white, depending on the context.+ | Red -- ^ Contrast cyan.+ | Yellow -- ^ Contrast violet.+ | Green -- ^ Contrast magenta.+ | Blue -- ^ Contrast orange.+ deriving (Eq, Show, Enum)+++neutral, contrast, grey+ , magenta, red, orange, yellow, green, cyan, blue, violet :: Colour+neutral = BaseColour Neutral+contrast= Contrast Neutral+grey = paler contrast+magenta = Contrast Green+red = BaseColour Red+orange = Contrast Blue+yellow = BaseColour Yellow+green = BaseColour Green+cyan = Contrast Red+blue = BaseColour Blue+violet = Contrast Yellow++paler, opposite :: Colour -> Colour+paler = Paler+opposite (BaseColour c) = Contrast c+opposite (Contrast c) = BaseColour c+opposite (Paler c) = Paler $ opposite c+opposite (CustomColour c) = CustomColour $ hueInvert c++type ColourScheme = Colour -> AColour++defaultColourScheme :: ColourScheme+defaultColourScheme (BaseColour Neutral) = opaque N.black+defaultColourScheme (BaseColour Red ) = opaque N.red+defaultColourScheme (BaseColour Yellow ) = opaque N.yellow+defaultColourScheme (BaseColour Green ) = opaque N.green+defaultColourScheme (BaseColour Blue ) = opaque N.blue+defaultColourScheme (Contrast Neutral) = opaque N.white+defaultColourScheme (Contrast Red ) = opaque N.cyan+defaultColourScheme (Contrast Yellow ) = opaque N.violet+defaultColourScheme (Contrast Green ) = opaque N.magenta+defaultColourScheme (Contrast Blue ) = opaque N.orange+defaultColourScheme (Paler c) = DCol.dissolve 0.5 $ defaultColourScheme c+defaultColourScheme (CustomColour c) = opaque c+++defaultColourSeq :: [Colour] +defaultColourSeq = cycle [blue, red, green, orange, cyan, magenta, yellow, violet]++++hueInvert :: FColour -> FColour+hueInvert c = let (l,a,b) = cieLABView i c+ in cieLAB i l (1-a) (1-b)+ where i = Illum.a
+ Graphics/Dynamic/Plot/R2.hs view
@@ -0,0 +1,1297 @@+-- |+-- Module : Graphics.Dynamic.Plot.R2+-- Copyright : (c) Justus Sagemüller 2013-2014+-- License : GPL v3+-- +-- Maintainer : (@) sagemueller $ geo.uni-koeln.de+-- Stability : experimental+-- Portability : requires GHC>6 extensions+++{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE StandaloneDeriving #-}++module Graphics.Dynamic.Plot.R2 (+ -- * Interactive display+ plotWindow+ -- * Plottable objects+ -- ** Class + , Plottable(..)+ -- ** Simple function plots + , fnPlot, paramPlot+ , continFnPlot+ , tracePlot+ -- ** View selection+ , xInterval, yInterval+ -- ** Plot type+ , DynamicPlottable+ ) where++import Graphics.Dynamic.Plot.Colour++++import qualified Prelude++-- import Graphics.DrawingCombinators ((%%), R, R2)+-- import qualified Graphics.DrawingCombinators as Draw+-- import qualified Graphics.UI.GLFW as GLFW+-- import qualified Graphics.Rendering.OpenGL as OpenGL+-- import Graphics.Rendering.OpenGL (($=))+import Diagrams.Prelude (R2, P2, (^&), (&), _x, _y)+import qualified Diagrams.Prelude as Dia+import qualified Diagrams.TwoD.Size as Dia+import qualified Diagrams.TwoD.Types as DiaTypes+import Diagrams.BoundingBox (BoundingBox)+import qualified Diagrams.BoundingBox as DiaBB+import qualified Diagrams.Backend.Cairo as Cairo+import qualified Diagrams.Backend.Cairo.Text as CairoTxt+ +import qualified Data.Colour as DCol++import qualified Diagrams.Backend.Gtk as BGTK+import qualified Graphics.UI.Gtk as GTK+import Graphics.UI.Gtk ( AttrOp((:=)) )+import qualified Graphics.UI.Gtk.Gdk.EventM as Event+import qualified System.Glib.Signals (on)++import Control.Monad.Trans (liftIO)++import qualified Control.Category.Hask as Hask+import Control.Category.Constrained.Prelude hiding ((^))+import Control.Arrow.Constrained+import Control.Monad.Constrained++import Control.Lens hiding ((...))++ +import Control.Concurrent.Async+import Control.DeepSeq+++import Data.List (foldl', sort, intercalate, isPrefixOf, isInfixOf, find, zip4)+import qualified Data.Vector as Arr+import Data.Maybe+import Data.Semigroup+import Data.Foldable (fold, foldMap)+import Data.Function (on)++import Data.VectorSpace+import Data.AffineSpace+import Data.LinearMap.HerMetric+import qualified Data.Map.Lazy as Map++import Data.Manifold ((:-->))+import qualified Data.Manifold as 𝓒⁰+ +import Text.Printf++import Data.IORef++import System.IO+import System.Exit+import System.Process+import Data.Time++++(^) :: Num n => n -> Int -> n+(^) = (Prelude.^)+++type R = Double++type Diagram = Dia.Diagram Cairo.B R2+++++class Plottable p where+ plot :: p -> DynamicPlottable++instance (RealFloat r₁, RealFloat r₂) => Plottable (r₁ -> r₂) where+ plot f = continFnPlot $ realToFrac . f . realToFrac++-- {-# RULES "plot/R->R" plot = fnPlot #-}++instance Plottable (Double :--> Double) where+ plot f = DynamicPlottable{+ relevantRange_x = const mempty+ , relevantRange_y = fmap yRangef+ , isTintableMonochromic = True+ , axesNecessity = 1+ , dynamicPlot = plot }+ where yRangef (Interval l r) = uncurry Interval . (minimum &&& maximum) + . map snd $ 𝓒⁰.finiteGraphContinℝtoℝ+ (𝓒⁰.GraphWindowSpec l r fgb fgt 9 9) f+ where (fgb, fgt) = (minimum &&& maximum) [f $ l, f $ m, f $ r]+ m = l + (r-l) * 0.352479608143+ + plot (GraphWindowSpec{..}) = curve `deepseq` Plot [] (trace curve)+ where curve :: [Dia.P2]+ curve = map convℝ² $ 𝓒⁰.finiteGraphContinℝtoℝ mWindow f+ mWindow = 𝓒⁰.GraphWindowSpec (c lBound) (c rBound) (c bBound) (c tBound) + xResolution yResolution+ trace (p:q:ps) = simpleLine p q <> trace (q:ps)+ trace _ = mempty+ + convℝ² = Dia.p2+ c = realToFrac++instance Plottable (Double :--> (Double, Double)) where+ plot f = DynamicPlottable{+ relevantRange_x = const mempty+ , relevantRange_y = const mempty+ , isTintableMonochromic = True+ , axesNecessity = 1+ , dynamicPlot = plot }+ where plot (GraphWindowSpec{..}) = curves `deepseq` Plot [] (foldMap trace curves)+ where curves :: [[Dia.P2]]+ curves = map (map convℝ²) $ 𝓒⁰.finiteGraphContinℝtoℝ² mWindow f+ mWindow = 𝓒⁰.GraphWindowSpec (c lBound) (c rBound) (c bBound) (c tBound) + xResolution yResolution+ trace (p:q:ps) = simpleLine p q <> trace (q:ps)+ trace _ = mempty+ + convℝ² = Dia.p2+ c = realToFrac+++instance (Plottable p) => Plottable [p] where+ plot l0 = DynamicPlottable{+ relevantRange_x = \ry -> foldMap (($ry) . relevantRange_x) l+ , relevantRange_y = \rx -> foldMap (($rx) . relevantRange_y) l+ , isTintableMonochromic = or $ isTintableMonochromic <$> l+ , axesNecessity = sum $ axesNecessity <$> l+ , dynamicPlot = foldMap dynamicPlot l+ }+ where l = map plot l0++instance Plottable Diagram where+ plot d = DynamicPlottable{+ relevantRange_x = const $ Option rlx+ , relevantRange_y = const $ Option rly+ , isTintableMonochromic = False+ , axesNecessity = -1+ , dynamicPlot = plot+ }+ where bb = DiaBB.boundingBox d+ (rlx,rly) = case DiaBB.getCorners bb of+ Just (c1, c2)+ -> ( Just $ c1^._x ... c2^._x+ , Just $ c1^._y ... c2^._y )+ plot _ = Plot [] d++++ ++data Pair p = Pair !p !p+ deriving (Hask.Functor, Show, Eq, Ord)+data Triple p = Triple !p !p !p+ deriving (Hask.Functor, Show, Eq, Ord)++data DiffList a = DiffList { getDiffList :: [a]->[a], diffListLen :: Int }+diffList :: Arr.Vector a -> DiffList a+diffList l = DiffList (Arr.toList l++) (Arr.length l)++instance Semigroup (DiffList a) where+ DiffList dl n <> DiffList dl' n' = DiffList (dl . dl') (n+n')+instance Monoid (DiffList a) where+ mappend = (<>); mempty = DiffList id 0+++newtype SplitList a = SplitList { getSplList :: Arr.Vector a }+ deriving (Hask.Functor, Monoid)+presplitList :: [a] -> SplitList a+presplitList = SplitList . Arr.fromList++splitEvenly :: Int -> SplitList a -> Either (Arr.Vector a) [SplitList a]+splitEvenly k _ | k < 1 = error "Can't split a list to less than one part."+splitEvenly k (SplitList v)+ | k >= n = Left v+ | otherwise = Right $ splits splitIs 0+ where splitIs = take k . map round . tail+ $ iterate (+ (fromIntegral n/fromIntegral k :: Double)) 0+ splits [_] i₀ = [SplitList $ Arr.drop i₀ v]+ splits (i:is) i₀ = SplitList (Arr.slice i₀ (i-i₀) v) : splits is i+ n = Arr.length v++instance Semigroup (SplitList a) where+ SplitList l <> SplitList l' = SplitList (l Arr.++ l')++fromDiffList :: DiffList a -> SplitList a+fromDiffList (DiffList f _) = SplitList . Arr.fromList $ f[]+++++data LinFitParams y = LinFitParams { constCoeff :: y+ , linCoeff :: Diff y }+deriving instance (AffineSpace y, Show y, Show (Diff y)) => Show (LinFitParams y)+++linFitMeanInCtrdUnitIntv ::+ (AffineSpace y, v~Diff y, VectorSpace v, Fractional (Scalar v))+ => LinFitParams y -> y+linFitMeanInCtrdUnitIntv (LinFitParams{..}) = constCoeff++++data DevBoxes y = DevBoxes { deviations :: HerMetric (Diff y)+ , maxDeviation :: Scalar (Diff y) }+ +++++data PCMRange x = PCMRange { pcmStart, pcmSampleDuration :: x } deriving (Show)+ +data RecursiveSamples' n x y t+ = RecursivePCM { rPCMlinFit :: LinFitParams y+ , details :: Either (Pair (RecursiveSamples' n x y t))+ (Arr.Vector (y,t))+ , pFitDeviations :: DevBoxes y+ , samplingSpec :: PCMRange x+ , splIdLen :: Int+ , rPCMNodeInfo :: n+ }+instance Hask.Functor (RecursiveSamples' n x y) where+ fmap f (RecursivePCM l d v s n i) = RecursivePCM l d' v s n i+ where d' = case d of Left rs' -> Left (fmap (fmap f) rs')+ Right ps -> Right $ fmap (second f) ps++fmapRPCMNodeInfo :: (n->n') -> RecursivePCM n x y -> RecursivePCM n' x y+fmapRPCMNodeInfo f (RecursivePCM l d v s n i) = RecursivePCM l d' v s n $ f i+ where d' = case d of Left rs' -> Left (fmap (fmapRPCMNodeInfo f) rs')+ Right ps -> Right ps++type RecursiveSamples = RecursiveSamples' ()+type RecursivePCM n x y = RecursiveSamples' n x y ()+type (x-.^>y) = RecursivePCM () x y++recursiveSamples' :: forall x y v t .+ ( VectorSpace x, Real (Scalar x)+ , AffineSpace y, v~Diff y, InnerSpace v, HasMetric v, RealFloat (Scalar v) )+ => PCMRange x -> [(y,t)] -> RecursiveSamples x y t+recursiveSamples' xrng_g ys = calcDeviations . go xrng_g $ presplitList ys+ where go :: PCMRange x -> SplitList (y,t) -> RecursiveSamples' (Arr.Vector y) x y t+ go xrng@(PCMRange xl wsp) l@(SplitList arr) = case splitEvenly 2 l of+ Right sps+ | [sp1, sp2] <- lIndThru xl sps+ -> let pFit = solveToLinFit+ $ (linFitMeanInCtrdUnitIntv.rPCMlinFit) <$> [sp1,sp2]+ in RecursivePCM pFit+ (Left $ Pair sp1 sp2)+ (undefined)+ xrng (Arr.length arr)+ (fmap fst arr)+ Right _ -> evenSplitErr+ Left pSpls -> RecursivePCM (solveToLinFit $ Arr.toList (fmap fst pSpls))+ (Right $ pSpls)+ (undefined)+ xrng (Arr.length arr)+ (fmap fst arr)+ where lIndThru _ [] = []+ lIndThru x₀₁ (sp₁@(SplitList arr₁):sps)+ = let x₀₂ = x₀₁ ^+^ fromIntegral (Arr.length arr₁) *^ wsp+ in go (PCMRange x₀₁ wsp) sp₁ : lIndThru x₀₂ sps + evenSplitErr = error "'splitEvenly' returned wrong number of slices."+ + calcDeviations :: RecursiveSamples' (Arr.Vector y) x y t+ -> RecursiveSamples x y t+ calcDeviations = cdvs Nothing Nothing+ where cdvs lPFits rPFits+ rPCM@( RecursivePCM pFit dtls _ sSpc@(PCMRange xl wsp) slLn pts )+ = RecursivePCM pFit dtls' (DevBoxes stdDev maxDev) sSpc slLn ()+ where stdDev = (^/ fromIntegral slLn) . sumV $ projector <$> msqs+ maxDev = sqrt . maximum $ magnitudeSq <$> msqs+ msqs = [ (y .-. ff x)+ | (x,y) <- normlsdIdd $ SplitList pts ]+ ff = l₀splineRep (Pair lPFits rPFits) rPCM+ dtls' = case dtls of+ Left (Pair r₁ r₂)+ -> let r₁' = cdvs (rRoute=<<lPFits) (Just r₂) r₁+ r₂' = cdvs (Just r₁) (lRoute=<<rPFits) r₂+ in Left $ Pair r₁' r₂'+ Right pSpls -> Right pSpls+ (LinFitParams b a) = pFit+lRoute, rRoute :: RecursiveSamples' n x y t -> Maybe (RecursiveSamples' n x y t)+lRoute (RecursivePCM {details = Right _}) = Nothing+lRoute (RecursivePCM {details = Left (Pair l _)}) = Just l+rRoute (RecursivePCM {details = Right _}) = Nothing+rRoute (RecursivePCM {details = Left (Pair _ r)}) = Just r+ ++recursiveSamples :: + ( AffineSpace y, v~Diff y, InnerSpace v, HasMetric v, RealFloat (Scalar v) )+ => [(y,t)] -> RecursiveSamples Int y t+recursiveSamples = recursiveSamples' (PCMRange 0 1)++recursivePCM :: ( VectorSpace x, Real (Scalar x)+ , AffineSpace y, v~Diff y, InnerSpace v, HasMetric v, RealFloat (Scalar v) )+ => PCMRange x -> [y] -> x-.^>y+recursivePCM xrng_g = recursiveSamples' xrng_g . fmap (,())+++splineRep :: ( AffineSpace y, v~Diff y, InnerSpace v, Floating (Scalar v), Ord (Scalar v) )+ => Int -- ^ Number of subdivisions to \"go down\".+ -> (R-.^>y) -> R -> y+splineRep n₀ rPCM@(RecursivePCM _ _ _ (PCMRange xl wsp) slLn ())+ = go n₀ Nothing Nothing rPCM . normaliseR+ where go n lPFits rPFits (RecursivePCM _ (Left (Pair r₁ r₂)) _ _ slLn ())+ | n>0, f₁ <- go (n-1) (rRoute=<<lPFits) (Just r₂) r₁+ , f₂ <- go (n-1) (Just r₁) (lRoute=<<rPFits) r₂+ = \x -> if x<0.5 then f₁ $ x*2+ else f₂ $ x*2 - 1+ go _ lPFits rPFits rPCM = l₀splineRep (Pair lPFits rPFits) rPCM+ + normaliseR x = (x - xl)/(wsp * fromIntegral slLn)++l₀splineRep ::+ ( VectorSpace x, Num (Scalar x)+ , AffineSpace y, v~Diff y, VectorSpace v, Floating (Scalar v), Ord (Scalar v) )+ => Pair (Maybe (RecursiveSamples' n x y t'))+ -> (RecursiveSamples' n x y t)+ -> R{-Sample position normalised to [0,1]-} -> y+l₀splineRep (Pair lPFits rPFits)+ (RecursivePCM{ rPCMlinFit=LinFitParams b a+ , samplingSpec=PCMRange x₀ wsp+ , splIdLen = n })+ = f+ where f x | x < 0.5, t <- realToFrac $ 0.5 - x+ , Just(RecursivePCM{rPCMlinFit=LinFitParams b'l a'l}) <- lPFits+ = b .+^ (b'l.-.b) ^* h₀₁ t+ .-^ a ^* h₁₀ t+ .-^ a'l ^* h₁₁ t+ | x > 0.5, t <- realToFrac $ x - 0.5+ , Just(RecursivePCM{rPCMlinFit=LinFitParams b'r a'r}) <- rPFits+ = b .+^ (b'r.-.b) ^* h₀₁ t+ .+^ a ^* h₁₀ t+ .+^ a'r ^* h₁₁ t+ | t <- realToFrac $ x-0.5+ = b .+^ t*^a+ h₀₀ t = (1 + 2*t) * (1 - t)^2 -- Cubic Hermite splines+ h₀₁ t = t^2 * (3 - 2*t)+ h₁₀ t = t * (1 - t)^2+ h₁₁ t = t^2 * (t - 1)++++rPCMSample :: (AffineSpace y, v~Diff y, InnerSpace v, HasMetric v, RealFloat (Scalar v))+ => Interval R -> R -> (R->y) -> R-.^>y+rPCMSample (Interval l r) δx f = recursivePCM (PCMRange l δx) [f x | x<-[l, l+δx .. r]] + ++instance Plottable (R-.^>R) where+ plot rPCM@(RecursivePCM gPFit gDetails gFitDevs (PCMRange x₀ wsp) gSplN ())+ = DynamicPlottable{+ relevantRange_x = const . pure $ Interval x₀ xr+ , relevantRange_y = fmap $ rPCMLinFitRange rPCM+ , isTintableMonochromic = True+ , axesNecessity = 1+ , dynamicPlot = plot+ }+ where + xr = wsp * fromIntegral gSplN+ plot (GraphWindowSpec{..}) = Plot [] . trace $ flattenPCM_resoCut bb δx rPCM+ where + trace dPath = fold [ trMBound [ p & _y +~ s*δ+ | (p, DevBoxes _ δ) <- dPath ]+ | s <- [-1, 1] ]+ <> trStRange dPath+ trStRange ((p,DevBoxes σp' δp) : qd@(q,DevBoxes σq' δq) : ps)+ = (let η = (σp/δp + σq/δq)/2+ in Dia.opacity (1-η)+ (Dia.strokeLocLoop (Dia.fromVertices+ [_y+~σq $ q, _y+~σp $ p, _y-~σp $ p, _y-~σq $ q+ ,_y+~σq $ q ]))+ <> Dia.opacity (η^2)+ (Dia.strokeLocLoop (Dia.fromVertices+ [_y+~δq $ q, _y+~δp $ p, _y-~δp $ p, _y-~δq $ q+ ,_y+~δq $ q ]))+ ) <> trStRange (qd:ps)+ where [σp,σq] = map (`metric`1) [σp', σq']+ trStRange _ = mempty+ trMBound l = Dia.fromVertices l & Dia.dashingO [2,2] 0+ + w = rBound - lBound; h = tBound - bBound+ δx = w * 3/fromIntegral xResolution+ bb = Interval lBound rBound+ -*| Interval (bBound - h) (tBound + h) -- Heuristic \"buffering\",+ -- to account for the missing ability of 'flattenPCM_resoCut' to+ -- take deviations from quadratic-fit into account.+ ++instance Plottable (RecursiveSamples Int P2 (DevBoxes P2)) where+ plot rPCM@(RecursivePCM gPFit gDetails gFitDevs (PCMRange t₀ τsp) gSplN ())+ = DynamicPlottable{+ relevantRange_x = const $ pure xRange+ , relevantRange_y = const $ pure yRange+ , isTintableMonochromic = True+ , axesNecessity = 1+ , dynamicPlot = plot+ }+ where plot (GraphWindowSpec{..}) = Plot []+ . foldMap trStRange+ $ flattenPCM_P2_resoCut bbView [(1/δxl)^&0, 0^&(1/δyl)] rPCM+ where trStRange (Left appr) = trSR $ map calcNormDev appr+ where trSR ((pl,pr) : qd@(ql,qr) : ps)+ = Dia.opacity 0.3+ (Dia.strokeLocLoop (Dia.fromVertices+ [ ql, pl, pr, qr, ql ]+ )) <> trSR (qd:ps)+ trSR _ = mempty+ calcNormDev ((p,v), DevBoxes σ _) = (p .+^ d, p .-^ d)+ where d = metriScale σ $ turnLeft v+ trStRange (Right pts) = (`foldMap`pts)+ $ \(p, DevBoxes dv _)+ -> let δxm = metric dv $ 1^&0+ δym = metric dv $ 0^&1+ in if δxm > δx && δym > δy+ then simpleLine (_x +~ δxm $ p) (_x -~ δxm $ p)+ <> simpleLine (_y +~ δym $ p) (_y -~ δym $ p)+ else (Dia.rect (max δx $ δxm*2) (max δy $ δym*2)+ & Dia.moveTo p)+ + w = rBound - lBound; h = tBound - bBound+ δxl = 6 * δx; δyl = 6 * δy+ δx = w/fromIntegral xResolution; δy = h/fromIntegral yResolution+ bbView = Interval lBound rBound -*| Interval bBound tBound+ bb = rPCM_R2_boundingBox rPCM+ (xRange,yRange) = xyRanges bb++++instance Plottable (Int -.^> P2) where+ plot = plot . fmap (\() -> DevBoxes zeroV zeroV :: DevBoxes P2)++++-- | Plot a sequence of points @(x,y)@. The appearance of the plot will be automatically+-- chosen to match resolution and point density: at low densities, each point will simply+-- get displayed on its own. When the density goes so high you couldn't distinguish+-- individual points anyway, we switch to a “trace view”, approximating+-- the probability density function around a “local mean path”, which is+-- rather more insightful (and much less obstructive/clunky) than a simple cloud of+-- independent points.+-- +-- In principle, this should be able to handle vast amounts of data+-- (so you can, say, directly plot an audio file); at the moment the implementation+-- isn't efficient enough and will get slow for more than some 100000 data points.+tracePlot :: [(Double, Double)] -> DynamicPlottable+tracePlot = plot . recursiveSamples . map ((,()) . Dia.p2)+ ++flattenPCM_resoCut :: BoundingBox R2 -> R -> (R-.^>R) -> [(P2, DevBoxes R)]+flattenPCM_resoCut bb δx = case DiaBB.getCorners bb of+ Nothing -> const []+ Just cs -> ($[]) . go' cs+ where go' cs@(lCorn,rCorn) = go where+ go rPCM@(RecursivePCM pFit details fitDevs (PCMRange x₁ wsp) splN ())+ | DiaBB.isEmptyBox $ DiaBB.intersection bb sqRange+ = id+ | w > δx, Left (Pair s1 s2) <- details+ = go s1 . go s2+ | otherwise + = ((xm ^& constCoeff pFit, fitDevs) :)+ where xr = x₁ + w+ xm = x₁ + w / 2+ w = wsp * fromIntegral splN+ sqRange = xRange -*| rPCMLinFitRange rPCM xRange_norm'd+ xRange = x₁ ... xr+ xRange_norm'd = max (-1) ((lCorn^._x - xm)/w)+ ... min 1 ((rCorn^._x - xm)/w)++flattenPCM_P2_resoCut :: BoundingBox R2 -> [DualSpace R2]+ -> (RecursiveSamples x P2 t)+ -> [ Either [((P2, R2), DevBoxes P2)]+ [(P2, t)] ]+flattenPCM_P2_resoCut bb δs = case DiaBB.getCorners bb of+ Nothing -> const []+ Just cs -> ($[]) . go' cs+ where go' cs@(lCorn,rCorn) = go where+ go rPCM@(RecursivePCM (LinFitParams pm pa) details fitDevs@(DevBoxes dev _) _ _ ())+ | DiaBB.isEmptyBox $ DiaBB.intersection bb (rPCM_R2_boundingBox rPCM)+ = \case l@(Left [] : _) -> l+ l -> Left [] : l+ | metrics dev δs > 0.5 || (sum $ ((^2).(pa<.>^)) <$> δs) > 3+ , Left (Pair s1 s2) <- details+ = go s1 . go s2+ | Right pts <- details = (Right (Arr.toList pts) :)+ | otherwise + = \case+ (Left h : r) -> Left (((pm, dir), fitDevs) : h) : r+ r -> Left [((pm, dir), fitDevs)] : r+ where dir = case magnitude pa of 0 -> zeroV; m -> pa ^/ m++turnLeft :: R2 -> R2+turnLeft (DiaTypes.R2 x y) = DiaTypes.R2 (-y) x+++rPCM_R2_boundingBox :: (RecursiveSamples x P2 t) -> BoundingBox R2+rPCM_R2_boundingBox rPCM@(RecursivePCM pFit _ (DevBoxes dev _) _ _ ())+ = Interval (xl - ux*2) (xr + ux*2)+ -*| Interval (yb - uy*2) (yt + uy*2)+ where pm = constCoeff pFit+ p₀ = pm .-^ linCoeff pFit; pe = pm .+^ linCoeff pFit+ ux = metric dev $ 1^&0; uy = metric dev $ 0^&1+ [xl,xr] = sort[p₀^._x, pe^._x]; [yb,yt] = sort[p₀^._y, pe^._y]++++solveToLinFit :: (AffineSpace y, v~Diff y, VectorSpace v, Floating (Scalar v))+ => [y] -> LinFitParams y+solveToLinFit [] = error+ "LinFit solve under-specified (need at least one reference point)."+solveToLinFit [y] = LinFitParams { constCoeff=y, linCoeff=zeroV }+solveToLinFit [y₁,y₂] -- @[x₁, x₂] ≡ [-½, ½]@, and @f(½) = (y₁+y₂)/2 + ½·(y₂-y₁) = y₂@.+ -- (Likewise for @f(-½) = y₁@).+ = LinFitParams { constCoeff = alerp y₁ y₂ 0.5+ , linCoeff = y₂ .-. y₁ }+solveToLinFit _ = error "LinFit solve over-specified (can't solve more than two points)."+++normlsdIdd :: Fractional x => SplitList y -> [(x, y)]+normlsdIdd (SplitList l) = zip [ (k+1/2)/fromIntegral (Arr.length l)+ | k<-iterate(+1)0] $ Arr.toList l+++rPCMLinFitRange :: (R-.^>R) -> Interval R -> Interval R+rPCMLinFitRange rPCM@(RecursivePCM _ _ (DevBoxes _ δ) _ _ ()) ix+ = let (Interval b t) = rppm rPCM ix in Interval (b-δ) (t+δ)+ where rppm rPCM@(RecursivePCM (LinFitParams b a) _ _ _ _ ()) (Interval l r)+ | r < (-1) = spInterval $ b - a+ | l > 1 = spInterval $ b + a+ | l < (-1) = rppm rPCM $ Interval (-1) r+ | r > 1 = rppm rPCM $ Interval l 1+ | otherwise = (b + l*a) ... (b + r*a)++++rPCMPlot :: [R] -> DynamicPlottable+rPCMPlot = plot . recursivePCM (PCMRange (0 :: Double) 1)++-- plotSamples :: [R2]++++++data GraphWindowSpec = GraphWindowSpec {+ lBound, rBound, bBound, tBound :: R+ , xResolution, yResolution :: Int+ , colourScheme :: ColourScheme+ }+instance Show GraphWindowSpec where+ show (GraphWindowSpec{..}) = "GraphWindowSpec{\+ \lBound="++show lBound++", \+ \rBound="++show rBound++", \+ \bBound="++show bBound++", \+ \tBound="++show tBound++", \+ \xResolution="++show xResolution++", \+ \yResolution="++show yResolution++"}"++moveStepRel :: (R, R) -- ^ Relative translation @(Δx/w, Δy/h)@.+ -> (R, R) -- ^ Relative zoom.+ -> GraphWindowSpec -> GraphWindowSpec+moveStepRel (δx,δy) (ζx,ζy) (GraphWindowSpec l r b t xRes yRes clSchm)+ = GraphWindowSpec l' r' b' t' xRes yRes clSchm+ where qx = (r-l)/2 ; qy = (t-b)/2+ mx'= l + qx*(1+δx) ; my'= b + qy*(1+δy) + qx'= zoomSafeGuard mx' $ qx/ζx; qy'= zoomSafeGuard my' $ qy/ζy+ l' = mx' - qx' ; b' = my' - qy'+ r' = mx' + qx' ; t' = my' + qy'+ zoomSafeGuard m = max (1e-250 + abs m*1e-6) . min 1e+250++++data Interval r = Interval !r !r deriving (Show)+instance (Ord r) => Semigroup (Interval r) where -- WRT closed hull of the union.+ Interval l₁ u₁ <> Interval l₂ u₂ = Interval (min l₁ l₂) (max u₁ u₂)++realInterval :: Real r => Interval r -> Interval R+realInterval (Interval a b) = Interval (realToFrac a) (realToFrac b)++onInterval :: ((R,R) -> (R,R)) -> Interval R -> Interval R+onInterval f (Interval l r) = uncurry Interval $ f (l, r)++infixl 6 ...+-- | Build an interval from specified boundary points. No matter which of these+-- points is higher, the result will always be the interval in between (i.e.,+-- @3 '...' 1@ will yield the interval [1,3], not an empty set or some \"oriented+-- interval\" [3,1]).+-- The fixity @infixl 6@ was chosen so you can write 2D bounding-boxes as e.g.+-- @-1...4 -*| -1...1@.+(...) :: (Ord r) => r -> r -> Interval r+x1...x2 | x1 < x2 = Interval x1 x2+ | otherwise = Interval x2 x1++spInterval :: r -> Interval r+spInterval x = Interval x x++intersects :: Ord r => Interval r -> Interval r -> Bool+intersects (Interval a b) (Interval c d) = a<=d && b>=c++includes :: Ord r => Interval r -> r -> Bool+Interval a b `includes` x = x>=a && x<=b++infix 5 -*|++-- | Cartesian product of intervals.+(-*|) :: Interval R -> Interval R -> BoundingBox R2+Interval l r -*| Interval b t = DiaBB.fromCorners (l^&b) (r^&t)++-- | Inverse of @uncurry ('-*|')@. /This is a partial function/, since+-- 'BoundingBox'es can be empty.+xyRanges :: BoundingBox R2 -> (Interval R, Interval R)+xyRanges bb = let Just (c₁, c₂) = DiaBB.getCorners bb+ in (c₁^._x ... c₂^._x, c₁^._y ... c₂^._y)+++++++++data Plot = Plot {+ plotAnnotations :: [Annotation]+ , getPlot :: Diagram+ }+instance Semigroup Plot where+ Plot a1 d1 <> Plot a2 d2 = Plot (a1<>a2) (d1<>d2)+instance Monoid Plot where+ mempty = Plot mempty mempty+ mappend = (<>)++data DynamicPlottable = DynamicPlottable { + relevantRange_x, relevantRange_y :: Option (Interval R) -> Option (Interval R)+ , isTintableMonochromic :: Bool+ , axesNecessity :: Necessity+ , dynamicPlot :: GraphWindowSpec -> Plot+ }++data GraphViewState = GraphViewState {+ lastStableView :: Maybe (GraphWindowSpec, Plot)+ , realtimeView, nextTgtView :: Async Plot+ , graphColor :: Maybe AColour+ }+++++ ++-- | Plot some plot objects to a new interactive GTK window. Useful for a quick+-- preview of some unknown data or real-valued functions; things like selection+-- of reasonable view range and colourisation are automatically chosen.+-- +-- Example:+-- +-- @+-- plotWindow [ fnPlot cos+-- , tracePlot [(x,y) | x<-[-1,-0.96..1]+-- , y<-[0,0.01..1]+-- , abs (x^2 + y^2 - 1) < 0.01 ]]+-- @+-- +-- This gives such a plot window:+-- +-- <<images/examples/cos-encircle-points.png>>+-- +-- And that can with the mouse wheel be zoomed/browsed, like+-- +-- <<images/examples/cos-encircle-points-far.png>>+-- +-- The individual objects you want to plot can be evaluated in multiple threads, so+-- a single hard calculatation won't freeze the responsitivity of the whole window.+-- Invoke e.g. from @ghci +RTS -N4@ to benefit from this.+plotWindow :: [DynamicPlottable] -> IO GraphWindowSpec+plotWindow [] = plotWindow [dynamicAxes]+plotWindow graphs' = do+ + dgStore <- newIORef $ mempty+ + + let defColourScheme = defaultColourScheme+ + + ([viewTgt, viewState], graphs) <- do+ let window₀ = autoDefaultView graphs'+ assignGrViews :: [DynamicPlottable] -> [Colour] -> Double+ -> IO [(DynamicPlottable, GraphViewState)]+ assignGrViews (g@DynamicPlottable{..}:gs) (c:cs) axn = do + v <- async $ return $! dynamicPlot window₀+ fmap ((g, GraphViewState { lastStableView = Nothing+ , realtimeView = v, nextTgtView = v + , graphColor = cl }+ ) : ) $ assignGrViews gs cs' (axn + axesNecessity)+ where (cl, cs')+ | isTintableMonochromic = (Just $ defColourScheme c, cs)+ | otherwise = (Nothing, c:cs)+ assignGrViews [] _ axesNeed + | axesNeed > 0 = assignGrViews [dynamicAxes] [grey] (-1)+ | otherwise = return []+ w <- mapM newIORef $ replicate 2 window₀+ gs <- newIORef =<< assignGrViews graphs' defaultColourSeq 0+ return (w,gs)+ + + GTK.initGUI+ window <- GTK.windowNew+ + refreshDraw <- do+ drawA <- GTK.drawingAreaNew+ GTK.onExpose drawA $ \_ -> do+ (canvasX,canvasY) <- GTK.widgetGetSize drawA+ modifyIORef viewTgt $ \view -> view{ xResolution = fromIntegral canvasX+ , yResolution = fromIntegral canvasY }+ dia <- readIORef dgStore+ let oldSize = Dia.size2D dia+ scaledDia = Dia.bg Dia.black+ . Dia.scaleX (fromInt canvasX / 2)+ . Dia.scaleY (-fromInt canvasY / 2)+ . Dia.translate (1 ^& (-1))+ . Dia.withEnvelope (Dia.rect 2 2 :: Diagram)+ $ dia+ drawWindow <- GTK.widgetGetDrawWindow drawA+ -- putStrLn $ "redrawing"++show(canvasX,canvasY)+ -- putStrLn . ("with state now:\n"++) . show =<< readIORef viewState+ BGTK.renderToGtk drawWindow $ scaledDia+ -- putStrLn $ "redrawn."+ return True+ + GTK.on drawA GTK.scrollEvent . Event.tryEvent $ do+ (canvasX,canvasY) <- liftIO $ GTK.widgetGetSize drawA+ (scrollX,scrollY) <- Event.eventCoordinates+ let (rcX,rcY) = ( scrollX*2 / fromIntegral canvasX - 1+ , 1 - scrollY*2 / fromIntegral canvasY )+ scrollD <- Event.eventScrollDirection+ case defaultScrollBehaviour scrollD of+ ScrollZoomIn -> liftIO $ do+ modifyIORef viewTgt $ \view@GraphWindowSpec{..}+ -> let w = rBound - lBound+ h = tBound - bBound+ in view{ lBound = lBound + w * (rcX + 1)^2 * scrollZoomStrength+ , rBound = rBound - w * (rcX - 1)^2 * scrollZoomStrength+ , tBound = tBound - h * (rcY - 1)^2 * scrollZoomStrength+ , bBound = bBound + h * (rcY + 1)^2 * scrollZoomStrength+ }+ ScrollZoomOut -> liftIO $ do+ modifyIORef viewTgt $ \view@GraphWindowSpec{..}+ -> let w = rBound - lBound+ h = tBound - bBound+ in view{ lBound = lBound - w * (rcX - 1)^2 * scrollZoomStrength+ , rBound = rBound + w * (rcX + 1)^2 * scrollZoomStrength+ , tBound = tBound + h * (rcY + 1)^2 * scrollZoomStrength+ , bBound = bBound - h * (rcY - 1)^2 * scrollZoomStrength+ }+ + + + GTK.set window [ GTK.windowTitle := "Plot"+ , GTK.windowDefaultWidth := defResX+ , GTK.windowDefaultHeight := defResY+ , GTK.containerChild := drawA+ ]+ + GTK.widgetShowAll window+ + return $ GTK.widgetQueueDraw drawA+ + + let updateRTView, updateTgtView :: (GraphWindowSpec -> GraphWindowSpec) -> IO ()+ updateRTView updRealView = do+ vstOld <- readIORef viewState+ let newRealView = updRealView vstOld+ grViewsOld <- readIORef graphs+ writeIORef graphs <=< forM grViewsOld $ + \(o@DynamicPlottable{..}, gv) -> do+ newRt <- async $ return $! dynamicPlot newRealView+ poll (realtimeView gv) >>= \case+ Just(Right vw) -> return (o+ , gv{ realtimeView = newRt, lastStableView = Just (vstOld, vw) })+ _ -> do + cancel $ realtimeView gv+ poll (nextTgtView gv) >>= \case+ Just(Right vw) -> do+ ttvn <- readIORef viewTgt + return (o, gv{ realtimeView = newRt, lastStableView = Just (ttvn, vw) })+ _ -> return (o, gv{ realtimeView = newRt })+ writeIORef viewState newRealView+ updateTgtView updTgtView = do+ newTgtView <- updTgtView <$> readIORef viewTgt+ grViewsOld <- readIORef graphs+ writeIORef graphs <=< forM grViewsOld $ + \(o@DynamicPlottable{..}, gv) -> do+ newTt <- async $ return $! dynamicPlot newTgtView+ cancel $ nextTgtView gv+ return (o, gv{ nextTgtView = newTt })+ writeIORef viewTgt newTgtView+ + t₀ <- getCurrentTime+ lastFrameTime <- newIORef t₀+ + let minKeyImpact = 0.05+ + keyImpactState <- newIORef $ Map.fromList [ (ka, (t₀, minKeyImpact)) | ka<-[MoveLeft .. ZoomOut_y] ]+ + + let refreshScreen = do+ currentView@(GraphWindowSpec{..}) <- readIORef viewState+ let normaliseView :: Diagram -> Diagram+ normaliseView = (Dia.scaleX xUnZ :: Diagram->Diagram) . Dia.scaleY yUnZ+ . Dia.translate (Dia.r2(-x₀,-y₀))+ where xUnZ = 1/w; yUnZ = 1/h+ w = (rBound - lBound)/2; h = (tBound - bBound)/2+ x₀ = lBound + w; y₀ = bBound + h+ renderComp (DynamicPlottable{..}, GraphViewState{..}) = do+ plt <- poll realtimeView >>= \case+ Just (Right pl) -> return $ Just pl+ _ -> case lastStableView of+ Just (_, vw) -> return $ Just vw+ _ -> poll nextTgtView >> return Nothing+ return $ case plt of+ Nothing -> mempty+ Just Plot{..} -> let + antTK = DiagramTK { viewScope = currentView + , textTools = TextTK defaultTxtStyle+ txtSize aspect 0.2 0.2 }+ txtSize = h * fontPts / fromIntegral yResolution+ aspect = w * fromIntegral yResolution+ / (h * fromIntegral xResolution)+ fontPts = 12+ transform :: Diagram -> Diagram+ transform = normaliseView . clr+ where clr | Just c <- graphColor = Dia.lcA c . Dia.fcA c+ | otherwise = id+ in transform $ foldMap (prerenderAnnotation antTK) plotAnnotations+ <> getPlot++ gvStates <- readIORef graphs+ waitAny $ map (realtimeView . snd) gvStates+ + writeIORef dgStore+ . mconcat . reverse =<< mapM renderComp (reverse gvStates)+ + refreshDraw+ + let mainLoop = do+ t <- getCurrentTime+ δt <- fmap (diffUTCTime t) $ readIORef lastFrameTime+ writeIORef lastFrameTime t+ + do vt <- readIORef viewTgt+ updateRTView $ \vo -> + let a%b = let η = min 1 $ 2 * realToFrac δt in η*a + (1-η)*b + in GraphWindowSpec (lBound vt % lBound vo) (rBound vt % rBound vo)+ (bBound vt % bBound vo) (tBound vt % tBound vo)+ (xResolution vt) (yResolution vt)+ defColourScheme+ -- GTK.sleep 0.01+ refreshScreen+ -- GTK.pollEvents+ return True+ + let keyImpact key = do+ t <- getCurrentTime+ Just (_, impact) <- fmap (Map.lookup key) $ readIORef keyImpactState+ modifyIORef keyImpactState $ Map.adjust ( \(t₁, p)+ -> (t, min 1 $ ( (p - minKeyImpact) * (exp . (*3) . realToFrac $ diffUTCTime t₁ t)+ + minKeyImpact ) * 2 )+ ) key+ return impact+ +-- GLFW.keyCallback $= \key state -> do+-- let keyStepSize = 0.1+-- (state==GLFW.Press) `when` do+-- case defaultKeyMap key of+-- Just QuitProgram -> writeIORef done True+-- Just movement -> do+-- impact <- keyImpact movement+-- updateTgtView $ case movement of+-- MoveUp -> moveStepRel (0, impact) (1, 1)+-- MoveDown -> moveStepRel (0, -impact) (1, 1)+-- MoveLeft -> moveStepRel (-impact, 0) (1, 1)+-- MoveRight -> moveStepRel (impact , 0) (1, 1)+-- ZoomIn_x -> moveStepRel (0, 0) (1+impact, 1)+-- ZoomOut_x -> moveStepRel (0, 0) (1-impact/2, 1)+-- ZoomIn_y -> moveStepRel (0, 0) (1, 1+impact/2)+-- ZoomOut_y -> moveStepRel (0, 0) (1, 1-impact/2)+-- _ -> return ()+-- + GTK.onDestroy window $ do+ (readIORef graphs >>=) . mapM_ -- cancel remaining threads+ $ \(_, GraphViewState{..}) -> cancel realtimeView >> cancel nextTgtView+ GTK.mainQuit+ + + -- putStrLn "Enter Main loop..."+ +-- mainLoop+ GTK.timeoutAdd mainLoop 100+ ++ GTK.mainGUI+ + -- putStrLn "Done."+ + -- GTK.mainQuit+ + readIORef viewState+++autoDefaultView :: [DynamicPlottable] -> GraphWindowSpec+autoDefaultView graphs = GraphWindowSpec l r b t defResX defResY defaultColourScheme+ where (xRange, yRange) = foldMap (relevantRange_x &&& relevantRange_y) graphs+ ((l,r), (b,t)) = ( xRange `dependentOn` yRange+ , yRange `dependentOn` xRange )+ ξ`dependentOn`υ = addMargin . defRng . ξ . return . defRng $ υ mempty+ defRng = Interval (-1) 1 `option` id+ addMargin (Interval a b) = (a - q, b + q)+ where q = (b - a) / 6+ +++-- render :: Diagram -> IO()+-- render = Dia.clearRender++defResX, defResY :: Integral i => i+defResX = 640+defResY = 480+++data ScrollAction = ScrollZoomIn | ScrollZoomOut++defaultScrollBehaviour :: Event.ScrollDirection -> ScrollAction+defaultScrollBehaviour Event.ScrollUp = ScrollZoomIn+defaultScrollBehaviour Event.ScrollDown = ScrollZoomOut++scrollZoomStrength :: Double+scrollZoomStrength = 1/20+++data KeyAction = MoveLeft+ | MoveRight+ | MoveUp+ | MoveDown+ | ZoomIn_x+ | ZoomOut_x+ | ZoomIn_y+ | ZoomOut_y+ | QuitProgram+ deriving (Eq, Ord, Enum)++defaultKeyMap :: GTK.KeyVal -> Maybe KeyAction+-- defaultKeyMap (GLFW.SpecialKey GLFW.UP ) = Just MoveUp+-- defaultKeyMap (GLFW.SpecialKey GLFW.DOWN ) = Just MoveDown+-- defaultKeyMap (GLFW.SpecialKey GLFW.LEFT ) = Just MoveLeft+-- defaultKeyMap (GLFW.SpecialKey GLFW.RIGHT) = Just MoveRight+-- defaultKeyMap (GLFW.CharKey 'K') = Just MoveUp+-- defaultKeyMap (GLFW.CharKey 'J') = Just MoveDown+-- defaultKeyMap (GLFW.CharKey 'H') = Just MoveLeft+-- defaultKeyMap (GLFW.CharKey 'L') = Just MoveRight+-- defaultKeyMap (GLFW.CharKey 'B') = Just ZoomIn_x+-- defaultKeyMap (GLFW.CharKey 'N') = Just ZoomOut_x+-- defaultKeyMap (GLFW.CharKey 'I') = Just ZoomIn_y+-- defaultKeyMap (GLFW.CharKey 'O') = Just ZoomOut_y+-- defaultKeyMap (GLFW.SpecialKey GLFW.ESC) = Just QuitProgram+defaultKeyMap _ = Nothing++-- instance NFData Draw.R+++-- | Plot an (assumed continuous) function in the usual way.+-- Since this uses functions of actual 'Double' values, you have more liberty+-- of defining functions with range-pattern-matching etc., which is at the moment+-- not possible in the ':-->' category.+-- +-- However, because 'Double' can't really proove properties of a mathematical+-- function, aliasing and similar problems are not taken into account. So it only works+-- accurately when the function is locally linear on pixel scales (what most+-- other plot programs just assume silently). In case of singularities, the+-- naïve thing is done (extend as far as possible; vertical line at sign change),+-- which again is common enough though not really right.+-- +-- We'd like to recommend using 'fnPlot' whenever possible, which automatically adjusts+-- the resolution so the plot is guaranteed accurate (but it's not usable yet for+-- a lot of real applications).+continFnPlot :: (Double -> Double) -> DynamicPlottable+continFnPlot f = DynamicPlottable{+ relevantRange_x = const mempty+ , relevantRange_y = yRangef+ , isTintableMonochromic = True+ , axesNecessity = 1+ , dynamicPlot = plot }+ where yRangef = fmap . onInterval $ \(l, r) -> ((!10) &&& (!70)) . sort . pruneOutlyers+ $ map f [l, l + (r-l)/80 .. r]+ plot (GraphWindowSpec{..}) = curve `deepseq` Plot [] (trace curve)+ where δx = (rBound - lBound) * 2 / fromIntegral xResolution+ curve = [ (x ^& f x) | x<-[lBound, lBound+δx .. rBound] ]+ trace (p:q:ps) = simpleLine p q <> trace (q:ps)+ trace _ = mempty+ pruneOutlyers = filter (not . isNaN) + l!n | (x:_)<-drop n l = x+ | otherwise = error "Function appears to yield NaN most of the time. Cannot be plotted."++ +-- | Plot a continuous function in the usual way, taking arguments from the+-- x-Coordinate and results to the y one.+-- The signature looks more complicated than it is; think about it as requiring+-- a polymorphic 'Floating' function. Any simple expression like+-- @'fnPlot' (\\x -> sin x / exp (x^2))@ will work (but the view must not contain+-- singularities).+-- +-- Under the hood this uses the category of continuous functions, ':-->', to proove+-- that no details are omitted (like small high-frequency bumps). The flip side is that+-- this does not always work very efficiently, in fact it can easily become exponentially+-- slow for some parameters.+-- Make sure to run multithreaded, to prevent hanging your program this way. Also consider+-- limiting the memory: if you try to plot across singularities, the program may well+-- eat up all available resorces before failing. (But it will never “succeed” and+-- plot something wrong!)+-- +-- In the future, we would like to switch to the category of piecewise continuously-differentiable+-- functions. That wouldn't suffer from said problems, and should+-- also generally be more efficient. (That category is not yet implemented in Haskell.)+fnPlot :: (forall m . 𝓒⁰.Manifold m + => ProxyVal (:-->) m Double -> ProxyVal (:-->) m Double) + -> DynamicPlottable+fnPlot f = plot fc+ where fc :: Double :--> Double+ fc = alg f+ +-- | Plot a continuous, “parametric function”, i.e. mapping the real+-- line to a path in ℝ².+paramPlot :: (forall m . 𝓒⁰.Manifold m + => ProxyVal (:-->) m Double + -> (ProxyVal (:-->) m Double, ProxyVal (:-->) m Double)) + -> DynamicPlottable+paramPlot f = plot fc+ where fc :: Double :--> (Double, Double)+ fc = alg1to2 f+++++data AxesStyle = DynamicAxesStyle+data DynamicAxes = DynamicAxes { yAxisClasses, xAxisClasses :: [AxisClass] }+data AxisClass = AxisClass { visibleAxes :: [Axis], axisStrength :: Double, decPrecision :: Int }+data Axis = Axis { axisPosition :: R }++crtDynamicAxes :: GraphWindowSpec -> DynamicAxes+crtDynamicAxes (GraphWindowSpec {..}) = DynamicAxes yAxCls xAxCls+ where [yAxCls, xAxCls] = zipWith3 directional + [lBound, bBound] [rBound, tBound] [xResolution, yResolution]+ directional l u res = map lvl lvlSpecs+ where span = u - l+ upDecaSpan = 10**(ceil $ lg span)+ pixelScale = span / (fromIntegral res * upDecaSpan)+ baseDecaval = upDecaSpan * (flor $ l / upDecaSpan)+ lvl (minSpc, strength) + = AxisClass [ Axis v | i<-[0 .. luDSdiv*2]+ , let v=(baseDecaval + i*laSpc), v>l, v<u ] + strength+ (floor $ lg laSpc)+ where laSpc = upDecaSpan / luDSdiv+ luDSdiv = ll -- maybe 1 id . listToMaybe + . takeWhile (\d -> pixelScale * minSpc < 1/d )+ . join $ iterate (map(*10)) [1, 2, 5]+ ll [] = error $ "pixelScale = "++show pixelScale+ ++"; minSpc = "++show minSpc+ ll l = last l+ lvlSpecs = [ (80, 0.3), (18, 0.1) ]++++dynamicAxes :: DynamicPlottable+dynamicAxes = DynamicPlottable { + relevantRange_x = const mempty+ , relevantRange_y = const mempty + , isTintableMonochromic = False+ , axesNecessity = superfluent+ , dynamicPlot = plot }+ where plot gwSpec@(GraphWindowSpec{..}) = Plot labels lines+ where (DynamicAxes yAxCls xAxCls) = crtDynamicAxes gwSpec+ lines = zeroLine (lBound^&0) (rBound^&0) `provided`(bBound<0 && tBound>0)+ <> zeroLine (0^&bBound) (0^&tBound) `provided`(lBound<0 && rBound>0)+ <> foldMap (renderClass $ \x -> (x^&bBound, x^&tBound)) yAxCls+ <> foldMap (renderClass $ \y -> (lBound^&y, rBound^&y)) xAxCls+ labels = do (dirq, hAlign, vAlign, acl) <- zip4 [\x -> x^&0, \y -> 0^&y ] + [AlignMid , AlignTop ]+ [AlignTop , AlignMid ]+ [yAxCls , xAxCls ]+ let (AxisClass vaxs _ prc) = head acl+ prepAnnotation (Axis{axisPosition=z}) = do+ guard(z/=0) + [Annotation (TextAnnotation txt align) place False]+ where txt = PlainText . prettyFloatShow prc $ realToFrac z+ place = ExactPlace $ dirq z+ align = TextAlignment hAlign vAlign+ prepAnnotation =<< vaxs+ zeroLine p1 p2 = simpleLine p1 p2 & Dia.lc Dia.grey+ renderClass crd (AxisClass axes strength _)+ = foldMap (uncurry simpleLine . crd . axisPosition) axes+ & Dia.lcA (Dia.grey `DCol.withOpacity` strength)++++type Necessity = Double+superfluent = -1e+32 :: Necessity++++simpleLine :: Dia.P2 -> Dia.P2 -> Diagram+simpleLine p q = Dia.fromVertices [p,q] & Dia.lwO 2++++-- | When you “plot” 'xInterval' / 'yInterval', it is ensured that the (initial) view encompasses +-- (at least) the specified range.+-- Note there is nothing special about these “flag” objects: /any/ 'Plottable' can request a +-- certain view, e.g. for a discrete point cloud it's obvious and a function defines at least+-- a @y@-range for a given @x@-range. Only use explicit range when necessary.+xInterval, yInterval :: (Double, Double) -> DynamicPlottable+xInterval (l,r) = DynamicPlottable { + relevantRange_x = const . return $ Interval l r+ , relevantRange_y = const mempty+ , isTintableMonochromic = False+ , axesNecessity = 0+ , dynamicPlot = plot }+ where plot _ = Plot mempty mempty+yInterval (b,t) = DynamicPlottable { + relevantRange_x = const mempty+ , relevantRange_y = const . return $ Interval b t+ , isTintableMonochromic = False+ , axesNecessity = 0+ , dynamicPlot = plot }+ where plot _ = Plot mempty mempty+ ++prettyFloatShow :: Int -> Double -> String+prettyFloatShow _ 0 = "0"+prettyFloatShow preci x+ | preci >= 0, preci < 4 = show $ round x+ | preci < 0, preci > -2 = printf "%.1f" x+ | otherwise = case ceiling (0.01 + lg (abs x/10^^(preci+1))) + preci of+ 0 | preci < 0 -> printf ("%."++show(-preci)++"f") x+ expn | expn>preci -> printf ("%."++show(expn-preci)++"f*10^%i")+ (x/10^^expn) expn+ | otherwise -> printf ("%i*10^%i")+ (round $ x/10^^expn :: Int) expn+ +++++maybeRead :: Read a => String -> Maybe a+maybeRead = fmap fst . listToMaybe . reads++data Annotation = Annotation {+ getAnnotation :: AnnotationObj + , placement :: AnnotationPlace+ , isOptional :: Bool+ }+data AnnotationObj = TextAnnotation TextObj TextAlignment+data AnnotationPlace = ExactPlace R2++data TextObj = PlainText String+data TextAlignment = TextAlignment { hAlign, vAlign :: Alignment } -- , blockSpread :: Bool }+data Alignment = AlignBottom | AlignMid | AlignTop++data DiagramTK = DiagramTK { textTools :: TextTK, viewScope :: GraphWindowSpec }+data TextTK = TextTK { txtCairoStyle :: Dia.Style R2 -- Draw.Font+ , txtSize, xAspect, padding, extraTopPad :: R }++defaultTxtStyle :: Dia.Style R2+defaultTxtStyle = mempty & Dia.fontSizeO 9+ & Dia.fc Dia.grey+ & Dia.lc Dia.grey+++prerenderAnnotation :: DiagramTK -> Annotation -> Diagram+prerenderAnnotation (DiagramTK{ textTools = TextTK{..}, viewScope = GraphWindowSpec{..} }) + (Annotation{..})+ | TextAnnotation (PlainText str) (TextAlignment{..}) <- getAnnotation+ , ExactPlace p₀ <- placement+ = let rnTextLines = map (CairoTxt.textVisualBounded txtCairoStyle) $ lines str+ lineWidths = map ((/4 {- Magic number ??? -})+ . Dia.width) rnTextLines+ nLines = length lineWidths+ lineHeight = 1 + extraTopPad + 2*padding+ ζx = ζy * xAspect+ ζy = txtSize -- / lineHeight+ width = (maximum $ 0 : lineWidths) + 2*padding+ height = fromIntegral nLines * lineHeight+ y₀ = case vAlign of+ AlignBottom -> padding + height - lineHeight+ AlignMid -> height/2 - lineHeight+ AlignTop -> - (lineHeight + padding)+ fullText = mconcat $ zipWith3 ( \n w -> + let y = n*lineHeight+ in (Dia.translate $ Dia.r2 (case hAlign of + AlignBottom -> (padding , y₀-y)+ AlignMid -> (- w/2 , y₀-y)+ AlignTop -> (-(w + padding), y₀-y)+ ) ) ) [0..] lineWidths rnTextLines+ p = px ^& py+ where px = max l' . min r' $ p₀^._x+ py = max b' . min t' $ p₀^._y+ (l', r') = case hAlign of+ AlignBottom -> (lBound , rBound - w )+ AlignMid -> (lBound + w/2, rBound - w/2)+ AlignTop -> (lBound + w , rBound )+ (b', t') = case vAlign of+ AlignBottom -> (bBound , tBound - h )+ AlignMid -> (bBound + h/2, tBound - h/2)+ AlignTop -> (bBound + h , tBound )+ w = ζx * width; h = ζy * height+ in Dia.translate p . Dia.scaleX ζx . Dia.scaleY ζy + $ Dia.lc Dia.grey fullText+ ++++++infixl 7 `provided`+provided :: Monoid m => m -> Bool -> m+provided m True = m+provided m False = mempty+++lg :: Floating a => a -> a+lg x = log x / log 10+++-- instance (Monoid v) => Semigroup (Draw.Image v) where+-- (<>) = mappend+-- instance Semigroup (Draw.Affine) where+-- (<>) = mappend+-- +ceil, flor :: R -> R+ceil = fromInt . ceiling+flor = fromInt . floor++fromInt :: Num a => Int -> a+fromInt = fromIntegral++++instance NFData Dia.P2+
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ dynamic-plot.cabal view
@@ -0,0 +1,76 @@+Name: dynamic-plot+Version: 0.1.0.0+Category: graphics+Synopsis: Interactive diagram windows+Description: Haskell excels at handling data like continuous functions+ in a nice way, i.e. without discretising anything to finite arrays as+ is typically done in languages like Matlab. Instead, you can simply pass+ around functions or infinite data structures (or /very/ high-resolution data+ that would be infeasible to handle in a strict language).+ .+ However when you want to /view/ the data, it will eventually need to be exported out of Haskell+ in some finite form. The purpose of this library is to delay this discretisation+ as long as possible: it implements an interactive plotting window that accepts continuous/recursive+ data and only “flattens” it according to the specific view configuration.+ You can then zoom in to a shown diagram and it will automatically calculate+ the features more detailedly, or zoom out and discover previosly unexpected+ features. You don't need to worry about specifying the range and/or resolution beforehand:+ the program will try to find a suitable default view based on /all/ data your displaying,+ and you can always still zoom, resize or move later.+ .+ <http://projects.haskell.org/diagrams> are used as the “pre-rendered” type. This+ makes the output usable in a very wide range of applications, though at the moment only the GTK+ window view is implemented.+License: GPL-3+License-file: COPYING+Author: Justus Sagemüller+Maintainer: (@) sagemuej $ smail.uni-koeln.de+Homepage: https://github.com/leftaroundabout/dynamic-plot+Build-Type: Simple+Cabal-Version: >=1.10+Extra-Doc-Files: images/examples/*.png++Source-Repository head+ type: git+ location: git://github.com/leftaroundabout/dynamic-plot.git++Library+ Build-Depends: base>=4.5 && <6+ , transformers+ , mtl+ , vector-space>=0.8+ , MemoTrie+ , vector+ , containers+ , semigroups+ , random+ , MonadRandom+ , time+ , async+ , deepseq+ , process+ , constrained-categories+ , diagrams-core == 1.2.0.2+ , diagrams-lib >= 1 && < 1.4+ , diagrams-cairo == 1.2.0.2+ , diagrams-gtk+ , gtk > 0.10 && < 0.15+ , glib+ , colour >= 2 && < 3+ , manifolds < 0.1.1+ , lens+ Other-Extensions: FlexibleInstances+ , TypeFamilies+ , FlexibleContexts+ , GADTs+ , RankNTypes+ , ConstraintKinds+ , PatternGuards+ , ScopedTypeVariables+ , RecordWildCards+ , TupleSections+ ghc-options: -O2+ default-language: Haskell2010+ Exposed-modules: Graphics.Dynamic.Plot.R2+ Other-modules: Graphics.Dynamic.Plot.Colour+ , Data.LinearMap.HerMetric
+ images/examples/cos-encircle-points-far.png view
binary file changed (absent → 26906 bytes)
+ images/examples/cos-encircle-points.png view
binary file changed (absent → 31328 bytes)