diff --git a/HasBigDecimal.cabal b/HasBigDecimal.cabal --- a/HasBigDecimal.cabal +++ b/HasBigDecimal.cabal @@ -1,37 +1,85 @@ -name: HasBigDecimal -version: 0.1.1 -synopsis: A library for arbitrary precision decimal numbers. -description: A native Haskell implementation of arbitrary precicion decimal numbers, based on Haskell Integers. Inspired by Java BigDecimals - -homepage: https://github.com/thma/HasBigDecimal#readme -license: Apache-2.0 -license-file: LICENSE -author: Thomas Mahler -maintainer: thma@apache.org -copyright: 2018 Thomas Mahler -category: Math -build-type: Simple -extra-source-files: README.md -cabal-version: >=1.10 - -library - hs-source-dirs: src - exposed-modules: Data.BigDecimal, Data.BigFloating - build-depends: base >= 4.7 && < 5 - default-language: Haskell2010 - -test-suite HasBigDecimal-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Spec.hs - other-modules: Data.BigDecimalSpec, Data.BigFloatingSpec, Data.TestUtils - build-depends: base - , HasBigDecimal - , hspec - , QuickCheck - ghc-options: -threaded -rtsopts -with-rtsopts=-N - default-language: Haskell2010 - -source-repository head - type: git - location: https://github.com/thma/HasBigDecimal +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: HasBigDecimal +version: 0.2.0.0 +synopsis: A library for arbitrary precision decimal numbers. +description: Please see the README on GitHub at +category: Math +homepage: https://github.com/thma/HasBigDecimal#readme +bug-reports: https://github.com/thma/HasBigDecimal/issues +author: Thomas Mahler +maintainer: thma@apache.org +copyright: 2018-2022 Thomas Mahler +license: Apache-2.0 +license-file: LICENSE +build-type: Simple +tested-with: + GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.1 +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/thma/HasBigDecimal + +library + exposed-modules: + Data.BigDecimal + Data.BigFloating + other-modules: + Paths_HasBigDecimal + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wname-shadowing -Wtype-defaults -Wincomplete-patterns -Wmissing-signatures -Wunused-top-binds + build-depends: + base >=4.7 && <5 + default-language: Haskell2010 + +executable HasBigDecimal-Demo + main-is: Main.hs + other-modules: + Taylor + Paths_HasBigDecimal + hs-source-dirs: + demo + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + HasBigDecimal + , base >=4.7 && <5 + default-language: Haskell2010 + +executable benchmark + main-is: Main.hs + other-modules: + Paths_HasBigDecimal + hs-source-dirs: + benchmark + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + HasBigDecimal + , base >=4.7 && <5 + , criterion + default-language: Haskell2010 + +test-suite HasBigDecimal-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Data.BigDecimalSpec + Data.BigFloatingSpec + Data.TestUtils + Paths_HasBigDecimal + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + HasBigDecimal + , QuickCheck + , base >=4.7 && <5 + , hspec + default-language: Haskell2010 + build-tool-depends: hspec-discover:hspec-discover == 2.* diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,201 +1,201 @@ - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS - - APPENDIX: How to apply the Apache License to your work. - - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "[]" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. - - Copyright [yyyy] [name of copyright owner] - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,59 +1,101 @@ -[![Build Status](https://travis-ci.org/thma/HasBigDecimal.svg?branch=master)](https://travis-ci.org/thma/HasBigDecimal) - -# HasBigDecimal - -This module defines the type 'BigDecimal' which provides a representation of arbitrary precision decimal numbers. -'BigDecimal' is a native Haskell implementation based on arbitrary sized 'Integer' values. -The implementation was inspired by Java BigDecimals. - -BigDecimal instantiates the typeclasses 'Num', 'Fractional' and 'Real'. It is thus possible to use all common operators like '+', '-', '*', '/', '^' on them. - -# Some examples from a ghci REPL -```haskell -λ> a = BigDecimal 144 2 -λ> toString a -"1.44" -λ> b = sqrt a -λ> toString b -"1.2" -λ> b * b -BigDecimal 144 2 -λ> b * b * b -BigDecimal 1728 3 -λ> b^2 -BigDecimal 144 2 -λ> c = fromString "123.4567890" -λ> c -BigDecimal 1234567890 7 -λ> a / c -BigDecimal 1166400010614240096589584878965222398584 41 -λ> roundBD it (halfUp 10) -BigDecimal 116640001 10 -λ> divide (a, c) $ halfUp 20 -BigDecimal 1166400010614240097 20 -``` - -# BigFloating -in addition to the pretty complete BigDecimal module there is the rather scetchy BigFloating module. -BigFloating contains a few first step to let BigDecimal instantiate the Floating typeclass. -As of now it contains arbitrary precision implementations for pi (based on Chudnovskis algorithm), sqrt and nthroot (based on Newtons classic algorithm). -All trigonometric functions, log and exp are still missing. -All code contributions are most welcome! -Here are some working examples: - -```haskell -λ> r = sqrt (BigDecimal 2 0) -λ> toString r -"1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727" -λ> r^2*pi -BigDecimal 6283185307179586476925286766559005768394338798750211641949889184615632812572417997256069650684234135488875159962758271904785109490094314219117662951460673928547017151357805018682925970564827587058974690236729643325013696514697383143361638452329945607739055327681644609147889519349178329780951524191191 300 -λ> toString it -"6.283185307179586476925286766559005768394338798750211641949889184615632812572417997256069650684234135488875159962758271904785109490094314219117662951460673928547017151357805018682925970564827587058974690236729643325013696514697383143361638452329945607739055327681644609147889519349178329780951524191191" - -λ> sqr 2 (halfUp 50) -BigDecimal 141421356237309504880168872420969807856967187537695 50 -λ> sqr 2 (halfUp 500) -BigDecimal 141421356237309504880168872420969807856967187537694807317667973799073247846210703885038753432764157273501384623091229702492483605585073721264412149709993583141322266592750559275579995050115278206057147010955997160597027453459686201472851741864088919860955232923048430871432145083976260362799525140798968725339654633180882964062061525835239505474575028775996172983557522033753185701135437460340849884716038689997069900481503054402779031645424782306849293691862158057846311159666871301301561856898723724 500 - -``` - +[![Actions Status](https://github.com/thma/HasBigDecimal/workflows/Haskell-CI/badge.svg)](https://github.com/thma/HasBigDecimal/actions) + +# HasBigDecimal + +This module defines the type 'BigDecimal' which provides a representation of arbitrary precision decimal numbers. +'BigDecimal' is a native Haskell implementation based on arbitrary sized 'Integer' values. +The implementation was inspired by Java BigDecimals. It aims to provide a simple to use API. + +```haskell +-- | BigDecimal is represented by an unscaled Integer value and a Natural that defines the scale +-- E.g.: (BigDecimal value = 1234, scale = 2) represents the decimal value 12.34. +data BigDecimal = BigDecimal + { + value :: Integer, -- ^ the unscaled Integer value + scale :: Natural -- ^ the scale (i.e. the number of digits after the decimal point) + } +``` + +BigDecimal instantiates the following typeclasses: + +```haskell +instance Eq BigDecimal +instance Ord BigDecimal + +instance Num BigDecimal +instance Fractional BigDecimal +instance Real BigDecimal + +instance Read BigDecimal +instance Show BigDecimal +``` + +It is thus possible to use all common numerical operations on operators like '+', '-', '*', '/', '^' on them. + + +# Some examples from a ghci REPL +```haskell +λ> a = BigDecimal 144 2 +λ> a +1.44 +λ> b = sqrt a +λ> b +1.2 +λ> b * b +1.44 +λ> b^3 +1.728 + +λ> c = fromString "123.4567890" +λ> c +123.4567890 + +λ> value c +1234567890 +λ> scale c +7 + +λ> a / c +0.01166400010614240096589584878965222398584 +λ> roundBD it (halfUp 10) +0.0116640001 +λ> divide (a, c) (halfUp 20) +0.01166400010614240097 + + +``` + +# BigFloating +in addition to the pretty complete BigDecimal module there is the rather scetchy BigFloating module. +BigFloating contains a few first steps to let `BigDecimal` instantiate the `Floating` typeclass. +As of now it contains arbitrary precision implementations for pi (based on Chudnovskis algorithm), sqrt and nthroot (based on Newtons classic algorithm). +All trigonometric functions, log and exp are still missing. +All code contributions are most welcome! + +Here are some working examples: + +```haskell +λ> r = sqrt (BigDecimal 2 0) +λ> r +1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727 +λ> r^2*pi +6.2831853071795864769252867665590057683943387987502116419498891846156328125724179972560696506842341354888751599627582719047851094900943142191176629514606739 +28547017151357805018682925970564827587058974690236729643325013696514697383143361638452329945607739055327681644609147889519349178329780951524191191 + +λ> sqr 2 (halfUp 50) +1.41421356237309504880168872420969807856967187537695 +λ> sqr 2 (halfUp 500) +1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727350138462309122970249248360558507372126441214970999358 +314132226659275055927557999505011527820605714701095599716059702745345968620147285174186408891986095523292304843087143214508397626036279952514079896872533965 +463318088296406206152583523950547457502877599617298355752203375318570113543746034084988471603868999706990048150305440277903164542478230684929369186215805784 +6311159666871301301561856898723724 + +λ> piChudnovsky (halfUp 500) +3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811 +174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066 +063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094330572703657595919530921861173819326117931051185480744623799627495 +6735188575272489122793818301194913 + + +``` + diff --git a/benchmark/Main.hs b/benchmark/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark/Main.hs @@ -0,0 +1,29 @@ +module Main ( + main +) where + +import Criterion.Main (bench, defaultMain, nf) +import Data.BigDecimal hiding (nf, precision) +import GHC.Natural (Natural) + +main :: IO () +main = benchmarks + +precision :: BigDecimal -> Natural +precision 0 = 1 +precision (BigDecimal val _) = go 1 $ abs val + where + go ds n = if n >= 10 then go (ds + 1) (n `div` 10) else ds + +precision' :: BigDecimal -> Natural +precision' = fromInteger . toInteger . length . show . abs . value + +benchmarks :: IO () +benchmarks = do + let bigNum = fromInteger (3 * 10 ^ 10000) + + defaultMain + [ bench "precision using division" $ nf precision bigNum, + bench "precision using show" $ nf precision' bigNum + ] + return () diff --git a/demo/Main.hs b/demo/Main.hs new file mode 100644 --- /dev/null +++ b/demo/Main.hs @@ -0,0 +1,43 @@ +module Main ( + main +) where + +import Data.BigDecimal +import Data.BigFloating +import Data.Maybe (fromJust) + + +bigPi :: BigDecimal +bigPi = piChudnovsky (DOWN, Just 100) + + + +halfToneStep :: BigDecimal +halfToneStep = nthRoot 2 12 (HALF_UP, Just 50) + +halfToneStepsFrom :: BigDecimal -> Integer -> BigDecimal +halfToneStepsFrom baseFrequency halfToneSteps = + baseFrequency * halfToneStep ^^ halfToneSteps + + + +main :: IO () +main = do + let a = fromString "3.1415926" + b = BigDecimal 31415926 7 + r = fromJust $ fromStringMaybe "2" + + print $ 100 * a + print $ 100 * b + print $ a == b + print bigPi + + print $ 2 / bigPi + + print $ r^2 * pi + + print $ sqrt 2 + + print $ sqr 2 (halfUp 3000) + + print $ roundBD (halfToneStepsFrom 440 12) (halfUp 2) diff --git a/demo/Taylor.hs b/demo/Taylor.hs new file mode 100644 --- /dev/null +++ b/demo/Taylor.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE DeriveFunctor, DeriveFoldable, NoMonomorphismRestriction #-} +{-# LANGUAGE FlexibleInstances #-} +module Taylor where + +-- playing around with ideas from https://iagoleal.com/posts/calculus-symbolic-ode/ +-- my idea is to use the taylor series based definitions to give implementations for the BigDecimal Floating instance. + +import Data.BigDecimal +import Data.BigFloating (piChudnovsky) +import Data.Foldable (toList) +--import Prelude hiding (pi) + + +defaultRounding :: RoundingAdvice +defaultRounding = (DOWN, Just 400) + +data Stream a = a :> Stream a + deriving (Functor, Foldable) + +infixr 2 :> + +ex :: Num a => Stream a +ex = 1 :> ex + +sine :: Num a => Stream a +sine = 0 :> cosine + +cosine :: Num a => Stream a +cosine = 1 :> fmap negate sine + + +-- | Turn a Stream f into a functional approximation +-- of its Taylor series around a point a. +-- That is, eval a f ≈ f(a + x) +eval :: Fractional a => a -> Stream a -> a -> a +eval a f x = foldr1 (\ fa f' -> fa + (x - a) * f') (take 300 taylor) + where + taylor = zipWith (/) (toList f) factorials + factorials = let fats = 1 : zipWith (*) fats [1..] + in fmap fromIntegral fats + +eval' :: BigDecimal -> Stream BigDecimal -> BigDecimal -> BigDecimal +eval' a f x = foldr1 (\ fa f' -> fa + (x - a) * f') (take 5000 taylor) + where + taylor = zipWith (/) (toList f) factorials + factorials = let fats = 1 : zipWith (*) fats [1..] + in fmap fromIntegral fats + + +-- | Taylor series representation of the derivative. +diff :: Stream a -> Stream a +diff (_ :> f') = f' + +-- | Taylor series for the constant zero. +zero :: Num a => Stream a +zero = 0 :> zero + +euler :: BigDecimal +euler = eval 0 ex 1 + +--pii = piChudnovsky defaultRounding + +p :: BigDecimal +p = eval 0 pi 0 + +-- | Taylor series for the identity function `f x = x`. +x :: Num a => Stream a +x = 0 :> 1 :> zero + +instance Num a => Num (Stream a) where + -- Good ol' linearity + (+) (fa :> f') (ga :> g') = fa + ga :> f' + g' + (-) (fa :> f') (ga :> g') = fa - ga :> f' - g' + negate = fmap negate + -- Leibniz rule applied to streams + (*) f@(fa :> f') g@(ga :> g') = fa * ga :> f' * g + f * g' + fromInteger n = fromInteger n :> zero + abs = error "Absolute value is not a smooth function" + signum = error "No well-defined sign for a series" + +instance Fractional a => Fractional (Stream a) where + -- The division rule from Calculus. We assume g(0) ≠ 0 + (/) f@(fa :> f') g@(ga :> g') = fa / ga :> (f' * g - f * g') / g^2 + fromRational n = fromRational n :> zero + +analytic :: Num a => (a -> a) -> (Stream a -> Stream a) -> Stream a -> Stream a +analytic g g' f@(fa :> f') = g fa :> g' f * f' + +instance Floating (Stream BigDecimal) where + pi = piChudnovsky defaultRounding :> zero + exp = analytic exp exp + log = analytic log recip + sin = analytic sin cos + cos = analytic cos (negate . sin) + asin = analytic asin (\x -> 1 / sqrt (1 - x^2)) + acos = analytic acos (\x -> -1 / sqrt (1 - x^2)) + atan = analytic atan (\x -> 1 / (1 + x^2)) + sinh = analytic sinh cosh + cosh = analytic cosh sinh + asinh = analytic asinh (\x -> 1 / sqrt (x^2 + 1)) + acosh = analytic acosh (\x -> 1 / sqrt (x^2 - 1)) + atanh = analytic atanh (\x -> 1 / (1 - x^2)) + + + diff --git a/src/Data/BigDecimal.hs b/src/Data/BigDecimal.hs --- a/src/Data/BigDecimal.hs +++ b/src/Data/BigDecimal.hs @@ -1,214 +1,238 @@ -{- | This module defines the type 'BigDecimal' which provides a representation of arbitrary precision decimal numbers. - 'BigDecimal' is a native Haskell implementation based on arbitrary sized 'Integer' values. - The implementation was inspired by Java BigDecimals. - - BigDecimal instantiates the typeclasses 'Num', 'Fractional' and 'Real'. It is thus possible to use all common - operators like '+', '-', '*', '/', '^' on them. - - Here are a few examples from an interactive GHCI session: - - > λ> a = BigDecimal 144 2 - > λ> toString a - > "1.44" - > λ> b = sqrt a - > λ> toString b - > "1.2" - > λ> b * b - > BigDecimal 144 2 - > λ> b * b * b - > BigDecimal 1728 3 - > λ> b^2 - > BigDecimal 144 2 - > λ> c = fromString "123.4567890" - > λ> c - > BigDecimal 1234567890 7 - > λ> a / c - > BigDecimal 1166400010614240096589584878965222398584 41 - > λ> roundBD it (halfUp 10) - > BigDecimal 116640001 10 - > λ> divide (a, c) $ halfUp 20 - > BigDecimal 1166400010614240097 20 - --} -module Data.BigDecimal - ( BigDecimal (..) - , RoundingMode (..) - , MathContext - , getScale - , getValue - , precision - , trim - , nf - , divide - , roundBD - , fromRatio - , halfUp - , fromString - , matchScales - , toString - ) -where - -import Data.List (find, elemIndex) -import Data.Maybe (fromMaybe) -import GHC.Real ((%), Ratio ((:%))) - --- | RoundingMode defines how to handle loss of precision in divisions or explicit rounding. -data RoundingMode - = UP -- ^ Rounding mode to round away from zero. - | DOWN -- ^ Rounding mode to round towards zero. - | CEILING -- ^ Rounding mode to round towards positive infinity. - | FLOOR -- ^ Rounding mode to round towards negative infinity. - | HALF_UP -- ^ Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case round up. - | HALF_DOWN -- ^ Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case round down. - | HALF_EVEN -- ^ Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case, round towards the even neighbor. - | PRECISE -- ^ Rounding mode to assert that the requested operation has an exact result, hence no rounding is applied. - -{-| BigDecimal is represented by an unscaled Integer value plus a second Integer value that defines the scale - E.g.: (BigDecimal 1234 2) represents the decimal value 12.34. - --} -data BigDecimal = - -- | creates a BigDecimal value from an unscaled 'Integer' value and a scale, given as a positive 'Integer'. - -- Example: (BigDecimal 1234 2) creates the value 12.34 - BigDecimal Integer Integer - deriving (Show, Read) - --- | gets the scale part of a BigDecimal -getScale :: BigDecimal -> Integer -getScale (BigDecimal _ s) = s - --- | get the unscaled value of a BigDecimal -getValue :: BigDecimal -> Integer -getValue (BigDecimal v _) = v - --- | A MathContext is interpreted by divisions and rounding operations to specify the expected loss of precision and the rounding behaviour. --- MathContext is a pair of a 'RoundingMode' and a target precision of type 'Maybe' 'Integer'. The precision defines the number of digits after the decimal point. --- If 'Nothing' is given as precision all decimal digits are to be preserved, that is precision is not limited. -type MathContext = (RoundingMode, Maybe Integer) - -instance Num BigDecimal where - a + b = plus (a, b) - a * b = mul (a, b) - abs (BigDecimal v s) = BigDecimal (abs v) s - signum (BigDecimal v _) = BigDecimal (signum v) 0 - fromInteger i = BigDecimal i 0 - negate (BigDecimal v s) = BigDecimal (-v) s - -instance Eq BigDecimal where - a == b = - let (BigDecimal valA _, BigDecimal valB _) = matchScales (a, b) - in valA == valB - -instance Fractional BigDecimal where - -- default division rounds up and does not limit precision - a / b = nf $ divide (matchScales (a, b)) (HALF_UP, Nothing) - fromRational ratio@(x :% y) = fromRatio ratio (HALF_UP, Nothing) - --- | creates a BigDecimal from a 'Rational' value. 'MathContext' defines precision and rounding mode. -fromRatio :: Rational -> MathContext -> BigDecimal -fromRatio (x :% y) = divide (fromInteger x, fromInteger y) - -instance Real BigDecimal where - toRational (BigDecimal val scale) = toRational val * 10^^(-scale) - -instance Ord BigDecimal where - compare a b = - let (BigDecimal valA _, BigDecimal valB _) = matchScales (a, b) - in compare valA valB - --- | add two BigDecimals -plus :: (BigDecimal, BigDecimal) -> BigDecimal -plus (a@(BigDecimal valA scaleA), b@(BigDecimal valB scaleB)) - | scaleA == scaleB = BigDecimal (valA + valB) scaleA - | otherwise = plus $ matchScales (a,b) - --- | multiply two BigDecimals -mul :: (BigDecimal, BigDecimal) -> BigDecimal -mul (BigDecimal valA scaleA, BigDecimal valB scaleB) = BigDecimal (valA * valB) (scaleA + scaleB) - --- | divide two BigDecimals and applies the 'MathContext' (i.e. a tuple of 'RoundingMode' and the specified precision) for rounding. -divide :: (BigDecimal, BigDecimal) -- ^ the tuple of dividend and divisor. I.e. (dividend, divisor) - -> MathContext -- ^ 'MathContext' (i.e. a tuple of 'RoundingMode' and the specified precision) defines the rounding behaviour. - -- if 'Nothing' if given as precision the maximum possible precision is used. - -> BigDecimal -- ^ the resulting BigDecimal -divide (a, b) (rMode, prefScale) = - let (BigDecimal numA _, BigDecimal numB _) = matchScales (a, b) - maxPrecision = fromMaybe (precision a + round (fromInteger (precision b) * 10 / 3)) prefScale - in trim maxPrecision (BigDecimal (divUsing rMode (numA * (10 :: Integer) ^ maxPrecision) numB) maxPrecision) - --- | divide two correctly scaled Integers and apply the RoundingMode -divUsing :: RoundingMode -> Integer -> Integer -> Integer -divUsing rounding a b = - let (quot, rem) = quotRem a b - delta = (10 * abs rem `div` abs b) - 5 - in case rounding of - PRECISE -> if rem == 0 then quot else error "non-terminating decimal expansion" - UP -> if abs rem > 0 then quot + signum quot else quot - CEILING -> if abs rem > 0 && quot >= 0 then quot + 1 else quot - HALF_UP -> if delta >= 0 then quot + signum quot else quot - HALF_DOWN -> if delta <= 0 then quot else quot + signum quot - DOWN -> quot - FLOOR -> if quot >= 0 then quot else quot - 1 - HALF_EVEN - | delta > 0 -> quot + signum quot - | delta == 0 && odd quot -> quot + signum quot - | otherwise -> quot - --- | round a BigDecimal to 'n' digits applying the 'MathContext' 'mc' -roundBD :: BigDecimal -> MathContext -> BigDecimal -roundBD bd@(BigDecimal val scale) mc@(rMode, Just n) - | n < 0 || n >= scale = bd - | otherwise = BigDecimal (divUsing rMode val (10 ^ (scale-n))) n - --- | match the scales of a tuple of BigDecimals -matchScales :: (BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal) -matchScales (a@(BigDecimal integerA scaleA), b@(BigDecimal integerB scaleB)) - | scaleA < scaleB = (BigDecimal (integerA * 10 ^ (scaleB - scaleA)) scaleB, b) - | scaleA > scaleB = (a, BigDecimal (integerB * 10 ^ (scaleA - scaleB)) scaleA) - | otherwise = (a, b) - --- | returns the number of digits of an Integer -precision :: BigDecimal -> Integer -precision 0 = 1 -precision (BigDecimal val _) = 1 + floor (logBase 10 $ abs $ fromInteger val) - --- | removes trailing zeros from a BigDecimals intValue by decreasing the scale -trim :: Integer -> BigDecimal -> BigDecimal -trim prefScale bd@(BigDecimal val scale) = - let (v, r) = quotRem val 10 - in if r == 0 && 0 <= prefScale && prefScale < scale - then trim prefScale $ BigDecimal v (scale - 1) - else bd - --- | computes the normal form of a BigDecimal -nf :: BigDecimal -> BigDecimal -nf = trim 0 - --- | read a BigDecimal from a human readable decimal notation. --- e.g. @ fromString "3.14" @ yields 'BigDecimal 314 2' -fromString :: String -> BigDecimal -fromString s = - let maybeIndex = elemIndex '.' s - intValue = read (filter (/= '.') s) :: Integer - in case maybeIndex of - Nothing -> BigDecimal intValue 0 - Just i -> BigDecimal intValue $ toInteger (length s - i - 1) - --- | returns a readable String representation of a BigDecimal --- e.g. @ toString (BigDecimal 314 2) @ yields "3.14" -toString :: BigDecimal -> String -toString bd@(BigDecimal intValue scale) = - let s = show $ abs intValue - filled = - if fromInteger scale >= length s - then replicate (1 + fromInteger scale - length s) '0' ++ s - else s - splitPos = length filled - fromInteger scale - (ints, decimals) = splitAt splitPos filled - sign = if intValue < 0 then "-" else "" - in sign ++ if not (null decimals) then ints ++ "." ++ decimals else ints - --- | construct a 'MathContext' for rounding 'HALF_UP' with 'scale' decimal digits -halfUp :: Integer -> MathContext -halfUp scale = (HALF_UP, Just scale) +{-# OPTIONS_GHC -fno-warn-type-defaults #-} -- avoids warnings for things like x^2 +-- -- | This module defines the type 'BigDecimal' which provides a representation of arbitrary precision decimal numbers. +-- 'BigDecimal' is a native Haskell implementation based on arbitrary sized 'Integer' values. +-- The implementation was inspired by Java BigDecimals. +-- +-- BigDecimal instantiates the typeclasses 'Num', 'Fractional' and 'Real'. It is thus possible to use all common +-- operators like '+', '-', '*', '/', '^' on them. +-- +-- Here are a few examples from an interactive GHCI session: +-- +-- > λ> a = BigDecimal 144 2 +-- > λ> toString a +-- > 1.44 +-- > λ> b = sqrt a +-- > λ> b +-- > 1.2 +-- > λ> b * b +-- > 1.44 +-- > λ> b * b * b +-- > 1.728 +-- > λ> b^2 +-- > 1.44 +-- > λ> c = read "123.4567890" :: BigDecimal +-- > λ> c +-- > 123.4567890 +-- > λ> a / c +-- > 0.01166400010614240096589584878965222398584 +-- > λ> roundBD it (halfUp 10) +-- > 0.0116640001 +-- > λ> divide (a, c) $ halfUp 20 +-- > 0.01166400010614240097 +module Data.BigDecimal + ( BigDecimal (..), + RoundingMode (..), + RoundingAdvice, + precision, + trim, + nf, + divide, + roundBD, + fromRatio, + halfUp, + fromString, + fromStringMaybe, + fromNatural, + matchScales, + ) +where + +import Data.List (elemIndex) +import Data.Maybe (fromJust, fromMaybe) +import GHC.Natural (Natural) +import GHC.Real (Ratio ((:%))) +import Text.Read (readMaybe) + +-- | BigDecimal is represented by an unscaled Integer value and a Natural that defines the scale +-- E.g.: (BigDecimal 1234 2) represents the decimal value 12.34. +data BigDecimal = BigDecimal + { -- | the unscaled Integer value + value :: Integer, + -- | the scale (i.e. the number of digits after the decimal point) + scale :: Natural + } + +-- | A RoundingAdvice is interpreted by divisions and rounding operations to specify the expected loss of precision and the rounding behaviour. +-- RoundingAdvice is a pair of a 'RoundingMode' and a target precision of type 'Maybe' 'Natural'. The precision defines the number of digits after the decimal point. +-- If 'Nothing' is given as precision all decimal digits are to be preserved, that is precision is not limited. +type RoundingAdvice = (RoundingMode, Maybe Natural) + +-- | RoundingMode defines how to handle loss of precision in divisions or explicit rounding. +data RoundingMode + = -- | Rounding mode to round away from zero. + UP + | -- | Rounding mode to round towards zero. + DOWN + | -- | Rounding mode to round towards positive infinity. + CEILING + | -- | Rounding mode to round towards negative infinity. + FLOOR + | -- | Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case round up. + HALF_UP + | -- | Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case round down. + HALF_DOWN + | -- | Rounding mode to round towards "nearest neighbor" unless both neighbors are equidistant, in which case, round towards the even neighbor. + HALF_EVEN + | -- | Rounding mode to assert that the requested operation has an exact result, hence no rounding is applied. + PRECISE + +instance Show BigDecimal where + show = toString + +instance Read BigDecimal where + readsPrec _ str = + case fromStringMaybe str of + Nothing -> [] + (Just bd) -> [(bd, "")] + +instance Num BigDecimal where + a + b = plus (a, b) + a * b = mul (a, b) + abs (BigDecimal v s) = BigDecimal (abs v) s + signum (BigDecimal v _) = BigDecimal (signum v) 0 + fromInteger i = BigDecimal i 0 + negate (BigDecimal v s) = BigDecimal (- v) s + +instance Eq BigDecimal where + a == b = + let (BigDecimal valA _, BigDecimal valB _) = matchScales (a, b) + in valA == valB + +instance Fractional BigDecimal where + -- default division rounds up and does not limit precision + a / b = nf $ divide (matchScales (a, b)) (HALF_UP, Nothing) + fromRational ratio = fromRatio ratio (HALF_UP, Nothing) + +-- | creates a BigDecimal from a 'Rational' value. 'RoundingAdvice' defines precision and rounding mode. +fromRatio :: Rational -> RoundingAdvice -> BigDecimal +fromRatio (x :% y) = nf . divide (fromInteger x, fromInteger y) + +instance Real BigDecimal where + toRational (BigDecimal val scl) = toRational val * 10 ^^ (- fromNatural scl) + +instance Ord BigDecimal where + compare a b = + let (BigDecimal valA _, BigDecimal valB _) = matchScales (a, b) + in compare valA valB + +-- | add two BigDecimals +plus :: (BigDecimal, BigDecimal) -> BigDecimal +plus (a@(BigDecimal valA scaleA), b@(BigDecimal valB scaleB)) + | scaleA == scaleB = BigDecimal (valA + valB) scaleA + | otherwise = plus $ matchScales (a, b) + +-- | multiply two BigDecimals +mul :: (BigDecimal, BigDecimal) -> BigDecimal +mul (BigDecimal valA scaleA, BigDecimal valB scaleB) = BigDecimal (valA * valB) (scaleA + scaleB) + +-- | divide two BigDecimals and applies the 'RoundingAdvice' (i.e. a tuple of 'RoundingMode' and the specified precision) for rounding. +divide :: + -- | the tuple of dividend and divisor. I.e. (dividend, divisor) + (BigDecimal, BigDecimal) -> + -- | 'RoundingAdvice' (i.e. a tuple of 'RoundingMode' and the specified precision) defines the rounding behaviour. + -- if 'Nothing' if given as precision the maximum possible precision is used. + RoundingAdvice -> + -- | the resulting BigDecimal + BigDecimal +divide (a, b) (rMode, prefScale) = + let (BigDecimal numA _, BigDecimal numB _) = matchScales (a, b) + maxPrecision = fromMaybe (precision a + round (fromIntegral (precision b) * 10 / 3)) prefScale :: Natural + in trim maxPrecision (BigDecimal (divUsing rMode (numA * (10 :: Integer) ^ maxPrecision) numB) maxPrecision) + +-- | divide two correctly scaled Integers and apply the RoundingMode +divUsing :: RoundingMode -> Integer -> Integer -> Integer +divUsing rounding a b = + let (quotient, remainder) = quotRem a b + delta = (10 * abs remainder `div` abs b) - 5 + in case rounding of + PRECISE -> if remainder == 0 then quotient else error "non-terminating decimal expansion" + UP -> if abs remainder > 0 then quotient + signum quotient else quotient + CEILING -> if abs remainder > 0 && quotient >= 0 then quotient + 1 else quotient + HALF_UP -> if delta >= 0 then quotient + signum quotient else quotient + HALF_DOWN -> if delta <= 0 then quotient else quotient + signum quotient + DOWN -> quotient + FLOOR -> if quotient >= 0 then quotient else quotient - 1 + HALF_EVEN + | delta > 0 -> quotient + signum quotient + | delta == 0 && odd quotient -> quotient + signum quotient + | otherwise -> quotient + +-- | round a BigDecimal according to a 'RoundingAdvice' to 'n' digits applying the 'RoundingMode' 'rMode' +roundBD :: BigDecimal -> RoundingAdvice -> BigDecimal +roundBD bd@(BigDecimal val scl) (rMode, Just n) + | n < 0 || n >= scl = bd + | otherwise = BigDecimal (divUsing rMode val (10 ^ (scl - n))) n +roundBD bd _ = bd + +-- | match the scales of a tuple of BigDecimals +matchScales :: (BigDecimal, BigDecimal) -> (BigDecimal, BigDecimal) +matchScales (a@(BigDecimal integerA scaleA), b@(BigDecimal integerB scaleB)) + | scaleA < scaleB = (BigDecimal (integerA * 10 ^ (scaleB - scaleA)) scaleB, b) + | scaleA > scaleB = (a, BigDecimal (integerB * 10 ^ (scaleA - scaleB)) scaleA) + | otherwise = (a, b) + +-- | returns the number of digits of a BigDecimal. +precision :: BigDecimal -> Natural +-- see benchmark/Main.hs +precision = fromInteger . toInteger . length . show . abs . value + +-- | removes trailing zeros from a BigDecimals intValue by decreasing the scale +trim :: Natural -> BigDecimal -> BigDecimal +trim prefScale bd@(BigDecimal val scl) = + let (v, r) = quotRem val 10 + in if r == 0 && 0 <= prefScale && prefScale < scl + then trim prefScale $ BigDecimal v (scl - 1) + else bd + +-- | computes the normal form of a BigDecimal +nf :: BigDecimal -> BigDecimal +nf = trim 0 + +-- | read a BigDecimal from a human readable decimal notation. +-- e.g. @ fromString "3.14" @ yields 'BigDecimal 314 2' +fromString :: String -> BigDecimal +fromString = fromJust . fromStringMaybe + +-- | read a BigDecimal from a human readable decimal notation. +-- e.g. @ fromString "3.14" @ yields 'BigDecimal 314 2' +fromStringMaybe :: String -> Maybe BigDecimal +fromStringMaybe s = + let maybeIndex = elemIndex '.' s + maybeIntValue = readMaybe (filter (/= '.') s) + in do + intValue <- maybeIntValue + case maybeIndex of + Nothing -> pure $ BigDecimal intValue 0 + Just i -> pure $ BigDecimal intValue (fromIntegral (length s - i - 1)) + +-- | returns a readable String representation of a BigDecimal +-- e.g. @ toString (BigDecimal 314 2) @ yields "3.14" +toString :: BigDecimal -> String +toString (BigDecimal intValue scl) = + let s = show $ abs intValue + filled = + if fromNatural scl >= length s + then replicate (1 + fromNatural scl - length s) '0' ++ s + else s + splitPos = length filled - fromNatural scl + (ints, decimals) = splitAt splitPos filled + sign = if intValue < 0 then "-" else "" + in sign ++ if not (null decimals) then ints ++ "." ++ decimals else ints + +-- | construct a 'RoundingAdvice' for rounding 'HALF_UP' with 'scl' decimal digits +halfUp :: Natural -> RoundingAdvice +halfUp scl = (HALF_UP, Just scl) + +-- | convert a Natural to any numeric type a +fromNatural :: Num a => Natural -> a +fromNatural = fromInteger . toInteger diff --git a/src/Data/BigFloating.hs b/src/Data/BigFloating.hs --- a/src/Data/BigFloating.hs +++ b/src/Data/BigFloating.hs @@ -1,100 +1,107 @@ -module Data.BigFloating - ( piChudnovsky - , sqr - , nthRoot - ) -where - -import Data.BigDecimal -import Data.List (find) -import Data.Maybe (fromMaybe) -import GHC.Real ((%), Ratio ((:%))) - --- I'm giving some implementation ideas for approximisations for functions on transcendental numbers. --- The rest is left as an exercise to the interested reader ;-) -instance Floating BigDecimal where - pi = piChudnovsky defaultMC - exp = undefined -- e^x - log = undefined - sin = undefined - cos = undefined - asin = undefined - acos = undefined - atan = undefined - sinh = undefined - cosh = undefined - asinh = undefined - acosh = undefined - atanh = undefined - --- not required for minimal implementation - sqrt x = sqr x defaultMC - x ** y = nthRoot (x^b) n defaultMC - where - (b :% n) = toRational y - -defaultMC = (DOWN, Just 100) - --- | computes the square root of any non-negative BigDecimal, rounding and precision defined by MathContext. --- We are using Newton's algorithm. -sqr :: BigDecimal -> MathContext -> BigDecimal -sqr x mc - | x < 0 = error "can't determine the square root of negative numbers" - | x == 0 = 0 - | otherwise = fst $ fromMaybe (error "did not find a sqrt") $ refine x 1 mc - where - refine x initial mc@(_, Just scale) = find withinPrecision $ iterate nextGuess (initial, 0) - where - withinPrecision (guess, count) = abs (guess^2 - x) < BigDecimal 10 scale || count > 10 * scale * precision x - nextGuess (guess, count) = (nf $ divide (guess + divide (x, guess) mc, 2) mc, count+1) - -nthRoot :: BigDecimal -> Integer -> MathContext -> BigDecimal -nthRoot x n mc@(r,Just s) - | x < 0 && even n = error "can't determine even roots of negative numbers" - | x < 0 && odd n = - nthRoot x (-n) mc - | x == 0 = 0 - | otherwise = roundBD (fst (fromMaybe (error "did not find a sqrt") $ refine x 1 (r, Just (s+4)))) mc - where - refine x initial mc@(_, Just scale) = find withinPrecision $ iterate nextGuess (initial, 0) - where - withinPrecision (guess, count) = abs (guess^n - x) < BigDecimal (n*10) scale || count > 10 * scale * precision x - nextGuess (guess, count) = - (nf $ divide ((guess * BigDecimal (n-1) 0) + divide (x, guess^(n-1)) mc, BigDecimal n 0) mc, count+1) - - --- | Compute pi using rounding mode and scale of the specified MathContext --- Sources: https://wiki.haskell.org/Integers_too_big_for_floats & https://github.com/eobermuhlner/big-math -piChudnovsky :: MathContext -> BigDecimal -piChudnovsky mc@(rMode, Just scale) = divide (1, 12 * divide (fromRatio s mc,f) mc') mc - where - mc' = (rMode, Just $ scale + 3) -- increase precision to avoid propagation of rounding errors - steps = 1 + div scale 14 -- taken from github.com/eobermuhlner/big-math - s = sum [chudnovsky n | n <- [0..steps]] :: Rational - f = sqr (fromInteger c^3) mc -- Common factor in the sum - - -- k-th term of the Chudnovsky series - chudnovsky :: Integer -> Rational - chudnovsky k - | even k = quot - | otherwise = -quot - where - quot = num % den - num = facDiv (6 * k) (3 * k) * (a + b * k) - den = fac k ^ 3 * (c ^ (3 * k)) - - -- Compute n! - fac :: (Enum a, Num a) => a -> a - fac n = product [1..n] - - -- Compute n! / m! efficiently - facDiv :: Integer -> Integer -> Integer - facDiv n m - | n > m = product [n, n - 1 .. m + 1] - | n == m = 1 - | otherwise = facDiv m n - - a = 13591409 - b = 545140134 - c = 640320 - - +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Data.BigFloating + ( piChudnovsky + , sqr + , nthRoot + ) +where + +import Data.BigDecimal +import Data.List (find) +import Data.Maybe (fromMaybe, fromJust) +import GHC.Real ((%), Ratio ((:%))) +import GHC.Natural + +-- I'm giving some implementation ideas for approximisations for functions on transcendental numbers. +-- The rest is left as an exercise to the interested reader ;-) +instance Floating BigDecimal where + pi = piChudnovsky defaultRounding + exp = undefined -- e^x + log = undefined + sin = undefined + cos = undefined + asin = undefined + acos = undefined + atan = undefined + sinh = undefined + cosh = undefined + asinh = undefined + acosh = undefined + atanh = undefined + +-- not required for minimal implementation + sqrt x = sqr x defaultRounding + x ** y = nthRoot (x^b) (fromIntegral n) defaultRounding + where + (b :% n) = toRational y + +defaultRounding :: RoundingAdvice +defaultRounding = (DOWN, Just 100) + +-- | computes the square root of any non-negative BigDecimal, rounding and precision defined by RoundingAdvice. +-- We are using Newton's algorithm. +sqr :: BigDecimal -> RoundingAdvice -> BigDecimal +sqr x mc + | x < 0 = error "can't determine the square root of negative numbers" + | x == 0 = 0 + | otherwise = fst $ fromMaybe (error "did not find a sqrt") $ refine x 1 mc + where + refine _ _ (_, Nothing) = error "can't produce square root with unlimited precision" + refine r initial ra@(_, Just scl) = find withinPrecision $ iterate nextGuess (initial, 0) + where + withinPrecision (guess, count) = abs (guess^(2::Int) - r) < BigDecimal 10 scl || count > 10 * scl * precision r + nextGuess (guess, count) = (nf $ divide (guess + divide (r, guess) mc, 2) ra, count+1) + +nthRoot :: BigDecimal -> Natural -> RoundingAdvice -> BigDecimal +nthRoot x n mc@(rm, maybeScale) + | x < 0 && even n = error "can't determine even roots of negative numbers" + | x < 0 && odd n = - nthRoot x (-n) mc + | x == 0 = 0 + | otherwise = roundBD (fst (fromMaybe (error "did not find a sqrt") $ refine x 1 (rm, Just (s+4)))) mc + where + s = fromJust maybeScale + refine _ _ (_, Nothing) = error "can't produce nth root with unlimited precision" + refine r initial ra@(_, Just scl) = find withinPrecision $ iterate nextGuess (initial, 0) + where + withinPrecision (guess, count) = abs (guess^n - r) < BigDecimal (fromIntegral $ n*10) scl || count > 10 * scl * precision r + nextGuess (guess, count) = + (nf $ divide ((guess * BigDecimal (fromIntegral $ n-1) 0) + divide (r, guess^(n-1)) ra, BigDecimal (fromIntegral n) 0) ra, count+1) + + +-- | Compute pi using rounding mode and scale of the specified RoundingAdvice +-- Sources: https://wiki.haskell.org/Integers_too_big_for_floats & https://github.com/eobermuhlner/big-math +piChudnovsky :: RoundingAdvice -> BigDecimal +piChudnovsky (_, Nothing) = error "can't compute pi with umlimited precision" +piChudnovsky mc@(rMode, Just scl) = divide (1, 12 * divide (fromRatio s mc,f) mc') mc + where + mc' = (rMode, Just $ scl + 3) -- increase precision to avoid propagation of rounding errors + steps = 1 + div scl 14 -- taken from github.com/eobermuhlner/big-math + s = sum [chudnovsky (fromIntegral n) | n <- [0..steps]] :: Rational + f = sqr (fromInteger c^(3::Int)) mc -- Common factor in the sum + + -- k-th term of the Chudnovsky series + chudnovsky :: Integer -> Rational + chudnovsky k + | even k = quotient + | otherwise = -quotient + where + quotient = num % den + num = facDiv (6 * k) (3 * k) * (a + b * k) + den = fac k ^ (3::Int) * (c ^ (3 * k)) + + -- Compute n! + fac :: (Enum a, Num a) => a -> a + fac n = product [1..n] + + -- Compute n! / m! efficiently + facDiv :: Integer -> Integer -> Integer + facDiv n m + | n > m = product [n, n - 1 .. m + 1] + | n == m = 1 + | otherwise = facDiv m n + + a = 13591409 + b = 545140134 + c = 640320 + + diff --git a/test/Data/BigDecimalSpec.hs b/test/Data/BigDecimalSpec.hs --- a/test/Data/BigDecimalSpec.hs +++ b/test/Data/BigDecimalSpec.hs @@ -1,315 +1,329 @@ -module Data.BigDecimalSpec - (main, spec) -where - -import Control.Exception (evaluate) -import Data.BigDecimal -import GHC.Real (Ratio ((:%))) -import Test.Hspec hiding (it) -import Data.TestUtils (it) -- I'm redefining it to use 1000 examples -import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess) -import Test.QuickCheck - --- `main` is here so that this module can be run from GHCi on its own. It is --- not needed for automatic spec discovery. -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "toBD" $ do - it "reads BigDecimals from strings" $ - fromString "-145.123" `shouldBe` BigDecimal (-145123) 3 - it "is inverse of toString" $ - property $ \bd -> (fromString . toString) bd === (bd :: BigDecimal) - - describe "toString" $ do - it "converts BigDecimals to string" $ - toString (BigDecimal (-145123) 3) `shouldBe` "-145.123" - it "adds leading 0s if required" $ - toString (BigDecimal (-14) 10) `shouldBe` "-0.0000000014" - it "can handle integer values" $ - toString 10 `shouldBe` "10" - it "is inverse of toBD" $ - property $ \bd -> (toString . fromString . toString) bd === toString (bd :: BigDecimal) - - describe "read" $ do - it "reads BigDecimals from strings in constructor notation" $ - read "BigDecimal 76878 5" `shouldBe` BigDecimal 76878 5 - it "is inverse of show" $ - property $ \bd -> (read . show) bd === (bd :: BigDecimal) - - describe "show" $ do - it "converts BigDecimals to strings in constructor notation" $ - show (BigDecimal 76878 5) `shouldBe` "BigDecimal 76878 5" - it "is inverse of read" $ - property $ \bd -> (read . show) bd === (bd :: BigDecimal) - - describe "(+)" $ do - it "adds two BigDecimals" $ - BigDecimal 73 1 + BigDecimal 270 2 `shouldBe` BigDecimal 1000 2 - modifyMaxSuccess (const 1000) $ it "has 0 as neutral element" $ - property $ \bd -> bd + 0 === (bd :: BigDecimal) - it "adds x to (-x) yielding 0" $ - property $ \bd -> bd + (-bd) === (0 :: BigDecimal) - it "uses the max scale of the summands" $ - property $ \ai as bi bs -> max as bs === getScale (BigDecimal ai as + BigDecimal bi bs) - it "uses Integer addition when summands have same scale" $ - property $ \ai bi scale -> ai + bi === getValue (BigDecimal ai scale + BigDecimal bi scale) - it "matches values when scaling" $ - property $ \ai bi scale -> getValue (BigDecimal ai scale + BigDecimal bi (scale+1)) === 10*ai + bi - - describe "(*)" $ do - it "multiplies BigDecimals" $ - BigDecimal 12 1 * BigDecimal 12 2 `shouldBe` BigDecimal 144 3 - it "has 1 as neutral element" $ - property $ \bd -> bd * 1 === (bd :: BigDecimal) - it "has 0 as zero element" $ - property $ \bd -> bd * 0 === (0 :: BigDecimal) - it "Uses Integer multiplication" $ - property $ \ai as bi -> BigDecimal ai as * BigDecimal bi 0 === BigDecimal (ai*bi) as - it "adds the scales of the multiplicands" $ - property $ \ai as bi bs -> BigDecimal ai as * BigDecimal bi bs === BigDecimal (ai*bi) (as+bs) - - describe "abs" $ do - it "determines the absolute value of a BigDecimal" $ - abs (BigDecimal (-12) 4) `shouldBe` BigDecimal 12 4 - it "is idempotent" $ - property $ \bd -> (abs . abs) bd === (abs bd :: BigDecimal) - it "is based on abs for Integers" $ - property $ \ai as -> abs (BigDecimal ai as) === BigDecimal (abs ai) as - it "negates for input < 0" $ - property $ \bd -> abs bd === if getValue bd < 0 then negate bd else bd - - describe "signum" $ do - it "determines the signature a BigDecimal" $ - signum (BigDecimal (-12) 4) `shouldBe` -1 - it "returns 1 if input > 0, zero if input == 0 and -1 if input < 0" $ - property $ \ai as -> signum (BigDecimal ai as) === if ai > 0 then 1 else if ai == 0 then 0 else -1 - it "is based on signum for Integers" $ - property $ \ai as -> signum (BigDecimal ai as) === BigDecimal (signum ai) 0 - - describe "fromInteger" $ do - it "constructs a BigDecimal from an Integer" $ - 1234 `shouldBe` BigDecimal 1234 0 - it "works for any Integer" $ - property $ \i -> fromInteger i === BigDecimal i 0 - - describe "negate" $ do - it "negates a BigDecimal" $ - negate (BigDecimal 1234 1) `shouldBe` -BigDecimal 1234 1 - it "works for any BigDecimal" $ - property $ \bd -> negate bd === (-bd :: BigDecimal) - it "is the same as *(-1)" $ - property $ \bd -> negate bd === (-1 * bd :: BigDecimal) - it "is its own inverse" $ - property $ \bd -> negate (negate bd) === (bd :: BigDecimal) - - describe "(/)" $ do - it "divides two BigDecimals" $ - BigDecimal 16 1 / BigDecimal 4 1 `shouldBe` BigDecimal 4 0 - it "yields x for x/1 for any x" $ - property $ \x -> x/1 === (x :: BigDecimal) - it "yields 1 for x/x any non-zero x" $ - property $ \x -> if x /= (0 :: BigDecimal) then x / x === 1 else 1===1 - it "throws an Arithmetic exception when dividing by 0" $ - property $ \bd -> evaluate (bd / 0 :: BigDecimal) `shouldThrow` anyArithException - it "yields y for (x*y)/x for any nonzero x" $ - property $ \x y -> y === if x == (0 :: BigDecimal) then y else (x*y)/x - it "rounds up if next decimal would be > 5" $ - 6 / 9 `shouldBe` fromString "0.6667" - it "rounds up if next decimal would be = 5" $ - 5 / 9 `shouldBe` fromString "0.5556" - it "rounds down if next decimal would be < 5" $ - 4 / 9 `shouldBe` fromString "0.4444" - - describe "fromRational" $ do - it "constructs a BigDecimal from a Ratio" $ - fromRational (1 :% 32) `shouldBe` 1 / BigDecimal 32 0 - it "works for any non-zero divisors" $ - property $ \x y -> if y == 0 then 1 ===1 else fromRational (x :% y) === BigDecimal x 0 / BigDecimal y 0 - - describe "toRational" $ do - it "converts a BigDecimal to a Ratio" $ - toRational (1 / BigDecimal 32 0) `shouldBe` (1 :% 32) - it "is inverse to fromRational" $ - property $ \x -> (x::BigDecimal) === fromRational (toRational x) - - describe "divide +/+" $ do - -- checking expresions >= 0 - it "divides BigDecimals applying RoundingMode and precision" $ - divide (2, 3) (HALF_UP, Just 9) `shouldBe` fromString "0.666666667" - it "always rounds down when using DOWN" $ - divide (2, 3) (DOWN, Just 9) `shouldBe` fromString "0.666666666" - it "always rounds down when using FLOOR" $ - divide (2, 3) (FLOOR, Just 9) `shouldBe` fromString "0.666666666" - it "rounds up when using UP when there is a remainder" $ - divide (1, 9) (UP, Just 3) `shouldBe` fromString "0.112" - it "does not round when there is no remainder when using UP" $ - divide (14, 100) (UP, Just 2) `shouldBe` fromString "0.14" - it "rounds up when using UP when there is a remainder" $ - divide (1, 9) (CEILING, Just 3) `shouldBe` fromString "0.112" - it "does not round when there is no remainder when using UP" $ - divide (14, 100) (CEILING, Just 2) `shouldBe` fromString "0.14" - it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ - divide (5, 9) (HALF_DOWN, Just 4) `shouldBe` fromString "0.5555" - it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ - divide (2, 3) (HALF_DOWN, Just 4) `shouldBe` fromString "0.6667" - it "rounds up if next decimal would be >= 5 when using HALF_UP" $ - divide (5, 9) (HALF_UP, Just 4) `shouldBe` fromString "0.5556" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (5, 9) (HALF_EVEN, Just 4) `shouldBe` fromString "0.5556" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (1, 8) (HALF_EVEN, Just 2) `shouldBe` fromString "0.12" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (15, 100) (HALF_EVEN, Just 1) `shouldBe` fromString "0.2" - it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ - divide (2, 3) (HALF_EVEN, Just 4) `shouldBe` fromString "0.6667" - it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ - evaluate (divide (5, 9) (PRECISE, Nothing)) `shouldThrow` anyException - it "gives a precise value when using PRECISE and no max precision" $ - divide (1, 32) (PRECISE, Nothing) `shouldBe` fromString "0.03125" - it "gives a precise value when using PRECISE and a sufficient precision" $ - divide (1, 32) (PRECISE, Just 5) `shouldBe` fromString "0.03125" - it "gives a precise value when using PRECISE and a to small precision" $ - evaluate (divide (1, 32) (PRECISE, Just 4)) `shouldThrow` anyException - - describe "divide -/+" $ do - -- checking dividend < 0 - it "divides BigDecimals applying RoundingMode and precision" $ - divide (-2, 3) (HALF_UP, Just 9) `shouldBe` fromString "-0.666666667" - it "always rounds down when using DOWN" $ - divide (-2, 3) (DOWN, Just 9) `shouldBe` fromString "-0.666666666" - it "always rounds towards -INF when using FLOOR" $ - divide (-2, 3) (FLOOR, Just 9) `shouldBe` fromString "-0.666666667" - it "rounds up when using UP when there is a remainder" $ - divide (-1, 9) (UP, Just 3) `shouldBe` fromString "-0.112" - it "does not round when there is no remainder when using UP" $ - divide (-14, 100) (UP, Just 2) `shouldBe` fromString "-0.14" - it "rounds towards +INF when using CEILING when there is a remainder" $ - divide (-1, 9) (CEILING, Just 3) `shouldBe` fromString "-0.111" - it "does not round when there is no remainder when using UP" $ - divide (-14, 100) (CEILING, Just 2) `shouldBe` fromString "-0.14" - it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ - divide (-5, 9) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.5555" - it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ - divide (-2, 3) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.6667" - it "rounds up if next decimal would be >= 5 when using HALF_UP" $ - divide (-5, 9) (HALF_UP, Just 4) `shouldBe` fromString "-0.5556" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (-5, 9) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.5556" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (-1, 8) (HALF_EVEN, Just 2) `shouldBe` fromString "-0.12" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (-15, 100) (HALF_EVEN, Just 1) `shouldBe` fromString "-0.2" - it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ - divide (-2, 3) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.6667" - it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ - evaluate (divide (-5, 9) (PRECISE, Nothing)) `shouldThrow` anyException - it "gives a precise value when using PRECISE and no max precision" $ - divide (-1, 32) (PRECISE, Nothing) `shouldBe` fromString "-0.03125" - it "gives a precise value when using PRECISE and a sufficient precision" $ - divide (-1, 32) (PRECISE, Just 5) `shouldBe` fromString "-0.03125" - it "gives a precise value when using PRECISE and a to small precision" $ - evaluate (divide (-1, 32) (PRECISE, Just 4)) `shouldThrow` anyException - - describe "divide +/-" $ do - -- checking divisor < 0 - it "divides BigDecimals applying RoundingMode and precision" $ - divide (2, -3) (HALF_UP, Just 9) `shouldBe` fromString "-0.666666667" - it "always rounds down when using DOWN" $ - divide (2, -3) (DOWN, Just 9) `shouldBe` fromString "-0.666666666" - it "always rounds towards -INF when using FLOOR" $ - divide (2, -3) (FLOOR, Just 9) `shouldBe` fromString "-0.666666667" - it "rounds up when using UP when there is a remainder" $ - divide (1, -9) (UP, Just 3) `shouldBe` fromString "-0.112" - it "does not round when there is no remainder when using UP" $ - divide (14, -100) (UP, Just 2) `shouldBe` fromString "-0.14" - it "rounds towards +INF when using CEILING when there is a remainder" $ - divide (1, -9) (CEILING, Just 3) `shouldBe` fromString "-0.111" - it "does not round when there is no remainder when using UP" $ - divide (14, -100) (CEILING, Just 2) `shouldBe` fromString "-0.14" - it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ - divide (5, -9) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.5555" - it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ - divide (2, -3) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.6667" - it "rounds up if next decimal would be >= 5 when using HALF_UP" $ - divide (5, -9) (HALF_UP, Just 4) `shouldBe` fromString "-0.5556" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (5, -9) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.5556" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (1, -8) (HALF_EVEN, Just 2) `shouldBe` fromString "-0.12" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (15, -100) (HALF_EVEN, Just 1) `shouldBe` fromString "-0.2" - it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ - divide (2, -3) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.6667" - it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ - evaluate (divide (5, -9) (PRECISE, Nothing)) `shouldThrow` anyException - it "gives a precise value when using PRECISE and no max precision" $ - divide (1, -32) (PRECISE, Nothing) `shouldBe` fromString "-0.03125" - it "gives a precise value when using PRECISE and a sufficient precision" $ - divide (1, -32) (PRECISE, Just 5) `shouldBe` fromString "-0.03125" - it "gives a precise value when using PRECISE and a to small precision" $ - evaluate (divide (1, -32) (PRECISE, Just 4)) `shouldThrow` anyException - - describe "divide -/-" $ do - -- checking dividend and divisor < 0 - it "divides BigDecimals applying RoundingMode and precision" $ - divide (-2, -3) (HALF_UP, Just 9) `shouldBe` fromString "0.666666667" - it "always rounds down when using DOWN" $ - divide (-2, -3) (DOWN, Just 9) `shouldBe` fromString "0.666666666" - it "always rounds towards -INF when using FLOOR" $ - divide (-2, -3) (FLOOR, Just 9) `shouldBe` fromString "0.666666666" - it "rounds up when using UP when there is a remainder" $ - divide (-1, -9) (UP, Just 3) `shouldBe` fromString "0.112" - it "does not round when there is no remainder when using UP" $ - divide (-14, -100) (UP, Just 2) `shouldBe` fromString "0.14" - it "rounds towards +INF when using CEILING when there is a remainder" $ - divide (-1, -9) (CEILING, Just 3) `shouldBe` fromString "0.112" - it "does not round when there is no remainder when using UP" $ - divide (-14, -100) (CEILING, Just 2) `shouldBe` fromString "0.14" - it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ - divide (-5, -9) (HALF_DOWN, Just 4) `shouldBe` fromString "0.5555" - it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ - divide (-2, -3) (HALF_DOWN, Just 4) `shouldBe` fromString "0.6667" - it "rounds up if next decimal would be >= 5 when using HALF_UP" $ - divide (-5, -9) (HALF_UP, Just 4) `shouldBe` fromString "0.5556" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (-5, -9) (HALF_EVEN, Just 4) `shouldBe` fromString "0.5556" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (-1, -8) (HALF_EVEN, Just 2) `shouldBe` fromString "0.12" - it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ - divide (-15, -100) (HALF_EVEN, Just 1) `shouldBe` fromString "0.2" - it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ - divide (-2, -3) (HALF_EVEN, Just 4) `shouldBe` fromString "0.6667" - it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ - evaluate (divide (-5, -9) (PRECISE, Nothing)) `shouldThrow` anyException - it "gives a precise value when using PRECISE and no max precision" $ - divide (-1, -32) (PRECISE, Nothing) `shouldBe` fromString "0.03125" - it "gives a precise value when using PRECISE and a sufficient precision" $ - divide (-1, -32) (PRECISE, Just 5) `shouldBe` fromString "0.03125" - it "gives a precise value when using PRECISE and a to small precision" $ - evaluate (divide (-1, -32) (PRECISE, Just 4)) `shouldThrow` anyException - - - describe "shrink" $ do - it "removes trailing zeros while taking care of the scale" $ - nf (BigDecimal 1000 3) `shouldBe` BigDecimal 1 0 - it "does not eliminate more 0s than requested" $ - trim 2 (BigDecimal 1000 3) `shouldBe` BigDecimal 100 2 - it "does not eliminate more 0s than possible" $ - nf (BigDecimal 1230 3) `shouldBe` BigDecimal 123 2 - it "does not change the value of a BigDecimal" $ - property $ \bd n -> trim n bd === bd - - describe "matchScales" $ - it "adjusts a pair of BigDecimals to use the same scale" $ - property $ \x y -> let (x', y') = matchScales (x,y) in getScale x' === getScale y' - - describe "roundBD" $ do - it "rounds a BigDecimal " $ - roundBD (BigDecimal 123456 3) (halfUp 2) `shouldBe` BigDecimal 12346 2 - it "ignores negative scales in MathContext" $ - roundBD (BigDecimal 123456 3) (halfUp (-2)) `shouldBe` BigDecimal 123456 3 - it "ignores MathContext with scale higher than in input value" $ - roundBD (BigDecimal 123456 3) (halfUp 10) `shouldBe` BigDecimal 123456 3 +{-# OPTIONS_GHC -fno-warn-overflowed-literals #-} +module Data.BigDecimalSpec (main, spec) where + +import Control.Exception (evaluate) +import Data.BigDecimal +-- I'm redefining it to use 1000 examples + +import Data.Maybe +import Data.TestUtils (it) +import GHC.Real (Ratio ((:%))) +import Test.Hspec hiding (it) +import Test.Hspec.QuickCheck (modifyMaxSuccess) +import Test.QuickCheck (Testable (property), (===)) + +-- `main` is here so that this module can be run from GHCi on its own. It is +-- not needed for automatic spec discovery. +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "toBD" $ do + it "reads BigDecimals from strings" $ + fromString "-145.123" `shouldBe` BigDecimal (-145123) 3 + it "is inverse of toString" $ + property $ \bd -> (fromString . show) bd === (bd :: BigDecimal) + + describe "show" $ do + it "converts BigDecimals to string" $ + show (BigDecimal (-145123) 3) `shouldBe` "-145.123" + it "adds leading 0s if required" $ + show (BigDecimal (-14) 10) `shouldBe` "-0.0000000014" + it "can handle integer values" $ + show 10 `shouldBe` "10" + it "is inverse of toBD" $ + property $ \bd -> (show . fromString . show) bd === show (bd :: BigDecimal) + + describe "read" $ do + it "reads BigDecimals from strings in constructor notation" $ + read "0.76878" `shouldBe` BigDecimal 76878 5 + it "is inverse of show" $ + property $ \bd -> (read . show) bd === (bd :: BigDecimal) + + describe "show" $ do + it "converts BigDecimals to strings in constructor notation" $ + show (BigDecimal 76878 5) `shouldBe` "0.76878" + it "is inverse of read" $ + property $ \bd -> (read . show) bd === (bd :: BigDecimal) + + describe "(+)" $ do + it "adds two BigDecimals" $ + BigDecimal 73 1 + BigDecimal 270 2 `shouldBe` BigDecimal 1000 2 + modifyMaxSuccess (const 1000) $ + it "has 0 as neutral element" $ + property $ \bd -> bd + 0 === (bd :: BigDecimal) + it "adds x to (-x) yielding 0" $ + property $ \bd -> bd + (- bd) === (0 :: BigDecimal) + it "uses the max scale of the summands" $ + property $ \ai as bi bs -> max as bs === scale (BigDecimal ai as + BigDecimal bi bs) + it "uses Integer addition when summands have same scale" $ + property $ \ai bi scale -> ai + bi === value (BigDecimal ai scale + BigDecimal bi scale) + it "matches values when scaling" $ + property $ \ai bi scale -> value (BigDecimal ai scale + BigDecimal bi (scale + 1)) === 10 * ai + bi + + describe "(*)" $ do + it "multiplies BigDecimals" $ + BigDecimal 12 1 * BigDecimal 12 2 `shouldBe` BigDecimal 144 3 + it "has 1 as neutral element" $ + property $ \bd -> bd * 1 === (bd :: BigDecimal) + it "has 0 as zero element" $ + property $ \bd -> bd * 0 === (0 :: BigDecimal) + it "Uses Integer multiplication" $ + property $ \ai as bi -> BigDecimal ai as * BigDecimal bi 0 === BigDecimal (ai * bi) as + it "adds the scales of the multiplicands" $ + property $ \ai as bi bs -> BigDecimal ai as * BigDecimal bi bs === BigDecimal (ai * bi) (as + bs) + + describe "abs" $ do + it "determines the absolute value of a BigDecimal" $ + abs (BigDecimal (-12) 4) `shouldBe` BigDecimal 12 4 + it "is idempotent" $ + property $ \bd -> (abs . abs) bd === (abs bd :: BigDecimal) + it "is based on abs for Integers" $ + property $ \ai as -> abs (BigDecimal ai as) === BigDecimal (abs ai) as + it "negates for input < 0" $ + property $ \bd -> abs bd === if value bd < 0 then negate bd else bd + + describe "signum" $ do + it "determines the signature a BigDecimal" $ + signum (BigDecimal (-12) 4) `shouldBe` -1 + it "returns 1 if input > 0, zero if input == 0 and -1 if input < 0" $ + property $ \ai as -> signum (BigDecimal ai as) === if ai > 0 then 1 else if ai == 0 then 0 else -1 + it "is based on signum for Integers" $ + property $ \ai as -> signum (BigDecimal ai as) === BigDecimal (signum ai) 0 + + describe "fromInteger" $ do + it "constructs a BigDecimal from an Integer" $ + 1234 `shouldBe` BigDecimal 1234 0 + it "works for any Integer" $ + property $ \i -> fromInteger i === BigDecimal i 0 + + describe "negate" $ do + it "negates a BigDecimal" $ + negate (BigDecimal 1234 1) `shouldBe` - BigDecimal 1234 1 + it "works for any BigDecimal" $ + property $ \bd -> negate bd === (- bd :: BigDecimal) + it "is the same as *(-1)" $ + property $ \bd -> negate bd === (-1 * bd :: BigDecimal) + it "is its own inverse" $ + property $ \bd -> negate (negate bd) === (bd :: BigDecimal) + + describe "(/)" $ do + it "divides two BigDecimals" $ + BigDecimal 16 1 / BigDecimal 4 1 `shouldBe` BigDecimal 4 0 + it "yields x for x/1 for any x" $ + property $ \x -> x / 1 === (x :: BigDecimal) + it "yields 1 for x/x any non-zero x" $ + property $ \x -> if x /= (0 :: BigDecimal) then x / x === 1 else 1 === 1 + it "throws an Arithmetic exception when dividing by 0" $ + property $ \bd -> evaluate (bd / 0 :: BigDecimal) `shouldThrow` anyArithException + it "yields y for (x*y)/x for any nonzero x" $ + property $ \x y -> y === if x == (0 :: BigDecimal) then y else (x * y) / x + it "rounds up if next decimal would be > 5" $ + 6 / 9 `shouldBe` fromString "0.6667" + it "rounds up if next decimal would be = 5" $ + 5 / 9 `shouldBe` fromString "0.5556" + it "rounds down if next decimal would be < 5" $ + 4 / 9 `shouldBe` fromString "0.4444" + + describe "fromRational" $ do + it "constructs a BigDecimal from a Ratio" $ + fromRational (1 :% 32) `shouldBe` 1 / BigDecimal 32 0 + it "works for any non-zero divisors" $ + property $ \x y -> if y == 0 then 1 === 1 else fromRational (x :% y) === BigDecimal x 0 / BigDecimal y 0 + + describe "toRational" $ do + it "converts a BigDecimal to a Ratio" $ + toRational (1 / BigDecimal 32 0) `shouldBe` (1 :% 32) + it "is inverse to fromRational" $ + property $ \x -> (x :: BigDecimal) === fromRational (toRational x) + + describe "divide +/+" $ do + -- checking expresions >= 0 + it "divides BigDecimals applying RoundingMode and precision" $ + divide (2, 3) (HALF_UP, Just 9) `shouldBe` fromString "0.666666667" + it "always rounds down when using DOWN" $ + divide (2, 3) (DOWN, Just 9) `shouldBe` fromString "0.666666666" + it "always rounds down when using FLOOR" $ + divide (2, 3) (FLOOR, Just 9) `shouldBe` fromString "0.666666666" + it "rounds up when using UP when there is a remainder" $ + divide (1, 9) (UP, Just 3) `shouldBe` fromString "0.112" + it "does not round when there is no remainder when using UP" $ + divide (14, 100) (UP, Just 2) `shouldBe` fromString "0.14" + it "rounds up when using UP when there is a remainder" $ + divide (1, 9) (CEILING, Just 3) `shouldBe` fromString "0.112" + it "does not round when there is no remainder when using UP" $ + divide (14, 100) (CEILING, Just 2) `shouldBe` fromString "0.14" + it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ + divide (5, 9) (HALF_DOWN, Just 4) `shouldBe` fromString "0.5555" + it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ + divide (2, 3) (HALF_DOWN, Just 4) `shouldBe` fromString "0.6667" + it "rounds up if next decimal would be >= 5 when using HALF_UP" $ + divide (5, 9) (HALF_UP, Just 4) `shouldBe` fromString "0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (5, 9) (HALF_EVEN, Just 4) `shouldBe` fromString "0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (1, 8) (HALF_EVEN, Just 2) `shouldBe` fromString "0.12" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (15, 100) (HALF_EVEN, Just 1) `shouldBe` fromString "0.2" + it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ + divide (2, 3) (HALF_EVEN, Just 4) `shouldBe` fromString "0.6667" + it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ + evaluate (divide (5, 9) (PRECISE, Nothing)) `shouldThrow` anyException + it "gives a precise value when using PRECISE and no max precision" $ + divide (1, 32) (PRECISE, Nothing) `shouldBe` fromString "0.03125" + it "gives a precise value when using PRECISE and a sufficient precision" $ + divide (1, 32) (PRECISE, Just 5) `shouldBe` fromString "0.03125" + it "gives a precise value when using PRECISE and a to small precision" $ + evaluate (divide (1, 32) (PRECISE, Just 4)) `shouldThrow` anyException + + describe "divide -/+" $ do + -- checking dividend < 0 + it "divides BigDecimals applying RoundingMode and precision" $ + divide (-2, 3) (HALF_UP, Just 9) `shouldBe` fromString "-0.666666667" + it "always rounds down when using DOWN" $ + divide (-2, 3) (DOWN, Just 9) `shouldBe` fromString "-0.666666666" + it "always rounds towards -INF when using FLOOR" $ + divide (-2, 3) (FLOOR, Just 9) `shouldBe` fromString "-0.666666667" + it "rounds up when using UP when there is a remainder" $ + divide (-1, 9) (UP, Just 3) `shouldBe` fromString "-0.112" + it "does not round when there is no remainder when using UP" $ + divide (-14, 100) (UP, Just 2) `shouldBe` fromString "-0.14" + it "rounds towards +INF when using CEILING when there is a remainder" $ + divide (-1, 9) (CEILING, Just 3) `shouldBe` fromString "-0.111" + it "does not round when there is no remainder when using UP" $ + divide (-14, 100) (CEILING, Just 2) `shouldBe` fromString "-0.14" + it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ + divide (-5, 9) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.5555" + it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ + divide (-2, 3) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.6667" + it "rounds up if next decimal would be >= 5 when using HALF_UP" $ + divide (-5, 9) (HALF_UP, Just 4) `shouldBe` fromString "-0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-5, 9) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-1, 8) (HALF_EVEN, Just 2) `shouldBe` fromString "-0.12" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-15, 100) (HALF_EVEN, Just 1) `shouldBe` fromString "-0.2" + it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ + divide (-2, 3) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.6667" + it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ + evaluate (divide (-5, 9) (PRECISE, Nothing)) `shouldThrow` anyException + it "gives a precise value when using PRECISE and no max precision" $ + divide (-1, 32) (PRECISE, Nothing) `shouldBe` fromString "-0.03125" + it "gives a precise value when using PRECISE and a sufficient precision" $ + divide (-1, 32) (PRECISE, Just 5) `shouldBe` fromString "-0.03125" + it "gives a precise value when using PRECISE and a to small precision" $ + evaluate (divide (-1, 32) (PRECISE, Just 4)) `shouldThrow` anyException + + describe "divide +/-" $ do + -- checking divisor < 0 + it "divides BigDecimals applying RoundingMode and precision" $ + divide (2, -3) (HALF_UP, Just 9) `shouldBe` fromString "-0.666666667" + it "always rounds down when using DOWN" $ + divide (2, -3) (DOWN, Just 9) `shouldBe` fromString "-0.666666666" + it "always rounds towards -INF when using FLOOR" $ + divide (2, -3) (FLOOR, Just 9) `shouldBe` fromString "-0.666666667" + it "rounds up when using UP when there is a remainder" $ + divide (1, -9) (UP, Just 3) `shouldBe` fromString "-0.112" + it "does not round when there is no remainder when using UP" $ + divide (14, -100) (UP, Just 2) `shouldBe` fromString "-0.14" + it "rounds towards +INF when using CEILING when there is a remainder" $ + divide (1, -9) (CEILING, Just 3) `shouldBe` fromString "-0.111" + it "does not round when there is no remainder when using UP" $ + divide (14, -100) (CEILING, Just 2) `shouldBe` fromString "-0.14" + it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ + divide (5, -9) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.5555" + it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ + divide (2, -3) (HALF_DOWN, Just 4) `shouldBe` fromString "-0.6667" + it "rounds up if next decimal would be >= 5 when using HALF_UP" $ + divide (5, -9) (HALF_UP, Just 4) `shouldBe` fromString "-0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (5, -9) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (1, -8) (HALF_EVEN, Just 2) `shouldBe` fromString "-0.12" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (15, -100) (HALF_EVEN, Just 1) `shouldBe` fromString "-0.2" + it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ + divide (2, -3) (HALF_EVEN, Just 4) `shouldBe` fromString "-0.6667" + it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ + evaluate (divide (5, -9) (PRECISE, Nothing)) `shouldThrow` anyException + it "gives a precise value when using PRECISE and no max precision" $ + divide (1, -32) (PRECISE, Nothing) `shouldBe` fromString "-0.03125" + it "gives a precise value when using PRECISE and a sufficient precision" $ + divide (1, -32) (PRECISE, Just 5) `shouldBe` fromString "-0.03125" + it "gives a precise value when using PRECISE and a to small precision" $ + evaluate (divide (1, -32) (PRECISE, Just 4)) `shouldThrow` anyException + + describe "divide -/-" $ do + -- checking dividend and divisor < 0 + it "divides BigDecimals applying RoundingMode and precision" $ + divide (-2, -3) (HALF_UP, Just 9) `shouldBe` fromString "0.666666667" + it "always rounds down when using DOWN" $ + divide (-2, -3) (DOWN, Just 9) `shouldBe` fromString "0.666666666" + it "always rounds towards -INF when using FLOOR" $ + divide (-2, -3) (FLOOR, Just 9) `shouldBe` fromString "0.666666666" + it "rounds up when using UP when there is a remainder" $ + divide (-1, -9) (UP, Just 3) `shouldBe` fromString "0.112" + it "does not round when there is no remainder when using UP" $ + divide (-14, -100) (UP, Just 2) `shouldBe` fromString "0.14" + it "rounds towards +INF when using CEILING when there is a remainder" $ + divide (-1, -9) (CEILING, Just 3) `shouldBe` fromString "0.112" + it "does not round when there is no remainder when using UP" $ + divide (-14, -100) (CEILING, Just 2) `shouldBe` fromString "0.14" + it "rounds down if next decimal would be <= 5 when using HALF_DOWN" $ + divide (-5, -9) (HALF_DOWN, Just 4) `shouldBe` fromString "0.5555" + it "rounds up if next decimal would be > 5 when using HALF_DOWN" $ + divide (-2, -3) (HALF_DOWN, Just 4) `shouldBe` fromString "0.6667" + it "rounds up if next decimal would be >= 5 when using HALF_UP" $ + divide (-5, -9) (HALF_UP, Just 4) `shouldBe` fromString "0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-5, -9) (HALF_EVEN, Just 4) `shouldBe` fromString "0.5556" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-1, -8) (HALF_EVEN, Just 2) `shouldBe` fromString "0.12" + it "rounds to next even number if next decimal would be == 5 when using HALF_EVEN" $ + divide (-15, -100) (HALF_EVEN, Just 1) `shouldBe` fromString "0.2" + it "rounds up if next decimal would be > 5 when using HALF_EVEN" $ + divide (-2, -3) (HALF_EVEN, Just 4) `shouldBe` fromString "0.6667" + it "throws an exception when PRECISE is used and a non-terminating decimal expansion is detected" $ + evaluate (divide (-5, -9) (PRECISE, Nothing)) `shouldThrow` anyException + it "gives a precise value when using PRECISE and no max precision" $ + divide (-1, -32) (PRECISE, Nothing) `shouldBe` fromString "0.03125" + it "gives a precise value when using PRECISE and a sufficient precision" $ + divide (-1, -32) (PRECISE, Just 5) `shouldBe` fromString "0.03125" + it "gives a precise value when using PRECISE and a to small precision" $ + evaluate (divide (-1, -32) (PRECISE, Just 4)) `shouldThrow` anyException + + describe "shrink" $ do + it "removes trailing zeros while taking care of the scale" $ + nf (BigDecimal 1000 3) `shouldBe` BigDecimal 1 0 + it "does not eliminate more 0s than requested" $ + trim 2 (BigDecimal 1000 3) `shouldBe` BigDecimal 100 2 + it "does not eliminate more 0s than possible" $ + nf (BigDecimal 1230 3) `shouldBe` BigDecimal 123 2 + it "does not change the value of a BigDecimal" $ + property $ \bd n -> trim n bd === bd + + describe "matchScales" $ + it "adjusts a pair of BigDecimals to use the same scale" $ + property $ \x y -> let (x', y') = matchScales (x, y) in scale x' === scale y' + + describe "roundBD" $ do + it "rounds a BigDecimal " $ + roundBD (BigDecimal 123456 3) (halfUp 2) `shouldBe` BigDecimal 12346 2 + it "reject negative scales in MathContext" $ + evaluate (roundBD (BigDecimal 123456 3) (halfUp (-2))) `shouldThrow` anyArithException + it "ignores MathContext with scale higher than in input value" $ + roundBD (BigDecimal 123456 3) (halfUp 10) `shouldBe` BigDecimal 123456 3 + + describe "handle values > 10^308" $ do + it "divides 2 * 10 ^ 307" $ + divideInfo (fromInteger (2 * 10 ^ 307), fromInteger 1) (HALF_UP, Nothing) `shouldBe` (311, 2000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000) + + it "divides 2 * 10 ^ 308" $ + divideInfo (fromInteger (2 * 10 ^ 308), fromInteger 1) (HALF_UP, Nothing) `shouldBe` (312, 200000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000) + +divideInfo (a, b) (rMode, prefScale) = + let (BigDecimal numA _, BigDecimal numB _) = matchScales (a, b) + maxPrecision = fromMaybe (precision a + round (fromNatural (precision b) * 10 / 3)) prefScale + in (maxPrecision, numA * (10 :: Integer) ^ maxPrecision) diff --git a/test/Data/BigFloatingSpec.hs b/test/Data/BigFloatingSpec.hs --- a/test/Data/BigFloatingSpec.hs +++ b/test/Data/BigFloatingSpec.hs @@ -1,45 +1,45 @@ -module Data.BigFloatingSpec - (main, spec) -where - -import Control.Exception (evaluate) -import Data.BigDecimal -import Data.BigFloating -import GHC.Real (Ratio ((:%))) -import Test.Hspec hiding (it) -import Data.TestUtils (it) -- I'm redefining it to use 1000 examples -import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess) -import Test.QuickCheck - - --- `main` is here so that this module can be run from GHCi on its own. It is --- not needed for automatic spec discovery. -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - -- mathematical functions on BigDecimals - describe "sqr" $ do - it "computes the square root of any non-negative BigDecimal" $ - property $ \x scale -> let (x', r) = (abs x, sqr x' $ halfUp scale) in abs (r*r - x') < BigDecimal 1000 scale - it "throws an exception if applied to a negative number" $ - evaluate (sqr (-16) $ halfUp 2) `shouldThrow` anyException - - -- mathematical functions on BigDecimals - describe "nthRoot" $ do - it "computes the nth root of any non-negative BigDecimal" $ - property $ \x n -> let (x', n', r) = (1+ abs x, 1+abs n, nthRoot x' n' (halfUp 10)) in abs (r^n' - x') < BigDecimal (n'*10000) 10 - it "throws an exception if trying to get even root of a negative number" $ - evaluate (nthRoot (-16) 4 $ halfUp 2) `shouldThrow` anyException - --it "computes odd roots of any negative BigDecimal" $ - -- property $ \x n -> let (x', n', r) = ((-1)- abs x, if even n then 1 + abs n else abs n, nthRoot x' n' (halfUp 10)) in abs (r^n' - x') < BigDecimal (n'*10000) 10 - - - describe "pi" $ - it "computes pi with a default precision of 100 decimal digits" $ - pi `shouldBe` fromString "3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679" - - describe "piChudnovsky" $ - it "computes pi with arbitrary precision (demonstrating it with 1000 digits)" $ - piChudnovsky (FLOOR, Just 1000) `shouldBe` fromString "3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094330572703657595919530921861173819326117931051185480744623799627495673518857527248912279381830119491298336733624406566430860213949463952247371907021798609437027705392171762931767523846748184676694051320005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235420199561121290219608640344181598136297747713099605187072113499999983729780499510597317328160963185950244594553469083026425223082533446850352619311881710100031378387528865875332083814206171776691473035982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201989" +module Data.BigFloatingSpec + (main, spec) +where + +import Control.Exception (evaluate) +import Data.BigDecimal +import Data.BigFloating +import GHC.Real (Ratio ((:%))) +import Test.Hspec hiding (it) +import Data.TestUtils (it) -- I'm redefining it to use 1000 examples +import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess) +import Test.QuickCheck + + +-- `main` is here so that this module can be run from GHCi on its own. It is +-- not needed for automatic spec discovery. +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + -- mathematical functions on BigDecimals + describe "sqr" $ do + it "computes the square root of any non-negative BigDecimal" $ + property $ \x scale -> let (x', r) = (abs x, sqr x' $ halfUp scale) in abs (r*r - x') < BigDecimal 1000 scale + it "throws an exception if applied to a negative number" $ + evaluate (sqr (-16) $ halfUp 2) `shouldThrow` anyException + + -- mathematical functions on BigDecimals + describe "nthRoot" $ do + it "computes the nth root of any non-negative BigDecimal" $ + property $ \x n -> let (x', n', r) = (1+ abs x, 1+abs n, nthRoot x' n' (halfUp 10)) in abs (r^n' - x') < BigDecimal (fromIntegral n'*10000) 10 + it "throws an exception if trying to get even root of a negative number" $ + evaluate (nthRoot (-16) 4 $ halfUp 2) `shouldThrow` anyException + --it "computes odd roots of any negative BigDecimal" $ + -- property $ \x n -> let (x', n', r) = ((-1)- abs x, if even n then 1 + abs n else abs n, nthRoot x' n' (halfUp 10)) in abs (r^n' - x') < BigDecimal (n'*10000) 10 + + + describe "pi" $ + it "computes pi with a default precision of 100 decimal digits" $ + pi `shouldBe` fromString "3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679" + + describe "piChudnovsky" $ + it "computes pi with arbitrary precision (demonstrating it with 1000 digits)" $ + piChudnovsky (FLOOR, Just 1000) `shouldBe` fromString "3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917153643678925903600113305305488204665213841469519415116094330572703657595919530921861173819326117931051185480744623799627495673518857527248912279381830119491298336733624406566430860213949463952247371907021798609437027705392171762931767523846748184676694051320005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235420199561121290219608640344181598136297747713099605187072113499999983729780499510597317328160963185950244594553469083026425223082533446850352619311881710100031378387528865875332083814206171776691473035982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201989" diff --git a/test/Data/TestUtils.hs b/test/Data/TestUtils.hs --- a/test/Data/TestUtils.hs +++ b/test/Data/TestUtils.hs @@ -1,19 +1,25 @@ -module Data.TestUtils where - -import Test.Hspec hiding (it) -import qualified Test.Hspec as HS (it) -import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess) -import Test.QuickCheck hiding (shrink) -import Data.BigDecimal - --- redefine it to use a sample with 1000 elements -it :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) -it label action = modifyMaxSuccess (const 1000) $ HS.it label action - --- arbitrary BigDecimals can be constructed using any Integer as unscaled value --- and any non-negative Integer as scale -instance Arbitrary BigDecimal where - arbitrary = do - unscaledValue <- arbitrary - NonNegative scale <- arbitrary - return $ BigDecimal unscaledValue scale +module Data.TestUtils where + +import Test.Hspec hiding (it) +import qualified Test.Hspec as HS (it) +import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess) +import Test.QuickCheck hiding (shrink) +import Data.BigDecimal +import GHC.Natural + +-- redefine it to use a sample with 1000 elements +it :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) +it label action = modifyMaxSuccess (const 1000) $ HS.it label action + +instance Arbitrary Natural where + arbitrary = do + NonNegative n <- arbitrary + pure $ fromInteger n + +-- arbitrary BigDecimals can be constructed using any Integer as unscaled value +-- and any non-negative Integer as scale +instance Arbitrary BigDecimal where + arbitrary = do + unscaledValue <- arbitrary + NonNegative scale <- arbitrary + return $ BigDecimal unscaledValue scale