diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,18 @@ +# Revision history for dataframe + +## 0.1.0.0 -- 2024-02-24 + +* Initial commit with small example + +## 0.1.0.1 -- 2024-11-24 + +* Added a few more dataframe operations. Notably sum and filtering logic. +* Slightly better error messaging for wrong types +* Another example dataset + example program. + +## 0.1.0.2 -- 2024-11-30 + +* Changed default string type to bytestring +* Add a single-column groupBy implementation +* Improved CSV IO to use mutable vectors and reduce allocations. +* Multi-column groupBy operation diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,674 @@ + 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 +. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,68 @@ +# DataFrame + +An intuitive, dynamically-typed DataFrame library. + +A tool for exploratory data analysis. + +## What is exploratory data analysis? +We provide a primer [here](./docs/exploratory_data_analysis_primer.md) and show how to do some common analyses. + +## Coming from other dataframe libraries +Familiar with another dataframe library? Get started: +* [Coming from Pandas](./docs/coming_from_pandas.md) +* [Coming from Polars](./docs/coming_from_polars.md) +* [Coming from dplyr](./docs/coming_from_dplyr.md) + +## Current status +The library is still in active development with a v0.1 launch planned for March 2025. + +## Example usage + +### Code example +```haskell +import qualified Data.DataFrame as D + +import Data.DataFrame ((|>)) + +main :: IO () + df <- D.readTsv "./data/chipotle.tsv" + print $ df + |> D.select ["item_name", "quantity"] + |> D.groupBy ["item_name"] + |> D.aggregate (zip (repeat "quantity") [D.Maximum, D.Mean, D.Sum]) + |> D.sortBy D.Descending ["Sum_quantity"] +``` + +Output: + +``` +---------------------------------------------------------------------------------------------------- +index | item_name | Sum_quantity | Mean_quantity | Maximum_quantity +------|---------------------------------------|--------------|--------------------|----------------- + Int | Text | Int | Double | Int +------|---------------------------------------|--------------|--------------------|----------------- +0 | Chips and Fresh Tomato Salsa | 130 | 1.1818181818181819 | 15 +1 | Izze | 22 | 1.1 | 3 +2 | Nantucket Nectar | 31 | 1.1481481481481481 | 3 +3 | Chips and Tomatillo-Green Chili Salsa | 35 | 1.1290322580645162 | 3 +4 | Chicken Bowl | 761 | 1.0482093663911847 | 3 +5 | Side of Chips | 110 | 1.0891089108910892 | 8 +6 | Steak Burrito | 386 | 1.048913043478261 | 3 +7 | Steak Soft Tacos | 56 | 1.018181818181818 | 2 +8 | Chips and Guacamole | 506 | 1.0563674321503131 | 4 +9 | Chicken Crispy Tacos | 50 | 1.0638297872340425 | 2 +``` + +Full example in `./app` folder using many of the constructs in the API. + +### Visual example +![Screencast of usage in GHCI](./static/example.gif) + +## Future work +* Apache arrow and Parquet compatability +* Integration with common data formats (currently only supports CSV) +* Support windowed plotting (currently only supports ASCII plots) +* Create a lazy API that builds an execution graph instead of running eagerly (will be used to compute on files larger than RAM) + +## Contributing +* Please first submit an issue and we can discuss there. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TupleSections #-} + +module Main where + +import qualified Data.DataFrame as D +import Data.DataFrame (dimensions, (|>)) +import Data.List (delete) +import Data.Maybe (fromMaybe, isJust, isNothing) +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Unboxed as VU + +-- Numbers default to int and double, and strings to text +default (Int, T.Text, Double) + +-- Example usage of DataFrame library + +main :: IO () +main = do + putStrLn "Housing" + housing + putStrLn $ replicate 100 '-' + + putStrLn "Chipotle Data" + chipotle + putStrLn $ replicate 100 '-' + + putStrLn "One Billion Row Challenge" + oneBillingRowChallenge + putStrLn $ replicate 100 '-' + + putStrLn "Covid Data" + covid + putStrLn $ replicate 100 '-' + + +mean :: (Fractional a, VG.Vector v a) => v a -> a +mean xs = VG.sum xs / fromIntegral (VG.length xs) + +oneBillingRowChallenge :: IO () +oneBillingRowChallenge = do + parsed <- D.readSeparated ';' D.defaultOptions "./data/measurements.txt" + print $ + parsed + |> D.groupBy ["City"] + |> D.reduceBy (\v -> (VG.minimum v, mean @Double v, VG.maximum v)) "Measurement" + |> D.sortBy D.Ascending ["City"] + +housing :: IO () +housing = do + parsed <- D.readCsv "./data/housing.csv" + + print $ D.columnInfo parsed + + -- Sample. + print $ D.take 5 parsed + + D.plotHistograms D.PlotAll D.VerticalHistogram parsed + +covid :: IO () +covid = do + rawFrame <- D.readCsv "./data/effects-of-covid-19-on-trade-at-15-december-2021-provisional.csv" + print $ dimensions rawFrame + print $ D.take 10 rawFrame + + D.plotHistograms D.PlotAll D.VerticalHistogram rawFrame + + -- value of all exports from 2015 + print $ + rawFrame + |> D.filter "Direction" (== "Exports") + |> D.select ["Direction", "Year", "Country", "Value"] + |> D.groupBy ["Direction", "Year", "Country"] + |> D.reduceByAgg D.Sum "Value" + +chipotle :: IO () +chipotle = do + rawFrame <- D.readTsv "./data/chipotle.tsv" + print $ D.dimensions rawFrame + + -- -- Sampling the dataframe + print $ D.take 5 rawFrame + + -- Transform the data from a raw string into + -- respective types (throws error on failure) + let f = + rawFrame + -- Change a specfic order ID + |> D.applyWhere (== 1) "order_id" (+ 2) "quantity" + -- Index based change. + |> D.applyAtIndex 0 (\n -> n - 2) "quantity" + -- Custom parsing: drop dollar sign and parse price as double + |> D.apply (D.readValue @Double . T.drop 1) "item_price" + + -- sample the dataframe. + print $ D.take 10 f + + -- Create a total_price column that is quantity * item_price + let multiply (a :: Int) (b :: Double) = fromIntegral a * b + let withTotalPrice = D.deriveFrom (["quantity", "item_price"], D.func multiply) "total_price" f + + -- sample a filtered subset of the dataframe + putStrLn "Sample dataframe" + print $ + withTotalPrice + |> D.select ["quantity", "item_name", "item_price", "total_price"] + |> D.filter "total_price" (100.0 <) + |> D.take 10 + + -- Check how many chicken burritos were ordered. + -- There are two ways to checking how many chicken burritos + -- were ordered. + let searchTerm = "Chicken Burrito" :: T.Text + + print $ + f + |> D.select ["item_name", "quantity"] + -- It's more efficient to filter before grouping. + |> D.filter "item_name" (searchTerm ==) + |> D.groupBy ["item_name"] + -- can also be written as: + -- D.aggregate (zip (repeat "quantity") [D.Sum, D.Maximum, D.Mean]) + |> D.aggregate (map ("quantity",) [D.Sum, D.Maximum, D.Mean]) + -- Automatically create a variable called _ + |> D.sortBy D.Descending ["Sum_quantity"] + + -- Similarly, we can aggregate quantities by all rows. + print $ + f + |> D.select ["item_name", "quantity"] + |> D.groupBy ["item_name"] + -- Aggregate written more explicitly. + -- We have the full expressiveness of Haskell and we needn't fall + -- use a DSL. + |> D.aggregate [("quantity", D.Maximum), ("quantity", D.Mean), ("quantity", D.Sum)] + |> D.take 10 + + let firstOrder = + withTotalPrice + |> D.filterBy (maybe False (T.isInfixOf "Guacamole")) "choice_description" + |> D.filterBy (("Chicken Bowl" :: T.Text) ==) "item_name" + + print $ D.take 10 firstOrder diff --git a/benchmark/Main.hs b/benchmark/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark/Main.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.DataFrame as D +import qualified Data.Vector.Unboxed as VU + +import Control.Monad (replicateM) +import Criterion.Main +import System.Random (randomRIO) + +stats :: Int -> IO () +stats n = do + ns <- VU.replicateM n (randomRIO (-20.0 :: Double, 20.0)) + xs <- VU.replicateM n (randomRIO (-20.0 :: Double, 20.0)) + ys <- VU.replicateM n (randomRIO (-20.0 :: Double, 20.0)) + let df = D.fromList [("first", D.UnboxedColumn ns), + ("second", D.UnboxedColumn xs), + ("third", D.UnboxedColumn ys)] + + print $ D.mean "first" df + print $ D.variance "second" df + print $ D.correlation "second" "third" df + print $ D.select ["first"] df D.|> D.take 1 + +main = defaultMain [ + bgroup "stats" [ bench "300_000" $ nfIO (stats 100_000) + , bench "3_000_000" $ nfIO (stats 1_000_000) + , bench "30_000_000" $ nfIO (stats 30_000_000) + ] + ] diff --git a/dataframe.cabal b/dataframe.cabal new file mode 100644 --- /dev/null +++ b/dataframe.cabal @@ -0,0 +1,128 @@ +cabal-version: 2.4 +name: dataframe +version: 0.1.0.0 + +synopsis: An intuitive, dynamically-typed DataFrame library. + +description: An intuitive, dynamically-typed DataFrame library for exploratory data analysis. + +bug-reports: https://github.com/mchav/dataframe/issues +license: GPL-3.0-or-later +license-file: LICENSE +author: Michael Chavinda +maintainer: mschavinda@gmail.com + +copyright: (c) 2024-2024 Michael Chavinda +category: Data +tested-with: GHC ==9.8.3 || ==9.6.6 || == 9.4.8 +extra-doc-files: CHANGELOG.md README.md + +source-repository head + type: git + location: https://github.com/mchav/dataframe + +library + exposed-modules: Data.DataFrame + other-modules: Data.DataFrame.Internal.Types, + Data.DataFrame.Internal.Function, + Data.DataFrame.Internal.Parsing, + Data.DataFrame.Internal.Column, + Data.DataFrame.Display.Terminal.PrettyPrint, + Data.DataFrame.Display.Terminal.Colours, + Data.DataFrame.Internal.DataFrame, + Data.DataFrame.Internal.Row, + Data.DataFrame.Errors, + Data.DataFrame.Operations.Core, + Data.DataFrame.Operations.Subset, + Data.DataFrame.Operations.Sorting, + Data.DataFrame.Operations.Statistics, + Data.DataFrame.Operations.Transformations, + Data.DataFrame.Operations.Typing, + Data.DataFrame.Operations.Aggregation, + Data.DataFrame.Display.Terminal.Plot, + Data.DataFrame.IO.CSV + build-depends: base >= 4.17.2.0 && < 4.21, + array ^>= 0.5, + attoparsec >= 0.12 && <= 0.14.4, + bytestring >= 0.11 && <= 0.12.2.0, + containers >= 0.6.7 && < 0.8, + directory >= 1.3.0.0 && <= 1.3.9.0, + hashable >= 1.2 && <= 1.5.0.0, + statistics == 0.16.3.0, + text >= 2.0 && <= 2.1.2, + time >= 1.12 && <= 1.14, + vector ^>= 0.13, + vector-algorithms ^>= 0.9 + hs-source-dirs: src + default-language: Haskell2010 + +executable dataframe + main-is: Main.hs + other-modules: Data.DataFrame, + Data.DataFrame.Internal.Types, + Data.DataFrame.Internal.Function, + Data.DataFrame.Internal.Parsing, + Data.DataFrame.Internal.Column, + Data.DataFrame.Display.Terminal.PrettyPrint, + Data.DataFrame.Display.Terminal.Colours, + Data.DataFrame.Internal.DataFrame, + Data.DataFrame.Internal.Row, + Data.DataFrame.Errors, + Data.DataFrame.Operations.Core, + Data.DataFrame.Operations.Subset, + Data.DataFrame.Operations.Sorting, + Data.DataFrame.Operations.Statistics, + Data.DataFrame.Operations.Transformations, + Data.DataFrame.Operations.Typing, + Data.DataFrame.Operations.Aggregation, + Data.DataFrame.Display.Terminal.Plot, + Data.DataFrame.IO.CSV + build-depends: base >= 4.17.2.0 && < 4.21, + array ^>= 0.5, + attoparsec >= 0.12 && <= 0.14.4, + bytestring >= 0.11 && <= 0.12.2.0, + containers >= 0.6.7 && < 0.8, + directory >= 1.3.0.0 && <= 1.3.9.0, + hashable >= 1.2 && <= 1.5.0.0, + statistics == 0.16.3.0, + text >= 2.0 && <= 2.1.2, + time >= 1.12 && <= 1.14, + vector ^>= 0.13, + vector-algorithms ^>= 0.9 + hs-source-dirs: app, + src + default-language: Haskell2010 + +benchmark dataframe-benchmark + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: benchmark + build-depends: base >= 4.17.2.0 && < 4.21, + criterion >= 1 && <= 1.6.4.0, + text >= 2.0 && <= 2.1.2, + random >= 1 && <= 1.3.1, + vector ^>= 0.13, + dataframe + default-language: Haskell2010 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: Assertions, + Operations.Apply, + Operations.Derive, + Operations.Filter, + Operations.GroupBy, + Operations.InsertColumn, + Operations.Sort, + Operations.Take + build-depends: base >= 4.17.2.0 && < 4.21, + HUnit ^>= 1.6, + random >= 1, + random-shuffle >= 0.0.4, + text >= 2.0, + time >= 1.12, + vector ^>= 0.13, + dataframe + hs-source-dirs: tests + default-language: Haskell2010 diff --git a/src/Data/DataFrame.hs b/src/Data/DataFrame.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame.hs @@ -0,0 +1,26 @@ +module Data.DataFrame + ( module D, + (|>) + ) +where + +import Data.DataFrame.Internal.Types as D +import Data.DataFrame.Internal.Function as D +import Data.DataFrame.Internal.Parsing as D +import Data.DataFrame.Internal.Column as D +import Data.DataFrame.Internal.DataFrame as D hiding (columnIndices, columns) +import Data.DataFrame.Internal.Row as D hiding (mkRowRep) +import Data.DataFrame.Errors as D +import Data.DataFrame.Operations.Core as D +import Data.DataFrame.Operations.Subset as D +import Data.DataFrame.Operations.Sorting as D +import Data.DataFrame.Operations.Statistics as D +import Data.DataFrame.Operations.Transformations as D +import Data.DataFrame.Operations.Typing as D +import Data.DataFrame.Operations.Aggregation as D +import Data.DataFrame.Display.Terminal.Plot as D +import Data.DataFrame.IO.CSV as D + +import Data.Function + +(|>) = (&) diff --git a/src/Data/DataFrame/Display/Terminal/Colours.hs b/src/Data/DataFrame/Display/Terminal/Colours.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Display/Terminal/Colours.hs @@ -0,0 +1,14 @@ +module Data.DataFrame.Display.Terminal.Colours where + +-- terminal color functions +red :: String -> String +red s = "\ESC[31m" ++ s ++ "\ESC[0m" + +green :: String -> String +green s = "\ESC[32m" ++ s ++ "\ESC[0m" + +brightGreen :: String -> String +brightGreen s = "\ESC[92m" ++ s ++ "\ESC[0m" + +brightBlue :: String -> String +brightBlue s = "\ESC[94m" ++ s ++ "\ESC[0m" diff --git a/src/Data/DataFrame/Display/Terminal/Plot.hs b/src/Data/DataFrame/Display/Terminal/Plot.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Display/Terminal/Plot.hs @@ -0,0 +1,340 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE TupleSections #-} +module Data.DataFrame.Display.Terminal.Plot where + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Unboxed as VU +import qualified Type.Reflection as Ref + +import Control.Monad ( forM_, forM ) +import Data.Bifunctor ( first ) +import Data.Char ( ord, chr ) +import Data.DataFrame.Display.Terminal.Colours +import Data.DataFrame.Internal.Column (Column(..)) +import Data.DataFrame.Internal.DataFrame (DataFrame(..)) +import Data.DataFrame.Internal.Types (Columnable) +import Data.DataFrame.Operations.Core +import Data.Maybe (fromMaybe) +import Data.Typeable (Typeable) +import Data.Type.Equality + ( type (:~:)(Refl), TestEquality(testEquality) ) +import GHC.Stack (HasCallStack) +import Text.Printf ( printf ) +import Type.Reflection (typeRep) + +data HistogramOrientation = VerticalHistogram | HorizontalHistogram + +data PlotColumns = PlotAll | PlotSubset [T.Text] + +plotHistograms :: HasCallStack => PlotColumns -> HistogramOrientation -> DataFrame -> IO () +plotHistograms plotSet orientation df = do + let cs = case plotSet of + PlotAll -> columnNames df + PlotSubset xs -> columnNames df `L.intersect` xs + forM_ cs $ \cname -> do + plotForColumn cname ((V.!) (columns df) (columnIndices df M.! cname)) orientation df + + +plotHistogramsBy :: HasCallStack => T.Text -> PlotColumns -> HistogramOrientation -> DataFrame -> IO () +plotHistogramsBy col plotSet orientation df = do + let cs = case plotSet of + PlotAll -> columnNames df + PlotSubset xs -> columnNames df `L.intersect` xs + forM_ cs $ \cname -> do + let plotColumn = (V.!) (columns df) (columnIndices df M.! cname) + let byColumn = (V.!) (columns df) (columnIndices df M.! col) + plotForColumnBy col cname byColumn plotColumn orientation df + +-- Plot code adapted from: https://alexwlchan.net/2018/ascii-bar-charts/ +plotForColumnBy :: HasCallStack => T.Text -> T.Text -> Maybe Column -> Maybe Column -> HistogramOrientation -> DataFrame -> IO () +plotForColumnBy _ _ Nothing _ _ _ = return () +plotForColumnBy byCol cname (Just (BoxedColumn (byColumn :: V.Vector a))) (Just (BoxedColumn (plotColumn :: V.Vector b))) orientation df = do + let zipped = VG.zipWith (\left right -> (show left, show right)) plotColumn byColumn + let counts = countOccurrences zipped + if null counts || length counts > 20 + then pure () + else case orientation of + VerticalHistogram -> error "Vertical histograms aren't yet supported" + HorizontalHistogram -> plotGivenCounts' cname counts +plotForColumnBy byCol cname (Just (UnboxedColumn byColumn)) (Just (BoxedColumn plotColumn)) orientation df = do + let zipped = VG.zipWith (\left right -> (show left, show right)) plotColumn (V.convert byColumn) + let counts = countOccurrences zipped + if null counts || length counts > 20 + then pure () + else case orientation of + VerticalHistogram -> error "Vertical histograms aren't yet supported" + HorizontalHistogram -> plotGivenCounts' cname counts +plotForColumnBy byCol cname (Just (BoxedColumn byColumn)) (Just (UnboxedColumn plotColumn)) orientation df = do + let zipped = VG.zipWith (\left right -> (show left, show right)) (V.convert plotColumn) (V.convert byColumn) + let counts = countOccurrences zipped + if null counts || length counts > 20 + then pure () + else case orientation of + -- VerticalHistogram -> plotVerticalGivenCounts cname counts + HorizontalHistogram -> plotGivenCounts' cname counts +plotForColumnBy byCol cname (Just (UnboxedColumn byColumn)) (Just (UnboxedColumn plotColumn)) orientation df = do + let zipped = VG.zipWith (\left right -> (show left, show right)) (V.convert plotColumn) (V.convert byColumn) + let counts = countOccurrences zipped + if null counts || length counts > 20 + then pure () + else case orientation of + VerticalHistogram -> error "Vertical histograms aren't yet supported" + HorizontalHistogram -> plotGivenCounts' cname counts +-- TODO: Add Optional columns +plotForColumnBy _ _ _ _ _ _ = return () + +-- Plot code adapted from: https://alexwlchan.net/2018/ascii-bar-charts/ +plotForColumn :: HasCallStack => T.Text -> Maybe Column -> HistogramOrientation -> DataFrame -> IO () +plotForColumn _ Nothing _ _ = return () +plotForColumn cname (Just (BoxedColumn (column :: V.Vector a))) orientation df = do + let repa :: Ref.TypeRep a = Ref.typeRep @a + repText :: Ref.TypeRep T.Text = Ref.typeRep @T.Text + repString :: Ref.TypeRep String = Ref.typeRep @String + let counts = case repa `testEquality` repText of + Just Refl -> map (first T.unpack) $ valueCounts @T.Text cname df + Nothing -> case repa `testEquality` repString of + Just Refl -> valueCounts @String cname df + -- Support other scalar types. + Nothing -> [] -- numericHistogram column + if null counts || length counts > 20 + then putStrLn $ numericHistogram cname (V.convert column) + else case orientation of + VerticalHistogram -> plotVerticalGivenCounts cname counts + HorizontalHistogram -> plotGivenCounts cname counts +plotForColumn cname (Just (UnboxedColumn (column :: VU.Vector a))) orientation df = do + let repa :: Ref.TypeRep a = Ref.typeRep @a + repText :: Ref.TypeRep T.Text = Ref.typeRep @T.Text + repString :: Ref.TypeRep String = Ref.typeRep @String + let counts = case repa `testEquality` repText of + Just Refl -> map (first show) $ valueCounts @T.Text cname df + Nothing -> case repa `testEquality` repString of + Just Refl -> valueCounts @String cname df + -- Support other scalar types. + Nothing -> [] + if null counts || length counts > 20 + then putStrLn $ numericHistogram cname (V.convert column) + else case orientation of + VerticalHistogram -> plotVerticalGivenCounts cname counts + HorizontalHistogram -> plotGivenCounts cname counts +plotForColumn _ _ _ _ = return () + +plotGivenCounts :: HasCallStack => T.Text -> [(String, Int)] -> IO () +plotGivenCounts cname counts = do + putStrLn $ "\nHistogram for " ++ show cname ++ "\n" + let n = 8 :: Int + let maxValue = maximum $ map snd counts + let increment = max 1 (maxValue `div` 50) + let longestLabelLength = maximum $ map (length . fst) counts + let longestBar = fromIntegral $ (maxValue * fromIntegral n `div` increment) `div` fromIntegral n + 1 + let border = "|" ++ replicate (longestLabelLength + length (show maxValue) + longestBar + 6) '-' ++ "|" + body <- forM counts $ \(label, count) -> do + let barChunks = fromIntegral $ (count * fromIntegral n `div` increment) `div` fromIntegral n + let remainder = fromIntegral $ (count * fromIntegral n `div` increment) `rem` fromIntegral n + let fractional = ([chr (ord '█' + n - remainder - 1) | remainder > 0]) + let bar = replicate barChunks '█' ++ fractional + let disp = if null bar then "| " else bar + let hist= "|" ++ brightGreen (leftJustify label longestLabelLength) ++ " | " ++ + leftJustify (show count) (length (show maxValue)) ++ " |" ++ + " " ++ brightBlue bar + return $ hist ++ "\n" ++ border + mapM_ putStrLn (border : body) + putChar '\n' + +plotVerticalGivenCounts :: HasCallStack => T.Text -> [(String, Int)] -> IO () +plotVerticalGivenCounts cname counts' = do + putStrLn $ "\nHistogram for " ++ show cname ++ "\n" + let n = 8 :: Int + let clip s = if length s > n then take n s ++ ".." else s + let counts = map (first clip) counts' + let maxValue = maximum $ map snd counts + let increment = max 1 (maxValue `div` 10) + let longestLabelLength = 2 + maximum (map (length . fst) counts) + let longestBar = fromIntegral $ (maxValue * fromIntegral n `div` increment) `div` fromIntegral n + 1 + let border = "‾" ++ replicate (longestBar + 1) '|' ++ "+" + let maximumLineLength = length border + body <- forM counts $ \(label, count) -> do + let barChunks = fromIntegral $ (count * fromIntegral n `div` increment) `div` fromIntegral n + let remainder = fromIntegral $ (count * fromIntegral n `div` increment) `rem` fromIntegral n + let fractional = ([chr (ord '█' - (n - remainder - 1)) | remainder > 0]) + let bar = replicate barChunks '█' ++ fractional + let disp = if null bar then "| " else bar + let hist = "‾" ++ bar + return $ replicate longestLabelLength (leftJustify hist maximumLineLength) ++ [border] + let fullGraph = map brightBlue $ rotate $ border : concat body + let partition = smallestPartition increment intPlotRanges + let increments = reverse [0, maxValue `div` 2 , maxValue + partition] + let incString = reverse $ map (`leftJustify` (length (show maxValue) + 1)) $ show 0 : replicate (length fullGraph `div` 2 - 2) " " + ++ [show (maxValue `div` 2)] + ++ replicate (length fullGraph `div` 2 - 2) " " + ++ [show (maxValue + partition)] + ++ [""] + mapM_ putStrLn (zipWith (++) incString fullGraph) + putStrLn $ " " ++ replicate (length (show maxValue) + 1) ' ' ++ unwords (map (brightGreen . flip leftJustify longestLabelLength . fst) counts) + putChar '\n' + +leftJustify :: String -> Int -> String +leftJustify s n = s ++ replicate (max 0 (n - length s)) ' ' + + +plotGivenCounts' :: HasCallStack => T.Text -> [((String, String), Int)] -> IO () +plotGivenCounts' cname counts = do + putStrLn $ "\nHistogram for " ++ show cname ++ "\n" + let n = 8 :: Int + let maxValue = maximum $ map snd counts + let increment = max 1 (maxValue `div` 50) + let longestLabelLength = maximum $ map (length. (\(a, b) -> a ++ " " ++ b) . fst) counts + let longestBar = fromIntegral $ (maxValue * fromIntegral n `div` increment) `div` fromIntegral n + 1 + let border = "|" ++ replicate (longestLabelLength + length (show maxValue) + longestBar + 6) '-' ++ "|" + body <- forM counts $ \((plotCol, byCol), count) -> do + let barChunks = fromIntegral $ (count * fromIntegral n `div` increment) `div` fromIntegral n + let remainder = fromIntegral $ (count * fromIntegral n `div` increment) `rem` fromIntegral n + let fractional = ([chr (ord '█' + n - remainder - 1) | remainder > 0]) + let bar = replicate barChunks '█' ++ fractional + let disp = if null bar then "| " else bar + let label = plotCol ++ " " ++ byCol + let hist= "|" ++ brightGreen (leftJustify label longestLabelLength) ++ " | " ++ + leftJustify (show count) (length (show maxValue)) ++ " |" ++ + " " ++ brightBlue bar + return $ hist ++ "\n" ++ border + mapM_ putStrLn (border : body) + putChar '\n' + +numericHistogram :: forall a . (HasCallStack, Columnable a) + => T.Text + -> V.Vector a + -> String +numericHistogram name xs = let + config = defaultConfig { + title = Just (T.unpack name), + width = 30, + height = 10 + } + in createHistogram config (V.toList xs') + where + xs' = case testEquality (typeRep @a) (typeRep @Double) of + Just Refl -> xs + Nothing -> case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> V.map fromIntegral xs + Nothing -> case testEquality (typeRep @a) (typeRep @Integer) of + Just Refl -> V.map fromIntegral xs + Nothing -> V.empty + +smallestPartition :: (Ord a) => a -> [a] -> a +-- TODO: Find a more graceful way to handle this. +smallestPartition p [] = error "Data range too large to plot" +smallestPartition p (x:y:rest) + | p < y = x + | otherwise = smallestPartition p (y:rest) +smallestPartition p (x:rest) + | p < x = x + | otherwise = error "" + +largestPartition :: (Ord a) => a -> [a] -> a +-- TODO: Find a more graceful way to handle this. +largestPartition p [] = error "Data range too large to plot" +largestPartition p (x:rest) + | p < x = x + | otherwise = largestPartition p rest + +intPlotRanges :: [Int] +intPlotRanges = [1, 5, + 10, 50, + 100, 500, + 1_000, 5_000, + 10_000, 50_000, + 100_000, 500_000, + 1_000_000, 5_000_000] + +rotate :: [String] -> [String] +rotate [] = [] +rotate xs + | head xs == "" = [] + | otherwise = map last xs : rotate (map init xs) + + +countOccurrences :: Ord a => V.Vector a -> [(a, Int)] +countOccurrences xs = M.toList $ VG.foldr count initMap xs + where initMap = M.fromList (map (, 0) (V.toList xs)) + count k = M.insertWith (+) k 1 + +data HistogramConfig = HistogramConfig { + width :: Int, -- Width of the histogram in characters + height :: Int, -- Height of the histogram in rows + barChar :: Char, -- Character to use for bars + title :: Maybe String -- Optional title for the histogram +} + +defaultConfig :: HistogramConfig +defaultConfig = HistogramConfig { + width = 40, + height = 15, + barChar = '█', + title = Nothing +} + +-- Calculate the histogram bins and counts +calculateBins :: [Double] -> Int -> [(Double, Int)] +calculateBins values numBins = + let minVal = minimum values + maxVal = maximum values + binWidth = (maxVal - minVal) / fromIntegral numBins + toBin x = floor ((x - minVal) / binWidth) + bins = map toBin values + counts = map length . L.group . L.sort $ bins + binValues = [minVal + (fromIntegral i * binWidth) | i <- [0..numBins-1]] + in zip binValues (counts ++ repeat 0) + +-- Format a number with appropriate scaling (k, M, B, etc.) +formatNumber :: Double -> String +formatNumber n + | n >= 1e9 = printf "%.1fB" (n / 1e9) + | n >= 1e6 = printf "%.1fM" (n / 1e6) + | n >= 1e3 = printf "%.1fk" (n / 1e3) + | otherwise = printf "%.1f" n + +-- Create the ASCII histogram +createHistogram :: HistogramConfig -> [Double] -> String +createHistogram _ [] = [] +createHistogram config values = + let bins = calculateBins values (width config) + maxCount = maximum $ map snd bins + scaleY = fromIntegral maxCount / fromIntegral (height config) + + -- Create Y-axis labels + yLabels = [formatNumber (fromIntegral i * scaleY) | i <- [height config, height config-1..0]] + maxYLabelWidth = maximum $ map length yLabels + + -- Create X-axis labels + xValues = map fst bins + xLabels = map formatNumber [head xValues, last xValues] + + -- Create histogram rows + makeRow :: Int -> String + makeRow row = + let threshold = fromIntegral (height config - row) * scaleY + barLine = map (\(_, count) -> + if fromIntegral count >= threshold + then barChar config + else ' ') bins + in printf "%*s |%s" maxYLabelWidth (yLabels !! row) (brightBlue $ L.foldl' (\acc c -> c:'|':acc) "" barLine) + + -- Build the complete histogram + histogramRows = map makeRow [0..height config - 1] + xAxis = replicate maxYLabelWidth ' ' ++ " " ++ + L.intercalate (replicate (2 * (width config - length xLabels)) ' ') xLabels + + -- Add title if provided + titleLine = case title config of + Just t -> t ++ "\n\n" + Nothing -> "" + + in titleLine ++ unlines (histogramRows ++ [xAxis]) diff --git a/src/Data/DataFrame/Display/Terminal/PrettyPrint.hs b/src/Data/DataFrame/Display/Terminal/PrettyPrint.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Display/Terminal/PrettyPrint.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +module Data.DataFrame.Display.Terminal.PrettyPrint where + +import qualified Data.Text as T + +import Data.List (transpose) + +-- Utility functions to show a DataFrame as a Markdown-ish table. + +-- Adapted from: https://stackoverflow.com/questions/5929377/format-list-output-in-haskell +-- a type for fill functions +type Filler = Int -> T.Text -> T.Text + +-- a type for describing table columns +data ColDesc t = ColDesc + { colTitleFill :: Filler, + colTitle :: T.Text, + colValueFill :: Filler + } + +-- functions that fill a string (s) to a given width (n) by adding pad +-- character (c) to align left, right, or center +fillLeft :: Char -> Int -> T.Text -> T.Text +fillLeft c n s = s `T.append` T.replicate (n - T.length s) (T.singleton c) + +fillRight :: Char -> Int -> T.Text -> T.Text +fillRight c n s = T.replicate (n - T.length s) (T.singleton c) `T.append` s + +fillCenter :: Char -> Int -> T.Text -> T.Text +fillCenter c n s = T.replicate l (T.singleton c) `T.append` s `T.append` T.replicate r (T.singleton c) + where + x = n - T.length s + l = x `div` 2 + r = x - l + +-- functions that fill with spaces +left :: Int -> T.Text -> T.Text +left = fillLeft ' ' + +right :: Int -> T.Text -> T.Text +right = fillRight ' ' + +center :: Int -> T.Text -> T.Text +center = fillCenter ' ' + +showTable :: [T.Text] -> [T.Text] -> [[T.Text]] -> T.Text +showTable header types rows = + let cs = map (\h -> ColDesc center h left) header + widths = [maximum $ map T.length col | col <- transpose $ header : types : rows] + border = T.intercalate "---" [T.replicate width (T.singleton '-') | width <- widths] + separator = T.intercalate "-|-" [T.replicate width (T.singleton '-') | width <- widths] + fillCols fill cols = T.intercalate " | " [fill c width col | (c, width, col) <- zip3 cs widths cols] + in T.unlines $ border : fillCols colTitleFill header : separator : fillCols colTitleFill types : separator : map (fillCols colValueFill) rows diff --git a/src/Data/DataFrame/Errors.hs b/src/Data/DataFrame/Errors.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Errors.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} + +module Data.DataFrame.Errors where + +import qualified Data.Text as T + +import Control.Exception +import Data.Array +import Data.DataFrame.Display.Terminal.Colours +import Data.Typeable (Typeable) +import Type.Reflection (TypeRep) + +data DataFrameException where + TypeMismatchException :: forall a b. (Typeable a, Typeable b) + => TypeRep a -- ^ given type + -> TypeRep b -- ^ expected type + -> T.Text -- ^ column name + -> T.Text -- ^ call point + -> DataFrameException + TypeMismatchException' :: forall a . (Typeable a) + => TypeRep a -- ^ expected type + -> String -- ^ given type + -> T.Text -- ^ column name + -> T.Text -- ^ call point + -> DataFrameException + ColumnNotFoundException :: T.Text -> T.Text -> [T.Text] -> DataFrameException + deriving (Exception) + +instance Show DataFrameException where + show :: DataFrameException -> String + show (TypeMismatchException a b columnName callPoint) = addCallPointInfo columnName (Just callPoint) (typeMismatchError a b) + show (TypeMismatchException' a b columnName callPoint) = addCallPointInfo columnName (Just callPoint) (typeMismatchError' (show a) b) + show (ColumnNotFoundException columnName callPoint availableColumns) = columnNotFound columnName callPoint availableColumns + +columnNotFound :: T.Text -> T.Text -> [T.Text] -> String +columnNotFound name callPoint columns = + red "\n\n[ERROR] " + ++ "Column not found: " + ++ T.unpack name + ++ " for operation " + ++ T.unpack callPoint + ++ "\n\tDid you mean " + ++ T.unpack (guessColumnName name columns) + ++ "?\n\n" + +typeMismatchError :: + Type.Reflection.TypeRep a -> + Type.Reflection.TypeRep b -> + String +typeMismatchError a b = typeMismatchError' (show a) (show b) + +typeMismatchError' :: String -> String -> String +typeMismatchError' givenType expectedType = + red $ + red "\n\n[Error]: Type Mismatch" + ++ "\n\tWhile running your code I tried to " + ++ "get a column of type: " + ++ red (show givenType) + ++ " but column was of type: " + ++ green (show expectedType) + +addCallPointInfo :: T.Text -> Maybe T.Text -> String -> String +addCallPointInfo name (Just cp) err = + err + ++ ( "\n\tThis happened when calling function " + ++ brightGreen (T.unpack cp) + ++ " on the column " + ++ brightGreen (T.unpack name) + ++ "\n\n" + ++ typeAnnotationSuggestion (T.unpack cp) + ) +addCallPointInfo name Nothing err = + err + ++ ( "\n\tOn the column " + ++ T.unpack name + ++ "\n\n" + ++ typeAnnotationSuggestion "" + ) + +typeAnnotationSuggestion :: String -> String +typeAnnotationSuggestion cp = + "\n\n\tTry adding a type at the end of the function e.g " + ++ "change\n\t\t" + ++ red (cp ++ " arg1 arg2") + ++ " to \n\t\t" + ++ green ("(" ++ cp ++ " arg1 arg2 :: )") + ++ "\n\tor add " + ++ "{-# LANGUAGE TypeApplications #-} to the top of your " + ++ "file then change the call to \n\t\t" + ++ brightGreen (cp ++ " @ arg1 arg2") + +guessColumnName :: T.Text -> [T.Text] -> T.Text +guessColumnName userInput columns = case map (\k -> (editDistance userInput k, k)) columns of + [] -> "" + res -> (snd . minimum) res + +editDistance :: T.Text -> T.Text -> Int +editDistance xs ys = table ! (m, n) + where + (m, n) = (T.length xs, T.length ys) + x = array (1, m) (zip [1 ..] (T.unpack xs)) + y = array (1, n) (zip [1 ..] (T.unpack ys)) + + table :: Array (Int, Int) Int + table = array bnds [(ij, dist ij) | ij <- range bnds] + bnds = ((0, 0), (m, n)) + + dist (0, j) = j + dist (i, 0) = i + dist (i, j) = + minimum + [ table ! (i - 1, j) + 1, + table ! (i, j - 1) + 1, + if x ! i == y ! j then table ! (i - 1, j - 1) else 1 + table ! (i - 1, j - 1) + ] diff --git a/src/Data/DataFrame/IO/CSV.hs b/src/Data/DataFrame/IO/CSV.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/IO/CSV.hs @@ -0,0 +1,297 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Strict #-} +module Data.DataFrame.IO.CSV where + +import qualified Data.ByteString.Char8 as C +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TLIO +import qualified Data.Text.IO as TIO +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Mutable as VM +import qualified Data.Vector.Unboxed.Mutable as VUM + +import Control.Applicative ((<$>), (<|>), (<*>), (<*), (*>), many) +import Control.Monad (forM_, zipWithM_, unless, void) +import Data.Attoparsec.Text +import Data.Char +import Data.DataFrame.Internal.Column (Column(..), freezeColumn', writeColumn, columnLength) +import Data.DataFrame.Internal.DataFrame (DataFrame(..)) +import Data.DataFrame.Internal.Parsing +import Data.DataFrame.Operations.Typing +import Data.Function (on) +import Data.IORef +import Data.Maybe +import Data.Text.Encoding (decodeUtf8Lenient) +import Data.Type.Equality + ( TestEquality (testEquality), + type (:~:) (Refl) + ) +import GHC.IO.Handle (Handle) +import Prelude hiding (concat, takeWhile) +import System.IO +import Type.Reflection + +-- | Record for CSV read options. +data ReadOptions = ReadOptions { + hasHeader :: Bool, + inferTypes :: Bool, + safeRead :: Bool +} + +-- | By default we assume the file has a header, we infer the types on read +-- and we convert any rows with nullish objects into Maybe (safeRead). +defaultOptions :: ReadOptions +defaultOptions = ReadOptions { hasHeader = True, inferTypes = True, safeRead = True } + +-- | Reads a CSV file from the given path. +-- Note this file stores intermediate temporary files +-- while converting the CSV from a row to a columnar format. +readCsv :: String -> IO DataFrame +readCsv = readSeparated ',' defaultOptions + +-- | Reads a tab separated file from the given path. +-- Note this file stores intermediate temporary files +-- while converting the CSV from a row to a columnar format. +readTsv :: String -> IO DataFrame +readTsv = readSeparated '\t' defaultOptions + +-- | Reads a character separated file into a dataframe using mutable vectors. +readSeparated :: Char -> ReadOptions -> String -> IO DataFrame +readSeparated c opts path = do + totalRows <- countRows c path + withFile path ReadMode $ \handle -> do + firstRow <- map T.strip . parseSep c <$> TIO.hGetLine handle + let columnNames = if hasHeader opts + then map (T.filter (/= '\"')) firstRow + else map (T.singleton . intToDigit) [0..(length firstRow - 1)] + -- If there was no header rewind the file cursor. + unless (hasHeader opts) $ hSeek handle AbsoluteSeek 0 + + -- Initialize mutable vectors for each column + let numColumns = length columnNames + let numRows = if hasHeader opts then totalRows - 1 else totalRows + -- Use this row to infer the types of the rest of the column. + -- TODO: this isn't robust but in so far as this is a guess anyway + -- it's probably fine. But we should probably sample n rows and pick + -- the most likely type from the sample. + dataRow <- map T.strip . parseSep c <$> TIO.hGetLine handle + + -- This array will track the indices of all null values for each column. + -- If any exist then the column will be an optional type. + nullIndices <- VM.unsafeNew numColumns + VM.set nullIndices [] + mutableCols <- VM.unsafeNew numColumns + getInitialDataVectors numRows mutableCols dataRow + + -- Read rows into the mutable vectors + fillColumns numRows c mutableCols nullIndices handle + + -- Freeze the mutable vectors into immutable ones + nulls' <- V.unsafeFreeze nullIndices + cols <- V.mapM (freezeColumn mutableCols nulls' opts) (V.generate numColumns id) + return $ DataFrame { + columns = cols, + freeIndices = [], + columnIndices = M.fromList (zip columnNames [0..]), + dataframeDimensions = (maybe 0 columnLength (cols V.! 0), V.length cols) + } +{-# INLINE readSeparated #-} + +getInitialDataVectors :: Int -> VM.IOVector Column -> [T.Text] -> IO () +getInitialDataVectors n mCol xs = do + forM_ (zip [0..] xs) $ \(i, x) -> do + col <- case inferValueType x of + "Int" -> MutableUnboxedColumn <$> ((VUM.unsafeNew n :: IO (VUM.IOVector Int)) >>= \c -> VUM.unsafeWrite c 0 (fromMaybe 0 $ readInt x) >> return c) + "Double" -> MutableUnboxedColumn <$> ((VUM.unsafeNew n :: IO (VUM.IOVector Double)) >>= \c -> VUM.unsafeWrite c 0 (fromMaybe 0 $ readDouble x) >> return c) + _ -> MutableBoxedColumn <$> ((VM.unsafeNew n :: IO (VM.IOVector T.Text)) >>= \c -> VM.unsafeWrite c 0 x >> return c) + VM.unsafeWrite mCol i col +{-# INLINE getInitialDataVectors #-} + +inferValueType :: T.Text -> T.Text +inferValueType s = let + example = s + in case readInt example of + Just _ -> "Int" + Nothing -> case readDouble example of + Just _ -> "Double" + Nothing -> "Other" +{-# INLINE inferValueType #-} + +-- | Reads rows from the handle and stores values in mutable vectors. +fillColumns :: Int -> Char -> VM.IOVector Column -> VM.IOVector [(Int, T.Text)] -> Handle -> IO () +fillColumns n c mutableCols nullIndices handle = do + input <- newIORef (mempty :: T.Text) + forM_ [1..n] $ \i -> do + isEOF <- hIsEOF handle + input' <- readIORef input + unless (isEOF && input' == mempty) $ do + parseWith (TIO.hGetChunk handle) (parseRow c) input' >>= \case + Fail unconsumed ctx er -> do + erpos <- hTell handle + fail $ "Failed to parse CSV file around " <> show erpos <> " byte; due: " + <> show er <> "; context: " <> show ctx + Partial c -> do + fail "Partial handler is called" + Done (unconsumed :: T.Text) (row :: [T.Text]) -> do + writeIORef input unconsumed + zipWithM_ (writeValue mutableCols nullIndices i) [0..] row +{-# INLINE fillColumns #-} + +-- | Writes a value into the appropriate column, resizing the vector if necessary. +writeValue :: VM.IOVector Column -> VM.IOVector [(Int, T.Text)] -> Int -> Int -> T.Text -> IO () +writeValue mutableCols nullIndices count colIndex value = do + col <- VM.unsafeRead mutableCols colIndex + res <- writeColumn count value col + let modify value = VM.unsafeModify nullIndices ((count, value) :) colIndex + either modify (const (return ())) res +{-# INLINE writeValue #-} + +-- | Freezes a mutable vector into an immutable one, trimming it to the actual row count. +freezeColumn :: VM.IOVector Column -> V.Vector [(Int, T.Text)] -> ReadOptions -> Int -> IO (Maybe Column) +freezeColumn mutableCols nulls opts colIndex = do + col <- VM.unsafeRead mutableCols colIndex + Just <$> freezeColumn' (nulls V.! colIndex) col +{-# INLINE freezeColumn #-} + +parseSep :: Char -> T.Text -> [T.Text] +parseSep c s = either error id (parseOnly (record c) s) +{-# INLINE parseSep #-} + +record :: Char -> Parser [T.Text] +record c = + field c `sepBy1` char c + "record" +{-# INLINE record #-} + +parseRow :: Char -> Parser [T.Text] +parseRow c = (record c <* lineEnd) "record-new-line" + +field :: Char -> Parser T.Text +field c = + quotedField <|> unquotedField c + "field" +{-# INLINE field #-} + +unquotedField :: Char -> Parser T.Text +unquotedField sep = + takeWhile nonTerminal "unquoted field" + where nonTerminal = (`S.notMember` S.fromList [sep, '\n', '\r', '"']) +{-# INLINE unquotedField #-} + +insideQuotes :: Parser T.Text +insideQuotes = + T.append <$> takeWhile (/= '"') + <*> (T.concat <$> many (T.cons <$> dquotes <*> insideQuotes)) + "inside of double quotes" + where + dquotes = + string "\"\"" >> return '"' + "paired double quotes" +{-# INLINE insideQuotes #-} + +quotedField :: Parser T.Text +quotedField = + char '"' *> insideQuotes <* char '"' + "quoted field" +{-# INLINE quotedField #-} + +lineEnd :: Parser () +lineEnd = + (endOfLine <|> endOfInput) + "end of line" +{-# INLINE lineEnd #-} + +-- | First pass to count rows for exact allocation +countRows :: Char -> FilePath -> IO Int +countRows c path = withFile path ReadMode $! go 0 "" + where + go !n !input h = do + isEOF <- hIsEOF h + if isEOF && input == mempty + then pure n + else + parseWith (TIO.hGetChunk h) (parseRow c) input >>= \case + Fail unconsumed ctx er -> do + erpos <- hTell h + fail $ "Failed to parse CSV file around " <> show erpos <> " byte; due: " + <> show er <> "; context: " <> show ctx + Partial c -> do + fail $ "Partial handler is called; n = " <> show n + Done (unconsumed :: T.Text) _ -> + go (n + 1) unconsumed h +{-# INLINE countRows #-} + +writeCsv :: String -> DataFrame -> IO () +writeCsv = writeSeparated ',' + +writeSeparated :: Char -- ^ Separator + -> String -- ^ Path to write to + -> DataFrame + -> IO () +writeSeparated c filepath df = withFile filepath WriteMode $ \handle ->do + let (rows, columns) = dataframeDimensions df + let headers = map fst (L.sortBy (compare `on` snd) (M.toList (columnIndices df))) + TIO.hPutStrLn handle (T.intercalate ", " headers) + forM_ [0..(rows - 1)] $ \i -> do + let row = getRowAsText df i + TIO.hPutStrLn handle (T.intercalate ", " row) + +getRowAsText :: DataFrame -> Int -> [T.Text] +getRowAsText df i = V.ifoldr go [] (columns df) + where + indexMap = M.fromList (map (\(a, b) -> (b, a)) $ M.toList (columnIndices df)) + go k Nothing acc = acc + go k (Just (BoxedColumn (c :: V.Vector a))) acc = case c V.!? i of + Just e -> textRep : acc + where textRep = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> e + Nothing -> case typeRep @a of + App t1 t2 -> case eqTypeRep t1 (typeRep @Maybe) of + Just HRefl -> case testEquality t2 (typeRep @T.Text) of + Just Refl -> fromMaybe "null" e + Nothing -> (fromOptional . (T.pack . show)) e + where fromOptional s + | T.isPrefixOf "Just " s = T.drop (T.length "Just ") s + | otherwise = "null" + Nothing -> (T.pack . show) e + _ -> (T.pack . show) e + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i + go k (Just (UnboxedColumn c)) acc = case c VU.!? i of + Just e -> T.pack (show e) : acc + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i + go k (Just (OptionalColumn (c :: V.Vector (Maybe a)))) acc = case c V.!? i of + Just e -> textRep : acc + where textRep = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> fromMaybe "Nothing" e + Nothing -> (T.pack . show) e + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i diff --git a/src/Data/DataFrame/Internal/Column.hs b/src/Data/DataFrame/Internal/Column.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Internal/Column.hs @@ -0,0 +1,467 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Data.DataFrame.Internal.Column where + +import qualified Data.ByteString.Char8 as C +import qualified Data.List as L +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector.Algorithms.Merge as VA +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as VB +import qualified Data.Vector.Mutable as VBM +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Unboxed.Mutable as VUM + +import Control.Monad.ST (runST) +import Data.DataFrame.Internal.Function +import Data.DataFrame.Internal.Types +import Data.DataFrame.Internal.Parsing +import Data.Int +import Data.Maybe +import Data.Text.Encoding (decodeUtf8Lenient) +import Data.Type.Equality (type (:~:)(Refl), TestEquality (..)) +import Data.Typeable (Typeable) +import Data.Word +import Type.Reflection + +-- | Our representation of a column is a GADT that can store data in either +-- a vector with boxed elements or +data Column where + BoxedColumn :: Columnable a => VB.Vector a -> Column + UnboxedColumn :: (Columnable a, VU.Unbox a) => VU.Vector a -> Column + OptionalColumn :: Columnable a => VB.Vector (Maybe a) -> Column + GroupedBoxedColumn :: Columnable a => VB.Vector (VB.Vector a) -> Column + GroupedUnboxedColumn :: (Columnable a, VU.Unbox a) => VB.Vector (VU.Vector a) -> Column + GroupedOptionalColumn :: (Columnable a) => VB.Vector (VB.Vector (Maybe a)) -> Column + MutableBoxedColumn :: Columnable a => VBM.IOVector a -> Column + MutableUnboxedColumn :: (Columnable a, VU.Unbox a) => VUM.IOVector a -> Column + +-- Functions about column metadata. +isGrouped :: Column -> Bool +isGrouped (GroupedBoxedColumn column) = True +isGrouped (GroupedUnboxedColumn column) = True +isGrouped _ = False + +columnVersionString :: Column -> String +columnVersionString column = case column of + BoxedColumn _ -> "Boxed" + UnboxedColumn _ -> "Unboxed" + OptionalColumn _ -> "Optional" + GroupedBoxedColumn _ -> "Grouped Boxed" + GroupedUnboxedColumn _ -> "Grouped Unboxed" + GroupedOptionalColumn _ -> "Grouped Optional" + +columnTypeString :: Column -> String +columnTypeString column = case column of + BoxedColumn (column :: VB.Vector a) -> show (typeRep @a) + UnboxedColumn (column :: VU.Vector a) -> show (typeRep @a) + OptionalColumn (column :: VB.Vector a) -> show (typeRep @a) + GroupedBoxedColumn (column :: VB.Vector a) -> show (typeRep @a) + GroupedUnboxedColumn (column :: VB.Vector a) -> show (typeRep @a) + GroupedOptionalColumn (column :: VB.Vector a) -> show (typeRep @a) + +instance Show Column where + show :: Column -> String + show (BoxedColumn column) = show column + show (UnboxedColumn column) = show column + show (OptionalColumn column) = show column + show (GroupedBoxedColumn column) = show column + show (GroupedUnboxedColumn column) = show column + +instance Eq Column where + (==) :: Column -> Column -> Bool + (==) (BoxedColumn (a :: VB.Vector t1)) (BoxedColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> a == b + (==) (OptionalColumn (a :: VB.Vector t1)) (OptionalColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> a == b + (==) (UnboxedColumn (a :: VU.Vector t1)) (UnboxedColumn (b :: VU.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> a == b + -- Note: comparing grouped columns is expensive. We do this for stable tests + -- but also you should probably aggregate grouped columns soon after creating them. + (==) (GroupedBoxedColumn (a :: VB.Vector t1)) (GroupedBoxedColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> VB.map (L.sort . VG.toList) a == VB.map (L.sort . VG.toList) b + (==) (GroupedUnboxedColumn (a :: VB.Vector t1)) (GroupedUnboxedColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> VB.map (L.sort . VG.toList) a == VB.map (L.sort . VG.toList) b + (==) (GroupedOptionalColumn (a :: VB.Vector t1)) (GroupedOptionalColumn (b :: VB.Vector t2)) = + case testEquality (typeRep @t1) (typeRep @t2) of + Nothing -> False + Just Refl -> VB.map (L.sort . VG.toList) a == VB.map (L.sort . VG.toList) b + (==) _ _ = False + +class (Columnable a) => Columnify a where + -- | Converts a boxed vector to a column making sure to put + -- the vector into an appropriate column type by reflection on the + -- vector's type parameter. + toColumn' :: VB.Vector a -> Column + +instance (Columnable a) => Columnify (Maybe a) where + toColumn' = OptionalColumn + +instance (Columnable a) => Columnify (VB.Vector a) where + toColumn' = GroupedBoxedColumn + +instance (Columnable a, VU.Unbox a) => Columnify (VU.Vector a) where + toColumn' = GroupedUnboxedColumn + +instance {-# INCOHERENT #-} (Columnable a) => Columnify a where + toColumn' xs = case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> UnboxedColumn (VU.convert xs) + Nothing -> case testEquality (typeRep @a) (typeRep @Double) of + Just Refl -> UnboxedColumn (VU.convert xs) + Nothing -> case testEquality (typeRep @a) (typeRep @Float) of + Just Refl -> UnboxedColumn (VU.convert xs) + Nothing -> BoxedColumn xs + +class (Columnable a) => ColumnifyList a where + -- | Converts a boxed vector to a column making sure to put + -- the vector into an appropriate column type by reflection on the + -- vector's type parameter. + toColumn :: [a] -> Column + +instance (Columnable a) => ColumnifyList (Maybe a) where + toColumn = OptionalColumn . VB.fromList + +instance {-# INCOHERENT #-} (Columnable a) => ColumnifyList a where + toColumn xs = case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> UnboxedColumn (VU.fromList xs) + Nothing -> case testEquality (typeRep @a) (typeRep @Double) of + Just Refl -> UnboxedColumn (VU.fromList xs) + Nothing -> case testEquality (typeRep @a) (typeRep @Float) of + Just Refl -> UnboxedColumn (VU.fromList xs) + Nothing -> BoxedColumn (VB.fromList xs) + +-- | Converts a an unboxed vector to a column making sure to put +-- the vector into an appropriate column type by reflection on the +-- vector's type parameter. +toColumnUnboxed :: forall a. (Columnable a, VU.Unbox a) => VU.Vector a -> Column +toColumnUnboxed = UnboxedColumn + +-- Functions that don't depend on column type. +-- | O(1) Gets the number of elements in the column. +columnLength :: Column -> Int +columnLength (BoxedColumn xs) = VG.length xs +columnLength (UnboxedColumn xs) = VG.length xs +columnLength (OptionalColumn xs) = VG.length xs +columnLength (GroupedBoxedColumn xs) = VG.length xs +columnLength (GroupedUnboxedColumn xs) = VG.length xs +columnLength (GroupedOptionalColumn xs) = VG.length xs +{-# INLINE columnLength #-} + +takeColumn :: Int -> Column -> Column +takeColumn n (BoxedColumn xs) = BoxedColumn $ VG.take n xs +takeColumn n (UnboxedColumn xs) = UnboxedColumn $ VG.take n xs +takeColumn n (OptionalColumn xs) = OptionalColumn $ VG.take n xs +takeColumn n (GroupedBoxedColumn xs) = GroupedBoxedColumn $ VG.take n xs +takeColumn n (GroupedUnboxedColumn xs) = GroupedUnboxedColumn $ VG.take n xs +takeColumn n (GroupedOptionalColumn xs) = GroupedOptionalColumn $ VG.take n xs +{-# INLINE takeColumn #-} + +-- TODO: Maybe we can remvoe all this boilerplate and make +-- transform take in a generic vector function. +takeLastColumn :: Int -> Column -> Column +takeLastColumn n column = sliceColumn (columnLength column - n) n column +{-# INLINE takeLastColumn #-} + +sliceColumn :: Int -> Int -> Column -> Column +sliceColumn start n (BoxedColumn xs) = BoxedColumn $ VG.slice start n xs +sliceColumn start n (UnboxedColumn xs) = UnboxedColumn $ VG.slice start n xs +sliceColumn start n (OptionalColumn xs) = OptionalColumn $ VG.slice start n xs +sliceColumn start n (GroupedBoxedColumn xs) = GroupedBoxedColumn $ VG.slice start n xs +sliceColumn start n (GroupedUnboxedColumn xs) = GroupedUnboxedColumn $ VG.slice start n xs +sliceColumn start n (GroupedOptionalColumn xs) = GroupedOptionalColumn $ VG.slice start n xs +{-# INLINE sliceColumn #-} + +-- TODO: We can probably generalize this to `applyVectorFunction`. +atIndices :: S.Set Int -> Column -> Column +atIndices indexes (BoxedColumn column) = BoxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (OptionalColumn column) = OptionalColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (UnboxedColumn column) = UnboxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (GroupedBoxedColumn column) = GroupedBoxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (GroupedUnboxedColumn column) = GroupedUnboxedColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +atIndices indexes (GroupedOptionalColumn column) = GroupedOptionalColumn $ VG.ifilter (\i _ -> i `S.member` indexes) column +{-# INLINE atIndices #-} + +atIndicesStable :: VU.Vector Int -> Column -> Column +atIndicesStable indexes (BoxedColumn column) = BoxedColumn $ indexes `getIndices` column +atIndicesStable indexes (UnboxedColumn column) = UnboxedColumn $ indexes `getIndicesUnboxed` column +atIndicesStable indexes (OptionalColumn column) = OptionalColumn $ indexes `getIndices` column +atIndicesStable indexes (GroupedBoxedColumn column) = GroupedBoxedColumn $ indexes `getIndices` column +atIndicesStable indexes (GroupedUnboxedColumn column) = GroupedUnboxedColumn $ indexes `getIndices` column +atIndicesStable indexes (GroupedOptionalColumn column) = GroupedOptionalColumn $ indexes `getIndices` column +{-# INLINE atIndicesStable #-} + +getIndices :: VU.Vector Int -> VB.Vector a -> VB.Vector a +getIndices indices xs = VB.generate (VU.length indices) (\i -> xs VB.! (indices VU.! i)) +{-# INLINE getIndices #-} + +getIndicesUnboxed :: (VU.Unbox a) => VU.Vector Int -> VU.Vector a -> VU.Vector a +getIndicesUnboxed indices xs = VU.generate (VU.length indices) (\i -> xs VU.! (indices VU.! i)) +{-# INLINE getIndicesUnboxed #-} + +sortedIndexes :: Bool -> Column -> VU.Vector Int +sortedIndexes asc (BoxedColumn column ) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (UnboxedColumn column) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (OptionalColumn column ) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (GroupedBoxedColumn column) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (GroupedUnboxedColumn column) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +sortedIndexes asc (GroupedOptionalColumn column) = runST $ do + withIndexes <- VG.thaw $ VG.indexed column + VA.sortBy (\(a, b) (a', b') -> (if asc then compare else flip compare) b b') withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length column) (\i -> fst (sorted VG.! i)) +{-# INLINE sortedIndexes #-} + +-- Operations on a column that may change its type. + +instance Transformable Column where + transform :: forall b c . (Columnable b, Columnable c) => (b -> c) -> Column -> Maybe Column + transform f (BoxedColumn (column :: VB.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return (toColumn' (VB.map f column)) + transform f (OptionalColumn (column :: VB.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return (toColumn' (VB.map f column)) + transform f (UnboxedColumn (column :: VU.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ if testUnboxable (typeRep @c) then transformUnboxed f column else toColumn' (VB.map f (VB.convert column)) + transform f (GroupedBoxedColumn (column :: VB.Vector (VB.Vector a))) = do + Refl <- testEquality (typeRep @(VB.Vector a)) (typeRep @b) + return (toColumn' (VB.map f column)) + transform f (GroupedUnboxedColumn (column :: VB.Vector (VU.Vector a))) = do + Refl <- testEquality (typeRep @(VU.Vector a)) (typeRep @b) + return (toColumn' (VB.map f column)) + transform f (GroupedOptionalColumn (column :: VB.Vector (VB.Vector a))) = do + Refl <- testEquality (typeRep @(VB.Vector a)) (typeRep @b) + return (toColumn' (VB.map f column)) + +-- | Applies a function that returns an unboxed result to an unboxed vector, storing the result in a column. +transformUnboxed :: forall a b . (Columnable a, VU.Unbox a, Columnable b) => (a -> b) -> VU.Vector a -> Column +transformUnboxed f = itransformUnboxed (const f) + +-- TODO: Make a type class with incoherent instances. +itransformUnboxed :: forall a b . (Columnable a, VU.Unbox a, Columnable b) => (Int -> a -> b) -> VU.Vector a -> Column +itransformUnboxed f column = case testEquality (typeRep @b) (typeRep @Int) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Int8) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Int16) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Int32) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Int64) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Word8) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing-> case testEquality (typeRep @b) (typeRep @Word16) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Word32) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Word64) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Char) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Bool) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Float) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Double) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> case testEquality (typeRep @b) (typeRep @Word) of + Just Refl -> UnboxedColumn $ VU.imap f column + Nothing -> error "Result type is unboxed" -- since we only call this after confirming + +-- | tranform with index. +itransform :: forall b c. (Columnable b, Columnable c) => (Int -> b -> c) -> Column -> Maybe Column +itransform f (BoxedColumn (column :: VB.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return (toColumn' (VB.imap f column)) +itransform f (UnboxedColumn (column :: VU.Vector a)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ if testUnboxable (typeRep @c) then itransformUnboxed f column else toColumn' (VB.imap f (VB.convert column)) +itransform f (GroupedBoxedColumn (column :: VB.Vector (VB.Vector a))) = do + Refl <- testEquality (typeRep @(VB.Vector a)) (typeRep @b) + return (toColumn' (VB.imap f column)) +itransform f (GroupedUnboxedColumn (column :: VB.Vector (VU.Vector a))) = do + Refl <- testEquality (typeRep @(VU.Vector a)) (typeRep @b) + return (toColumn' (VB.imap f column)) + +-- | Filter column with index. +ifilterColumn :: forall a . (Columnable a) => (Int -> a -> Bool) -> Column -> Maybe Column +ifilterColumn f c@(BoxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ BoxedColumn $ VG.ifilter f column +ifilterColumn f c@(UnboxedColumn (column :: VU.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ UnboxedColumn $ VG.ifilter f column +ifilterColumn f c@(GroupedBoxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ GroupedBoxedColumn $ VG.ifilter f column +ifilterColumn f c@(GroupedUnboxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ GroupedUnboxedColumn $ VG.ifilter f column + +-- TODO: Expand this to use more predicates. +ifilterColumnF :: Function -> Column -> Maybe Column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(BoxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ BoxedColumn $ VG.ifilter f column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(UnboxedColumn (column :: VU.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ UnboxedColumn $ VG.ifilter f column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(OptionalColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ OptionalColumn $ VG.ifilter f column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(GroupedBoxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ GroupedBoxedColumn $ VG.ifilter f column +ifilterColumnF (ICond (f :: Int -> a -> Bool)) c@(GroupedUnboxedColumn (column :: VB.Vector b)) = do + Refl <- testEquality (typeRep @a) (typeRep @b) + return $ GroupedUnboxedColumn $ VG.ifilter f column + +ifoldrColumn :: forall a b. (Columnable a, Columnable b) => (Int -> a -> b -> b) -> b -> Column -> Maybe b +ifoldrColumn f acc c@(BoxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column +ifoldrColumn f acc c@(OptionalColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column +ifoldrColumn f acc c@(UnboxedColumn (column :: VU.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column +ifoldrColumn f acc c@(GroupedBoxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column +ifoldrColumn f acc c@(GroupedUnboxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldr f acc column + +ifoldlColumn :: forall a b . (Columnable a, Columnable b) => (b -> Int -> a -> b) -> b -> Column -> Maybe b +ifoldlColumn f acc c@(BoxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column +ifoldlColumn f acc c@(OptionalColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column +ifoldlColumn f acc c@(UnboxedColumn (column :: VU.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column +ifoldlColumn f acc c@(GroupedBoxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column +ifoldlColumn f acc c@(GroupedUnboxedColumn (column :: VB.Vector d)) = do + Refl <- testEquality (typeRep @a) (typeRep @d) + return $ VG.ifoldl' f acc column + +reduceColumn :: forall a b. Columnable a => (a -> b) -> Column -> b +{-# SPECIALIZE reduceColumn :: + (VU.Vector (Double, Double) -> Double) -> Column -> Double, + (VU.Vector Double -> Double) -> Column -> Double #-} +reduceColumn f (BoxedColumn (column :: c)) = case testEquality (typeRep @c) (typeRep @a) of + Just Refl -> f column + Nothing -> error $ "Can't reduce. Incompatible types: " ++ show (typeRep @a) ++ " " ++ show (typeRep @a) +reduceColumn f (UnboxedColumn (column :: c)) = case testEquality (typeRep @c) (typeRep @a) of + Just Refl -> f column + Nothing -> error $ "Can't reduce. Incompatible types: " ++ show (typeRep @a) ++ " " ++ show (typeRep @a) +reduceColumn f (OptionalColumn (column :: c)) = case testEquality (typeRep @c) (typeRep @a) of + Just Refl -> f column + Nothing -> error $ "Can't reduce. Incompatible types: " ++ show (typeRep @a) ++ " " ++ show (typeRep @a) +{-# INLINE reduceColumn #-} + +safeReduceColumn :: forall a b. (Typeable a) => (a -> b) -> Column -> Maybe b +safeReduceColumn f (BoxedColumn (column :: c)) = do + Refl <- testEquality (typeRep @c) (typeRep @a) + return $! f column +safeReduceColumn f (UnboxedColumn (column :: c)) = do + Refl <- testEquality (typeRep @c) (typeRep @a) + return $! f column +safeReduceColumn f (OptionalColumn (column :: c)) = do + Refl <- testEquality (typeRep @c) (typeRep @a) + return $! f column +{-# INLINE safeReduceColumn #-} + +zipColumns :: Column -> Column -> Column +zipColumns (BoxedColumn column) (BoxedColumn other) = BoxedColumn (VG.zip column other) +zipColumns (BoxedColumn column) (UnboxedColumn other) = BoxedColumn (VB.generate (min (VG.length column) (VG.length other)) (\i -> (column VG.! i, other VG.! i))) +zipColumns (UnboxedColumn column) (BoxedColumn other) = BoxedColumn (VB.generate (min (VG.length column) (VG.length other)) (\i -> (column VG.! i, other VG.! i))) +zipColumns (UnboxedColumn column) (UnboxedColumn other) = UnboxedColumn (VG.zip column other) +{-# INLINE zipColumns #-} + +-- Functions for mutable columns (intended for IO). +-- Clean this up. +writeColumn :: Int -> T.Text -> Column -> IO (Either T.Text Bool) +writeColumn i value (MutableBoxedColumn (col :: VBM.IOVector a)) = let + in case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> (if isNullish value + then VBM.unsafeWrite col i "" >> return (Left $! value) + else VBM.unsafeWrite col i value >> return (Right True)) + Nothing -> return (Left value) +writeColumn i value (MutableUnboxedColumn (col :: VUM.IOVector a)) = + case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> case readInt value of + Just v -> VUM.unsafeWrite col i v >> return (Right True) + Nothing -> VUM.unsafeWrite col i 0 >> return (Left value) + Nothing -> case testEquality (typeRep @a) (typeRep @Double) of + Nothing -> return (Left $! value) + Just Refl -> case readDouble value of + Just v -> VUM.unsafeWrite col i v >> return (Right True) + Nothing -> VUM.unsafeWrite col i 0 >> return (Left $! value) +{-# INLINE writeColumn #-} + +freezeColumn' :: [(Int, T.Text)] -> Column -> IO Column +freezeColumn' nulls (MutableBoxedColumn col) + | null nulls = BoxedColumn <$> VB.unsafeFreeze col + | all (isNullish . snd) nulls = OptionalColumn . VB.imap (\i v -> if i `elem` map fst nulls then Nothing else Just v) <$> VB.unsafeFreeze col + | otherwise = BoxedColumn . VB.imap (\i v -> if i `elem` map fst nulls then Left (fromMaybe (error "") (lookup i nulls)) else Right v) <$> VB.unsafeFreeze col +freezeColumn' nulls (MutableUnboxedColumn col) + | null nulls = UnboxedColumn <$> VU.unsafeFreeze col + | all (isNullish . snd) nulls = VU.unsafeFreeze col >>= \c -> return $ OptionalColumn $ VB.generate (VU.length c) (\i -> if i `elem` map fst nulls then Nothing else Just (c VU.! i)) + | otherwise = VU.unsafeFreeze col >>= \c -> return $ BoxedColumn $ VB.generate (VU.length c) (\i -> if i `elem` map fst nulls then Left (fromMaybe (error "") (lookup i nulls)) else Right (c VU.! i)) +{-# INLINE freezeColumn' #-} + +expandColumn :: Int -> Column -> Column +expandColumn n (OptionalColumn col) = OptionalColumn $ col <> VB.replicate n Nothing +expandColumn n (BoxedColumn col) = OptionalColumn $ VB.map Just col <> VB.replicate n Nothing +expandColumn n (UnboxedColumn col) = OptionalColumn $ VB.map Just (VU.convert col) <> VB.replicate n Nothing +expandColumn n (GroupedBoxedColumn col) = GroupedBoxedColumn $ col <> VB.replicate n VB.empty +expandColumn n (GroupedUnboxedColumn col) = GroupedUnboxedColumn $ col <> VB.replicate n VU.empty diff --git a/src/Data/DataFrame/Internal/DataFrame.hs b/src/Data/DataFrame/Internal/DataFrame.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Internal/DataFrame.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StrictData #-} +module Data.DataFrame.Internal.DataFrame where + +import qualified Data.Map as M +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Control.Monad (join) +import Data.DataFrame.Display.Terminal.PrettyPrint +import Data.DataFrame.Internal.Column +import Data.Function (on) +import Data.List (sortBy, transpose) +import Data.Maybe (isJust) +import Data.Type.Equality (type (:~:)(Refl), TestEquality (testEquality)) +import Type.Reflection (typeRep) + +data DataFrame = DataFrame + { -- | Our main data structure stores a dataframe as + -- a vector of columns. This improv + columns :: V.Vector (Maybe Column), + -- | Keeps the column names in the order they were inserted in. + columnIndices :: M.Map T.Text Int, + -- | Next free index that we insert a column into. + freeIndices :: [Int], + dataframeDimensions :: (Int, Int) + } + +instance Eq DataFrame where + (==) :: DataFrame -> DataFrame -> Bool + a == b = map fst (M.toList $ columnIndices a) == map fst (M.toList $ columnIndices b) && + foldr (\(name, index) acc -> acc && (columns a V.!? index == (columns b V.!? (columnIndices b M.! name)))) True (M.toList $ columnIndices a) + +instance Show DataFrame where + show :: DataFrame -> String + show d = T.unpack (asText d) + +asText :: DataFrame -> T.Text +asText d = + let header = "index" : map fst (sortBy (compare `on` snd) $ M.toList (columnIndices d)) + types = V.toList $ V.filter (/= "") $ V.map getType (columns d) + getType Nothing = "" + getType (Just (BoxedColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) + getType (Just (UnboxedColumn (column :: VU.Vector a))) = T.pack $ show (typeRep @a) + getType (Just (OptionalColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) + getType (Just (GroupedBoxedColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) + getType (Just (GroupedUnboxedColumn (column :: V.Vector a))) = T.pack $ show (typeRep @a) + -- Separate out cases dynamically so we don't end up making round trip string + -- copies. + get (Just (BoxedColumn (column :: V.Vector a))) = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> column + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> V.map T.pack column + Nothing -> V.map (T.pack . show) column + get (Just (UnboxedColumn column)) = V.map (T.pack . show) (V.convert column) + get (Just (OptionalColumn column)) = V.map (T.pack . show) column + get (Just (GroupedBoxedColumn column)) = V.map (T.pack . show) column + get (Just (GroupedUnboxedColumn column)) = V.map (T.pack . show) column + getTextColumnFromFrame df (i, name) = if i == 0 + then V.fromList (map (T.pack . show) [0..(fst (dataframeDimensions df) - 1)]) + else get $ (V.!) (columns d) ((M.!) (columnIndices d) name) + rows = + transpose $ + zipWith (curry (V.toList . getTextColumnFromFrame d)) [0..] header + in showTable header ("Int":types) rows + +-- | O(1) Creates an empty dataframe +empty :: DataFrame +empty = DataFrame {columns = V.replicate initialColumnSize Nothing, + columnIndices = M.empty, + freeIndices = [0..(initialColumnSize - 1)], + dataframeDimensions = (0, 0) } + +initialColumnSize :: Int +initialColumnSize = 8 + +getColumn :: T.Text -> DataFrame -> Maybe Column +getColumn name df = do + i <- columnIndices df M.!? name + join $ columns df V.!? i + +null :: DataFrame -> Bool +null df = dataframeDimensions df == (0, 0) + +metadata :: DataFrame -> String +metadata df = show (columnIndices df) ++ "\n" ++ + show (V.map (fmap columnVersionString) (columns df)) ++ "\n" ++ + show (freeIndices df) ++ "\n" ++ + show (dataframeDimensions df) diff --git a/src/Data/DataFrame/Internal/Function.hs b/src/Data/DataFrame/Internal/Function.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Internal/Function.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE PatternSynonyms #-} + +module Data.DataFrame.Internal.Function where + +import qualified Data.Text as T +import qualified Data.Vector as V + +import Data.DataFrame.Internal.Types +import Data.Typeable ( Typeable, type (:~:)(Refl) ) +import Data.Type.Equality (TestEquality(testEquality)) +import Type.Reflection (typeRep, typeOf) + +-- A GADT to wrap functions so we can have hetegeneous lists of functions. +data Function where + F1 :: forall a b . (Columnable a, Columnable b) => (a -> b) -> Function + F2 :: forall a b c . (Columnable a, Columnable b, Columnable c) => (a -> b -> c) -> Function + F3 :: forall a b c d . (Columnable a, Columnable b, Columnable c, Columnable d) => (a -> b -> c -> d) -> Function + F4 :: forall a b c d e . (Columnable a, Columnable b, Columnable c, Columnable d, Columnable e) => (a -> b -> c -> d -> e) -> Function + Cond :: forall a . (Columnable a) => (a -> Bool) -> Function + ICond :: forall a . (Columnable a) => (Int -> a -> Bool) -> Function + +-- Helper class to do the actual wrapping +class WrapFunction a where + wrapFunction :: a -> Function + +-- Instance for 1-argument functions +instance (Columnable a, Columnable b) => WrapFunction (a -> b) where + wrapFunction :: (Columnable a, Columnable b) => (a -> b) -> Function + wrapFunction = F1 + +-- Instance for 2-argument functions +instance {-# INCOHERENT #-} (Columnable a, Columnable b, Columnable c) => WrapFunction (a -> b -> c) where + wrapFunction :: (Columnable a, Columnable b, Columnable c) => (a -> b -> c) -> Function + wrapFunction = F2 + +-- Instance for 3-argument functions +instance {-# INCOHERENT #-} (Columnable a, Columnable b, Columnable c, Columnable d) => WrapFunction (a -> b -> c -> d) where + wrapFunction :: (Columnable a, Columnable b, Columnable c, Columnable d) => (a -> b -> c -> d) -> Function + wrapFunction = F3 + +instance {-# INCOHERENT #-} (Columnable a, Columnable b, Columnable c, Columnable d, Columnable e) => WrapFunction (a -> b -> c -> d -> e) where + wrapFunction :: (Columnable a, Columnable b, Columnable c, Columnable d, Columnable e) => (a -> b -> c -> d -> e) -> Function + wrapFunction = F4 + +-- The main function that wraps arbitrary functions +func :: forall fn . WrapFunction fn => fn -> Function +func = wrapFunction + +pattern Empty :: V.Vector a +pattern Empty <- (V.null -> True) where Empty = V.empty + +uncons :: V.Vector a -> Maybe (a, V.Vector a) +uncons Empty = Nothing +uncons v = Just (V.unsafeHead v, V.unsafeTail v) + +pattern (:<|) :: a -> V.Vector a -> V.Vector a +pattern x :<| xs <- (uncons -> Just (x, xs)) + +funcApply :: forall c . (Columnable c) => V.Vector RowValue -> Function -> c +funcApply Empty _ = error "Empty args" +funcApply (Value (x :: a') :<| Empty) (F1 (f :: (a -> b))) = case testEquality (typeRep @a') (typeRep @a) of + Just Refl -> case testEquality (typeOf (f x)) (typeRep @c) of + Just Refl -> f x + Nothing -> error "Result type mismatch" + Nothing -> error "Arg type mismatch" +funcApply (Value (x :: a') :<| xs) (F2 (f :: (a -> b))) = case testEquality (typeOf x) (typeRep @a) of + Just Refl -> funcApply xs (F1 (f x)) + Nothing -> error "Arg type mismatch" +funcApply (Value (x :: a') :<| xs) (F3 (f :: (a -> b))) = case testEquality (typeOf x) (typeRep @a) of + Just Refl -> funcApply xs (F2 (f x)) + Nothing -> error "Arg type mismatch" +funcApply (Value (x :: a') :<| xs) (F4 (f :: (a -> b))) = case testEquality (typeOf x) (typeRep @a) of + Just Refl -> funcApply xs (F3 (f x)) + Nothing -> error "Arg type mismatch" diff --git a/src/Data/DataFrame/Internal/Parsing.hs b/src/Data/DataFrame/Internal/Parsing.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Internal/Parsing.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +module Data.DataFrame.Internal.Parsing where + +import qualified Data.ByteString.Char8 as C +import qualified Data.Set as S +import qualified Data.Text as T + +import Data.Text.Read +import Data.Maybe (fromMaybe) +import GHC.Stack (HasCallStack) +import Text.Read (readMaybe) + +isNullish :: T.Text -> Bool +isNullish s = s `S.member` S.fromList ["Nothing", "NULL", "", " ", "nan"] + +readValue :: (HasCallStack, Read a) => T.Text -> a +readValue s = case readMaybe (T.unpack s) of + Nothing -> error $ "Could not read value: " ++ T.unpack s + Just value -> value + +readInteger :: (HasCallStack) => T.Text -> Maybe Integer +readInteger s = case signed decimal (T.strip s) of + Left _ -> Nothing + Right (value, "") -> Just value + Right (value, _) -> Nothing + +readInt :: (HasCallStack) => T.Text -> Maybe Int +readInt s = case signed decimal (T.strip s) of + Left _ -> Nothing + Right (value, "") -> Just value + Right (value, _) -> Nothing +{-# INLINE readInt #-} + +readByteStringInt :: (HasCallStack) => C.ByteString -> Maybe Int +readByteStringInt s = case C.readInt (C.strip s) of + Nothing -> Nothing + Just (value, "") -> Just value + Just (value, _) -> Nothing +{-# INLINE readByteStringInt #-} + +readDouble :: (HasCallStack) => T.Text -> Maybe Double +readDouble s = + case signed double s of + Left _ -> Nothing + Right (value, "") -> Just value + Right (value, _) -> Nothing +{-# INLINE readDouble #-} + +readIntegerEither :: (HasCallStack) => T.Text -> Either T.Text Integer +readIntegerEither s = case signed decimal (T.strip s) of + Left _ -> Left s + Right (value, "") -> Right value + Right (value, _) -> Left s +{-# INLINE readIntegerEither #-} + +readIntEither :: (HasCallStack) => T.Text -> Either T.Text Int +readIntEither s = case signed decimal (T.strip s) of + Left _ -> Left s + Right (value, "") -> Right value + Right (value, _) -> Left s +{-# INLINE readIntEither #-} + +readDoubleEither :: (HasCallStack) => T.Text -> Either T.Text Double +readDoubleEither s = + case signed double s of + Left _ -> Left s + Right (value, "") -> Right value + Right (value, _) -> Left s +{-# INLINE readDoubleEither #-} + +safeReadValue :: (Read a) => T.Text -> Maybe a +safeReadValue s = readMaybe (T.unpack s) + +readWithDefault :: (HasCallStack, Read a) => a -> T.Text -> a +readWithDefault v s = fromMaybe v (readMaybe (T.unpack s)) diff --git a/src/Data/DataFrame/Internal/Row.hs b/src/Data/DataFrame/Internal/Row.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Internal/Row.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} +module Data.DataFrame.Internal.Row where + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Algorithms.Merge as VA + +import Control.Exception (throw) +import Control.Monad.ST (runST) +import Data.DataFrame.Errors (DataFrameException(..)) +import Data.DataFrame.Internal.Column +import Data.DataFrame.Internal.DataFrame +import Data.DataFrame.Internal.Types +import Data.Function (on) + +type Row = V.Vector RowValue + +toRowList :: [T.Text] -> DataFrame -> [Row] +toRowList names df = let + nameSet = S.fromList names + in map (mkRowRep df nameSet) [0..(fst (dataframeDimensions df) - 1)] + +toRowVector :: [T.Text] -> DataFrame -> V.Vector Row +toRowVector names df = let + nameSet = S.fromList names + in V.generate (fst (dataframeDimensions df)) (mkRowRep df nameSet) + +mkRowFromArgs :: [T.Text] -> DataFrame -> Int -> Row +mkRowFromArgs names df i = V.map get (V.fromList names) + where + get name = case getColumn name df of + Nothing -> throw $ ColumnNotFoundException name "[INTERNAL] mkRowFromArgs" (map fst $ M.toList $ columnIndices df) + Just (BoxedColumn column) -> toRowValue (column V.! i) + Just (UnboxedColumn column) -> toRowValue (column VU.! i) + Just (OptionalColumn column) -> toRowValue (column V.! i) + +mkRowRep :: DataFrame -> S.Set T.Text -> Int -> Row +mkRowRep df names i = V.generate (S.size names) (\index -> get (names' V.! index)) + where + inOrderIndexes = map fst $ L.sortBy (compare `on` snd) $ M.toList (columnIndices df) + names' = V.fromList [n | n <- inOrderIndexes, S.member n names] + throwError name = error $ "Column " + ++ T.unpack name + ++ " has less items than " + ++ "the other columns at index " + ++ show i + get name = case getColumn name df of + Just (BoxedColumn c) -> case c V.!? i of + Just e -> toRowValue e + Nothing -> throwError name + Just (OptionalColumn c) -> case c V.!? i of + Just e -> toRowValue e + Nothing -> throwError name + Just (UnboxedColumn c) -> case c VU.!? i of + Just e -> toRowValue e + Nothing -> throwError name + Just (GroupedBoxedColumn c) -> case c V.!? i of + Just e -> toRowValue e + Nothing -> throwError name + Just (GroupedUnboxedColumn c) -> case c V.!? i of + Just e -> toRowValue e + Nothing -> throwError name + +sortedIndexes' :: Bool -> V.Vector Row -> VU.Vector Int +sortedIndexes' asc rows = runST $ do + withIndexes <- VG.thaw (V.indexed rows) + VA.sortBy ((if asc then compare else flip compare) `on` snd) withIndexes + sorted <- VG.unsafeFreeze withIndexes + return $ VU.generate (VG.length rows) (\i -> fst (sorted VG.! i)) diff --git a/src/Data/DataFrame/Internal/Types.hs b/src/Data/DataFrame/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Internal/Types.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE Strict #-} +module Data.DataFrame.Internal.Types where + +import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Kind (Type) +import Data.Maybe (fromMaybe) +import Data.Typeable (Typeable, type (:~:) (..)) +import Data.Word ( Word8, Word16, Word32, Word64 ) +import Type.Reflection (TypeRep, typeOf, typeRep) +import Data.Type.Equality (TestEquality(..)) + +-- We need an "Object" type as an intermediate representation +-- for rows. Useful for things like sorting and function application. +type Columnable a = (Typeable a, Show a, Ord a, Eq a) + +data RowValue where + Value :: (Columnable a) => a -> RowValue + +instance Eq RowValue where + (==) :: RowValue -> RowValue -> Bool + (Value a) == (Value b) = fromMaybe False $ do + Refl <- testEquality (typeOf a) (typeOf b) + return $ a == b + +instance Ord RowValue where + (<=) :: RowValue -> RowValue -> Bool + (Value a) <= (Value b) = fromMaybe False $ do + Refl <- testEquality (typeOf a) (typeOf b) + return $ a <= b + +instance Show RowValue where + show :: RowValue -> String + show (Value a) = show a + +toRowValue :: forall a . (Columnable a) => a -> RowValue +toRowValue = Value + +-- | Essentially a "functor" instance of our type-erased Column. +class Transformable a where + transform :: forall b c . (Columnable b, Columnable c) => (b -> c) -> a -> Maybe a + +-- Convenience functions for types. +unboxableTypes :: TypeRepList '[Int, Int8, Int16, Int32, Int64, + Word, Word8, Word16, Word32, Word64, + Char, Double, Float, Bool] +unboxableTypes = Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep Nil))))))))))))) + +numericTypes :: TypeRepList '[Int, Int8, Int16, Int32, Int64, Double, Float] +numericTypes = Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep (Cons typeRep Nil)))))) + +data TypeRepList (xs :: [Type]) where + Nil :: TypeRepList '[] + Cons :: Typeable x => TypeRep x -> TypeRepList xs -> TypeRepList (x ': xs) + +matchesAnyType :: forall a xs. (Typeable a) => TypeRepList xs -> TypeRep a -> Bool +matchesAnyType Nil _ = False +matchesAnyType (Cons ty tys) rep = + case testEquality ty rep of + Just Refl -> True + Nothing -> matchesAnyType tys rep + +testUnboxable :: forall a . Typeable a => TypeRep a -> Bool +testUnboxable x = matchesAnyType unboxableTypes (typeRep @a) + +testNumeric :: forall a . Typeable a => TypeRep a -> Bool +testNumeric x = matchesAnyType numericTypes (typeRep @a) diff --git a/src/Data/DataFrame/Operations/Aggregation.hs b/src/Data/DataFrame/Operations/Aggregation.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Operations/Aggregation.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Data.DataFrame.Operations.Aggregation where + +import qualified Data.Set as S + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Map.Strict as MS +import qualified Data.Text as T +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as VM +import qualified Data.Vector.Unboxed as VU +import qualified Statistics.Quantile as SS +import qualified Statistics.Sample as SS + +import Control.Exception (throw) +import Control.Monad (foldM_) +import Control.Monad.ST (runST) +import Data.DataFrame.Internal.Column (Column(..), toColumn', getIndicesUnboxed, getIndices) +import Data.DataFrame.Internal.DataFrame (DataFrame(..), empty, getColumn) +import Data.DataFrame.Internal.Parsing +import Data.DataFrame.Internal.Types +import Data.DataFrame.Errors +import Data.DataFrame.Operations.Core +import Data.DataFrame.Operations.Subset +import Data.Function ((&)) +import Data.Hashable +import Data.Maybe +import Data.Type.Equality (type (:~:)(Refl), TestEquality(..)) +import Type.Reflection (typeRep, typeOf) + +-- | O(k * n) groups the dataframe by the given rows aggregating the remaining rows +-- into vector that should be reduced later. +groupBy :: + [T.Text] -> + DataFrame -> + DataFrame +groupBy names df + | any (`notElem` columnNames df) names = throw $ ColumnNotFoundException (T.pack $ show $ names L.\\ columnNames df) "groupBy" (columnNames df) + | otherwise = L.foldl' insertColumns initDf groupingColumns + where + insertOrAdjust k v m = if MS.notMember k m then MS.insert k [v] m else MS.adjust (appendWithFrontMin v) k m + -- Create a string representation of each row. + values = V.generate (fst (dimensions df)) (mkRowRep df (S.fromList names)) + -- Create a mapping from the row representation to the list of indices that + -- have that row representation. This will allow us sortedIndexesto combine the indexes + -- where the rows are the same. + valueIndices = V.ifoldl' (\m index rowRep -> insertOrAdjust rowRep index m) M.empty values + -- Since the min is at the head this allows us to get the min in constant time and sort by it + -- That way we can recover the original order of the rows. + -- valueIndicesInitOrder = L.sortBy (compare `on` snd) $! MS.toList $ MS.map VU.head valueIndices + valueIndicesInitOrder = runST $ do + v <- VM.new (MS.size valueIndices) + foldM_ (\i idxs -> VM.write v i (VU.fromList idxs) >> return (i + 1)) 0 valueIndices + V.unsafeFreeze v + + -- These are the indexes of the grouping/key rows i.e the minimum elements + -- of the list. + keyIndices = VU.generate (VG.length valueIndicesInitOrder) (\i -> VG.head $ valueIndicesInitOrder VG.! i) + -- this will be our main worker function in the fold that takes all + -- indices and replaces each value in a column with a list of + -- the elements with the indices where the grouped row + -- values are the same. + insertColumns = groupColumns valueIndicesInitOrder df + -- Out initial DF will just be all the grouped rows added to an + -- empty dataframe. The entries are dedued and are in their + -- initial order. + initDf = L.foldl' (mkGroupedColumns keyIndices df) empty names + -- All the rest of the columns that we are grouping by. + groupingColumns = columnNames df L.\\ names + +mkRowRep :: DataFrame -> S.Set T.Text -> Int -> Int +mkRowRep df names i = hash $ V.ifoldl' go [] (columns df) + where + indexMap = M.fromList (map (\(a, b) -> (b, a)) $ M.toList (columnIndices df)) + go acc k Nothing = acc + go acc k (Just (BoxedColumn (c :: V.Vector a))) = + if S.notMember (indexMap M.! k) names + then acc + else case c V.!? i of + Just e -> hash' @a e : acc + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i + go acc k (Just (UnboxedColumn (c :: VU.Vector a))) = + if S.notMember (indexMap M.! k) names + then acc + else case c VU.!? i of + Just e -> hash' @a e : acc + Nothing -> + error $ + "Column " + ++ T.unpack (indexMap M.! k) + ++ " has less items than " + ++ "the other columns at index " + ++ show i + +-- | This hash function returns the hash when given a non numeric type but +-- the value when given a numeric. +hash' :: Columnable a => a -> Double +hash' value = case testEquality (typeOf value) (typeRep @Double) of + Just Refl -> value + Nothing -> case testEquality (typeOf value) (typeRep @Int) of + Just Refl -> fromIntegral value + Nothing -> case testEquality (typeOf value) (typeRep @T.Text) of + Just Refl -> fromIntegral $ hash value + Nothing -> fromIntegral $ hash (show value) + +mkGroupedColumns :: VU.Vector Int -> DataFrame -> DataFrame -> T.Text -> DataFrame +mkGroupedColumns indices df acc name = + case (V.!) (columns df) (columnIndices df M.! name) of + Nothing -> error "Unexpected" + (Just (BoxedColumn column)) -> + let vs = indices `getIndices` column + in insertColumn name vs acc + (Just (UnboxedColumn column)) -> + let vs = indices `getIndicesUnboxed` column + in insertUnboxedColumn name vs acc + +groupColumns :: V.Vector (VU.Vector Int) -> DataFrame -> DataFrame -> T.Text -> DataFrame +groupColumns indices df acc name = + case (V.!) (columns df) (columnIndices df M.! name) of + Nothing -> df + (Just (BoxedColumn column)) -> + let vs = V.map (`getIndices` column) indices + in insertColumn' name (Just $ GroupedBoxedColumn vs) acc + (Just (UnboxedColumn column)) -> + let vs = V.map (`getIndicesUnboxed` column) indices + in insertColumn' name (Just $ GroupedUnboxedColumn vs) acc + +data Aggregation = Count + | Mean + | Minimum + | Median + | Maximum + | Sum deriving (Show, Eq) + +groupByAgg :: Aggregation -> [T.Text] -> DataFrame -> DataFrame +groupByAgg agg columnNames df = let + in case agg of + Count -> insertColumnWithDefault @Int 1 (T.pack (show agg)) V.empty df + & groupBy columnNames + & reduceBy @Int VG.length "Count" + _ -> error "UNIMPLEMENTED" + +-- O (k * n) Reduces a vector valued volumn with a given function. +reduceBy :: + forall a b . (Columnable a, Columnable b) => + (forall v . (VG.Vector v a) => v a -> b) -> + T.Text -> + DataFrame -> + DataFrame +reduceBy f name df = case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> case testEquality (typeRep @a) (typeRep @a') of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map f column)) df + Nothing -> error "Type error" + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> case testEquality (typeRep @a) (typeRep @a') of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map f column)) df + Nothing -> error "Type error" + _ -> error "Column is ungrouped" + +reduceByAgg :: Aggregation + -> T.Text + -> DataFrame + -> DataFrame +reduceByAgg agg name df = case agg of + Count -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.length column)) df + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.length column)) df + _ -> error $ "Cannot count ungrouped Column: " ++ T.unpack name + Mean -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map fromIntegral) column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map SS.mean column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Float) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map realToFrac) column)) df + Nothing -> error $ "Cannot get mean of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map fromIntegral) column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map SS.mean column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Float) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map (SS.mean . VG.map realToFrac) column)) df + Nothing -> error $ "Cannot get mean of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? + Minimum -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.minimum column)) df + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.minimum column)) df + Maximum -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.maximum column)) df + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> insertColumn' name (Just $ toColumn' (VG.map VG.maximum column)) df + Sum -> case getColumn name df of + Just ((GroupedBoxedColumn (column :: V.Vector (V.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df + Nothing -> error $ "Cannot get sum of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? + Just ((GroupedUnboxedColumn (column :: V.Vector (VU.Vector a')))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> insertColumn' name (Just $ toColumn' (VG.map VG.sum column)) df + Nothing -> error $ "Cannot get sum of non-numeric column: " ++ T.unpack name -- Not sure what to do with no numeric - return nothing??? + _ -> error "UNIMPLEMENTED" + +aggregate :: [(T.Text, Aggregation)] -> DataFrame -> DataFrame +aggregate aggs df = let + f (name, agg) d = cloneColumn name alias d & reduceByAgg agg alias + where alias = (T.pack . show) agg <> "_" <> name + in fold f aggs df & exclude (map fst aggs) + + +appendWithFrontMin :: (Ord a) => a -> [a] -> [a] +appendWithFrontMin x [] = [x] +appendWithFrontMin x xs@(f:rest) + | x < f = x:xs + | otherwise = f:x:rest +{-# INLINE appendWithFrontMin #-} diff --git a/src/Data/DataFrame/Operations/Core.hs b/src/Data/DataFrame/Operations/Core.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Operations/Core.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE BangPatterns #-} +module Data.DataFrame.Operations.Core where + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Map.Strict as MS +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Control.Exception ( throw ) +import Data.DataFrame.Errors +import Data.DataFrame.Internal.Column ( Column(..), toColumn', toColumn, columnLength, columnTypeString, expandColumn ) +import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn, null, empty) +import Data.DataFrame.Internal.Parsing (isNullish) +import Data.DataFrame.Internal.Types (Columnable) +import Data.Either +import Data.Function (on, (&)) +import Data.Maybe +import Data.Type.Equality (type (:~:)(Refl), TestEquality(..)) +import Type.Reflection +import Prelude hiding (null) + +-- | O(1) Get DataFrame dimensions i.e. (rows, columns) +dimensions :: DataFrame -> (Int, Int) +dimensions = dataframeDimensions +{-# INLINE dimensions #-} + +-- | O(k) Get column names of the DataFrame in order of insertion. +columnNames :: DataFrame -> [T.Text] +columnNames = map fst . L.sortBy (compare `on` snd). M.toList . columnIndices +{-# INLINE columnNames #-} + +-- | /O(n)/ Adds a vector to the dataframe. +insertColumn :: + forall a. + (Columnable a) => + -- | Column Name + T.Text -> + -- | Vector to add to column + V.Vector a -> + -- | DataFrame to add column to + DataFrame -> + DataFrame +insertColumn name xs = insertColumn' name (Just (toColumn' xs)) +{-# INLINE insertColumn #-} + +cloneColumn :: T.Text -> T.Text -> DataFrame -> DataFrame +cloneColumn original new df = fromMaybe (throw $ ColumnNotFoundException original "cloneColumn" (map fst $ M.toList $ columnIndices df)) $ do + column <- getColumn original df + return $ insertColumn' new (Just column) df + +-- | /O(n)/ Adds an unboxed vector to the dataframe. +insertUnboxedColumn :: + forall a. + (Columnable a, VU.Unbox a) => + -- | Column Name + T.Text -> + -- | Unboxed vector to add to column + VU.Vector a -> + -- | DataFrame to add to column + DataFrame -> + DataFrame +insertUnboxedColumn name xs = insertColumn' name (Just (UnboxedColumn xs)) + +-- -- | /O(n)/ Add a column to the dataframe. Not meant for external use. +insertColumn' :: + -- | Column Name + T.Text -> + -- | Column to add + Maybe Column -> + -- | DataFrame to add to column + DataFrame -> + DataFrame +insertColumn' _ Nothing d = d +insertColumn' name optCol@(Just column) d + | M.member name (columnIndices d) = let + i = (M.!) (columnIndices d) name + in d { columns = columns d V.// [(i, optCol)] } + | otherwise = insertNewColumn + where + l = columnLength column + (r, c) = dataframeDimensions d + diff = abs (l - r) + insertNewColumn + -- If we have a non-empty dataframe and we have more rows in the new column than the other column + -- we should make all the other columns have null and then add the new column. + | r > 0 && l > r = let + indexes = (map snd . L.sortBy (compare `on` snd). M.toList . columnIndices) d + nonEmptyColumns = L.foldl' (\acc i -> acc ++ [maybe (error "Unexpected") (expandColumn diff) (columns d V.! i)]) [] indexes + in fromList (zip (columnNames d ++ [name]) (nonEmptyColumns ++ [column])) + | otherwise = let + (n:rest) = case freeIndices d of + [] -> [VG.length (columns d)..(VG.length (columns d) * 2 - 1)] + lst -> lst + columns' = if L.null (freeIndices d) + then columns d V.++ V.replicate (VG.length (columns d)) Nothing + else columns d + xs' + | diff <= 0 || null d = optCol + | otherwise = expandColumn diff <$> optCol + in d + { columns = columns' V.// [(n, xs')], + columnIndices = M.insert name n (columnIndices d), + freeIndices = rest, + dataframeDimensions = (max l r, c + 1) + } + +-- | /O(k)/ Add a column to the dataframe providing a default. +-- This constructs a new vector and also may convert it +-- to an unboxed vector if necessary. Since columns are usually +-- large the runtime is dominated by the length of the list, k. +insertColumnWithDefault :: + forall a. + (Columnable a) => + -- | Default Value + a -> + -- | Column name + T.Text -> + -- | Data to add to column + V.Vector a -> + -- | DataFrame to add to column + DataFrame -> + DataFrame +insertColumnWithDefault defaultValue name xs d = + let (rows, _) = dataframeDimensions d + values = xs V.++ V.replicate (rows - V.length xs) defaultValue + in insertColumn' name (Just $ toColumn' values) d + +-- TODO: Add existence check in rename. +rename :: T.Text -> T.Text -> DataFrame -> DataFrame +rename orig new df = fromMaybe (throw $ ColumnNotFoundException orig "rename" (map fst $ M.toList $ columnIndices df)) $ do + columnIndex <- M.lookup orig (columnIndices df) + let origRemoved = M.delete orig (columnIndices df) + let newAdded = M.insert new columnIndex origRemoved + return df { columnIndices = newAdded } + +-- | O(1) Get the number of elements in a given column. +columnSize :: T.Text -> DataFrame -> Maybe Int +columnSize name df = columnLength <$> getColumn name df + +data ColumnInfo = ColumnInfo { + nameOfColumn :: !T.Text, + nonNullValues :: !Int, + nullValues :: !Int, + partiallyParsedValues :: !Int, + uniqueValues :: !Int, + typeOfColumn :: !T.Text + } + +-- | O(n) Returns the number of non-null columns in the dataframe and the type associated +-- with each column. +columnInfo :: DataFrame -> DataFrame +columnInfo df = empty & insertColumn' "Column Name" (Just $! toColumn (map nameOfColumn infos)) + & insertColumn' "# Non-null Values" (Just $! toColumn (map nonNullValues infos)) + & insertColumn' "# Null Values" (Just $! toColumn (map nullValues infos)) + & insertColumn' "# Partially parsed" (Just $! toColumn (map partiallyParsedValues infos)) + & insertColumn' "# Unique Values" (Just $! toColumn (map uniqueValues infos)) + & insertColumn' "Type" (Just $! toColumn (map typeOfColumn infos)) + where + infos = L.sortBy (compare `on` nonNullValues) (V.ifoldl' go [] (columns df)) :: [ColumnInfo] + indexMap = M.fromList (map (\(a, b) -> (b, a)) $ M.toList (columnIndices df)) + columnName i = indexMap M.! i + go acc i Nothing = acc + go acc i (Just col@(OptionalColumn (c :: V.Vector a))) = let + cname = columnName i + countNulls = nulls col + countPartial = partiallyParsed col + columnType = T.pack $ show $ typeRep @a + unique = S.size $ VG.foldr S.insert S.empty c + in ColumnInfo cname (columnLength col - countNulls) countNulls countPartial unique columnType : acc + go acc i (Just col@(BoxedColumn (c :: V.Vector a))) = let + cname = columnName i + countPartial = partiallyParsed col + columnType = T.pack $ show $ typeRep @a + unique = S.size $ VG.foldr S.insert S.empty c + in ColumnInfo cname (columnLength col) 0 countPartial unique columnType : acc + go acc i (Just col@(UnboxedColumn c)) = let + cname = columnName i + columnType = T.pack $ columnTypeString col + unique = S.size $ VG.foldr S.insert S.empty c + -- Unboxed columns cannot have nulls since Maybe + -- is not an instance of Unbox a + in ColumnInfo cname (columnLength col) 0 0 unique columnType : acc + +nulls :: Column -> Int +nulls (OptionalColumn xs) = VG.length $ VG.filter isNothing xs +nulls (BoxedColumn (xs :: V.Vector a)) = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> VG.length $ VG.filter isNullish xs + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> VG.length $ VG.filter (isNullish . T.pack) xs + Nothing -> case typeRep @a of + App t1 t2 -> case eqTypeRep t1 (typeRep @Maybe) of + Just HRefl -> VG.length $ VG.filter isNothing xs + Nothing -> 0 + _ -> 0 +nulls _ = 0 + +partiallyParsed :: Column -> Int +partiallyParsed (BoxedColumn (xs :: V.Vector a)) = + case typeRep @a of + App (App tycon t1) t2 -> case eqTypeRep tycon (typeRep @Either) of + Just HRefl -> VG.length $ VG.filter isLeft xs + Nothing -> 0 + _ -> 0 +partiallyParsed _ = 0 + +fromList :: [(T.Text, Column)] -> DataFrame +fromList = L.foldl' (\df (!name, !column) -> insertColumn' name (Just $! column) df) empty + +-- | O (k * n) Counts the occurences of each value in a given column. +valueCounts :: forall a. (Columnable a) => T.Text -> DataFrame -> [(a, Int)] +valueCounts columnName df = case getColumn columnName df of + Nothing -> throw $ ColumnNotFoundException columnName "sortBy" (map fst $ M.toList $ columnIndices df) + Just (BoxedColumn (column' :: V.Vector c)) -> + let + column = V.foldl' (\m v -> MS.insertWith (+) v (1 :: Int) m) M.empty column' + in case (typeRep @a) `testEquality` (typeRep @c) of + Nothing -> throw $ TypeMismatchException (typeRep @a) (typeRep @c) columnName "valueCounts" + Just Refl -> M.toAscList column + Just (OptionalColumn (column' :: V.Vector c)) -> + let + column = V.foldl' (\m v -> MS.insertWith (+) v (1 :: Int) m) M.empty column' + in case (typeRep @a) `testEquality` (typeRep @c) of + Nothing -> throw $ TypeMismatchException (typeRep @a) (typeRep @c) columnName "valueCounts" + Just Refl -> M.toAscList column + Just (UnboxedColumn (column' :: VU.Vector c)) -> let + column = V.foldl' (\m v -> MS.insertWith (+) v (1 :: Int) m) M.empty (V.convert column') + in case (typeRep @a) `testEquality` (typeRep @c) of + Nothing -> throw $ TypeMismatchException (typeRep @a) (typeRep @c) columnName "valueCounts" + Just Refl -> M.toAscList column + +fold :: (a -> DataFrame -> DataFrame) -> [a] -> DataFrame -> DataFrame +fold f xs acc = L.foldl' (flip f) acc xs diff --git a/src/Data/DataFrame/Operations/Sorting.hs b/src/Data/DataFrame/Operations/Sorting.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Operations/Sorting.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +module Data.DataFrame.Operations.Sorting where + +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Vector as V + +import Control.Exception (throw) +import Data.DataFrame.Errors (DataFrameException(..)) +import Data.DataFrame.Internal.Column +import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn) +import Data.DataFrame.Internal.Row +import Data.DataFrame.Operations.Core + +-- | Sort order taken as a parameter by the sortby function. +data SortOrder = Ascending | Descending deriving (Eq) + +-- | O(k log n) Sorts the dataframe by a given row. +-- +-- > sortBy "Age" df +sortBy :: + SortOrder -> + [T.Text] -> + DataFrame -> + DataFrame +sortBy order names df + | any (`notElem` columnNames df) names = throw $ ColumnNotFoundException (T.pack $ show $ names L.\\ columnNames df) "sortBy" (columnNames df) + | otherwise = let + -- TODO: Remove the SortOrder defintion from operations so we can share it between here and internal and + -- we don't have to do this Bool mapping. + indexes = sortedIndexes' (order == Ascending) (toRowVector names df) + pick idxs col = atIndicesStable idxs <$> col + in df {columns = V.map (pick indexes) (columns df)} diff --git a/src/Data/DataFrame/Operations/Statistics.hs b/src/Data/DataFrame/Operations/Statistics.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Operations/Statistics.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +module Data.DataFrame.Operations.Statistics where + +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import qualified Statistics.Quantile as SS +import qualified Statistics.Sample as SS + +import Prelude as P + +import Control.Exception (throw) +import Data.DataFrame.Errors (DataFrameException(..)) +import Data.DataFrame.Internal.Column +import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn, empty) +import Data.DataFrame.Internal.Types (Columnable, transform) +import Data.DataFrame.Operations.Core +import Data.Foldable (asum) +import Data.Maybe (isJust, fromMaybe) +import Data.Function ((&)) +import Data.Type.Equality (type (:~:)(Refl), TestEquality (testEquality)) +import Type.Reflection (typeRep) + + +frequencies :: T.Text -> DataFrame -> DataFrame +frequencies name df = case getColumn name df of + Just ((BoxedColumn (column :: V.Vector a))) -> let + counts = valueCounts @a name df + total = P.sum $ map snd counts + vText :: forall a . (Columnable a) => a -> T.Text + vText c' = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> c' + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> T.pack c' + Nothing -> (T.pack . show) c' + initDf = empty & insertColumn "Statistic" (V.fromList ["Count" :: T.Text, "Percentage (%)"]) + in L.foldl' (\df (col, k) -> insertColumn (vText col) (V.fromList [k, k * 100 `div` total]) df) initDf counts + Just ((OptionalColumn (column :: V.Vector a))) -> let + counts = valueCounts @a name df + total = P.sum $ map snd counts + vText :: forall a . (Columnable a) => a -> T.Text + vText c' = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> c' + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> T.pack c' + Nothing -> (T.pack . show) c' + initDf = empty & insertColumn "Statistic" (V.fromList ["Count" :: T.Text, "Percentage (%)"]) + in L.foldl' (\df (col, k) -> insertColumn (vText col) (V.fromList [k, k * 100 `div` total]) df) initDf counts + Just ((UnboxedColumn (column :: VU.Vector a))) -> let + counts = valueCounts @a name df + total = P.sum $ map snd counts + vText :: forall a . (Columnable a) => a -> T.Text + vText c' = case testEquality (typeRep @a) (typeRep @T.Text) of + Just Refl -> c' + Nothing -> case testEquality (typeRep @a) (typeRep @String) of + Just Refl -> T.pack c' + Nothing -> (T.pack . show) c' + initDf = empty & insertColumn "Statistic" (V.fromList ["Count" :: T.Text, "Percentage (%)"]) + in L.foldl' (\df (col, k) -> insertColumn (vText col) (V.fromList [k, k * 100 `div` total]) df) initDf counts + +mean :: T.Text -> DataFrame -> Maybe Double +mean = applyStatistic SS.mean + +median :: T.Text -> DataFrame -> Maybe Double +median = applyStatistic (SS.median SS.medianUnbiased) + +standardDeviation :: T.Text -> DataFrame -> Maybe Double +standardDeviation = applyStatistic SS.fastStdDev + +skewness :: T.Text -> DataFrame -> Maybe Double +skewness = applyStatistic SS.skewness + +variance :: T.Text -> DataFrame -> Maybe Double +variance = applyStatistic SS.variance + +interQuartileRange :: T.Text -> DataFrame -> Maybe Double +interQuartileRange = applyStatistic (SS.midspread SS.medianUnbiased 4) + +correlation :: T.Text -> T.Text -> DataFrame -> Maybe Double +correlation first second df = do + f <- _getColumnAsDouble first df + s <- _getColumnAsDouble second df + return $ SS.correlation2 f s + +_getColumnAsDouble :: T.Text -> DataFrame -> Maybe (VU.Vector Double) +_getColumnAsDouble name df = case getColumn name df of + Just (UnboxedColumn (f :: VU.Vector a)) -> case testEquality (typeRep @a) (typeRep @Double) of + Just Refl -> Just f + Nothing -> case testEquality (typeRep @a) (typeRep @Int) of + Just Refl -> Just $ VU.map fromIntegral f + Nothing -> Nothing + _ -> Nothing + +sum :: T.Text -> DataFrame -> Maybe Double +sum name df = case getColumn name df of + Just ((UnboxedColumn (column :: VU.Vector a'))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> Just $ VG.sum (VU.map fromIntegral column) + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> Just $ VG.sum column + Nothing -> Nothing + Nothing -> Nothing + +applyStatistic :: (VU.Vector Double -> Double) -> T.Text -> DataFrame -> Maybe Double +applyStatistic f name df = do + column <- getColumn name df + if columnTypeString column == "Double" + then safeReduceColumn f column + else do + matching <- asum [ transform (fromIntegral :: Int -> Double) column, + transform (realToFrac :: Float -> Double) column, + Just column ] + safeReduceColumn f matching + +applyStatistics :: (VU.Vector Double -> VU.Vector Double) -> T.Text -> DataFrame -> Maybe (VU.Vector Double) +applyStatistics f name df = case getColumn name df of + Just ((UnboxedColumn (column :: VU.Vector a'))) -> case testEquality (typeRep @a') (typeRep @Int) of + Just Refl -> Just $! f (VU.map fromIntegral column) + Nothing -> case testEquality (typeRep @a') (typeRep @Double) of + Just Refl -> Just $! f column + Nothing -> case testEquality (typeRep @a') (typeRep @Float) of + Just Refl -> Just $! f (VG.map realToFrac column) + Nothing -> Nothing + _ -> Nothing + +summarize :: DataFrame -> DataFrame +summarize df = fold columnStats (columnNames df) (fromList [("Statistic", toColumn ["Mean" :: T.Text, "Minimum", "25%" ,"Median", "75%", "Max", "StdDev", "IQR", "Skewness"])]) + where columnStats name d = if all isJust (stats name) then insertUnboxedColumn name (VU.fromList (map (roundTo 2 . fromMaybe 0) $ stats name)) d else d + stats name = let + quantiles = applyStatistics (SS.quantilesVec SS.medianUnbiased (VU.fromList [0,1,2,3,4]) 4) name df + min' = flip (VG.!) 0 <$> quantiles + quartile1 = flip (VG.!) 1 <$> quantiles + median' = flip (VG.!) 2 <$> quantiles + quartile3 = flip (VG.!) 3 <$> quantiles + max' = flip (VG.!) 4 <$> quantiles + iqr = (-) <$> quartile3 <*> quartile1 + in [mean name df, + min', + quartile1, + median', + quartile3, + max', + standardDeviation name df, + iqr, + skewness name df] + roundTo :: Int -> Double -> Double + roundTo n x = fromInteger (round $ x * (10^n)) / (10.0^^n) diff --git a/src/Data/DataFrame/Operations/Subset.hs b/src/Data/DataFrame/Operations/Subset.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Operations/Subset.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} +module Data.DataFrame.Operations.Subset where + +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Generic as VG +import qualified Prelude + +import Control.Exception (throw) +import Data.DataFrame.Errors (DataFrameException(..)) +import Data.DataFrame.Internal.Column +import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn, empty) +import Data.DataFrame.Internal.Function +import Data.DataFrame.Internal.Row (mkRowFromArgs) +import Data.DataFrame.Internal.Types (Columnable, RowValue, toRowValue) +import Data.DataFrame.Operations.Core +import Data.DataFrame.Operations.Transformations (apply) +import Data.Function ((&)) +import Data.Maybe (isJust, fromJust, fromMaybe) +import Prelude hiding (filter, take) +import Type.Reflection + +-- | O(k * n) Take the first n rows of a DataFrame. +take :: Int -> DataFrame -> DataFrame +take n d = d {columns = V.map (takeColumn n' <$>) (columns d), dataframeDimensions = (n', c)} + where + (r, c) = dataframeDimensions d + n' = clip n 0 r + +takeLast :: Int -> DataFrame -> DataFrame +takeLast n d = d {columns = V.map (takeLastColumn n' <$>) (columns d), dataframeDimensions = (n', c)} + where + (r, c) = dataframeDimensions d + n' = clip n 0 r + +drop :: Int -> DataFrame -> DataFrame +drop n d = d {columns = V.map (sliceColumn n' (max (r - n') 0) <$>) (columns d), dataframeDimensions = (max (r - n') 0, c)} + where + (r, c) = dataframeDimensions d + n' = clip n 0 r + +dropLast :: Int -> DataFrame -> DataFrame +dropLast n d = d {columns = V.map (sliceColumn 0 n' <$>) (columns d), dataframeDimensions = (n', c)} + where + (r, c) = dataframeDimensions d + n' = clip (r - n) 0 r + +-- | O(k * n) Take a range of rows of a DataFrame. +range :: (Int, Int) -> DataFrame -> DataFrame +range (start, end) d = d {columns = V.map (sliceColumn (clip start 0 r) n' <$>) (columns d), dataframeDimensions = (n', c)} + where + (r, c) = dataframeDimensions d + n' = clip (end - start) 0 r + +clip :: Int -> Int -> Int -> Int +clip n left right = min right $ max n left + +-- | O(n * k) Filter rows by a given condition. +filter :: + forall a. + (Columnable a) => + -- | Column to filter by + T.Text -> + -- | Filter condition + (a -> Bool) -> + -- | Dataframe to filter + DataFrame -> + DataFrame +filter filterColumnName condition df = case getColumn filterColumnName df of + Nothing -> throw $ ColumnNotFoundException filterColumnName "filter" (map fst $ M.toList $ columnIndices df) + Just column -> case ifoldlColumn (\s i v -> if condition v then S.insert i s else s) S.empty column of + Nothing -> throw $ TypeMismatchException' (typeRep @a) (columnTypeString column) filterColumnName "filter" + Just indexes -> let + c' = snd $ dataframeDimensions df + pick idxs col = atIndices idxs <$> col + in df {columns = V.map (pick indexes) (columns df), dataframeDimensions = (S.size indexes, c')} + +filterBy :: (Columnable a) => (a -> Bool) -> T.Text -> DataFrame -> DataFrame +filterBy = flip filter + +filterWhere :: ([T.Text], Function) -> DataFrame -> DataFrame +filterWhere (args, f) df = let + indexes = VG.ifoldl' (\s i row -> if funcApply @Bool row f then S.insert i s else s) S.empty $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + c' = snd $ dataframeDimensions df + pick idxs col = atIndices idxs <$> col + in df {columns = V.map (pick indexes) (columns df), dataframeDimensions = (S.size indexes, c')} + + +filterJust :: T.Text -> DataFrame -> DataFrame +filterJust name df = case getColumn name df of + Nothing -> throw $ ColumnNotFoundException name "extractNonEmpty" (map fst $ M.toList $ columnIndices df) + Just column@(OptionalColumn (col :: V.Vector (Maybe a))) -> filter @(Maybe a) name isJust df & apply @(Maybe a) fromJust name + Just column -> error $ "Column " ++ T.unpack name ++ " is not of type Maybe a" + +-- | O(k) cuts the dataframe in a cube of size (a, b) where +-- a is the length and b is the width. +-- +-- > cube (10, 5) df +cube :: (Int, Int) -> DataFrame -> DataFrame +cube (length, width) = take length . selectIntRange (0, width - 1) + +-- | O(n) Selects a number of columns in a given dataframe. +-- +-- > select ["name", "age"] df +select :: + [T.Text] -> + DataFrame -> + DataFrame +select cs df + | L.null cs = empty + | any (`notElem` columnNames df) cs = throw $ ColumnNotFoundException (T.pack $ show $ cs L.\\ columnNames df) "select" (columnNames df) + | otherwise = L.foldl' addKeyValue empty cs + where + cIndexAssoc = M.toList $ columnIndices df + remaining = L.filter (\(!c, _) -> c `elem` cs) cIndexAssoc + removed = cIndexAssoc L.\\ remaining + indexes = map snd remaining + (r, c) = dataframeDimensions df + addKeyValue d k = + d + { columns = V.imap (\i v -> if i `notElem` indexes then Nothing else v) (columns df), + columnIndices = M.fromList remaining, + freeIndices = map snd removed ++ freeIndices df, + dataframeDimensions = (r, L.length remaining) + } + +-- | O(n) select columns by index range of column names. +selectIntRange :: (Int, Int) -> DataFrame -> DataFrame +selectIntRange (from, to) df = select (Prelude.take (to - from + 1) $ Prelude.drop from (columnNames df)) df + +-- | O(n) select columns by index range of column names. +selectRange :: (T.Text, T.Text) -> DataFrame -> DataFrame +selectRange (from, to) df = select (reverse $ Prelude.dropWhile (to /=) $ reverse $ dropWhile (from /=) (columnNames df)) df + +-- | O(n) select columns by column predicate name. +selectBy :: (T.Text -> Bool) -> DataFrame -> DataFrame +selectBy f df = select (L.filter f (columnNames df)) df + +-- | O(n) inverse of select +-- +-- > exclude ["Name"] df +exclude :: + [T.Text] -> + DataFrame -> + DataFrame +exclude cs df = + let keysToKeep = columnNames df L.\\ cs + in select keysToKeep df diff --git a/src/Data/DataFrame/Operations/Transformations.hs b/src/Data/DataFrame/Operations/Transformations.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Operations/Transformations.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Data.DataFrame.Operations.Transformations where + +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Map as M +import qualified Data.Vector.Generic as VG +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Control.Exception (throw) +import Data.DataFrame.Errors (DataFrameException(..)) +import Data.DataFrame.Internal.Column (Column(..), columnTypeString, itransform, ifoldrColumn) +import Data.DataFrame.Internal.DataFrame (DataFrame(..), getColumn) +import Data.DataFrame.Internal.Function (Function(..), funcApply) +import Data.DataFrame.Internal.Row (mkRowFromArgs) +import Data.DataFrame.Internal.Types (Columnable, RowValue, toRowValue, transform) +import Data.DataFrame.Operations.Core +import Type.Reflection (typeRep, typeOf) + +-- | O(k) Apply a function to a given column in a dataframe. +apply :: + forall b c. + (Columnable b, Columnable c) => + -- | function to apply + (b -> c) -> + -- | Column name + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +apply f columnName d = case getColumn columnName d of + Nothing -> throw $ ColumnNotFoundException columnName "apply" (map fst $ M.toList $ columnIndices d) + Just column -> case transform f column of + Nothing -> throw $ TypeMismatchException' (typeRep @b) (columnTypeString column) columnName "apply" + column' -> insertColumn' columnName column' d + +-- | O(k) Apply a function to a combination of columns in a dataframe and +-- add the result into `alias` column. +deriveFrom :: ([T.Text], Function) -> T.Text -> DataFrame -> DataFrame +deriveFrom (args, f) name df = case f of + (F4 (f' :: a -> b -> c -> d -> e)) -> let + xs = VG.map (\row -> funcApply @e row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + in insertColumn name xs df + (F3 (f' :: a -> b -> c -> d)) -> let + xs = VG.map (\row -> funcApply @d row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + in insertColumn name xs df + (F2 (f' :: a -> b -> c)) -> let + xs = VG.map (\row -> funcApply @c row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + in insertColumn name xs df + (F1 (f' :: a -> b)) -> let + xs = VG.map (\row -> funcApply @b row f) $ V.generate (fst (dimensions df)) (mkRowFromArgs args df) + in insertColumn name xs df + +-- | O(k) Apply a function to a given column in a dataframe and +-- add the result into alias column. + +derive :: + forall b c. + (Columnable b, Columnable c) => + -- | New name + T.Text -> + -- | function to apply + (b -> c) -> + -- | Derivative column name + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +derive alias f columnName d = case getColumn columnName d of + Nothing -> throw $ ColumnNotFoundException columnName "derive" (map fst $ M.toList $ columnIndices d) + Just column -> case transform f column of + Nothing -> throw $ TypeMismatchException (typeOf column) (typeRep @b) columnName "derive" + Just res -> insertColumn' alias (Just res) d + +-- | O(k * n) Apply a function to given column names in a dataframe. +applyMany :: + (Columnable b, Columnable c) => + (b -> c) -> + [T.Text] -> + DataFrame -> + DataFrame +applyMany f names df = L.foldl' (flip (apply f)) df names + +-- | O(k) Convenience function that applies to an int column. +applyInt :: + (Columnable b) => + -- | Column name + -- | function to apply + (Int -> b) -> + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +applyInt = apply + +-- | O(k) Convenience function that applies to an double column. +applyDouble :: + (Columnable b) => + -- | Column name + -- | function to apply + (Double -> b) -> + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +applyDouble = apply + +-- | O(k * n) Apply a function to a column only if there is another column +-- value that matches the given criterion. +-- +-- > applyWhere "Age" (<20) "Generation" (const "Gen-Z") +applyWhere :: + forall a b . + (Columnable a, Columnable b) => + (a -> Bool) -> -- Filter condition + T.Text -> -- Criterion Column + (b -> b) -> -- function to apply + T.Text -> -- Column name + DataFrame -> -- DataFrame to apply operation to + DataFrame +applyWhere condition filterColumnName f columnName df = case getColumn filterColumnName df of + Nothing -> throw $ ColumnNotFoundException filterColumnName "applyWhere" (map fst $ M.toList $ columnIndices df) + Just column -> case ifoldrColumn (\i val acc -> if condition val then V.cons i acc else acc) V.empty column of + Nothing -> throw $ TypeMismatchException' (typeRep @a) (columnTypeString column) filterColumnName "applyWhere" + Just indexes -> if V.null indexes + then df + else L.foldl' (\d i -> applyAtIndex i f columnName d) df indexes + +-- | O(k) Apply a function to the column at a given index. +applyAtIndex :: + forall a. + (Columnable a) => + -- | Index + Int -> + -- | function to apply + (a -> a) -> + -- | Column name + T.Text -> + -- | DataFrame to apply operation to + DataFrame -> + DataFrame +applyAtIndex i f columnName df = case getColumn columnName df of + Nothing -> throw $ ColumnNotFoundException columnName "applyAtIndex" (map fst $ M.toList $ columnIndices df) + Just column -> case itransform (\index value -> if index == i then f value else value) column of + Nothing -> throw $ TypeMismatchException' (typeRep @a) (columnTypeString column) columnName "applyAtIndex" + column' -> insertColumn' columnName column' df diff --git a/src/Data/DataFrame/Operations/Typing.hs b/src/Data/DataFrame/Operations/Typing.hs new file mode 100644 --- /dev/null +++ b/src/Data/DataFrame/Operations/Typing.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Data.DataFrame.Operations.Typing where + +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Data.DataFrame.Internal.Column (Column(..)) +import Data.DataFrame.Internal.DataFrame (DataFrame(..)) +import Data.DataFrame.Internal.Parsing +import Data.Either +import Data.Maybe +import Data.Time +import Data.Type.Equality (type (:~:)(Refl), TestEquality(..)) +import Type.Reflection (typeRep) + +parseDefaults :: Bool -> DataFrame -> DataFrame +parseDefaults safeRead df = df {columns = V.map (parseDefault safeRead) (columns df)} + +parseDefault :: Bool -> Maybe Column -> Maybe Column +parseDefault _ Nothing = Nothing +parseDefault safeRead (Just (BoxedColumn (c :: V.Vector a))) = let + parseTimeOpt s = parseTimeM {- Accept leading/trailing whitespace -} True defaultTimeLocale "%Y-%m-%d" (T.unpack s) :: Maybe Day + unsafeParseTime s = parseTimeOrError {- Accept leading/trailing whitespace -} True defaultTimeLocale "%Y-%m-%d" (T.unpack s) :: Day + in case (typeRep @a) `testEquality` (typeRep @T.Text) of + Nothing -> case (typeRep @a) `testEquality` (typeRep @String) of + Just Refl -> let + emptyToNothing v = if isNullish (T.pack v) then Nothing else Just v + safeVector = V.map emptyToNothing c + hasNulls = V.foldl' (\acc v -> if isNothing v then acc || True else acc) False safeVector + in Just $ if safeRead && hasNulls then BoxedColumn safeVector else BoxedColumn c + Nothing -> Just $ BoxedColumn c + Just Refl -> + let example = T.strip (V.head c) + emptyToNothing v = if isNullish v then Nothing else Just v + in case readInt example of + Just _ -> + let safeVector = V.map ((=<<) readInt . emptyToNothing) c + hasNulls = V.elem Nothing safeVector + in Just $ if safeRead && hasNulls then BoxedColumn safeVector else UnboxedColumn (VU.generate (V.length c) (fromMaybe 0 . (safeVector V.!))) + Nothing -> case readDouble example of + Just _ -> + let safeVector = V.map ((=<<) readDouble . emptyToNothing) c + hasNulls = V.elem Nothing safeVector + in Just $ if safeRead && hasNulls then BoxedColumn safeVector else UnboxedColumn (VU.generate (V.length c) (fromMaybe 0 . (safeVector V.!))) + Nothing -> case parseTimeOpt example of + Just d -> let + -- failed parse should be Either, nullish should be Maybe + emptyToNothing' v = if isNullish v then Left v else Right v + parseTimeEither v = case parseTimeOpt v of + Just v' -> Right v' + Nothing -> Left v + safeVector = V.map ((=<<) parseTimeEither . emptyToNothing') c + toMaybe (Left _) = Nothing + toMaybe (Right value) = Just value + lefts = V.filter isLeft safeVector + onlyNulls = (not (V.null lefts) && V.all (isNullish . fromLeft "non-null") lefts) + in Just $ if safeRead + then if onlyNulls + then BoxedColumn (V.map toMaybe safeVector) + else if V.any isLeft safeVector + then BoxedColumn safeVector + else BoxedColumn (V.map unsafeParseTime c) + else BoxedColumn (V.map unsafeParseTime c) + Nothing -> let + safeVector = V.map emptyToNothing c + hasNulls = V.any isNullish c + in Just $ if safeRead && hasNulls then BoxedColumn safeVector else BoxedColumn c +parseDefault safeRead column = column diff --git a/tests/Assertions.hs b/tests/Assertions.hs new file mode 100644 --- /dev/null +++ b/tests/Assertions.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Assertions where + +import qualified Data.List as L + +import Control.Exception +import Test.HUnit + +-- Adapted from: https://github.com/BartMassey/chunk/blob/1ee4bd6545e0db6b8b5f4935d97e7606708eacc9/hunit.hs#L29 +assertExpectException :: String -> String -> + IO a -> Assertion +assertExpectException preface expected action = do + r <- catch + (action >> (return . Just) "no exception thrown") + (\(e::SomeException) -> + return (checkForExpectedException e)) + case r of + Nothing -> return () + Just msg -> assertFailure $ preface ++ ": " ++ msg + where + checkForExpectedException :: SomeException -> Maybe String + checkForExpectedException e + | expected `L.isInfixOf` show e = Nothing + | otherwise = + Just $ "wrong exception detail, expected " ++ + expected ++ ", got: " ++ show e diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Main where + +import qualified Data.DataFrame as D +import qualified Data.DataFrame as DI +import qualified Data.List as L +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU +import qualified System.Exit as Exit + +import Control.Exception +import Data.Time +import Test.HUnit + +import Assertions + +import qualified Operations.Apply +import qualified Operations.Derive +import qualified Operations.Filter +import qualified Operations.GroupBy +import qualified Operations.InsertColumn +import qualified Operations.Sort +import qualified Operations.Take + +testData :: D.DataFrame +testData = D.fromList [ ("test1", DI.toColumn ([1..26] :: [Int])) + , ("test2", DI.toColumn ['a'..'z']) + ] + +-- Dimensions +correctDimensions :: Test +correctDimensions = TestCase (assertEqual "should be (26, 2)" (26, 2) (D.dimensions testData)) + +emptyDataframeDimensions :: Test +emptyDataframeDimensions = TestCase (assertEqual "should be (0, 0)" (0, 0) (D.dimensions D.empty)) + +dimensionsTest :: [Test] +dimensionsTest = [ TestLabel "dimensions_correctDimensions" correctDimensions + , TestLabel "dimensions_emptyDataframeDimensions" emptyDataframeDimensions + ] + +-- parsing. +parseDate :: Test +parseDate = let + expected = Just $ DI.BoxedColumn (V.fromList [fromGregorian 2020 02 14, fromGregorian 2021 02 14, fromGregorian 2022 02 14]) + actual = D.parseDefault True $ Just $ DI.toColumn' (V.fromList ["2020-02-14" :: T.Text, "2021-02-14", "2022-02-14"]) + in TestCase (assertEqual "Correctly parses gregorian date" expected actual) + +incompleteDataParseEither :: Test +incompleteDataParseEither = let + expected = Just $ DI.BoxedColumn (V.fromList [Right $ fromGregorian 2020 02 14, Left ("2021-02-" :: T.Text), Right $ fromGregorian 2022 02 14]) + actual = D.parseDefault True $ Just $ DI.toColumn' (V.fromList ["2020-02-14" :: T.Text, "2021-02-", "2022-02-14"]) + in TestCase (assertEqual "Parses Either for gregorian date" expected actual) + +incompleteDataParseMaybe :: Test +incompleteDataParseMaybe = let + expected = Just $ DI.BoxedColumn (V.fromList [Just $ fromGregorian 2020 02 14, Nothing, Just $ fromGregorian 2022 02 14]) + actual = D.parseDefault True $ Just $ DI.toColumn' (V.fromList ["2020-02-14" :: T.Text, "", "2022-02-14"]) + in TestCase (assertEqual "Parses Maybe for gregorian date with null/empty" expected actual) + +parseTests :: [Test] +parseTests = [ + TestLabel "parseDate" parseDate, + TestLabel "incompleteDataParseMaybe" incompleteDataParseMaybe, + TestLabel "incompleteDataParseEither" incompleteDataParseEither + ] + +tests :: Test +tests = TestList $ dimensionsTest + ++ Operations.Apply.tests + ++ Operations.Derive.tests + ++ Operations.Filter.tests + ++ Operations.GroupBy.tests + ++ Operations.InsertColumn.tests + ++ Operations.Sort.tests + ++ Operations.Take.tests + ++ parseTests + +main :: IO () +main = do + result <- runTestTT tests + if failures result > 0 || errors result > 0 then Exit.exitFailure else Exit.exitSuccess diff --git a/tests/Operations/Apply.hs b/tests/Operations/Apply.hs new file mode 100644 --- /dev/null +++ b/tests/Operations/Apply.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +module Operations.Apply where + +import qualified Data.DataFrame as D +import qualified Data.DataFrame as DI +import qualified Data.DataFrame as DE +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Assertions +import Test.HUnit +import Type.Reflection (typeRep) + +values :: [(T.Text, DI.Column)] +values = [ ("test1", DI.toColumn ([1..26] :: [Int])) + , ("test2", DI.toColumn (map show ['a'..'z'])) + , ("test3", DI.toColumn ([1..26] :: [Int])) + , ("test4", DI.toColumn ['a'..'z']) + , ("test5", DI.toColumn ([1..26] :: [Int])) + , ("test6", DI.toColumn ['a'..'z']) + , ("test7", DI.toColumn ([1..26] :: [Int])) + , ("test8", DI.toColumn ['a'..'z']) + ] + +testData :: D.DataFrame +testData = D.fromList values + +applyBoxedToUnboxed :: Test +applyBoxedToUnboxed = TestCase (assertEqual "Boxed apply unboxed when result is unboxed" + (Just $ DI.UnboxedColumn (VU.fromList (replicate 26 (1 :: Int)))) + (DI.getColumn "test2" $ D.apply @String (const (1::Int)) "test2" testData)) + +applyBoxedToBoxed :: Test +applyBoxedToBoxed = TestCase (assertEqual "Boxed apply remains in boxed vector" + (Just $ DI.BoxedColumn (V.fromList (replicate 26 (1 :: Integer)))) + (DI.getColumn "test2" $ D.apply @String (const (1::Integer)) "test2" testData)) + +applyWrongType :: Test +applyWrongType = TestCase (assertExpectException "[Error Case]" + (DE.typeMismatchError (typeRep @Char) (typeRep @[Char])) + (print $ DI.getColumn "test2" $ D.apply @Char (const (1::Int)) "test2" testData)) + +applyUnknownColumn :: Test +applyUnknownColumn = TestCase (assertExpectException "[Error Case]" + (DE.columnNotFound "test9" "apply" (D.columnNames testData)) + (print $ D.apply @[Char] (const (1::Int)) "test9" testData)) + +applyManyOnlyGivenFields :: Test +applyManyOnlyGivenFields = TestCase (assertEqual "Applies function to many fields" + (D.fromList (map (, D.toColumn $ replicate 26 (1 :: Integer)) ["test4", "test6"] ++ + -- All other fields should have their original values. + filter (\(name, col) -> name /= "test4" && name /= "test6") values)) + (D.applyMany @Char (const (1::Integer)) + ["test4", "test6"] testData)) + +applyManyBoxedToBoxed :: Test +applyManyBoxedToBoxed = TestCase (assertEqual "Applies function to many fields" + (D.fromList (map (, D.toColumn $ replicate 26 (1 :: Integer)) ["test4", "test6", "test8"])) + (D.select ["test4", "test6", "test8"] $ D.applyMany @Char (const (1::Integer)) + ["test4", "test6", "test8"] testData)) + +applyManyBoxedToUnboxed :: Test +applyManyBoxedToUnboxed = TestCase (assertEqual "Unboxes fields when necessary" + (D.fromList (map (, D.toColumn $ replicate 26 (1 :: Int)) ["test4", "test6", "test8"])) + (D.select ["test4", "test6", "test8"] $ D.applyMany @Char (const (1::Int)) + ["test4", "test6", "test8"] testData)) + +applyManyColumnNotFound :: Test +applyManyColumnNotFound = TestCase (assertExpectException "[Error Case]" + (DE.columnNotFound "test0" "apply" (D.columnNames testData)) + (print $ D.applyMany @Char (const (1::Integer)) + ["test0", "test6", "test8"] testData)) + +applyManyWrongType :: Test +applyManyWrongType = TestCase (assertExpectException "[Error Case]" + (DE.typeMismatchError (typeRep @Char) (typeRep @[Char])) + (print $ DI.getColumn "test2" $ D.applyMany @Char (const (1::Int)) ["test2"] testData)) + +applyWhereWrongConditionType :: Test +applyWhereWrongConditionType = TestCase (assertExpectException "[Error Case]" + (DE.typeMismatchError (typeRep @Integer) (typeRep @Int)) + (print $ D.applyWhere (even @Integer) "test1" ((+1) :: Int -> Int) "test5" testData)) + +applyWhereWrongTargetType :: Test +applyWhereWrongTargetType = TestCase (assertExpectException "[Error Case]" + (DE.typeMismatchError (typeRep @Float) (typeRep @Int)) + (print $ D.applyWhere (even @Int) "test1" ((+1) :: Float -> Float) "test5" testData)) + +applyWhereConditionColumnNotFound :: Test +applyWhereConditionColumnNotFound = TestCase (assertExpectException "[Error Case]" + (DE.columnNotFound "test0" "applyWhere" (D.columnNames testData)) + (print $ D.applyWhere (even @Int) "test0" ((+1) :: Int -> Int) "test5" testData)) + +applyWhereTargetColumnNotFound :: Test +applyWhereTargetColumnNotFound = TestCase (assertExpectException "[Error Case]" + (DE.columnNotFound "test0" "applyAtIndex" (D.columnNames testData)) + (print $ D.applyWhere (even @Int) "test1" ((+1) :: Int -> Int) "test0" testData)) + +applyWhereWAI :: Test +applyWhereWAI = TestCase (assertEqual "applyWhere works as intended" + (Just $ DI.UnboxedColumn (VU.fromList (zipWith ($) (cycle [id, (+1)]) [(1 :: Int)..26]))) + (D.getColumn "test5" $ D.applyWhere (even @Int) "test1" ((+1) :: Int -> Int) "test5" testData)) + +tests :: [Test] +tests = [ TestLabel "applyBoxedToUnboxed" applyBoxedToUnboxed + , TestLabel "applyWrongType" applyWrongType + , TestLabel "applyUnknownColumn" applyUnknownColumn + , TestLabel "applyBoxedToBoxed" applyBoxedToBoxed + , TestLabel "applyManyBoxedToBoxed" applyManyBoxedToBoxed + , TestLabel "applyManyOnlyGivenFields" applyManyOnlyGivenFields + , TestLabel "applyManyBoxedToUnboxed" applyManyBoxedToUnboxed + , TestLabel "applyManyColumnNotFound" applyManyColumnNotFound + , TestLabel "applyManyWrongType" applyManyWrongType + , TestLabel "applyWhereWrongConditionType" applyWhereWrongConditionType + , TestLabel "applyWhereWrongTargetType" applyWhereWrongTargetType + , TestLabel "applyWhereConditionColumnNotFound" applyWhereConditionColumnNotFound + , TestLabel "applyWhereTargetColumnNotFound" applyWhereTargetColumnNotFound + , TestLabel "applyWhereWAI" applyWhereWAI + ] diff --git a/tests/Operations/Derive.hs b/tests/Operations/Derive.hs new file mode 100644 --- /dev/null +++ b/tests/Operations/Derive.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Operations.Derive where + +import qualified Data.DataFrame as D +import qualified Data.DataFrame as DI +import qualified Data.DataFrame as DE +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Assertions +import Test.HUnit +import Type.Reflection (typeRep) + +values :: [(T.Text, DI.Column)] +values = [ ("test1", DI.toColumn ([1..26] :: [Int])) + , ("test2", DI.toColumn (map show ['a'..'z'])) + , ("test3", DI.toColumn ['a'..'z']) + ] + +testData :: D.DataFrame +testData = D.fromList values + +deriveFromWAI :: Test +deriveFromWAI = TestCase (assertEqual "deriveFrom works when function args align" + (Just $ DI.BoxedColumn (V.fromList (zipWith (\n c -> show n ++ [c]) [1..26] ['a'..'z']))) + (DI.getColumn "test4" $ D.deriveFrom ( + ["test1", "test3"], + D.func (\(n :: Int) (c :: Char) -> show n ++ [c])) "test4" testData)) + +tests :: [Test] +tests = [ TestLabel "deriveFromWAI" deriveFromWAI + ] diff --git a/tests/Operations/Filter.hs b/tests/Operations/Filter.hs new file mode 100644 --- /dev/null +++ b/tests/Operations/Filter.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} +module Operations.Filter where + +import qualified Data.DataFrame as D +import qualified Data.DataFrame as DI +import qualified Data.DataFrame as DE +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Assertions +import Test.HUnit +import Type.Reflection (typeRep) + +values :: [(T.Text, DI.Column)] +values = [ ("test1", DI.toColumn ([1..26] :: [Int])) + , ("test2", DI.toColumn (map show ['a'..'z'])) + , ("test3", DI.toColumn ([1..26] :: [Int])) + , ("test4", DI.toColumn ['a'..'z']) + , ("test5", DI.toColumn ([1..26] :: [Int])) + , ("test6", DI.toColumn ['a'..'z']) + , ("test7", DI.toColumn ([1..26] :: [Int])) + , ("test8", DI.toColumn ['a'..'z']) + ] + +testData :: D.DataFrame +testData = D.fromList values + +filterColumnDoesNotExist :: Test +filterColumnDoesNotExist = TestCase (assertExpectException "[Error Case]" + (DE.columnNotFound "test0" "filter" (D.columnNames testData)) + (print $ D.filter @Int "test0" even testData)) + +filterColumnWrongType :: Test +filterColumnWrongType = TestCase (assertExpectException "[Error Case]" + (DE.typeMismatchError (typeRep @Integer) (typeRep @Int)) + (print $ D.filter @Integer "test1" even testData)) + +filterByColumnDoesNotExist :: Test +filterByColumnDoesNotExist = TestCase (assertExpectException "[Error Case]" + (DE.columnNotFound "test0" "filter" (D.columnNames testData)) + (print $ D.filterBy @Int even "test0" testData)) + +filterByColumnWrongType :: Test +filterByColumnWrongType = TestCase (assertExpectException "[Error Case]" + (DE.typeMismatchError (typeRep @Integer) (typeRep @Int)) + (print $ D.filterBy @Integer even "test1" testData)) + +filterColumnInexistentValues :: Test +filterColumnInexistentValues = TestCase (assertEqual "Non existent filter value returns no rows" + (0, 8) + (D.dimensions $ D.filter @Int "test1" (<0) testData)) + +filterColumnAllValues :: Test +filterColumnAllValues = TestCase (assertEqual "Filters all columns" + (26, 8) + (D.dimensions $ D.filter @Int "test1" (const True) testData)) + +filterJustWAI :: Test +filterJustWAI = TestCase (assertEqual "Filters out Nothing and unwraps Maybe" + (D.fromList [("test", D.toColumn $ replicate 5 (1 :: Int))]) + (D.filterJust "test" (D.fromList [("test", D.toColumn $ take 10 $ cycle [Just (1 :: Int), Nothing])]))) + +tests :: [Test] +tests = [ TestLabel "filterColumnDoesNotExist" filterColumnDoesNotExist + , TestLabel "filterColumnWrongType" filterColumnWrongType + , TestLabel "filterByColumnDoesNotExist" filterByColumnDoesNotExist + , TestLabel "filterByColumnWrongType" filterByColumnWrongType + , TestLabel "filterColumnInexistentValues" filterColumnInexistentValues + , TestLabel "filterColumnAllValues" filterColumnAllValues + , TestLabel "filterJustWAI" filterJustWAI + ] diff --git a/tests/Operations/GroupBy.hs b/tests/Operations/GroupBy.hs new file mode 100644 --- /dev/null +++ b/tests/Operations/GroupBy.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} +module Operations.GroupBy where + +import qualified Data.DataFrame as D +import qualified Data.DataFrame as DI +import qualified Data.DataFrame as DE +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Assertions +import Test.HUnit + +values :: [(T.Text, DI.Column)] +values = [ ("test1", DI.toColumn (concatMap (replicate 10) [1 :: Int, 2, 3, 4])) + , ("test2", DI.toColumn (take 40 $ cycle [1 :: Int,2])) + , ("test3", DI.toColumn [(1 :: Int)..40]) + , ("test4", DI.toColumn (reverse [(1 :: Int)..40])) + ] + +testData :: D.DataFrame +testData = D.fromList values + +groupBySingleRowWAI :: Test +groupBySingleRowWAI = TestCase (assertEqual "Groups by single column" + (D.fromList [("test1", DI.toColumn [(1::Int)..4]), + -- This just makes rows with [1, 2] for every unique test1 row + ("test2", DI.GroupedUnboxedColumn (V.replicate 4 $ VU.fromList (take 10 $ cycle [1 :: Int, 2]))), + ("test3", DI.GroupedUnboxedColumn (V.generate 4 (\i -> VU.fromList [(i * 10 + 1)..((i + 1) * 10)]))), + ("test4", DI.GroupedUnboxedColumn (V.generate 4 (\i -> VU.fromList [(((3 - i) + 1) * 10),(((3 - i) + 1) * 10 - 1)..((3 - i) * 10 + 1)]))) + ]) + (D.groupBy ["test1"] testData D.|> D.sortBy D.Ascending ["test1"])) + +groupByMultipleRowsWAI :: Test +groupByMultipleRowsWAI = TestCase (assertEqual "Groups by single column" + (D.fromList [("test1", DI.toColumn $ concatMap (replicate 2) [(1::Int)..4]), + ("test2", DI.toColumn (take 8 $ cycle [1 :: Int, 2])), + ("test3", DI.GroupedUnboxedColumn (V.fromList [ + VU.fromList [1 :: Int,3..9], + VU.fromList [2,4..10], + VU.fromList [11,13..19], + VU.fromList [12,14..20], + VU.fromList [21,23..29], + VU.fromList [22,24..30], + VU.fromList [31,33..39], + VU.fromList [32,34..40] + ])), + ("test4", DI.GroupedUnboxedColumn (V.fromList $ reverse [ + VU.fromList [1 :: Int,3..9], + VU.fromList [2,4..10], + VU.fromList [11,13..19], + VU.fromList [12,14..20], + VU.fromList [21,23..29], + VU.fromList [22,24..30], + VU.fromList [31,33..39], + VU.fromList [32,34..40] + ])) + ]) + (D.groupBy ["test1", "test2"] testData D.|> D.sortBy D.Ascending ["test1", "test2"])) + +groupByColumnDoesNotExist :: Test +groupByColumnDoesNotExist = TestCase (assertExpectException "[Error Case]" + (DE.columnNotFound "[\"test0\"]" "groupBy" (D.columnNames testData)) + (print $ D.groupBy ["test0"] testData)) + +tests :: [Test] +tests = [ TestLabel "groupBySingleRowWAI" groupBySingleRowWAI + , TestLabel "groupByMultipleRowsWAI" groupByMultipleRowsWAI + , TestLabel "groupByColumnDoesNotExist" groupByColumnDoesNotExist + ] + diff --git a/tests/Operations/InsertColumn.hs b/tests/Operations/InsertColumn.hs new file mode 100644 --- /dev/null +++ b/tests/Operations/InsertColumn.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} +module Operations.InsertColumn where + +import qualified Data.DataFrame as D +import qualified Data.DataFrame as DI +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Assertions +import Test.HUnit + +testData :: D.DataFrame +testData = D.fromList [ ("test1", DI.toColumn ([1..26] :: [Int])) + , ("test2", DI.toColumn ['a'..'z']) + , ("test3", DI.toColumn ([1..26] :: [Int])) + , ("test4", DI.toColumn ['a'..'z']) + , ("test5", DI.toColumn ([1..26] :: [Int])) + , ("test6", DI.toColumn ['a'..'z']) + , ("test7", DI.toColumn ([1..26] :: [Int])) + , ("test8", DI.toColumn ['a'..'z']) + ] + +-- Adding a boxed vector to an empty dataframe creates a new column boxed containing the vector elements. +addBoxedColumn :: Test +addBoxedColumn = TestCase (assertEqual "Two columns should be equal" + (Just $ DI.BoxedColumn (V.fromList ["Thuba" :: T.Text, "Zodwa", "Themba"])) + (DI.getColumn "new" $ D.insertColumn "new" (V.fromList ["Thuba" :: T.Text, "Zodwa", "Themba"]) D.empty)) + +addBoxedColumn' :: Test +addBoxedColumn' = TestCase (assertEqual "Two columns should be equal" + (Just $ DI.toColumn ["Thuba" :: T.Text, "Zodwa", "Themba"]) + (DI.getColumn "new" $ D.insertColumn' "new" (Just $ DI.toColumn ["Thuba" :: T.Text, "Zodwa", "Themba"]) D.empty)) + +-- Adding an boxed vector with an unboxable type (Int/Double) to an empty dataframe creates a new column boxed containing the vector elements. +addUnboxedColumn :: Test +addUnboxedColumn = TestCase (assertEqual "Value should be boxed" + (Just $ DI.UnboxedColumn (VU.fromList [1 :: Int, 2, 3])) + (DI.getColumn "new" $ D.insertColumn "new" (V.fromList [1 :: Int, 2, 3]) D.empty)) + +addUnboxedColumn' :: Test +addUnboxedColumn' = TestCase (assertEqual "Value should be boxed" + (Just $ DI.toColumn [1 :: Int, 2, 3]) + (DI.getColumn "new" $ D.insertColumn' "new" (Just $ DI.toColumn [1 :: Int, 2, 3]) D.empty)) + +-- Adding a column with less values than the current DF dimensions adds column with optionals. +addSmallerColumnBoxed :: Test +addSmallerColumnBoxed = TestCase ( + assertEqual "Missing values should be replaced with Nothing" + (Just $ DI.OptionalColumn (V.fromList [Just "a" :: Maybe T.Text, Just "b", Just "c", Nothing, Nothing])) + (DI.getColumn "newer" $ D.insertColumn "newer" (V.fromList ["a" :: T.Text, "b", "c"]) $ D.insertColumn "new" (V.fromList ["a" :: T.Text, "b", "c", "d", "e"]) D.empty) + ) + +addSmallerColumnUnboxed :: Test +addSmallerColumnUnboxed = TestCase ( + assertEqual "Missing values should be replaced with Nothing" + (Just $ DI.OptionalColumn (V.fromList [Just 1 :: Maybe Int, Just 2, Just 3, Nothing, Nothing])) + (DI.getColumn "newer" $ D.insertColumn "newer" (V.fromList [1 :: Int, 2, 3]) $ D.insertColumn "new" (V.fromList [1 :: Int, 2, 3, 4, 5]) D.empty) + ) + +insertColumnWithDefaultFillsWithDefault :: Test +insertColumnWithDefaultFillsWithDefault = TestCase ( + assertEqual "Missing values should be replaced with Nothing" + (Just $ DI.UnboxedColumn (VU.fromList [1 :: Int, 2, 3, 0, 0])) + (DI.getColumn "newer" $ D.insertColumnWithDefault 0 "newer" (V.fromList [1 :: Int, 2, 3]) $ D.insertColumn "new" (V.fromList [1 :: Int, 2, 3, 4, 5]) D.empty) + ) + +insertColumnWithDefaultFillsLargerNoop :: Test +insertColumnWithDefaultFillsLargerNoop = TestCase ( + assertEqual "Lists should be the same size" + (Just $ DI.UnboxedColumn (VU.fromList [(6 :: Int)..10])) + (DI.getColumn "newer" $ D.insertColumnWithDefault 0 "newer" (V.fromList [(6 :: Int)..10]) $ D.insertColumn "new" (V.fromList [1 :: Int, 2, 3, 4, 5]) D.empty) + ) + +addLargerColumnBoxed :: Test +addLargerColumnBoxed = + TestCase (assertEqual "Smaller lists should grow and contain optionals" + (D.fromList [("new", D.toColumn [Just "a" :: Maybe T.Text, Just "b", Just "c", Nothing, Nothing]), + ("newer", D.toColumn ["a" :: T.Text, "b", "c", "d", "e"])]) + (D.insertColumn "newer" (V.fromList ["a" :: T.Text, "b", "c", "d", "e"]) + $ D.insertColumn "new" (V.fromList ["a" :: T.Text, "b", "c"]) D.empty)) +addLargerColumnUnboxed :: Test +addLargerColumnUnboxed = + TestCase (assertEqual "Smaller lists should grow and contain optionals" + (D.fromList [("old", D.toColumn [Just 1 :: Maybe Int, Just 2, Nothing, Nothing, Nothing]), + ("new", D.toColumn [Just 1 :: Maybe Int, Just 2, Just 3, Nothing, Nothing]), + ("newer", D.toColumn [1 :: Int, 2, 3, 4, 5])]) + (D.insertColumn "newer" (V.fromList [1 :: Int, 2, 3, 4, 5]) + $ D.insertColumn "new" (V.fromList [1 :: Int, 2, 3]) $ + D.insertColumn "old" (V.fromList [1 :: Int, 2]) D.empty)) + +dimensionsChangeAfterAdd :: Test +dimensionsChangeAfterAdd = TestCase (assertEqual "should be (26, 3)" + (26, 9) + (D.dimensions $ D.insertColumn @Int "new" (V.fromList [1..26]) testData)) + +dimensionsNotChangedAfterDuplicate :: Test +dimensionsNotChangedAfterDuplicate = TestCase (assertEqual "should be (26, 3)" + (26, 9) + (D.dimensions $ D.insertColumn @Int "new" (V.fromList [1..26]) + $ D.insertColumn @Int "new" (V.fromList [1..26]) testData)) + + +tests :: [Test] +tests = [ + TestLabel "dimensionsChangeAfterAdd" dimensionsChangeAfterAdd + , TestLabel "dimensionsNotChangedAfterDuplicate" dimensionsNotChangedAfterDuplicate + , TestLabel "addBoxedColunmToEmpty" addBoxedColumn + , TestLabel "addBoxedColumnAutoUnboxes" addBoxedColumn + , TestLabel "addSmallerColumnBoxed" addSmallerColumnBoxed + , TestLabel "addSmallerColumnUnboxed" addSmallerColumnUnboxed + , TestLabel "addLargerColumnBoxed" addLargerColumnBoxed + , TestLabel "addLargerColumnUnboxed" addLargerColumnUnboxed + , TestLabel "insertColumnWithDefaultFillsWithDefault" insertColumnWithDefaultFillsWithDefault + , TestLabel "insertColumnWithDefaultFillsLargerNoop" insertColumnWithDefaultFillsLargerNoop + ] diff --git a/tests/Operations/Sort.hs b/tests/Operations/Sort.hs new file mode 100644 --- /dev/null +++ b/tests/Operations/Sort.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} +module Operations.Sort where + +import qualified Data.DataFrame as D +import qualified Data.DataFrame as DI +import qualified Data.DataFrame as DE +import qualified Data.Text as T +import qualified Data.Vector as V +import qualified Data.Vector.Unboxed as VU + +import Assertions +import Control.Monad +import Data.Char +import System.Random +import System.Random.Shuffle (shuffle') +import Test.HUnit + +values :: [(T.Text, DI.Column)] +values = let + ns = shuffle' [(1::Int)..26] 26 $ mkStdGen 252 + in [ ("test1", DI.toColumn ns) + , ("test2", DI.toColumn (map (chr . (+96)) ns)) + ] + +testData :: D.DataFrame +testData = D.fromList values + +sortByAscendingWAI :: Test +sortByAscendingWAI = TestCase (assertEqual "Sorting rows by ascending works as intended" + (D.fromList [("test1", DI.toColumn [(1::Int)..26]), + ("test2", DI.toColumn ['a'..'z'])]) + (D.sortBy D.Ascending ["test1"] testData)) + +sortByDescendingWAI :: Test +sortByDescendingWAI = TestCase (assertEqual "Sorting rows by descending works as intended" + (D.fromList [("test1", DI.toColumn $ reverse [(1::Int)..26]), + ("test2", DI.toColumn $ reverse ['a'..'z'])]) + (D.sortBy D.Descending ["test1"] testData)) + +sortByColumnDoesNotExist :: Test +sortByColumnDoesNotExist = TestCase (assertExpectException "[Error Case]" + (DE.columnNotFound "[\"test0\"]" "sortBy" (D.columnNames testData)) + (print $ D.sortBy D.Ascending ["test0"] testData)) + +tests :: [Test] +tests = [ TestLabel "sortByAscendingWAI" sortByAscendingWAI + , TestLabel "sortByDescendingWAI" sortByDescendingWAI + , TestLabel "sortByColumnDoesNotExist" sortByColumnDoesNotExist + ] + diff --git a/tests/Operations/Take.hs b/tests/Operations/Take.hs new file mode 100644 --- /dev/null +++ b/tests/Operations/Take.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} +module Operations.Take where + +import qualified Data.DataFrame as D +import qualified Data.DataFrame as DI + +import Test.HUnit + +testData :: D.DataFrame +testData = D.fromList [ ("test1", DI.toColumn ([1..26] :: [Int])) + , ("test2", DI.toColumn ['a'..'z']) + ] + + +takeWAI :: Test +takeWAI = TestCase (assertEqual "Gets first 10 numbers" (Just $ D.toColumn [(1 :: Int)..10]) (D.getColumn "test1" $ D.take 10 testData)) + +takeLastWAI :: Test +takeLastWAI = TestCase (assertEqual "Gets first 10 numbers" (Just $ D.toColumn [(17 :: Int)..26]) (D.getColumn "test1" $ D.takeLast 10 testData)) + +lengthEqualsTakeParam :: Test +lengthEqualsTakeParam = TestCase (assertEqual "should be (5, 2)" (5, 2) (D.dimensions $ D.take 5 testData)) + +lengthGreaterThanTakeParam :: Test +lengthGreaterThanTakeParam = TestCase (assertEqual "should be (26, 2)" (26, 2) (D.dimensions $ D.take 30 testData)) + +emptyIsZero :: Test +emptyIsZero = TestCase (assertEqual "should be (0, 0)" (0, 0) (D.dimensions $ D.take 5 D.empty)) + +negativeIsZero :: Test +negativeIsZero = TestCase (assertEqual "should be (0, 2)" (0, 2) (D.dimensions $ D.take (-1) testData)) + +lengthEqualsTakeLastParam :: Test +lengthEqualsTakeLastParam = TestCase (assertEqual "should be (5, 2)" (5, 2) (D.dimensions $ D.takeLast 5 testData)) + +lengthGreaterThanTakeLastParam :: Test +lengthGreaterThanTakeLastParam = TestCase (assertEqual "should be (26, 2)" (26, 2) (D.dimensions $ D.takeLast 30 testData)) + +emptyIsZeroTakeLast :: Test +emptyIsZeroTakeLast = TestCase (assertEqual "should be (0, 0)" (0, 0) (D.dimensions $ D.takeLast 5 D.empty)) + +negativeIsZeroTakeLast :: Test +negativeIsZeroTakeLast = TestCase (assertEqual "should be (0, 2)" (0, 2) (D.dimensions $ D.takeLast (-1) testData)) + +tests :: [Test] +tests = [ TestLabel "takeWAI" takeWAI + , TestLabel "takeLastWAI" takeLastWAI + , TestLabel "lengthEqualsTakeParam" lengthEqualsTakeParam + , TestLabel "lengthGreaterThanTakeParam" lengthGreaterThanTakeParam + , TestLabel "emptyIsZero" emptyIsZero + , TestLabel "negativeIsZero" negativeIsZero + , TestLabel "lengthEqualsTakeLastParam" lengthEqualsTakeLastParam + , TestLabel "lengthGreaterThanTakeLastParam" lengthGreaterThanTakeLastParam + , TestLabel "emptyIsZeroTakeLast" emptyIsZeroTakeLast + , TestLabel "negativeIsZeroTakeLast" negativeIsZeroTakeLast + ]