HasBigDecimal 0.1.1 → 0.2.0.0
raw patch · 11 files changed
+1308/−990 lines, 11 filesdep +criteriondep ~basenew-component:exe:HasBigDecimal-Demonew-component:exe:benchmarkPVP ok
version bump matches the API change (PVP)
Dependencies added: criterion
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.BigDecimal: getScale :: BigDecimal -> Integer
- Data.BigDecimal: getValue :: BigDecimal -> Integer
- Data.BigDecimal: toString :: BigDecimal -> String
- Data.BigDecimal: type MathContext = (RoundingMode, Maybe Integer)
+ Data.BigDecimal: [scale] :: BigDecimal -> Natural
+ Data.BigDecimal: [value] :: BigDecimal -> Integer
+ Data.BigDecimal: fromNatural :: Num a => Natural -> a
+ Data.BigDecimal: fromStringMaybe :: String -> Maybe BigDecimal
+ Data.BigDecimal: type RoundingAdvice = (RoundingMode, Maybe Natural)
- Data.BigDecimal: BigDecimal :: Integer -> Integer -> BigDecimal
+ Data.BigDecimal: BigDecimal :: Integer -> Natural -> BigDecimal
- Data.BigDecimal: divide :: (BigDecimal, BigDecimal) -> MathContext -> BigDecimal
+ Data.BigDecimal: divide :: (BigDecimal, BigDecimal) -> RoundingAdvice -> BigDecimal
- Data.BigDecimal: fromRatio :: Rational -> MathContext -> BigDecimal
+ Data.BigDecimal: fromRatio :: Rational -> RoundingAdvice -> BigDecimal
- Data.BigDecimal: halfUp :: Integer -> MathContext
+ Data.BigDecimal: halfUp :: Natural -> RoundingAdvice
- Data.BigDecimal: precision :: BigDecimal -> Integer
+ Data.BigDecimal: precision :: BigDecimal -> Natural
- Data.BigDecimal: roundBD :: BigDecimal -> MathContext -> BigDecimal
+ Data.BigDecimal: roundBD :: BigDecimal -> RoundingAdvice -> BigDecimal
- Data.BigDecimal: trim :: Integer -> BigDecimal -> BigDecimal
+ Data.BigDecimal: trim :: Natural -> BigDecimal -> BigDecimal
- Data.BigFloating: nthRoot :: BigDecimal -> Integer -> MathContext -> BigDecimal
+ Data.BigFloating: nthRoot :: BigDecimal -> Natural -> RoundingAdvice -> BigDecimal
- Data.BigFloating: piChudnovsky :: MathContext -> BigDecimal
+ Data.BigFloating: piChudnovsky :: RoundingAdvice -> BigDecimal
- Data.BigFloating: sqr :: BigDecimal -> MathContext -> BigDecimal
+ Data.BigFloating: sqr :: BigDecimal -> RoundingAdvice -> BigDecimal
Files
- HasBigDecimal.cabal +85/−37
- LICENSE +201/−201
- README.md +101/−59
- benchmark/Main.hs +29/−0
- demo/Main.hs +43/−0
- demo/Taylor.hs +105/−0
- src/Data/BigDecimal.hs +238/−214
- src/Data/BigFloating.hs +107/−100
- test/Data/BigDecimalSpec.hs +329/−315
- test/Data/BigFloatingSpec.hs +45/−45
- test/Data/TestUtils.hs +25/−19
HasBigDecimal.cabal view
@@ -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 <https://github.com/thma/HasBigDecimal#readme> +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.*
LICENSE view
@@ -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.
README.md view
@@ -1,59 +1,101 @@-[](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--```-+[](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 + + +``` +
+ benchmark/Main.hs view
@@ -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 ()
+ demo/Main.hs view
@@ -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)
+ demo/Taylor.hs view
@@ -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)) + + +
src/Data/BigDecimal.hs view
@@ -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
src/Data/BigFloating.hs view
@@ -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 + +
test/Data/BigDecimalSpec.hs view
@@ -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)
test/Data/BigFloatingSpec.hs view
@@ -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"
test/Data/TestUtils.hs view
@@ -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