diff --git a/README.markdown b/README.markdown new file mode 100644 --- /dev/null +++ b/README.markdown @@ -0,0 +1,23 @@ +# **Factory**. + +This is **Factory**, a library of number-theory functions. + +## Installation + +It can be built and installed using [Cabal](https://www.haskell.org/cabal/users-guide/installing-packages.html). + +## Documentation + +More information about this library can be found at [Factory](http://functionalley.eu/Factory/factory.html). + +## License + +For information on copying and distributing this package, see the file **LICENSE** in this directory. + +## Bug-reporting + +Bug-reports should be emailed to . + +## Author + +This library is written and maintained by Dr. Alistair Ward. diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -1,88 +0,0 @@ -2011-03-01 Dr. Alistair Ward - -0.0.0.1 - * First version of the package. -0.0.0.2 - * Created the modules; "Factory.Test.QuickCheck.Bounds", "Factory.Math.Implementations.Pi.Borwein.*" and "Factory.Test.Performance.Statistics". - * Created a new module "Factory.Data.PrimeFactors", and migrated definitions from both "Factory.Math.PrimeFactorisation" and "Factory.Math.Implementations.PrimeFactorisation". - * Created the class 'Factory.Math.Factorial.Factorial' and a new module "Factory.Math.Implementations.Factorial". - Moved existing implementation (Bisection) into the new module, with a new implementation (PrimeFactorisation). - * Added the function 'Factory.Math.Summation.sumR'. - * Added a parameter to the functions 'Factory.Math.DivideAndConquer.divideAndConquer' and 'Factory.Data.Bounds.divideAndConquer', to permit asymmetric bisection. - * Added methods to class "Factory.Math.Pi.Algorithm" to permit the retrieval of /Pi/ as a 'Rational' or a 'String'. - * Renamed the function 'Factory.Math.Precision.capPrecision' to 'Factory.Math.Precision.simplify'. - * Removed the module "Factory.Test.Performance.Exponential". - * Removed the function 'Factory.Math.Power.raise', which was no more efficient than ghc's implementation of '(^)'. - * Uploaded to . -0.1.0.0 - * Amended 'factory.cabal' to more correctly specify the dependency on package 'toolshed'. - * Added the module "Factory.Math.Probability". - * Renamed the module "Factory.Data.Bounds" to "Factory.Data.Interval", - and added the functions; 'Factory.Data.Interval.precisely', 'Factory.Data.Interval.shift', 'Factory.Data.Interval.closedUnitInterval'. - * Guarded 'eager-blackholing' flag in /cabal/ file. -0.1.0.1 - * Renamed classes "Factory.Math.[Primality, Pi, Factorial, SquareRoot, PrimeFactorisation].Algorithm" to "Factory.Math.[Primality, Pi, Factorial, SquareRoot, PrimeFactorisation].Algorithmic", to distinguish them from the data-types which implement them. - * Added the modules "Factory.Math.Hyperoperation", "Factory.Test.QuickCheck.Hyperoperation" and "Factory.Test.Performance.Hyperoperation". - * Added the modules "Factory.Math.Primes", "Factory.Math.Implementation.Primes", "Factory.Test.Performance.Primes", "Factory.Test.QuickCheck.Primes" and "Factory.Data.PrimeWheel". - * Added the function 'Factory.Math.PrimeFactorisation.squareFree'. - * Added rewrite-rules to specialise 'Factory.Math.Power.isPerfectPower' for type-parameter='Int'. - * Recoded "Factory.Math.Radix" to the interface "Data.Array.IArray.IArray", rather than the data-type "Data.Array.Array". -0.1.0.2 - * Added 'Factory.Math.Primes.primorial'. - * Altered 'Factory.Math.Implementations.Primes.trialDivision' to take an integer defining the size of a 'Factory.Data.PrimeWheel', from which candidates are extracted. - * Removed the command-line option 'primesPerformanceGraph', which appears to memoise data from previous tests. - * Uploaded to . -0.1.0.3 - * Qualified 'Factory.Math.Implementations.Primes.trialDivision' with /NOINLINE/ pragma, to block optimization which conflicts with rewrite-rule for 'Factory.Math.Implementations.Primes.sieveOfEratosthenes' ! - * Re-coded 'Factory.Data.PrimeWheel.coprimes' and 'Factory.Math.Implementations.Primes.sieveOfEratosthenes', to use a map of lists, rather than a map of lists of lists. -0.2.0.0 - * Separately coded the special-case of a 'Factory.Data.PrimeWheel' of size zero, in 'Factory.Math.Implementations.Primes.trialDivision', to achieve better space-complexity. - * Added 'Factory.Data.PrimeWheel.estimateOptimalSize'. - * Split "Factory.Math.Implementations.Primes" into; "Factory.Math.Implementations.Primes.SieveOfEratosthenes", "Factory.Math.Implementations.Primes.TurnersSieve", "Factory.Math.Implementations.Primes.TrialDivision", and added a new module "Factory.Math.Implementations.Primes.SieveOfAtkin". This makes the rewrite-rules less fragile. - * Coded 'Factory.Math.Radix.digitalRoot' more concisely. - * Split "Factory.Math.Power" into an additional module "Factory.Math.PerfectPower". - * Replaced '(+ 1)' and '(- 1)' with the faster calls 'succ' and 'pred'. - * Used 'Paths_factory.version' in 'Main', rather than hard-coding it. -0.2.0.1 - * Changed by Lennart Augustsson, to replace "System" with "System.Environment" and "System.Exit", and to remove dependency on "haskell98". -0.2.0.2 - * Reacted to new module-hierarchy and addition of method 'ToolShed.SelfValidate.getErrors', in 'toolshed-0.13.0.0'. - * Made 'Factory.Data.Interval.getLength' private. - * Added 'Factory.Data.Interval.mkBounded'. - * Generalised "Factory.Math.Statistics" to accept any 'Data.Foldable.Foldable' 'Functor', rather than merely lists. -0.2.0.3 - * Added class 'Show' to some contexts in "Factory.Math.Radix", for migration to 'ghc-7.4'. -0.2.0.4 - * Added classes 'Eq' and 'Show' to many contexts, for migration to 'ghc-7.4'. - * Minor re-formatting. -0.2.0.5 - * Minor clarification of 'Factory.Math.Implementations.Primality.witnessesCompositeness'. - * Added details to any failure to parse the command-line arguments. - * Defined package's name using program's name, in "Main.hs". - * Added 'Factory.Math.Primes.mersenneNumbers'. - * Replaced use of 'mod' on positive integers, with the faster 'rem', in 'Factory.Math.Implementations.Pi.Spigot.Spigot.processColumns', 'Factory.Math.Implementations.Primality.witnessesCompositeness', 'Factory.Math.Implementations.Primes.TrialDivision.isIndivisibleBy', 'Factory.Math.Implementations.Primes.SieveOfAtkin.polynomialTypeLookup', 'Factory.Math.Implementations.Primes.SieveOfAtkin.findPolynomialSolutions', 'Factory.Math.Implementations.Primes.TurnersSieve.turnersSieve', 'Factory.Math.PerfectPower.maybeSquareNumber'. - * Replaced calls to 'realToFrac' with 'toRational' in; "Factory.Math.Implementations.SquareRoot", 'Factory.Math.Statistics.getDispersionFromMean', 'Factory.Math.SquareRoot.getDiscrepancy', 'Factory.Math.SquareRoot.getAccuracy', to more clearly represent the required operation. -0.2.1.0 - * Refactored 'Factory.Test.QuickCheck.QuickChecks'. - * Remove redundant import of 'Data.Ratio' from many modules. - * Refactored 'Factory.Math.Radix.encodes' to make use of 'Data.List.genericLength', & removed empty 'where'. - * Explicitly closed standard-input in the executable. - * Replaced calls to 'error' from inside the IO-monad, with 'Control.Monad.fail'. - * Added function 'Factory.Math.Precision.roundTo'. - * Trapped command-line arguments to which garbage has been appended. - * Corrected the output of 'Main.main.optDescrList.printVersion'. - * Removed the integral population-size parameter from 'Factory.Math.Probability.generateContinuousPopulation' & 'Factory.Math.Probability.generateDiscretePopulation', making the result conceptually infinite. - * Created class 'Factory.Math.Probability.Distribution', to which data-types 'Factory.Math.Probability.ContinuousDistribution' & 'Factory.Math.Probability.DiscreteDistribution' conform. - * Added data-constructors 'Factory.Math.Probability.ExponentialDistribution', 'Factory.Math.Probability.ShiftedGeometricDistribution' & 'Factory.Math.Probability.LogNormal'. - * Added command-line option '--plotDiscreteDistribution' to "Main". - * Removed Preprocessor-check on the version of package 'toolshed', in "Factory/Math/Summation" & "Factory/Data/PrimeFactors". -0.2.1.1 - * Added 'Factory.Test.QuickCheck.Probability.prop_logNormalDistributionEqual'. - * Removed /INLINE/ pragma from 'Factory.Math.Implementations.Primes.TrialDivision.isIndivisibleBy', since to be effective it must be called with fully applied parameters (which it isn't). - * Un eta-reduced 'Factory.Math.Power.square', since we want it to be inlined when called with one argument. - * Tested with 'haskell-platform-2013.2.0.0'. - * Replaced preprocessor-directives with 'build-depends' constraints in 'factory.cabal'. - * Added function 'Factory.Math.Statistics.getWeightedMean' & corresponding tests in module "Factory.Test.QuickCheck.Statistics". - * Since '(<$>)' is exported from the Prelude from 'base-4.8', imported "Prelude" hiding '(<*>)' into module "Factory.Data.Monomial", since this symbol is defined locally for other purposes. - * Either replaced instances of '(<$>)' with 'fmap' to avoid ambiguity between "Control.Applicative" & "Prelude" which (from 'base-4.8') also exports this symbol, or hid the symbol when importing the "Prelude".. - diff --git a/changelog.markdown b/changelog.markdown new file mode 100644 --- /dev/null +++ b/changelog.markdown @@ -0,0 +1,98 @@ +# 2011-03-01 Dr. Alistair Ward + +## 0.0.0.1 + * First version of the package. +## 0.0.0.2 + * Created the modules; **Factory.Test.QuickCheck.Bounds**, **Factory.Math.Implementations.Pi.Borwein** & **Factory.Test.Performance.Statistics** . + * Created a new module **Factory.Data.PrimeFactors**, and migrated definitions from both **Factory.Math.PrimeFactorisation** & **Factory.Math.Implementations.PrimeFactorisation**. + * Created the class `Factory.Math.Factorial.Factorial` and a new module **Factory.Math.Implementations.Factorial**. + Moved existing implementation (`Bisection`) into the new module, with a new implementation (`PrimeFactorisation`). + * Added the function `Factory.Math.Summation.sumR`. + * Added a parameter to the functions `Factory.Math.DivideAndConquer.divideAndConquer` and `Factory.Data.Bounds.divideAndConquer`, to permit asymmetric bisection. + * Added methods to class `Factory.Math.Pi.Algorithm` to permit the retrieval of *Pi* as a `Rational` or a `String`. + * Renamed the function `Factory.Math.Precision.capPrecision` to `Factory.Math.Precision.simplify`. + * Removed the module **Factory.Test.Performance.Exponential**. + * Removed the function `Factory.Math.Power.raise`, which was no more efficient than ghc's implementation of `(^)`. + * Uploaded to [Hackage](http://hackage.haskell.org/packages/hackage.html). +## 0.1.0.0 + * Amended the *.cabal*-file to more correctly specify the dependency on package **toolshed**. + * Added the module **Factory.Math.Probability**. + * Renamed the module **Factory.Data.Bounds** to **Factory.Data.Interval**, + and added the functions; `Factory.Data.Interval.precisely`, `Factory.Data.Interval.shift`, `Factory.Data.Interval.closedUnitInterval`. + * Guarded **eager-blackholing** flag in the *cabal*-file. +## 0.1.0.1 + * Renamed classes *Factory.Math.[Primality, Pi, Factorial, SquareRoot, PrimeFactorisation].Algorithm* to *Factory.Math.[Primality, Pi, Factorial, SquareRoot, PrimeFactorisation].Algorithmic*, to distinguish them from the data-types which implement them. + * Added the modules **Factory.Math.Hyperoperation**, **Factory.Test.QuickCheck.Hyperoperation** and **Factory.Test.Performance.Hyperoperation**. + * Added the modules **Factory.Math.Primes**, **Factory.Math.Implementation.Primes**, **Factory.Test.Performance.Primes**, **Factory.Test.QuickCheck.Primes** and **Factory.Data.PrimeWheel**. + * Added the function `Factory.Math.PrimeFactorisation.squareFree`. + * Added rewrite-rules to specialise `Factory.Math.Power.isPerfectPower` for type-parameter=`Int`. + * Recoded **Factory.Math.Radix** to the interface `Data.Array.IArray.IArray`, rather than the data-type `Data.Array.Array`. +## 0.1.0.2 + * Added `Factory.Math.Primes.primorial`. + * Altered `Factory.Math.Implementations.Primes.trialDivision` to take an integer defining the size of a `Factory.Data.PrimeWheel`, from which candidates are extracted. + * Removed the command-line option `primesPerformanceGraph`, which appears to memoise data from previous tests. + * Uploaded to [Hackage](http://hackage.haskell.org/packages/hackage.html). +## 0.1.0.3 + * Qualified `Factory.Math.Implementations.Primes.trialDivision` with **NOINLINE**-pragma, to block optimization which conflicts with rewrite-rule for `Factory.Math.Implementations.Primes.sieveOfEratosthenes` ! + * Re-coded `Factory.Data.PrimeWheel.coprimes` and `Factory.Math.Implementations.Primes.sieveOfEratosthenes`, to use a map of lists, rather than a map of lists of lists. +## 0.2.0.0 + * Separately coded the special-case of a **Factory.Data.PrimeWheel** of size zero, in `Factory.Math.Implementations.Primes.trialDivision`, to achieve better space-complexity. + * Added `Factory.Data.PrimeWheel.estimateOptimalSize`. + * Split **Factory.Math.Implementations.Primes** into; **Factory.Math.Implementations.Primes.SieveOfEratosthenes**, **Factory.Math.Implementations.Primes.TurnersSieve**, **Factory.Math.Implementations.Primes.TrialDivision**, and added a new module **Factory.Math.Implementations.Primes.SieveOfAtkin**. This makes the rewrite-rules less fragile. + * Coded `Factory.Math.Radix.digitalRoot` more concisely. + * Split **Factory.Math.Power** into an additional module **Factory.Math.PerfectPower**. + * Replaced `(+ 1)` and `(- 1)` with the faster calls `succ` and `pred`. + * Used `Paths_factory.version` in **Main**, rather than hard-coding it. +## 0.2.0.1 + * Changed by Lennart Augustsson, to replace `System` with `System.Environment` and `System.Exit`, and to remove dependency on **haskell98**. +## 0.2.0.2 + * Reacted to new module-hierarchy and addition of method `ToolShed.SelfValidate.getErrors`, in **toolshed-0.13.0.0**. + * Made `Factory.Data.Interval.getLength` private. + * Added `Factory.Data.Interval.mkBounded`. + * Generalised **Factory.Math.Statistics** to accept any `Data.Foldable.Foldable` *Functor*, rather than merely lists. +## 0.2.0.3 + * Added class `Show` to some contexts in **Factory.Math.Radix**, for migration to **ghc-7.4**. +## 0.2.0.4 + * Added classes `Eq` and `Show` to many contexts, for migration to **ghc-7.4**. + * Minor re-formatting. +## 0.2.0.5 + * Minor clarification of `Factory.Math.Implementations.Primality.witnessesCompositeness`. + * Added details to any failure to parse the command-line arguments. + * Defined package's name using program's name, in **Main.hs**. + * Added `Factory.Math.Primes.mersenneNumbers`. + * Replaced use of `mod` on positive integers, with the faster `rem`, in `Factory.Math.Implementations.Pi.Spigot.Spigot.processColumns`, `Factory.Math.Implementations.Primality.witnessesCompositeness`, `Factory.Math.Implementations.Primes.TrialDivision.isIndivisibleBy`, `Factory.Math.Implementations.Primes.SieveOfAtkin.polynomialTypeLookup`, `Factory.Math.Implementations.Primes.SieveOfAtkin.findPolynomialSolutions`, `Factory.Math.Implementations.Primes.TurnersSieve.turnersSieve`, `Factory.Math.PerfectPower.maybeSquareNumber`. + * Replaced calls to `realToFrac` with `toRational` in; **Factory.Math.Implementations.SquareRoot**, `Factory.Math.Statistics.getDispersionFromMean`, `Factory.Math.SquareRoot.getDiscrepancy`, `Factory.Math.SquareRoot.getAccuracy`, to more clearly represent the required operation. +## 0.2.1.0 + * Refactored **Factory.Test.QuickCheck.QuickChecks**. + * Remove redundant import of `Data.Ratio` from many modules. + * Refactored `Factory.Math.Radix.encodes` to make use of `Data.List.genericLength`, & removed empty `where`. + * Explicitly closed standard-input in the executable. + * Replaced calls to `error` from inside the IO-monad, with `Control.Monad.fail`. + * Added function `Factory.Math.Precision.roundTo`. + * Trapped command-line arguments to which garbage has been appended. + * Corrected the output of `Main.main.optDescrList.printVersion`. + * Removed the integral population-size parameter from `Factory.Math.Probability.generateContinuousPopulation` & `Factory.Math.Probability.generateDiscretePopulation`, making the result conceptually infinite. + * Created class `Factory.Math.Probability.Distribution`, to which data-types `Factory.Math.Probability.ContinuousDistribution` & `Factory.Math.Probability.DiscreteDistribution` conform. + * Added data-constructors `Factory.Math.Probability.ExponentialDistribution`, `Factory.Math.Probability.ShiftedGeometricDistribution` & `Factory.Math.Probability.LogNormal`. + * Added command-line option **--plotDiscreteDistribution** to **Main**. + * Removed Preprocessor-check on the version of package **toolshed**, in **Factory/Math/Summation** & **Factory/Data/PrimeFactors**. +## 0.2.1.1 + * Added `Factory.Test.QuickCheck.Probability.prop_logNormalDistributionEqual`. + * Removed /INLINE/ pragma from `Factory.Math.Implementations.Primes.TrialDivision.isIndivisibleBy`, since to be effective it must be called with fully applied parameters (which it isn't). + * Un eta-reduced `Factory.Math.Power.square`, since we want it to be inlined when called with one argument. + * Tested with **haskell-platform-2013.2.0.0**. + * Replaced preprocessor-directives with **build-depends** constraints in the *.cabal*-file. + * Added function `Factory.Math.Statistics.getWeightedMean` & corresponding tests in module **Factory.Test.QuickCheck.Statistics**. + * Since `(<$>)` is exported from the Prelude from **base-4.8**, imported **Prelude** hiding `(<*>)` into module **Factory.Data.Monomial**, since this symbol is defined locally for other purposes. + * Either replaced instances of `(<$>)` with `fmap` to avoid ambiguity between **Control.Applicative** & **Prelude** which (from **base-4.8**) also exports this symbol, or hid the symbol when importing the **Prelude**.. +## 0.2.1.2 + * Hid `(<$>)` when importing the **Prelude** into module **src/Factory/Test/QuickCheck/Pi**. + * Added the compiler to the output returned for the command-line option **version**. + * Changed flag **threaded** in the *.cabal*-file to **manual**. + * Added **Default-language**-specification to the *.cabal*-file. + * Added file **README.markdown**. + * Converted this file to markdown-format. + * Replaced `System.Exit.exitWith (System.Exit.ExitFailure 1)` with `System.Exit.exitFailure` & `System.Exit.exitWith System.Exit.ExitSuccess` with `System.Exit.exitSuccess`. + * Moved the entry-point to the test-suite from **Main.hs** to **Test.hs**, both to integrate with **cabal** & to minimise the dependencies of the executable. + * Partitioned the source-files into **src-lib**, **src-exe**, & **src-test** directories, & referenced them individually from the *.cabal*-file to avoid repeated compilation. + * Used **CPP** to control the import of symbols from **Control.Applicative**. diff --git a/copyright b/copyright --- a/copyright +++ b/copyright @@ -5,7 +5,7 @@ Copyright (C) 2011-2013 Dr. Alistair Ward. All Rights Reserved. Home-page: - http://functionalley.eu + http://functionalley.eu/Factory/factory.html License: GNU GENERAL PUBLIC LICENSE Version 3; see '/usr/share/common-licenses/GPL-3' or '/usr/share/doc/licenses/gpl-3.0.txt' where available, or the local packaged file 'LICENSE'. diff --git a/factory.cabal b/factory.cabal --- a/factory.cabal +++ b/factory.cabal @@ -1,34 +1,56 @@ --- Package-properties -Name: factory -Version: 0.2.1.1 -Cabal-Version: >= 1.6 -Copyright: (C) 2011-2013 Dr. Alistair Ward -License: GPL -License-file: LICENSE -Author: Dr. Alistair Ward -Stability: Unstable interface, incomplete features. -Synopsis: Rational arithmetic in an irrational world. -Build-Type: Simple -Description: A library of number-theory functions, for; factorials, square-roots, Pi and primes. -Category: Math, Number Theory -Tested-With: GHC == 7.4, GHC == 7.6, GHC == 7.10 -Homepage: http://functionalley.eu -Maintainer: factory functionalley eu -Bug-reports: factory functionalley eu -Extra-Source-Files: changelog, copyright, makefile +-- This file is part of Factory. +-- +-- Factory is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- Factory is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with Factory. If not, see . --- Turn on using: 'runhaskell ./Setup.hs configure -f llvm'. +Name: factory +Version: 0.2.1.2 +Cabal-version: >= 1.10 +Copyright: (C) 2011-2015 Dr. Alistair Ward +License: GPL +License-file: LICENSE +Author: Dr. Alistair Ward +Stability: stable +Synopsis: Rational arithmetic in an irrational world. +Build-type: Simple +Description: A library of number-theory functions, for; factorials, square-roots, Pi and primes. +Category: Math, Number Theory +Tested-with: GHC == 7.4, GHC == 7.6, GHC == 7.8, GHC == 7.10 +Homepage: http://functionalley.eu/Factory/factory.html +Maintainer: mailto factory functionalley eu +Bug-reports: mailto factory functionalley eu + +-- None of these files are needed at run-time. +Extra-source-files: + changelog.markdown + copyright + README.markdown + +-- Enable using: 'cabal configure -f llvm'. flag llvm Description: Whether the 'llvm' compiler-backend has been installed and is required for code-generation. - manual: True - default: False + Manual: True + Default: False flag threaded Description: Enable parallelized code. - default: True + Manual: True + Default: True Library - hs-source-dirs: src + Default-language: Haskell2010 + GHC-options: -Wall -O2 -fno-warn-tabs + Hs-source-dirs: src-lib Exposed-modules: Factory.Data.Exponential @@ -97,9 +119,7 @@ parallel >= 3.0, primes >= 0.1, random, - toolshed >= 0.13 - - GHC-options: -Wall -O2 -fno-warn-tabs + toolshed >= 0.16 if impl(ghc >= 7.4.1) GHC-prof-options: -prof -fprof-auto -fprof-cafs @@ -110,10 +130,13 @@ GHC-options: -fllvm Executable factory - hs-source-dirs: src - - Main-Is: Main.hs + Default-language: Haskell2010 + GHC-options: -Wall -O2 -fno-warn-tabs + Hs-source-dirs: src-exe + Main-is: Main.hs + GHC-prof-options: -prof -auto-all -caf-all +-- Unexposed modules must be referenced for 'cabal sdist'. Other-modules: Factory.Test.CommandOptions Factory.Test.Performance.Factorial @@ -124,6 +147,35 @@ Factory.Test.Performance.Primes Factory.Test.Performance.SquareRoot Factory.Test.Performance.Statistics + + Build-depends: + array, + base >= 4.3 && < 5, + Cabal >= 1.10, + containers, + deepseq >= 1.1, + factory, + random, + toolshed >= 0.16 + + if flag(threaded) + GHC-options: -threaded + + if impl(ghc >= 7.0) + GHC-options: -rtsopts + + if flag(llvm) + GHC-options: -fllvm + +Test-Suite quickCheck + Default-language: Haskell2010 + GHC-options: -Wall -fno-warn-tabs + Hs-source-dirs: src-test + Main-is: Main.hs + Type: exitcode-stdio-1.0 + +-- Required for 'cabal sdist'. + Other-modules: Factory.Test.QuickCheck.ArithmeticGeometricMean Factory.Test.QuickCheck.Factorial Factory.Test.QuickCheck.Hyperoperation @@ -137,25 +189,18 @@ Factory.Test.QuickCheck.PrimeFactorisation Factory.Test.QuickCheck.Primes Factory.Test.QuickCheck.Probability - Factory.Test.QuickCheck.QuickChecks Factory.Test.QuickCheck.Radix Factory.Test.QuickCheck.SquareRoot Factory.Test.QuickCheck.Statistics Factory.Test.QuickCheck.Summation Build-depends: - Cabal >= 1.6 && < 2, - QuickCheck >= 2.2 - - GHC-options: -Wall -O2 -fno-warn-tabs - GHC-prof-options: -prof -auto-all -caf-all - - if flag(threaded) - GHC-options: -threaded - - if impl(ghc >= 7.0) - GHC-options: -rtsopts - - if flag(llvm) - GHC-options: -fllvm - + array, + base >= 4.3 && < 5, + containers, + deepseq >= 1.1, + factory, + primes >= 0.1, + QuickCheck >= 2.2, + random, + toolshed >= 0.16 diff --git a/makefile b/makefile deleted file mode 100644 --- a/makefile +++ /dev/null @@ -1,57 +0,0 @@ -# Copyright (C) 2011-2104 Dr. Alistair Ward -# -# This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -.PHONY: all build check clean configure copy haddock help hlint install prof sdist - -all: install - -install: build haddock - @[ -z "$$CABAL_INSTALL_OPTIONS" ] || echo "INFO: CABAL_INSTALL_OPTIONS='$$CABAL_INSTALL_OPTIONS'" - runhaskell Setup $@ $$CABAL_INSTALL_OPTIONS - -prof: - CABAL_CONFIGURE_OPTIONS="--enable-library-profiling --enable-executable-profiling $$CABAL_CONFIGURE_OPTIONS" make install - -copy: build - @[ -z "$$CABAL_COPY_OPTIONS" ] || echo "INFO: CABAL_COPY_OPTIONS='$$CABAL_COPY_OPTIONS'" - runhaskell Setup $@ $$CABAL_COPY_OPTIONS - -build: configure - @[ -z "$$CABAL_BUILD_OPTIONS" ] || echo "INFO: CABAL_BUILD_OPTIONS='$$CABAL_BUILD_OPTIONS'" - runhaskell Setup $@ $$CABAL_BUILD_OPTIONS - -configure: factory.cabal Setup.hs - @[ -z "$$CABAL_CONFIGURE_OPTIONS" ] || echo "INFO: CABAL_CONFIGURE_OPTIONS='$$CABAL_CONFIGURE_OPTIONS'" - runhaskell Setup $@ $$CABAL_CONFIGURE_OPTIONS #--user - -haddock: configure - PATH=~/.cabal/bin:$$PATH runhaskell Setup $@ --hyperlink-source #Amend path to find 'HsColour', as required for 'hyperlink-source'. - -hlint: - @$@ -i 'Use &&' -i 'Reduce duplication' -i 'Redundant bracket' src/ +RTS -N - -sdist: - TAR_OPTIONS='--format=ustar' runhaskell Setup $@ - -check: sdist - cabal upload --check --verbose=3 dist/*.tar.gz; - -clean: - runhaskell Setup $@ - find src -type f \( -name '*.hc' -o -name '*.hcr' -o -name '*.hi' -o -name '*.o' \) -delete - -help: - @grep '^[a-zA-Z].*:' makefile | sed -e 's/:.*//' - diff --git a/src-exe/Factory/Test/CommandOptions.hs b/src-exe/Factory/Test/CommandOptions.hs new file mode 100644 --- /dev/null +++ b/src-exe/Factory/Test/CommandOptions.hs @@ -0,0 +1,48 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the available set of command-line options; of which there's currently only one. +-} + +module Factory.Test.CommandOptions( +-- * Types +-- ** Data-types + CommandOptions(..), +-- * Functions +-- ** Mutators + setVerbose +) where + +import qualified ToolShed.Defaultable + +-- | Declare a record used to contain command-line options. +data CommandOptions = MkCommandOptions { + verbose :: Bool -- ^ Whether additional informative output should be generated, where applicable. +} + +instance ToolShed.Defaultable.Defaultable CommandOptions where + defaultValue = MkCommandOptions { verbose = False } + +-- | Mutator. +setVerbose :: CommandOptions -> CommandOptions +setVerbose commandOptions = commandOptions { + verbose = True +} + + diff --git a/src-exe/Factory/Test/Performance/Factorial.hs b/src-exe/Factory/Test/Performance/Factorial.hs new file mode 100644 --- /dev/null +++ b/src-exe/Factory/Test/Performance/Factorial.hs @@ -0,0 +1,73 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Times the methods exported from module "Math.Factorial". +-} + +module Factory.Test.Performance.Factorial( +-- * Functions + factorialPerformance, + factorialPerformanceControl, + factorialPerformanceGraph, + factorialPerformanceGraphControl +) where + +import qualified Control.DeepSeq +import qualified Data.List +import qualified Factory.Math.Factorial as Math.Factorial +import qualified ToolShed.System.TimePure + +-- | Measures the CPU-time required by 'Math.Factorial.factorial'. +factorialPerformance :: ( + Control.DeepSeq.NFData i, + Integral i, + Math.Factorial.Algorithmic algorithm, + Show i + ) => algorithm -> i -> IO (Double, i) +factorialPerformance algorithm = ToolShed.System.TimePure.getCPUSeconds . Math.Factorial.factorial algorithm + +-- | Measures the CPU-time required by a naive implementation. +factorialPerformanceControl :: (Control.DeepSeq.NFData i, Integral i) => i -> IO (Double, i) +-- factorialPerformanceControl i = ToolShed.System.TimePure.getCPUSeconds $ product [1 .. i] -- CAVEAT: too lazy. +factorialPerformanceControl i = ToolShed.System.TimePure.getCPUSeconds $ Data.List.foldl' (*) 1 [2 .. i] + +{- | + * Measure the CPU-time required by 'Math.Factorial.factorial', against an exponentially increasing operand. + + * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. +-} +factorialPerformanceGraph :: Math.Factorial.Algorithmic algorithm => Bool -> algorithm -> IO () +factorialPerformanceGraph verbose algorithm = mapM_ ( + \operand -> factorialPerformance algorithm operand >>= putStrLn . shows operand . showChar '\t' . ( + if verbose + then (`shows` "") + else (`shows` "") . fst + ) + ) $ iterate (* 2) (1 :: Integer) + +-- | Graphs the CPU-time required by a naive implementation, against an exponentially increasing operand. +factorialPerformanceGraphControl :: Bool -> IO () +factorialPerformanceGraphControl verbose = mapM_ ( + \operand -> factorialPerformanceControl operand >>= putStrLn . shows operand . showChar '\t' . ( + if verbose + then (`shows` "") + else (`shows` "") . fst + ) + ) $ iterate (* 2) (1 :: Integer) + diff --git a/src-exe/Factory/Test/Performance/Hyperoperation.hs b/src-exe/Factory/Test/Performance/Hyperoperation.hs new file mode 100644 --- /dev/null +++ b/src-exe/Factory/Test/Performance/Hyperoperation.hs @@ -0,0 +1,71 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Times functions exported from module "Math.Hyperoperation". +-} + +module Factory.Test.Performance.Hyperoperation( +-- * Functions + hyperoperationPerformance, + hyperoperationPerformanceGraphRank, + hyperoperationPerformanceGraphExponent +) where + +import qualified Factory.Math.Hyperoperation as Math.Hyperoperation +import qualified ToolShed.System.TimePure + +-- | Measures the CPU-time required by 'Math.Hyperoperation.hyperoperation'. +hyperoperationPerformance :: (Integral rank, Show rank) => rank -> Math.Hyperoperation.Base -> Math.Hyperoperation.HyperExponent -> IO (Double, Integer) +hyperoperationPerformance rank base = ToolShed.System.TimePure.getCPUSeconds . Math.Hyperoperation.hyperoperation rank base + +{- | + * Measure the CPU-time required by 'Math.Hyperoperation.hyperoperation', against a linearly increasing /rank/. + + * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. +-} +hyperoperationPerformanceGraphRank + :: Bool -- ^ Verbose. + -> Math.Hyperoperation.Base + -> Math.Hyperoperation.HyperExponent + -> IO () +hyperoperationPerformanceGraphRank verbose base hyperExponent = mapM_ ( + \rank -> hyperoperationPerformance rank base hyperExponent >>= putStrLn . shows rank . showChar '\t' . ( + if verbose + then (`shows` "") + else (`shows` "") . fst + ) + ) [0 :: Int ..] + +{- | + * Measure the CPU-time required by 'Math.Hyperoperation.hyperoperation', against a linearly increasing /hyper-exponent/. + + * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. +-} +hyperoperationPerformanceGraphExponent :: (Integral rank, Show rank) + => Bool -- ^ Verbose. + -> rank + -> Math.Hyperoperation.Base + -> IO () +hyperoperationPerformanceGraphExponent verbose rank base = mapM_ ( + \hyperExponent -> hyperoperationPerformance rank base hyperExponent >>= putStrLn . shows hyperExponent . showChar '\t' . ( + if verbose + then (`shows` "") + else (`shows` "") . fst + ) + ) [0 ..] diff --git a/src-exe/Factory/Test/Performance/Pi.hs b/src-exe/Factory/Test/Performance/Pi.hs new file mode 100644 --- /dev/null +++ b/src-exe/Factory/Test/Performance/Pi.hs @@ -0,0 +1,81 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Times the methods exported from module "Math.Pi". +-} + +module Factory.Test.Performance.Pi( +-- * Types +-- ** Type-synonyms + Category, +-- * Functions + piPerformance, + piPerformanceGraph +) where + +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Implementations.Pi.AGM.Algorithm as Math.Implementations.Pi.AGM.Algorithm +import qualified Factory.Math.Implementations.Pi.BBP.Algorithm as Math.Implementations.Pi.BBP.Algorithm +import qualified Factory.Math.Implementations.Pi.Borwein.Algorithm as Math.Implementations.Pi.Borwein.Algorithm +import qualified Factory.Math.Implementations.Pi.Ramanujan.Algorithm as Math.Implementations.Pi.Ramanujan.Algorithm +import qualified Factory.Math.Implementations.Pi.Spigot.Algorithm as Math.Implementations.Pi.Spigot.Algorithm +import qualified Factory.Math.Pi as Math.Pi +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.SquareRoot as Math.SquareRoot +import qualified ToolShed.System.TimePure + +-- | The type of a /Pi/-algorithm, including where required, the algorithm for /square-root/s and /factorial/s. +type Category squareRootAlgorithm factorialAlgorithm = Math.Pi.Category ( + Math.Implementations.Pi.AGM.Algorithm.Algorithm squareRootAlgorithm + ) Math.Implementations.Pi.BBP.Algorithm.Algorithm ( + Math.Implementations.Pi.Borwein.Algorithm.Algorithm squareRootAlgorithm factorialAlgorithm + ) ( + Math.Implementations.Pi.Ramanujan.Algorithm.Algorithm squareRootAlgorithm factorialAlgorithm + ) Math.Implementations.Pi.Spigot.Algorithm.Algorithm + +-- | Measures the CPU-time required to find Pi to the required precision. +piPerformance :: ( + Math.SquareRoot.Algorithmic squareRootAlgorithm, + Math.Factorial.Algorithmic factorialAlgorithm + ) => Category squareRootAlgorithm factorialAlgorithm -> Math.Precision.DecimalDigits -> IO (Double, String) +piPerformance category = ToolShed.System.TimePure.getCPUSeconds . Math.Pi.openS category + +{- | + * Measures the CPU-time required to determine /Pi/ to an exponentially increasing precision-requirement. + + * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. +-} +piPerformanceGraph :: ( + Math.SquareRoot.Algorithmic squareRootAlgorithm, + Show squareRootAlgorithm, + Math.Factorial.Algorithmic factorialAlgorithm, + Show factorialAlgorithm + ) => RealFrac i + => Category squareRootAlgorithm factorialAlgorithm -- ^ The algorithm. + -> i -- ^ The factor by which the precision is increased on each iteration. + -> Math.Precision.DecimalDigits -- ^ The maximum precision required. + -> Bool -- ^ Whether to return the digits of /Pi/. + -> IO () +piPerformanceGraph category factor maxDecimalDigits verbose = mapM_ ( + \decimalDigits -> piPerformance category decimalDigits >>= putStrLn . shows decimalDigits . showChar '\t' . ( + if verbose + then (`shows` "") + else (`shows` "") . fst + ) + ) . takeWhile (<= maxDecimalDigits) . map round $ iterate (* factor) 1 diff --git a/src-exe/Factory/Test/Performance/Primality.hs b/src-exe/Factory/Test/Performance/Primality.hs new file mode 100644 --- /dev/null +++ b/src-exe/Factory/Test/Performance/Primality.hs @@ -0,0 +1,54 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Times functions exported from module "Math.Primality". +-} + +module Factory.Test.Performance.Primality( +-- * Functions + carmichaelNumbersPerformance, + isPrimePerformance, + isPrimePerformanceGraph +) where + +import qualified Control.DeepSeq +import qualified Factory.Math.Fibonacci as Math.Fibonacci +import qualified Factory.Math.Primality as Math.Primality +import qualified ToolShed.System.TimePure + +-- | Measures the CPU-time required to find the specified number of /Carmichael/-numbers, which is returned together with the requested list. +carmichaelNumbersPerformance :: Math.Primality.Algorithmic primalityAlgorithm => primalityAlgorithm -> Int -> IO (Double, [Integer]) +carmichaelNumbersPerformance primalityAlgorithm i + | i < 0 = fail $ "Factory.Test.Performance.Primality.carmichaelNumbersPerformance:\tnegative number; " ++ show i + | otherwise = ToolShed.System.TimePure.getCPUSeconds . take i $ Math.Primality.carmichaelNumbers primalityAlgorithm + +-- | Measures the CPU-time required to determine whether the specified integer is prime, which is returned together with the Boolean result. +isPrimePerformance :: (Control.DeepSeq.NFData i, Integral i, Show i) => Math.Primality.Algorithmic primalityAlgorithm => primalityAlgorithm -> i -> IO (Double, Bool) +isPrimePerformance primalityAlgorithm = ToolShed.System.TimePure.getCPUSeconds . Math.Primality.isPrime primalityAlgorithm + +{- | + * Measures the CPU-time required to determine whether /prime-indexed Fibonacci-numbers/ are actually /prime/. + + * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. +-} +isPrimePerformanceGraph :: Math.Primality.Algorithmic primalityAlgorithm => primalityAlgorithm -> IO () +isPrimePerformanceGraph primalityAlgorithm = mapM_ ( + \operand -> isPrimePerformance primalityAlgorithm operand >>= putStrLn . shows operand . showChar '\t' . (`shows` "") + ) (Math.Fibonacci.primeIndexedFibonacci :: [Integer]) + diff --git a/src-exe/Factory/Test/Performance/PrimeFactorisation.hs b/src-exe/Factory/Test/Performance/PrimeFactorisation.hs new file mode 100644 --- /dev/null +++ b/src-exe/Factory/Test/Performance/PrimeFactorisation.hs @@ -0,0 +1,50 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Times the methods exported by module "Math.PrimeFactorisation". +-} + +module Factory.Test.Performance.PrimeFactorisation( +-- * Functions + primeFactorsPerformance, + primeFactorsPerformanceGraph +) where + +import qualified Factory.Data.PrimeFactors as Data.PrimeFactors +import qualified Factory.Math.Fibonacci as Math.Fibonacci +import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation +import qualified ToolShed.System.TimePure + +-- | Measures the CPU-time required to prime-factorise the specified integer, which is returned together with the resulting list of factors. +primeFactorsPerformance :: Math.PrimeFactorisation.Algorithmic algorithm => algorithm -> Integer -> IO (Double, Data.PrimeFactors.Factors Integer Int) +primeFactorsPerformance algorithm = ToolShed.System.TimePure.getCPUSeconds . Math.PrimeFactorisation.primeFactors algorithm + +{- | + * Measure the CPU-time required by 'Math.PrimeFactorisation.primeFactors', + arbitrarily against the /Fibonacci/-numbers (which seemed to fit the requirements). + + * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. +-} +primeFactorsPerformanceGraph :: Math.PrimeFactorisation.Algorithmic algorithm => algorithm -> Int -> IO () +primeFactorsPerformanceGraph algorithm tests + | tests < 0 = fail $ "Factory.Test.Performance.PrimeFactorisation.primeFactorsPerformanceGraph:\tnegative number; " ++ show tests + | otherwise = mapM_ ( + \operand -> primeFactorsPerformance algorithm operand >>= putStrLn . shows operand . showChar '\t' . (`shows` "") + ) . take tests . dropWhile (< 2) $ Math.Fibonacci.fibonacci + diff --git a/src-exe/Factory/Test/Performance/Primes.hs b/src-exe/Factory/Test/Performance/Primes.hs new file mode 100644 --- /dev/null +++ b/src-exe/Factory/Test/Performance/Primes.hs @@ -0,0 +1,47 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Measures the CPU-time required by "Math.Primes.primes". +-} + +module Factory.Test.Performance.Primes( +-- * Functions + primesPerformance, + mersenneNumbersPerformance +) where + +import qualified Control.DeepSeq +import qualified Data.Array.IArray +import qualified Factory.Math.Primes as Math.Primes +import qualified ToolShed.System.TimePure + +-- | Measures the CPU-time required by 'Math.Primes.primes', to find the specified prime. +primesPerformance :: ( + Control.DeepSeq.NFData i, + Data.Array.IArray.Ix i, + Math.Primes.Algorithmic algorithm, + Integral i + ) => algorithm -> Int -> IO (Double, i) +primesPerformance algorithm = ToolShed.System.TimePure.getCPUSeconds . (Math.Primes.primes algorithm !!) + +-- | Measures the CPU-time required to find the specified number of /Mersenne/-numbers, which is returned together with the requested list. +mersenneNumbersPerformance :: Math.Primes.Algorithmic algorithm => algorithm -> Int -> IO (Double, [Integer]) +mersenneNumbersPerformance primalityAlgorithm i + | i < 0 = fail $ "Factory.Test.Performance.Primes.mersenneNumbersPerformance:\tnegative number; " ++ show i + | otherwise = ToolShed.System.TimePure.getCPUSeconds . take i $ Math.Primes.mersenneNumbers primalityAlgorithm diff --git a/src-exe/Factory/Test/Performance/SquareRoot.hs b/src-exe/Factory/Test/Performance/SquareRoot.hs new file mode 100644 --- /dev/null +++ b/src-exe/Factory/Test/Performance/SquareRoot.hs @@ -0,0 +1,59 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Measures the CPU-time required by the methods exported from module "Math.SquareRoot". +-} + +module Factory.Test.Performance.SquareRoot( +-- * Functions + squareRootPerformance, + squareRootPerformanceGraph +) where + +import qualified Control.Arrow +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.SquareRoot as Math.SquareRoot +import qualified ToolShed.System.TimePure + +-- | Measures the CPU-time required by 'Math.SquareRoot.squareRootFrom', which is returned together with the approximate rational result. +squareRootPerformance :: ( + Math.SquareRoot.Algorithmic algorithm, + Real operand, + Show operand + ) => algorithm -> operand -> Math.Precision.DecimalDigits -> IO (Double, Math.SquareRoot.Result) +squareRootPerformance algorithm operand requiredDecimalDigits = ToolShed.System.TimePure.getCPUSeconds $ Math.SquareRoot.squareRoot algorithm requiredDecimalDigits operand + +{- | + * Measures the CPU-time required by 'Math.SquareRoot.squareRootFrom', and the resulting accuracy, + using the specified algorithm, to an exponentially increasing precision-requirement. + + * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. +-} +squareRootPerformanceGraph :: ( + Math.SquareRoot.Algorithmic algorithm, + Math.SquareRoot.Iterator algorithm, + Real operand, + Show algorithm, + Show operand + ) => algorithm -> operand -> IO () +squareRootPerformanceGraph algorithm operand = mapM_ ( + \requiredDecimalDigits -> putStrLn . ( + \(cpuSeconds, actualDecimalDigits) -> shows algorithm . showChar '\t' . shows requiredDecimalDigits . showChar '\t' . shows actualDecimalDigits . showChar '\t' $ shows cpuSeconds "" + ) . Control.Arrow.second (Math.SquareRoot.getAccuracy operand) =<< squareRootPerformance algorithm operand requiredDecimalDigits + ) $ iterate (* max 2 (Math.SquareRoot.convergenceOrder algorithm)) 16 diff --git a/src-exe/Factory/Test/Performance/Statistics.hs b/src-exe/Factory/Test/Performance/Statistics.hs new file mode 100644 --- /dev/null +++ b/src-exe/Factory/Test/Performance/Statistics.hs @@ -0,0 +1,45 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Times the functions exported from module "Math.Statistics". +-} + +module Factory.Test.Performance.Statistics( +-- * Functions + nCrPerformance +) where + +import qualified Control.DeepSeq +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Statistics as Math.Statistics +import qualified ToolShed.System.TimePure + +-- | Measures the CPU-time required by 'Math.Statistics.nCr'. +nCrPerformance :: ( + Control.DeepSeq.NFData i, + Integral i, + Math.Factorial.Algorithmic factorialAlgorithm, + Show i + ) + => factorialAlgorithm + -> i -- ^ The total number from which to select. + -> i -- ^ The number of items in a sample. + -> IO (Double, i) +nCrPerformance factorialAlgorithm n r = ToolShed.System.TimePure.getCPUSeconds $ Math.Statistics.nCr factorialAlgorithm n r + diff --git a/src-exe/Main.hs b/src-exe/Main.hs new file mode 100644 --- /dev/null +++ b/src-exe/Main.hs @@ -0,0 +1,241 @@ +{- + Copyright (C) 2011-2013 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Contains the entry-point to the program. + + * Facilitates testing. +-} + +module Main(main) where + +import qualified Data.Map +import qualified Data.List +import qualified Data.Version +import qualified Distribution.Package +import qualified Distribution.Text +import qualified Distribution.Version +import qualified Factory.Math.Hyperoperation as Math.Hyperoperation +import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial +import qualified Factory.Math.Implementations.Primality as Math.Implementations.Primality +import qualified Factory.Math.Implementations.PrimeFactorisation as Math.Implementations.PrimeFactorisation +import qualified Factory.Math.Implementations.Primes.Algorithm as Math.Implementations.Primes.Algorithm +import qualified Factory.Math.Implementations.SquareRoot as Math.Implementations.SquareRoot +import qualified Factory.Math.Probability as Math.Probability +import qualified Factory.Test.CommandOptions as Test.CommandOptions +import qualified Factory.Test.Performance.Factorial as Test.Performance.Factorial +import qualified Factory.Test.Performance.Hyperoperation as Test.Performance.Hyperoperation +import qualified Factory.Test.Performance.Pi as Test.Performance.Pi +import qualified Factory.Test.Performance.Primality as Test.Performance.Primality +import qualified Factory.Test.Performance.PrimeFactorisation as Test.Performance.PrimeFactorisation +import qualified Factory.Test.Performance.Primes as Test.Performance.Primes +import qualified Factory.Test.Performance.SquareRoot as Test.Performance.SquareRoot +import qualified Factory.Test.Performance.Statistics as Test.Performance.Statistics +import qualified Paths_factory as Paths -- Either local stub, or package-instance autogenerated by 'Setup.hs build'. +import qualified System.Console.GetOpt as G +import qualified System.Environment +import qualified System.Exit +import qualified System.Info +import qualified System.IO +import qualified System.IO.Error +import qualified System.Random +import qualified ToolShed.Defaultable + +-- Local convenience definitions. +type PrimalityAlgorithm = Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm +type PiCategory = Test.Performance.Pi.Category Math.Implementations.SquareRoot.Algorithm Math.Implementations.Factorial.Algorithm + +-- | Used to thread user-defined command-line options, though the list of functions which implement them. +type CommandLineAction = Test.CommandOptions.CommandOptions -> IO Test.CommandOptions.CommandOptions -- Supplied as the type-argument to 'G.OptDescr'. + +-- | On failure to parse the specified string, returns an explanatory error. +read' :: Read a => String -> String -> a +read' errorMessage s = case reads s of + [(x, "")] -> x + _ -> error $ errorMessage ++ show s + +-- | On failure to parse a command-line argument, returns an explanatory error. +readCommandArg :: Read a => String -> a +readCommandArg = read' "Failed to parse command-line argument " + +-- | Parses the command-line arguments, to determine 'Test.CommandOptions.CommandOptions'. +main :: IO () +main = do + System.IO.hClose System.IO.stdin -- Nothing is read from standard input. + + progName <- System.Environment.getProgName + + let + usageMessage :: String + usageMessage = "Usage:\t" ++ G.usageInfo progName optDescrList + + optDescrList :: [G.OptDescr CommandLineAction] + optDescrList = [ +-- String [String] (G.ArgDescr CommandLineAction) String + G.Option "?" ["help"] (G.NoArg $ const printUsage) "Display this help-text & then exit.", + G.Option "" ["verbose"] (G.NoArg $ return {-to IO-monad-} . Test.CommandOptions.setVerbose) ("Provide additional information where available; default '" ++ show (Test.CommandOptions.verbose ToolShed.Defaultable.defaultValue) ++ "'."), + G.Option "" ["version"] (G.NoArg $ const printVersion) "Print version-information & then exit.", + G.Option "" ["carmichaelNumbersPerformance"] (carmichaelNumbersPerformance `G.ReqArg` "(Math.Implementations.Primality.Algorithm, Int)") "Test the performance of 'Math.Primality.carmichaelNumbers'.", + G.Option "" ["factorialPerformance"] (factorialPerformance `G.ReqArg` "(Math.Implementations.Factorial.Algorithm, Integer)") "Test the performance of 'Math.Factorial.factorial'.", + G.Option "" ["factorialPerformanceGraph"] (factorialPerformanceGraph `G.ReqArg` "Math.Implementations.Factorial.Algorithm") "Test the performance of 'Math.Factorial.factorial', with an exponentially increasing operand.", + G.Option "" ["factorialPerformanceGraphControl"] (G.NoArg factorialPerformanceGraphControl) "Test the performance of a naive factorial-implementation, with an exponentially increasing operand.", + G.Option "" ["hyperoperationPerformance"] (hyperoperationPerformance `G.ReqArg` "(Integer, Math.Hyperoperation.Base, Math.Hyperoperation.HyperExponent)") "Test the performance of 'Math.Hyperoperation.hyperoperation', against the specified rank, base and hyper-exponent.", + G.Option "" ["hyperoperationPerformanceGraphRank"] (hyperoperationPerformanceGraphRank `G.ReqArg` "(Math.Hyperoperation.Base, Math.Hyperoperation.HyperExponent)") "Test the performance of 'Math.Hyperoperation.hyperoperation', for the specified base and hyper-exponent, and a linearly increasing rank.", + G.Option "" ["hyperoperationPerformanceGraphExponent"] (hyperoperationPerformanceGraphExponent `G.ReqArg` "(Integer, Math.Hyperoperation.Base)") "Test the performance of 'Math.Hyperoperation.hyperoperation', for the specified rank and base, and a linearly increasing hyper-exponent.", + G.Option "" ["isPrimePerformance"] (isPrimePerformance `G.ReqArg` "(Math.Implementations.Primality.Algorithm, Integer)") "Test the performance of 'Math.Primality.isPrime'.", + G.Option "" ["isPrimePerformanceGraph"] (isPrimePerformanceGraph `G.ReqArg` "Math.Implementations.Primality.Algorithm") "Test the performance of 'Math.Primality.isPrime', against the prime-indexed Fibonacci-numbers.", + G.Option "" ["mersenneNumbersPerformance"] (mersenneNumbersPerformance `G.ReqArg` "(Math.Implementations.Primes.Algorithm.Algorithm, Int)") "Test the performance of 'Math.Primes.mersenneNumbers'.", + G.Option "" ["factorialPerformance"] (factorialPerformance `G.ReqArg` "(Math.Implementations.Factorial.Algorithm, Integer)") "Test the performance of 'Math.Factorial.factorial'.", + G.Option "" ["nCrPerformance"] (nCrPerformance `G.ReqArg` "(Math.Implementations.Factorial.Algorithm, Integer, Integer)") "Test the performance of 'Math.Factorial.factorial'.", + G.Option "" ["piPerformance"] (piPerformance `G.ReqArg` "(Math.Pi.Category, Math.Precision.DecimalDigits)") "Test the performance of 'Math.Pi.openI'.", + G.Option "" ["piPerformanceGraph"] (piPerformanceGraph `G.ReqArg` "(Math.Pi.Category, Double, Math.Precision.DecimalDigits)") "Test the performance of 'Math.Pi.openI', with an exponential precision-requirement (of the specified exponent), up to the specified limit.", + G.Option "" ["plotDiscreteDistribution"] (plotDiscreteDistribution `G.ReqArg` "(Int, Math.Probability.DiscreteDistribution)") "Plot the Probability Mass function for the specified discrete distribution.", + G.Option "" ["primeFactorsPerformance"] (primeFactorsPerformance `G.ReqArg` "(Math.Implementations.PrimeFactorisation.Algorithm, Integer)") "Test the performance of 'Math.PrimeFactorisation.primeFactors'.", + G.Option "" ["primeFactorsPerformanceGraph"] (primeFactorsPerformanceGraph `G.ReqArg` "(Math.Implementations.PrimeFactorisation.Algorithm, Int)") "Test the performance of 'Math.PrimeFactorisation.primeFactors', on the specified number of odd integers from the Fibonacci-sequence.", + G.Option "" ["primesPerformance"] (primesPerformance `G.ReqArg` "(Math.Implementations.Primes.Algorithm.Algorithm, Int)") "Test the performance of 'Math.Primes.primes'.", + G.Option "" ["squareRootPerformance"] (squareRootPerformance `G.ReqArg` "(Math.Implementations.SquareRoot.Algorithm, Rational, DecimalDigits)") "Test the performance of 'Math.SquareRoot.squareRoot'.", + G.Option "" ["squareRootPerformanceGraph"] (squareRootPerformanceGraph `G.ReqArg` "(Math.Implementations.SquareRoot.Algorithm, Rational)") "Test the performance of 'Math.SquareRoot.squareRoot', with an exponentially increasing precision-requirement." + ] where + printVersion, printUsage :: IO Test.CommandOptions.CommandOptions + printVersion = System.IO.hPutStrLn System.IO.stderr ( + Distribution.Text.display packageIdentifier ++ "\n\nCompiled by " ++ show compiler ++ ".\n\nCopyright (C) 2011-2015 " ++ author ++ ".\nThis program comes with ABSOLUTELY NO WARRANTY.\nThis is free software, and you are welcome to redistribute it under certain conditions.\n\nWritten by " ++ author ++ "." + ) >> System.Exit.exitSuccess where + packageIdentifier :: Distribution.Package.PackageIdentifier + packageIdentifier = Distribution.Package.PackageIdentifier { + Distribution.Package.pkgName = Distribution.Package.PackageName progName, -- CAVEAT: coincidentally. + Distribution.Package.pkgVersion = Distribution.Version.Version (Data.Version.versionBranch Paths.version) [] + } + + author, compiler :: String + author = "Dr. Alistair Ward" + compiler = System.Info.compilerName ++ "-" ++ Data.List.intercalate "." (map show $ Data.Version.versionBranch System.Info.compilerVersion) + + printUsage = System.IO.hPutStrLn System.IO.stderr usageMessage >> System.Exit.exitSuccess + + factorialPerformanceGraphControl :: Test.CommandOptions.CommandOptions -> IO Test.CommandOptions.CommandOptions + factorialPerformanceGraphControl commandOptions = Test.Performance.Factorial.factorialPerformanceGraphControl (Test.CommandOptions.verbose commandOptions) >> System.Exit.exitFailure + + carmichaelNumbersPerformance, factorialPerformance, factorialPerformanceGraph, hyperoperationPerformance, hyperoperationPerformanceGraphRank, hyperoperationPerformanceGraphExponent, isPrimePerformance, isPrimePerformanceGraph, mersenneNumbersPerformance, piPerformance, piPerformanceGraph, plotDiscreteDistribution, primeFactorsPerformance, primesPerformance, squareRootPerformance, squareRootPerformanceGraph :: String -> CommandLineAction + + carmichaelNumbersPerformance arg _ = Test.Performance.Primality.carmichaelNumbersPerformance algorithm i >>= print >> System.Exit.exitSuccess where + algorithm :: PrimalityAlgorithm + (algorithm, i) = readCommandArg arg + + factorialPerformance arg _ = Test.Performance.Factorial.factorialPerformance algorithm i >>= print >> System.Exit.exitSuccess where + algorithm :: Math.Implementations.Factorial.Algorithm + i :: Integer + (algorithm, i) = readCommandArg arg + + factorialPerformanceGraph arg commandOptions = Test.Performance.Factorial.factorialPerformanceGraph (Test.CommandOptions.verbose commandOptions) (readCommandArg arg :: Math.Implementations.Factorial.Algorithm) >> System.Exit.exitFailure + + hyperoperationPerformance arg _ = Test.Performance.Hyperoperation.hyperoperationPerformance rank base hyperExponent >>= print >> System.Exit.exitSuccess where + rank :: Integer + base :: Math.Hyperoperation.Base + hyperExponent :: Math.Hyperoperation.HyperExponent + (rank, base, hyperExponent) = readCommandArg arg + + hyperoperationPerformanceGraphRank arg commandOptions = Test.Performance.Hyperoperation.hyperoperationPerformanceGraphRank (Test.CommandOptions.verbose commandOptions) base hyperExponent >> System.Exit.exitFailure where + base :: Math.Hyperoperation.Base + hyperExponent :: Math.Hyperoperation.HyperExponent + (base, hyperExponent) = readCommandArg arg + + hyperoperationPerformanceGraphExponent arg commandOptions = Test.Performance.Hyperoperation.hyperoperationPerformanceGraphExponent (Test.CommandOptions.verbose commandOptions) rank base >> System.Exit.exitFailure where + rank :: Integer + base :: Math.Hyperoperation.Base + (rank, base) = readCommandArg arg + + isPrimePerformance arg _ = Test.Performance.Primality.isPrimePerformance algorithm i >>= print >> System.Exit.exitSuccess where + algorithm :: PrimalityAlgorithm + i :: Integer + (algorithm, i) = readCommandArg arg + + isPrimePerformanceGraph arg _ = Test.Performance.Primality.isPrimePerformanceGraph (readCommandArg arg :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm) >> System.Exit.exitFailure + + mersenneNumbersPerformance arg _ = Test.Performance.Primes.mersenneNumbersPerformance algorithm i >>= print >> System.Exit.exitSuccess where + algorithm :: Math.Implementations.Primes.Algorithm.Algorithm + (algorithm, i) = readCommandArg arg + + nCrPerformance arg _ = Test.Performance.Statistics.nCrPerformance algorithm n r >>= print >> System.Exit.exitSuccess where + algorithm :: Math.Implementations.Factorial.Algorithm + n, r :: Integer + (algorithm, n, r) = readCommandArg arg + + piPerformance arg _ = Test.Performance.Pi.piPerformance category decimalDigits >>= print >> System.Exit.exitSuccess where + category :: PiCategory + (category, decimalDigits) = readCommandArg arg + + piPerformanceGraph arg commandOptions = Test.Performance.Pi.piPerformanceGraph category factor maxDecimalDigits (Test.CommandOptions.verbose commandOptions) >> System.Exit.exitFailure where + category :: PiCategory + factor :: Double + (category, factor, maxDecimalDigits) = readCommandArg arg + + plotDiscreteDistribution arg _ = let + distribution :: Math.Probability.DiscreteDistribution Double + (n, distribution) = readCommandArg arg + in do + System.Random.getStdGen >>= print . Data.Map.toList . Data.Map.map ((/ (fromIntegral n :: Double)) . fromInteger) . Data.Map.fromListWith (+) . (`zip` repeat 1) . (take n :: [Integer] -> [Integer]) . Math.Probability.generateDiscretePopulation distribution + + System.Exit.exitSuccess + + primeFactorsPerformance arg _ = Test.Performance.PrimeFactorisation.primeFactorsPerformance algorithm i >>= print >> System.Exit.exitSuccess where + algorithm :: Math.Implementations.PrimeFactorisation.Algorithm + (algorithm, i) = readCommandArg arg + + primeFactorsPerformanceGraph arg _ = Test.Performance.PrimeFactorisation.primeFactorsPerformanceGraph algorithm index >> System.Exit.exitFailure where + algorithm :: Math.Implementations.PrimeFactorisation.Algorithm + (algorithm, index) = readCommandArg arg + + primesPerformance arg _ = ( + ( +{- + Hard-code specific algorithms, so the simplifier triggers rewrite-rules in "Math.Implementations.Primes", + ready for run-time definitions of 'algorithm' to exploit as appropriate. + CAVEAT: fragile. +-} + case algorithm of + Math.Implementations.Primes.Algorithm.SieveOfEratosthenes wheelSize -> Test.Performance.Primes.primesPerformance $ Math.Implementations.Primes.Algorithm.SieveOfEratosthenes wheelSize + Math.Implementations.Primes.Algorithm.SieveOfAtkin maxPrime -> Test.Performance.Primes.primesPerformance $ Math.Implementations.Primes.Algorithm.SieveOfAtkin maxPrime + _ -> Test.Performance.Primes.primesPerformance algorithm + ) index :: IO ( + Double, +-- Integer + Int -- Exploits rewrite-rules in "Math.Implementations.Primes.*". + ) + ) >>= print >> System.Exit.exitSuccess where + algorithm :: Math.Implementations.Primes.Algorithm.Algorithm + (algorithm, index) = readCommandArg arg + + squareRootPerformance arg _ = Test.Performance.SquareRoot.squareRootPerformance algorithm operand decimalDigits >>= print >> System.Exit.exitSuccess where + algorithm :: Math.Implementations.SquareRoot.Algorithm + operand :: Rational + (algorithm, operand, decimalDigits) = readCommandArg arg + + squareRootPerformanceGraph arg _ = Test.Performance.SquareRoot.squareRootPerformanceGraph algorithm operand >> System.Exit.exitFailure where + algorithm :: Math.Implementations.SquareRoot.Algorithm + operand :: Rational + (algorithm, operand) = readCommandArg arg + + args <- System.Environment.getArgs + +-- G.getOpt :: G.ArgOrder CommandLineAction -> [G.OptDescr Action] -> [String] -> ([Action], [String], [String]) + case G.getOpt G.RequireOrder optDescrList args of + (commandLineActions, _, []) -> Data.List.foldl' (>>=) (return {-to IO-monad-} ToolShed.Defaultable.defaultValue) commandLineActions >> System.Exit.exitSuccess + (_, _, errors) -> System.IO.Error.ioError . System.IO.Error.userError $ concat errors ++ usageMessage -- Throw. + diff --git a/src-lib/Factory/Data/Exponential.hs b/src-lib/Factory/Data/Exponential.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Data/Exponential.hs @@ -0,0 +1,89 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Describes a simple numeric type, designed to contain an /exponential/ number. + + * . +-} + +module Factory.Data.Exponential( +-- * Types +-- ** Type-synonyms + Exponential, +-- * Functions + evaluate, + invert, +-- ** Accessors + getBase, + getExponent, +-- ** Constructors + rightIdentity, +-- ** Operators + (<^), + (=~) +) where + +import qualified Control.Arrow + +infix 4 =~ -- Same as (==). +infixr 8 <^ -- Same as (^). + +-- | Describes an /exponential/, in terms of its /base/ and /exponent/. +type Exponential base exponent = (base, exponent) + +-- | Accessor. +{-# INLINE getBase #-} +getBase :: Exponential base exponent -> base +getBase = fst + +-- | Accessor. +{-# INLINE getExponent #-} +getExponent :: Exponential base exponent -> exponent +getExponent = snd + +{- | + * Construct an 'Exponential' merely raised to the 1st power. + + * The value of the resulting exponential is the same as specified 'base'; . +-} +rightIdentity :: Num exponent => base -> Exponential base exponent +rightIdentity x = (x, 1) + +-- | Evaluate the specified 'Exponential', returning the resulting number. +{-# INLINE evaluate #-} +evaluate :: (Num base, Integral exponent) => Exponential base exponent -> base +evaluate = uncurry (^) -- CAVEAT: in this eta-reduced form, it'll only be inlined when called without arguments. + +-- | True if the /bases/ are equal. +(=~) :: Eq base => Exponential base exponent -> Exponential base exponent -> Bool +(l, _) =~ (r, _) = l == r + +-- | Raise the specified 'Exponential' to a power. +(<^) :: Num exponent + => Exponential base exponent -- ^ The operand. + -> exponent -- ^ The power to which the exponential is to be raised. + -> Exponential base exponent -- ^ The result. +(b, e) <^ power = (b, e * power) + +-- | Invert the value, by negating the exponent. +invert :: Num exponent => Exponential base exponent -> Exponential base exponent +invert = Control.Arrow.second negate + diff --git a/src-lib/Factory/Data/Interval.hs b/src-lib/Factory/Data/Interval.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Data/Interval.hs @@ -0,0 +1,201 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Describes a bounded set of, typically integral, quantities. + + * Operations have been defined, on the list of /consecutive/ quantities delimited by these endpoints. + + * The point is that if the list is composed from /consecutive/ quantities, the intermediate values can be inferred, rather than physically represented. + + [@CAVEATS@] + + * The API was driven top-down by its caller's requirements, rather than a bottom-up attempt to provide a complete interface. + consequently there may be omissions from the view point of future callers. + + * Thought similar to the mathematical concept of an /interval/, the latter technically relates to /real/ numbers; . + + * No account has been made for /semi-closed/ or /open/ intervals. +-} + +module Factory.Data.Interval( +-- * Types +-- ** Type-synonyms + Interval, +-- * Constants + closedUnitInterval, + mkBounded, +-- * Functions +-- divideAndConquer, + elem', +-- getLength, + normalise, + product', + shift, + splitAt', + toList, +-- ** Accessors + getMinBound, + getMaxBound, +-- ** Constructors + precisely, +-- ** Predicates + isReversed +) where + +import Control.Arrow((***), (&&&)) +import qualified Control.Parallel.Strategies +import qualified Data.Monoid +import qualified Data.Ratio +import qualified Data.Tuple +import qualified ToolShed.Data.Pair + +-- | Defines a closed (inclusive) interval of consecutive values. +type Interval endPoint = (endPoint, endPoint) + +-- | Accessor. +{-# INLINE getMinBound #-} +getMinBound :: Interval endPoint -> endPoint +getMinBound = fst + +-- | Accessor. +{-# INLINE getMaxBound #-} +getMaxBound :: Interval endPoint -> endPoint +getMaxBound = snd + +-- | Construct the /unsigned closed unit-interval/; . +closedUnitInterval :: Num n => Interval n +closedUnitInterval = (0, 1) + +-- | Construct an /interval/ from a bounded type. +mkBounded :: Bounded endPoint => Interval endPoint +mkBounded = (minBound, maxBound) + +-- | Construct an /interval/ from a single value. +precisely :: endPoint -> Interval endPoint +precisely = id &&& id + +-- | Shift of both /end-points/ of the /interval/ by the specified amount. +shift :: Num endPoint + => endPoint -- ^ The magnitude of the require shift. + -> Interval endPoint -- ^ The interval to be shifted. + -> Interval endPoint +shift i = ToolShed.Data.Pair.mirror (+ i) + +-- | True if the specified value is within the inclusive bounds of the /interval/. +elem' :: Ord endPoint => endPoint -> Interval endPoint -> Bool +elem' x = uncurry (&&) . ((<= x) *** (x <=)) + +-- | True if 'getMinBound' exceeds 'getMaxBound' extent. +isReversed :: Ord endPoint => Interval endPoint -> Bool +isReversed = uncurry (>) + +-- | Swap the /end-points/ where they were originally reversed, but otherwise do nothing. +normalise :: Ord endPoint => Interval endPoint -> Interval endPoint +normalise b + | isReversed b = Data.Tuple.swap b + | otherwise = b + +-- | Bisect the /interval/ at the specified /end-point/; which should be between the two existing /end-points/. +splitAt' :: ( + Enum endPoint, + Num endPoint, + Ord endPoint, + Show endPoint + ) => endPoint -> Interval endPoint -> (Interval endPoint, Interval endPoint) +splitAt' i interval@(l, r) + | any ($ i) [(< l), (>= r)] = error $ "Factory.Data.Interval.splitAt':\tunsuitable index=" ++ show i ++ " for interval=" ++ show interval ++ "." + | otherwise = ((l, i), (succ i, r)) + +{- | + * The distance between the endpoints, + which for 'Integral' quantities is the same as the number of items in closed interval; though the latter concept would return type 'Int'. + + * CAVEAT: the implementation accounts for the potential fence-post error, for closed intervals of integers, + but this results in the opposite error when used with /Fractional/ quantities. + So, though most of the module merely requires 'Enum', this function is further restricted to 'Integral'. +-} +{-# INLINE getLength #-} +getLength :: Integral endPoint => Interval endPoint -> endPoint +getLength (l, r) = succ r - l + +{- | + * Converts 'Interval' to a list by enumerating the values. + + * CAVEAT: produces rather odd results for 'Fractional' types, but no stranger than considering such types Enumerable in the first place. +-} +{-# INLINE toList #-} +toList :: Enum endPoint => Interval endPoint -> [endPoint] +toList = uncurry enumFromTo -- CAVEAT: in this eta-reduced form, it'll only be inlined when called without arguments. + +{- | + * Reduces 'Interval' to a single integral value encapsulated in a 'Data.Monoid.Monoid', + using a /divide-and-conquer/ strategy, + bisecting the /interval/ and recursively evaluating each part; . + + * By choosing a 'ratio' other than @(1 % 2)@, the bisection can be made asymmetrical. + The specified ratio represents the length of the left-hand portion over the original list-length; + eg. @(1 % 3)@ results in the first part, half the length of the second. + + * This process of recursive bisection, is terminated beneath the specified minimum length, + after which the 'Interval' are expanded into the corresponding list, and the /monoid/'s binary operator is directly /folded/ over it. + + * One can view this as a , + in which 'Interval' is exploded into a binary tree-structure + (each leaf of which contains a list of up to 'minLength' integers, and each node of which contains an associative binary operator), + and then collapsed to a scalar, by application of the operators. +-} +divideAndConquer :: (Data.Monoid.Monoid monoid, Integral i, Show i) + => (i -> monoid) -- ^ The monoid's constructor. + -> Data.Ratio.Ratio i -- ^ The ratio of the original span, at which to bisect the 'Interval'. + -> i -- ^ For efficiency, the /interval/ will not be bisected, when it's length has been reduced to this value. + -> Interval i + -> monoid -- ^ The resulting scalar. +divideAndConquer monoidConstructor ratio minLength + | any ($ ratio) [ + (< 0), + (>= 1) + ] = error $ "Factory.Data.Interval.divideAndConquer:\tunsuitable ratio='" ++ show ratio ++ "'." + | minLength < 1 = error $ "Factory.Data.Interval.divideAndConquer:\tunsuitable minLength=" ++ show minLength ++ "." + | otherwise = slave + where + slave interval@(l, r) + | getLength interval <= minLength = Data.Monoid.mconcat . map monoidConstructor $ toList interval -- Fold the monoid's binary operator over the delimited list. + | otherwise = uncurry Data.Monoid.mappend . Control.Parallel.Strategies.withStrategy ( + Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rseq Control.Parallel.Strategies.rseq + ) . ToolShed.Data.Pair.mirror slave $ splitAt' ( + l + (r - l) * Data.Ratio.numerator ratio `div` Data.Ratio.denominator ratio -- Use the ratio to generate the split-index. + ) interval -- Apply the monoid's binary operator to the two operands resulting from bisection. + +{- | + * Multiplies the consecutive sequence of integers within 'Interval'. + + * Since the result can be large, 'divideAndConquer' is used to form operands of a similar order of magnitude, + thus improving the efficiency of the big-number multiplication. +-} +product' :: (Integral i, Show i) + => Data.Ratio.Ratio i -- ^ The ratio at which to bisect the 'Interval'. + -> i -- ^ For efficiency, the /interval/ will not be bisected, when it's length has been reduced to this value. + -> Interval i + -> i -- ^ The resulting product. +product' ratio minLength interval + | elem' 0 interval = 0 + | otherwise = Data.Monoid.getProduct $ divideAndConquer Data.Monoid.Product ratio minLength interval + diff --git a/src-lib/Factory/Data/MonicPolynomial.hs b/src-lib/Factory/Data/MonicPolynomial.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Data/MonicPolynomial.hs @@ -0,0 +1,98 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Describes a /monic polynomial; ; + ie. in which the /coefficient/ of the /leading term/ is one. +-} + +module Factory.Data.MonicPolynomial( +-- * Types +-- ** Data-types, + MonicPolynomial(getPolynomial), -- Hide the data-constructor. +-- * Functions +-- ** Constructors + mkMonicPolynomial +) where + +import qualified Control.Arrow +import qualified Factory.Data.Monomial as Data.Monomial +import Factory.Data.Polynomial((*=)) +import qualified Factory.Data.Polynomial as Data.Polynomial +import qualified Factory.Data.QuotientRing as Data.QuotientRing +import Factory.Data.Ring((=*=), (=+=), (=-=)) +import qualified Factory.Data.Ring as Data.Ring +import qualified ToolShed.Data.Pair + +-- | A type of 'Data.Polynomial.Polynomial', in which the /leading term/ is required to have a /coefficient/ of one. +newtype MonicPolynomial c e = MkMonicPolynomial { + getPolynomial :: Data.Polynomial.Polynomial c e +} deriving (Eq, Show) + +-- | Smart constructor. Constructs an arbitrary /monic polynomial/. +mkMonicPolynomial :: ( + Eq c, + Num c, + Ord e, + Show c, + Show e + ) => Data.Polynomial.Polynomial c e -> MonicPolynomial c e +mkMonicPolynomial polynomial + | not $ Data.Polynomial.isMonic polynomial = error $ "Factory.Data.MonicPolynomial.mkMonicPolynomial:\tnot monic; " ++ show polynomial + | otherwise = MkMonicPolynomial polynomial + +{- + * This instance-declaration merely delegates to the 'Data.Polynomial.Polynomial' payload. + + * CAVEAT: it's not strictly an instance of this class, since the result of some methods isn't /monic/. +-} +instance ( + Eq c, + Num c, + Num e, + Ord e, + Show c, + Show e + ) => Data.Ring.Ring (MonicPolynomial c e) where + MkMonicPolynomial l =*= MkMonicPolynomial r = MkMonicPolynomial $ l =*= r + MkMonicPolynomial l =+= MkMonicPolynomial r = mkMonicPolynomial $ l =+= r -- CAVEAT: potentially non-monic. +-- additiveInverse (MkMonicPolynomial p) = MkMonicPolynomial $ Data.Ring.additiveInverse p -- CAVEAT: not monic ! + additiveInverse _ = error "Factory.Data.MonicPolynomial.additiveInverse:\tresult isn't monic" + multiplicativeIdentity = MkMonicPolynomial Data.Ring.multiplicativeIdentity + additiveIdentity = MkMonicPolynomial Data.Ring.additiveIdentity -- CAVEAT: not monic ! + +-- Since the /leading term/ of the /denominator/ is one, the /coefficient/ isn't required to implement 'Fractional'. +instance ( + Eq c, + Num c, + Num e, + Ord e, + Show c, + Show e + ) => Data.QuotientRing.QuotientRing (MonicPolynomial c e) where + MkMonicPolynomial polynomialN `quotRem'` MkMonicPolynomial polynomialD = ToolShed.Data.Pair.mirror MkMonicPolynomial $ longDivide polynomialN where +-- longDivide :: (Num c, Num e, Ord e) => Polynomial c e -> (Polynomial c e, Polynomial c e) + longDivide numerator + | Data.Polynomial.isZero numerator || Data.Monomial.getExponent quotient < 0 = (Data.Polynomial.zero, numerator) + | otherwise = Control.Arrow.first (Data.Polynomial.lift (quotient :)) $ longDivide (numerator =-= polynomialD *= quotient) + where +-- quotient :: Num e => Data.Monomial.Monomial c e + quotient = Data.Polynomial.getLeadingTerm numerator `Data.Monomial.shiftExponent` negate (Data.Monomial.getExponent $ Data.Polynomial.getLeadingTerm polynomialD) + diff --git a/src-lib/Factory/Data/Monomial.hs b/src-lib/Factory/Data/Monomial.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Data/Monomial.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE CPP #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Describes a and operations on it. + + * A /monomial/ is merely a /polynomial/ with a single non-zero term; cf. /Binomial/. +-} + +module Factory.Data.Monomial( +-- * Types +-- ** Type-synonyms + Monomial, +-- * Functions + double, + mod', + negateCoefficient, + realCoefficientToFrac, + shiftCoefficient, + shiftExponent, + square, +-- ** Accessors + getExponent, + getCoefficient, +-- ** Operators + (<=>), + (), + (<*>), -- CAVEAT: this clashes with the Prelude from 'base-4.8'. + (=~), +-- ** Predicates + isMonomial +) where + +import qualified Control.Arrow + +#if MIN_VERSION_base(4,8,0) +import Prelude hiding ((<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. +#endif + +infix 4 <=> -- Same as (==). +infix 4 =~ -- Same as (==). +infixl 7 -- Same as (/). +infixl 7 <*> -- Same as (*). + +{- | + * The type of an arbitrary monomial. + + * CAVEAT: though a /monomial/ has an integral power, this contraint is only imposed at the function-level. +-} +type Monomial coefficient exponent = (coefficient, exponent) + +-- | Accessor. +{-# INLINE getCoefficient #-} +getCoefficient :: Monomial c e -> c +getCoefficient = fst + +-- | Accessor. +{-# INLINE getExponent #-} +getExponent :: Monomial c e -> e +getExponent = snd + +{- | + * 'True' if the /exponent/ is both integral and non-/negative/. + + * CAVEAT: one can't even call this function unless the /exponent/ is integral. +-} +isMonomial :: Integral e => Monomial c e -> Bool +isMonomial = (>= 0) . getExponent + +-- | Compares the /exponents/ of the specified 'Monomial's. +{-# INLINE (<=>) #-} +(<=>) :: Ord e => Monomial c e -> Monomial c e -> Ordering +(_, l) <=> (_, r) = l `compare` r + +-- | True if the /exponents/ are equal. +(=~) :: Eq e => Monomial c e -> Monomial c e -> Bool +(_, l) =~ (_, r) = l == r + +-- | Multiply the two specified 'Monomial's. +{-# INLINE (<*>) #-} +(<*>) :: (Num c, Num e) => Monomial c e -> Monomial c e -> Monomial c e +(cL, eL) <*> (cR, eR) = (cL * cR, eL + eR) + +-- | Divide the two specified 'Monomial's. +() :: (Eq c, Fractional c, Num e) + => Monomial c e -- ^ Numerator. + -> Monomial c e -- ^ Denominator. + -> Monomial c e +(cN, eN) (1, eD) = (cN, eN - eD) +(cN, eN) (cD, eD) = (cN / cD, eN - eD) + +-- | Square the specified 'Monomial'. +square :: (Num c, Num e) => Monomial c e -> Monomial c e +square (c, e) = (c ^ (2 :: Int), 2 * e) + +-- | Double the specified 'Monomial'. +{-# INLINE double #-} +double :: Num c => Monomial c e -> Monomial c e +double (c, e) = (2 * c, e) + +-- | Shift the /coefficient/, by the specified amount. +{-# INLINE shiftCoefficient #-} +shiftCoefficient :: Num c + => Monomial c e + -> c -- ^ The magnitude of the shift. + -> Monomial c e +-- m `shiftCoefficient` i = Control.Arrow.first (+ i) m -- CAVEAT: Too slow. +(c, e) `shiftCoefficient` i = (c + i, e) + +-- | Shift the /exponent/, by the specified amount. +{-# INLINE shiftExponent #-} +shiftExponent :: Num e + => Monomial c e + -> e -- ^ The magnitude of the shift. + -> Monomial c e +-- m `shiftExponent` i = Control.Arrow.second (+ i) m -- CAVEAT: Too slow. +(c, e) `shiftExponent` i = (c, e + i) + +-- | Negate the coefficient. +negateCoefficient :: Num c => Monomial c e -> Monomial c e +negateCoefficient = Control.Arrow.first negate + +-- | Reduce the coefficient using /modular/ arithmetic. +{-# INLINE mod' #-} +mod' :: Integral c + => Monomial c e + -> c -- ^ Modulus. + -> Monomial c e +monomial `mod'` modulus = Control.Arrow.first (`mod` modulus) monomial + +-- | Convert the type of the /coefficient/. +realCoefficientToFrac :: (Real r, Fractional f) => Monomial r e -> Monomial f e +realCoefficientToFrac = Control.Arrow.first realToFrac + diff --git a/src-lib/Factory/Data/Polynomial.hs b/src-lib/Factory/Data/Polynomial.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Data/Polynomial.hs @@ -0,0 +1,379 @@ +{-# LANGUAGE CPP #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Describes a polynomial and operations on it. + + * . + + * . +-} + +module Factory.Data.Polynomial( +-- * Types +-- ** Type-synonyms +-- MonomialList, +-- ** Data-types, + Polynomial, +-- * Constants + zero, + one, +-- * Functions + evaluate, + getDegree, + getLeadingTerm, + lift, + mod', + normalise, +-- pruneCoefficients, + raiseModulo, + realCoefficientsToFrac, + terms, +-- ** Constructors + mkConstant, + mkLinear, + mkPolynomial, +-- ** Operators + (*=), +-- ** Predicates + areCongruentModulo, + inAscendingOrder, + inDescendingOrder, +-- inOrder, + isMonic, + isMonomial, + isNormalised, + isPolynomial, +-- isReduced, + isZero +) where + +import Control.Arrow((&&&)) +import qualified Control.Arrow +import qualified Data.List +import Factory.Data.Monomial((<*>), (), (<=>), (=~)) +import qualified Factory.Data.Monomial as Data.Monomial +import qualified Factory.Data.QuotientRing as Data.QuotientRing +import Factory.Data.Ring((=*=), (=+=), (=-=)) +import qualified Factory.Data.Ring as Data.Ring + +#if MIN_VERSION_base(4,8,0) +import Prelude hiding ((<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. +#endif + +infixl 7 *= -- Same as (*). + +-- | The guts of a 'Polynomial'. +type MonomialList coefficient exponent = [Data.Monomial.Monomial coefficient exponent] + +{- | + * The type of an arbitrary /univariate/ polynomial; + actually it's more general, since it permits negative powers (s). + It can't describe /multivariate/ polynomials, which would require a list of /exponents/. + Rather than requiring the /exponent/ to implement the /type-class/ 'Integral', this is implemented at the function-level, as required. + + * The structure permits gaps between /exponents/, + in which /coefficients/ are inferred to be zero, thus enabling efficient representation of sparse polynomials. + + * CAVEAT: the 'MonomialList' is required to; + be ordered by /descending/ exponent (ie. reverse ); + have had zero coefficients removed; + and to have had /like/ terms merged; + so the raw data-constructor isn't exported. +-} +newtype {- Integral exponent => -} Polynomial coefficient exponent = MkPolynomial { + getMonomialList :: MonomialList coefficient exponent -- ^ Accessor. +} deriving (Eq, Show) + +-- | Makes /Polynomial/ a 'Data.Ring.Ring', over the /field/ composed from all possible /coefficients/; . +instance ( + Eq c, + Num c, + Num e, + Ord e + ) => Data.Ring.Ring (Polynomial c e) where + MkPolynomial [] =*= _ = zero + _ =*= MkPolynomial [] = zero + polynomialL =*= polynomialR +-- | polynomialL == one = polynomialR -- Counterproductive. +-- | polynomialR == one = polynomialL -- Counterproductive. + | terms polynomialL > terms polynomialR = polynomialL `times` polynomialR + | otherwise = polynomialR `times` polynomialL + where + l `times` r = {-# SCC "times" #-} Data.Ring.sum' (recip 2) {-TODO-} 10 {-empirical-} . map (l *=) $ getMonomialList r + + MkPolynomial [] =+= p = p + p =+= MkPolynomial [] = p + MkPolynomial listL =+= MkPolynomial listR = {-# SCC "merge" #-} MkPolynomial $ merge listL listR where + merge [] r = r + merge l [] = l + merge l@(lh : ls) r@(rh : rs) = case lh <=> rh of + GT -> lh : merge ls r + LT -> rh : merge l rs + _ -> case lh `Data.Monomial.shiftCoefficient` Data.Monomial.getCoefficient rh of + (0, _) -> merge ls rs + monomial -> monomial : merge ls rs + + additiveInverse = lift (Data.Monomial.negateCoefficient `map`) + multiplicativeIdentity = one + additiveIdentity = zero + +{- + Override the default implementation, + in order to take advantage of the symmetry under reflection about the main diagonal, + in the square matrix of products formed from the multiplication of each term by each term. + Eg: + (ax^3 + bx^2 + cx + d)^2 = [ + (a^2x^6 + abx^5 + acx^4 + adx^3) + + (bax^5 + b^2x^4 + bcx^3 + bdx^2) + + (cax^4 + cbx^3 + c^2x^2 + cdx) + + (dax^3 + dbx^2 + dcx + d^2) + ] + + = (a^2x^6 + b^2x^4 + c^2x^2 + d^2) + 2 * [ax^3 * (bx^2 + cx + d) + bx^2 * (cx + d) + cx * (d)] +-} + square (MkPolynomial []) = zero + square p = Data.Ring.sum' (recip 2) {-TODO-} 10 {-empirical-} $ diagonal : corners where + diagonal = {-# SCC "diagonal" #-} map Data.Monomial.square `lift` p + corners = {-# SCC "corners" #-} uncurry ( + zipWith (*=) + ) $ map MkPolynomial . init {-remove terminal null-} . Data.List.tails . tail &&& map Data.Monomial.double $ getMonomialList p + +-- | Defines the ability to divide /polynomials/. +instance ( + Eq c, + Fractional c, + Num e, + Ord e + ) => Data.QuotientRing.QuotientRing (Polynomial c e) where +{- + Uses /Euclidian division/. + . + . +-} + _ `quotRem'` MkPolynomial [] = error "Factory.Data.Polynomial.quotRem':\tzero denominator." + polynomialN `quotRem'` polynomialD = longDivide polynomialN where +-- longDivide :: (Fractional c, Num e, Ord e) => Polynomial c e -> (Polynomial c e, Polynomial c e) + longDivide (MkPolynomial []) = (zero, zero) -- Exactly divides. + longDivide numerator + | Data.Monomial.getExponent quotient < 0 = (zero, numerator) -- Indivisible remainder. + | otherwise = Control.Arrow.first (lift (quotient :)) $ longDivide (numerator =-= polynomialD *= quotient ) + where +-- quotient :: (Fractional c, Num e) => Data.Monomial.Monomial c e + quotient = getLeadingTerm numerator getLeadingTerm polynomialD + +{- | + * Transforms the data behind the constructor. + + * CAVEAT: similar to 'Data.Functor.fmap', but 'Polynomial' isn't an instance of 'Data.Functor.Functor' since we may want to operate on both /type-parameters/. + + * CAVEAT: the caller is required to re-'normalise' the resulting polynomial depending on the nature of the transformation of the data. +-} +lift :: (MonomialList c1 e1 -> MonomialList c2 e2) -> Polynomial c1 e1 -> Polynomial c2 e2 +lift transform = MkPolynomial . transform . getMonomialList + +-- | Returns the number of non-zero terms in the polynomial. +terms :: Polynomial c e -> Int +terms (MkPolynomial l) = length l + +-- | Return the highest-degree monomial. +getLeadingTerm :: Polynomial c e -> Data.Monomial.Monomial c e +getLeadingTerm (MkPolynomial []) = error "Factory.Data.Polynomial.getLeadingTerm:\tzero polynomial has no leading term." +getLeadingTerm (MkPolynomial (m : _)) = m + +-- | Removes terms with a /coefficient/ of zero. +pruneCoefficients :: (Eq c, Num c) => Polynomial c e -> Polynomial c e +pruneCoefficients (MkPolynomial []) = zero +pruneCoefficients p = filter ((/= 0) . Data.Monomial.getCoefficient) `lift` p + +-- | Sorts into /descending order/ of exponents, groups /like/ exponents, and calls 'pruneCoefficients'. +normalise :: (Eq c, Num c, Ord e) => Polynomial c e -> Polynomial c e +normalise = pruneCoefficients . lift ( + map ( + foldr ((+) . Data.Monomial.getCoefficient) 0 &&& Data.Monomial.getExponent . head + ) . Data.List.groupBy (=~) . Data.List.sortBy (flip (<=>)) + ) + +-- | Constructs an arbitrary /zeroeth-degree polynomial/, ie. independent of the /indeterminate/. +mkConstant :: (Eq c, Num c, Num e) => c -> Polynomial c e +mkConstant 0 = zero +mkConstant c = MkPolynomial [(c, 0)] + +-- | Constructs an arbitrary /first-degree polynomial/. +mkLinear :: (Eq c, Num c, Num e) + => c -- ^ Gradient. + -> c -- ^ Constant. + -> Polynomial c e +mkLinear m c = pruneCoefficients $ MkPolynomial [(m, 1), (c, 0)] + +-- | Smart constructor. Constructs an arbitrary /polynomial/. +mkPolynomial :: (Eq c, Num c, Ord e) => MonomialList c e -> Polynomial c e +mkPolynomial [] = zero +mkPolynomial l = normalise $ MkPolynomial l + +-- | Constructs a /polynomial/ with zero terms. +zero :: Polynomial c e +zero = MkPolynomial [] + +-- | Constructs a constant /monomial/, independent of the /indeterminate/. +one :: (Eq c, Num c, Num e) => Polynomial c e +one = mkConstant 1 + +-- | True if all /exponents/ are in the order defined by the specified comparator. +inOrder :: (e -> e -> Bool) -> Polynomial c e -> Bool +inOrder comparator p + | any ($ p) [isZero, isMonomial] = True + | otherwise = and . uncurry (zipWith comparator) . (init &&& tail) . map Data.Monomial.getExponent $ getMonomialList p + +-- | True if the /exponents/ of successive terms are in /ascending/ order. +inAscendingOrder :: Ord e => Polynomial c e -> Bool +inAscendingOrder = inOrder (<=) + +-- | True if the /exponents/ of successive terms are in /descending/ order. +inDescendingOrder :: Ord e => Polynomial c e -> Bool +inDescendingOrder = inOrder (>=) + +-- | True if no term has a /coefficient/ of zero. +isReduced :: (Eq c, Num c) => Polynomial c e -> Bool +isReduced = all ((/= 0) . Data.Monomial.getCoefficient) . getMonomialList + +-- | True if no term has a /coefficient/ of zero and the /exponents/ of successive terms are in /descending/ order. +isNormalised :: (Eq c, Num c, Ord e) => Polynomial c e -> Bool +isNormalised polynomial = all ($ polynomial) [isReduced, inDescendingOrder] + +{- | + * 'True' if the /leading coefficient/ is one. + + * . +-} +isMonic :: (Eq c, Num c) => Polynomial c e -> Bool +isMonic (MkPolynomial []) = False -- All coefficients are zero, and have therefore been removed. +isMonic p = (== 1) . Data.Monomial.getCoefficient $ getLeadingTerm p + +-- | True if there are zero terms. +isZero :: Polynomial c e -> Bool +isZero (MkPolynomial []) = True +isZero _ = False + +-- | True if there's exactly one term. +isMonomial :: Polynomial c e -> Bool +isMonomial (MkPolynomial []) = True +isMonomial _ = False + +-- | True if all /exponents/ are /positive/ integers as required. +isPolynomial :: Integral e => Polynomial c e -> Bool +isPolynomial = all Data.Monomial.isMonomial . getMonomialList + +{- | + * 'True' if the two specified /polynomials/ are /congruent/ in /modulo/-arithmetic. + + * . +-} +areCongruentModulo :: (Integral c, Num e, Ord e) + => Polynomial c e -- ^ LHS. + -> Polynomial c e -- ^ RHS. + -> c -- ^ Modulus. + -> Bool +areCongruentModulo _ _ 0 = error "Factory.Data.Polynomial.areCongruentModulo:\tzero modulus." +areCongruentModulo _ _ 1 = True +areCongruentModulo l r modulus + | l == r = True + | otherwise = all ((== 0) . (`mod` modulus) . Data.Monomial.getCoefficient) . getMonomialList $ l =-= r + +{- | + * Return the /degree/ (AKA /order/) of the /polynomial/. + + * . + + * . +-} +getDegree :: Num e => Polynomial c e -> e +getDegree (MkPolynomial []) = -1 -- CAVEAT: debatable, but makes some operations more robust and consistent. +getDegree p = Data.Monomial.getExponent $ getLeadingTerm p + +{- | + * Scale-up the specified /polynomial/ by a constant /monomial/ factor. + + * . +-} +(*=) :: (Eq c, Num c, Num e) => Polynomial c e -> Data.Monomial.Monomial c e -> Polynomial c e +polynomial *= monomial + | Data.Monomial.getCoefficient monomial == 1 = map (`Data.Monomial.shiftExponent` Data.Monomial.getExponent monomial) `lift` polynomial + | otherwise = map (monomial <*>) `lift` polynomial + +{- | + * Raise a /polynomial/ to the specified positive integral power, but using /modulo/-arithmetic. + + * Whilst one could naively implement this as @(x Data.Ring.=^ n) `mod` m@, this will result in arithmetic operatons on unnecessarily big integers. +-} +raiseModulo :: (Integral c, Integral power, Num e, Ord e, Show power) + => Polynomial c e -- ^ The base. + -> power -- ^ The exponent to which the base should be raised. + -> c -- ^ The modulus. + -> Polynomial c e -- ^ The result. +raiseModulo _ _ 0 = error "Factory.Data.Polynomial.raiseModulo:\tzero modulus." +raiseModulo _ _ 1 = zero +raiseModulo _ 0 modulus = mkConstant $ 1 `mod` modulus +raiseModulo polynomial power modulus + | power < 0 = error $ "Factory.Data.Polynomial.raiseModulo:\tthe result isn't guaranteed to be a polynomial, for power=" ++ show power + | first `elem` [zero, one] = first -- Eg 'raiseModulo (mkPolynomial [(3,1)]) 100 3' or 'raiseModulo (mkPolynomial [(3,1),(1,0)]) 100 3'. + | otherwise = slave power + where +-- first :: Integral c => Polynomial c e + first = polynomial `mod'` modulus + +-- slave :: (Integral c, Integral power, Num e, Ord e) => power -> Polynomial c e + slave 1 = first + slave n = (`mod'` modulus) . (if r == 0 {-even-} then id else (polynomial =*=)) . Data.Ring.square $ slave q {-recurse-} where + (q, r) = n `quotRem` 2 + +-- | Reduces all the coefficients using /modular/ arithmetic. +mod' :: Integral c + => Polynomial c e + -> c -- ^ Modulus. + -> Polynomial c e +mod' p modulus = pruneCoefficients $ map (`Data.Monomial.mod'` modulus) `lift` p + +{- | + * Evaluate the /polynomial/ at a specific /indeterminate/. + + * CAVEAT: requires positive exponents; but it wouldn't really be a /polynomial/ otherwise. + + * If the /polynomial/ is very sparse, this may be inefficient, + since it /memoizes/ the complete sequence of powers up to the polynomial's /degree/. +-} +evaluate :: (Num n, Integral e, Show e) + => n -- ^ The /indeterminate/. + -> Polynomial n e + -> n -- ^ The Result. +evaluate x = foldr ((+) . raise) 0 . getMonomialList where + powers = iterate (* x) 1 + + raise monomial + | exponent' < 0 = error $ "Factory.Data.Polynomial.evaluate.raise:\tnegative exponent; " ++ show exponent' + | otherwise = Data.Monomial.getCoefficient monomial * Data.List.genericIndex powers exponent' + where + exponent' = Data.Monomial.getExponent monomial + +-- | Convert the type of the /coefficient/s. +realCoefficientsToFrac :: (Real r, Fractional f) => Polynomial r e -> Polynomial f e +realCoefficientsToFrac = lift (Data.Monomial.realCoefficientToFrac `map`) + diff --git a/src-lib/Factory/Data/PrimeFactors.hs b/src-lib/Factory/Data/PrimeFactors.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Data/PrimeFactors.hs @@ -0,0 +1,143 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Describes a list of /prime factors/. + + * The product of this list of prime-factors represents the /composite/ integer from which they were originally extracted. +-} + +module Factory.Data.PrimeFactors( +-- * Types +-- ** Type-synonyms + Factors, +-- * Functions + insert', +-- invert, + product', + reduce, +-- reduceSorted, +-- sumExponents, +-- ** Operators + (>*<), + (>/<), + (>^) +) where + +import qualified Control.Arrow +import Control.Arrow((&&&)) +import qualified Data.List +import qualified Data.Ord +import qualified Factory.Math.DivideAndConquer as Math.DivideAndConquer +import qualified Factory.Data.Exponential as Data.Exponential +import Factory.Data.Exponential((<^), (=~)) +import qualified ToolShed.Data.List + +infixl 7 >/<, >*< -- Same as (/). +infixr 8 >^ -- Same as (^). + +{- | + * Each element of this list represents one /prime-factor/, expressed as an /exponential/ with a /prime/ base, of the original integer. + + * Whilst it only makes sense for both the /base/ and /exponent/ to be integral, these constrains are applied at the function-level as required. +-} +type Factors base exponent = [Data.Exponential.Exponential base exponent] + +{- | + * Sorts a list representing a product of /prime factors/ by increasing /base/. + + * Multiplies 'Data.Exponential.Exponential's of similar /base/. +-} +reduce :: (Ord base, Num exponent, Ord exponent) => Factors base exponent -> Factors base exponent +reduce = reduceSorted . Data.List.sort {-primarily by base-} + +-- | Multiplies 'Data.Exponential.Exponential's of similar /base/. +reduceSorted :: (Eq base, Num exponent) => Factors base exponent -> Factors base exponent +-- reduceSorted = map (Data.Exponential.getBase . head &&& sumExponents) . Data.List.groupBy (=~) -- Slow +reduceSorted [] = [] +reduceSorted (x : xs) + | null matched = x : reduceSorted remainder + | otherwise = Control.Arrow.second (+ sumExponents matched) x : reduceSorted remainder + where + (matched, remainder) = span (=~ x) xs + +{- | + * Insert a 'Data.Exponential.Exponential', into a list representing a product of /prime factors/, multiplying with any incumbent of like /base/. + + * The list should be sorted by increasing /base/. + + * Preserves the sort-order. + + * CAVEAT: this is tolerably efficient for sporadic insertion; to insert a list, use '>*<'. +-} +insert' :: (Ord base, Num exponent) => Data.Exponential.Exponential base exponent -> Factors base exponent -> Factors base exponent +insert' e [] = [e] +insert' e l@(x : xs) = case Data.Ord.comparing Data.Exponential.getBase e x of + LT -> e : l + GT -> x : insert' e xs -- Recurse. + _ -> Control.Arrow.second (+ Data.Exponential.getExponent e) x : xs -- Multiply by adding exponents. + +{- | + * Multiplies two lists each representing a product of /prime factors/, and sorted by increasing /base/. + + * Preserves the sort-order. +-} +(>*<) :: (Ord base, Num exponent, Ord exponent) => Factors base exponent -> Factors base exponent -> Factors base exponent +l >*< r = reduceSorted $ ToolShed.Data.List.merge l r + +-- | Invert the product of a list /prime factors/, by negating each of the /exponents/. +invert :: Num exponent => Factors base exponent -> Factors base exponent +invert = map Data.Exponential.invert + +{- | + * Divides two lists, each representing a product of /prime factors/, and sorted by increasing /base/. + + * Preserves the sort-order. +-} +(>/<) :: (Integral base, Integral exponent) + => Factors base exponent -- ^ The list of /prime factors/ in the /numerator/. + -> Factors base exponent -- ^ The list of /prime factors/ in the /denominator/. + -> (Factors base exponent, Factors base exponent) -- ^ The ratio of /numerator/ and /denominator/, after like /prime factors/ are cancelled. +numerator >/< denominator = filter ( + (> 0) . Data.Exponential.getExponent + ) &&& invert . filter ( + (< 0) . Data.Exponential.getExponent + ) $ numerator >*< invert denominator + +{- | + * Raise the product of a list /prime factors/ to the specified power. + + * CAVEAT: this merely involves raising each element to the specified power; cf. raising a /polynomial/ to a power. +-} +(>^) :: Num exponent => Factors base exponent -> exponent -> Factors base exponent +factors >^ power = map (<^ power) factors + +-- | Sum the /exponents/ of the specified list; as required to multiply exponentials with identical /base/. +sumExponents :: Num exponent => Factors base exponent -> exponent +sumExponents = foldr ((+) . Data.Exponential.getExponent) 0 + +-- | Multiply a list of /prime factors/. +product' :: (Num base, Integral exponent) + => Math.DivideAndConquer.BisectionRatio + -> Math.DivideAndConquer.MinLength + -> Factors base exponent -- ^ The list on which to operate. + -> base -- ^ The result. +product' bisectionRatio minLength = Math.DivideAndConquer.product' bisectionRatio minLength . map Data.Exponential.evaluate + diff --git a/src-lib/Factory/Data/PrimeWheel.hs b/src-lib/Factory/Data/PrimeWheel.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Data/PrimeWheel.hs @@ -0,0 +1,198 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines a /prime-wheel/, for use in prime-number generation; . +-} + +module Factory.Data.PrimeWheel( +-- * Types +-- ** Type-synonyms + Distance, + NPrimes, + PrimeMultiples, +-- Repository, +-- ** Data-types + PrimeWheel(getPrimeComponents, getSpokeGaps), +-- * Functions + estimateOptimalSize, +-- findCoprimes, + generateMultiples, + roll, + rotate, +-- ** Constructors + mkPrimeWheel, +-- ** Query + getCircumference, + getSpokeCount +) where + +import Control.Arrow((&&&), (***)) +import qualified Data.IntMap +import qualified Data.List + +{- | + * A conceptual /wheel/, with irregularly spaced spokes; . + + * On being rolled, the trace of the spokes, identifies candidates which are /coprime/ to those primes from which the /wheel/ was composed. + + * One can alternatively view this as a set of vertical nested rings, each with a /prime circumference/, and touching at its lowest point. + Each has a single mark on its /circumference/, which when rolled identifies multiples of that /circumference/. + When the complete set is rolled, from the state where all marks are coincident, all multiples of the set of primes, are traced. + + * CAVEAT: The distance required to return to this state (the wheel's /circumference/), grows rapidly with the number of primes: + +> zip [0 ..] . scanl (*) 1 $ [2,3,5,7,11,13,17,19,23,29,31] +> [(0,1),(1,2),(2,6),(3,30),(4,210),(5,2310),(6,30030),(7,510510),(8,9699690),(9,223092870),(10,6469693230),(11,200560490130)] + + * The number of spokes also grows rapidly with the number of primes: + +> zip [0 ..] . scanl (*) 1 . map pred $ [2,3,5,7,11,13,17,19,23,29,31] +> [(0,1),(1,1),(2,2),(3,8),(4,48),(5,480),(6,5760),(7,92160),(8,1658880),(9,36495360),(10,1021870080),(11,30656102400)] +-} +data PrimeWheel i = MkPrimeWheel { + getPrimeComponents :: [i], -- ^ Accessor: the ordered sequence of initial primes, from which the /wheel/ was composed. + getSpokeGaps :: [i] -- ^ Accessor: the sequence of spoke-gaps, the sum of which equals its /circumference/. +} deriving Show + +-- | The /circumference/ of the specified 'PrimeWheel'. +getCircumference :: Integral i => PrimeWheel i -> i +getCircumference = product . getPrimeComponents + +-- | The number of spokes in the specified 'PrimeWheel'. +getSpokeCount :: Integral i => PrimeWheel i -> i +getSpokeCount = foldr ((*) . pred) 1 . getPrimeComponents + +-- | An infinite increasing sequence, of the multiples of a specific prime. +type PrimeMultiples i = [i] + +-- | Defines a container for the 'PrimeMultiples'. +type Repository = Data.IntMap.IntMap (PrimeMultiples Int) + +-- | The size of the /wheel/, measured by the number of primes from which it is composed. +type NPrimes = Int + +{- | + * Uses a /Sieve of Eratosthenes/ (), to generate an initial sequence of primes. + + * Also generates an infinite sequence of candidate primes, each of which is /coprime/ to the primes just found, e.g.: + @filter ((== 1) . (gcd (2 * 3 * 5 * 7))) [11 ..] = [11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,121 ..]@; NB /121/ isn't prime. + + * CAVEAT: the use, for efficiency, of "Data.IntMap", limits the maximum bound of this sequence, though not to a significant extent. +-} +findCoprimes :: NPrimes -> ([Int], [Int]) +findCoprimes 0 = ([], []) +findCoprimes required + | required < 0 = error $ "Factory.Data.PrimeWheel.findCoprimes: invalid number of coprimes; " ++ show required + | otherwise = splitAt required $ 2 : sieve 3 0 Data.IntMap.empty + where + sieve :: Int -> NPrimes -> Repository -> [Int] + sieve candidate found repository = case Data.IntMap.lookup candidate repository of + Just primeMultiples -> sieve' found . insertUniq primeMultiples $ Data.IntMap.delete candidate repository -- Re-insert subsequent multiples. + Nothing {-prime-} -> let + found' = succ found + (key : values) = iterate (+ gap * candidate) $ candidate ^ (2 :: Int) -- Generate a sequence of prime-multiples, starting from its square. + in candidate : sieve' found' ( + if found' >= required + then repository + else Data.IntMap.insert key values repository + ) + where + gap :: Int + gap = 2 -- For efficiency, only sieve odd integers. + + sieve' :: NPrimes -> Repository -> [Int] + sieve' = sieve $ candidate + gap -- Tail-recurse. + + insertUniq :: PrimeMultiples Int -> Repository -> Repository + insertUniq l m = insert $ dropWhile (`Data.IntMap.member` m) l where + insert :: PrimeMultiples Int -> Repository + insert [] = error "Factory.Data.PrimeWheel.findCoprimes.sieve.insertUniq.insert:\tnull list" + insert (key : values) = Data.IntMap.insert key values m +{- | + * The optimal number of low primes from which to build the /wheel/, grows with the number of primes required; + the /circumference/ should be approximately the /square-root/ of the number of integers it will be required to sieve. + + * CAVEAT: one greater than this is returned, which empirically seems better. +-} +estimateOptimalSize :: Integral i => i -> NPrimes +estimateOptimalSize maxPrime = succ . length . takeWhile (<= optimalCircumference) . scanl1 (*) {-circumference-} . map fromIntegral {-prevent overflow-} . fst {-primes-} $ findCoprimes 10 {-arbitrary maximum bound-} where + optimalCircumference :: Integer + optimalCircumference = round (sqrt $ fromIntegral maxPrime :: Double) + +{- | + Smart constructor for a /wheel/ from the specified number of low primes. + + * The optimal number of low primes from which to build the /wheel/, grows with the number of primes required; + the /circumference/ should be approximately the /square-root/ of the number of integers it will be required to sieve. + + * The sequence of gaps between spokes on the /wheel/ is /symmetrical under reflection/; + though two values lie /on/ the axis, that aren't part of this symmetry. Eg: + +> nPrimes Gaps +> ====== ==== +> 0 [1] +> 1 [2] -- The terminal gap for all subsequent wheels is '2'; [(succ circumference `mod` circumference) - (pred circumference `mod` circumference)]. +> 2 [4,2] -- Both points are on the axis, so the symmetry isn't yet clear. +> 3 [6,4,2,4,2,4,6,2] +> 4 [10,2,4,2,4,6,2,6,4,2,4,6,6,2,6,4,2,6,4,6,8,4,2,4,2,4,8,6,4,6,2,4,6,2,6,6,4,2,4,6,2,6,4,2,4,2,10,2] + + Exploitation of this property has proved counter-productive, probably because it requires /strict evaluation/, + exposing the user to the full cost of inadvertently choosing a /wheel/, which in practice, is rotated less than once. +-} +mkPrimeWheel :: Integral i => NPrimes -> PrimeWheel i +mkPrimeWheel 0 = MkPrimeWheel [] [1] +mkPrimeWheel nPrimes + | nPrimes < 0 = error $ "Factory.Data.PrimeWheel.mkPrimeWheel: unable to construct from " ++ show nPrimes ++ " primes" + | otherwise = primeWheel + where + (primeComponents, coprimeCandidates) = (map fromIntegral *** map fromIntegral . Data.List.genericTake (getSpokeCount primeWheel)) $ findCoprimes nPrimes + primeWheel = MkPrimeWheel primeComponents $ zipWith (-) coprimeCandidates $ 1 : coprimeCandidates -- Measure the gaps between candidate primes. + +-- | Couples a candidate prime with a /rolling wheel/, to define the distance rolled. +type Distance i = (i, [i]) + +-- | Generates a new candidate prime, from a /rolling wheel/, and the current candidate. +rotate :: Integral i => Distance i -> Distance i +rotate (candidate, rollingWheel) = (candidate +) . head &&& tail $ rollingWheel + +{-# INLINE rotate #-} + +-- | Generate an infinite, increasing sequence of candidate primes, from the specified /wheel/. +roll :: Integral i => PrimeWheel i -> [Distance i] +roll primeWheel = tail $ iterate rotate (1, cycle $ getSpokeGaps primeWheel) + +{- | + * Generates multiples of the specified prime, starting from its /square/, + skipping those multiples of the low primes from which the specified 'PrimeWheel' was composed, + and which therefore, the /wheel/ won't generate as candidates. Eg: + +> Prime Rotating PrimeWheel 3 Output +> ===== ===================== ====== +> 7 [4,2,4,2,4,6,2,6] [49,77,91,119,133,161,203,217,259 ..] +> 11 [2,4,2,4,6,2,6,4] [121,143,187,209,253,319,341,407 ..] +> 13 [4,2,4,6,2,6,4,2] [169,221,247,299,377,403,481,533,559 ..] +-} +generateMultiples :: Integral i + => i -- ^ The number to square and multiply + -> [i] -- ^ A /rolling wheel/, the track of which, delimits the gaps between /coprime/ candidates. + -> [i] +generateMultiples i = scanl (\accumulator -> (+ accumulator) . (* i)) (i ^ (2 :: Int)) + +{-# INLINE generateMultiples #-} + diff --git a/src-lib/Factory/Data/QuotientRing.hs b/src-lib/Factory/Data/QuotientRing.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Data/QuotientRing.hs @@ -0,0 +1,79 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Describes a /Quotient Ring/; . + + * This is a /ring/ composed from a residue-class resulting from /modular/ division. +-} + +module Factory.Data.QuotientRing( +-- * Type-classes + QuotientRing(..), +-- * Functions + quot', + rem', +-- ** Predicates + areCongruentModulo, + isDivisibleBy +) where + +import Factory.Data.Ring((=-=)) +import qualified Factory.Data.Ring as Data.Ring + +-- | Defines a sub-class of 'Data.Ring.Ring', in which division is implemented. +class Data.Ring.Ring q => QuotientRing q where + quotRem' :: q -> q -> (q, q) -- ^ Divides the first operand by the second, to yield a pair composed from the /quotient/ and the /remainder/. + +-- | Returns the /quotient/, after division of the two specified 'QuotientRing's. +quot' :: QuotientRing q + => q -- ^ Numerator. + -> q -- ^ Denominator. + -> q +quot' numerator = fst . quotRem' numerator + +-- | Returns the /remainder/, after division of the two specified 'QuotientRing's. +rem' :: QuotientRing q + => q -- ^ Numerator. + -> q -- ^ Denominator. + -> q +rem' numerator = snd . quotRem' numerator + +{- | + * 'True' if the two specified 'QuotientRing's are /congruent/ in /modulo/-arithmetic, where the /modulus/ is a third 'QuotientRing'. + + * . +-} +areCongruentModulo :: (Eq q, QuotientRing q) + => q -- ^ LHS. + -> q -- ^ RHS. + -> q -- ^ Modulus. + -> Bool +areCongruentModulo l r modulus + | l == r = True -- Only required for efficiency. + | otherwise = (l =-= r) `isDivisibleBy` modulus + +-- | True if the second operand /divides/ the first. +isDivisibleBy :: (Eq q, QuotientRing q) + => q -- ^ Numerator. + -> q -- ^ Denominator. + -> Bool +numerator `isDivisibleBy` denominator = rem' numerator denominator == Data.Ring.additiveIdentity + diff --git a/src-lib/Factory/Data/Ring.hs b/src-lib/Factory/Data/Ring.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Data/Ring.hs @@ -0,0 +1,118 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Describes a /ring/ and operations on its members. + + * . + + * . +-} + +module Factory.Data.Ring( +-- * Type-classes + Ring(..), +-- * Types +-- ** Data.types +-- Product, +-- Sum, +-- * Functions + product', + sum', +-- ** Operators + (=^) +) where + +import qualified Data.Monoid +import qualified Factory.Math.DivideAndConquer as Math.DivideAndConquer + +infixl 6 =+= -- Same as (+). +infixl 6 =-= -- Same as (-). +infixl 7 =*= -- Same as (*). +infixr 8 =^ -- Same as (^). + +{- | + * Define both the operations applicable to all members of the /ring/, and its mandatory members. + + * Minimal definition; '=+=', '=*=', 'additiveInverse', 'multiplicativeIdentity', 'additiveIdentity'. +-} +class Ring r where + (=+=) :: r -> r -> r -- ^ Addition of two members; required to be /commutative/; . + (=*=) :: r -> r -> r -- ^ Multiplication of two members. + additiveInverse :: r -> r -- ^ The operand required to yield /zero/ under addition; . + multiplicativeIdentity :: r -- ^ The /identity/-member under multiplication; . + additiveIdentity :: r -- ^ The /identity/-member under addition (AKA /zero/); . + + (=-=) :: r -> r -> r -- ^ Subtract the two specified /ring/-members. + l =-= r = l =+= additiveInverse r -- Default implementation. + + square :: r -> r -- ^ Square the ring. + square r = r =*= r -- Default implementation; there may be a more efficient one. + +{- | + * Raise a /ring/-member to the specified positive integral power. + + * Exponentiation is implemented as a sequence of either squares of, or multiplications by, the /ring/-member; + . +-} +(=^) :: ( + Eq r, + Integral power, + Ring r, + Show power + ) => r -> power -> r +_ =^ 0 = multiplicativeIdentity +ring =^ power + | power < 0 = error $ "Factory.Data.Ring.(=^):\tthe result isn't guaranteed to be a ring-member, for power=" ++ show power + | ring `elem` [additiveIdentity, multiplicativeIdentity] = ring + | otherwise = slave power + where + slave 1 = ring + slave n = (if r == 0 {-even-} then id else (=*= ring)) . square $ slave q where + (q, r) = n `quotRem` 2 + +-- | Does for 'Ring', what 'Data.Monoid.Product' does for type 'Num', in that it makes it an instance of 'Data.Monoid.Monoid' under multiplication. +newtype Product p = MkProduct { + getProduct :: p -- ^ Access the polymorphic payload. +} deriving (Read, Show) + +instance Ring r => Data.Monoid.Monoid (Product r) where + mempty = MkProduct multiplicativeIdentity + MkProduct x `mappend` MkProduct y = MkProduct $ x =*= y + +-- | Returns the /product/ of the list of /ring/-members. +product' :: Ring r => Math.DivideAndConquer.BisectionRatio -> Math.DivideAndConquer.MinLength -> [r] -> r +-- product' _ _ = getProduct . Data.Monoid.mconcat . map MkProduct +product' ratio minLength = getProduct . Math.DivideAndConquer.divideAndConquer ratio minLength . map MkProduct + +-- | Does for 'Ring', what 'Data.Monoid.Sum' does for type 'Num', in that it makes it an instance of 'Data.Monoid.Monoid' under addition. +newtype Sum s = MkSum { + getSum :: s -- ^ Access the polymorphic payload. +} deriving (Read, Show) + +instance Ring r => Data.Monoid.Monoid (Sum r) where + mempty = MkSum additiveIdentity + MkSum x `mappend` MkSum y = MkSum $ x =+= y + +-- | Returns the /sum/ of the list of /ring/-members. +sum' :: Ring r => Math.DivideAndConquer.BisectionRatio -> Math.DivideAndConquer.MinLength -> [r] -> r +-- sum' _ _ = getSum . Data.Monoid.mconcat . map MkSum +sum' ratio minLength = getSum . Math.DivideAndConquer.divideAndConquer ratio minLength . map MkSum + diff --git a/src-lib/Factory/Math/ArithmeticGeometricMean.hs b/src-lib/Factory/Math/ArithmeticGeometricMean.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/ArithmeticGeometricMean.hs @@ -0,0 +1,91 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Determines the /Arithmetic-geometric mean/; . +-} + +module Factory.Math.ArithmeticGeometricMean( +-- * Types +-- ** Type-synonyms + ArithmeticMean, + GeometricMean, + AGM, +-- * Functions + convergeToAGM, + spread, +-- ** Accessors + getArithmeticMean, + getGeometricMean, +-- ** Predicates + isValid +) where + +import Control.Arrow((&&&)) +import qualified Control.Parallel.Strategies +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.SquareRoot as Math.SquareRoot + +-- | The type of the /arithmetic mean/; . +type ArithmeticMean = Rational + +-- | The type of the /geometric mean/; . +type GeometricMean = Rational + +-- | Encapsulates both /arithmetic/ and /geometric/ means. +type AGM = (ArithmeticMean, GeometricMean) + +-- | Accessor. +{-# INLINE getArithmeticMean #-} +getArithmeticMean :: AGM -> ArithmeticMean +getArithmeticMean = fst + +-- | Accessor. +{-# INLINE getGeometricMean #-} +getGeometricMean :: AGM -> GeometricMean +getGeometricMean = snd + +-- | Returns an infinite list which converges on the /Arithmetic-geometric mean/. +convergeToAGM :: Math.SquareRoot.Algorithmic squareRootAlgorithm => squareRootAlgorithm -> Math.Precision.DecimalDigits -> AGM -> [AGM] +convergeToAGM squareRootAlgorithm decimalDigits agm + | decimalDigits <= 0 = error $ "Factory.Math.ArithmeticGeometricMean.convergeToAGM:\tinvalid number of decimal digits; " ++ show decimalDigits + | not $ isValid agm = error $ "Factory.Math.ArithmeticGeometricMean.convergeToAGM:\tboth means must be positive for a real geometric mean; " ++ show agm + | spread agm == 0 = repeat agm + | otherwise = let + simplify :: Rational -> Rational + simplify = Math.Precision.simplify (pred decimalDigits {-ignore single integral digit-}) -- This makes a gigantic difference to performance. + + findArithmeticMean :: AGM -> ArithmeticMean + findArithmeticMean = (/ 2) . uncurry (+) + + findGeometricMean :: AGM -> GeometricMean + findGeometricMean = Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits . uncurry (*) + in iterate ( + Control.Parallel.Strategies.withStrategy ( + Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rdeepseq Control.Parallel.Strategies.rdeepseq + ) . (simplify . findArithmeticMean &&& simplify . findGeometricMean) + ) agm + +-- | Returns the bounds within which the 'AGM' has been constrained. +spread :: AGM -> Rational +spread = uncurry (-) + +-- | Checks that both /means/ are positive, as required for the /geometric mean/ to be consistently /real/. +isValid :: AGM -> Bool +isValid (a, g) = all (>= 0) [a, g] + diff --git a/src-lib/Factory/Math/DivideAndConquer.hs b/src-lib/Factory/Math/DivideAndConquer.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/DivideAndConquer.hs @@ -0,0 +1,122 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Provides a polymorphic algorithm, to /unfold/ a list into a tree, to which an /associative binary operator/ is then applied to re-/fold/ the tree to a /scalar/. + + * Implementations of this strategy have been provided for /addition/ and /multiplication/, + though other associative binary operators, like 'gcd' or 'lcm' could also be used. + + * Where the contents of the list are consecutive, a more efficient implementation is available in /Factory.Data.Interval/. +-} + +module Factory.Math.DivideAndConquer( +-- * Types +-- ** Type-synonyms + BisectionRatio, + MinLength, +-- * Functions + divideAndConquer, + product', + sum' +) where + +import Control.Arrow((***)) +import qualified Control.Parallel.Strategies +import qualified Data.Monoid +import qualified Data.Ratio + +{- | + * The ratio of the original list-length at which to bisect. + + * CAVEAT: the value can overflow. +-} +type BisectionRatio = Data.Ratio.Ratio Int + +-- | The list-length beneath which to terminate bisection. +type MinLength = Int + +{- | + * Reduces a list to a single scalar encapsulated in a 'Data.Monoid.Monoid', + using a /divide-and-conquer/ strategy, + bisecting the list and recursively evaluating each part; . + + * By choosing a 'bisectionRatio' other than @(1 % 2)@, the bisection can be made asymmetrical. + The specified ratio represents the length of the left-hand portion, over the original list-length; + eg. @(1 % 3)@ results in the first part, half the length of the second. + + * This process of recursive bisection, is terminated beneath the specified minimum list-length, + after which the /monoid/'s binary operator is directly /folded/ over the list. + + * One can view this as a , + in which the list is exploded into a binary tree-structure + (each leaf of which contains a list of up to 'minLength' integers, and each node of which contains an associative binary operator), + and then collapsed to a scalar, by application of the operators. +-} +divideAndConquer :: Data.Monoid.Monoid monoid + => BisectionRatio -- ^ The ratio of the original list-length at which to bisect. + -> MinLength -- ^ For efficiency, the list will not be bisected, when it's length has been reduced to this value. + -> [monoid] -- ^ The list on which to operate. + -> monoid -- ^ The resulting scalar. +divideAndConquer bisectionRatio minLength l + | any ($ apportion minLength) [ + (< 1), -- The left-hand list may be null. + (> pred minLength) -- The right-hand list may be null. + ] = error $ "Factory.Math.DivideAndConquer.divideAndConquer:\tbisectionRatio='" ++ show bisectionRatio ++ "' is incompatible with minLength=" ++ show minLength ++ "." + | otherwise = slave (length l) l + where + apportion :: Int -> Int + apportion list = (list * Data.Ratio.numerator bisectionRatio) `div` Data.Ratio.denominator bisectionRatio + + slave len list + | len <= minLength = Data.Monoid.mconcat list -- Fold the monoid's binary operator over the list. + | otherwise = uncurry Data.Monoid.mappend . Control.Parallel.Strategies.withStrategy ( + Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rseq Control.Parallel.Strategies.rseq + ) . (slave cut *** slave (len - cut)) $ splitAt cut list where -- Apply the monoid's binary operator to the two operands resulting from bisection. + cut = apportion len + +{- | + * Multiplies the specified list of numbers. + + * Since the result can be large, 'divideAndConquer' is used in an attempt to form operands of a similar order of magnitude, + which creates scope for the use of more efficient multiplication-algorithms. +-} +product' :: Num n + => BisectionRatio -- ^ The ratio of the original list-length at which to bisect. + -> MinLength -- ^ For efficiency, the list will not be bisected, when it's length has been reduced to this value. + -> [n] -- ^ The numbers whose product is required. + -> n -- ^ The resulting product. +product' bisectionRatio minLength = Data.Monoid.getProduct . divideAndConquer bisectionRatio minLength . map Data.Monoid.Product + +{- | + * Sums the specified list of numbers. + + * Since the result can be large, 'divideAndConquer' is used in an attempt to form operands of a similar order of magnitude, + which creates scope for the use of more efficient multiplication-algorithms. + /Multiplication/ is required for the /addition/ of 'Rational' numbers by cross-multiplication; + this function is unlikely to be useful for other numbers. +-} +sum' :: Num n + => BisectionRatio -- ^ The ratio of the original list-length at which to bisect. + -> MinLength -- ^ For efficiency, the list will not be bisected, when it's length has been reduced to this value. + -> [n] -- ^ The numbers whose sum is required. + -> n -- ^ The resulting sum. +sum' bisectionRatio minLength = Data.Monoid.getSum . divideAndConquer bisectionRatio minLength . map Data.Monoid.Sum + diff --git a/src-lib/Factory/Math/Factorial.hs b/src-lib/Factory/Math/Factorial.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Factorial.hs @@ -0,0 +1,37 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Whilst this particular function is the subject of many introductory examples to Haskell, + the simple algorithms appropriate for that forum, leave a large margin for performance-improvement. + This module provides the interface for alternative algorithms. + + * . +-} + +module Factory.Math.Factorial( +-- * Type-classes + Algorithmic(..) +) where + +-- | Defines the methods expected of a /factorial/-algorithm. +class Algorithmic algorithm where + factorial :: (Integral i, Show i) => algorithm -> i -> i + diff --git a/src-lib/Factory/Math/Fibonacci.hs b/src-lib/Factory/Math/Fibonacci.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Fibonacci.hs @@ -0,0 +1,42 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] . +-} + +module Factory.Math.Fibonacci( +-- * Constants + fibonacci, + primeIndexedFibonacci +) where + +import qualified Data.Numbers.Primes + +-- | A constant ordered list of the /Fibonacci/-numbers. +fibonacci :: Integral i => [i] +fibonacci = 0 : scanl (+) 1 fibonacci + +{- | + * The subset of 'fibonacci', /indexed/ by a /prime/-number. + + * . +-} +primeIndexedFibonacci :: Integral i => [i] +primeIndexedFibonacci = map (fibonacci !!) Data.Numbers.Primes.primes + diff --git a/src-lib/Factory/Math/Hyperoperation.hs b/src-lib/Factory/Math/Hyperoperation.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Hyperoperation.hs @@ -0,0 +1,113 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Provides various /hyperoperations/; . +-} + +module Factory.Math.Hyperoperation( +-- * Types +-- ** Type-synonyms + Base, + HyperExponent, +-- * Constants + succession, + addition, + multiplication, + exponentiation, + tetration, + pentation, + hexation, +-- * Functions + hyperoperation, + ackermannPeter, + powerTower, +-- ** Predicates + areCoincidental +) where + +import qualified Data.List + +{- | + * Merely to enhance self-documentation. + + * CAVEAT: whilst it may appear that 'Base' could be non-'Integral', the recursive definition for /hyper-exponents/ above 'tetration', prevents this. +-} +type Base = Integer + +{- | + * Merely to enhance self-documentation. + + * CAVEAT: whilst 'Base' and 'HyperExponent' can be independent types for both 'exponentiation' and 'tetration', they interact for other /hyper-exponents/. +-} +type HyperExponent = Base + +succession, addition, multiplication, exponentiation, tetration, pentation, hexation :: Int -- Arbitrarily. +(succession : addition : multiplication : exponentiation : tetration : pentation : hexation : _) = [0 ..] + +{- | + * Returns the /power-tower/ of the specified /base/; . + + * A synonym for /tetration/; + , + . +-} +powerTower :: (Integral base, Integral hyperExponent, Show base) => base -> hyperExponent -> base +powerTower 0 hyperExponent + | even hyperExponent = 1 + | otherwise = 0 +powerTower _ (-1) = 0 -- The only negative hyper-exponent for which there's a consistent result. +powerTower base hyperExponent + | base < 0 && hyperExponent > 1 = error $ "Factory.Math.Hyperoperation.powerTower:\tundefined for negative base; " ++ show base + | otherwise = Data.List.genericIndex (iterate (base ^) 1) hyperExponent + +-- | The /hyperoperation/-sequence; . +hyperoperation :: (Integral rank, Show rank) => rank -> Base -> HyperExponent -> Base +hyperoperation rank base hyperExponent + | rank < fromIntegral succession = error $ "Factory.Math.Hyperoperation.hyperoperation:\tundefined for rank; " ++ show rank + | hyperExponent < 0 = error $ "Factory.Math.Hyperoperation.hyperoperation:\tundefined for hyper-exponent; " ++ show hyperExponent + | otherwise = rank ^# hyperExponent + where + (^#) :: Integral rank => rank -> HyperExponent -> Base + r ^# 0 = case r of + 1 {-addition-} -> base + 2 {-multiplication-} -> 0 + _ -> 1 + r ^# e = case r of + 0 {-succession-} -> succ {-fromIntegral-} e + 1 {-addition-} -> base + {-fromIntegral-} e + 2 {-multiplication-} -> base * {-fromIntegral-} e + 3 {-exponentiation-} -> base ^ e + 4 {-tetration-} -> base `powerTower` e + _ + | e' == e -> tetration ^# e' -- To which it would otherwise be reduced by laborious recursion. + | otherwise -> pred r ^# e' + where + e' = {-fromIntegral $-} r ^# pred e + +-- | The /Ackermann-Peter/-function; . +ackermannPeter :: (Integral rank, Show rank) => rank -> HyperExponent -> Base +ackermannPeter rank = (+ negate 3) . hyperoperation rank 2 {-base-} . (+ 3) + +-- | True if @hyperoperation base hyperExponent@ has the same value for each specified 'rank'. +areCoincidental :: (Integral rank, Show rank) => Base -> HyperExponent -> [rank] -> Bool +areCoincidental _ _ [] = True +areCoincidental _ _ [_] = True +areCoincidental base hyperExponent ranks = all (== h) hs where + (h : hs) = map (\rank -> hyperoperation rank base hyperExponent) ranks + diff --git a/src-lib/Factory/Math/Implementations/Factorial.hs b/src-lib/Factory/Math/Implementations/Factorial.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Factorial.hs @@ -0,0 +1,138 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Provides implementations of the class 'Math.Factorial.Algorithmic'. + + * Provides additional functions related to /factorials/, but which depends on a specific implementation, + and which therefore can't be accessed throught the class-interface. + + * . + + * . + + * . +-} + +module Factory.Math.Implementations.Factorial( +-- * Types +-- ** Data-types + Algorithm(..), +-- * Functions + primeFactors, +-- primeMultiplicity, + risingFactorial, + fallingFactorial, +-- ** Operators + (!/!) +) where + +import qualified Data.Numbers.Primes +import qualified Factory.Data.Interval as Data.Interval +import qualified Factory.Data.PrimeFactors as Data.PrimeFactors +import qualified Factory.Math.Factorial as Math.Factorial +import qualified ToolShed.Defaultable + +infixl 7 !/! -- Same as (/). + +-- | The algorithms by which /factorial/ has been implemented. +data Algorithm = + Bisection -- ^ The integers from which the /factorial/ is composed, are multiplied using @Data.Interval.product'@. + | PrimeFactorisation -- ^ The /prime factors/ of the /factorial/ are extracted, then raised to the appropriate power, before multiplication. + deriving (Eq, Read, Show) + +instance ToolShed.Defaultable.Defaultable Algorithm where + defaultValue = Bisection + +instance Math.Factorial.Algorithmic Algorithm where + factorial algorithm n + | n < 2 = 1 + | otherwise = case algorithm of + Bisection -> risingFactorial 2 $ pred n + PrimeFactorisation -> Data.PrimeFactors.product' (recip 5) {-empirical-} 10 {-empirical-} $ primeFactors n + +{- | + * Returns the /prime factors/, of the /factorial/ of the specifed integer. + + * Precisely all the primes less than or equal to the specified integer /n/, are included in /n!/; + only the multiplicity of each of these known prime components need be determined. + + * . + + * CAVEAT: currently a hotspot. +-} +primeFactors :: Integral base + => base -- ^ The number, whose /factorial/ is to be factorised. + -> Data.PrimeFactors.Factors base base -- ^ The /base/ and /exponent/ of each /prime factor/ in the /factorial/, ordered by increasing /base/ (and decreasing /exponent/). +primeFactors n = takeWhile ((> 0) . snd) $ map (\prime -> (prime, primeMultiplicity prime n)) Data.Numbers.Primes.primes + +{- | + * The number of times a specific /prime/, can be factored from the /factorial/ of the specified integer. + + * General purpose /prime-factorisation/ has /exponential time-complexity/, + so use /Legendre's Theorem/, which relates only to the /prime factors/ of /factorials/. + + * . +-} +primeMultiplicity :: Integral i + => i -- ^ A prime number. + -> i -- ^ The integer, the factorial of which the prime is a factor. + -> i -- ^ The number of times the prime occurs in the factorial. +primeMultiplicity prime = sum . takeWhile (> 0) . tail . iterate (`div` prime) + +-- | Returns the /rising factorial/; +risingFactorial :: (Integral i, Show i) + => i -- ^ The lower bound of the integer-range, whose product is returned. + -> i -- ^ The number of integers in the range above. + -> i -- ^ The result. +risingFactorial _ 0 = 1 +risingFactorial 0 _ = 0 +risingFactorial x n = Data.Interval.product' (recip 2) 64 $ Data.Interval.normalise (x, pred $ x + n) + +-- | Returns the /falling factorial/; +fallingFactorial :: (Integral i, Show i) + => i -- ^ The upper bound of the integer-range, whose product is returned. + -> i -- ^ The number of integers in the range beneath. + -> i -- ^ The result. +fallingFactorial _ 0 = 1 +fallingFactorial 0 _ = 0 +fallingFactorial x n = Data.Interval.product' (recip 2) 64 $ Data.Interval.normalise (x, succ $ x - n) + +{- | + * Returns the ratio of two factorials. + + * It is more efficient than evaluating both factorials, and then dividing. + + * For more complex combinations of factorials, such as in the /Binomial coefficient/, + extract the /prime factors/ using 'primeFactors' + then manipulate them using the module "Data.PrimeFactors", + and evaluate it using by /Data.PrimeFactors.product'/. +-} +(!/!) :: (Integral i, Fractional f, Show i) + => i -- ^ The /numerator/. + -> i -- ^ The /denominator/. + -> f -- ^ The resulting fraction. +numerator !/! denominator + | numerator <= 1 = recip . fromIntegral $ Math.Factorial.factorial (ToolShed.Defaultable.defaultValue :: Algorithm) denominator + | denominator <= 1 = fromIntegral $ Math.Factorial.factorial (ToolShed.Defaultable.defaultValue :: Algorithm) numerator + | numerator == denominator = 1 + | numerator < denominator = recip $ denominator !/! numerator -- Recurse. + | otherwise = fromIntegral $ Data.Interval.product' (recip 2) 64 (succ denominator, numerator) + diff --git a/src-lib/Factory/Math/Implementations/Pi/AGM/Algorithm.hs b/src-lib/Factory/Math/Implementations/Pi/AGM/Algorithm.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/AGM/Algorithm.hs @@ -0,0 +1,42 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the set of /Arithmetic-geometric Mean/-type /Pi/-algorithms which have been implemented; currently just one. +-} + +module Factory.Math.Implementations.Pi.AGM.Algorithm( +-- * Types +-- ** Data-types + Algorithm(..) +) where + +import qualified Factory.Math.Implementations.Pi.AGM.BrentSalamin as Math.Implementations.Pi.AGM.BrentSalamin +import qualified Factory.Math.Pi as Math.Pi +import qualified Factory.Math.SquareRoot as Math.SquareRoot +import qualified ToolShed.Defaultable + +-- | Defines the available algorithms. +data Algorithm squareRootAlgorithm = BrentSalamin squareRootAlgorithm deriving (Eq, Read, Show) + +instance ToolShed.Defaultable.Defaultable squareRootAlgorithm => ToolShed.Defaultable.Defaultable (Algorithm squareRootAlgorithm) where + defaultValue = BrentSalamin ToolShed.Defaultable.defaultValue + +instance Math.SquareRoot.Algorithmic squareRootAlgorithm => Math.Pi.Algorithmic (Algorithm squareRootAlgorithm) where + openR (BrentSalamin squareRootAlgorithm) = Math.Implementations.Pi.AGM.BrentSalamin.openR squareRootAlgorithm + diff --git a/src-lib/Factory/Math/Implementations/Pi/AGM/BrentSalamin.hs b/src-lib/Factory/Math/Implementations/Pi/AGM/BrentSalamin.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/AGM/BrentSalamin.hs @@ -0,0 +1,64 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Implements the /Brent-Salamin/ (AKA /Gauss-Legendre/) algorithm; + , + , + . + + * The precision of the result approximately doubles for each iteration. + + [@CAVEAT@] Assumptions on the convergence-rate result in rounding-errors, when only a small number of digits are requested. +-} + +module Factory.Math.Implementations.Pi.AGM.BrentSalamin( +-- * Functions + openR +) where + +import Control.Arrow((&&&)) +import qualified Factory.Math.ArithmeticGeometricMean as Math.ArithmeticGeometricMean +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.SquareRoot as Math.SquareRoot + +{- | + * Returns /Pi/, accurate to the specified number of decimal digits. + + * This algorithm is based on the /arithmetic-geometric/ mean of @1@ and @(1 / sqrt 2)@, + but there are many confusingly similar formulations. + The algorithm I've used here, where @a@ is the /arithmetic mean/ and @g@ is the /geometric mean/, is equivalent to other common formulations: + +> pi = (a[N-1] + g[N-1])^2 / (1 - sum [2^n * (a[n] - g[n])^2]) where n = [0 .. N-1] +> => 4*a[N]^2 / (1 - sum [2^n * (a[n]^2 - 2*a[n]*g[n] + g[n]^2)]) +> => 4*a[N]^2 / (1 - sum [2^n * (a[n]^2 + 2*a[n]*g[n] + g[n]^2 - 4*a[n]*g[n])]) +> => 4*a[N]^2 / (1 - sum [2^n * ((a[n] + g[n])^2 - 4*a[n]*g[n])]) +> => 4*a[N]^2 / (1 - sum [2^(n-1) * 4 * (a[n-1]^2 - g[n-1]^2)]) where n = [1 .. N] +> => 4*a[N]^2 / (1 - sum [2^(n+1) * (a[n-1]^2 - g[n-1]^2)]) + +-} +openR :: Math.SquareRoot.Algorithmic squareRootAlgorithm => squareRootAlgorithm -> Math.Precision.DecimalDigits -> Rational +openR squareRootAlgorithm decimalDigits = uncurry (/) . ( + Math.Power.square . uncurry (+) . last &&& negate . pred . sum . zipWith (*) (iterate (* 2) 1) . map (Math.Power.square . Math.ArithmeticGeometricMean.spread) + ) . take ( + Math.Precision.getIterationsRequired Math.Precision.quadraticConvergence 1 decimalDigits + ) $ Math.ArithmeticGeometricMean.convergeToAGM squareRootAlgorithm decimalDigits (1, Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits (recip 2 :: Rational)) + diff --git a/src-lib/Factory/Math/Implementations/Pi/BBP/Algorithm.hs b/src-lib/Factory/Math/Implementations/Pi/BBP/Algorithm.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/BBP/Algorithm.hs @@ -0,0 +1,47 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the set of /Bailey-Borwein-Plouffe/-type formulae which have been implemented. +-} + +module Factory.Math.Implementations.Pi.BBP.Algorithm( +-- * Types +-- ** Data-types + Algorithm(..) +) where + +import qualified Factory.Math.Implementations.Pi.BBP.Base65536 as Math.Implementations.Pi.BBP.Base65536 +import qualified Factory.Math.Implementations.Pi.BBP.Bellard as Math.Implementations.Pi.BBP.Bellard +import qualified Factory.Math.Implementations.Pi.BBP.Implementation as Math.Implementations.Pi.BBP.Implementation +import qualified Factory.Math.Pi as Math.Pi +import qualified ToolShed.Defaultable + +-- | Defines those /BBP/-type series which have been implemented. +data Algorithm = + Base65536 -- ^ A /base/-@2^16@ version of the formula. + | Bellard -- ^ A /nega-base/ @2^10@ version of the formula. + deriving (Eq, Read, Show) + +instance ToolShed.Defaultable.Defaultable Algorithm where + defaultValue = Base65536 + +instance Math.Pi.Algorithmic Algorithm where + openR Base65536 = Math.Implementations.Pi.BBP.Implementation.openR Math.Implementations.Pi.BBP.Base65536.series + openR Bellard = Math.Implementations.Pi.BBP.Implementation.openR Math.Implementations.Pi.BBP.Bellard.series + diff --git a/src-lib/Factory/Math/Implementations/Pi/BBP/Base65536.hs b/src-lib/Factory/Math/Implementations/Pi/BBP/Base65536.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/BBP/Base65536.hs @@ -0,0 +1,38 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines a specific base-@2^16@ /BBP/-formula; + +-} + +module Factory.Math.Implementations.Pi.BBP.Base65536( +-- * Constants + series +) where + +import qualified Factory.Math.Implementations.Pi.BBP.Series as Math.Implementations.Pi.BBP.Series + +-- | Defines the parameters of this specific series. +series :: Math.Implementations.Pi.BBP.Series.Series +series = Math.Implementations.Pi.BBP.Series.MkSeries { + Math.Implementations.Pi.BBP.Series.numerators = zipWith ($) (cycle [id, id, id, negate]) $ map (2 ^) [15 :: Integer, 14, 14, 12, 11, 10, 10, 8, 7, 6, 6, 4, 3, 2, 2, 0], + Math.Implementations.Pi.BBP.Series.getDenominators = \i -> map (32 * fromIntegral i +) [2, 3, 4, 7, 10, 11, 12, 15, 18, 19, 20, 23, 26, 27, 28, 31], + Math.Implementations.Pi.BBP.Series.seriesScalingFactor = recip $ 2 ^ (13 :: Int), + Math.Implementations.Pi.BBP.Series.base = 2 ^ (16 :: Int) +} diff --git a/src-lib/Factory/Math/Implementations/Pi/BBP/Bellard.hs b/src-lib/Factory/Math/Implementations/Pi/BBP/Bellard.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/BBP/Bellard.hs @@ -0,0 +1,41 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /Bellard/'s nega-base-@2^10@ /BBP/-formula; +-} + +module Factory.Math.Implementations.Pi.BBP.Bellard( +-- * Constants + series +) where + +import Control.Arrow((&&&)) +import qualified Factory.Math.Implementations.Pi.BBP.Series as Math.Implementations.Pi.BBP.Series + +-- | Defines the parameters of this specific series. +series :: Math.Implementations.Pi.BBP.Series.Series +series = Math.Implementations.Pi.BBP.Series.MkSeries { + Math.Implementations.Pi.BBP.Series.numerators = zipWith ($) [negate, negate, id, negate, negate, negate, id] $ map (2 ^) [5 :: Integer, 0, 8, 6, 2, 2, 0], + Math.Implementations.Pi.BBP.Series.getDenominators = \i -> let + f, t :: Integer + (f, t) = (4 *) &&& (10 *) $ fromIntegral i + in [f + 1, f + 3, t + 1, t + 3, t + 5, t + 7, t + 9], + Math.Implementations.Pi.BBP.Series.seriesScalingFactor = recip $ 2 ^ (6 :: Int), + Math.Implementations.Pi.BBP.Series.base = negate $ 2 ^ (10 :: Int) +} diff --git a/src-lib/Factory/Math/Implementations/Pi/BBP/Implementation.hs b/src-lib/Factory/Math/Implementations/Pi/BBP/Implementation.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/BBP/Implementation.hs @@ -0,0 +1,57 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Implements a /Bailey-Borwein-Plouffe/ formula; + + * Surprisingly, because of the huge size of the 'Rational' quantities, + it is a /single/ call to @Factory.Math.Summation.sum'@, rather than the calculation of the many terms in the series, which is the performance-bottleneck. +-} + +module Factory.Math.Implementations.Pi.BBP.Implementation( +-- * Functions + openR +) where + +import Data.Ratio((%)) +import qualified Factory.Math.Implementations.Pi.BBP.Series as Math.Implementations.Pi.BBP.Series +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.Summation as Math.Summation + +-- | Returns /Pi/, accurate to the specified number of decimal digits. +openR + :: Math.Implementations.Pi.BBP.Series.Series -- ^ This /Pi/-algorithm is parameterised by the type of other algorithms to use. + -> Math.Precision.DecimalDigits -- ^ The number of decimal digits required. + -> Rational +openR Math.Implementations.Pi.BBP.Series.MkSeries { + Math.Implementations.Pi.BBP.Series.numerators = numerators, + Math.Implementations.Pi.BBP.Series.getDenominators = getDenominators, + Math.Implementations.Pi.BBP.Series.seriesScalingFactor = seriesScalingFactor, + Math.Implementations.Pi.BBP.Series.base = base +} decimalDigits = (seriesScalingFactor *) . Math.Summation.sum' 8 . take ( + Math.Precision.getTermsRequired ( + recip . fromIntegral $ abs {-potentially negative-} base -- The convergence-rate. + ) decimalDigits + ) . zipWith (*) ( + iterate (/ fromIntegral base) 1 -- Generate the scaling-ratio, between successive terms. + ) $ map ( + sum . zipWith (%) numerators . getDenominators + ) [0 ..] + diff --git a/src-lib/Factory/Math/Implementations/Pi/BBP/Series.hs b/src-lib/Factory/Math/Implementations/Pi/BBP/Series.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/BBP/Series.hs @@ -0,0 +1,36 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines a /Bailey-Borwein-Plouffe/ formula; +-} + +module Factory.Math.Implementations.Pi.BBP.Series( +-- * Types +-- ** Data-types + Series(..) +) where + +-- | Defines a series corresponding to a specific /BBP/-formula. +data Series = MkSeries { + numerators :: [Integer], -- ^ The constant numerators from which each term in the series is composed. + getDenominators :: Int -> [Integer], -- ^ Generates the term-dependent denominators from which each term in the series is composed. + seriesScalingFactor :: Rational, -- ^ The ratio by which the sum to infinity of the series, must be scaled to result in /Pi/. + base :: Integer -- ^ The geometric ratio, by which successive terms are scaled. +} + diff --git a/src-lib/Factory/Math/Implementations/Pi/Borwein/Algorithm.hs b/src-lib/Factory/Math/Implementations/Pi/Borwein/Algorithm.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Borwein/Algorithm.hs @@ -0,0 +1,56 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the set of /Borwein/-type algorithms (currently only one) which have been implemented; . +-} + +module Factory.Math.Implementations.Pi.Borwein.Algorithm( +-- * Types +-- ** Data-types + Algorithm(..) +) where + +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Implementations.Pi.Borwein.Borwein1993 as Math.Implementations.Pi.Borwein.Borwein1993 +import qualified Factory.Math.Implementations.Pi.Borwein.Implementation as Math.Implementations.Pi.Borwein.Implementation +import qualified Factory.Math.Pi as Math.Pi +import qualified Factory.Math.SquareRoot as Math.SquareRoot +import qualified ToolShed.Defaultable + +{- | + * Define those /Borwein/-series which have been implemented. + + * Though currently there's only one, provision has been made for the addition of more. +-} +data Algorithm squareRootAlgorithm factorialAlgorithm = + Borwein1993 squareRootAlgorithm factorialAlgorithm -- ^ . + deriving (Eq, Read, Show) + +instance ( + ToolShed.Defaultable.Defaultable squareRootAlgorithm, + ToolShed.Defaultable.Defaultable factorialAlgorithm + ) => ToolShed.Defaultable.Defaultable (Algorithm squareRootAlgorithm factorialAlgorithm) where + defaultValue = Borwein1993 ToolShed.Defaultable.defaultValue ToolShed.Defaultable.defaultValue + +instance ( + Math.SquareRoot.Algorithmic squareRootAlgorithm, + Math.Factorial.Algorithmic factorialAlgorithm + ) => Math.Pi.Algorithmic (Algorithm squareRootAlgorithm factorialAlgorithm) where + openR (Borwein1993 squareRootAlgorithm factorialAlgorithm) = Math.Implementations.Pi.Borwein.Implementation.openR Math.Implementations.Pi.Borwein.Borwein1993.series squareRootAlgorithm factorialAlgorithm + diff --git a/src-lib/Factory/Math/Implementations/Pi/Borwein/Borwein1993.hs b/src-lib/Factory/Math/Implementations/Pi/Borwein/Borwein1993.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Borwein/Borwein1993.hs @@ -0,0 +1,73 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the /Borwein/ series for /Pi/; +-} + +module Factory.Math.Implementations.Pi.Borwein.Borwein1993( +-- * Constants + series +) where + +-- import Control.Arrow((***)) +import Data.Ratio((%)) +-- import Factory.Data.PrimeFactors((>*<), (>/<), (>^)) +-- import qualified Factory.Data.PrimeFactors as Data.PrimeFactors +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial +import qualified Factory.Math.Implementations.Pi.Borwein.Series as Math.Implementations.Pi.Borwein.Series +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.SquareRoot as Math.SquareRoot + +-- | Defines the parameters of the /Borwein/ series. +series :: (Math.SquareRoot.Algorithmic squareRootAlgorithm, Math.Factorial.Algorithmic factorialAlgorithm) => Math.Implementations.Pi.Borwein.Series.Series squareRootAlgorithm factorialAlgorithm +series = Math.Implementations.Pi.Borwein.Series.MkSeries { + Math.Implementations.Pi.Borwein.Series.terms = \squareRootAlgorithm factorialAlgorithm decimalDigits -> let + simplify, squareRoot :: Rational -> Rational + simplify = Math.Precision.simplify $ pred decimalDigits {-ignore single integral digit-} -- This makes a gigantic difference to performance. + squareRoot = simplify . Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits + + sqrt5, a, b, c3 :: Rational + sqrt5 = squareRoot 5 + + a = 63365028312971999585426220 + sqrt5 * (28337702140800842046825600 + 384 * squareRoot (10891728551171178200467436212395209160385656017 + 4870929086578810225077338534541688721351255040 * sqrt5)) + b = 7849910453496627210289749000 + 3510586678260932028965606400 * sqrt5 + 2515968 * squareRoot (3110 * (6260208323789001636993322654444020882161 + 2799650273060444296577206890718825190235 * sqrt5)) + c3 = simplify . Math.Power.cube $ negate 214772995063512240 - sqrt5 * (96049403338648032 + 1296 * squareRoot (10985234579463550323713318473 + 4912746253692362754607395912 * sqrt5)) + in ( + squareRoot $ negate c3, -- The factor into which the series must be divided, to yield Pi. + zipWith ( +{- + \n power -> let + product' = Data.PrimeFactors.product' (recip 2) 10 + in uncurry (/) . ( + (* (a + b * fromIntegral n)) . fromIntegral . product' *** (* power) . fromIntegral . product' + ) $ Math.Implementations.Factorial.primeFactors (6 * n) >/< ( + Math.Implementations.Factorial.primeFactors (3 * n) >*< Math.Implementations.Factorial.primeFactors n >^ 3 + ) +-} + \n power -> ( + Math.Implementations.Factorial.risingFactorial (succ $ 3 * n) (3 * n) % Math.Power.cube (Math.Factorial.factorial factorialAlgorithm n) + ) * ( + (a + b * fromIntegral n) / power + ) + ) [0 :: Integer ..] $ iterate (* c3) 1 + ), + Math.Implementations.Pi.Borwein.Series.convergenceRate = 10 ** negate 50 -- Empirical. +} diff --git a/src-lib/Factory/Math/Implementations/Pi/Borwein/Implementation.hs b/src-lib/Factory/Math/Implementations/Pi/Borwein/Implementation.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Borwein/Implementation.hs @@ -0,0 +1,50 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /Borwein/ series for /Pi/; +-} + +module Factory.Math.Implementations.Pi.Borwein.Implementation( +-- * Functions + openR +) where + +import qualified Control.Arrow +import qualified Control.Parallel.Strategies +import qualified Factory.Math.Implementations.Pi.Borwein.Series as Math.Implementations.Pi.Borwein.Series +import qualified Factory.Math.Precision as Math.Precision + +-- | Returns /Pi/, accurate to the specified number of decimal digits. +openR + :: Math.Implementations.Pi.Borwein.Series.Series squareRootAlgorithm factorialAlgorithm -- ^ This /Pi/-algorithm is parameterised by the type of other algorithms to use. + -> squareRootAlgorithm -- ^ The specific /square-root/ algorithm to apply to the above series. + -> factorialAlgorithm -- ^ The specific /factorial/-algorithm to apply to the above series. + -> Math.Precision.DecimalDigits -- ^ The number of decimal digits required. + -> Rational +openR Math.Implementations.Pi.Borwein.Series.MkSeries { + Math.Implementations.Pi.Borwein.Series.terms = terms, + Math.Implementations.Pi.Borwein.Series.convergenceRate = convergenceRate +} squareRootAlgorithm factorialAlgorithm decimalDigits = uncurry (/) . Control.Parallel.Strategies.withStrategy ( + Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rdeepseq Control.Parallel.Strategies.rdeepseq + ) . Control.Arrow.second ( + sum . take ( + Math.Precision.getTermsRequired convergenceRate decimalDigits + ) + ) $ terms squareRootAlgorithm factorialAlgorithm decimalDigits + diff --git a/src-lib/Factory/Math/Implementations/Pi/Borwein/Series.hs b/src-lib/Factory/Math/Implementations/Pi/Borwein/Series.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Borwein/Series.hs @@ -0,0 +1,43 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines a -type series for /Pi/. +-} + +module Factory.Math.Implementations.Pi.Borwein.Series( +-- * Types +-- ** Data-types + Series(..) +) where + +import qualified Factory.Math.Precision as Math.Precision + +-- | Defines a series corresponding to a specific /Borwein/-formula. +data Series squareRootAlgorithm factorialAlgorithm = MkSeries { + terms + :: squareRootAlgorithm + -> factorialAlgorithm + -> Math.Precision.DecimalDigits + -> ( + Rational, -- The factor into which the sum to infinity of the sequence, must be divided to result in /Pi/ + [Rational] -- The sequence of terms, the sum to infinity of which defines the series. + ), + convergenceRate :: Math.Precision.ConvergenceRate -- ^ The expected number of digits of /Pi/, per term in the series. +} + diff --git a/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Algorithm.hs b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Algorithm.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Algorithm.hs @@ -0,0 +1,55 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the set of /Ramanujan/-type algorithms which have been implemented; . +-} + +module Factory.Math.Implementations.Pi.Ramanujan.Algorithm( +-- * Types +-- ** Data-types + Algorithm(..) +) where + +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Implementations.Pi.Ramanujan.Chudnovsky as Math.Implementations.Pi.Ramanujan.Chudnovsky +import qualified Factory.Math.Implementations.Pi.Ramanujan.Classic as Math.Implementations.Pi.Ramanujan.Classic +import qualified Factory.Math.Implementations.Pi.Ramanujan.Implementation as Math.Implementations.Pi.Ramanujan.Implementation +import qualified Factory.Math.Pi as Math.Pi +import qualified Factory.Math.SquareRoot as Math.SquareRoot +import qualified ToolShed.Defaultable + +-- | Define those /Ramanujan/-series which have been implemented. +data Algorithm squareRootAlgorithm factorialAlgorithm = + Classic squareRootAlgorithm factorialAlgorithm -- ^ The original version. + | Chudnovsky squareRootAlgorithm factorialAlgorithm -- ^ A variant found by the /Chudnovsky brothers/. + deriving (Eq, Read, Show) + +instance ( + ToolShed.Defaultable.Defaultable squareRootAlgorithm, + ToolShed.Defaultable.Defaultable factorialAlgorithm + ) => ToolShed.Defaultable.Defaultable (Algorithm squareRootAlgorithm factorialAlgorithm) where + defaultValue = Chudnovsky ToolShed.Defaultable.defaultValue ToolShed.Defaultable.defaultValue + +instance ( + Math.SquareRoot.Algorithmic squareRootAlgorithm, + Math.Factorial.Algorithmic factorialAlgorithm + ) => Math.Pi.Algorithmic (Algorithm squareRootAlgorithm factorialAlgorithm) where + openR (Classic squareRootAlgorithm factorialAlgorithm) = Math.Implementations.Pi.Ramanujan.Implementation.openR Math.Implementations.Pi.Ramanujan.Classic.series squareRootAlgorithm factorialAlgorithm + openR (Chudnovsky squareRootAlgorithm factorialAlgorithm) = Math.Implementations.Pi.Ramanujan.Implementation.openR Math.Implementations.Pi.Ramanujan.Chudnovsky.series squareRootAlgorithm factorialAlgorithm + diff --git a/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Chudnovsky.hs b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Chudnovsky.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Chudnovsky.hs @@ -0,0 +1,63 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the /Chudnovsky/ series for /Pi/; . +-} + +module Factory.Math.Implementations.Pi.Ramanujan.Chudnovsky( +-- * Constants + series +) where + +-- import Control.Arrow((***)) +import Data.Ratio((%)) +-- import Factory.Data.PrimeFactors((>/<), (>*<), (>^)) +-- import qualified Factory.Data.PrimeFactors as Data.PrimeFactors +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial +import qualified Factory.Math.Implementations.Pi.Ramanujan.Series as Math.Implementations.Pi.Ramanujan.Series +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.SquareRoot as Math.SquareRoot + +-- | Defines the parameters of the /Chudnovsky/ series. +series :: ( + Math.SquareRoot.Algorithmic squareRootAlgorithm, + Math.Factorial.Algorithmic factorialAlgorithm + ) => Math.Implementations.Pi.Ramanujan.Series.Series squareRootAlgorithm factorialAlgorithm +series = Math.Implementations.Pi.Ramanujan.Series.MkSeries { + Math.Implementations.Pi.Ramanujan.Series.terms = \factorialAlgorithm -> zipWith ( +{- + \n power -> let + product' = Data.PrimeFactors.product' (recip 2) 10 + in uncurry (%) . ( + (* (13591409 + 545140134 * n)) . product' *** (* power) . product' + ) $ Math.Implementations.Factorial.primeFactors (6 * n) >/< ( + Math.Implementations.Factorial.primeFactors (3 * n) >*< Math.Implementations.Factorial.primeFactors n >^ 3 + ) +-} + \n power -> ( + Math.Implementations.Factorial.risingFactorial (succ $ 3 * n) (3 * n) % Math.Power.cube (Math.Factorial.factorial factorialAlgorithm n) + ) * ( + (13591409 + 545140134 * n) % power + ) -- CAVEAT: the order in which these terms are evaluated radically affects performance. + ) [0 ..] $ iterate (* (Math.Power.cube $ negate 640320 :: Integer)) 1, + Math.Implementations.Pi.Ramanujan.Series.getSeriesScalingFactor = \squareRootAlgorithm decimalDigits -> 426880 * Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits (10005 :: Integer), + Math.Implementations.Pi.Ramanujan.Series.convergenceRate = 10 ** negate 14.0 -- Empirical. +} + diff --git a/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Classic.hs b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Classic.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Classic.hs @@ -0,0 +1,60 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the /Ramanujan/ series for /Pi/; . +-} + +module Factory.Math.Implementations.Pi.Ramanujan.Classic( +-- * Constants + series +) where + +-- import Control.Arrow((***)) +import Data.Ratio((%)) +-- import Factory.Data.PrimeFactors((>/<), (>^)) +-- import qualified Factory.Data.PrimeFactors as Data.PrimeFactors +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial +import qualified Factory.Math.Implementations.Pi.Ramanujan.Series as Math.Implementations.Pi.Ramanujan.Series +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.SquareRoot as Math.SquareRoot + +-- | Defines the parameters of the /Ramanujan/ series. +series :: (Math.SquareRoot.Algorithmic squareRootAlgorithm, Math.Factorial.Algorithmic factorialAlgorithm) => Math.Implementations.Pi.Ramanujan.Series.Series squareRootAlgorithm factorialAlgorithm +series = Math.Implementations.Pi.Ramanujan.Series.MkSeries { + Math.Implementations.Pi.Ramanujan.Series.terms = \factorialAlgorithm -> let + toFourthPower = (^ (4 :: Int)) + in zipWith ( +{- + \n power -> let + product' = Data.PrimeFactors.product' (recip 2) 10 + in uncurry (%) . ( + (* (1103 + 26390 * n)) . product' *** (* power) . product' + ) $ Math.Implementations.Factorial.primeFactors (4 * n) >/< Math.Implementations.Factorial.primeFactors n >^ 4 +-} + \n power -> ( + Math.Implementations.Factorial.risingFactorial (succ n) (3 * n) % Math.Power.cube (Math.Factorial.factorial factorialAlgorithm n) + ) * ( + (1103 + 26390 * n) % power + ) -- CAVEAT: the order in which these terms are evaluated radically affects performance. + ) [0 ..] $ iterate (* toFourthPower 396) 1, + Math.Implementations.Pi.Ramanujan.Series.getSeriesScalingFactor = \squareRootAlgorithm decimalDigits -> 9801 / Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits (8 :: Integer), + Math.Implementations.Pi.Ramanujan.Series.convergenceRate = 10 ** negate 7.9 -- Empirical. +} + diff --git a/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Implementation.hs b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Implementation.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Implementation.hs @@ -0,0 +1,52 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements a /Ramanujan/-type series for /Pi/; . +-} + +module Factory.Math.Implementations.Pi.Ramanujan.Implementation( +-- * Functions + openR +) where + +import qualified Control.Parallel.Strategies +import qualified Factory.Math.Implementations.Pi.Ramanujan.Series as Math.Implementations.Pi.Ramanujan.Series +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.Summation as Math.Summation + +-- | Returns /Pi/, accurate to the specified number of decimal digits. +openR + :: Math.Implementations.Pi.Ramanujan.Series.Series squareRootAlgorithm factorialAlgorithm -- ^ This /Pi/-algorithm is parameterised by the type of other algorithms to use. + -> squareRootAlgorithm -- ^ The specific /square-root/ algorithm to apply to the above series. + -> factorialAlgorithm -- ^ The specific /factorial/-algorithm to apply to the above series. + -> Math.Precision.DecimalDigits -- ^ The number of decimal digits required. + -> Rational +openR Math.Implementations.Pi.Ramanujan.Series.MkSeries { + Math.Implementations.Pi.Ramanujan.Series.terms = terms, + Math.Implementations.Pi.Ramanujan.Series.getSeriesScalingFactor = getSeriesScalingFactor, + Math.Implementations.Pi.Ramanujan.Series.convergenceRate = convergenceRate +} squareRootAlgorithm factorialAlgorithm decimalDigits = uncurry (/) $ Control.Parallel.Strategies.withStrategy ( + Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rdeepseq Control.Parallel.Strategies.rdeepseq + ) ( + getSeriesScalingFactor squareRootAlgorithm decimalDigits, + Math.Summation.sumR 64 . take ( + Math.Precision.getTermsRequired convergenceRate decimalDigits + ) $ terms factorialAlgorithm + ) -- Pair. + diff --git a/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Series.hs b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Series.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Ramanujan/Series.hs @@ -0,0 +1,37 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines a -type series for /Pi/. +-} + +module Factory.Math.Implementations.Pi.Ramanujan.Series( +-- * Types +-- ** Data-types + Series(..) +) where + +import qualified Factory.Math.Precision as Math.Precision + +-- | Defines a series corresponding to a specific /Ramanujan/-formula. +data Series squareRootAlgorithm factorialAlgorithm = MkSeries { + terms :: factorialAlgorithm -> [Rational], -- ^ The sequence of terms, the sum to infinity of which defines the series. + getSeriesScalingFactor :: squareRootAlgorithm -> Math.Precision.DecimalDigits -> Rational, -- ^ The ratio by which the sum to infinity of the sequence, must be scaled to result in /Pi/. + convergenceRate :: Math.Precision.ConvergenceRate -- ^ The expected number of digits of /Pi/, per term in the series. +} + diff --git a/src-lib/Factory/Math/Implementations/Pi/Spigot/Algorithm.hs b/src-lib/Factory/Math/Implementations/Pi/Spigot/Algorithm.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Spigot/Algorithm.hs @@ -0,0 +1,50 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the set of /Spigot/-algorithms which have been implemented. +-} + +module Factory.Math.Implementations.Pi.Spigot.Algorithm( +-- * Types +-- ** Data-types + Algorithm(..) +) where + +import Data.Ratio((%)) +import qualified Factory.Math.Implementations.Pi.Spigot.Gosper as Math.Implementations.Pi.Spigot.Gosper +import qualified Factory.Math.Implementations.Pi.Spigot.RabinowitzWagon as Math.Implementations.Pi.Spigot.RabinowitzWagon +import qualified Factory.Math.Implementations.Pi.Spigot.Spigot as Math.Implementations.Pi.Spigot.Spigot +import qualified Factory.Math.Pi as Math.Pi +import qualified ToolShed.Defaultable + +-- | Define those /Spigot/-algorithms which have been implemented. +data Algorithm = + Gosper -- ^ A /continued fraction/ discovered by /Gosper/. + | RabinowitzWagon -- ^ A /continued fraction/ discovered by /Rabinowitz/ and /Wagon/. + deriving (Eq, Read, Show) + +instance ToolShed.Defaultable.Defaultable Algorithm where + defaultValue = Gosper + +instance Math.Pi.Algorithmic Algorithm where + openI Gosper = Math.Implementations.Pi.Spigot.Spigot.openI Math.Implementations.Pi.Spigot.Gosper.series + openI RabinowitzWagon = Math.Implementations.Pi.Spigot.Spigot.openI Math.Implementations.Pi.Spigot.RabinowitzWagon.series + + openR algorithm decimalDigits = Math.Pi.openI algorithm decimalDigits % (10 ^ pred decimalDigits) + diff --git a/src-lib/Factory/Math/Implementations/Pi/Spigot/Gosper.hs b/src-lib/Factory/Math/Implementations/Pi/Spigot/Gosper.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Spigot/Gosper.hs @@ -0,0 +1,39 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the /Gosper/ series; +-} + +module Factory.Math.Implementations.Pi.Spigot.Gosper( +-- * Constants + series +) where + +import qualified Factory.Math.Implementations.Pi.Spigot.Series as Math.Implementations.Pi.Spigot.Series +import qualified Factory.Math.Precision as Math.Precision + +-- | Defines a series which converges to /Pi/. +series :: Integral i => Math.Implementations.Pi.Spigot.Series.Series i +series = Math.Implementations.Pi.Spigot.Series.MkSeries { + Math.Implementations.Pi.Spigot.Series.baseNumerators = map (\i -> i * pred (2 * i)) [1 ..], + Math.Implementations.Pi.Spigot.Series.baseDenominators = map ((* 3) . (\i -> succ i * (i + 2))) [3, 6 ..], + Math.Implementations.Pi.Spigot.Series.coefficients = [3, 8 ..], -- 5n - 2 + Math.Implementations.Pi.Spigot.Series.nTerms = Math.Precision.getTermsRequired $ 1 / 13 {-empirical convergence-rate-} +} + diff --git a/src-lib/Factory/Math/Implementations/Pi/Spigot/RabinowitzWagon.hs b/src-lib/Factory/Math/Implementations/Pi/Spigot/RabinowitzWagon.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Spigot/RabinowitzWagon.hs @@ -0,0 +1,40 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the /Rabinowitz-Wagon/ series; + + . +-} + +module Factory.Math.Implementations.Pi.Spigot.RabinowitzWagon( +-- * Constants + series +) where + +import qualified Factory.Math.Implementations.Pi.Spigot.Series as Math.Implementations.Pi.Spigot.Series +import qualified Factory.Math.Precision as Math.Precision + +-- | Defines a series which converges to /Pi/. +series :: Integral i => Math.Implementations.Pi.Spigot.Series.Series i +series = Math.Implementations.Pi.Spigot.Series.MkSeries { + Math.Implementations.Pi.Spigot.Series.baseNumerators = [1 ..], + Math.Implementations.Pi.Spigot.Series.baseDenominators = [3, 5 ..], + Math.Implementations.Pi.Spigot.Series.coefficients = repeat 2, + Math.Implementations.Pi.Spigot.Series.nTerms = Math.Precision.getTermsRequired $ 10 ** negate (3 / 10) {-convergence-rate-} +} diff --git a/src-lib/Factory/Math/Implementations/Pi/Spigot/Series.hs b/src-lib/Factory/Math/Implementations/Pi/Spigot/Series.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Spigot/Series.hs @@ -0,0 +1,53 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the parameters of a series used in a /Spigot/-table to generate /Pi/. +-} + +module Factory.Math.Implementations.Pi.Spigot.Series( +-- * Types +-- ** Data-types + Series(..), +-- * Functions + bases +) where + +import Data.Ratio((%)) +import qualified Data.Ratio +import qualified Factory.Math.Precision as Math.Precision + +{- | + * Defines a series composed from a sum of terms, each one of which is the product of a coefficient and a base. + + * The coefficents and bases of the series are described in /Horner form/; @Pi = c1 + (b1 * (c2 + b2 * (c3 + b3 * (...))))@. +-} +data Series i = MkSeries { + coefficients :: [i], + baseNumerators :: [i], + baseDenominators :: [i], + nTerms :: Math.Precision.DecimalDigits -> Int -- ^ The width of the spigot-table, required to accurately generate the requested number of digits. +} + +-- | Combines 'baseNumerators' and 'baseDenominators', and as a side-effect, expresses the ratio in lowest terms. +bases :: Integral i => Series i -> [Data.Ratio.Ratio i] +bases MkSeries { + baseNumerators = n, + baseDenominators = d +} = zipWith (%) n d + diff --git a/src-lib/Factory/Math/Implementations/Pi/Spigot/Spigot.hs b/src-lib/Factory/Math/Implementations/Pi/Spigot/Spigot.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Pi/Spigot/Spigot.hs @@ -0,0 +1,153 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Implements a /spigot/-algorithm; . + + * Uses the traditional algorithm, rather than the /unbounded/ algorithm described by . +-} + +module Factory.Math.Implementations.Pi.Spigot.Spigot( +-- * Types +-- ** Type-synonyms +-- Base, +-- Coefficients, +-- I, +-- Pi, +-- PreDigits, +-- QuotRem, +-- * Constants + decimal, +-- * Functions +-- carryAndDivide, +-- processColumns, + openI, +-- ** Accessors +-- getQuotient, +-- getRemainder, +-- ** Constructors +-- mkRow +) where + +import qualified Control.Arrow +import qualified Data.Char +import qualified Data.Ratio +import qualified Factory.Math.Implementations.Pi.Spigot.Series as Math.Implementations.Pi.Spigot.Series +import qualified Factory.Math.Precision as Math.Precision + +{- | + * The type in which all arithmetic is performed. + + * A small dynamic range, 32 bits or more, is typically adequate. +-} +type I = Int + +-- | The constant base in which we want the resulting value of /Pi/ to be expressed. +decimal :: I +decimal = 10 + +-- | Coerce the polymorphic type 'Data.Ratio.Ratio' to suit the base used in our series. +type Base = Data.Ratio.Ratio I + +-- | Coerce the polymorphic type returned by 'quotRem' to our specific requirements. +type QuotRem = (I, I) + +-- Accessors. +getQuotient, getRemainder :: QuotRem -> I +getQuotient = fst +getRemainder = snd + +type PreDigits = [I] +type Pi = [I] +type Coefficients = [I] + +{- | + * For a digit on one row of the spigot-table, add any numerator carried from the similar calculation one column to the right. + + * Divide the result of this summation, by the denominator of the base, to get the quotient and remainder. + + * Determine the quantity to carry to the similar calculation one column to the left, by multiplying the quotient by the numerator of the base. +-} +carryAndDivide :: (Base, I) -> QuotRem -> QuotRem +carryAndDivide (base, lhs) rhs + | n < d = (0, n) -- In some degenerate cases, the result of the subsequent calculation can be more simply determined. + | otherwise = Control.Arrow.first (* Data.Ratio.numerator base) $ n `quotRem` d + where + d, n :: I + d = Data.Ratio.denominator base + n = lhs + getQuotient rhs -- Carry numerator from the column to the right and add it to the current digit. + +{- | + * Fold 'carryAndDivide', from right to left, over the columns of a row in the spigot-table, continuously checking for overflow. + + * Release any previously withheld result-digits, after any adjustment for overflow in the current result-digit. + + * Withhold the current result-digit until the risk of overflow in subsequent result-digits has been assessed. + + * Call 'mkRow'. +-} +processColumns + :: Math.Implementations.Pi.Spigot.Series.Series I + -> PreDigits + -> [(Base, I)] -- ^ Data-row. + -> Pi +processColumns series preDigits l + | overflowMargin > 1 = preDigits ++ nextRow [digit] -- There's neither overflow, nor risk of impact from subsequent overflow. + | overflowMargin == 1 = nextRow $ preDigits ++ [digit] -- There's no overflow, but risk of impact from subsequent overflow. + | otherwise = map ((`rem` decimal) . succ) preDigits ++ nextRow [0] -- Overflow => propagate the excess to previously withheld preDigits. + where + results :: [QuotRem] + results = init $ scanr carryAndDivide (0, undefined) l + + digit :: I + digit = getQuotient $ head results + + overflowMargin :: I + overflowMargin = decimal - digit + + nextRow :: [I] -> [I] + nextRow preDigits' = mkRow series preDigits' $ map getRemainder results + +{- | + * Multiply the remainders from the previous row. + + * Zip them with the constant bases, with an addition one stuck on the front to perform the conversion to decimal, to create a new row of the spigot-table. + + * Call 'processColumns'. +-} +mkRow :: Math.Implementations.Pi.Spigot.Series.Series I -> PreDigits -> Coefficients -> Pi +mkRow series preDigits = processColumns series preDigits . zip (recip (fromIntegral decimal) : Math.Implementations.Pi.Spigot.Series.bases series) . map (* decimal) + +{- | + * Initialises a /spigot/-table with the row of 'Math.Implementations.Pi.Spigot.Series.coefficients'. + + * Ensures that the row has suffient terms to accurately generate the required number of digits. + + * Extracts only those digits which are guaranteed to be accurate. + + * CAVEAT: the result is returned as an 'Integer', i.e. without any decimal point. +-} +openI :: Math.Implementations.Pi.Spigot.Series.Series I -> Math.Precision.DecimalDigits -> Integer +openI series decimalDigits = read . map ( + Data.Char.intToDigit . fromIntegral + ) . take decimalDigits . mkRow series [] . take ( + Math.Implementations.Pi.Spigot.Series.nTerms series decimalDigits + ) $ Math.Implementations.Pi.Spigot.Series.coefficients series + diff --git a/src-lib/Factory/Math/Implementations/Primality.hs b/src-lib/Factory/Math/Implementations/Primality.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Primality.hs @@ -0,0 +1,217 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Determines whether an integer is prime. + + * . + + * + + * CAVEAT: it doesn't determine the prime-factors of composite numbers, just that they exist. +-} + +module Factory.Math.Implementations.Primality( +-- * Types +-- ** Data-types + Algorithm(..) +-- * Functions +-- ** Predicates +-- isPrimeByAKS, +-- isPrimeByMillerRabin, +-- witnessesCompositeness +) where + +import Control.Arrow((&&&)) +import qualified Control.DeepSeq +import qualified Control.Parallel.Strategies +import qualified Data.Numbers.Primes +import qualified Factory.Data.MonicPolynomial as Data.MonicPolynomial +import qualified Factory.Data.Polynomial as Data.Polynomial +import qualified Factory.Data.QuotientRing as Data.QuotientRing +import qualified Factory.Math.MultiplicativeOrder as Math.MultiplicativeOrder +import qualified Factory.Math.PerfectPower as Math.PerfectPower +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.Primality as Math.Primality +import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation +import qualified ToolShed.Defaultable + +-- | The algorithms by which /primality/-testing has been implemented. +data Algorithm factorisationAlgorithm = + AKS factorisationAlgorithm -- ^ . + | MillerRabin -- ^ . + deriving (Eq, Read, Show) + +instance ToolShed.Defaultable.Defaultable (Algorithm factorisationAlgorithm) where + defaultValue = MillerRabin + +instance Math.PrimeFactorisation.Algorithmic factorisationAlgorithm => Math.Primality.Algorithmic (Algorithm factorisationAlgorithm) where + isPrime _ 2 = True -- The only even prime. + isPrime algorithm candidate + | candidate < 2 || ( + any ( + (== 0) . (candidate `rem`) -- The candidate has a small prime-factor, and is therefore composite. + ) . filter ( + (candidate >=) . (* 2) -- The candidate must be at least double the small prime, for it to be a potential factor. + ) . take 5 {-arbitrarily-} $ Data.Numbers.Primes.primes -- Excludes even numbers, provided at least the 1st prime is tested. + ) = False + | otherwise = ( + case algorithm of + AKS factorisationAlgorithm -> isPrimeByAKS factorisationAlgorithm + MillerRabin -> isPrimeByMillerRabin + ) candidate + +{- | + * An implementation of the /Agrawal-Kayal-Saxena/ primality-test; , + using the /Lenstra/ and /Pomerance/ algorithm. + + * CAVEAT: this deterministic algorithm has a theoretical time-complexity of @O(log^6)@, + and therefore can't compete with the performance of probabilistic ones. + + * The /formal polynomials/ used in this algorithm, are conceptually different from /polynomial functions/; + the /indeterminate/ and its powers, are merely used to name a sequence of pigeon-holes in which /coefficients/ are stored, + and is never substituted for a specific value. + This mind-shift, allows one to introduce concepts like /modular/ arithmetic on polynomials, + which merely represent an operation on their coefficients and the pigeon-hole in which they're placed. + + [@Manindra Agrawal, Neeraj Kayal and Nitin Saxena@] . + + [@H. W. Lenstra, Jr. and Carl Pomerance@] . + + [@Salembier and Southerington@] , + + [@R. Crandall and J. Papadopoulos@] , + + [@Andreas Klappenecker@] , + + [@Vibhor Bhatt and G. K. Patra@] , +-} +isPrimeByAKS :: ( + Control.DeepSeq.NFData i, + Integral i, + Math.PrimeFactorisation.Algorithmic factorisationAlgorithm, + Show i + ) => factorisationAlgorithm -> i -> Bool +isPrimeByAKS factorisationAlgorithm n = and [ + not $ Math.PerfectPower.isPerfectPower n, -- Step 1. + Math.Primality.areCoprime n `all` filter (/= n) [2 .. r], -- Step 3. + and $ Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq {-Benefits from '+RTS -H100M', which reduces garbage-collections-} ( + \a -> let +-- lhs, rhs :: Data.Polynomial.Polynomial i i + lhs = Data.Polynomial.raiseModulo (Data.Polynomial.mkLinear 1 a) n {-power-} n {-modulus-} + rhs = Data.Polynomial.mod' (Data.Polynomial.mkPolynomial [(1, n), (a, 0)]) n + in Data.QuotientRing.areCongruentModulo ( + Data.MonicPolynomial.mkMonicPolynomial lhs + ) ( + Data.MonicPolynomial.mkMonicPolynomial rhs + ) ( + Data.MonicPolynomial.mkMonicPolynomial modulus + ) -- Because all these polynomials are /monic/, one can establish /congruence/ using /integer/-division. + ) [ + 1 .. floor . (* lg) . sqrt $ fromIntegral r + ] -- Step 4; (x + a)^n ~ x^n + a mod (x^r - 1, n). + ] where + lg :: Double + lg = logBase 2 $ fromIntegral n + +-- r :: i + r = fst . head . dropWhile ( + (<= floor (Math.Power.square lg)) . snd + ) . map ( + id &&& Math.MultiplicativeOrder.multiplicativeOrder factorisationAlgorithm n + ) $ Math.Primality.areCoprime n `filter` [2 ..] -- Step 2. + +-- modulus :: Data.Polynomial.Polynomial i i + modulus = Data.Polynomial.mkPolynomial [(1, r), (negate 1, 0)] + +{- | + * Uses the specified 'base' in an attempt to prove the /compositeness/ of an integer. + + * This is the opposite of the /Miller Test/; . + + * If the result is 'True', then the candidate is /composite/; regrettably the converse isn't true. + Amongst the set of possible bases, over three-quarters are /witnesses/ to the compositeness of a /composite/ candidate, + the remainder belong to the subset of /liars/. + In consequence, many false results must be accumulated for different bases, to convincingly identify a prime. +-} +witnessesCompositeness :: (Integral i, Show i) + => i -- ^ Candidate integer. + -> i + -> Int + -> i -- ^ Base. + -> Bool +witnessesCompositeness candidate oddRemainder nPowersOfTwo base = all ( + $ ((`rem` candidate) . Math.Power.square) `iterate` Math.Power.raiseModulo base oddRemainder candidate -- Repeatedly modulo-square. + ) [ + (/= 1) . head, -- Check whether the zeroeth modulo-power is incongruent to one. + notElem (pred candidate) . take nPowersOfTwo -- Check whether any modulo-power is incongruent to -1. + ] + +{- | + * Repeatedly calls 'witnessesCompositeness', to progressively increase the probability of detecting a /composite/ number, + until ultimately the candidate integer is proven to be prime. + + * Should all bases be tested, then the test is deterministic, but at an efficiency /lower/ than performing prime-factorisation. + + * The test becomes deterministic, for any candidate integer, when the number of tests reaches the limit defined by /Eric Bach/. + + * A testing of smaller set of bases, is sufficient for candidates smaller than various thresholds; . + + * . + + * + + * . + + * , . +-} +isPrimeByMillerRabin :: (Integral i, Show i) => i -> Bool +isPrimeByMillerRabin primeCandidate = not $ witnessesCompositeness primeCandidate ( + fst $ last binaryFactors -- Odd-remainder. + ) ( + length binaryFactors -- The number of times that 'two' can be factored-out from 'predecessor'. + ) `any` testBases where + predecessor = pred primeCandidate + binaryFactors = takeWhile ((== 0) . snd) . tail {-drop the original-} $ iterate ((`quotRem` 2) . fst) (predecessor, 0) -- Factor-out powers of two. + testBases + | null fewestPrimeBases = let + millersTestSet = floor . (* 2 {-Eric Bach-}) . Math.Power.square . toRational {-avoid premature rounding-} $ log (fromIntegral primeCandidate :: Double {-overflows at 10^851-}) + in [2 .. predecessor `min` millersTestSet] + | otherwise = head fewestPrimeBases `take` Data.Numbers.Primes.primes + where + fewestPrimeBases = map fst $ dropWhile ((primeCandidate >=) . snd) [ + (0, 9), -- All odd integers less this, are prime, and require no further verification. + (1, 2047), + (2, 1373653), + (3, 25326001), + (4, 3215031751), + (5, 2152302898747), -- Jaeschke ... + (6, 3474749660383), + (8, 341550071728321), + (11, 3825123056546413051), -- Zhang ... + (12, 318665857834031151167461), + (13, 3317044064679887385961981), + (14, 6003094289670105800312596501), + (15, 59276361075595573263446330101), + (17, 564132928021909221014087501701), + (19, 1543267864443420616877677640751301), + (20, 10 ^ (36 :: Int)) -- At least. + ] + diff --git a/src-lib/Factory/Math/Implementations/PrimeFactorisation.hs b/src-lib/Factory/Math/Implementations/PrimeFactorisation.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/PrimeFactorisation.hs @@ -0,0 +1,145 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Implements several different prime-factorisation algorithms. + + * . +-} + +module Factory.Math.Implementations.PrimeFactorisation( +-- * Types +-- ** Data-types + Algorithm( +-- DixonsMethod, + FermatsMethod, + TrialDivision + ) +-- * Functions +-- factoriseByDixonsMethod +-- factoriseByFermatsMethod +-- factoriseByTrialDivision +) where + +import Control.Arrow((&&&)) +import qualified Control.Arrow +import qualified Control.DeepSeq +import qualified Control.Parallel.Strategies +import qualified Data.Maybe +import qualified Data.Numbers.Primes +import qualified Factory.Data.Exponential as Data.Exponential +import Factory.Data.Exponential((<^)) +import qualified Factory.Data.PrimeFactors as Data.PrimeFactors +import qualified Factory.Math.PerfectPower as Math.PerfectPower +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation +import qualified ToolShed.Data.Pair +import qualified ToolShed.Defaultable + +-- | The algorithms by which prime-factorisation has been implemented. +data Algorithm + = DixonsMethod -- ^ . + | FermatsMethod -- ^ . + | TrialDivision -- ^ . + deriving (Eq, Read, Show) + +instance ToolShed.Defaultable.Defaultable Algorithm where + defaultValue = TrialDivision + +instance Math.PrimeFactorisation.Algorithmic Algorithm where + primeFactors algorithm = case algorithm of + DixonsMethod -> factoriseByDixonsMethod + FermatsMethod -> Data.PrimeFactors.reduce . factoriseByFermatsMethod + TrialDivision -> factoriseByTrialDivision + +-- | . +factoriseByDixonsMethod :: Integral base => base -> Data.PrimeFactors.Factors base exponent +factoriseByDixonsMethod = undefined + +{- | + * . + + * . + + * . + + * @i = f1 * f2@ Assume a non-trivial factorisation, ie. one in which both factors exceed one. + => @i = (larger + smaller) * (larger - smaller)@ Represent the co-factors as a sum and difference. + => @i = larger^2 - smaller^2@ Which has an integral solution if @i@ is neither /even/ nor a /perfect square/. + => @sqrt (larger^2 - i) = smaller@ Search for /larger/, which results in an integral value for /smaller/. + + * Given that the smaller factor /f2/, can't be less than 3 (/i/ isn't /even/), then the larger /f1/, can't be greater than @(i `div` 3)@. + So: @(f2 >= 3) && (f1 <= i `div` 3)@ Two equations which can be used to solve for /larger/. + => @(larger - smaller >= 3) && (larger + smaller <= i `div` 3)@ Add these to eliminate /smaller/. + => @larger <= (i + 9) `div` 6@ The upper bound of the search-space. + + * This algorithm works best when there's a factor close to the /square-root/. +-} +factoriseByFermatsMethod :: ( + Control.DeepSeq.NFData base, + Control.DeepSeq.NFData exponent, + Integral base, + Num exponent + ) => base -> Data.PrimeFactors.Factors base exponent +factoriseByFermatsMethod i + | i <= 3 = [Data.Exponential.rightIdentity i] + | even i = Data.Exponential.rightIdentity 2 : factoriseByFermatsMethod (i `div` 2) {-recurse-} + | Data.Maybe.isJust maybeSquareNumber = (<^ 2) `map` factoriseByFermatsMethod (Data.Maybe.fromJust maybeSquareNumber) {-recurse-} + | null factors = [Data.Exponential.rightIdentity i] -- Prime. + | otherwise = uncurry (++) . Control.Parallel.Strategies.withStrategy ( + Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rdeepseq Control.Parallel.Strategies.rdeepseq -- CAVEAT: unproductive on the size of integers tested so far. + ) . ToolShed.Data.Pair.mirror factoriseByFermatsMethod $ head factors + where +-- maybeSquareNumber :: Integral i => Maybe i + maybeSquareNumber = Math.PerfectPower.maybeSquareNumber i + +-- factors :: Integral i => [i] + factors = map ( + ( + uncurry (+) &&& uncurry (-) -- Construct the co-factors as the sum and difference of /larger/ and /smaller/. + ) . Control.Arrow.second Data.Maybe.fromJust + ) . filter ( + Data.Maybe.isJust . snd -- Search for a perfect square. + ) . map ( + Control.Arrow.second $ Math.PerfectPower.maybeSquareNumber {-hotspot-} . (+ negate i) -- Associate the corresponding value of /smaller/. + ) . takeWhile ( + (<= (i + 9) `div` 6) . fst -- Terminate the search at the maximum value of /larger/. + ) . Math.Power.squaresFrom {-hotspot-} . ceiling $ sqrt (fromIntegral i :: Double) -- Start the search at the minimum value of /larger/. + +{- | + * Decomposes the specified integer, into a product of /prime/-factors, + using , AKA . + + * This works best when the factors are small. +-} +factoriseByTrialDivision :: (Integral base, Num exponent) => base -> Data.PrimeFactors.Factors base exponent +factoriseByTrialDivision = slave Data.Numbers.Primes.primes where + slave primes i + | null primeCandidates = [Data.Exponential.rightIdentity i] + | otherwise = Data.Exponential.rightIdentity lowestPrimeFactor `Data.PrimeFactors.insert'` slave primeCandidates (i `quot` lowestPrimeFactor) + where + primeCandidates = dropWhile ( + (/= 0) . (i `rem`) + ) $ takeWhile ( + <= Math.PrimeFactorisation.maxBoundPrimeFactor i + ) primes + + lowestPrimeFactor = head primeCandidates + diff --git a/src-lib/Factory/Math/Implementations/Primes/Algorithm.hs b/src-lib/Factory/Math/Implementations/Primes/Algorithm.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Primes/Algorithm.hs @@ -0,0 +1,63 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Generates the constant list of /prime-numbers/, by a variety of different algorithms. + + * . + + * . + + * . +-} + +module Factory.Math.Implementations.Primes.Algorithm( +-- * Types +-- ** Data-types + Algorithm(..) +) where + +import qualified Data.Numbers.Primes +import qualified Factory.Data.PrimeWheel as Data.PrimeWheel +import qualified Factory.Math.Implementations.Primes.SieveOfAtkin as Math.Implementations.Primes.SieveOfAtkin +import qualified Factory.Math.Implementations.Primes.SieveOfEratosthenes as Math.Implementations.Primes.SieveOfEratosthenes +import qualified Factory.Math.Implementations.Primes.TrialDivision as Math.Implementations.Primes.TrialDivision +import qualified Factory.Math.Implementations.Primes.TurnersSieve as Math.Implementations.Primes.TurnersSieve +import qualified Factory.Math.Primes as Math.Primes +import qualified ToolShed.Defaultable + +-- | The implemented methods by which the primes may be generated. +data Algorithm + = SieveOfAtkin Integer -- ^ The /Sieve of Atkin/, optimised using a 'Data.PrimeWheel.PrimeWheel' of optimal size, for primes up to the specified maximum bound; . + | SieveOfEratosthenes Data.PrimeWheel.NPrimes -- ^ The /Sieve of Eratosthenes/ (), optimised using a 'Data.PrimeWheel.PrimeWheel'. + | TrialDivision Data.PrimeWheel.NPrimes -- ^ For each candidate, confirm indivisibility, by all /primes/ smaller than its /square-root/, optimised using a 'Data.PrimeWheel.PrimeWheel'. + | TurnersSieve -- ^ For each /prime/, the infinite list of candidates greater than its /square/, is filtered for indivisibility; . + | WheelSieve Int -- ^ 'Data.Numbers.Primes.wheelSieve'. + deriving (Eq, Read, Show) + +instance ToolShed.Defaultable.Defaultable Algorithm where + defaultValue = SieveOfEratosthenes 7 -- Resulting in a wheel of circumference 510510. + +instance Math.Primes.Algorithmic Algorithm where + primes (SieveOfAtkin maxPrime) = Math.Implementations.Primes.SieveOfAtkin.sieveOfAtkin (Data.PrimeWheel.estimateOptimalSize maxPrime) $ fromIntegral maxPrime + primes (SieveOfEratosthenes wheelSize) = Math.Implementations.Primes.SieveOfEratosthenes.sieveOfEratosthenes wheelSize + primes (TrialDivision wheelSize) = Math.Implementations.Primes.TrialDivision.trialDivision wheelSize + primes TurnersSieve = Math.Implementations.Primes.TurnersSieve.turnersSieve + primes (WheelSieve wheelSize) = Data.Numbers.Primes.wheelSieve wheelSize -- Has better space-complexity than 'SieveOfEratosthenes'. diff --git a/src-lib/Factory/Math/Implementations/Primes/SieveOfAtkin.hs b/src-lib/Factory/Math/Implementations/Primes/SieveOfAtkin.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Primes/SieveOfAtkin.hs @@ -0,0 +1,242 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Generates the constant /bounded/ list of /prime-numbers/, using the /Sieve of Atkin/; . + + * . + + * The implementation; + has been optimised using a /wheel/ of static, but parameterised, size; + has been parallelized; + is polymorphic, but with a specialisation for type 'Int'. + + [@CAVEAT@] The 'Int'-specialisation is implemented by a /rewrite-rule/, which is /very/ fragile. +-} + +module Factory.Math.Implementations.Primes.SieveOfAtkin( +-- * Types +-- ** Data-types +-- PolynomialType, +-- * Constants +-- atkinsModulus, +-- inherentPrimes, +-- nInherentPrimes, +-- squares, +-- * Functions +-- polynomialTypeLookupPeriod, +-- polynomialTypeLookup, +-- findPolynomialSolutions, +-- filterOddRepetitions, +-- generateMultiplesOfSquareTo, +-- getPrefactoredPrimes, + sieveOfAtkin, +-- sieveOfAtkinInt +) where + +import qualified Control.DeepSeq +import qualified Control.Parallel.Strategies +import qualified Data.Array.IArray +import Data.Array.IArray((!)) +import qualified Data.IntSet +import qualified Data.List +import qualified Data.Set +import qualified Factory.Data.PrimeWheel as Data.PrimeWheel +import qualified Factory.Math.Power as Math.Power +import qualified ToolShed.Data.List + +-- | Defines the types of /quadratic/, available to test the potential primality of a candidate integer. +data PolynomialType + = ModFour -- ^ Suitable for primality-testing numbers meeting @(n `mod` 4 == 1)@. + | ModSix -- ^ Suitable for primality-testing numbers meeting @(n `mod` 6 == 1)@. + | ModTwelve -- ^ Suitable for primality-testing numbers meeting @(n `mod` 12 == 11)@. + | None -- ^ There's no polynomial which can assess primality, because the candidate is composite. + deriving Eq + +-- | The constant modulus used to select the appropriate quadratic for a prime candidate. +atkinsModulus :: Integral i => i +atkinsModulus = foldr1 lcm [4, 6, 12] -- Sure, this is always '12', but this is the reason why. + +-- | The constant list of primes factored-out by the unoptimised algorithm. +inherentPrimes :: Integral i => [i] +inherentPrimes = [2, 3] + +-- | The constant number of primes factored-out by the unoptimised algorithm. +nInherentPrimes :: Int +nInherentPrimes = length (inherentPrimes :: [Int]) + +-- | Typically the set of primes which have been built into the specified /wheel/, but never fewer than 'inherentPrimes'. +getPrefactoredPrimes :: Integral i => Data.PrimeWheel.PrimeWheel i -> [i] +getPrefactoredPrimes = max inherentPrimes . Data.PrimeWheel.getPrimeComponents + +-- | The period over which the data returned by 'polynomialTypeLookup' repeats. +polynomialTypeLookupPeriod :: Integral i => Data.PrimeWheel.PrimeWheel i -> i +polynomialTypeLookupPeriod = lcm atkinsModulus . Data.PrimeWheel.getCircumference + +{- | + * Defines which, if any, of the three /quadratics/ is appropriate for the primality-test for each candidate. + + * Since this algorithm uses /modular arithmetic/, the /range/ of results repeat after a short /domain/ related to the /modulus/. + Thus one need calculate at most one period of this cycle, but fewer if the maximum prime required falls within the first cycle of results. + + * Because the results are /bounded/, they're returned in a zero-indexed /array/, to provide efficient random access; + the first few elements should never be required, but it makes query clearer. + + * . +-} +polynomialTypeLookup :: (Data.Array.IArray.Ix i, Integral i) + => Data.PrimeWheel.PrimeWheel i + -> i -- ^ The maximum prime required. + -> Data.Array.IArray.Array i PolynomialType +polynomialTypeLookup primeWheel maxPrime = Data.Array.IArray.listArray (0, pred (polynomialTypeLookupPeriod primeWheel) `min` maxPrime) $ map select [0 ..] where +-- select :: Integral i => i -> PolynomialType + select n + | any ( + (== 0) . (n `rem`) -- Though this is merely /Trial Division/, it's only performed over a short bounded interval of numerators. + ) primeComponents = None + | r `elem` [1, 5] = ModFour -- We actually require @(n `mod` 4 == 1)@, but this is the equivalent modulo 12, with @(r == 9)@ removed because they're all divisible by /3/. + | r == 7 = ModSix -- We actually require @(n `mod` 6 == 1)@, but this is the equivalent modulo 12, where @(r == 1)@ has been accounted for above. + | r == 11 = ModTwelve -- We require @(n `mod` 12 == 11)@. + | otherwise = None + where + r = n `rem` atkinsModulus + primeComponents = drop nInherentPrimes $ Data.PrimeWheel.getPrimeComponents primeWheel + +-- | The constant, infinite list of the /squares/, of integers increasing from /1/. +squares :: Integral i => [i] +squares = map snd $ Math.Power.squaresFrom 1 + +{- | + * Returns the /ordered/ list of those values with an /odd/ number of occurrences in the specified /unordered/ list. + + * CAVEAT: this is expensive in both execution-time and space. + The typical imperative-style implementation accumulates polynomial-solutions in a /mutable array/ indexed by the candidate integer. + This doesn't translate seamlessly to the /pure functional/ domain where /arrays/ naturally immutable, + so we /sort/ a /list/ of polynomial-solutions, then measure the length of the solution-spans, corresponding to viable candidates. + Regrettably, 'Data.List.sort' (implemented in /GHC/ by /mergesort/) has a time-complexity /O(n*log n)/ + which is greater than the theoretical /O(n)/ of the whole /Sieve of Atkin/; + /GHC/'s old /qsort/-implementation is even slower :( +-} +filterOddRepetitions :: Ord a => [a] -> [a] +-- filterOddRepetitions = map head . filter (foldr (const not) False) . Data.List.group . Data.List.sort -- Too slow. +filterOddRepetitions = slave True . Data.List.sort where + slave isOdd (one : remainder@(two : _)) + | one == two = slave (not isOdd) remainder + | isOdd = one : beginSpan + | otherwise = beginSpan + where + beginSpan = slave True remainder + slave True [singleton] = [singleton] + slave _ _ = [] + +{- | + * Returns the ordered list of solutions aggregated from each of three /bivariate quadratics/; @z = f(x, y)@. + + * For a candidate integer to be prime, it is necessary but insufficient, that there are an /odd/ number of solutions of value /candidate/. + + * At most one of these three polynomials is suitable for the validation of any specific candidate /z/, depending on 'lookupPolynomialType'. + so the three sets of solutions are mutually exclusive. + One coordinate @(x, y)@, can have solutions in more than one of the three polynomials. + + * This algorithm exhaustively traverses the domain @(x, y)@, for resulting /z/ of the required modulus. + Whilst it tightly constrains the bounds of the search-space, it searches the domain methodically rather than intelligently. +-} +findPolynomialSolutions :: (Control.DeepSeq.NFData i, Data.Array.IArray.Ix i, Integral i) + => Data.PrimeWheel.PrimeWheel i + -> i -- ^ The maximum prime-number required. + -> [i] +findPolynomialSolutions primeWheel maxPrime = foldr1 ToolShed.Data.List.merge {-The lists were previously sorted, as a side-effect, by 'filterOddRepetitions'-} $ Control.Parallel.Strategies.withStrategy ( + Control.Parallel.Strategies.parList Control.Parallel.Strategies.rdeepseq + ) [ + {-# SCC "4x^2+y^2" #-} filterOddRepetitions [ + z | + x' <- takeWhile (<= pred maxPrime) $ map (* 4) squares, + z <- takeWhile (<= maxPrime) $ map (+ x') oddSquares, + lookupPolynomialType z == ModFour + ], -- List-comprehension. Twice the length of the other two lists. + {-# SCC "3x^2+y^2" #-} filterOddRepetitions [ + z | + x' <- takeWhile (<= pred maxPrime) $ map (* 3) squares, + z <- takeWhile (<= maxPrime) . map (+ x') $ if even x' then oddSelection else evenSelection, + lookupPolynomialType z == ModSix + ], -- List-comprehension. + {-# SCC "3x^2-y^2" #-} filterOddRepetitions [ + z | + x2 <- takeWhile (<= maxPrime `div` 2) squares, + z <- dropWhile (> maxPrime) . map (3 * x2 -) . takeWhile (< x2) $ if even x2 then oddSelection else evenSelection, + lookupPolynomialType z == ModTwelve + ] -- List-comprehension. + ] where + (evenSquares, oddSquares) = Data.List.partition even squares + +-- evenSelection, oddSelection :: Integral i => [i] + evenSelection = selection110 evenSquares where + selection110 (x0 : x1 : _ : xs) = x0 : x1 : selection110 xs -- Effectively, those for meeting ((== 4) . (`mod` 6)). + selection110 xs = xs + oddSelection = selection101 oddSquares where + selection101 (x0 : _ : x2 : xs) = x0 : x2 : selection101 xs -- Effectively, those for meeting ((== 1) . (`mod` 6)). + selection101 xs = xs + +-- lookupPolynomialType :: (Data.Array.IArray.Ix i, Integral i) => i -> PolynomialType + lookupPolynomialType = (polynomialTypeLookup primeWheel maxPrime !) . (`rem` polynomialTypeLookupPeriod primeWheel) + +-- | Generates the /bounded/ list of multiples, of the /square/ of the specified prime, skipping those which aren't required. +generateMultiplesOfSquareTo :: Integral i + => Data.PrimeWheel.PrimeWheel i -- ^ Used to generate the gaps between prime multiples of the square. + -> i -- ^ The /prime/. + -> i -- ^ The maximum bound. + -> [i] +generateMultiplesOfSquareTo primeWheel prime max' = takeWhile (<= max') . scanl (\accumulator -> (+ accumulator) . (* prime2)) prime2 . cycle $ Data.PrimeWheel.getSpokeGaps primeWheel where + prime2 = Math.Power.square prime + +{- | + * Generates the constant /bounded/ list of /prime-numbers/. + + * +-} +sieveOfAtkin :: (Control.DeepSeq.NFData i, Data.Array.IArray.Ix i, Integral i) + => Data.PrimeWheel.NPrimes -- ^ Other implementations effectively use a hard-coded value either /2/ or /3/, but /6/ seems better. + -> i -- ^ The maximum prime required. + -> [i] -- ^ The /bounded/ list of primes. +sieveOfAtkin wheelSize maxPrime = (prefactoredPrimes ++) . filterSquareFree Data.Set.empty . dropWhile (<= maximum prefactoredPrimes) $ findPolynomialSolutions primeWheel maxPrime where + primeWheel = Data.PrimeWheel.mkPrimeWheel wheelSize + prefactoredPrimes = getPrefactoredPrimes primeWheel + +-- filterSquareFree :: Integral i => Data.Set.Set i -> [i] -> [i] + filterSquareFree _ [] = [] + filterSquareFree primeMultiples (candidate : candidates) + | Data.Set.member candidate primeMultiples = {-# SCC "delete" #-} filterSquareFree (Data.Set.delete candidate primeMultiples) candidates -- Tail-recurse. + | otherwise = {-# SCC "insert" #-} candidate : filterSquareFree (Data.Set.union primeMultiples . Data.Set.fromDistinctAscList $ generateMultiplesOfSquareTo primeWheel candidate maxPrime) candidates + +{-# NOINLINE sieveOfAtkin #-} +{-# RULES "sieveOfAtkin/Int" sieveOfAtkin = sieveOfAtkinInt #-} -- CAVEAT: doesn't fire when built with profiling enabled. + +-- | A specialisation of 'sieveOfAtkin', which reduces both the execution-time and the space required. +sieveOfAtkinInt :: Data.PrimeWheel.NPrimes -> Int -> [Int] +sieveOfAtkinInt wheelSize maxPrime = (prefactoredPrimes ++) . filterSquareFree Data.IntSet.empty . dropWhile (<= maximum prefactoredPrimes) $ findPolynomialSolutions primeWheel maxPrime where + primeWheel = Data.PrimeWheel.mkPrimeWheel wheelSize + prefactoredPrimes = getPrefactoredPrimes primeWheel + + filterSquareFree :: Data.IntSet.IntSet -> [Int] -> [Int] + filterSquareFree _ [] = [] + filterSquareFree primeMultiples (candidate : candidates) + | Data.IntSet.member candidate primeMultiples = filterSquareFree (Data.IntSet.delete candidate primeMultiples) candidates + | otherwise = candidate : filterSquareFree (Data.IntSet.union primeMultiples . Data.IntSet.fromDistinctAscList $ generateMultiplesOfSquareTo primeWheel candidate maxPrime) candidates + diff --git a/src-lib/Factory/Math/Implementations/Primes/SieveOfEratosthenes.hs b/src-lib/Factory/Math/Implementations/Primes/SieveOfEratosthenes.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Primes/SieveOfEratosthenes.hs @@ -0,0 +1,162 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Generates the constant, conceptually infinite, list of /prime-numbers/, using the /Sieve of Eratosthenes/; . + + * Based on . + + * The implementation; + has been optimised using a /wheel/ of static, but parameterised, size; + is polymorphic, but with a specialisation for type 'Int'. + + [@CAVEAT@] The 'Int'-specialisation is implemented by a /rewrite-rule/, which is /very/ fragile. +-} + +module Factory.Math.Implementations.Primes.SieveOfEratosthenes( +-- * Types +-- ** Type-synonyms +-- PrimeMultiplesQueue, +-- PrimeMultiplesMap, +-- Repository, +-- PrimeMultiplesMapInt, +-- RepositoryInt, +-- * Functions +-- head', +-- tail', + sieveOfEratosthenes, +-- sieveOfEratosthenesInt +) where + +import Control.Arrow((&&&), (***)) +import qualified Control.Arrow +import qualified Data.IntMap +import qualified Data.Map +import Data.Sequence((|>)) +import qualified Data.Sequence +import qualified Factory.Data.PrimeWheel as Data.PrimeWheel + +-- | The 'Data.Sequence.Seq' counterpart to 'Data.List.head'. +head' :: Data.Sequence.Seq [a] -> [a] +head' = (`Data.Sequence.index` 0) + +{- | + * The 'Data.Sequence.Seq' counterpart to 'Data.List.tail'. + + * CAVEAT: because @ Data.List.tail [] @ returns an error, whereas @ tail' Data.Sequence.empty @ returns 'Data.Sequence.empty', + this function is for internal use only. +-} +tail' :: Data.Sequence.Seq [a] -> Data.Sequence.Seq [a] +tail' = Data.Sequence.drop 1 + +-- | An ordered queue of the multiples of primes. +type PrimeMultiplesQueue i = Data.Sequence.Seq (Data.PrimeWheel.PrimeMultiples i) + +-- | A map of the multiples of primes. +type PrimeMultiplesMap i = Data.Map.Map i (Data.PrimeWheel.PrimeMultiples i) + +-- | Combine a /queue/, with a /map/, to form a repository to hold prime-multiples. +type Repository i = (PrimeMultiplesQueue i, PrimeMultiplesMap i) + +{- | + * A refinement of the /Sieve Of Eratosthenes/, which pre-sieves candidates, selecting only those /coprime/ to the specified short sequence of low prime-numbers. + + * The short sequence of initial primes are represented by a 'Data.PrimeWheel.PrimeWheel', + of parameterised, but static, size; . + + * The algorithm requires one to record multiples of previously discovered primes, allowing /composite/ candidates to be eliminated by comparison. + + * Because each /list/ of multiples, starts with the /square/ of the prime from which it was generated, + the vast majority will be larger than the maximum prime ultimately demanded, and the effort of constructing and storing this list, is consequently wasted. + Many implementations solve this, by requiring specification of the maximum prime required, + thus allowing the construction of redundant lists of multiples to be avoided. + + * This implementation doesn't impose that constraint, leaving a requirement for /rapid/ storage, + which is supported by /appending/ the /list/ of prime-multiples, to a /queue/. + If a large enough candidate is ever generated, to match the /head/ of the /list/ of prime-multiples, + at the /head/ of this /queue/, then the whole /list/ of prime-multiples is dropped from the /queue/, + but the /tail/ of this /list/ of prime-multiples, for which there is now a high likelyhood of a subsequent match, must now be re-recorded. + A /queue/ doesn't support efficient random /insertion/, so a 'Data.Map.Map' is used for these subsequent multiples. + This solution is faster than just using a "Data.PQueue.Min". + + * CAVEAT: has linear /O(n)/ space-complexity. +-} +sieveOfEratosthenes :: Integral i + => Data.PrimeWheel.NPrimes + -> [i] +sieveOfEratosthenes = uncurry (++) . (Data.PrimeWheel.getPrimeComponents &&& start . Data.PrimeWheel.roll) . Data.PrimeWheel.mkPrimeWheel where + start :: Integral i => [Data.PrimeWheel.Distance i] -> [i] + start ~((candidate, rollingWheel) : distances) = candidate : sieve (head distances) (Data.Sequence.singleton $ Data.PrimeWheel.generateMultiples candidate rollingWheel, Data.Map.empty) + + sieve :: Integral i => Data.PrimeWheel.Distance i -> Repository i -> [i] + sieve distance@(candidate, rollingWheel) repository@(primeSquares, squareFreePrimeMultiples) = case Data.Map.lookup candidate squareFreePrimeMultiples of + Just primeMultiples -> sieve' $ Control.Arrow.second (insertUniq primeMultiples . Data.Map.delete candidate) repository -- Re-insert subsequent multiples. + Nothing -- Not a square-free composite. + | candidate == smallestPrimeSquare -> sieve' $ (tail' *** insertUniq subsequentPrimeMultiples) repository -- Migrate subsequent prime-multiples, from 'primeSquares' to 'squareFreePrimeMultiples'. + | otherwise {-prime-} -> candidate : sieve' (Control.Arrow.first (|> Data.PrimeWheel.generateMultiples candidate rollingWheel) repository) + where + (smallestPrimeSquare : subsequentPrimeMultiples) = head' primeSquares + where +-- sieve' :: Repository i -> [i] + sieve' = sieve $ Data.PrimeWheel.rotate distance -- Tail-recurse. + + insertUniq :: Ord i => Data.PrimeWheel.PrimeMultiples i -> PrimeMultiplesMap i -> PrimeMultiplesMap i + insertUniq l m = insert $ dropWhile (`Data.Map.member` m) l where +-- insert :: Ord i => Data.PrimeWheel.PrimeMultiples i -> PrimeMultiplesMap i + insert [] = error "Factory.Math.Implementations.Primes.SieveOfEratosthenes.sieveOfEratosthenes.sieve.insertUniq.insert:\tnull list" + insert (key : values) = Data.Map.insert key values m + +{-# NOINLINE sieveOfEratosthenes #-} +{-# RULES "sieveOfEratosthenes/Int" sieveOfEratosthenes = sieveOfEratosthenesInt #-} -- CAVEAT: doesn't fire when built with profiling enabled. + +-- | A specialisation of 'PrimeMultiplesMap'. +type PrimeMultiplesMapInt = Data.IntMap.IntMap (Data.PrimeWheel.PrimeMultiples Int) + +-- | A specialisation of 'Repository'. +type RepositoryInt = (PrimeMultiplesQueue Int, PrimeMultiplesMapInt) + +{- | + * A specialisation of 'sieveOfEratosthenes', which approximately /doubles/ the speed and reduces the space required. + + * CAVEAT: because the algorithm involves /squares/ of primes, + this implementation will overflow when finding primes greater than @2^16@ on a /32-bit/ machine. +-} +sieveOfEratosthenesInt :: Data.PrimeWheel.NPrimes -> [Int] +sieveOfEratosthenesInt = uncurry (++) . (Data.PrimeWheel.getPrimeComponents &&& start . Data.PrimeWheel.roll) . Data.PrimeWheel.mkPrimeWheel where + start :: [Data.PrimeWheel.Distance Int] -> [Int] + start ~((candidate, rollingWheel) : distances) = candidate : sieve (head distances) (Data.Sequence.singleton $ Data.PrimeWheel.generateMultiples candidate rollingWheel, Data.IntMap.empty) + + sieve :: Data.PrimeWheel.Distance Int -> RepositoryInt -> [Int] + sieve distance@(candidate, rollingWheel) repository@(primeSquares, squareFreePrimeMultiples) = case Data.IntMap.lookup candidate squareFreePrimeMultiples of + Just primeMultiples -> sieve' $ Control.Arrow.second (insertUniq primeMultiples . Data.IntMap.delete candidate) repository + Nothing + | candidate == smallestPrimeSquare -> sieve' $ (tail' *** insertUniq subsequentPrimeMultiples) repository + | otherwise -> candidate : sieve' (Control.Arrow.first (|> Data.PrimeWheel.generateMultiples candidate rollingWheel) repository) + where + (smallestPrimeSquare : subsequentPrimeMultiples) = head' primeSquares + where + sieve' :: RepositoryInt -> [Int] + sieve' = sieve $ Data.PrimeWheel.rotate distance + + insertUniq :: Data.PrimeWheel.PrimeMultiples Int -> PrimeMultiplesMapInt -> PrimeMultiplesMapInt + insertUniq l m = insert $ dropWhile (`Data.IntMap.member` m) l where + insert :: Data.PrimeWheel.PrimeMultiples Int -> PrimeMultiplesMapInt + insert [] = error "Factory.Math.Implementations.Primes.SieveOfEratosthenes.sieveOfEratosthenesInt.sieve.insertUniq.insert:\tnull list" + insert (key : values) = Data.IntMap.insert key values m diff --git a/src-lib/Factory/Math/Implementations/Primes/TrialDivision.hs b/src-lib/Factory/Math/Implementations/Primes/TrialDivision.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Primes/TrialDivision.hs @@ -0,0 +1,59 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Generates the constant, conceptually infinite, list of /prime-numbers/, using /Trial Division/. +-} + +module Factory.Math.Implementations.Primes.TrialDivision( +-- * Functions + trialDivision +-- ** Predicates +-- isIndivisibleBy +) where + +import qualified Control.Arrow +import qualified Data.List +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation +import qualified Factory.Data.PrimeWheel as Data.PrimeWheel + +-- | Uses /Trial Division/, to determine whether the specified candidate is indivisible by all potential denominators from the specified list. +isIndivisibleBy :: Integral i + => i -- ^ The numerator. + -> [i] -- ^ The denominators of which it must not be a multiple. + -> Bool +isIndivisibleBy numerator = all ((/= 0) . (numerator `rem`)) . takeWhile (<= Math.PrimeFactorisation.maxBoundPrimeFactor numerator) + +{- | + * For each candidate, confirm indivisibility, by all /primes/ smaller than its /square-root/. + + * The candidates to sieve, are generated by a 'Data.PrimeWheel.PrimeWheel', + of parameterised, but static, size; . +-} +trialDivision :: Integral prime => Data.PrimeWheel.NPrimes -> [prime] +trialDivision 0 = [2, 3] ++ filter (`isIndivisibleBy` trialDivision 0 {-recurse-}) [5 ..] -- No faster than using 'Data.PrimeWheel.mkPrimeWheel 0', but apparently better space-complexity ?! +trialDivision wheelSize = Data.PrimeWheel.getPrimeComponents primeWheel ++ indivisible where + primeWheel = Data.PrimeWheel.mkPrimeWheel wheelSize + candidates = map fst $ Data.PrimeWheel.roll primeWheel + indivisible = uncurry (++) . Control.Arrow.second ( + filter (`isIndivisibleBy` indivisible {-recurse-}) + ) $ Data.List.span ( + < Math.Power.square (head candidates) -- The first composite candidate, is the square of the next prime after the wheel's constituent ones. + ) candidates + diff --git a/src-lib/Factory/Math/Implementations/Primes/TurnersSieve.hs b/src-lib/Factory/Math/Implementations/Primes/TurnersSieve.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/Primes/TurnersSieve.hs @@ -0,0 +1,48 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Generates the constant, conceptally infinite, list of /prime-numbers/, using /Turner's Sieve/; . +-} + +module Factory.Math.Implementations.Primes.TurnersSieve( +-- * Functions + turnersSieve +) where + +import qualified Factory.Math.Power as Math.Power + +{- | + * For each /prime/, the infinite list of candidates greater than its /square/, + is filtered for indivisibility; . + + * CAVEAT: though one can easily add a 'Data.PrimeWheel.PrimeWheel', it proved counterproductive. +-} +turnersSieve :: Integral prime => [prime] +turnersSieve = 2 : sieve [3, 5 ..] where + sieve :: Integral i => [i] -> [i] + sieve [] = [] + sieve (prime : candidates) = prime : sieve ( + filter ( + \candidate -> any ($ candidate) [ + (< Math.Power.square prime), -- Unconditionally admit any candidate smaller than the square of the last prime. + (/= 0) . (`rem` prime) -- Ensure indivisibility, of all subsequent candidates, by the last prime discovered. + ] + ) candidates + ) + diff --git a/src-lib/Factory/Math/Implementations/SquareRoot.hs b/src-lib/Factory/Math/Implementations/SquareRoot.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Implementations/SquareRoot.hs @@ -0,0 +1,192 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Math.SquareRoot.Algorithmic' by a variety of methods. + + [@CAVEAT@] + + Caller may benefit from application of 'Math.Precision.simplify' before operating on the result; + which though of the required accuracy, may not be the most concise rational number satisfying that criterion. +-} +module Factory.Math.Implementations.SquareRoot( +-- * Types +-- ** Type-synonyms +-- ProblemSpecification, + Terms, +-- ** Data-types + Algorithm(..) +-- * Functions +-- squareRootByContinuedFraction, +-- squareRootByIteration, +-- squareRootByTaylorSeries, +-- taylorSeriesCoefficients +) where + +import Control.Arrow((***)) +import Factory.Data.PrimeFactors((>/<), (>^)) +import qualified Factory.Data.PrimeFactors as Data.PrimeFactors +import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.SquareRoot as Math.SquareRoot +import qualified Factory.Math.Summation as Math.Summation +import qualified ToolShed.Defaultable + +-- | The number of terms in a series. +type Terms = Int + +-- | The algorithms by which the /square-root/ has been implemented. +data Algorithm + = BakhshaliApproximation -- ^ + | ContinuedFraction -- ^ . + | HalleysMethod -- ^ . + | NewtonRaphsonIteration -- ^ . + | TaylorSeries Terms -- ^ . + deriving (Eq, Read, Show) + +instance ToolShed.Defaultable.Defaultable Algorithm where + defaultValue = NewtonRaphsonIteration + +-- | Returns an improved estimate for the /square-root/ of the specified value, to the required precision, using the supplied initial estimate.. +type ProblemSpecification operand + = Math.SquareRoot.Estimate + -> Math.Precision.DecimalDigits -- ^ The required precision. + -> operand -- ^ The value for which to find the /square-root/. + -> Math.SquareRoot.Result + +instance Math.SquareRoot.Algorithmic Algorithm where + squareRootFrom _ _ _ 0 = 0 + squareRootFrom _ _ _ 1 = 1 + squareRootFrom algorithm estimate@(x, decimalDigits) requiredDecimalDigits y + | decimalDigits >= requiredDecimalDigits = x + | requiredDecimalDigits <= 0 = error $ "Factory.Math.Implementations.SquareRoot.squareRootFrom:\tinvalid number of required decimal digits; " ++ show requiredDecimalDigits + | y < 0 = error $ "Factory.Math.Implementations.SquareRoot.squareRootFrom:\tthere's no real square-root of " ++ show y + | otherwise = ( + case algorithm of + ContinuedFraction -> squareRootByContinuedFraction + _ -> squareRootByIteration algorithm + ) estimate requiredDecimalDigits y + +instance Math.SquareRoot.Iterator Algorithm where + step BakhshaliApproximation y x + | dy == 0 = x -- The estimate was precise. + | otherwise = x' - dx' -- Correct the estimate. + where + dy, dydx, dx, x', dydx', dx' :: Math.SquareRoot.Result + dy = Math.SquareRoot.getDiscrepancy y x + dydx = 2 * x + dx = dy / dydx + x' = x + dx -- Identical to Newton-Raphson iteration. + dydx' = 2 * x' + dx' = Math.Power.square dx / dydx' + +{- + * /Halley's/ method; + +> X(n+1) = Xn - f(Xn) / [f'(Xn) - f''(Xn) * f(Xn) / 2 * f'(Xn)] +> => Xn - (Xn^2 - Y) / [2Xn - 2 * (Xn^2 - Y) / 2 * 2Xn] where Y = X^2, f(X) = X^2 - Y, f'(X) = 2X, f''(X) = 2 +> => Xn - 1 / [2Xn / (Xn^2 - Y) - 1 / 2Xn] +-} + step HalleysMethod y x + | dy == 0 = x -- The estimate was precise. + | otherwise = x - dx -- Correct the estimate. + where + dy, dydx, dx :: Math.SquareRoot.Result + dy = negate $ Math.SquareRoot.getDiscrepancy y x -- Use the estimate to determine the error in 'y'. + dydx = 2 * x -- The gradient, at the estimated value 'x'. + dx = recip $ dydx / dy - recip dydx + +-- step NewtonRaphsonIteration y x = (x + toRational y / x) / 2 -- This is identical to the /Babylonian Method/. +-- step NewtonRaphsonIteration y x = x / 2 + toRational y / (2 * x) -- Faster. + step NewtonRaphsonIteration y x = x / 2 + (toRational y / 2) / x -- Faster still. + + step (TaylorSeries terms) y x = squareRootByTaylorSeries terms y x + + step algorithm _ _ = error $ "Factory.Math.Implementations.SquareRoot.step:\tinappropriate algorithm; " ++ show algorithm + + convergenceOrder BakhshaliApproximation = Math.Precision.quarticConvergence + convergenceOrder ContinuedFraction = Math.Precision.linearConvergence + convergenceOrder HalleysMethod = Math.Precision.cubicConvergence + convergenceOrder NewtonRaphsonIteration = Math.Precision.quadraticConvergence + convergenceOrder (TaylorSeries terms) = terms -- The order of convergence, per iteration, equals the number of terms in the series on each iteration. + +{- | + * Uses /continued-fractions/, to iterate towards the principal /square-root/ of the specified positive integer; + , + , + . + + + * The convergence of the /continued-fraction/ is merely /1st order/ (linear). +-} +squareRootByContinuedFraction :: Real operand => ProblemSpecification operand +squareRootByContinuedFraction (initialEstimate, initialDecimalDigits) requiredDecimalDigits y = initialEstimate + (convergents initialEstimate !! Math.Precision.getTermsRequired (10 ^^ negate initialDecimalDigits) requiredDecimalDigits) where + convergents :: Math.SquareRoot.Result -> [Math.SquareRoot.Result] + convergents x = iterate ((Math.SquareRoot.getDiscrepancy y x /) . ((2 * x) +)) 0 + +{- | + * The constant coefficients of the /Taylor-series/ for a /square-root/; . + + * @ ((-1)^n * factorial(2*n)) / ((1 - 2*n) * 4^n * factorial(n^2)) @. +-} +taylorSeriesCoefficients :: Fractional f => [f] +taylorSeriesCoefficients = zipWith ( + \powers n -> let + doubleN = 2 * n + product' = Data.PrimeFactors.product' (recip 2) {-arbitrary-} 10 {-arbitrary-} + in uncurry (/) . ( + fromIntegral . product' *** fromIntegral . (* ((1 - doubleN) * powers)) . product' + ) $ Math.Implementations.Factorial.primeFactors doubleN >/< Math.Implementations.Factorial.primeFactors n >^ 2 + ) ( + iterate (* negate 4) 1 -- (-4)^n + ) [0 :: Integer ..] -- n + +{- | + * Returns the /Taylor-series/ for the /square-root/ of the specified value, to any requested number of terms. + + * . + + * The convergence of the series is merely /linear/, + in that each term increases the precision, by a constant number of decimal places, equal to the those in the original estimate. + + * By feeding-back the improved estimate, to form a new series, the order of convergence, on each successive iteration, + becomes proportional to the number of terms; + +> Terms Convergence +> ===== =========== +> 2 terms /quadratic/ +> 3 terms /cubic/ +-} +squareRootByTaylorSeries :: Real operand + => Terms -- ^ The number of terms of the infinite series, to evaluate. + -> operand -- ^ The value for which the /square-root/ is required. + -> Math.SquareRoot.Result -- ^ An initial estimate. + -> Math.SquareRoot.Result +squareRootByTaylorSeries _ _ 0 = error "Factory.Math.Implementations.SquareRoot.squareRootByTaylorSeries:\talgorithm can't cope with estimated value of zero." +squareRootByTaylorSeries terms y x + | terms < 2 = error $ "Factory.Math.Implementations.SquareRoot.squareRootByTaylorSeries:\tinvalid number of terms; " ++ show terms + | otherwise = Math.Summation.sumR' . take terms . zipWith (*) taylorSeriesCoefficients $ iterate (* relativeError) x + where + relativeError :: Math.SquareRoot.Result + relativeError = pred $ toRational y / Math.Power.square x -- Pedantically, this is the error in y, which is twice the magnitude of the error in x. + +-- | Iterates from the estimated value, towards the /square-root/, a sufficient number of times to achieve the required accuracy. +squareRootByIteration :: Real operand => Algorithm -> ProblemSpecification operand +squareRootByIteration algorithm (initialEstimate, initialDecimalDigits) requiredDecimalDigits y = iterate (Math.SquareRoot.step algorithm y) initialEstimate !! Math.Precision.getIterationsRequired (Math.SquareRoot.convergenceOrder algorithm) initialDecimalDigits requiredDecimalDigits + diff --git a/src-lib/Factory/Math/MultiplicativeOrder.hs b/src-lib/Factory/Math/MultiplicativeOrder.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/MultiplicativeOrder.hs @@ -0,0 +1,66 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Exports the /Multiplicative Order/ of an integer, in a specific /modular/ arithmetic. + +-} + +module Factory.Math.MultiplicativeOrder( +-- * Functions + multiplicativeOrder +) where + +import qualified Control.DeepSeq +import qualified Factory.Data.Exponential as Data.Exponential +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.Primality as Math.Primality +import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation + +{- | + * The smallest positive integral power to which the specified integral base must be raised, + to be congruent with one, in the specified /modular/ arithmetic. + + * Based on . + + * . + + * . +-} +multiplicativeOrder :: (Math.PrimeFactorisation.Algorithmic primeFactorisationAlgorithm, Control.DeepSeq.NFData i, Integral i, Show i) + => primeFactorisationAlgorithm + -> i -- ^ Base. + -> i -- ^ Modulus. + -> i -- ^ Result. +multiplicativeOrder primeFactorisationAlgorithm base modulus + | modulus < 2 = error $ "Factory.Math.MultiplicativeOrder.multiplicativeOrder:\tinvalid modulus; " ++ show modulus + | not $ Math.Primality.areCoprime base modulus = error $ "Factory.Math.MultiplicativeOrder.multiplicativeOrder:\targuments aren't coprime; " ++ show (base, modulus) + | otherwise = foldr (lcm . multiplicativeOrder') 1 $ Math.PrimeFactorisation.primeFactors primeFactorisationAlgorithm modulus -- Combine the /multiplicative order/ of the constituent /prime-factors/. + where +-- multiplicativeOrder' :: (Control.DeepSeq.NFData i, Integral i) => Data.Exponential.Exponential i -> i + multiplicativeOrder' e = product . map ( + \e' -> let + d :: Int + d = length . takeWhile (/= 1) . iterate ( + \y -> Math.Power.raiseModulo y (Data.Exponential.getBase e') pk + ) $ Math.Power.raiseModulo base (totient `div` Data.Exponential.evaluate e') pk + in Data.Exponential.getBase e' ^ d + ) $ Math.PrimeFactorisation.primeFactors primeFactorisationAlgorithm totient where + pk = Data.Exponential.evaluate e + totient = Math.PrimeFactorisation.primePowerTotient e + diff --git a/src-lib/Factory/Math/PerfectPower.hs b/src-lib/Factory/Math/PerfectPower.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/PerfectPower.hs @@ -0,0 +1,100 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Exports functions related to /perfect powers/. +-} + +module Factory.Math.PerfectPower( +-- * Functions + maybeSquareNumber, +-- ** Predicates + isPerfectPower +-- isPerfectPowerInt +) where + +import qualified Data.IntSet +import qualified Data.Set +import qualified Factory.Math.Power as Math.Power + +{- | + * Returns @(Just . sqrt)@ if the specified integer is a /square number/ (AKA /perfect square/). + + * . + + * . + + * @(Math.Power.square . sqrt)@ is expensive, so the modulus of the operand is tested first, in an attempt to prove it isn't a /perfect square/. + The set of tests, and the valid moduli within each test, are ordered to maximize the rate of failure-detection. +-} +maybeSquareNumber :: Integral i => i -> Maybe i +maybeSquareNumber i +-- | i < 0 = Nothing -- This function is performance-sensitive, but this test is neither strictly nor frequently required. + | all (\(modulus, valid) -> rem i modulus `elem` valid) [ +-- -- Distribution of moduli amongst perfect squares Cumulative failure-detection. + (16, [0,1,4,9]), -- All moduli are equally likely. 75% + (9, [0,1,4,7]), -- Zero occurs 33%, the others only 22%. 88% + (17, [1,2,4,8,9,13,15,16,0]), -- Zero only occurs 5.8%, the others 11.8%. 94% +-- These additional tests, aren't always cost-effective. + (13, [1,3,4,9,10,12,0]), -- Zero only occurs 7.7%, the others 15.4%. 97% + (7, [1,2,4,0]), -- Zero only occurs 14.3%, the others 28.6%. 98% + (5, [1,4,0]) -- Zero only occurs 20%, the others 40%. 99% + +-- ] && fromIntegral iSqrt == sqrt' = Just iSqrt -- CAVEAT: erroneously True for 187598574531033120 (187598574531033121 is square). + ] && Math.Power.square iSqrt == i = Just iSqrt + | otherwise = Nothing + where + sqrt' :: Double + sqrt' = sqrt $ fromIntegral i + + iSqrt = round sqrt' + +{- | + * An integer @(> 1)@ which can be expressed as an integral power @(> 1)@ of a smaller /natural/ number. + + * CAVEAT: /zero/ and /one/ are normally excluded from this set. + + * . + + * . + + * A generalisation of the concept of /perfect squares/, in which only the exponent '2' is significant. +-} +isPerfectPower :: Integral i => i -> Bool +isPerfectPower i + | i < Math.Power.square 2 = False + | otherwise = i `Data.Set.member` foldr ( + \n set -> if n `Data.Set.member` set + then set +-- else Data.Set.union set . Data.Set.fromDistinctAscList . takeWhile (<= i) . iterate (* n) $ Math.Power.square n + else foldr Data.Set.insert set . takeWhile (<= i) . iterate (* n) $ Math.Power.square n -- Faster. + ) Data.Set.empty [2 .. round $ sqrt (fromIntegral i :: Double)] + +{-# NOINLINE isPerfectPower #-} +{-# RULES "isPerfectPower/Int" isPerfectPower = isPerfectPowerInt #-} + +-- | A specialisation of 'isPerfectPower'. +isPerfectPowerInt :: Int -> Bool +isPerfectPowerInt i + | i < Math.Power.square 2 = False + | otherwise = i `Data.IntSet.member` foldr ( + \n set -> if n `Data.IntSet.member` set + then set + else foldr Data.IntSet.insert set . takeWhile (<= i) . iterate (* n) $ Math.Power.square n + ) Data.IntSet.empty [2 .. round $ sqrt (fromIntegral i :: Double)] + diff --git a/src-lib/Factory/Math/Pi.hs b/src-lib/Factory/Math/Pi.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Pi.hs @@ -0,0 +1,100 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the classes of /Pi/-algorithm which have been implemented. +-} + +module Factory.Math.Pi( +-- * Type-classes + Algorithmic(..), +-- * Types +-- ** Data-types + Category(..) +) where + +import qualified Factory.Math.Precision as Math.Precision +import qualified ToolShed.Defaultable + +{- | + * Defines the methods expected of a /Pi/-algorithm. + + * Most of the implementations naturally return a 'Rational', but the spigot-algorithms naturally produce a @[Int]@; + though representing /Pi/ as a big integer with the decimal point removed is clearly incorrect. + + * Since representing /Pi/ as either a 'Rational' or promoted to an 'Integer', is inconvenient, an alternative decimal 'String'-representation is provided. +-} +class Algorithmic algorithm where + openR :: algorithm -> Math.Precision.DecimalDigits -> Rational -- ^ Returns the value of /Pi/ as a 'Rational'. + + openI :: algorithm -> Math.Precision.DecimalDigits -> Integer -- ^ Returns the value of /Pi/, promoted by the required precision to form an integer. + openI _ 1 = 3 + openI algorithm decimalDigits + | decimalDigits <= 0 = error $ "Factory.Math.Pi.openI:\tinsufficient decimalDigits=" ++ show decimalDigits + | otherwise = round . Math.Precision.promote (openR algorithm decimalDigits) $ pred decimalDigits + + openS :: algorithm -> Math.Precision.DecimalDigits -> String -- ^ Returns the value of /Pi/ as a decimal 'String'. + openS _ 1 = "3" + openS algorithm decimalDigits + | decimalDigits <= 0 = "" + | decimalDigits <= 16 = take (succ decimalDigits) $ show (pi :: Double) + | otherwise = "3." ++ tail (show $ openI algorithm decimalDigits) -- Insert a decimal point. + +-- | Categorises the various algorithms. +data Category agm bbp borwein ramanujan spigot + = AGM agm -- ^ Algorithms based on the /Arithmetic-geometric Mean/. + | BBP bbp -- ^ . + | Borwein borwein -- ^ . + | Ramanujan ramanujan -- ^ . + | Spigot spigot -- ^ Algorithms from which the digits of /Pi/ slowly drip, one by one. + deriving (Eq, Read, Show) + +instance ( + ToolShed.Defaultable.Defaultable agm, + ToolShed.Defaultable.Defaultable bbp, + ToolShed.Defaultable.Defaultable borwein, + ToolShed.Defaultable.Defaultable ramanujan, + ToolShed.Defaultable.Defaultable spigot + ) => ToolShed.Defaultable.Defaultable (Category agm bbp borwein ramanujan spigot) where + defaultValue = BBP ToolShed.Defaultable.defaultValue + +instance ( + Algorithmic agm, + Algorithmic bbp, + Algorithmic borwein, + Algorithmic ramanujan, + Algorithmic spigot + ) => Algorithmic (Category agm bbp borwein ramanujan spigot) where + openR algorithm decimalDigits + | decimalDigits <= 0 = error $ "Factory.Math.Pi.openR:\tinsufficient decimalDigits=" ++ show decimalDigits + | decimalDigits <= 16 = Math.Precision.simplify (pred decimalDigits) (pi :: Double) + | otherwise = ( + case algorithm of + AGM agm -> openR agm + BBP bbp -> openR bbp + Borwein borwein -> openR borwein + Ramanujan ramanujan -> openR ramanujan + Spigot spigot -> openR spigot + ) decimalDigits + + openI _ 1 = 3 + openI (Spigot spigot) decimalDigits = openI spigot decimalDigits + openI algorithm decimalDigits + | decimalDigits <= 0 = error $ "Factory.Math.Pi.openI:\tinsufficient decimalDigits=" ++ show decimalDigits + | otherwise = round . Math.Precision.promote (openR algorithm decimalDigits) $ pred decimalDigits + diff --git a/src-lib/Factory/Math/Power.hs b/src-lib/Factory/Math/Power.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Power.hs @@ -0,0 +1,84 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Exports functions involving integral powers. +-} + +module Factory.Math.Power( +-- * Functions + square, + squaresFrom, + cube, + cubeRoot, + raiseModulo +) where + +-- | Mainly for convenience. +square :: Num n => n -> n +square x = x ^ (2 :: Int) -- CAVEAT: this could be eta-reduced, but it won't then inline when called with a single argument. + +{-# INLINE square #-} + +-- | Just for convenience. +cube :: Num n => n -> n +cube = (^ (3 :: Int)) + +{- | + * Iteratively generate sequential /squares/, from the specified initial value, + based on the fact that @(x + 1)^2 = x^2 + 2 * x + 1@. + + * The initial value doesn't need to be either positive or integral. +-} +squaresFrom :: (Enum n, Num n) + => n -- ^ Lower bound. + -> [(n, n)] -- ^ @ [(n, n^2)] @. +squaresFrom from = iterate (\(x, y) -> (succ x, succ $ y + 2 * x)) (from, square from) + +-- | Just for convenience. +cubeRoot :: Double -> Double +cubeRoot = (** recip 3) + +{- | + * Raise an arbitrary number to the specified positive integral power, using /modular/ arithmetic. + + * Implements exponentiation as a sequence of either /squares/ or multiplications by the base; + . + + * . +-} +raiseModulo :: (Integral i, Integral power, Show power) + => i -- ^ Base. + -> power + -> i -- ^ Modulus. + -> i -- ^ Result. +raiseModulo _ _ 0 = error "Factory.Math.Power.raiseModulo:\tzero modulus." +raiseModulo _ _ 1 = 0 +raiseModulo _ 0 modulus = 1 `mod` modulus +raiseModulo base power modulus + | base < 0 = (`mod` modulus) . (if even power then id else negate) $ raiseModulo (negate base) power modulus -- Recurse. + | power < 0 = error $ "Factory.Math.Power.raiseModulo:\tnegative power; " ++ show power + | first `elem` [0, 1] = first + | otherwise = slave power + where + first = base `mod` modulus + + slave 1 = first + slave e = (`mod` modulus) . (if r == 0 {-even-} then id else (* base)) . square $ slave q {-recurse-} where + (q, r) = e `quotRem` 2 + diff --git a/src-lib/Factory/Math/Precision.hs b/src-lib/Factory/Math/Precision.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Precision.hs @@ -0,0 +1,125 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines the unit with which precision is measured, and operations on it. +-} +module Factory.Math.Precision( +-- * Types +-- ** Type-synonyms + ConvergenceOrder, + ConvergenceRate, + DecimalDigits, +-- * Constants + linearConvergence, + quadraticConvergence, + cubicConvergence, + quarticConvergence, +-- * Functions + getIterationsRequired, + getTermsRequired, + roundTo, + promote, + simplify +) where + +import qualified Data.Ratio + +-- | The /order of convergence/; . +type ConvergenceOrder = Int + +-- | The /rate of convergence/; . +type ConvergenceRate = Double + +-- | A number of decimal digits; presumably positive. +type DecimalDigits = Int + +-- | /Linear/ convergence-rate; which may be qualified by the /rate of convergence/. +linearConvergence :: ConvergenceOrder +linearConvergence = 1 + +-- | /Quadratic/ convergence-rate. +quadraticConvergence :: ConvergenceOrder +quadraticConvergence = 2 + +-- | /Cubic/ convergence-rate. +cubicConvergence :: ConvergenceOrder +cubicConvergence = 3 + +-- | /Quartic/ convergence-rate. +quarticConvergence :: ConvergenceOrder +quarticConvergence = 4 + +-- | The predicted number of iterations, required to achieve a specific accuracy, at a given /order of convergence/. +getIterationsRequired :: Integral i + => ConvergenceOrder + -> DecimalDigits -- ^ The precision of the initial estimate. + -> DecimalDigits -- ^ The required precision. + -> i +getIterationsRequired convergenceOrder initialDecimalDigits requiredDecimalDigits + | initialDecimalDigits <= 0 = error $ "Factory.Math.Precision.getIterationsRequired:\tinsufficient 'initialDecimalDigits'; " ++ show initialDecimalDigits + | precisionRatio <= 1 = 0 + | otherwise = ceiling $ fromIntegral convergenceOrder `logBase` precisionRatio + where + precisionRatio :: Double + precisionRatio = fromIntegral requiredDecimalDigits / fromIntegral initialDecimalDigits + +{- | + * The predicted number of terms which must be extracted from a series, + if it is to converge to the required accuracy, + at the specified linear /convergence-rate/. + + * The /convergence-rate/ of a series, is the error in the series after summation of @(n+1)th@ terms, + divided by the error after only @n@ terms, as the latter tends to infinity. + As such, for a /convergent/ series (in which the error get smaller with successive terms), it's value lies in the range @0 .. 1@. + + * . +-} +getTermsRequired :: Integral i + => ConvergenceRate + -> DecimalDigits -- ^ The additional number of correct decimal digits. + -> i +getTermsRequired _ 0 = 0 +getTermsRequired convergenceRate requiredDecimalDigits + | convergenceRate <= 0 || convergenceRate >= 1 = error $ "Factory.Math.Precision.getTermsRequired:\t(0 < convergence-rate < 1); " ++ show convergenceRate + | requiredDecimalDigits < 0 = error $ "Factory.Math.Precision.getTermsRequired:\t'requiredDecimalDigits' must be positive; " ++ show requiredDecimalDigits + | otherwise = ceiling $ fromIntegral requiredDecimalDigits / negate (logBase 10 convergenceRate) + +-- | Rounds the specified number, to a positive number of 'DecimalDigits'. +roundTo :: (RealFrac a, Fractional f) => DecimalDigits -> a -> f +roundTo decimals = (/ fromInteger promotionFactor) . fromInteger . round . (* fromInteger promotionFactor) where + promotionFactor :: Integer + promotionFactor = 10 ^ decimals + +-- | Promotes the specified number, by a positive number of 'DecimalDigits'. +promote :: Num n => n -> DecimalDigits -> n +promote x = (* x) . (10 ^) + +{- | + * Reduces a 'Rational' to the minimal form required for the specified number of /fractional/ decimal places; + irrespective of the number of integral decimal places. + + * A 'Rational' approximation to an irrational number, may be very long, and provide an unknown excess precision. + Whilst this doesn't sound harmful, it costs in performance and memory-requirement, and being unpredictable isn't actually useful. +-} +simplify :: RealFrac operand + => DecimalDigits -- ^ The number of places after the decimal point, which are required. + -> operand + -> Rational +simplify decimalDigits operand = Data.Ratio.approxRational operand . recip $ 4 * 10 ^ succ decimalDigits -- Tolerate any error less than half the least significant digit required. + diff --git a/src-lib/Factory/Math/Primality.hs b/src-lib/Factory/Math/Primality.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Primality.hs @@ -0,0 +1,102 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Exports a common interface for primality-implementations. + + * Provides utilities for these implementations. +-} + +module Factory.Math.Primality( +-- * Type-classes + Algorithmic(..), +-- * Functions + carmichaelNumbers, +-- ** Predicates + areCoprime, + isFermatWitness, + isCarmichaelNumber +) where + +import qualified Control.DeepSeq +import qualified Factory.Math.Power as Math.Power + +-- | Defines the methods expected of a primality-testing algorithm. +class Algorithmic algorithm where + isPrime :: (Control.DeepSeq.NFData i, Integral i, Show i) => algorithm -> i -> Bool + +{- | + 'True' if the two specified integers are /relatively prime/, + i.e. if they share no common positive factors except one. + + * @1@ and @-1@ are the only numbers which are /coprime/ to themself. + + * . + + * . +-} +areCoprime :: Integral i => i -> i -> Bool +areCoprime i = (== 1) . gcd i + +{- | + * Tests /Fermat's Little Theorem/ for all applicable values, as a probabilistic primality-test. + + * . + + * . + + * . + + * CAVEAT: this primality-test fails for the /Carmichael numbers/. + + * TODO: confirm that all values must be tested. +-} +isFermatWitness :: (Integral i, Show i) => i -> Bool +isFermatWitness i = not . all isFermatPseudoPrime $ filter (areCoprime i) [2 .. pred i] where + isFermatPseudoPrime base = Math.Power.raiseModulo base (pred i) i == 1 -- CAVEAT: a /Fermat Pseudo-prime/ must also be a /composite/ number. + +{- | + * A /Carmichael number/ is an /odd/ /composite/ number which satisfies /Fermat's little theorem/. + + * . + + * . +-} +isCarmichaelNumber :: ( + Algorithmic algorithm, + Control.DeepSeq.NFData i, + Integral i, + Show i + ) => algorithm -> i -> Bool +isCarmichaelNumber algorithm i = not $ or [ + i <= 2, + even i, + isFermatWitness i, + isPrime algorithm i + ] + +-- | An ordered list of the /Carmichael/ numbers; . +carmichaelNumbers :: ( + Algorithmic algorithm, + Control.DeepSeq.NFData i, + Integral i, + Show i + ) => algorithm -> [i] +carmichaelNumbers algorithm = isCarmichaelNumber algorithm `filter` [3, 5 ..] diff --git a/src-lib/Factory/Math/PrimeFactorisation.hs b/src-lib/Factory/Math/PrimeFactorisation.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/PrimeFactorisation.hs @@ -0,0 +1,151 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * . + + * Exports a common interface to permit decomposition of positive integers, + into the unique combination of /prime/-factors known to exist according to the /Fundamental Theorem of Arithmetic/; . + + * Leveraging this abstract capability, it derives the /smoothness/, /power-smoothness/, /omega/-numbers and /square-free/ integers. + + * Filters the list of /regular-numbers/ from the list of /smoothness/. + + * CAVEAT: to avoid wasting time, it may be advantageous to check /Factory.Math.Primality.isPrime/ first. +-} + +module Factory.Math.PrimeFactorisation( +-- * Type-classes + Algorithmic(..), +-- * Functions + maxBoundPrimeFactor, + smoothness, + powerSmoothness, + regularNumbers, + primePowerTotient, + eulersTotient, + omega, + squareFree +) where + +import qualified Control.DeepSeq +import qualified Data.List +import qualified Factory.Data.Exponential as Data.Exponential +import qualified Factory.Data.PrimeFactors as Data.PrimeFactors + +-- | Defines the methods expected of a /factorisation/-algorithm. +class Algorithmic algorithm where + primeFactors :: (Control.DeepSeq.NFData base, Integral base) + => algorithm + -> base -- ^ The operand + -> Data.PrimeFactors.Factors base Int {-arbitrarily-} + +{- | + * The upper limit for a prime to be considered as a candidate factor of the specified number. + + * One might naively think that this limit is @(x `div` 2)@ for an even number, + but though a prime-factor /greater/ than the /square-root/ of the number can exist, + its smaller /cofactor/ decomposes to a prime which must be less than the /square-root/. + + * NB: rather then using @(primeFactor <= sqrt numerator)@ to filter the candidate prime-factors of a given numerator, + one can alternatively use @(numerator >= primeFactor ^ 2)@ to filter what can potentially be factored by a given prime-factor. + + * CAVEAT: suffers from rounding-errors, though no consequence has been witnessed. +-} +maxBoundPrimeFactor :: Integral i => i -> i +maxBoundPrimeFactor = floor . (sqrt :: Double -> Double) . fromIntegral + +{- | + * A constant, zero-indexed, conceptually infinite, list, of the /smooth/ness of all positive integers. + + * . + + * . +-} +smoothness :: (Algorithmic algorithm, Control.DeepSeq.NFData base, Integral base) => algorithm -> [base] +smoothness algorithm = 0 : map (Data.Exponential.getBase . last . primeFactors algorithm) [1 ..] + +{- | + * A constant, zero-indexed, conceptually infinite, list of the /power-smooth/ness of all positive integers. + + * . +-} +powerSmoothness :: (Algorithmic algorithm, Control.DeepSeq.NFData base, Integral base) => algorithm -> [base] +powerSmoothness algorithm = 0 : map (maximum . map Data.Exponential.evaluate . primeFactors algorithm) [1 ..] + +{- | + * Filters 'smoothness', to derive the constant list of /Hamming-numbers/. + + * . +-} +regularNumbers :: (Algorithmic algorithm, Control.DeepSeq.NFData base, Integral base) => algorithm -> [base] +regularNumbers algorithm = map fst . filter ((<= (5 :: Integer)) . snd) . zip [1 ..] . tail $ smoothness algorithm + +{- | + * /Euler's Totient/ for a /power/ of a /prime/-number. + + * By /Olofsson/; @(phi(n^k) = n^(k - 1) * phi(n))@ + and since @(phi(prime) = prime - 1)@ + + * CAVEAT: checks neither the primality nor the bounds of the specified value; therefore for internal use only. +-} +primePowerTotient :: (Integral base, Integral exponent) => Data.Exponential.Exponential base exponent -> base +primePowerTotient (base, exponent') = pred base * base ^ pred exponent' + +{- | + * The number of /coprimes/ less than or equal to the specified positive integer. + + * . + + * . + + * AKA /EulerPhi/. +-} +eulersTotient :: ( + Algorithmic algorithm, + Control.DeepSeq.NFData i, + Integral i, + Show i + ) => algorithm -> i -> i +eulersTotient _ 1 = 1 +eulersTotient algorithm i + | i <= 0 = error $ "Factory.Math.PrimeFactorisation.eulersTotient:\tundefined for; " ++ show i + | otherwise = product . map primePowerTotient $ primeFactors algorithm i + +{- | + * A constant, zero-indexed, conceptually infinite, list of the /small omega/ numbers (i.e. the number of /distinct/ prime factors); cf. /big omega/. + + * . + + * + + * . +-} +omega :: (Algorithmic algorithm, Control.DeepSeq.NFData i, Integral i) => algorithm -> [i] +omega algorithm = map (Data.List.genericLength . primeFactors algorithm) [0 :: Integer ..] + +{- | + * A constant, conceptually infinite, list of the /square-free/ numbers, i.e. those which aren't divisible by any /perfect square/. + + * . +-} +squareFree :: (Algorithmic algorithm, Control.DeepSeq.NFData i, Integral i) => algorithm -> [i] +squareFree algorithm = filter (all (== 1) . map Data.Exponential.getExponent . primeFactors algorithm) [1 ..] + diff --git a/src-lib/Factory/Math/Primes.hs b/src-lib/Factory/Math/Primes.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Primes.hs @@ -0,0 +1,64 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Exports a common interface for implementations of /prime-number/ generators. +-} + +module Factory.Math.Primes( +-- * Types-classes + Algorithmic(..), +-- * Functions + primorial, + mersenneNumbers +) where + +import qualified Control.DeepSeq +import qualified Data.Array.IArray + +-- | Defines the methods expected of a /prime-number/ generator. +class Algorithmic algorithm where + primes :: (Control.DeepSeq.NFData i, Data.Array.IArray.Ix i, Integral i) => algorithm -> [i] -- ^ Returns the constant, infinite, list of primes. + +{- | + * Returns the constant list, defining the /Primorial/. + + * . + + * . +-} +primorial :: ( + Algorithmic algorithm, + Control.DeepSeq.NFData i, + Data.Array.IArray.Ix i, + Integral i + ) => algorithm -> [i] +primorial = scanl (*) 1 . primes + +{- | + * Returns the constant ordered infinite list of /Mersenne numbers/. + + * Only the subset composed from a prime exponent is returned; which is a strict superset of the /Mersenne Primes/. + + * . + + * +-} +mersenneNumbers :: (Algorithmic algorithm, Integral i) => algorithm -> [i] +mersenneNumbers algorithm = map (pred . (2 ^)) (primes algorithm :: [Int]) -- Whilst the exponentiation could be parallelised, not all values are known to be required. + diff --git a/src-lib/Factory/Math/Probability.hs b/src-lib/Factory/Math/Probability.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Probability.hs @@ -0,0 +1,255 @@ +{- + Copyright (C) 2011-2013 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Functions for probability-distributions. + + [@CAVEAT@] Because data-constructors are exposed, 'ToolShed.SelfValidate.isValid' need not be called. +-} + +module Factory.Math.Probability( +-- * Type-classes + Distribution(..), +-- * Types +-- ** Data-types + ContinuousDistribution(..), + DiscreteDistribution(..), +-- * Functions + maxPreciseInteger, +-- minPositiveFloat, + boxMullerTransform, +-- reProfile, + generateStandardizedNormalDistribution, + generateContinuousPopulation, +-- generatePoissonDistribution, + generateDiscretePopulation +) where + +import qualified Control.Arrow +import Control.Arrow((***), (&&&)) +import qualified Factory.Data.Interval as Data.Interval +import qualified Factory.Math.Power as Math.Power +import qualified System.Random +import qualified ToolShed.Data.List +import qualified ToolShed.Data.Pair +import qualified ToolShed.SelfValidate + +-- | The maximum integer which can be accurately represented as a Double. +maxPreciseInteger :: RealFloat a => a -> Integer +maxPreciseInteger = (2 ^) . floatDigits + +{- | + * Determines the minimum positive floating-point number, which can be represented by using the parameter's type. + + * Only the type of the parameter is relevant, not its value. +-} +minPositiveFloat :: RealFloat a => a -> a +minPositiveFloat = encodeFloat 1 . uncurry (-) . (fst . floatRange &&& floatDigits) + +-- | Describes /continuous probability-distributions/; . +data ContinuousDistribution parameter + = ExponentialDistribution parameter {-lambda-} -- ^ Defines an /Exponential/-distribution with a particular /lambda/; . + | LogNormalDistribution parameter {-location-} parameter {-scale2-} -- ^ Defines a distribution whose logarithm is normally distributed with a particular /mean/ & /variance/; . + | NormalDistribution parameter {-mean-} parameter {-variance-} -- ^ Defines a /Normal/-distribution with a particular /mean/ & /variance/; . + | UniformDistribution (Data.Interval.Interval parameter) -- ^ Defines a /Uniform/-distribution within a /closed interval/; . + deriving (Eq, Read, Show) + +instance (Floating parameter, Ord parameter, Show parameter) => ToolShed.SelfValidate.SelfValidator (ContinuousDistribution parameter) where + getErrors probabilityDistribution = ToolShed.SelfValidate.extractErrors $ case probabilityDistribution of + ExponentialDistribution lambda -> [(lambda <= 0, "'lambda' must exceed zero; " ++ show probabilityDistribution ++ ".")] + LogNormalDistribution location scale2 -> let + maxParameter = log . fromInteger $ maxPreciseInteger (undefined :: Double) + in [ + (scale2 <= 0, "'scale' must exceed zero; " ++ show probabilityDistribution ++ "."), + (location > maxParameter || scale2 > maxParameter, "loss of precision will result from either 'location' or 'scale^2' exceeding '" ++ show maxParameter ++ "'; " ++ show probabilityDistribution ++ ".") + ] + NormalDistribution _ variance -> [(variance <= 0, "variance must exceed zero; " ++ show probabilityDistribution ++ ".")] + UniformDistribution interval -> [(Data.Interval.isReversed interval, "reversed interval='" ++ show probabilityDistribution ++ "'.")] + +-- | Describes /discrete probability-distributions/; . +data DiscreteDistribution parameter + = PoissonDistribution parameter {-lambda-} -- ^ Defines an /Poisson/-distribution with a particular /lambda/; . + | ShiftedGeometricDistribution parameter {-probability-} -- ^ Defines an /Geometric/-distribution with a particular probability of success; . + deriving (Eq, Read, Show) + +instance (Num parameter, Ord parameter, Show parameter) => ToolShed.SelfValidate.SelfValidator (DiscreteDistribution parameter) where + getErrors probabilityDistribution = ToolShed.SelfValidate.extractErrors $ case probabilityDistribution of + PoissonDistribution lambda -> [(lambda <= 0, "'lambda' must exceed zero; " ++ show probabilityDistribution ++ ".")] + ShiftedGeometricDistribution probability -> [(any ($ probability) [(<= 0), (> 1)], "probability must be in the semi-closed unit-interval (0, 1]; " ++ show probabilityDistribution ++ ".")] + +-- | Defines a common interface for probability-distributions. +class Distribution probabilityDistribution where + generatePopulation + :: (Fractional sample, System.Random.RandomGen randomGen) + => probabilityDistribution + -> randomGen -- ^ A generator of /uniformly distributed/ random numbers. + -> [sample] -- ^ CAVEAT: the integers generated for discrete distributions are represented by a fractional type; use 'generateDiscretePopulation' if this is a problem. + + getMean :: Fractional mean => probabilityDistribution -> mean -- ^ The theoretical mean. + + getStandardDeviation :: Floating standardDeviation => probabilityDistribution -> standardDeviation-- ^ The theoretical standard-deviation. + getStandardDeviation = sqrt . getVariance -- Default implementation. + + getVariance :: Floating variance => probabilityDistribution -> variance -- ^ The theoretical variance. + getVariance = Math.Power.square . getStandardDeviation -- Default implementation. + +instance (RealFloat parameter, Show parameter, System.Random.Random parameter) => Distribution (ContinuousDistribution parameter) where + generatePopulation probabilityDistribution = map realToFrac {-parameter -> sample-} . generateContinuousPopulation probabilityDistribution + + getMean (ExponentialDistribution lambda) = realToFrac $ recip lambda + getMean (LogNormalDistribution location scale2) = realToFrac . exp . (+ location) $ scale2 / 2 + getMean (NormalDistribution mean _) = realToFrac mean + getMean (UniformDistribution (minParameter, maxParameter)) = realToFrac $ (minParameter + maxParameter) / 2 + + getVariance (ExponentialDistribution lambda) = realToFrac . recip $ Math.Power.square lambda + getVariance (LogNormalDistribution location scale2) = realToFrac $ (exp scale2 - 1) * exp (2 * location + scale2) -- NB: for standard-deviation == mean, use scale^2 == ln 2. + getVariance (NormalDistribution _ variance) = realToFrac variance + getVariance (UniformDistribution (minParameter, maxParameter)) = realToFrac $ Math.Power.square (maxParameter - minParameter) / 12 + +instance (RealFloat parameter, Show parameter, System.Random.Random parameter) => Distribution (DiscreteDistribution parameter) where + generatePopulation probabilityDistribution = map fromInteger . generateDiscretePopulation probabilityDistribution + + getMean (PoissonDistribution lambda) = realToFrac lambda + getMean (ShiftedGeometricDistribution probability) = realToFrac $ recip probability + + getVariance (PoissonDistribution lambda) = realToFrac lambda + getVariance (ShiftedGeometricDistribution probability) = realToFrac $ (1 - probability) / Math.Power.square probability + +{- | + * Converts a pair of independent /uniformly distributed/ random numbers, within the /semi-closed unit interval/ /(0,1]/, + to a pair of independent /normally distributed/ random numbers, of standardized /mean/=0, and /variance/=1. + + * . +-} +boxMullerTransform :: ( + Floating f, + Ord f, + Show f + ) + => (f, f) -- ^ Independent, /uniformly distributed/ random numbers, which must be within the /semi-closed unit interval/, /(0,1]/. + -> (f, f) -- ^ Independent, /normally distributed/ random numbers, with standardized /mean/=0 and /variance/=1. +boxMullerTransform cartesian + | not . uncurry (&&) $ ToolShed.Data.Pair.mirror inSemiClosedUnitInterval cartesian = error $ "Factory.Math.Probability.boxMullerTransform:\tspecified Cartesian coordinates, must be within semi-closed unit-interval (0, 1]; " ++ show cartesian + | otherwise = polarToCartesianTransform $ (sqrt . negate . (* 2) . log *** (* 2) . (* pi)) cartesian + where + inSemiClosedUnitInterval :: (Num n, Ord n) => n -> Bool + inSemiClosedUnitInterval = uncurry (&&) . ((> 0) &&& (<= 1)) + + polarToCartesianTransform :: Floating f => (f, f) -> (f, f) + polarToCartesianTransform = uncurry (*) . Control.Arrow.second cos &&& uncurry (*) . Control.Arrow.second sin + +{- | + * Uses the supplied random-number generator, + to generate a conceptually infinite list, of /normally distributed/ random numbers, with standardized /mean/=0, and /variance/=1. + + * , . +-} +generateStandardizedNormalDistribution :: ( + RealFloat f, + Show f, + System.Random.Random f, + System.Random.RandomGen randomGen + ) => randomGen -> [f] +generateStandardizedNormalDistribution = ToolShed.Data.List.linearise . uncurry (zipWith $ curry boxMullerTransform) . ToolShed.Data.Pair.mirror ( + System.Random.randomRs (minPositiveFloat undefined, 1) + ) . System.Random.split + +-- | Stretches and shifts a /distribution/ to achieve the required /mean/ and /standard-deviation/. +reProfile :: (Distribution distribution, Floating n) => distribution -> [n] -> [n] +reProfile distribution = map ((+ getMean distribution) . (* getStandardDeviation distribution)) + +-- | Uses the supplied random-number generator, to generate a conceptually infinite population, with the specified continuous probability-distribution. +generateContinuousPopulation :: ( + RealFloat f, + Show f, + System.Random.Random f, + System.Random.RandomGen randomGen + ) + => ContinuousDistribution f + -> randomGen -- ^ A generator of /uniformly distributed/ random numbers. + -> [f] +generateContinuousPopulation probabilityDistribution randomGen + | not $ ToolShed.SelfValidate.isValid probabilityDistribution = error $ "Factory.Math.Probability.generateContinuousPopulation:\t" ++ ToolShed.SelfValidate.getFirstError probabilityDistribution + | otherwise = ( + case probabilityDistribution of + ExponentialDistribution lambda -> let + quantile = (/ lambda) . negate . log . (1 -) -- . + in map quantile . System.Random.randomRs (0, 1) + LogNormalDistribution location scale2 -> map ( + exp . (+ location) . (* sqrt scale2) -- Stretch the standard-deviation & re-locate the mean to that specified for the log-space, then return to the original coordinates. + ) . generateStandardizedNormalDistribution + NormalDistribution _ _ -> reProfile probabilityDistribution . generateStandardizedNormalDistribution + UniformDistribution interval -> System.Random.randomRs interval + ) randomGen + +{- | + * Uses the supplied random-number generator, + to generate a conceptually infinite population, of random integers conforming to the /Poisson distribution/; . + + * CAVEAT: + uses an algorithm by Knuth, which having a /linear time-complexity/ in /lambda/, can be intolerably slow; + also, the term @exp $ negate lambda@, underflows for large /lambda/; + so for large /lambda/, this implementation returns the appropriate 'NormalDistribution'. +-} +generatePoissonDistribution :: ( + Integral sample, + RealFloat lambda, + Show lambda, + System.Random.Random lambda, + System.Random.RandomGen randomGen + ) + => lambda -- ^ Defines the required approximate value of both /mean/ and /variance/. + -> randomGen + -> [sample] +generatePoissonDistribution lambda + | lambda <= 0 = error $ "Factory.Math.Probability.generatePoissonDistribution:\tlambda must exceed zero " ++ show lambda + | lambda > ( + negate . log $ minPositiveFloat lambda -- Guard against underflow, in the user-defined type for lambda. + ) = filter (>= 0) . map round . (reProfile (PoissonDistribution lambda) :: [Double] -> [Double]) . generateStandardizedNormalDistribution + | otherwise = generator + where + generator = uncurry (:) . ( + fst . head . dropWhile ( + (> exp (negate lambda)) . snd -- CAVEAT: underflows if lambda > (103 :: Float, 745 :: Double). + ) . scanl ( + \accumulator random -> succ *** (* random) $ accumulator + ) (negate 1, 1) . System.Random.randomRs (0, 1) *** generator {-recurse-} + ) . System.Random.split + +-- | Uses the supplied random-number generator, to generate a conceptually infinite population, with the specified discrete probability-distribution. +generateDiscretePopulation :: ( + Integral sample, + Ord parameter, + RealFloat parameter, + Show parameter, + System.Random.Random parameter, + System.Random.RandomGen randomGen + ) + => DiscreteDistribution parameter + -> randomGen -- ^ A generator of /uniformly distributed/ random numbers. + -> [sample] +generateDiscretePopulation probabilityDistribution randomGen + | not $ ToolShed.SelfValidate.isValid probabilityDistribution = error $ "Factory.Math.Probability.generateDiscretePopulation:\t" ++ ToolShed.SelfValidate.getFirstError probabilityDistribution + | otherwise = ( + case probabilityDistribution of + PoissonDistribution lambda -> generatePoissonDistribution lambda + ShiftedGeometricDistribution probability + | probability == 1 -> const $ repeat 1 -- The first Bernoulli Trial is guaranteed to succeed. + | otherwise -> map ceiling {-minimum 1-} . (\x -> x :: [Rational]) . generatePopulation (ExponentialDistribution . negate $ log (1 - probability)) -- The geometric distribution is a discrete version of the exponential distribution. + ) randomGen + diff --git a/src-lib/Factory/Math/Radix.hs b/src-lib/Factory/Math/Radix.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Radix.hs @@ -0,0 +1,139 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Facilitates representation of 'Integral' values in alternative 'Integral' bases. +-} + +module Factory.Math.Radix( +-- * Constants +-- decodes, +-- digits, +-- encodes, +-- * Functions + digitSum, + digitalRoot, + fromBase, + toBase +) where + +import Data.Array.IArray((!)) +import qualified Data.Array.IArray +import qualified Data.Char +import qualified Data.List +import qualified Data.Maybe + +-- | Characters used to represent the digits of numbers in @(-36 <= base <= 36)@. +digits :: String +digits = ['0' .. '9'] ++ ['a' .. 'z'] + +-- | Constant random-access lookup for 'digits'. +encodes :: (Data.Array.IArray.Ix index, Integral index) => Data.Array.IArray.Array index Char +encodes = Data.Array.IArray.listArray (0, pred $ Data.List.genericLength digits) digits + +-- | Constant reverse-lookup for 'digits'. +decodes :: Integral i => [(Char, i)] +decodes = zip digits [0 ..] + +{- | + * Convert the specified integral quantity, to an alternative base, and represent the result as a 'String'. + + * Both negative integers and negative bases are permissible. + + * The conversion to 'Char' can only succeed where printable and intelligible characters exist to represent all digits in the chosen base; + which in practice means @(-36 <= base <= 36)@. +-} +toBase :: ( + Data.Array.IArray.Ix decimal, + Integral base, + Integral decimal, + Show base, + Show decimal + ) => base -> decimal -> String +toBase 10 decimal = show decimal -- Base unchanged. +toBase _ 0 = "0" -- Zero has the same representation in any base. +toBase base decimal + | abs base < 2 = error $ "Factory.Math.Radix.toBase:\tan arbitrary integer can't be represented in base " ++ show base + | abs base > Data.List.genericLength digits = error $ "Factory.Math.Radix.toBase:\tunable to clearly represent the complete set of digits in base " ++ show base + | base > 0 && decimal < 0 = '-' : map toDigit (fromDecimal (negate decimal) []) + | otherwise = toDigit `map` fromDecimal decimal [] + where + fromDecimal 0 = id + fromDecimal n + | remainder < 0 = fromDecimal (succ quotient) . ((remainder - fromIntegral base) :) -- This can only occur when base is negative; cf. 'divMod'. + | otherwise = fromDecimal quotient . (remainder :) + where + (quotient, remainder) = n `quotRem` fromIntegral base + + toDigit :: (Data.Array.IArray.Ix i, Integral i, Show i) => i -> Char + toDigit n + | n >&< encodes = encodes ! n + | otherwise = error $ "Factory.Math.Radix.toBase.toDigit:\tno suitable character-representation for integer " ++ show n + where + (>&<) :: (Data.Array.IArray.Ix i, Integral i) => i -> Data.Array.IArray.Array i Char -> Bool + index >&< array = ($ index) `all` [(>= lower), (<= upper)] where + (lower, upper) = Data.Array.IArray.bounds array + +{- | + * Convert the 'String'-representation of a number in the specified base, to an integer. + + * Both negative numbers and negative bases are permissible. +-} +fromBase :: ( + Integral base, + Integral decimal, + Read decimal, + Show base + ) => base -> String -> decimal +fromBase 10 s = read s -- Base unchanged. +fromBase _ "0" = 0 -- Zero has the same representation in any base. +fromBase base s + | abs base < 2 = error $ "Factory.Math.Radix.fromBase:\tan arbitrary integer can't be represented in base " ++ show base + | abs base > Data.List.genericLength digits = error $ "Factory.Math.Radix.fromBase:\tunable to clearly represent the complete set of digits in base " ++ show base + | base > 0 && head s == '-' = negate . fromBase base $ tail s -- Recurse. + | otherwise = Data.List.foldl' (\l -> ((l * fromIntegral base) +) . fromDigit) 0 s where + fromDigit :: Integral i => Char -> i + fromDigit c = case c `lookup` decodes of + Just i + | i >= abs (fromIntegral base) -> error $ "Factory.Math.Radix.fromBase.fromDigit:\tillegal char " ++ show c ++ ", for base " ++ show base + | otherwise -> i + _ -> error $ "Factory.Math.Radix.fromBase.fromDigit:\tunrecognised char " ++ show c + +{- | + * . + + * . +-} +digitSum :: ( + Data.Array.IArray.Ix decimal, + Integral base, + Integral decimal, + Show base, + Show decimal + ) => base -> decimal -> decimal +digitSum 10 = fromIntegral . foldr ((+) . Data.Char.digitToInt) 0 . show +digitSum base = sum . Data.Maybe.mapMaybe (`lookup` decodes) . toBase base + +-- | . +digitalRoot :: ( + Data.Array.IArray.Ix decimal, + Integral decimal, + Show decimal + ) => decimal -> decimal +digitalRoot = until (<= 9) (digitSum (10 :: Int)) + diff --git a/src-lib/Factory/Math/SquareRoot.hs b/src-lib/Factory/Math/SquareRoot.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/SquareRoot.hs @@ -0,0 +1,120 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * Exports a common interface for /square-root/ implementations. + + * Provides utilities for these implementations. +-} + +module Factory.Math.SquareRoot( +-- * Type-classes + Algorithmic(..), + Iterator(..), +-- * Types +-- ** Type-synonyms + Result, + Estimate, +-- * Functions + getAccuracy, + getDiscrepancy, + getEstimate, +-- rSqrt, +-- ** Predicates + isPrecise +) where + +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.Precision as Math.Precision + +-- | The result-type; actually, only the concrete return-type of 'Math.Precision.simplify', stops it being a polymorphic instance of 'Fractional'. +type Result = Rational + +-- | Contains an estimate for the /square-root/ of a value, and its accuracy. +type Estimate = (Result, Math.Precision.DecimalDigits) + +-- | Defines the methods expected of a /square-root/ algorithm. +class Algorithmic algorithm where + squareRootFrom :: (Real operand, Show operand) + => algorithm + -> Estimate -- ^ An initial estimate from which to start. + -> Math.Precision.DecimalDigits -- ^ The required precision. + -> operand -- ^ The value for which to find the /square-root/. + -> Result -- ^ Returns an improved estimate of the /square-root/, found using the specified algorithm, accurate to at least the required number of decimal digits. + + squareRoot :: (Real operand, Show operand) + => algorithm + -> Math.Precision.DecimalDigits -- ^ The required precision. + -> operand -- ^ The value for which to find the /square-root/. + -> Result -- ^ Returns an estimate of the /square-root/, found using the specified algorithm, accurate to at least the required number of decimal digits. + squareRoot algorithm decimalDigits operand = squareRootFrom algorithm (getEstimate operand) decimalDigits operand -- Default implementation + +-- | The interface required to iterate, from an estimate of the required value, to the next approximation. +class Iterator algorithm where + step :: Real operand + => algorithm + -> operand -- ^ The value for which the /square-root/ is required; @y@. + -> Result -- ^ The current estimate; @x(n)@. + -> Result -- ^ An improved estimate; @x(n+1)@. + + convergenceOrder :: algorithm -> Math.Precision.ConvergenceOrder -- ^ The ultimate ratio of successive terms as the iteration converges. + +-- | Generalise 'sqrt' to operate on any 'Real' operand. +rSqrt :: Real operand => operand -> Double +rSqrt = sqrt . realToFrac + +-- | Uses 'Double'-precision floating-point arithmetic, to obtain an initial estimate for the /square-root/, and its accuracy. +getEstimate :: (Real operand, Show operand) => operand -> Estimate +getEstimate y + | y < 0 = error $ "Factory.Math.SquareRoot.getEstimate:\tthere's no real square-root of " ++ show y + | otherwise = (Math.Precision.simplify decimalDigits {-doubles performance by roughly length of the Rational representation-} . toRational $ rSqrt y, decimalDigits) + where + decimalDigits :: Math.Precision.DecimalDigits + decimalDigits = 16 -- . + +{- | + * The signed difference between the /square/ of an estimate for the /square-root/ of a value, and that value. + + * Positive when the estimate is too low. + + * CAVEAT: the magnitude is twice the error in the /square-root/. +-} +getDiscrepancy :: Real operand => operand -> Result -> Result +getDiscrepancy y x = toRational y - Math.Power.square x + +-- | True if the specified estimate for the /square-root/, is precise. +isPrecise :: Real operand => operand -> Result -> Bool +isPrecise y x = getDiscrepancy y x == 0 + +{- | + * For a given value and an estimate of its /square-root/, + returns the number of decimals digits to which the /square-root/ is accurate; including the integral digits. + + * CAVEAT: the result returned for an exact match has been bodged. +-} +getAccuracy :: Real operand => operand -> Result -> Math.Precision.DecimalDigits +getAccuracy y x + | absoluteError == 0 = maxBound -- Bodge. +-- | otherwise = length . takeWhile (< 1) $ iterate (* 10) relativeError -- CAVEAT: too slow. + | otherwise = length $ show (round $ toRational y / absoluteError :: Integer) + where + absoluteError :: Result + absoluteError = abs (getDiscrepancy y x) / 2 -- NB: the magnitude of the error in 'y', is twice the error in its square-root, 'x'. + diff --git a/src-lib/Factory/Math/Statistics.hs b/src-lib/Factory/Math/Statistics.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Statistics.hs @@ -0,0 +1,181 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Miscellaneous statistics functions. +-} + +module Factory.Math.Statistics( +-- * Functions + getMean, + getWeightedMean, +-- getDispersionFromMean, + getVariance, + getStandardDeviation, + getAverageAbsoluteDeviation, + getCoefficientOfVariance, + nCr, + nPr +) where + +import Control.Arrow((***)) +import Control.Parallel(par, pseq) +import qualified Data.Foldable +import qualified Data.List +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial +import qualified Factory.Math.Power as Math.Power + +{- | + * Determines the /mean/ of the specified numbers; . + + * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. +-} +getMean :: ( + Data.Foldable.Foldable foldable, + Fractional result, + Real value + ) + => foldable value + -> result +getMean foldable + | denominator == 0 = error "Factory.Math.Statistics.getMean:\tno data => undefined result." + | otherwise = realToFrac numerator / fromIntegral denominator + where + (numerator, denominator) = Data.Foldable.foldr (\s -> (+ s) *** succ) (0, 0 :: Int) foldable + +{- | + * Determines the /weighted mean/ of the specified numbers; . + + * The specified value is only evaluated if the corresponding weight is non-zero. + + * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. +-} +getWeightedMean :: ( + Data.Foldable.Foldable foldable, + Fractional result, + Real value, + Real weight + ) + => foldable (value, weight) -- ^ Each pair consists of a value & the corresponding weight. + -> result +getWeightedMean foldable + | denominator == 0 = error "Factory.Math.Statistics.getWeightedMean:\tzero weight => undefined result." + | otherwise = numerator / realToFrac denominator + where + (numerator, denominator) = Data.Foldable.foldr ( + \(value, weight) -> if weight == 0 + then id --Avoid unnecessarily evaluation. + else (+ realToFrac value * realToFrac weight) *** (+ weight) + ) (0, 0) foldable + +{- | + * Measures the /dispersion/ of a /population/ of results from the /mean/ value; . + + * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. +-} +getDispersionFromMean :: ( + Data.Foldable.Foldable foldable, + Fractional result, + Functor foldable, + Real value + ) => (Rational -> Rational) -> foldable value -> result +getDispersionFromMean weight foldable = getMean $ fmap (weight . (+ negate mean) . toRational) foldable where + mean :: Rational + mean = getMean foldable + +{- | + * Determines the exact /variance/ of the specified numbers; . + + * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. +-} +getVariance :: ( + Data.Foldable.Foldable foldable, + Fractional variance, + Functor foldable, + Real value + ) => foldable value -> variance +getVariance = getDispersionFromMean Math.Power.square + +-- | Determines the /standard-deviation/ of the specified numbers; . +getStandardDeviation :: ( + Data.Foldable.Foldable foldable, + Floating result, + Functor foldable, + Real value + ) => foldable value -> result +getStandardDeviation = sqrt . getVariance + +{- | + * Determines the /average absolute deviation/ of the specified numbers; . + + * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. +-} +getAverageAbsoluteDeviation :: ( + Data.Foldable.Foldable foldable, + Fractional result, + Functor foldable, + Real value + ) => foldable value -> result +getAverageAbsoluteDeviation = getDispersionFromMean abs + +-- | Determines the /coefficient-of-variance/ of the specified numbers; . +getCoefficientOfVariance :: ( + Data.Foldable.Foldable foldable, + Eq result, + Floating result, + Functor foldable, + Real value + ) => foldable value -> result +getCoefficientOfVariance l + | mean == 0 = error "Factory.Math.Statistics.getCoefficientOfVariance:\tundefined if mean is zero." + | otherwise = getStandardDeviation l / abs mean + where + mean = getMean l + +-- | The number of unordered /combinations/ of /r/ objects taken from /n/; . +nCr :: (Math.Factorial.Algorithmic factorialAlgorithm, Integral i, Show i) + => factorialAlgorithm + -> i -- ^ The total number of items from which to select. + -> i -- ^ The number of items in a sample. + -> i -- ^ The number of combinations. +nCr _ 0 _ = 1 +nCr _ _ 0 = 1 +nCr factorialAlgorithm n r + | n < 0 = error $ "Factory.Math.Statistics.nCr:\tinvalid n; " ++ show n + | r < 0 = error $ "Factory.Math.Statistics.nCr:\tinvalid r; " ++ show r + | n < r = 0 + | otherwise = numerator `par` (denominator `pseq` numerator `div` denominator) + where + [smaller, bigger] = Data.List.sort [r, n - r] + numerator = Math.Implementations.Factorial.risingFactorial (succ bigger) (n - bigger) + denominator = Math.Factorial.factorial factorialAlgorithm smaller + +-- | The number of /permutations/ of /r/ objects taken from /n/; . +nPr :: (Integral i, Show i) + => i -- ^ The total number of items from which to select. + -> i -- ^ The number of items in a sample. + -> i -- ^ The number of permutations. +nPr 0 _ = 1 +nPr _ 0 = 1 +nPr n r + | n < 0 = error $ "Factory.Math.Statistics.nPr:\tinvalid n; " ++ show n + | r < 0 = error $ "Factory.Math.Statistics.nPr:\tinvalid r; " ++ show r + | n < r = 0 + | otherwise = Math.Implementations.Factorial.fallingFactorial n r + diff --git a/src-lib/Factory/Math/Summation.hs b/src-lib/Factory/Math/Summation.hs new file mode 100644 --- /dev/null +++ b/src-lib/Factory/Math/Summation.hs @@ -0,0 +1,91 @@ +{- + Copyright (C) 2011 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Provides an alternative algorithm for the summation of /rational/ numbers. +-} + +module Factory.Math.Summation( +-- * Functions + sum', + sumR', + sumR +) where + +import qualified Control.DeepSeq +import qualified Control.Parallel.Strategies +import qualified Data.List +import qualified Data.Ratio +import Data.Ratio((%)) +import qualified ToolShed.Data.List + +{- | + * Sums a list of numbers of arbitrary type. + + * Sparks the summation of @(list-length / chunk-size)@ chunks from the list, each of the specified size (thought the last chunk may be smaller), + then recursively sums the list of results from each spark. + + * CAVEAT: unless the numbers are large, 'Rational' (requiring /cross-multiplication/), or the list long, + 'sum' is too light-weight for sparking to be productive, + therefore it is more likely to be the parallelised deep /evaluation/ of list-elements which saves time. +-} +sum' :: (Num n, Control.DeepSeq.NFData n) + => ToolShed.Data.List.ChunkLength + -> [n] + -> n +sum' chunkLength + | chunkLength <= 1 = error $ "Factory.Math.Summation.sum':\tinvalid chunk-size; " ++ show chunkLength + | otherwise = slave + where + slave :: (Num n, Control.DeepSeq.NFData n) => [n] -> n + slave [] = 0 + slave [x] = x + slave l = slave {-recurse-} . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq sum $ ToolShed.Data.List.chunk chunkLength l + +{- | + * Sums a list of /rational/ type numbers. + + * CAVEAT: though faster than 'Data.List.sum', this algorithm has poor space-complexity, making it unsuitable for unrestricted use. +-} +{-# INLINE sumR' #-} -- This makes a staggering difference. +sumR' :: Integral i => [Data.Ratio.Ratio i] -> Data.Ratio.Ratio i +sumR' l = foldr (\ratio -> ((Data.Ratio.numerator ratio * (commonDenominator `div` Data.Ratio.denominator ratio)) +)) 0 l % commonDenominator where +-- commonDenominator = foldr (lcm . Data.Ratio.denominator) 1 l + commonDenominator = Data.List.foldl' (\multiple -> lcm multiple . Data.Ratio.denominator) 1 l -- Slightly faster. + +{- | + * Sums a list of /rational/ numbers. + + * Sparks the summation of @(list-length / chunk-length)@ chunks from the list, each of the specified size (thought the last chunk may be smaller), + then recursively sums the list of results from each spark. + + * CAVEAT: memory-use is proportional to chunk-size. +-} +{-# INLINE sumR #-} -- This makes a staggering difference to calls from other modules. +sumR :: (Integral i, Control.DeepSeq.NFData i) + => ToolShed.Data.List.ChunkLength + -> [Data.Ratio.Ratio i] + -> Data.Ratio.Ratio i +sumR chunkLength + | chunkLength <= 1 = error $ "Factory.Math.Summation.sumR:\tinvalid chunk-size; " ++ show chunkLength + | otherwise = slave + where + slave :: (Integral i, Control.DeepSeq.NFData i) => [Data.Ratio.Ratio i] -> Data.Ratio.Ratio i + slave l + | length l <= chunkLength = sumR' l + | otherwise = slave {-recurse-} . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq sumR' $ ToolShed.Data.List.chunk chunkLength l diff --git a/src-test/Factory/Test/QuickCheck/ArithmeticGeometricMean.hs b/src-test/Factory/Test/QuickCheck/ArithmeticGeometricMean.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/ArithmeticGeometricMean.hs @@ -0,0 +1,57 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.ArithmeticGeometricMean". +-} + +module Factory.Test.QuickCheck.ArithmeticGeometricMean( +-- * Constants + results, +-- * Types +-- ** Type-synonyms +-- Testable +) where + +import qualified Data.Tuple +import qualified Factory.Math.ArithmeticGeometricMean as Math.ArithmeticGeometricMean +import qualified Factory.Math.Implementations.SquareRoot as Math.Implementations.SquareRoot +import qualified Factory.Math.Precision as Math.Precision +import Factory.Test.QuickCheck.SquareRoot() +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +type Testable = Math.Implementations.SquareRoot.Algorithm -> Math.Precision.DecimalDigits -> Math.ArithmeticGeometricMean.AGM -> Int -> Test.QuickCheck.Property + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [prop_symmetrical, prop_bounds] where + prop_symmetrical, prop_bounds :: Testable + prop_symmetrical squareRootAlgorithm decimalDigits agm index = Math.ArithmeticGeometricMean.isValid agm ==> Test.QuickCheck.label "prop_symmetrical" . and . tail . take index' $ zipWith (==) ( + Math.ArithmeticGeometricMean.convergeToAGM squareRootAlgorithm decimalDigits' agm + ) ( + Math.ArithmeticGeometricMean.convergeToAGM squareRootAlgorithm decimalDigits' $ Data.Tuple.swap agm + ) where + decimalDigits' = succ $ decimalDigits `mod` 64 + index' = succ $ index `mod` 8 + + prop_bounds squareRootAlgorithm decimalDigits agm index = all ($ agm) [Math.ArithmeticGeometricMean.isValid, uncurry (/=)] ==> Test.QuickCheck.label "prop_bounds" . all (uncurry (>=)) . tail . take index' $ Math.ArithmeticGeometricMean.convergeToAGM squareRootAlgorithm decimalDigits' agm + where + decimalDigits' = 33 {-test is sensitive to rounding-errors-} + (decimalDigits `mod` 96) + index' = succ $ index `mod` 5 + diff --git a/src-test/Factory/Test/QuickCheck/Factorial.hs b/src-test/Factory/Test/QuickCheck/Factorial.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Factorial.hs @@ -0,0 +1,75 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Implementations.Factorial". +-} + +module Factory.Test.QuickCheck.Factorial( +-- * Constants + results, +-- * Types +-- ** Type-synonyms +-- Testable +) where + +import Data.Ratio((%)) +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial +import Factory.Math.Implementations.Factorial((!/!)) +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +instance Test.QuickCheck.Arbitrary Math.Implementations.Factorial.Algorithm where + arbitrary = Test.QuickCheck.elements [Math.Implementations.Factorial.Bisection, Math.Implementations.Factorial.PrimeFactorisation] + +type Testable = Integer -> Integer -> Test.QuickCheck.Property + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_equivalence, + Test.QuickCheck.quickCheckResult prop_symmetry, + Test.QuickCheck.quickCheckResult prop_x0, + Test.QuickCheck.quickCheckResult prop_0n, + Test.QuickCheck.quickCheckResult prop_ratio, + Test.QuickCheck.quickCheckResult prop_consistency + ] where + prop_equivalence, prop_symmetry, prop_x0, prop_0n :: Testable + prop_equivalence x n = Test.QuickCheck.label "prop_equivalence" $ Math.Implementations.Factorial.risingFactorial x n == sign * Math.Implementations.Factorial.fallingFactorial (negate x) n && Math.Implementations.Factorial.fallingFactorial x n == sign * Math.Implementations.Factorial.risingFactorial (negate x) n where + sign :: Integer + sign + | even n = 1 + | otherwise = negate 1 + + prop_symmetry x n = Test.QuickCheck.label "prop_symmetry" $ Math.Implementations.Factorial.risingFactorial x n == Math.Implementations.Factorial.fallingFactorial (pred $ x + n) n + + prop_x0 x _ = Test.QuickCheck.label "prop_x0" $ all (== 1) $ map ($ 0) [Math.Implementations.Factorial.risingFactorial x, Math.Implementations.Factorial.fallingFactorial x] + + prop_0n _ n = Test.QuickCheck.label "prop_0n" $ all (== if n == 0 then 1 else 0) $ map ($ n) [Math.Implementations.Factorial.risingFactorial 0, Math.Implementations.Factorial.fallingFactorial 0] + + prop_ratio :: Math.Implementations.Factorial.Algorithm -> Integer -> Integer -> Test.QuickCheck.Property + prop_ratio algorithm i j = Test.QuickCheck.label "prop_ratio" $ n !/! d == Math.Factorial.factorial algorithm n % Math.Factorial.factorial algorithm d where + n = pred $ i `mod` 100000 + d = pred $ j `mod` 100000 + + prop_consistency :: Math.Implementations.Factorial.Algorithm -> Math.Implementations.Factorial.Algorithm -> Integer -> Test.QuickCheck.Property + prop_consistency l r i = l /= r ==> Test.QuickCheck.label "prop_consistency" $ Math.Factorial.factorial l n == Math.Factorial.factorial r n where + n = pred $ i `mod` 100000 + diff --git a/src-test/Factory/Test/QuickCheck/Hyperoperation.hs b/src-test/Factory/Test/QuickCheck/Hyperoperation.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Hyperoperation.hs @@ -0,0 +1,79 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Hyperoperation". +-} + +module Factory.Test.QuickCheck.Hyperoperation( +-- * Constants + results +) where + +import qualified Factory.Math.Hyperoperation as Math.Hyperoperation +import qualified Test.QuickCheck + +type Rank = Int + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_rankCoincides, + Test.QuickCheck.quickCheckResult prop_baseCoincides, + Test.QuickCheck.quickCheckResult prop_hyperExponentCoincides, + Test.QuickCheck.quickCheckResult prop_succ, + Test.QuickCheck.quickCheckResult prop_addition, + Test.QuickCheck.quickCheckResult prop_multiplication, + Test.QuickCheck.quickCheckResult prop_exponentiation + ] where + prop_rankCoincides :: Rank -> Test.QuickCheck.Property + prop_rankCoincides rank = Test.QuickCheck.label "prop_rankCoincides" $ Math.Hyperoperation.hyperoperation rank' 2 2 == 4 where + rank' :: Rank + rank' = succ $ rank `mod` 1000 + + prop_baseCoincides :: Rank -> Integer -> Test.QuickCheck.Property + prop_baseCoincides rank base = Test.QuickCheck.label "prop_baseCoincides" $ Math.Hyperoperation.hyperoperation rank' base 1 == base where + rank' :: Rank + rank' = 2 + (rank `mod` 1000) + + prop_hyperExponentCoincides :: Rank -> Integer -> Test.QuickCheck.Property + prop_hyperExponentCoincides rank hyperExponent = Test.QuickCheck.label "prop_hyperExponentCoincides" $ Math.Hyperoperation.hyperoperation rank' 1 hyperExponent' == 1 where + rank' :: Rank + rank' = 3 + (rank `mod` 1000) + + hyperExponent' :: Math.Hyperoperation.HyperExponent + hyperExponent' = abs hyperExponent + + prop_succ, prop_addition, prop_multiplication, prop_exponentiation :: Integer -> Integer -> Test.QuickCheck.Property + prop_succ base hyperExponent = Test.QuickCheck.label "prop_succ" $ Math.Hyperoperation.hyperoperation Math.Hyperoperation.succession base hyperExponent' == succ (fromIntegral hyperExponent') where + hyperExponent' :: Math.Hyperoperation.HyperExponent + hyperExponent' = abs hyperExponent + + prop_addition base hyperExponent = Test.QuickCheck.label "prop_addition" $ Math.Hyperoperation.hyperoperation Math.Hyperoperation.addition base hyperExponent' == base + fromIntegral hyperExponent' where + hyperExponent' :: Math.Hyperoperation.HyperExponent + hyperExponent' = abs hyperExponent + + prop_multiplication base hyperExponent = Test.QuickCheck.label "prop_multiplication" $ Math.Hyperoperation.hyperoperation Math.Hyperoperation.multiplication base hyperExponent' == base * fromIntegral hyperExponent' where + hyperExponent' :: Math.Hyperoperation.HyperExponent + hyperExponent' = abs hyperExponent + + prop_exponentiation base hyperExponent = Test.QuickCheck.label "prop_exponentiation" $ Math.Hyperoperation.hyperoperation Math.Hyperoperation.exponentiation base hyperExponent' == base ^ hyperExponent' where + hyperExponent' :: Math.Hyperoperation.HyperExponent + hyperExponent' = abs hyperExponent + + diff --git a/src-test/Factory/Test/QuickCheck/Interval.hs b/src-test/Factory/Test/QuickCheck/Interval.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Interval.hs @@ -0,0 +1,43 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Data.Interval". +-} + +module Factory.Test.QuickCheck.Interval( +-- * Constants + results +) where + +import qualified Data.Ratio +import qualified Factory.Data.Interval as Data.Interval +import qualified Test.QuickCheck + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 1000 } `mapM` [prop_product] where + prop_product :: Data.Ratio.Ratio Integer -> Integer -> Data.Interval.Interval Integer -> Test.QuickCheck.Property + prop_product ratio minLength interval = Test.QuickCheck.label "prop_product" $ Data.Interval.product' ratio' minLength' interval' == product (Data.Interval.toList interval') where + interval' = Data.Interval.normalise interval + minLength' = succ $ minLength `mod` 1000 + ratio' + | r > 1 = recip r + | otherwise = r + where + r = abs ratio diff --git a/src-test/Factory/Test/QuickCheck/MonicPolynomial.hs b/src-test/Factory/Test/QuickCheck/MonicPolynomial.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/MonicPolynomial.hs @@ -0,0 +1,77 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Data.MonicPolynomial". +-} + +module Factory.Test.QuickCheck.MonicPolynomial( +-- * Constants + results, +-- * Types +-- ** Type-synonyms +-- P +) where + +import Factory.Data.Ring((=*=), (=+=), (=^)) +import Factory.Test.QuickCheck.Polynomial() +import qualified Factory.Data.MonicPolynomial as Data.MonicPolynomial +import qualified Factory.Data.Polynomial as Data.Polynomial +import qualified Factory.Data.QuotientRing as Data.QuotientRing +import qualified Factory.Data.Ring as Data.Ring +import qualified Test.QuickCheck + +instance ( + Integral c, + Integral e, + Test.QuickCheck.Arbitrary c, + Test.QuickCheck.Arbitrary e, + Show c, + Show e + ) => Test.QuickCheck.Arbitrary (Data.MonicPolynomial.MonicPolynomial c e) where + arbitrary = do + polynomial <- Test.QuickCheck.arbitrary + + return {-to Gen-monad-} . Data.MonicPolynomial.mkMonicPolynomial $ ((1, succ $ Data.Polynomial.getDegree polynomial) :) `Data.Polynomial.lift` polynomial + +type P = Data.MonicPolynomial.MonicPolynomial Integer Integer + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_quotRem, + Test.QuickCheck.quickCheckResult prop_quotientRingNormalised, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 50 } prop_perfectPower, + Test.QuickCheck.quickCheckResult prop_isDivisibleBy + ] where + prop_quotRem, prop_quotientRingNormalised :: P -> P -> Test.QuickCheck.Property + prop_quotRem numerator denominator = Test.QuickCheck.label "prop_quotRem" $ numerator == denominator =*= quotient =+= remainder where + (quotient, remainder) = numerator `Data.QuotientRing.quotRem'` denominator + + prop_quotientRingNormalised numerator denominator = Test.QuickCheck.label "prop_quotientRingNormalised" $ all (Data.Polynomial.isNormalised . Data.MonicPolynomial.getPolynomial) [numerator `Data.QuotientRing.quot'` denominator, numerator `Data.QuotientRing.rem'` denominator] + + prop_perfectPower :: P -> Int -> Test.QuickCheck.Property + prop_perfectPower polynomial power = Test.QuickCheck.label "prop_perfectPower" $ iterate (`Data.QuotientRing.quot'` polynomial) (polynomial =^ power') !! pred power' == polynomial where + power' :: Int + power' = succ $ power `mod` 100 + + prop_isDivisibleBy :: [P] -> Test.QuickCheck.Property + prop_isDivisibleBy monicPolynomials = Test.QuickCheck.label "prop_isDivisibleBy" $ all (Data.QuotientRing.isDivisibleBy (Data.Ring.product' (recip 2) {-TODO-} 10 monicPolynomials)) monicPolynomials + + diff --git a/src-test/Factory/Test/QuickCheck/PerfectPower.hs b/src-test/Factory/Test/QuickCheck/PerfectPower.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/PerfectPower.hs @@ -0,0 +1,55 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.PerfectPower". +-} + +module Factory.Test.QuickCheck.PerfectPower( +-- * Constants + results +) where + +import qualified Data.Maybe +import qualified Factory.Math.PerfectPower as Math.PerfectPower +import qualified Factory.Math.Power as Math.Power +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_maybeSquareNumber, + Test.QuickCheck.quickCheckResult prop_rewriteRule, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 10000 } prop_notSquare, + Test.QuickCheck.quickCheckResult prop_isPerfectPower + ] where + prop_maybeSquareNumber, prop_notSquare, prop_rewriteRule :: Integer -> Test.QuickCheck.Property + prop_maybeSquareNumber i = Test.QuickCheck.label "prop_maybeSquareNumber" $ Math.PerfectPower.maybeSquareNumber (Math.Power.square i) == Just (abs i) + + prop_notSquare i = abs i > 0 ==> Test.QuickCheck.label "prop_notSquare" . Data.Maybe.isNothing $ Math.PerfectPower.maybeSquareNumber (succ $ i ^ (10 {-promote rounding-error using big number-} :: Int)) + + prop_rewriteRule i = Test.QuickCheck.label "prop_rewriteRule" $ Math.PerfectPower.isPerfectPower i' == Math.PerfectPower.isPerfectPower (fromIntegral i' :: Int) where + i' = abs i + + prop_isPerfectPower :: Integer -> Integer -> Test.QuickCheck.Property + prop_isPerfectPower b e = Test.QuickCheck.label "prop_isPerfectPower" . Math.PerfectPower.isPerfectPower $ b' ^ e' where + b' = 2 + (b `mod` 10) + e' = 2 + (e `mod` 8) + + diff --git a/src-test/Factory/Test/QuickCheck/Pi.hs b/src-test/Factory/Test/QuickCheck/Pi.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Pi.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Pi". +-} + +module Factory.Test.QuickCheck.Pi( +-- * Constants + results, +-- * Types +-- ** Type-synonyms +-- Testable +) where + +import Factory.Test.QuickCheck.Factorial() +import Factory.Test.QuickCheck.SquareRoot() +import qualified Factory.Math.Factorial as Math.Factorial +import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial +import qualified Factory.Math.Implementations.Pi.AGM.Algorithm as Math.Implementations.Pi.AGM.Algorithm +import qualified Factory.Math.Implementations.Pi.BBP.Algorithm as Math.Implementations.Pi.BBP.Algorithm +import qualified Factory.Math.Implementations.Pi.Borwein.Algorithm as Math.Implementations.Pi.Borwein.Algorithm +import qualified Factory.Math.Implementations.Pi.Ramanujan.Algorithm as Math.Implementations.Pi.Ramanujan.Algorithm +import qualified Factory.Math.Implementations.Pi.Spigot.Algorithm as Math.Implementations.Pi.Spigot.Algorithm +import qualified Factory.Math.Implementations.SquareRoot as Math.Implementations.SquareRoot +import qualified Factory.Math.Pi as Math.Pi +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.SquareRoot as Math.SquareRoot +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative((<$>), (<*>)) +#endif + +instance ( + Test.QuickCheck.Arbitrary squareRootAlgorithm, + Math.SquareRoot.Algorithmic squareRootAlgorithm + ) => Test.QuickCheck.Arbitrary (Math.Implementations.Pi.AGM.Algorithm.Algorithm squareRootAlgorithm) where + arbitrary = Math.Implementations.Pi.AGM.Algorithm.BrentSalamin <$> Test.QuickCheck.arbitrary + +instance Test.QuickCheck.Arbitrary Math.Implementations.Pi.BBP.Algorithm.Algorithm where + arbitrary = Test.QuickCheck.elements [Math.Implementations.Pi.BBP.Algorithm.Bellard, Math.Implementations.Pi.BBP.Algorithm.Base65536] + +instance ( + Test.QuickCheck.Arbitrary squareRootAlgorithm, + Math.SquareRoot.Algorithmic squareRootAlgorithm, + Test.QuickCheck.Arbitrary factorialAlgorithm, + Math.Factorial.Algorithmic factorialAlgorithm + ) => Test.QuickCheck.Arbitrary (Math.Implementations.Pi.Borwein.Algorithm.Algorithm squareRootAlgorithm factorialAlgorithm) where + arbitrary = Test.QuickCheck.oneof [ + Math.Implementations.Pi.Borwein.Algorithm.Borwein1993 <$> Test.QuickCheck.arbitrary <*> Test.QuickCheck.arbitrary + ] + +instance ( + Test.QuickCheck.Arbitrary squareRootAlgorithm, + Math.SquareRoot.Algorithmic squareRootAlgorithm, + Test.QuickCheck.Arbitrary factorialAlgorithm, + Math.Factorial.Algorithmic factorialAlgorithm + ) => Test.QuickCheck.Arbitrary (Math.Implementations.Pi.Ramanujan.Algorithm.Algorithm squareRootAlgorithm factorialAlgorithm) where + arbitrary = Test.QuickCheck.oneof [ + Math.Implementations.Pi.Ramanujan.Algorithm.Classic <$> Test.QuickCheck.arbitrary <*> Test.QuickCheck.arbitrary, + Math.Implementations.Pi.Ramanujan.Algorithm.Chudnovsky <$> Test.QuickCheck.arbitrary <*> Test.QuickCheck.arbitrary + ] + +instance Test.QuickCheck.Arbitrary Math.Implementations.Pi.Spigot.Algorithm.Algorithm where + arbitrary = Test.QuickCheck.elements [Math.Implementations.Pi.Spigot.Algorithm.RabinowitzWagon, Math.Implementations.Pi.Spigot.Algorithm.Gosper] + +instance ( + Test.QuickCheck.Arbitrary agm, + Test.QuickCheck.Arbitrary bbp, + Test.QuickCheck.Arbitrary borwein, + Test.QuickCheck.Arbitrary ramanujan, + Test.QuickCheck.Arbitrary spigot + ) => Test.QuickCheck.Arbitrary (Math.Pi.Category agm bbp borwein ramanujan spigot) where + arbitrary = Test.QuickCheck.oneof [ + Math.Pi.AGM <$> Test.QuickCheck.arbitrary, + Math.Pi.BBP <$> Test.QuickCheck.arbitrary, + Math.Pi.Borwein <$> Test.QuickCheck.arbitrary, + Math.Pi.Ramanujan <$> Test.QuickCheck.arbitrary, + Math.Pi.Spigot <$> Test.QuickCheck.arbitrary + ] + +type Category = Math.Pi.Category ( + Math.Implementations.Pi.AGM.Algorithm.Algorithm Math.Implementations.SquareRoot.Algorithm + ) Math.Implementations.Pi.BBP.Algorithm.Algorithm ( + Math.Implementations.Pi.Borwein.Algorithm.Algorithm Math.Implementations.SquareRoot.Algorithm Math.Implementations.Factorial.Algorithm + ) ( + Math.Implementations.Pi.Ramanujan.Algorithm.Algorithm Math.Implementations.SquareRoot.Algorithm Math.Implementations.Factorial.Algorithm + ) Math.Implementations.Pi.Spigot.Algorithm.Algorithm + +type Testable = Category -> Category -> Math.Precision.DecimalDigits -> Test.QuickCheck.Property + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [prop_consistency] where + prop_consistency :: Testable + prop_consistency l r decimalDigits = l /= r ==> Test.QuickCheck.label "prop_consistency" $ Math.Pi.openI l decimalDigits' - Math.Pi.openI r decimalDigits' <= 1 {-rounding error-} where + decimalDigits' = succ $ decimalDigits `mod` 250 + diff --git a/src-test/Factory/Test/QuickCheck/Polynomial.hs b/src-test/Factory/Test/QuickCheck/Polynomial.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Polynomial.hs @@ -0,0 +1,122 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Data.Polynomial". +-} + +module Factory.Test.QuickCheck.Polynomial( +-- * Constants + results +) where + +import Control.Arrow((***)) +import Factory.Data.Ring((=*=), (=+=), (=-=), (=^)) +import qualified Data.Numbers.Primes +import qualified Factory.Data.Polynomial as Data.Polynomial +import qualified Factory.Data.QuotientRing as Data.QuotientRing +import qualified Factory.Data.Ring as Data.Ring +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +instance ( + Test.QuickCheck.Arbitrary c, + Integral c, + Test.QuickCheck.Arbitrary e, + Integral e + ) => Test.QuickCheck.Arbitrary (Data.Polynomial.Polynomial c e) where + arbitrary = (Data.Polynomial.mkPolynomial . map ((+ negate 4) . (`mod` 8) *** (`mod` 8))) `fmap` Test.QuickCheck.arbitrary + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_congruence, + Test.QuickCheck.quickCheckResult prop_quotRem, + Test.QuickCheck.quickCheckResult prop_degree, + Test.QuickCheck.quickCheckResult prop_ringNormalised, + Test.QuickCheck.quickCheckResult prop_quotientRingNormalised, + Test.QuickCheck.quickCheckResult prop_power, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 50 } prop_perfectPower, + Test.QuickCheck.quickCheckResult prop_normalised, + Test.QuickCheck.quickCheckResult prop_raiseModuloNormalised, + Test.QuickCheck.quickCheckResult prop_integralDomain, + Test.QuickCheck.quickCheckResult prop_isDivisibleBy + ] where + prop_congruence :: Int -> Test.QuickCheck.Property + prop_congruence i = Test.QuickCheck.label "prop_congruence" $ Data.Polynomial.areCongruentModulo (Data.Polynomial.mkLinear 1 (negate 1) =^ prime) (Data.Polynomial.mkPolynomial [(1, prime), (negate 1, 0)]) prime where + prime :: Integer + prime = Data.Numbers.Primes.primes !! mod i 100 + + prop_quotRem, prop_degree, prop_ringNormalised, prop_quotientRingNormalised :: Data.Polynomial.Polynomial Integer Integer -> Data.Polynomial.Polynomial Integer Integer -> Test.QuickCheck.Property + prop_quotRem numerator denominator = denominator' /= Data.Polynomial.zero ==> Test.QuickCheck.label "prop_quotRem" $ numerator' == denominator' =*= quotient =+= remainder where + numerator', denominator' :: Data.Polynomial.Polynomial Rational Integer + numerator' = Data.Polynomial.realCoefficientsToFrac numerator + denominator' = Data.Polynomial.realCoefficientsToFrac denominator + + (quotient, remainder) = numerator' `Data.QuotientRing.quotRem'` denominator' + + prop_degree numerator denominator = denominator' /= Data.Polynomial.zero ==> Test.QuickCheck.label "prop_degree" $ remainder == Data.Polynomial.zero || Data.Polynomial.getDegree remainder < Data.Polynomial.getDegree denominator' where + numerator', denominator' :: Data.Polynomial.Polynomial Rational Integer + numerator' = Data.Polynomial.realCoefficientsToFrac numerator + denominator' = Data.Polynomial.realCoefficientsToFrac denominator + + remainder = numerator' `Data.QuotientRing.rem'` denominator' + + prop_ringNormalised l r = Test.QuickCheck.label "prop_ringNormalised" $ all Data.Polynomial.isNormalised [l =*= r, l =+= r, l =-= r] + + prop_quotientRingNormalised numerator denominator = denominator' /= Data.Polynomial.zero ==> Test.QuickCheck.label "prop_quotientRingNormalised" $ all Data.Polynomial.isNormalised [numerator' `Data.QuotientRing.quot'` denominator', numerator' `Data.QuotientRing.rem'` denominator'] where + numerator', denominator' :: Data.Polynomial.Polynomial Rational Integer + numerator' = Data.Polynomial.realCoefficientsToFrac numerator + denominator' = Data.Polynomial.realCoefficientsToFrac denominator + + prop_power, prop_perfectPower, prop_normalised :: Data.Polynomial.Polynomial Integer Integer -> Int -> Test.QuickCheck.Property + prop_power polynomial power = Test.QuickCheck.label "prop_power" $ polynomial =^ power' == iterate (=*= polynomial) polynomial !! pred power' where + power' :: Int + power' = succ $ power `mod` 100 + + prop_perfectPower polynomial power = polynomial' /= Data.Polynomial.zero ==> Test.QuickCheck.label "prop_perfectPower" $ iterate (`Data.QuotientRing.quot'` polynomial') (polynomial' =^ power') !! pred power' == polynomial' where + polynomial' :: Data.Polynomial.Polynomial Rational Integer + polynomial' = Data.Polynomial.realCoefficientsToFrac polynomial + + power' :: Int + power' = succ $ power `mod` 100 + + prop_normalised polynomial i = Test.QuickCheck.label "prop_normalised" $ all Data.Polynomial.isNormalised [ + polynomial =^ power', + polynomial `Data.Polynomial.mod'` modulus' + ] where + power' :: Int + power' = succ $ i `mod` 100 + + modulus' :: Integer + modulus' = succ $ fromIntegral i `mod` 100 + + prop_raiseModuloNormalised :: Data.Polynomial.Polynomial Integer Integer -> Integer -> Integer -> Test.QuickCheck.Property + prop_raiseModuloNormalised polynomial power modulus = Test.QuickCheck.label "prop_raiseModuloNormalised" . Data.Polynomial.isNormalised $ Data.Polynomial.raiseModulo polynomial power' modulus' where + power', modulus' :: Integer + power' = succ $ power `mod` 100 + modulus' = succ $ modulus `mod` 100 + + prop_integralDomain, prop_isDivisibleBy :: [Data.Polynomial.Polynomial Integer Integer] -> Test.QuickCheck.Property + prop_integralDomain polynomials = Data.Polynomial.zero `notElem` polynomials ==> Test.QuickCheck.label "prop_integralDomain" $ Data.Ring.product' (recip 2) {-TODO-} 10 polynomials /= Data.Polynomial.zero + + prop_isDivisibleBy polynomials = Test.QuickCheck.label "prop_isDivisibleBy" . all (Data.QuotientRing.isDivisibleBy (Data.Ring.product' (recip 2) {-TODO-} 10 polynomials')) $ filter (/= Data.Polynomial.zero) polynomials' where + polynomials' :: [Data.Polynomial.Polynomial Rational Integer] + polynomials' = map Data.Polynomial.realCoefficientsToFrac polynomials + diff --git a/src-test/Factory/Test/QuickCheck/Power.hs b/src-test/Factory/Test/QuickCheck/Power.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Power.hs @@ -0,0 +1,47 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties "Math.Power". +-} + +module Factory.Test.QuickCheck.Power( +-- * Constants + results +) where + +import qualified Data.List +import qualified Factory.Math.Power as Math.Power +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_squaresFrom, + Test.QuickCheck.quickCheckResult prop_raiseModulo + ] where + prop_squaresFrom :: Integer -> Integer -> Test.QuickCheck.Property + prop_squaresFrom from l = Test.QuickCheck.label "prop_squaresFrom" . (\(x, y) -> y == Math.Power.square x) . Data.List.genericIndex (Math.Power.squaresFrom from) $ abs l + + prop_raiseModulo :: Integer -> Integer -> Integer -> Test.QuickCheck.Property + prop_raiseModulo b e m = m /= 0 ==> Test.QuickCheck.label "prop_raiseModulo" $ Math.Power.raiseModulo b e' m == (b ^ e') `mod` m where + e' :: Integer + e' = abs e + + diff --git a/src-test/Factory/Test/QuickCheck/Primality.hs b/src-test/Factory/Test/QuickCheck/Primality.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Primality.hs @@ -0,0 +1,72 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Math.Implementations.Primality". +-} + +module Factory.Test.QuickCheck.Primality( +-- * Constants + results +) where + +import Factory.Test.QuickCheck.PrimeFactorisation() +import qualified Data.List +import qualified Data.Numbers.Primes +import qualified Factory.Math.Implementations.Primality as Math.Implementations.Primality +import qualified Factory.Math.Implementations.PrimeFactorisation as Math.Implementations.PrimeFactorisation +import qualified Factory.Math.Primality as Math.Primality +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +instance Test.QuickCheck.Arbitrary factorisationAlgorithm => Test.QuickCheck.Arbitrary (Math.Implementations.Primality.Algorithm factorisationAlgorithm) where + arbitrary = Test.QuickCheck.oneof [ + Math.Implementations.Primality.AKS `fmap` Test.QuickCheck.arbitrary, + return {-to Gen-monad-} Math.Implementations.Primality.MillerRabin + ] + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 50 } prop_prime, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 50 } prop_composite, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 50 } prop_consistency + ] where + prop_prime :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm -> Integer -> Test.QuickCheck.Property + prop_prime primalityAlgorithm i = Test.QuickCheck.label "prop_prime" $ Math.Primality.isPrime primalityAlgorithm prime where + normalise n + | primalityAlgorithm == Math.Implementations.Primality.MillerRabin = n `mod` 1000000 -- Limited by the efficiency of 'Data.Numbers.Primes.primes'. + | otherwise = n `mod` 59 + + prime :: Integer + prime = Data.List.genericIndex Data.Numbers.Primes.primes $ normalise i + + prop_composite :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm -> [Integer] -> Test.QuickCheck.Property + prop_composite primalityAlgorithm l = length l > 1 ==> Test.QuickCheck.label "prop_composite" . not $ Math.Primality.isPrime primalityAlgorithm composite where + normalise n + | primalityAlgorithm == Math.Implementations.Primality.MillerRabin = n `mod` 1000000 + | otherwise = n `mod` 10 + + composite :: Integer + composite = product . map (Data.List.genericIndex Data.Numbers.Primes.primes . normalise) $ take 8 l + + prop_consistency :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm -> Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm -> Integer -> Test.QuickCheck.Property + prop_consistency l r i = l /= r ==> Test.QuickCheck.label "prop_consistency" $ Math.Primality.isPrime l i' == Math.Primality.isPrime r i' where + i' = i `mod` 512 + diff --git a/src-test/Factory/Test/QuickCheck/PrimeFactorisation.hs b/src-test/Factory/Test/QuickCheck/PrimeFactorisation.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/PrimeFactorisation.hs @@ -0,0 +1,100 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Math.PrimeFactorisation". +-} + +module Factory.Test.QuickCheck.PrimeFactorisation( +-- * Constants + results +) where + +import qualified Data.List +import qualified Data.Numbers.Primes +import qualified Factory.Data.PrimeFactors as Data.PrimeFactors +import qualified Factory.Data.Exponential as Data.Exponential +import qualified Factory.Math.Implementations.PrimeFactorisation as Math.Implementations.PrimeFactorisation +import qualified Factory.Math.MultiplicativeOrder as Math.MultiplicativeOrder +import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +instance Test.QuickCheck.Arbitrary Math.Implementations.PrimeFactorisation.Algorithm where + arbitrary = Test.QuickCheck.oneof [ + Test.QuickCheck.elements [ + Math.Implementations.PrimeFactorisation.TrialDivision, + Math.Implementations.PrimeFactorisation.FermatsMethod + ] + ] + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_consistency, + Test.QuickCheck.quickCheckResult prop_primeFactors, + Test.QuickCheck.quickCheckResult prop_smoothness, + Test.QuickCheck.quickCheckResult prop_eulersTotientP, + Test.QuickCheck.quickCheckResult prop_eulersTotientInequality, + Test.QuickCheck.quickCheckResult prop_eulersTotient, + Test.QuickCheck.quickCheckResult prop_lagrange, + Test.QuickCheck.quickCheckResult prop_multiplicativeOrder, + Test.QuickCheck.quickCheckResult prop_perfectPower + ] where + prop_consistency :: Integer -> Test.QuickCheck.Property + prop_consistency i = Test.QuickCheck.label "prop_consistency" $ (Math.PrimeFactorisation.primeFactors Math.Implementations.PrimeFactorisation.TrialDivision i' :: Data.PrimeFactors.Factors Integer Int) == Math.PrimeFactorisation.primeFactors Math.Implementations.PrimeFactorisation.FermatsMethod i' where + i' :: Integer + i' = succ $ i `mod` 1000000 + + prop_primeFactors, prop_smoothness, prop_eulersTotientP, prop_eulersTotientInequality :: Math.Implementations.PrimeFactorisation.Algorithm -> Integer -> Test.QuickCheck.Property + prop_primeFactors algorithm i = Test.QuickCheck.label "prop_primeFactors" $ Data.PrimeFactors.product' (recip 2) {-TODO-} 10 (Math.PrimeFactorisation.primeFactors algorithm i') == i' where + i' :: Integer + i' = succ $ i `mod` 1000000 + + prop_smoothness algorithm i = Test.QuickCheck.label "prop_smoothness" $ (Math.PrimeFactorisation.smoothness algorithm !! (2 ^ i')) <= (2 :: Integer) where + i' :: Integer + i' = i `mod` 20 + + prop_eulersTotientP algorithm i = Test.QuickCheck.label "prop_eulersTotientP" $ Math.PrimeFactorisation.eulersTotient algorithm prime == pred prime where + prime :: Integer + prime = Data.List.genericIndex Data.Numbers.Primes.primes (i `mod` 10000) + + prop_eulersTotientInequality algorithm i = i `notElem` [2, 6] ==> Test.QuickCheck.label "prop_eulersTotientInequality" $ Math.PrimeFactorisation.eulersTotient algorithm i' >= floor (sqrt $ fromIntegral i' :: Double) where + i' = succ $ i `mod` 100000 + + prop_eulersTotient, prop_lagrange, prop_multiplicativeOrder, prop_perfectPower :: Math.Implementations.PrimeFactorisation.Algorithm -> Integer -> Integer -> Test.QuickCheck.Property + prop_eulersTotient algorithm i power = Test.QuickCheck.label "prop_eulersTotient" $ Math.PrimeFactorisation.eulersTotient algorithm (base ^ power') == (base ^ pred power') * pred base where + base :: Integer + base = Data.List.genericIndex Data.Numbers.Primes.primes (i `mod` 8) + + power' = succ $ power `mod` 5 + + prop_lagrange algorithm base modulus = gcd base modulus' == 1 ==> Test.QuickCheck.label "prop_lagrange" $ (Math.PrimeFactorisation.eulersTotient algorithm modulus' `rem` Math.MultiplicativeOrder.multiplicativeOrder algorithm base modulus') == 0 where + modulus' :: Integer + modulus' = 2 + abs modulus + + prop_multiplicativeOrder algorithm base modulus = gcd base modulus' == 1 ==> Test.QuickCheck.label "prop_multiplicativeOrder" $ ( + base ^ Math.MultiplicativeOrder.multiplicativeOrder algorithm base modulus' + ) `mod` modulus' == 1 where + modulus' :: Integer + modulus' = 2 + abs modulus + + prop_perfectPower algorithm b e = Test.QuickCheck.label "prop_perfectPower" $ foldr1 gcd ( + map Data.Exponential.getExponent . Math.PrimeFactorisation.primeFactors algorithm $ (2 + b `mod` 10 :: Integer) ^ (2 + e `mod` 5) + ) > 1 diff --git a/src-test/Factory/Test/QuickCheck/Primes.hs b/src-test/Factory/Test/QuickCheck/Primes.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Primes.hs @@ -0,0 +1,101 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Math.Implementations.Primes". +-} + +module Factory.Test.QuickCheck.Primes( +-- * Constants +-- defaultAlgorithm, + results, +-- * Functions +-- isPrime, + upperBound +) where + +import qualified Control.DeepSeq +import qualified Data.Set +import qualified Factory.Data.PrimeWheel as Data.PrimeWheel +import qualified Factory.Math.Implementations.Primality as Math.Implementations.Primality +import qualified Factory.Math.Implementations.PrimeFactorisation as Math.Implementations.PrimeFactorisation +import qualified Factory.Math.Implementations.Primes.Algorithm as Math.Implementations.Primes.Algorithm +import qualified Factory.Math.Primality as Math.Primality +import qualified Factory.Math.Primes as Math.Primes +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) +import qualified ToolShed.Defaultable + +instance Test.QuickCheck.Arbitrary Math.Implementations.Primes.Algorithm.Algorithm where + arbitrary = Test.QuickCheck.oneof [ + return {-to Gen-monad-} Math.Implementations.Primes.Algorithm.TurnersSieve, + (Math.Implementations.Primes.Algorithm.TrialDivision . (`mod` 10)) `fmap` Test.QuickCheck.arbitrary, + (Math.Implementations.Primes.Algorithm.SieveOfEratosthenes . (`mod` 10)) `fmap` Test.QuickCheck.arbitrary + ] + +isPrime :: (Control.DeepSeq.NFData i, Integral i, Show i) => i -> Bool +isPrime = Math.Primality.isPrime primalityAlgorithm where + primalityAlgorithm :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm + primalityAlgorithm = ToolShed.Defaultable.defaultValue + +upperBound :: Math.Implementations.Primes.Algorithm.Algorithm -> Int -> Int +upperBound algorithm i = mod i $ if algorithm == Math.Implementations.Primes.Algorithm.TurnersSieve + then 8192 + else 65536 + +defaultAlgorithm :: Math.Implementations.Primes.Algorithm.Algorithm +defaultAlgorithm = ToolShed.Defaultable.defaultValue + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_isPrime, + Test.QuickCheck.quickCheckResult prop_isComposite, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 50 } prop_consistency, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 25 } prop_rewriteRule, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 25 } prop_sieveOfAtkin, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 25 } prop_sieveOfAtkinRewrite + ] where + prop_isPrime, prop_isComposite :: Math.Implementations.Primes.Algorithm.Algorithm -> Int -> Test.QuickCheck.Property + prop_isPrime algorithm i = Test.QuickCheck.label "prop_isPrime" . all isPrime . takeWhile (<= upperBound algorithm i) $ (Math.Primes.primes algorithm :: [Int]) + prop_isComposite algorithm i = Test.QuickCheck.label "prop_isComposite" . not . any isPrime . Data.Set.toList . Data.Set.difference ( + Data.Set.fromList [2 .. upperBound algorithm i] + ) . Data.Set.fromList . takeWhile (<= upperBound algorithm i) $ Math.Primes.primes algorithm + + prop_consistency :: Math.Implementations.Primes.Algorithm.Algorithm -> Math.Implementations.Primes.Algorithm.Algorithm -> Int -> Test.QuickCheck.Property + prop_consistency l r i = l /= r ==> Test.QuickCheck.label "prop_consistency" . and . take (i `mod` 4096) $ zipWith (==) (Math.Primes.primes l) (Math.Primes.primes r :: [Int]) + + prop_rewriteRule :: Data.PrimeWheel.NPrimes -> Int -> Test.QuickCheck.Property + prop_rewriteRule wheelSize i = Test.QuickCheck.label "prop_rewriteRule" $ toInteger (Math.Primes.primes (Math.Implementations.Primes.Algorithm.SieveOfEratosthenes wheelSize') !! index :: Int) == (Math.Primes.primes (Math.Implementations.Primes.Algorithm.SieveOfEratosthenes wheelSize') !! index :: Integer) where + wheelSize' = wheelSize `mod` 8 + index = i `mod` 131072 + + prop_sieveOfAtkin, prop_sieveOfAtkinRewrite :: Int -> Test.QuickCheck.Property + prop_sieveOfAtkin i = Test.QuickCheck.label "prop_sieveOfAtkin" $ Math.Primes.primes (Math.Implementations.Primes.Algorithm.SieveOfAtkin prime) !! index == prime where + index = i `mod` 131072 + + prime :: Integer + prime = Math.Primes.primes defaultAlgorithm !! index + + prop_sieveOfAtkinRewrite i = Test.QuickCheck.label "prop_sieveOfAtkinRewrite" $ Math.Primes.primes (Math.Implementations.Primes.Algorithm.SieveOfAtkin $ fromIntegral prime) !! index == prime where + index = i `mod` 131072 + + prime :: Int + prime = Math.Primes.primes defaultAlgorithm !! index + diff --git a/src-test/Factory/Test/QuickCheck/Probability.hs b/src-test/Factory/Test/QuickCheck/Probability.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Probability.hs @@ -0,0 +1,161 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Probability". +-} + +module Factory.Test.QuickCheck.Probability( +-- * Constants + results, +-- * Functions +-- normalise +) where + +import Control.Arrow((&&&)) +import qualified Data.List +import qualified Factory.Math.Probability as Math.Probability +import qualified Factory.Math.Statistics as Math.Statistics +import Factory.Test.QuickCheck.Factorial() +import qualified System.Random +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) +import qualified ToolShed.Data.Pair + +-- | Re-profile a distribution to achieve a standard mean & variance. +normalise :: ( + Eq f, + Floating f, + Math.Probability.Distribution distribution + ) => distribution -> [f] -> [f] +normalise distribution + | variance == 0 = error "Factory.Test.Quick.Probability.normalise:\tzero variance => can't stretch to one." + | otherwise = map $ (/ sqrt variance) . (+ negate mean) + where + (mean, variance) = Math.Probability.getMean &&& Math.Probability.getVariance $ distribution + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = let + isWithinTolerance :: Double -> Double -> Bool + isWithinTolerance i = (< recip i) . abs + + prop_logNormalDistribution, prop_logNormalDistribution', prop_normalDistribution, prop_uniformDistribution :: System.Random.RandomGen randomGen => randomGen -> Double -> Double -> Test.QuickCheck.Property + prop_logNormalDistribution randomGen location scale2 = scale2 /= 0 ==> Test.QuickCheck.label "prop_logNormalDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 1) . ( + Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. + ) . ( + normalise distribution :: [Double] -> [Double] + ) . take 10000 $ Math.Probability.generatePopulation distribution randomGen where + maxParameter = log . fromInteger $ Math.Probability.maxPreciseInteger (undefined :: Double) + location' + | location >= 0 = maxParameter `min` location + | otherwise = negate maxParameter `max` location + + distribution = Math.Probability.LogNormalDistribution location' . min maxParameter $ abs scale2 + + prop_logNormalDistribution' randomGen location scale2 = scale2 /= 0 ==> Test.QuickCheck.label "prop_logNormalDistribution'" . all ( + >= (0 :: Double) + ) . take 10 $ Math.Probability.generatePopulation (Math.Probability.LogNormalDistribution location' . min maxParameter $ abs scale2) randomGen where + maxParameter = log . fromInteger $ Math.Probability.maxPreciseInteger (undefined :: Double) + + location' + | location >= 0 = maxParameter `min` location + | otherwise = negate maxParameter `max` location + +-- The mean & standard-deviation are equal when scale^2 == ln 2, but this seems to break-down when the mean is close to zero. + prop_logNormalDistributionEqual :: System.Random.RandomGen randomGen => randomGen -> Double -> Test.QuickCheck.Property + prop_logNormalDistributionEqual randomGen location = location' > 16 {-any lower & it seems to fail-} ==> Test.QuickCheck.label "prop_logNormalDistributionEqual" . ( + < (recip 1000000 :: Double) + ) . pred . abs . uncurry (/) . ( + Math.Statistics.getMean &&& Math.Statistics.getStandardDeviation + ) $ take 10000 ( + Math.Probability.generatePopulation (Math.Probability.LogNormalDistribution location' $ log 2) randomGen :: [Double] + ) where + maxParameter = log . fromInteger $ Math.Probability.maxPreciseInteger (undefined :: Double) + + location' + | location >= 0 = maxParameter `min` location + | otherwise = negate maxParameter `max` location + + prop_normalDistribution randomGen mean variance = variance /= 0 ==> Test.QuickCheck.label "prop_normalDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( + Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. + ) . ( + normalise distribution :: [Double] -> [Double] + ) . take 1000 $ Math.Probability.generatePopulation distribution randomGen where + distribution = Math.Probability.NormalDistribution mean $ abs variance + + prop_uniformDistribution randomGen min' max' = min' /= max' ==> Test.QuickCheck.label "prop_uniformDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( + Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. + ) . ( + normalise distribution :: [Double] -> [Double] + ) . take 10000 $ Math.Probability.generatePopulation distribution randomGen where + [min'', max''] = Data.List.sort [min', max'] + distribution = Math.Probability.UniformDistribution (min'', max'') + + prop_exponentialDistribution, prop_exponentialDistribution', prop_poissonDistribution, prop_poissonDistribution', prop_shiftedGeometricDistribution, prop_shiftedGeometricDistribution' :: System.Random.RandomGen randomGen => randomGen -> Double -> Test.QuickCheck.Property + prop_exponentialDistribution randomGen lambda = Test.QuickCheck.label "prop_exponentialDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( + Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. + ) . ( + normalise distribution :: [Double] -> [Double] + ) . take 10000 $ Math.Probability.generatePopulation distribution randomGen where + distribution = Math.Probability.ExponentialDistribution . succ {-exclude zero-} $ abs lambda `max` 10 {-cap-} + + prop_exponentialDistribution' randomGen lambda = lambda /= 0 ==> Test.QuickCheck.label "prop_exponentialDistribution'" . all ( + >= (0 :: Double) + ) . take 10 $ Math.Probability.generatePopulation (Math.Probability.ExponentialDistribution $ abs lambda) randomGen + + prop_poissonDistribution randomGen lambda = Test.QuickCheck.label "prop_poissonDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( + Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. + ) . ( + normalise distribution :: [Double] -> [Double] + ) . take 1000 $ Math.Probability.generatePopulation distribution randomGen where + distribution = Math.Probability.PoissonDistribution . succ {-exclude zero-} $ abs lambda `max` 10 {-cap-} + + prop_poissonDistribution' randomGen lambda = lambda /= 0 ==> Test.QuickCheck.label "prop_poissonDistribution'" . all ( + >= (0 :: Double) + ) . take 10 $ Math.Probability.generatePopulation (Math.Probability.PoissonDistribution $ abs lambda) randomGen + + prop_shiftedGeometricDistribution randomGen probability = probability' /= 1 ==> Test.QuickCheck.label "prop_shiftedGeometricDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( + Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. + ) . ( + normalise distribution :: [Double] -> [Double] + ) . take 10000 $ Math.Probability.generatePopulation distribution randomGen where + probability' = recip . succ $ abs probability -- Semi-closed unit-interval (0, 1]. + distribution = Math.Probability.ShiftedGeometricDistribution probability' + + prop_shiftedGeometricDistribution' randomGen probability = Test.QuickCheck.label "prop_shiftedGeometricDistribution'" . all ( + >= (1 :: Double) + ) . take 10 $ Math.Probability.generatePopulation (Math.Probability.ShiftedGeometricDistribution probability') randomGen where + probability' = recip . succ $ abs probability -- Semi-closed unit-interval (0, 1]. + in do + randomGen <- System.Random.getStdGen + + sequence [ + Test.QuickCheck.quickCheckResult $ prop_logNormalDistributionEqual randomGen, -- CAVEAT: known to fail occasionally. + Test.QuickCheck.quickCheckResult $ prop_logNormalDistribution randomGen, + Test.QuickCheck.quickCheckResult $ prop_logNormalDistribution' randomGen, + Test.QuickCheck.quickCheckResult $ prop_normalDistribution randomGen, + Test.QuickCheck.quickCheckResult $ prop_uniformDistribution randomGen, + Test.QuickCheck.quickCheckResult $ prop_exponentialDistribution randomGen, + Test.QuickCheck.quickCheckResult $ prop_exponentialDistribution' randomGen, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 25 } $ prop_poissonDistribution randomGen, + Test.QuickCheck.quickCheckResult $ prop_poissonDistribution' randomGen, + Test.QuickCheck.quickCheckWithResult Test.QuickCheck.stdArgs { Test.QuickCheck.maxSuccess = 50 } $ prop_shiftedGeometricDistribution randomGen, + Test.QuickCheck.quickCheckResult $ prop_shiftedGeometricDistribution' randomGen + ] + diff --git a/src-test/Factory/Test/QuickCheck/Radix.hs b/src-test/Factory/Test/QuickCheck/Radix.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Radix.hs @@ -0,0 +1,46 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Radix". +-} + +module Factory.Test.QuickCheck.Radix( +-- * Constants + results, +-- * Types +-- ** Type-synonyms +-- Testable +) where + +import qualified Factory.Math.Radix as Math.Radix +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +type Testable = (Int, Integer) -> Test.QuickCheck.Property + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [prop_reversable, prop_digitalRoot] where + prop_reversable, prop_digitalRoot :: Testable + prop_reversable (b, n) = abs base > 1 ==> Test.QuickCheck.label "prop_reversable" $ Math.Radix.fromBase base (Math.Radix.toBase base n) == n where + base = (b `mod` 73) - 36 + + prop_digitalRoot (_, n) = Test.QuickCheck.label "prop_digitalRoot" $ Math.Radix.digitalRoot n' == 9 where + n' = 9 * succ (abs n) + diff --git a/src-test/Factory/Test/QuickCheck/SquareRoot.hs b/src-test/Factory/Test/QuickCheck/SquareRoot.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/SquareRoot.hs @@ -0,0 +1,85 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Math.Implementations.SquareRoot". +-} + +module Factory.Test.QuickCheck.SquareRoot( +-- * Constants + results +) where + +import Data.Ratio((%)) +import qualified Data.Ratio +import qualified Factory.Math.Implementations.SquareRoot as Math.Implementations.SquareRoot +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.Precision as Math.Precision +import qualified Factory.Math.SquareRoot as Math.SquareRoot +import qualified Test.QuickCheck + +instance Test.QuickCheck.Arbitrary (Math.Implementations.SquareRoot.Algorithm) where + arbitrary = Test.QuickCheck.oneof [ + Test.QuickCheck.elements [ + Math.Implementations.SquareRoot.BakhshaliApproximation, + Math.Implementations.SquareRoot.ContinuedFraction, + Math.Implementations.SquareRoot.HalleysMethod, + Math.Implementations.SquareRoot.NewtonRaphsonIteration + ], + Math.Implementations.SquareRoot.TaylorSeries `fmap` Test.QuickCheck.elements [2 .. 32] + ] + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [ + prop_accuracy, + prop_factorable +-- prop_perfectSquare -- This occasionally fails. + ] where + prop_accuracy, prop_factorable, prop_perfectSquare :: (Math.Implementations.SquareRoot.Algorithm, Math.Precision.DecimalDigits, Rational) -> Test.QuickCheck.Property + prop_accuracy (algorithm, decimalDigits, operand) = Test.QuickCheck.label "prop_accuracy" . (>= requiredDecimalDigits) . Math.SquareRoot.getAccuracy operand' $ Math.SquareRoot.squareRoot algorithm requiredDecimalDigits operand' where + requiredDecimalDigits :: Math.Precision.DecimalDigits + requiredDecimalDigits = succ $ decimalDigits `mod` 1024 + + operand' :: Rational + operand' = abs operand + + prop_factorable (algorithm, decimalDigits, operand) = Test.QuickCheck.label "prop_factorable" . (<= 5) . ( + * 10 ^ requiredDecimalDigits -- Promote the relative error. + ) . abs $ 1 - ( + Math.SquareRoot.squareRoot algorithm requiredDecimalDigits ( + toRational $ Data.Ratio.numerator operand' + ) / Math.SquareRoot.squareRoot algorithm requiredDecimalDigits ( + toRational $ Data.Ratio.denominator operand' + ) + ) / Math.SquareRoot.squareRoot algorithm requiredDecimalDigits operand' where + requiredDecimalDigits :: Math.Precision.DecimalDigits + requiredDecimalDigits = succ $ decimalDigits `mod` 1024 + + operand' :: Rational + operand' = succ $ abs operand + + prop_perfectSquare (algorithm, decimalDigits, operand) = Test.QuickCheck.label "prop_perfectSquare" . Math.SquareRoot.isPrecise perfectSquare $ Math.SquareRoot.squareRoot algorithm requiredDecimalDigits perfectSquare where + requiredDecimalDigits :: Math.Precision.DecimalDigits + requiredDecimalDigits = succ $ decimalDigits `mod` 32768 + + operand', perfectSquare :: Rational + operand' = (abs (Data.Ratio.numerator operand) `min` (2 ^ (32 :: Int))) % (abs (Data.Ratio.denominator operand) `min` (2 ^ (32 :: Int))) -- Avoid floating-point rounding-errors in 'Math.SquareRoot.rSqrt'. + perfectSquare = Math.Power.square operand' + diff --git a/src-test/Factory/Test/QuickCheck/Statistics.hs b/src-test/Factory/Test/QuickCheck/Statistics.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Statistics.hs @@ -0,0 +1,125 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Statistics". +-} + +module Factory.Test.QuickCheck.Statistics( +-- * Constants + results +) where + +import qualified Data.Array +import qualified Data.List +import qualified Data.Map +import qualified Data.Numbers.Primes +import qualified Data.Set +import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial +import qualified Factory.Math.Power as Math.Power +import qualified Factory.Math.Statistics as Math.Statistics +import Factory.Test.QuickCheck.Factorial() +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = sequence [ + Test.QuickCheck.quickCheckResult prop_nC0, + Test.QuickCheck.quickCheckResult prop_nC1, + Test.QuickCheck.quickCheckResult prop_sum, + Test.QuickCheck.quickCheckResult prop_symmetry, + Test.QuickCheck.quickCheckResult prop_prime, + Test.QuickCheck.quickCheckResult prop_nP0, + Test.QuickCheck.quickCheckResult prop_nP1, + Test.QuickCheck.quickCheckResult prop_zeroVariance, + Test.QuickCheck.quickCheckResult prop_zeroAverageAbsoluteDeviation, + Test.QuickCheck.quickCheckResult prop_balance, + Test.QuickCheck.quickCheckResult prop_varianceRelocated, + Test.QuickCheck.quickCheckResult prop_varianceScaled, + Test.QuickCheck.quickCheckResult prop_varianceOrder, + Test.QuickCheck.quickCheckResult prop_equivalence, + Test.QuickCheck.quickCheckResult prop_varianceOfArray, + Test.QuickCheck.quickCheckResult prop_varianceOfMap, + Test.QuickCheck.quickCheckResult prop_meanOfSet, + Test.QuickCheck.quickCheckResult prop_weightedMeanRational, + Test.QuickCheck.quickCheckResult prop_weightedMeanInteger, + Test.QuickCheck.quickCheckResult prop_weightedMeanUniformDenominator + ] where + prop_nC0, prop_nC1, prop_sum :: Math.Implementations.Factorial.Algorithm -> Integer -> Test.QuickCheck.Property + prop_nC0 algorithm n = Test.QuickCheck.label "prop_nC0" $ Math.Statistics.nCr algorithm (abs n) 0 == 1 + + prop_nC1 algorithm i = Test.QuickCheck.label "prop_nC1" $ Math.Statistics.nCr algorithm n 1 == n where + n = succ $ abs i + + prop_sum algorithm i = Test.QuickCheck.label "prop_sum" $ sum (Math.Statistics.nCr algorithm n `map` [0 .. n]) == 2 ^ n where + n = succ $ abs i + + prop_symmetry, prop_prime :: Math.Implementations.Factorial.Algorithm -> (Integer, Integer) -> Test.QuickCheck.Property + prop_symmetry algorithm (i, j) = Test.QuickCheck.label "prop_symmetry" $ Math.Statistics.nCr algorithm n r == Math.Statistics.nCr algorithm n (n - r) where + [r, n] = Data.List.sort $ map abs [i, j] + + prop_prime algorithm (i, j) = r `notElem` [0, n] ==> Test.QuickCheck.label "prop_prime" $ (Math.Statistics.nCr algorithm n r `mod` n) == 0 where + n = Data.Numbers.Primes.primes !! fromIntegral (i `mod` 500000) + r = j `mod` n -- Ensure r is smaller than n. + + prop_nP0, prop_nP1 :: Integer -> Test.QuickCheck.Property + prop_nP0 n = Test.QuickCheck.label "prop_nP0" $ Math.Statistics.nPr (abs n) 0 == 1 + + prop_nP1 i = Test.QuickCheck.label "prop_nP1" $ Math.Statistics.nPr n 1 == n where + n = succ $ abs i + + prop_zeroVariance, prop_zeroAverageAbsoluteDeviation :: Rational -> Test.QuickCheck.Property + prop_zeroVariance x = Test.QuickCheck.label "prop_zeroVariance" $ Math.Statistics.getVariance (replicate 32 x) == (0 :: Rational) + prop_zeroAverageAbsoluteDeviation x = Test.QuickCheck.label "zeroAverageAbsoluteDeviation" $ Math.Statistics.getAverageAbsoluteDeviation (replicate 32 x) == (0 :: Rational) + + prop_balance, prop_varianceRelocated, prop_varianceScaled, prop_varianceOrder, prop_equivalence, prop_varianceOfMap, prop_meanOfSet, prop_varianceOfArray :: [Integer] -> Test.QuickCheck.Property + prop_balance l = not (null l) ==> Test.QuickCheck.label "prop_balance" . (== 0) . abs . sum $ map (\i -> toRational i - Math.Statistics.getMean l) l + prop_varianceRelocated l = not (null l) ==> Test.QuickCheck.label "prop_varianceRelocated" $ (Math.Statistics.getVariance l :: Rational) == Math.Statistics.getVariance (map succ l) + prop_varianceScaled l = not (null l) ==> Test.QuickCheck.label "prop_varianceScaled" $ (4 * Math.Statistics.getVariance l :: Rational) == Math.Statistics.getVariance (map (* 2) l) + prop_varianceOrder l = not (null l) ==> Test.QuickCheck.label "prop_varianceOrder" $ Math.Statistics.getVariance l == (Math.Statistics.getVariance (reverse l) :: Rational) + prop_equivalence l = not (null l) ==> Test.QuickCheck.label "prop_equivalence" $ Math.Statistics.getVariance l == Math.Statistics.getMean (map Math.Power.square l) - Math.Power.square (Math.Statistics.getMean l :: Rational) + prop_varianceOfArray l = not (null l) ==> Test.QuickCheck.label "prop_varianceOfArray" $ Math.Statistics.getVariance (Data.Array.array (1, length l) $ zip [1 ..] l) == (Math.Statistics.getVariance l :: Rational) + prop_varianceOfMap l = not (null l) ==> Test.QuickCheck.label "prop_varianceOfMap" $ Math.Statistics.getVariance (Data.Map.fromList $ zip [0 :: Int ..] l) == (Math.Statistics.getVariance l :: Rational) + prop_meanOfSet l = not (null l') ==> Test.QuickCheck.label "prop_meanOfSet" $ Math.Statistics.getMean (Data.Set.fromList l') == (Math.Statistics.getMean l' :: Rational) where + l' = Data.List.nub l + + prop_weightedMeanRational :: [(Rational, Rational)] -> Test.QuickCheck.Property + prop_weightedMeanRational assoc = (denominator /= 0) ==> Test.QuickCheck.label "prop_weightedMeanRational" $ Math.Statistics.getWeightedMean assoc == ( + sum (map (uncurry (*)) assoc) / denominator + ) where + denominator = sum $ map snd assoc + + + prop_weightedMeanInteger :: [(Integer, Integer)] -> Test.QuickCheck.Property + prop_weightedMeanInteger assoc = (denominator /= 0) ==> Test.QuickCheck.label "prop_weightedMeanInteger" $ Math.Statistics.getWeightedMean assoc == ( + toRational ( + sum $ map ( + uncurry (*) + ) assoc + ) / toRational denominator + ) where + denominator = sum $ map snd assoc + + prop_weightedMeanUniformDenominator :: [Rational] -> Integer -> Test.QuickCheck.Property + prop_weightedMeanUniformDenominator numerators i = (not (null numerators) && i /= 0) ==> Test.QuickCheck.label "prop_weightedMeanUniformDenominator" $ Math.Statistics.getWeightedMean ( + zip numerators $ repeat i + ) == ( + Math.Statistics.getMean numerators :: Rational + ) + diff --git a/src-test/Factory/Test/QuickCheck/Summation.hs b/src-test/Factory/Test/QuickCheck/Summation.hs new file mode 100644 --- /dev/null +++ b/src-test/Factory/Test/QuickCheck/Summation.hs @@ -0,0 +1,42 @@ +{- + Copyright (C) 2011-2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Summation". +-} + +module Factory.Test.QuickCheck.Summation( +-- * Constants + results +) where + +import qualified Factory.Math.Summation as Math.Summation +import qualified Test.QuickCheck +import Test.QuickCheck((==>)) + +-- | The constant test-results for this data-type. +results :: IO [Test.QuickCheck.Result] +results = mapM Test.QuickCheck.quickCheckResult [prop_sum, prop_sumR] where + prop_sum, prop_sumR :: Int -> [Rational] -> Test.QuickCheck.Property + prop_sum chunkSize l = not (null l) ==> Test.QuickCheck.label "prop_sum" $ Math.Summation.sum' chunkSize' l == sum l where + chunkSize' = 2 + (chunkSize `mod` length l) + + prop_sumR chunkSize l = not (null l) ==> Test.QuickCheck.label "prop_sumR" $ Math.Summation.sumR chunkSize' l == sum l where + chunkSize' = 2 + (chunkSize `mod` length l) + + diff --git a/src-test/Main.hs b/src-test/Main.hs new file mode 100644 --- /dev/null +++ b/src-test/Main.hs @@ -0,0 +1,76 @@ +{- + Copyright (C) 2015 Dr. Alistair Ward + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{- | + [@AUTHOR@] Dr. Alistair Ward + + [@DESCRIPTION@] + + * The entry-point to the application's test-suite. +-} + +module Main(main) where + +import Control.Arrow((***)) +import qualified Control.Monad +import qualified Factory.Test.QuickCheck.ArithmeticGeometricMean as Test.QuickCheck.ArithmeticGeometricMean +import qualified Factory.Test.QuickCheck.Factorial as Test.QuickCheck.Factorial +import qualified Factory.Test.QuickCheck.Hyperoperation as Test.QuickCheck.Hyperoperation +import qualified Factory.Test.QuickCheck.Interval as Test.QuickCheck.Interval +import qualified Factory.Test.QuickCheck.MonicPolynomial as Test.QuickCheck.MonicPolynomial +import qualified Factory.Test.QuickCheck.PerfectPower as Test.QuickCheck.PerfectPower +import qualified Factory.Test.QuickCheck.Pi as Test.QuickCheck.Pi +import qualified Factory.Test.QuickCheck.Polynomial as Test.QuickCheck.Polynomial +import qualified Factory.Test.QuickCheck.Power as Test.QuickCheck.Power +import qualified Factory.Test.QuickCheck.Primality as Test.QuickCheck.Primality +import qualified Factory.Test.QuickCheck.PrimeFactorisation as Test.QuickCheck.PrimeFactorisation +import qualified Factory.Test.QuickCheck.Primes as Test.QuickCheck.Primes +import qualified Factory.Test.QuickCheck.Probability as Test.QuickCheck.Probability +import qualified Factory.Test.QuickCheck.Radix as Test.QuickCheck.Radix +import qualified Factory.Test.QuickCheck.SquareRoot as Test.QuickCheck.SquareRoot +import qualified Factory.Test.QuickCheck.Statistics as Test.QuickCheck.Statistics +import qualified Factory.Test.QuickCheck.Summation as Test.QuickCheck.Summation +import qualified System.Exit +import qualified ToolShed.Test.QuickCheck.Result + +-- | Entry-point. +main :: IO () +main = mapM_ ( + snd {-exit-status-} . ( + putStrLn . (++ ":") *** ( + >>= (`Control.Monad.unless` System.Exit.exitFailure) . all ToolShed.Test.QuickCheck.Result.isSuccessful + ) + ) + ) [ + ("ArithmeticGeometricMean", Test.QuickCheck.ArithmeticGeometricMean.results), + ("Factorial", Test.QuickCheck.Factorial.results), + ("Hyperoperation", Test.QuickCheck.Hyperoperation.results), + ("Interval", Test.QuickCheck.Interval.results), + ("MonicPolynomial", Test.QuickCheck.MonicPolynomial.results), + ("PerfectPower", Test.QuickCheck.PerfectPower.results), + ("Pi", Test.QuickCheck.Pi.results), + ("Polynomial", Test.QuickCheck.Polynomial.results), + ("Power", Test.QuickCheck.Power.results), + ("Primality", Test.QuickCheck.Primality.results), + ("PrimeFactorisation", Test.QuickCheck.PrimeFactorisation.results), + ("Primes", Test.QuickCheck.Primes.results), + ("Probability", Test.QuickCheck.Probability.results), + ("Radix", Test.QuickCheck.Radix.results), + ("SquareRoot", Test.QuickCheck.SquareRoot.results), + ("Statistics", Test.QuickCheck.Statistics.results), + ("Summation", Test.QuickCheck.Summation.results) + ] + diff --git a/src/Factory/Data/Exponential.hs b/src/Factory/Data/Exponential.hs deleted file mode 100644 --- a/src/Factory/Data/Exponential.hs +++ /dev/null @@ -1,89 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Describes a simple numeric type, designed to contain an /exponential/ number. - - * . --} - -module Factory.Data.Exponential( --- * Types --- ** Type-synonyms - Exponential, --- * Functions - evaluate, - invert, --- ** Accessors - getBase, - getExponent, --- ** Constructors - rightIdentity, --- ** Operators - (<^), - (=~) -) where - -import qualified Control.Arrow - -infix 4 =~ -- Same as (==). -infixr 8 <^ -- Same as (^). - --- | Describes an /exponential/, in terms of its /base/ and /exponent/. -type Exponential base exponent = (base, exponent) - --- | Accessor. -{-# INLINE getBase #-} -getBase :: Exponential base exponent -> base -getBase = fst - --- | Accessor. -{-# INLINE getExponent #-} -getExponent :: Exponential base exponent -> exponent -getExponent = snd - -{- | - * Construct an 'Exponential' merely raised to the 1st power. - - * The value of the resulting exponential is the same as specified 'base'; . --} -rightIdentity :: Num exponent => base -> Exponential base exponent -rightIdentity x = (x, 1) - --- | Evaluate the specified 'Exponential', returning the resulting number. -{-# INLINE evaluate #-} -evaluate :: (Num base, Integral exponent) => Exponential base exponent -> base -evaluate = uncurry (^) -- CAVEAT: in this eta-reduced form, it'll only be inlined when called without arguments. - --- | True if the /bases/ are equal. -(=~) :: Eq base => Exponential base exponent -> Exponential base exponent -> Bool -(l, _) =~ (r, _) = l == r - --- | Raise the specified 'Exponential' to a power. -(<^) :: Num exponent - => Exponential base exponent -- ^ The operand. - -> exponent -- ^ The power to which the exponential is to be raised. - -> Exponential base exponent -- ^ The result. -(b, e) <^ power = (b, e * power) - --- | Invert the value, by negating the exponent. -invert :: Num exponent => Exponential base exponent -> Exponential base exponent -invert = Control.Arrow.second negate - diff --git a/src/Factory/Data/Interval.hs b/src/Factory/Data/Interval.hs deleted file mode 100644 --- a/src/Factory/Data/Interval.hs +++ /dev/null @@ -1,201 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Describes a bounded set of, typically integral, quantities. - - * Operations have been defined, on the list of /consecutive/ quantities delimited by these endpoints. - - * The point is that if the list is composed from /consecutive/ quantities, the intermediate values can be inferred, rather than physically represented. - - [@CAVEATS@] - - * The API was driven top-down by its caller's requirements, rather than a bottom-up attempt to provide a complete interface. - consequently there may be omissions from the view point of future callers. - - * Thought similar to the mathematical concept of an /interval/, the latter technically relates to /real/ numbers; . - - * No account has been made for /semi-closed/ or /open/ intervals. --} - -module Factory.Data.Interval( --- * Types --- ** Type-synonyms - Interval, --- * Constants - closedUnitInterval, - mkBounded, --- * Functions --- divideAndConquer, - elem', --- getLength, - normalise, - product', - shift, - splitAt', - toList, --- ** Accessors - getMinBound, - getMaxBound, --- ** Constructors - precisely, --- ** Predicates - isReversed -) where - -import Control.Arrow((***), (&&&)) -import qualified Control.Parallel.Strategies -import qualified Data.Monoid -import qualified Data.Ratio -import qualified Data.Tuple -import qualified ToolShed.Data.Pair - --- | Defines a closed (inclusive) interval of consecutive values. -type Interval endPoint = (endPoint, endPoint) - --- | Accessor. -{-# INLINE getMinBound #-} -getMinBound :: Interval endPoint -> endPoint -getMinBound = fst - --- | Accessor. -{-# INLINE getMaxBound #-} -getMaxBound :: Interval endPoint -> endPoint -getMaxBound = snd - --- | Construct the /unsigned closed unit-interval/; . -closedUnitInterval :: Num n => Interval n -closedUnitInterval = (0, 1) - --- | Construct an /interval/ from a bounded type. -mkBounded :: Bounded endPoint => Interval endPoint -mkBounded = (minBound, maxBound) - --- | Construct an /interval/ from a single value. -precisely :: endPoint -> Interval endPoint -precisely = id &&& id - --- | Shift of both /end-points/ of the /interval/ by the specified amount. -shift :: Num endPoint - => endPoint -- ^ The magnitude of the require shift. - -> Interval endPoint -- ^ The interval to be shifted. - -> Interval endPoint -shift i = ToolShed.Data.Pair.mirror (+ i) - --- | True if the specified value is within the inclusive bounds of the /interval/. -elem' :: Ord endPoint => endPoint -> Interval endPoint -> Bool -elem' x = uncurry (&&) . ((<= x) *** (x <=)) - --- | True if 'getMinBound' exceeds 'getMaxBound' extent. -isReversed :: Ord endPoint => Interval endPoint -> Bool -isReversed = uncurry (>) - --- | Swap the /end-points/ where they were originally reversed, but otherwise do nothing. -normalise :: Ord endPoint => Interval endPoint -> Interval endPoint -normalise b - | isReversed b = Data.Tuple.swap b - | otherwise = b - --- | Bisect the /interval/ at the specified /end-point/; which should be between the two existing /end-points/. -splitAt' :: ( - Enum endPoint, - Num endPoint, - Ord endPoint, - Show endPoint - ) => endPoint -> Interval endPoint -> (Interval endPoint, Interval endPoint) -splitAt' i interval@(l, r) - | any ($ i) [(< l), (>= r)] = error $ "Factory.Data.Interval.splitAt':\tunsuitable index=" ++ show i ++ " for interval=" ++ show interval ++ "." - | otherwise = ((l, i), (succ i, r)) - -{- | - * The distance between the endpoints, - which for 'Integral' quantities is the same as the number of items in closed interval; though the latter concept would return type 'Int'. - - * CAVEAT: the implementation accounts for the potential fence-post error, for closed intervals of integers, - but this results in the opposite error when used with /Fractional/ quantities. - So, though most of the module merely requires 'Enum', this function is further restricted to 'Integral'. --} -{-# INLINE getLength #-} -getLength :: Integral endPoint => Interval endPoint -> endPoint -getLength (l, r) = succ r - l - -{- | - * Converts 'Interval' to a list by enumerating the values. - - * CAVEAT: produces rather odd results for 'Fractional' types, but no stranger than considering such types Enumerable in the first place. --} -{-# INLINE toList #-} -toList :: Enum endPoint => Interval endPoint -> [endPoint] -toList = uncurry enumFromTo -- CAVEAT: in this eta-reduced form, it'll only be inlined when called without arguments. - -{- | - * Reduces 'Interval' to a single integral value encapsulated in a 'Data.Monoid.Monoid', - using a /divide-and-conquer/ strategy, - bisecting the /interval/ and recursively evaluating each part; . - - * By choosing a 'ratio' other than @(1 % 2)@, the bisection can be made asymmetrical. - The specified ratio represents the length of the left-hand portion over the original list-length; - eg. @(1 % 3)@ results in the first part, half the length of the second. - - * This process of recursive bisection, is terminated beneath the specified minimum length, - after which the 'Interval' are expanded into the corresponding list, and the /monoid/'s binary operator is directly /folded/ over it. - - * One can view this as a , - in which 'Interval' is exploded into a binary tree-structure - (each leaf of which contains a list of up to 'minLength' integers, and each node of which contains an associative binary operator), - and then collapsed to a scalar, by application of the operators. --} -divideAndConquer :: (Data.Monoid.Monoid monoid, Integral i, Show i) - => (i -> monoid) -- ^ The monoid's constructor. - -> Data.Ratio.Ratio i -- ^ The ratio of the original span, at which to bisect the 'Interval'. - -> i -- ^ For efficiency, the /interval/ will not be bisected, when it's length has been reduced to this value. - -> Interval i - -> monoid -- ^ The resulting scalar. -divideAndConquer monoidConstructor ratio minLength - | any ($ ratio) [ - (< 0), - (>= 1) - ] = error $ "Factory.Data.Interval.divideAndConquer:\tunsuitable ratio='" ++ show ratio ++ "'." - | minLength < 1 = error $ "Factory.Data.Interval.divideAndConquer:\tunsuitable minLength=" ++ show minLength ++ "." - | otherwise = slave - where - slave interval@(l, r) - | getLength interval <= minLength = Data.Monoid.mconcat . map monoidConstructor $ toList interval -- Fold the monoid's binary operator over the delimited list. - | otherwise = uncurry Data.Monoid.mappend . Control.Parallel.Strategies.withStrategy ( - Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rseq Control.Parallel.Strategies.rseq - ) . ToolShed.Data.Pair.mirror slave $ splitAt' ( - l + (r - l) * Data.Ratio.numerator ratio `div` Data.Ratio.denominator ratio -- Use the ratio to generate the split-index. - ) interval -- Apply the monoid's binary operator to the two operands resulting from bisection. - -{- | - * Multiplies the consecutive sequence of integers within 'Interval'. - - * Since the result can be large, 'divideAndConquer' is used to form operands of a similar order of magnitude, - thus improving the efficiency of the big-number multiplication. --} -product' :: (Integral i, Show i) - => Data.Ratio.Ratio i -- ^ The ratio at which to bisect the 'Interval'. - -> i -- ^ For efficiency, the /interval/ will not be bisected, when it's length has been reduced to this value. - -> Interval i - -> i -- ^ The resulting product. -product' ratio minLength interval - | elem' 0 interval = 0 - | otherwise = Data.Monoid.getProduct $ divideAndConquer Data.Monoid.Product ratio minLength interval - diff --git a/src/Factory/Data/MonicPolynomial.hs b/src/Factory/Data/MonicPolynomial.hs deleted file mode 100644 --- a/src/Factory/Data/MonicPolynomial.hs +++ /dev/null @@ -1,98 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Describes a /monic polynomial; ; - ie. in which the /coefficient/ of the /leading term/ is one. --} - -module Factory.Data.MonicPolynomial( --- * Types --- ** Data-types, - MonicPolynomial(getPolynomial), -- Hide the data-constructor. --- * Functions --- ** Constructors - mkMonicPolynomial -) where - -import qualified Control.Arrow -import qualified Factory.Data.Monomial as Data.Monomial -import Factory.Data.Polynomial((*=)) -import qualified Factory.Data.Polynomial as Data.Polynomial -import qualified Factory.Data.QuotientRing as Data.QuotientRing -import Factory.Data.Ring((=*=), (=+=), (=-=)) -import qualified Factory.Data.Ring as Data.Ring -import qualified ToolShed.Data.Pair - --- | A type of 'Data.Polynomial.Polynomial', in which the /leading term/ is required to have a /coefficient/ of one. -newtype MonicPolynomial c e = MkMonicPolynomial { - getPolynomial :: Data.Polynomial.Polynomial c e -} deriving (Eq, Show) - --- | Smart constructor. Constructs an arbitrary /monic polynomial/. -mkMonicPolynomial :: ( - Eq c, - Num c, - Ord e, - Show c, - Show e - ) => Data.Polynomial.Polynomial c e -> MonicPolynomial c e -mkMonicPolynomial polynomial - | not $ Data.Polynomial.isMonic polynomial = error $ "Factory.Data.MonicPolynomial.mkMonicPolynomial:\tnot monic; " ++ show polynomial - | otherwise = MkMonicPolynomial polynomial - -{- - * This instance-declaration merely delegates to the 'Data.Polynomial.Polynomial' payload. - - * CAVEAT: it's not strictly an instance of this class, since the result of some methods isn't /monic/. --} -instance ( - Eq c, - Num c, - Num e, - Ord e, - Show c, - Show e - ) => Data.Ring.Ring (MonicPolynomial c e) where - MkMonicPolynomial l =*= MkMonicPolynomial r = MkMonicPolynomial $ l =*= r - MkMonicPolynomial l =+= MkMonicPolynomial r = mkMonicPolynomial $ l =+= r -- CAVEAT: potentially non-monic. --- additiveInverse (MkMonicPolynomial p) = MkMonicPolynomial $ Data.Ring.additiveInverse p -- CAVEAT: not monic ! - additiveInverse _ = error "Factory.Data.MonicPolynomial.additiveInverse:\tresult isn't monic" - multiplicativeIdentity = MkMonicPolynomial Data.Ring.multiplicativeIdentity - additiveIdentity = MkMonicPolynomial Data.Ring.additiveIdentity -- CAVEAT: not monic ! - --- Since the /leading term/ of the /denominator/ is one, the /coefficient/ isn't required to implement 'Fractional'. -instance ( - Eq c, - Num c, - Num e, - Ord e, - Show c, - Show e - ) => Data.QuotientRing.QuotientRing (MonicPolynomial c e) where - MkMonicPolynomial polynomialN `quotRem'` MkMonicPolynomial polynomialD = ToolShed.Data.Pair.mirror MkMonicPolynomial $ longDivide polynomialN where --- longDivide :: (Num c, Num e, Ord e) => Polynomial c e -> (Polynomial c e, Polynomial c e) - longDivide numerator - | Data.Polynomial.isZero numerator || Data.Monomial.getExponent quotient < 0 = (Data.Polynomial.zero, numerator) - | otherwise = Control.Arrow.first (Data.Polynomial.lift (quotient :)) $ longDivide (numerator =-= polynomialD *= quotient) - where --- quotient :: Num e => Data.Monomial.Monomial c e - quotient = Data.Polynomial.getLeadingTerm numerator `Data.Monomial.shiftExponent` negate (Data.Monomial.getExponent $ Data.Polynomial.getLeadingTerm polynomialD) - diff --git a/src/Factory/Data/Monomial.hs b/src/Factory/Data/Monomial.hs deleted file mode 100644 --- a/src/Factory/Data/Monomial.hs +++ /dev/null @@ -1,148 +0,0 @@ -{- - Copyright (C) 2011-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Describes a and operations on it. - - * A /monomial/ is merely a /polynomial/ with a single non-zero term; cf. /Binomial/. --} - -module Factory.Data.Monomial( --- * Types --- ** Type-synonyms - Monomial, --- * Functions - double, - mod', - negateCoefficient, - realCoefficientToFrac, - shiftCoefficient, - shiftExponent, - square, --- ** Accessors - getExponent, - getCoefficient, --- ** Operators - (<=>), - (), - (<*>), - (=~), --- ** Predicates - isMonomial -) where - -import Prelude hiding ((<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. -import qualified Control.Arrow - -infix 4 <=> -- Same as (==). -infix 4 =~ -- Same as (==). -infixl 7 -- Same as (/). -infixl 7 <*> -- Same as (*). - -{- | - * The type of an arbitrary monomial. - - * CAVEAT: though a /monomial/ has an integral power, this contraint is only imposed at the function-level. --} -type Monomial coefficient exponent = (coefficient, exponent) - --- | Accessor. -{-# INLINE getCoefficient #-} -getCoefficient :: Monomial c e -> c -getCoefficient = fst - --- | Accessor. -{-# INLINE getExponent #-} -getExponent :: Monomial c e -> e -getExponent = snd - -{- | - * 'True' if the /exponent/ is both integral and non-/negative/. - - * CAVEAT: one can't even call this function unless the /exponent/ is integral. --} -isMonomial :: Integral e => Monomial c e -> Bool -isMonomial = (>= 0) . getExponent - --- | Compares the /exponents/ of the specified 'Monomial's. -{-# INLINE (<=>) #-} -(<=>) :: Ord e => Monomial c e -> Monomial c e -> Ordering -(_, l) <=> (_, r) = l `compare` r - --- | True if the /exponents/ are equal. -(=~) :: Eq e => Monomial c e -> Monomial c e -> Bool -(_, l) =~ (_, r) = l == r - --- | Multiply the two specified 'Monomial's. -{-# INLINE (<*>) #-} -(<*>) :: (Num c, Num e) => Monomial c e -> Monomial c e -> Monomial c e -(cL, eL) <*> (cR, eR) = (cL * cR, eL + eR) - --- | Divide the two specified 'Monomial's. -() :: (Eq c, Fractional c, Num e) - => Monomial c e -- ^ Numerator. - -> Monomial c e -- ^ Denominator. - -> Monomial c e -(cN, eN) (1, eD) = (cN, eN - eD) -(cN, eN) (cD, eD) = (cN / cD, eN - eD) - --- | Square the specified 'Monomial'. -square :: (Num c, Num e) => Monomial c e -> Monomial c e -square (c, e) = (c ^ (2 :: Int), 2 * e) - --- | Double the specified 'Monomial'. -{-# INLINE double #-} -double :: Num c => Monomial c e -> Monomial c e -double (c, e) = (2 * c, e) - --- | Shift the /coefficient/, by the specified amount. -{-# INLINE shiftCoefficient #-} -shiftCoefficient :: Num c - => Monomial c e - -> c -- ^ The magnitude of the shift. - -> Monomial c e --- m `shiftCoefficient` i = Control.Arrow.first (+ i) m -- CAVEAT: Too slow. -(c, e) `shiftCoefficient` i = (c + i, e) - --- | Shift the /exponent/, by the specified amount. -{-# INLINE shiftExponent #-} -shiftExponent :: Num e - => Monomial c e - -> e -- ^ The magnitude of the shift. - -> Monomial c e --- m `shiftExponent` i = Control.Arrow.second (+ i) m -- CAVEAT: Too slow. -(c, e) `shiftExponent` i = (c, e + i) - --- | Negate the coefficient. -negateCoefficient :: Num c => Monomial c e -> Monomial c e -negateCoefficient = Control.Arrow.first negate - --- | Reduce the coefficient using /modular/ arithmetic. -{-# INLINE mod' #-} -mod' :: Integral c - => Monomial c e - -> c -- ^ Modulus. - -> Monomial c e -monomial `mod'` modulus = Control.Arrow.first (`mod` modulus) monomial - --- | Convert the type of the /coefficient/. -realCoefficientToFrac :: (Real r, Fractional f) => Monomial r e -> Monomial f e -realCoefficientToFrac = Control.Arrow.first realToFrac - diff --git a/src/Factory/Data/Polynomial.hs b/src/Factory/Data/Polynomial.hs deleted file mode 100644 --- a/src/Factory/Data/Polynomial.hs +++ /dev/null @@ -1,375 +0,0 @@ -{- - Copyright (C) 2011-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Describes a polynomial and operations on it. - - * . - - * . --} - -module Factory.Data.Polynomial( --- * Types --- ** Type-synonyms --- MonomialList, --- ** Data-types, - Polynomial, --- * Constants - zero, - one, --- * Functions - evaluate, - getDegree, - getLeadingTerm, - lift, - mod', - normalise, --- pruneCoefficients, - raiseModulo, - realCoefficientsToFrac, - terms, --- ** Constructors - mkConstant, - mkLinear, - mkPolynomial, --- ** Operators - (*=), --- ** Predicates - areCongruentModulo, - inAscendingOrder, - inDescendingOrder, --- inOrder, - isMonic, - isMonomial, - isNormalised, - isPolynomial, --- isReduced, - isZero -) where - -import Prelude hiding ((<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. -import Control.Arrow((&&&)) -import qualified Control.Arrow -import qualified Data.List -import Factory.Data.Monomial((<*>), (), (<=>), (=~)) -import qualified Factory.Data.Monomial as Data.Monomial -import qualified Factory.Data.QuotientRing as Data.QuotientRing -import Factory.Data.Ring((=*=), (=+=), (=-=)) -import qualified Factory.Data.Ring as Data.Ring - -infixl 7 *= -- Same as (*). - --- | The guts of a 'Polynomial'. -type MonomialList coefficient exponent = [Data.Monomial.Monomial coefficient exponent] - -{- | - * The type of an arbitrary /univariate/ polynomial; - actually it's more general, since it permits negative powers (s). - It can't describe /multivariate/ polynomials, which would require a list of /exponents/. - Rather than requiring the /exponent/ to implement the /type-class/ 'Integral', this is implemented at the function-level, as required. - - * The structure permits gaps between /exponents/, - in which /coefficients/ are inferred to be zero, thus enabling efficient representation of sparse polynomials. - - * CAVEAT: the 'MonomialList' is required to; - be ordered by /descending/ exponent (ie. reverse ); - have had zero coefficients removed; - and to have had /like/ terms merged; - so the raw data-constructor isn't exported. --} -newtype {- Integral exponent => -} Polynomial coefficient exponent = MkPolynomial { - getMonomialList :: MonomialList coefficient exponent -- ^ Accessor. -} deriving (Eq, Show) - --- | Makes /Polynomial/ a 'Data.Ring.Ring', over the /field/ composed from all possible /coefficients/; . -instance ( - Eq c, - Num c, - Num e, - Ord e - ) => Data.Ring.Ring (Polynomial c e) where - MkPolynomial [] =*= _ = zero - _ =*= MkPolynomial [] = zero - polynomialL =*= polynomialR --- | polynomialL == one = polynomialR -- Counterproductive. --- | polynomialR == one = polynomialL -- Counterproductive. - | terms polynomialL > terms polynomialR = polynomialL `times` polynomialR - | otherwise = polynomialR `times` polynomialL - where - l `times` r = {-# SCC "times" #-} Data.Ring.sum' (recip 2) {-TODO-} 10 {-empirical-} . map (l *=) $ getMonomialList r - - MkPolynomial [] =+= p = p - p =+= MkPolynomial [] = p - MkPolynomial listL =+= MkPolynomial listR = {-# SCC "merge" #-} MkPolynomial $ merge listL listR where - merge [] r = r - merge l [] = l - merge l@(lh : ls) r@(rh : rs) = case lh <=> rh of - GT -> lh : merge ls r - LT -> rh : merge l rs - _ -> case lh `Data.Monomial.shiftCoefficient` Data.Monomial.getCoefficient rh of - (0, _) -> merge ls rs - monomial -> monomial : merge ls rs - - additiveInverse = lift (Data.Monomial.negateCoefficient `map`) - multiplicativeIdentity = one - additiveIdentity = zero - -{- - Override the default implementation, - in order to take advantage of the symmetry under reflection about the main diagonal, - in the square matrix of products formed from the multiplication of each term by each term. - Eg: - (ax^3 + bx^2 + cx + d)^2 = [ - (a^2x^6 + abx^5 + acx^4 + adx^3) + - (bax^5 + b^2x^4 + bcx^3 + bdx^2) + - (cax^4 + cbx^3 + c^2x^2 + cdx) + - (dax^3 + dbx^2 + dcx + d^2) - ] - - = (a^2x^6 + b^2x^4 + c^2x^2 + d^2) + 2 * [ax^3 * (bx^2 + cx + d) + bx^2 * (cx + d) + cx * (d)] --} - square (MkPolynomial []) = zero - square p = Data.Ring.sum' (recip 2) {-TODO-} 10 {-empirical-} $ diagonal : corners where - diagonal = {-# SCC "diagonal" #-} map Data.Monomial.square `lift` p - corners = {-# SCC "corners" #-} uncurry ( - zipWith (*=) - ) $ map MkPolynomial . init {-remove terminal null-} . Data.List.tails . tail &&& map Data.Monomial.double $ getMonomialList p - --- | Defines the ability to divide /polynomials/. -instance ( - Eq c, - Fractional c, - Num e, - Ord e - ) => Data.QuotientRing.QuotientRing (Polynomial c e) where -{- - Uses /Euclidian division/. - . - . --} - _ `quotRem'` MkPolynomial [] = error "Factory.Data.Polynomial.quotRem':\tzero denominator." - polynomialN `quotRem'` polynomialD = longDivide polynomialN where --- longDivide :: (Fractional c, Num e, Ord e) => Polynomial c e -> (Polynomial c e, Polynomial c e) - longDivide (MkPolynomial []) = (zero, zero) -- Exactly divides. - longDivide numerator - | Data.Monomial.getExponent quotient < 0 = (zero, numerator) -- Indivisible remainder. - | otherwise = Control.Arrow.first (lift (quotient :)) $ longDivide (numerator =-= polynomialD *= quotient ) - where --- quotient :: (Fractional c, Num e) => Data.Monomial.Monomial c e - quotient = getLeadingTerm numerator getLeadingTerm polynomialD - -{- | - * Transforms the data behind the constructor. - - * CAVEAT: similar to 'Data.Functor.fmap', but 'Polynomial' isn't an instance of 'Data.Functor.Functor' since we may want to operate on both /type-parameters/. - - * CAVEAT: the caller is required to re-'normalise' the resulting polynomial depending on the nature of the transformation of the data. --} -lift :: (MonomialList c1 e1 -> MonomialList c2 e2) -> Polynomial c1 e1 -> Polynomial c2 e2 -lift transform = MkPolynomial . transform . getMonomialList - --- | Returns the number of non-zero terms in the polynomial. -terms :: Polynomial c e -> Int -terms (MkPolynomial l) = length l - --- | Return the highest-degree monomial. -getLeadingTerm :: Polynomial c e -> Data.Monomial.Monomial c e -getLeadingTerm (MkPolynomial []) = error "Factory.Data.Polynomial.getLeadingTerm:\tzero polynomial has no leading term." -getLeadingTerm (MkPolynomial (m : _)) = m - --- | Removes terms with a /coefficient/ of zero. -pruneCoefficients :: (Eq c, Num c) => Polynomial c e -> Polynomial c e -pruneCoefficients (MkPolynomial []) = zero -pruneCoefficients p = filter ((/= 0) . Data.Monomial.getCoefficient) `lift` p - --- | Sorts into /descending order/ of exponents, groups /like/ exponents, and calls 'pruneCoefficients'. -normalise :: (Eq c, Num c, Ord e) => Polynomial c e -> Polynomial c e -normalise = pruneCoefficients . lift ( - map ( - foldr ((+) . Data.Monomial.getCoefficient) 0 &&& Data.Monomial.getExponent . head - ) . Data.List.groupBy (=~) . Data.List.sortBy (flip (<=>)) - ) - --- | Constructs an arbitrary /zeroeth-degree polynomial/, ie. independent of the /indeterminate/. -mkConstant :: (Eq c, Num c, Num e) => c -> Polynomial c e -mkConstant 0 = zero -mkConstant c = MkPolynomial [(c, 0)] - --- | Constructs an arbitrary /first-degree polynomial/. -mkLinear :: (Eq c, Num c, Num e) - => c -- ^ Gradient. - -> c -- ^ Constant. - -> Polynomial c e -mkLinear m c = pruneCoefficients $ MkPolynomial [(m, 1), (c, 0)] - --- | Smart constructor. Constructs an arbitrary /polynomial/. -mkPolynomial :: (Eq c, Num c, Ord e) => MonomialList c e -> Polynomial c e -mkPolynomial [] = zero -mkPolynomial l = normalise $ MkPolynomial l - --- | Constructs a /polynomial/ with zero terms. -zero :: Polynomial c e -zero = MkPolynomial [] - --- | Constructs a constant /monomial/, independent of the /indeterminate/. -one :: (Eq c, Num c, Num e) => Polynomial c e -one = mkConstant 1 - --- | True if all /exponents/ are in the order defined by the specified comparator. -inOrder :: (e -> e -> Bool) -> Polynomial c e -> Bool -inOrder comparator p - | any ($ p) [isZero, isMonomial] = True - | otherwise = and . uncurry (zipWith comparator) . (init &&& tail) . map Data.Monomial.getExponent $ getMonomialList p - --- | True if the /exponents/ of successive terms are in /ascending/ order. -inAscendingOrder :: Ord e => Polynomial c e -> Bool -inAscendingOrder = inOrder (<=) - --- | True if the /exponents/ of successive terms are in /descending/ order. -inDescendingOrder :: Ord e => Polynomial c e -> Bool -inDescendingOrder = inOrder (>=) - --- | True if no term has a /coefficient/ of zero. -isReduced :: (Eq c, Num c) => Polynomial c e -> Bool -isReduced = all ((/= 0) . Data.Monomial.getCoefficient) . getMonomialList - --- | True if no term has a /coefficient/ of zero and the /exponents/ of successive terms are in /descending/ order. -isNormalised :: (Eq c, Num c, Ord e) => Polynomial c e -> Bool -isNormalised polynomial = all ($ polynomial) [isReduced, inDescendingOrder] - -{- | - * 'True' if the /leading coefficient/ is one. - - * . --} -isMonic :: (Eq c, Num c) => Polynomial c e -> Bool -isMonic (MkPolynomial []) = False -- All coefficients are zero, and have therefore been removed. -isMonic p = (== 1) . Data.Monomial.getCoefficient $ getLeadingTerm p - --- | True if there are zero terms. -isZero :: Polynomial c e -> Bool -isZero (MkPolynomial []) = True -isZero _ = False - --- | True if there's exactly one term. -isMonomial :: Polynomial c e -> Bool -isMonomial (MkPolynomial []) = True -isMonomial _ = False - --- | True if all /exponents/ are /positive/ integers as required. -isPolynomial :: Integral e => Polynomial c e -> Bool -isPolynomial = all Data.Monomial.isMonomial . getMonomialList - -{- | - * 'True' if the two specified /polynomials/ are /congruent/ in /modulo/-arithmetic. - - * . --} -areCongruentModulo :: (Integral c, Num e, Ord e) - => Polynomial c e -- ^ LHS. - -> Polynomial c e -- ^ RHS. - -> c -- ^ Modulus. - -> Bool -areCongruentModulo _ _ 0 = error "Factory.Data.Polynomial.areCongruentModulo:\tzero modulus." -areCongruentModulo _ _ 1 = True -areCongruentModulo l r modulus - | l == r = True - | otherwise = all ((== 0) . (`mod` modulus) . Data.Monomial.getCoefficient) . getMonomialList $ l =-= r - -{- | - * Return the /degree/ (AKA /order/) of the /polynomial/. - - * . - - * . --} -getDegree :: Num e => Polynomial c e -> e -getDegree (MkPolynomial []) = -1 -- CAVEAT: debatable, but makes some operations more robust and consistent. -getDegree p = Data.Monomial.getExponent $ getLeadingTerm p - -{- | - * Scale-up the specified /polynomial/ by a constant /monomial/ factor. - - * . --} -(*=) :: (Eq c, Num c, Num e) => Polynomial c e -> Data.Monomial.Monomial c e -> Polynomial c e -polynomial *= monomial - | Data.Monomial.getCoefficient monomial == 1 = map (`Data.Monomial.shiftExponent` Data.Monomial.getExponent monomial) `lift` polynomial - | otherwise = map (monomial <*>) `lift` polynomial - -{- | - * Raise a /polynomial/ to the specified positive integral power, but using /modulo/-arithmetic. - - * Whilst one could naively implement this as @(x Data.Ring.=^ n) `mod` m@, this will result in arithmetic operatons on unnecessarily big integers. --} -raiseModulo :: (Integral c, Integral power, Num e, Ord e, Show power) - => Polynomial c e -- ^ The base. - -> power -- ^ The exponent to which the base should be raised. - -> c -- ^ The modulus. - -> Polynomial c e -- ^ The result. -raiseModulo _ _ 0 = error "Factory.Data.Polynomial.raiseModulo:\tzero modulus." -raiseModulo _ _ 1 = zero -raiseModulo _ 0 modulus = mkConstant $ 1 `mod` modulus -raiseModulo polynomial power modulus - | power < 0 = error $ "Factory.Data.Polynomial.raiseModulo:\tthe result isn't guaranteed to be a polynomial, for power=" ++ show power - | first `elem` [zero, one] = first -- Eg 'raiseModulo (mkPolynomial [(3,1)]) 100 3' or 'raiseModulo (mkPolynomial [(3,1),(1,0)]) 100 3'. - | otherwise = slave power - where --- first :: Integral c => Polynomial c e - first = polynomial `mod'` modulus - --- slave :: (Integral c, Integral power, Num e, Ord e) => power -> Polynomial c e - slave 1 = first - slave n = (`mod'` modulus) . (if r == 0 {-even-} then id else (polynomial =*=)) . Data.Ring.square $ slave q {-recurse-} where - (q, r) = n `quotRem` 2 - --- | Reduces all the coefficients using /modular/ arithmetic. -mod' :: Integral c - => Polynomial c e - -> c -- ^ Modulus. - -> Polynomial c e -mod' p modulus = pruneCoefficients $ map (`Data.Monomial.mod'` modulus) `lift` p - -{- | - * Evaluate the /polynomial/ at a specific /indeterminate/. - - * CAVEAT: requires positive exponents; but it wouldn't really be a /polynomial/ otherwise. - - * If the /polynomial/ is very sparse, this may be inefficient, - since it /memoizes/ the complete sequence of powers up to the polynomial's /degree/. --} -evaluate :: (Num n, Integral e, Show e) - => n -- ^ The /indeterminate/. - -> Polynomial n e - -> n -- ^ The Result. -evaluate x = foldr ((+) . raise) 0 . getMonomialList where - powers = iterate (* x) 1 - - raise monomial - | exponent' < 0 = error $ "Factory.Data.Polynomial.evaluate.raise:\tnegative exponent; " ++ show exponent' - | otherwise = Data.Monomial.getCoefficient monomial * Data.List.genericIndex powers exponent' - where - exponent' = Data.Monomial.getExponent monomial - --- | Convert the type of the /coefficient/s. -realCoefficientsToFrac :: (Real r, Fractional f) => Polynomial r e -> Polynomial f e -realCoefficientsToFrac = lift (Data.Monomial.realCoefficientToFrac `map`) - diff --git a/src/Factory/Data/PrimeFactors.hs b/src/Factory/Data/PrimeFactors.hs deleted file mode 100644 --- a/src/Factory/Data/PrimeFactors.hs +++ /dev/null @@ -1,143 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Describes a list of /prime factors/. - - * The product of this list of prime-factors represents the /composite/ integer from which they were originally extracted. --} - -module Factory.Data.PrimeFactors( --- * Types --- ** Type-synonyms - Factors, --- * Functions - insert', --- invert, - product', - reduce, --- reduceSorted, --- sumExponents, --- ** Operators - (>*<), - (>/<), - (>^) -) where - -import qualified Control.Arrow -import Control.Arrow((&&&)) -import qualified Data.List -import qualified Data.Ord -import qualified Factory.Math.DivideAndConquer as Math.DivideAndConquer -import qualified Factory.Data.Exponential as Data.Exponential -import Factory.Data.Exponential((<^), (=~)) -import qualified ToolShed.Data.List - -infixl 7 >/<, >*< -- Same as (/). -infixr 8 >^ -- Same as (^). - -{- | - * Each element of this list represents one /prime-factor/, expressed as an /exponential/ with a /prime/ base, of the original integer. - - * Whilst it only makes sense for both the /base/ and /exponent/ to be integral, these constrains are applied at the function-level as required. --} -type Factors base exponent = [Data.Exponential.Exponential base exponent] - -{- | - * Sorts a list representing a product of /prime factors/ by increasing /base/. - - * Multiplies 'Data.Exponential.Exponential's of similar /base/. --} -reduce :: (Ord base, Num exponent, Ord exponent) => Factors base exponent -> Factors base exponent -reduce = reduceSorted . Data.List.sort {-primarily by base-} - --- | Multiplies 'Data.Exponential.Exponential's of similar /base/. -reduceSorted :: (Eq base, Num exponent) => Factors base exponent -> Factors base exponent --- reduceSorted = map (Data.Exponential.getBase . head &&& sumExponents) . Data.List.groupBy (=~) -- Slow -reduceSorted [] = [] -reduceSorted (x : xs) - | null matched = x : reduceSorted remainder - | otherwise = Control.Arrow.second (+ sumExponents matched) x : reduceSorted remainder - where - (matched, remainder) = span (=~ x) xs - -{- | - * Insert a 'Data.Exponential.Exponential', into a list representing a product of /prime factors/, multiplying with any incumbent of like /base/. - - * The list should be sorted by increasing /base/. - - * Preserves the sort-order. - - * CAVEAT: this is tolerably efficient for sporadic insertion; to insert a list, use '>*<'. --} -insert' :: (Ord base, Num exponent) => Data.Exponential.Exponential base exponent -> Factors base exponent -> Factors base exponent -insert' e [] = [e] -insert' e l@(x : xs) = case Data.Ord.comparing Data.Exponential.getBase e x of - LT -> e : l - GT -> x : insert' e xs -- Recurse. - _ -> Control.Arrow.second (+ Data.Exponential.getExponent e) x : xs -- Multiply by adding exponents. - -{- | - * Multiplies two lists each representing a product of /prime factors/, and sorted by increasing /base/. - - * Preserves the sort-order. --} -(>*<) :: (Ord base, Num exponent, Ord exponent) => Factors base exponent -> Factors base exponent -> Factors base exponent -l >*< r = reduceSorted $ ToolShed.Data.List.merge l r - --- | Invert the product of a list /prime factors/, by negating each of the /exponents/. -invert :: Num exponent => Factors base exponent -> Factors base exponent -invert = map Data.Exponential.invert - -{- | - * Divides two lists, each representing a product of /prime factors/, and sorted by increasing /base/. - - * Preserves the sort-order. --} -(>/<) :: (Integral base, Integral exponent) - => Factors base exponent -- ^ The list of /prime factors/ in the /numerator/. - -> Factors base exponent -- ^ The list of /prime factors/ in the /denominator/. - -> (Factors base exponent, Factors base exponent) -- ^ The ratio of /numerator/ and /denominator/, after like /prime factors/ are cancelled. -numerator >/< denominator = filter ( - (> 0) . Data.Exponential.getExponent - ) &&& invert . filter ( - (< 0) . Data.Exponential.getExponent - ) $ numerator >*< invert denominator - -{- | - * Raise the product of a list /prime factors/ to the specified power. - - * CAVEAT: this merely involves raising each element to the specified power; cf. raising a /polynomial/ to a power. --} -(>^) :: Num exponent => Factors base exponent -> exponent -> Factors base exponent -factors >^ power = map (<^ power) factors - --- | Sum the /exponents/ of the specified list; as required to multiply exponentials with identical /base/. -sumExponents :: Num exponent => Factors base exponent -> exponent -sumExponents = foldr ((+) . Data.Exponential.getExponent) 0 - --- | Multiply a list of /prime factors/. -product' :: (Num base, Integral exponent) - => Math.DivideAndConquer.BisectionRatio - -> Math.DivideAndConquer.MinLength - -> Factors base exponent -- ^ The list on which to operate. - -> base -- ^ The result. -product' bisectionRatio minLength = Math.DivideAndConquer.product' bisectionRatio minLength . map Data.Exponential.evaluate - diff --git a/src/Factory/Data/PrimeWheel.hs b/src/Factory/Data/PrimeWheel.hs deleted file mode 100644 --- a/src/Factory/Data/PrimeWheel.hs +++ /dev/null @@ -1,198 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines a /prime-wheel/, for use in prime-number generation; . --} - -module Factory.Data.PrimeWheel( --- * Types --- ** Type-synonyms - Distance, - NPrimes, - PrimeMultiples, --- Repository, --- ** Data-types - PrimeWheel(getPrimeComponents, getSpokeGaps), --- * Functions - estimateOptimalSize, --- findCoprimes, - generateMultiples, - roll, - rotate, --- ** Constructors - mkPrimeWheel, --- ** Query - getCircumference, - getSpokeCount -) where - -import Control.Arrow((&&&), (***)) -import qualified Data.IntMap -import qualified Data.List - -{- | - * A conceptual /wheel/, with irregularly spaced spokes; . - - * On being rolled, the trace of the spokes, identifies candidates which are /coprime/ to those primes from which the /wheel/ was composed. - - * One can alternatively view this as a set of vertical nested rings, each with a /prime circumference/, and touching at its lowest point. - Each has a single mark on its /circumference/, which when rolled identifies multiples of that /circumference/. - When the complete set is rolled, from the state where all marks are coincident, all multiples of the set of primes, are traced. - - * CAVEAT: The distance required to return to this state (the wheel's /circumference/), grows rapidly with the number of primes: - -> zip [0 ..] . scanl (*) 1 $ [2,3,5,7,11,13,17,19,23,29,31] -> [(0,1),(1,2),(2,6),(3,30),(4,210),(5,2310),(6,30030),(7,510510),(8,9699690),(9,223092870),(10,6469693230),(11,200560490130)] - - * The number of spokes also grows rapidly with the number of primes: - -> zip [0 ..] . scanl (*) 1 . map pred $ [2,3,5,7,11,13,17,19,23,29,31] -> [(0,1),(1,1),(2,2),(3,8),(4,48),(5,480),(6,5760),(7,92160),(8,1658880),(9,36495360),(10,1021870080),(11,30656102400)] --} -data PrimeWheel i = MkPrimeWheel { - getPrimeComponents :: [i], -- ^ Accessor: the ordered sequence of initial primes, from which the /wheel/ was composed. - getSpokeGaps :: [i] -- ^ Accessor: the sequence of spoke-gaps, the sum of which equals its /circumference/. -} deriving Show - --- | The /circumference/ of the specified 'PrimeWheel'. -getCircumference :: Integral i => PrimeWheel i -> i -getCircumference = product . getPrimeComponents - --- | The number of spokes in the specified 'PrimeWheel'. -getSpokeCount :: Integral i => PrimeWheel i -> i -getSpokeCount = foldr ((*) . pred) 1 . getPrimeComponents - --- | An infinite increasing sequence, of the multiples of a specific prime. -type PrimeMultiples i = [i] - --- | Defines a container for the 'PrimeMultiples'. -type Repository = Data.IntMap.IntMap (PrimeMultiples Int) - --- | The size of the /wheel/, measured by the number of primes from which it is composed. -type NPrimes = Int - -{- | - * Uses a /Sieve of Eratosthenes/ (), to generate an initial sequence of primes. - - * Also generates an infinite sequence of candidate primes, each of which is /coprime/ to the primes just found, e.g.: - @filter ((== 1) . (gcd (2 * 3 * 5 * 7))) [11 ..] = [11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,121 ..]@; NB /121/ isn't prime. - - * CAVEAT: the use, for efficiency, of "Data.IntMap", limits the maximum bound of this sequence, though not to a significant extent. --} -findCoprimes :: NPrimes -> ([Int], [Int]) -findCoprimes 0 = ([], []) -findCoprimes required - | required < 0 = error $ "Factory.Data.PrimeWheel.findCoprimes: invalid number of coprimes; " ++ show required - | otherwise = splitAt required $ 2 : sieve 3 0 Data.IntMap.empty - where - sieve :: Int -> NPrimes -> Repository -> [Int] - sieve candidate found repository = case Data.IntMap.lookup candidate repository of - Just primeMultiples -> sieve' found . insertUniq primeMultiples $ Data.IntMap.delete candidate repository -- Re-insert subsequent multiples. - Nothing {-prime-} -> let - found' = succ found - (key : values) = iterate (+ gap * candidate) $ candidate ^ (2 :: Int) -- Generate a sequence of prime-multiples, starting from its square. - in candidate : sieve' found' ( - if found' >= required - then repository - else Data.IntMap.insert key values repository - ) - where - gap :: Int - gap = 2 -- For efficiency, only sieve odd integers. - - sieve' :: NPrimes -> Repository -> [Int] - sieve' = sieve $ candidate + gap -- Tail-recurse. - - insertUniq :: PrimeMultiples Int -> Repository -> Repository - insertUniq l m = insert $ dropWhile (`Data.IntMap.member` m) l where - insert :: PrimeMultiples Int -> Repository - insert [] = error "Factory.Data.PrimeWheel.findCoprimes.sieve.insertUniq.insert:\tnull list" - insert (key : values) = Data.IntMap.insert key values m -{- | - * The optimal number of low primes from which to build the /wheel/, grows with the number of primes required; - the /circumference/ should be approximately the /square-root/ of the number of integers it will be required to sieve. - - * CAVEAT: one greater than this is returned, which empirically seems better. --} -estimateOptimalSize :: Integral i => i -> NPrimes -estimateOptimalSize maxPrime = succ . length . takeWhile (<= optimalCircumference) . scanl1 (*) {-circumference-} . map fromIntegral {-prevent overflow-} . fst {-primes-} $ findCoprimes 10 {-arbitrary maximum bound-} where - optimalCircumference :: Integer - optimalCircumference = round (sqrt $ fromIntegral maxPrime :: Double) - -{- | - Smart constructor for a /wheel/ from the specified number of low primes. - - * The optimal number of low primes from which to build the /wheel/, grows with the number of primes required; - the /circumference/ should be approximately the /square-root/ of the number of integers it will be required to sieve. - - * The sequence of gaps between spokes on the /wheel/ is /symmetrical under reflection/; - though two values lie /on/ the axis, that aren't part of this symmetry. Eg: - -> nPrimes Gaps -> ====== ==== -> 0 [1] -> 1 [2] -- The terminal gap for all subsequent wheels is '2'; [(succ circumference `mod` circumference) - (pred circumference `mod` circumference)]. -> 2 [4,2] -- Both points are on the axis, so the symmetry isn't yet clear. -> 3 [6,4,2,4,2,4,6,2] -> 4 [10,2,4,2,4,6,2,6,4,2,4,6,6,2,6,4,2,6,4,6,8,4,2,4,2,4,8,6,4,6,2,4,6,2,6,6,4,2,4,6,2,6,4,2,4,2,10,2] - - Exploitation of this property has proved counter-productive, probably because it requires /strict evaluation/, - exposing the user to the full cost of inadvertently choosing a /wheel/, which in practice, is rotated less than once. --} -mkPrimeWheel :: Integral i => NPrimes -> PrimeWheel i -mkPrimeWheel 0 = MkPrimeWheel [] [1] -mkPrimeWheel nPrimes - | nPrimes < 0 = error $ "Factory.Data.PrimeWheel.mkPrimeWheel: unable to construct from " ++ show nPrimes ++ " primes" - | otherwise = primeWheel - where - (primeComponents, coprimeCandidates) = (map fromIntegral *** map fromIntegral . Data.List.genericTake (getSpokeCount primeWheel)) $ findCoprimes nPrimes - primeWheel = MkPrimeWheel primeComponents $ zipWith (-) coprimeCandidates $ 1 : coprimeCandidates -- Measure the gaps between candidate primes. - --- | Couples a candidate prime with a /rolling wheel/, to define the distance rolled. -type Distance i = (i, [i]) - --- | Generates a new candidate prime, from a /rolling wheel/, and the current candidate. -rotate :: Integral i => Distance i -> Distance i -rotate (candidate, rollingWheel) = (candidate +) . head &&& tail $ rollingWheel - -{-# INLINE rotate #-} - --- | Generate an infinite, increasing sequence of candidate primes, from the specified /wheel/. -roll :: Integral i => PrimeWheel i -> [Distance i] -roll primeWheel = tail $ iterate rotate (1, cycle $ getSpokeGaps primeWheel) - -{- | - * Generates multiples of the specified prime, starting from its /square/, - skipping those multiples of the low primes from which the specified 'PrimeWheel' was composed, - and which therefore, the /wheel/ won't generate as candidates. Eg: - -> Prime Rotating PrimeWheel 3 Output -> ===== ===================== ====== -> 7 [4,2,4,2,4,6,2,6] [49,77,91,119,133,161,203,217,259 ..] -> 11 [2,4,2,4,6,2,6,4] [121,143,187,209,253,319,341,407 ..] -> 13 [4,2,4,6,2,6,4,2] [169,221,247,299,377,403,481,533,559 ..] --} -generateMultiples :: Integral i - => i -- ^ The number to square and multiply - -> [i] -- ^ A /rolling wheel/, the track of which, delimits the gaps between /coprime/ candidates. - -> [i] -generateMultiples i = scanl (\accumulator -> (+ accumulator) . (* i)) (i ^ (2 :: Int)) - -{-# INLINE generateMultiples #-} - diff --git a/src/Factory/Data/QuotientRing.hs b/src/Factory/Data/QuotientRing.hs deleted file mode 100644 --- a/src/Factory/Data/QuotientRing.hs +++ /dev/null @@ -1,79 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Describes a /Quotient Ring/; . - - * This is a /ring/ composed from a residue-class resulting from /modular/ division. --} - -module Factory.Data.QuotientRing( --- * Type-classes - QuotientRing(..), --- * Functions - quot', - rem', --- ** Predicates - areCongruentModulo, - isDivisibleBy -) where - -import Factory.Data.Ring((=-=)) -import qualified Factory.Data.Ring as Data.Ring - --- | Defines a sub-class of 'Data.Ring.Ring', in which division is implemented. -class Data.Ring.Ring q => QuotientRing q where - quotRem' :: q -> q -> (q, q) -- ^ Divides the first operand by the second, to yield a pair composed from the /quotient/ and the /remainder/. - --- | Returns the /quotient/, after division of the two specified 'QuotientRing's. -quot' :: QuotientRing q - => q -- ^ Numerator. - -> q -- ^ Denominator. - -> q -quot' numerator = fst . quotRem' numerator - --- | Returns the /remainder/, after division of the two specified 'QuotientRing's. -rem' :: QuotientRing q - => q -- ^ Numerator. - -> q -- ^ Denominator. - -> q -rem' numerator = snd . quotRem' numerator - -{- | - * 'True' if the two specified 'QuotientRing's are /congruent/ in /modulo/-arithmetic, where the /modulus/ is a third 'QuotientRing'. - - * . --} -areCongruentModulo :: (Eq q, QuotientRing q) - => q -- ^ LHS. - -> q -- ^ RHS. - -> q -- ^ Modulus. - -> Bool -areCongruentModulo l r modulus - | l == r = True -- Only required for efficiency. - | otherwise = (l =-= r) `isDivisibleBy` modulus - --- | True if the second operand /divides/ the first. -isDivisibleBy :: (Eq q, QuotientRing q) - => q -- ^ Numerator. - -> q -- ^ Denominator. - -> Bool -numerator `isDivisibleBy` denominator = rem' numerator denominator == Data.Ring.additiveIdentity - diff --git a/src/Factory/Data/Ring.hs b/src/Factory/Data/Ring.hs deleted file mode 100644 --- a/src/Factory/Data/Ring.hs +++ /dev/null @@ -1,118 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Describes a /ring/ and operations on its members. - - * . - - * . --} - -module Factory.Data.Ring( --- * Type-classes - Ring(..), --- * Types --- ** Data.types --- Product, --- Sum, --- * Functions - product', - sum', --- ** Operators - (=^) -) where - -import qualified Data.Monoid -import qualified Factory.Math.DivideAndConquer as Math.DivideAndConquer - -infixl 6 =+= -- Same as (+). -infixl 6 =-= -- Same as (-). -infixl 7 =*= -- Same as (*). -infixr 8 =^ -- Same as (^). - -{- | - * Define both the operations applicable to all members of the /ring/, and its mandatory members. - - * Minimal definition; '=+=', '=*=', 'additiveInverse', 'multiplicativeIdentity', 'additiveIdentity'. --} -class Ring r where - (=+=) :: r -> r -> r -- ^ Addition of two members; required to be /commutative/; . - (=*=) :: r -> r -> r -- ^ Multiplication of two members. - additiveInverse :: r -> r -- ^ The operand required to yield /zero/ under addition; . - multiplicativeIdentity :: r -- ^ The /identity/-member under multiplication; . - additiveIdentity :: r -- ^ The /identity/-member under addition (AKA /zero/); . - - (=-=) :: r -> r -> r -- ^ Subtract the two specified /ring/-members. - l =-= r = l =+= additiveInverse r -- Default implementation. - - square :: r -> r -- ^ Square the ring. - square r = r =*= r -- Default implementation; there may be a more efficient one. - -{- | - * Raise a /ring/-member to the specified positive integral power. - - * Exponentiation is implemented as a sequence of either squares of, or multiplications by, the /ring/-member; - . --} -(=^) :: ( - Eq r, - Integral power, - Ring r, - Show power - ) => r -> power -> r -_ =^ 0 = multiplicativeIdentity -ring =^ power - | power < 0 = error $ "Factory.Data.Ring.(=^):\tthe result isn't guaranteed to be a ring-member, for power=" ++ show power - | ring `elem` [additiveIdentity, multiplicativeIdentity] = ring - | otherwise = slave power - where - slave 1 = ring - slave n = (if r == 0 {-even-} then id else (=*= ring)) . square $ slave q where - (q, r) = n `quotRem` 2 - --- | Does for 'Ring', what 'Data.Monoid.Product' does for type 'Num', in that it makes it an instance of 'Data.Monoid.Monoid' under multiplication. -newtype Product p = MkProduct { - getProduct :: p -- ^ Access the polymorphic payload. -} deriving (Read, Show) - -instance Ring r => Data.Monoid.Monoid (Product r) where - mempty = MkProduct multiplicativeIdentity - MkProduct x `mappend` MkProduct y = MkProduct $ x =*= y - --- | Returns the /product/ of the list of /ring/-members. -product' :: Ring r => Math.DivideAndConquer.BisectionRatio -> Math.DivideAndConquer.MinLength -> [r] -> r --- product' _ _ = getProduct . Data.Monoid.mconcat . map MkProduct -product' ratio minLength = getProduct . Math.DivideAndConquer.divideAndConquer ratio minLength . map MkProduct - --- | Does for 'Ring', what 'Data.Monoid.Sum' does for type 'Num', in that it makes it an instance of 'Data.Monoid.Monoid' under addition. -newtype Sum s = MkSum { - getSum :: s -- ^ Access the polymorphic payload. -} deriving (Read, Show) - -instance Ring r => Data.Monoid.Monoid (Sum r) where - mempty = MkSum additiveIdentity - MkSum x `mappend` MkSum y = MkSum $ x =+= y - --- | Returns the /sum/ of the list of /ring/-members. -sum' :: Ring r => Math.DivideAndConquer.BisectionRatio -> Math.DivideAndConquer.MinLength -> [r] -> r --- sum' _ _ = getSum . Data.Monoid.mconcat . map MkSum -sum' ratio minLength = getSum . Math.DivideAndConquer.divideAndConquer ratio minLength . map MkSum - diff --git a/src/Factory/Math/ArithmeticGeometricMean.hs b/src/Factory/Math/ArithmeticGeometricMean.hs deleted file mode 100644 --- a/src/Factory/Math/ArithmeticGeometricMean.hs +++ /dev/null @@ -1,91 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Determines the /Arithmetic-geometric mean/; . --} - -module Factory.Math.ArithmeticGeometricMean( --- * Types --- ** Type-synonyms - ArithmeticMean, - GeometricMean, - AGM, --- * Functions - convergeToAGM, - spread, --- ** Accessors - getArithmeticMean, - getGeometricMean, --- ** Predicates - isValid -) where - -import Control.Arrow((&&&)) -import qualified Control.Parallel.Strategies -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.SquareRoot as Math.SquareRoot - --- | The type of the /arithmetic mean/; . -type ArithmeticMean = Rational - --- | The type of the /geometric mean/; . -type GeometricMean = Rational - --- | Encapsulates both /arithmetic/ and /geometric/ means. -type AGM = (ArithmeticMean, GeometricMean) - --- | Accessor. -{-# INLINE getArithmeticMean #-} -getArithmeticMean :: AGM -> ArithmeticMean -getArithmeticMean = fst - --- | Accessor. -{-# INLINE getGeometricMean #-} -getGeometricMean :: AGM -> GeometricMean -getGeometricMean = snd - --- | Returns an infinite list which converges on the /Arithmetic-geometric mean/. -convergeToAGM :: Math.SquareRoot.Algorithmic squareRootAlgorithm => squareRootAlgorithm -> Math.Precision.DecimalDigits -> AGM -> [AGM] -convergeToAGM squareRootAlgorithm decimalDigits agm - | decimalDigits <= 0 = error $ "Factory.Math.ArithmeticGeometricMean.convergeToAGM:\tinvalid number of decimal digits; " ++ show decimalDigits - | not $ isValid agm = error $ "Factory.Math.ArithmeticGeometricMean.convergeToAGM:\tboth means must be positive for a real geometric mean; " ++ show agm - | spread agm == 0 = repeat agm - | otherwise = let - simplify :: Rational -> Rational - simplify = Math.Precision.simplify (pred decimalDigits {-ignore single integral digit-}) -- This makes a gigantic difference to performance. - - findArithmeticMean :: AGM -> ArithmeticMean - findArithmeticMean = (/ 2) . uncurry (+) - - findGeometricMean :: AGM -> GeometricMean - findGeometricMean = Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits . uncurry (*) - in iterate ( - Control.Parallel.Strategies.withStrategy ( - Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rdeepseq Control.Parallel.Strategies.rdeepseq - ) . (simplify . findArithmeticMean &&& simplify . findGeometricMean) - ) agm - --- | Returns the bounds within which the 'AGM' has been constrained. -spread :: AGM -> Rational -spread = uncurry (-) - --- | Checks that both /means/ are positive, as required for the /geometric mean/ to be consistently /real/. -isValid :: AGM -> Bool -isValid (a, g) = all (>= 0) [a, g] - diff --git a/src/Factory/Math/DivideAndConquer.hs b/src/Factory/Math/DivideAndConquer.hs deleted file mode 100644 --- a/src/Factory/Math/DivideAndConquer.hs +++ /dev/null @@ -1,122 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Provides a polymorphic algorithm, to /unfold/ a list into a tree, to which an /associative binary operator/ is then applied to re-/fold/ the tree to a /scalar/. - - * Implementations of this strategy have been provided for /addition/ and /multiplication/, - though other associative binary operators, like 'gcd' or 'lcm' could also be used. - - * Where the contents of the list are consecutive, a more efficient implementation is available in /Factory.Data.Interval/. --} - -module Factory.Math.DivideAndConquer( --- * Types --- ** Type-synonyms - BisectionRatio, - MinLength, --- * Functions - divideAndConquer, - product', - sum' -) where - -import Control.Arrow((***)) -import qualified Control.Parallel.Strategies -import qualified Data.Monoid -import qualified Data.Ratio - -{- | - * The ratio of the original list-length at which to bisect. - - * CAVEAT: the value can overflow. --} -type BisectionRatio = Data.Ratio.Ratio Int - --- | The list-length beneath which to terminate bisection. -type MinLength = Int - -{- | - * Reduces a list to a single scalar encapsulated in a 'Data.Monoid.Monoid', - using a /divide-and-conquer/ strategy, - bisecting the list and recursively evaluating each part; . - - * By choosing a 'bisectionRatio' other than @(1 % 2)@, the bisection can be made asymmetrical. - The specified ratio represents the length of the left-hand portion, over the original list-length; - eg. @(1 % 3)@ results in the first part, half the length of the second. - - * This process of recursive bisection, is terminated beneath the specified minimum list-length, - after which the /monoid/'s binary operator is directly /folded/ over the list. - - * One can view this as a , - in which the list is exploded into a binary tree-structure - (each leaf of which contains a list of up to 'minLength' integers, and each node of which contains an associative binary operator), - and then collapsed to a scalar, by application of the operators. --} -divideAndConquer :: Data.Monoid.Monoid monoid - => BisectionRatio -- ^ The ratio of the original list-length at which to bisect. - -> MinLength -- ^ For efficiency, the list will not be bisected, when it's length has been reduced to this value. - -> [monoid] -- ^ The list on which to operate. - -> monoid -- ^ The resulting scalar. -divideAndConquer bisectionRatio minLength l - | any ($ apportion minLength) [ - (< 1), -- The left-hand list may be null. - (> pred minLength) -- The right-hand list may be null. - ] = error $ "Factory.Math.DivideAndConquer.divideAndConquer:\tbisectionRatio='" ++ show bisectionRatio ++ "' is incompatible with minLength=" ++ show minLength ++ "." - | otherwise = slave (length l) l - where - apportion :: Int -> Int - apportion list = (list * Data.Ratio.numerator bisectionRatio) `div` Data.Ratio.denominator bisectionRatio - - slave len list - | len <= minLength = Data.Monoid.mconcat list -- Fold the monoid's binary operator over the list. - | otherwise = uncurry Data.Monoid.mappend . Control.Parallel.Strategies.withStrategy ( - Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rseq Control.Parallel.Strategies.rseq - ) . (slave cut *** slave (len - cut)) $ splitAt cut list where -- Apply the monoid's binary operator to the two operands resulting from bisection. - cut = apportion len - -{- | - * Multiplies the specified list of numbers. - - * Since the result can be large, 'divideAndConquer' is used in an attempt to form operands of a similar order of magnitude, - which creates scope for the use of more efficient multiplication-algorithms. --} -product' :: Num n - => BisectionRatio -- ^ The ratio of the original list-length at which to bisect. - -> MinLength -- ^ For efficiency, the list will not be bisected, when it's length has been reduced to this value. - -> [n] -- ^ The numbers whose product is required. - -> n -- ^ The resulting product. -product' bisectionRatio minLength = Data.Monoid.getProduct . divideAndConquer bisectionRatio minLength . map Data.Monoid.Product - -{- | - * Sums the specified list of numbers. - - * Since the result can be large, 'divideAndConquer' is used in an attempt to form operands of a similar order of magnitude, - which creates scope for the use of more efficient multiplication-algorithms. - /Multiplication/ is required for the /addition/ of 'Rational' numbers by cross-multiplication; - this function is unlikely to be useful for other numbers. --} -sum' :: Num n - => BisectionRatio -- ^ The ratio of the original list-length at which to bisect. - -> MinLength -- ^ For efficiency, the list will not be bisected, when it's length has been reduced to this value. - -> [n] -- ^ The numbers whose sum is required. - -> n -- ^ The resulting sum. -sum' bisectionRatio minLength = Data.Monoid.getSum . divideAndConquer bisectionRatio minLength . map Data.Monoid.Sum - diff --git a/src/Factory/Math/Factorial.hs b/src/Factory/Math/Factorial.hs deleted file mode 100644 --- a/src/Factory/Math/Factorial.hs +++ /dev/null @@ -1,37 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Whilst this particular function is the subject of many introductory examples to Haskell, - the simple algorithms appropriate for that forum, leave a large margin for performance-improvement. - This module provides the interface for alternative algorithms. - - * . --} - -module Factory.Math.Factorial( --- * Type-classes - Algorithmic(..) -) where - --- | Defines the methods expected of a /factorial/-algorithm. -class Algorithmic algorithm where - factorial :: (Integral i, Show i) => algorithm -> i -> i - diff --git a/src/Factory/Math/Fibonacci.hs b/src/Factory/Math/Fibonacci.hs deleted file mode 100644 --- a/src/Factory/Math/Fibonacci.hs +++ /dev/null @@ -1,42 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] . --} - -module Factory.Math.Fibonacci( --- * Constants - fibonacci, - primeIndexedFibonacci -) where - -import qualified Data.Numbers.Primes - --- | A constant ordered list of the /Fibonacci/-numbers. -fibonacci :: Integral i => [i] -fibonacci = 0 : scanl (+) 1 fibonacci - -{- | - * The subset of 'fibonacci', /indexed/ by a /prime/-number. - - * . --} -primeIndexedFibonacci :: Integral i => [i] -primeIndexedFibonacci = map (fibonacci !!) Data.Numbers.Primes.primes - diff --git a/src/Factory/Math/Hyperoperation.hs b/src/Factory/Math/Hyperoperation.hs deleted file mode 100644 --- a/src/Factory/Math/Hyperoperation.hs +++ /dev/null @@ -1,113 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Provides various /hyperoperations/; . --} - -module Factory.Math.Hyperoperation( --- * Types --- ** Type-synonyms - Base, - HyperExponent, --- * Constants - succession, - addition, - multiplication, - exponentiation, - tetration, - pentation, - hexation, --- * Functions - hyperoperation, - ackermannPeter, - powerTower, --- ** Predicates - areCoincidental -) where - -import qualified Data.List - -{- | - * Merely to enhance self-documentation. - - * CAVEAT: whilst it may appear that 'Base' could be non-'Integral', the recursive definition for /hyper-exponents/ above 'tetration', prevents this. --} -type Base = Integer - -{- | - * Merely to enhance self-documentation. - - * CAVEAT: whilst 'Base' and 'HyperExponent' can be independent types for both 'exponentiation' and 'tetration', they interact for other /hyper-exponents/. --} -type HyperExponent = Base - -succession, addition, multiplication, exponentiation, tetration, pentation, hexation :: Int -- Arbitrarily. -(succession : addition : multiplication : exponentiation : tetration : pentation : hexation : _) = [0 ..] - -{- | - * Returns the /power-tower/ of the specified /base/; . - - * A synonym for /tetration/; - , - . --} -powerTower :: (Integral base, Integral hyperExponent, Show base) => base -> hyperExponent -> base -powerTower 0 hyperExponent - | even hyperExponent = 1 - | otherwise = 0 -powerTower _ (-1) = 0 -- The only negative hyper-exponent for which there's a consistent result. -powerTower base hyperExponent - | base < 0 && hyperExponent > 1 = error $ "Factory.Math.Hyperoperation.powerTower:\tundefined for negative base; " ++ show base - | otherwise = Data.List.genericIndex (iterate (base ^) 1) hyperExponent - --- | The /hyperoperation/-sequence; . -hyperoperation :: (Integral rank, Show rank) => rank -> Base -> HyperExponent -> Base -hyperoperation rank base hyperExponent - | rank < fromIntegral succession = error $ "Factory.Math.Hyperoperation.hyperoperation:\tundefined for rank; " ++ show rank - | hyperExponent < 0 = error $ "Factory.Math.Hyperoperation.hyperoperation:\tundefined for hyper-exponent; " ++ show hyperExponent - | otherwise = rank ^# hyperExponent - where - (^#) :: Integral rank => rank -> HyperExponent -> Base - r ^# 0 = case r of - 1 {-addition-} -> base - 2 {-multiplication-} -> 0 - _ -> 1 - r ^# e = case r of - 0 {-succession-} -> succ {-fromIntegral-} e - 1 {-addition-} -> base + {-fromIntegral-} e - 2 {-multiplication-} -> base * {-fromIntegral-} e - 3 {-exponentiation-} -> base ^ e - 4 {-tetration-} -> base `powerTower` e - _ - | e' == e -> tetration ^# e' -- To which it would otherwise be reduced by laborious recursion. - | otherwise -> pred r ^# e' - where - e' = {-fromIntegral $-} r ^# pred e - --- | The /Ackermann-Peter/-function; . -ackermannPeter :: (Integral rank, Show rank) => rank -> HyperExponent -> Base -ackermannPeter rank = (+ negate 3) . hyperoperation rank 2 {-base-} . (+ 3) - --- | True if @hyperoperation base hyperExponent@ has the same value for each specified 'rank'. -areCoincidental :: (Integral rank, Show rank) => Base -> HyperExponent -> [rank] -> Bool -areCoincidental _ _ [] = True -areCoincidental _ _ [_] = True -areCoincidental base hyperExponent ranks = all (== h) hs where - (h : hs) = map (\rank -> hyperoperation rank base hyperExponent) ranks - diff --git a/src/Factory/Math/Implementations/Factorial.hs b/src/Factory/Math/Implementations/Factorial.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Factorial.hs +++ /dev/null @@ -1,138 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Provides implementations of the class 'Math.Factorial.Algorithmic'. - - * Provides additional functions related to /factorials/, but which depends on a specific implementation, - and which therefore can't be accessed throught the class-interface. - - * . - - * . - - * . --} - -module Factory.Math.Implementations.Factorial( --- * Types --- ** Data-types - Algorithm(..), --- * Functions - primeFactors, --- primeMultiplicity, - risingFactorial, - fallingFactorial, --- ** Operators - (!/!) -) where - -import qualified Data.Numbers.Primes -import qualified Factory.Data.Interval as Data.Interval -import qualified Factory.Data.PrimeFactors as Data.PrimeFactors -import qualified Factory.Math.Factorial as Math.Factorial -import qualified ToolShed.Defaultable - -infixl 7 !/! -- Same as (/). - --- | The algorithms by which /factorial/ has been implemented. -data Algorithm = - Bisection -- ^ The integers from which the /factorial/ is composed, are multiplied using @Data.Interval.product'@. - | PrimeFactorisation -- ^ The /prime factors/ of the /factorial/ are extracted, then raised to the appropriate power, before multiplication. - deriving (Eq, Read, Show) - -instance ToolShed.Defaultable.Defaultable Algorithm where - defaultValue = Bisection - -instance Math.Factorial.Algorithmic Algorithm where - factorial algorithm n - | n < 2 = 1 - | otherwise = case algorithm of - Bisection -> risingFactorial 2 $ pred n - PrimeFactorisation -> Data.PrimeFactors.product' (recip 5) {-empirical-} 10 {-empirical-} $ primeFactors n - -{- | - * Returns the /prime factors/, of the /factorial/ of the specifed integer. - - * Precisely all the primes less than or equal to the specified integer /n/, are included in /n!/; - only the multiplicity of each of these known prime components need be determined. - - * . - - * CAVEAT: currently a hotspot. --} -primeFactors :: Integral base - => base -- ^ The number, whose /factorial/ is to be factorised. - -> Data.PrimeFactors.Factors base base -- ^ The /base/ and /exponent/ of each /prime factor/ in the /factorial/, ordered by increasing /base/ (and decreasing /exponent/). -primeFactors n = takeWhile ((> 0) . snd) $ map (\prime -> (prime, primeMultiplicity prime n)) Data.Numbers.Primes.primes - -{- | - * The number of times a specific /prime/, can be factored from the /factorial/ of the specified integer. - - * General purpose /prime-factorisation/ has /exponential time-complexity/, - so use /Legendre's Theorem/, which relates only to the /prime factors/ of /factorials/. - - * . --} -primeMultiplicity :: Integral i - => i -- ^ A prime number. - -> i -- ^ The integer, the factorial of which the prime is a factor. - -> i -- ^ The number of times the prime occurs in the factorial. -primeMultiplicity prime = sum . takeWhile (> 0) . tail . iterate (`div` prime) - --- | Returns the /rising factorial/; -risingFactorial :: (Integral i, Show i) - => i -- ^ The lower bound of the integer-range, whose product is returned. - -> i -- ^ The number of integers in the range above. - -> i -- ^ The result. -risingFactorial _ 0 = 1 -risingFactorial 0 _ = 0 -risingFactorial x n = Data.Interval.product' (recip 2) 64 $ Data.Interval.normalise (x, pred $ x + n) - --- | Returns the /falling factorial/; -fallingFactorial :: (Integral i, Show i) - => i -- ^ The upper bound of the integer-range, whose product is returned. - -> i -- ^ The number of integers in the range beneath. - -> i -- ^ The result. -fallingFactorial _ 0 = 1 -fallingFactorial 0 _ = 0 -fallingFactorial x n = Data.Interval.product' (recip 2) 64 $ Data.Interval.normalise (x, succ $ x - n) - -{- | - * Returns the ratio of two factorials. - - * It is more efficient than evaluating both factorials, and then dividing. - - * For more complex combinations of factorials, such as in the /Binomial coefficient/, - extract the /prime factors/ using 'primeFactors' - then manipulate them using the module "Data.PrimeFactors", - and evaluate it using by /Data.PrimeFactors.product'/. --} -(!/!) :: (Integral i, Fractional f, Show i) - => i -- ^ The /numerator/. - -> i -- ^ The /denominator/. - -> f -- ^ The resulting fraction. -numerator !/! denominator - | numerator <= 1 = recip . fromIntegral $ Math.Factorial.factorial (ToolShed.Defaultable.defaultValue :: Algorithm) denominator - | denominator <= 1 = fromIntegral $ Math.Factorial.factorial (ToolShed.Defaultable.defaultValue :: Algorithm) numerator - | numerator == denominator = 1 - | numerator < denominator = recip $ denominator !/! numerator -- Recurse. - | otherwise = fromIntegral $ Data.Interval.product' (recip 2) 64 (succ denominator, numerator) - diff --git a/src/Factory/Math/Implementations/Pi/AGM/Algorithm.hs b/src/Factory/Math/Implementations/Pi/AGM/Algorithm.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/AGM/Algorithm.hs +++ /dev/null @@ -1,42 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the set of /Arithmetic-geometric Mean/-type /Pi/-algorithms which have been implemented; currently just one. --} - -module Factory.Math.Implementations.Pi.AGM.Algorithm( --- * Types --- ** Data-types - Algorithm(..) -) where - -import qualified Factory.Math.Implementations.Pi.AGM.BrentSalamin as Math.Implementations.Pi.AGM.BrentSalamin -import qualified Factory.Math.Pi as Math.Pi -import qualified Factory.Math.SquareRoot as Math.SquareRoot -import qualified ToolShed.Defaultable - --- | Defines the available algorithms. -data Algorithm squareRootAlgorithm = BrentSalamin squareRootAlgorithm deriving (Eq, Read, Show) - -instance ToolShed.Defaultable.Defaultable squareRootAlgorithm => ToolShed.Defaultable.Defaultable (Algorithm squareRootAlgorithm) where - defaultValue = BrentSalamin ToolShed.Defaultable.defaultValue - -instance Math.SquareRoot.Algorithmic squareRootAlgorithm => Math.Pi.Algorithmic (Algorithm squareRootAlgorithm) where - openR (BrentSalamin squareRootAlgorithm) = Math.Implementations.Pi.AGM.BrentSalamin.openR squareRootAlgorithm - diff --git a/src/Factory/Math/Implementations/Pi/AGM/BrentSalamin.hs b/src/Factory/Math/Implementations/Pi/AGM/BrentSalamin.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/AGM/BrentSalamin.hs +++ /dev/null @@ -1,64 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Implements the /Brent-Salamin/ (AKA /Gauss-Legendre/) algorithm; - , - , - . - - * The precision of the result approximately doubles for each iteration. - - [@CAVEAT@] Assumptions on the convergence-rate result in rounding-errors, when only a small number of digits are requested. --} - -module Factory.Math.Implementations.Pi.AGM.BrentSalamin( --- * Functions - openR -) where - -import Control.Arrow((&&&)) -import qualified Factory.Math.ArithmeticGeometricMean as Math.ArithmeticGeometricMean -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.SquareRoot as Math.SquareRoot - -{- | - * Returns /Pi/, accurate to the specified number of decimal digits. - - * This algorithm is based on the /arithmetic-geometric/ mean of @1@ and @(1 / sqrt 2)@, - but there are many confusingly similar formulations. - The algorithm I've used here, where @a@ is the /arithmetic mean/ and @g@ is the /geometric mean/, is equivalent to other common formulations: - -> pi = (a[N-1] + g[N-1])^2 / (1 - sum [2^n * (a[n] - g[n])^2]) where n = [0 .. N-1] -> => 4*a[N]^2 / (1 - sum [2^n * (a[n]^2 - 2*a[n]*g[n] + g[n]^2)]) -> => 4*a[N]^2 / (1 - sum [2^n * (a[n]^2 + 2*a[n]*g[n] + g[n]^2 - 4*a[n]*g[n])]) -> => 4*a[N]^2 / (1 - sum [2^n * ((a[n] + g[n])^2 - 4*a[n]*g[n])]) -> => 4*a[N]^2 / (1 - sum [2^(n-1) * 4 * (a[n-1]^2 - g[n-1]^2)]) where n = [1 .. N] -> => 4*a[N]^2 / (1 - sum [2^(n+1) * (a[n-1]^2 - g[n-1]^2)]) - --} -openR :: Math.SquareRoot.Algorithmic squareRootAlgorithm => squareRootAlgorithm -> Math.Precision.DecimalDigits -> Rational -openR squareRootAlgorithm decimalDigits = uncurry (/) . ( - Math.Power.square . uncurry (+) . last &&& negate . pred . sum . zipWith (*) (iterate (* 2) 1) . map (Math.Power.square . Math.ArithmeticGeometricMean.spread) - ) . take ( - Math.Precision.getIterationsRequired Math.Precision.quadraticConvergence 1 decimalDigits - ) $ Math.ArithmeticGeometricMean.convergeToAGM squareRootAlgorithm decimalDigits (1, Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits (recip 2 :: Rational)) - diff --git a/src/Factory/Math/Implementations/Pi/BBP/Algorithm.hs b/src/Factory/Math/Implementations/Pi/BBP/Algorithm.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/BBP/Algorithm.hs +++ /dev/null @@ -1,47 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the set of /Bailey-Borwein-Plouffe/-type formulae which have been implemented. --} - -module Factory.Math.Implementations.Pi.BBP.Algorithm( --- * Types --- ** Data-types - Algorithm(..) -) where - -import qualified Factory.Math.Implementations.Pi.BBP.Base65536 as Math.Implementations.Pi.BBP.Base65536 -import qualified Factory.Math.Implementations.Pi.BBP.Bellard as Math.Implementations.Pi.BBP.Bellard -import qualified Factory.Math.Implementations.Pi.BBP.Implementation as Math.Implementations.Pi.BBP.Implementation -import qualified Factory.Math.Pi as Math.Pi -import qualified ToolShed.Defaultable - --- | Defines those /BBP/-type series which have been implemented. -data Algorithm = - Base65536 -- ^ A /base/-@2^16@ version of the formula. - | Bellard -- ^ A /nega-base/ @2^10@ version of the formula. - deriving (Eq, Read, Show) - -instance ToolShed.Defaultable.Defaultable Algorithm where - defaultValue = Base65536 - -instance Math.Pi.Algorithmic Algorithm where - openR Base65536 = Math.Implementations.Pi.BBP.Implementation.openR Math.Implementations.Pi.BBP.Base65536.series - openR Bellard = Math.Implementations.Pi.BBP.Implementation.openR Math.Implementations.Pi.BBP.Bellard.series - diff --git a/src/Factory/Math/Implementations/Pi/BBP/Base65536.hs b/src/Factory/Math/Implementations/Pi/BBP/Base65536.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/BBP/Base65536.hs +++ /dev/null @@ -1,38 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines a specific base-@2^16@ /BBP/-formula; - --} - -module Factory.Math.Implementations.Pi.BBP.Base65536( --- * Constants - series -) where - -import qualified Factory.Math.Implementations.Pi.BBP.Series as Math.Implementations.Pi.BBP.Series - --- | Defines the parameters of this specific series. -series :: Math.Implementations.Pi.BBP.Series.Series -series = Math.Implementations.Pi.BBP.Series.MkSeries { - Math.Implementations.Pi.BBP.Series.numerators = zipWith ($) (cycle [id, id, id, negate]) $ map (2 ^) [15 :: Integer, 14, 14, 12, 11, 10, 10, 8, 7, 6, 6, 4, 3, 2, 2, 0], - Math.Implementations.Pi.BBP.Series.getDenominators = \i -> map (32 * fromIntegral i +) [2, 3, 4, 7, 10, 11, 12, 15, 18, 19, 20, 23, 26, 27, 28, 31], - Math.Implementations.Pi.BBP.Series.seriesScalingFactor = recip $ 2 ^ (13 :: Int), - Math.Implementations.Pi.BBP.Series.base = 2 ^ (16 :: Int) -} diff --git a/src/Factory/Math/Implementations/Pi/BBP/Bellard.hs b/src/Factory/Math/Implementations/Pi/BBP/Bellard.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/BBP/Bellard.hs +++ /dev/null @@ -1,41 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /Bellard/'s nega-base-@2^10@ /BBP/-formula; --} - -module Factory.Math.Implementations.Pi.BBP.Bellard( --- * Constants - series -) where - -import Control.Arrow((&&&)) -import qualified Factory.Math.Implementations.Pi.BBP.Series as Math.Implementations.Pi.BBP.Series - --- | Defines the parameters of this specific series. -series :: Math.Implementations.Pi.BBP.Series.Series -series = Math.Implementations.Pi.BBP.Series.MkSeries { - Math.Implementations.Pi.BBP.Series.numerators = zipWith ($) [negate, negate, id, negate, negate, negate, id] $ map (2 ^) [5 :: Integer, 0, 8, 6, 2, 2, 0], - Math.Implementations.Pi.BBP.Series.getDenominators = \i -> let - f, t :: Integer - (f, t) = (4 *) &&& (10 *) $ fromIntegral i - in [f + 1, f + 3, t + 1, t + 3, t + 5, t + 7, t + 9], - Math.Implementations.Pi.BBP.Series.seriesScalingFactor = recip $ 2 ^ (6 :: Int), - Math.Implementations.Pi.BBP.Series.base = negate $ 2 ^ (10 :: Int) -} diff --git a/src/Factory/Math/Implementations/Pi/BBP/Implementation.hs b/src/Factory/Math/Implementations/Pi/BBP/Implementation.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/BBP/Implementation.hs +++ /dev/null @@ -1,57 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Implements a /Bailey-Borwein-Plouffe/ formula; - - * Surprisingly, because of the huge size of the 'Rational' quantities, - it is a /single/ call to @Factory.Math.Summation.sum'@, rather than the calculation of the many terms in the series, which is the performance-bottleneck. --} - -module Factory.Math.Implementations.Pi.BBP.Implementation( --- * Functions - openR -) where - -import Data.Ratio((%)) -import qualified Factory.Math.Implementations.Pi.BBP.Series as Math.Implementations.Pi.BBP.Series -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.Summation as Math.Summation - --- | Returns /Pi/, accurate to the specified number of decimal digits. -openR - :: Math.Implementations.Pi.BBP.Series.Series -- ^ This /Pi/-algorithm is parameterised by the type of other algorithms to use. - -> Math.Precision.DecimalDigits -- ^ The number of decimal digits required. - -> Rational -openR Math.Implementations.Pi.BBP.Series.MkSeries { - Math.Implementations.Pi.BBP.Series.numerators = numerators, - Math.Implementations.Pi.BBP.Series.getDenominators = getDenominators, - Math.Implementations.Pi.BBP.Series.seriesScalingFactor = seriesScalingFactor, - Math.Implementations.Pi.BBP.Series.base = base -} decimalDigits = (seriesScalingFactor *) . Math.Summation.sum' 8 . take ( - Math.Precision.getTermsRequired ( - recip . fromIntegral $ abs {-potentially negative-} base -- The convergence-rate. - ) decimalDigits - ) . zipWith (*) ( - iterate (/ fromIntegral base) 1 -- Generate the scaling-ratio, between successive terms. - ) $ map ( - sum . zipWith (%) numerators . getDenominators - ) [0 ..] - diff --git a/src/Factory/Math/Implementations/Pi/BBP/Series.hs b/src/Factory/Math/Implementations/Pi/BBP/Series.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/BBP/Series.hs +++ /dev/null @@ -1,36 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines a /Bailey-Borwein-Plouffe/ formula; --} - -module Factory.Math.Implementations.Pi.BBP.Series( --- * Types --- ** Data-types - Series(..) -) where - --- | Defines a series corresponding to a specific /BBP/-formula. -data Series = MkSeries { - numerators :: [Integer], -- ^ The constant numerators from which each term in the series is composed. - getDenominators :: Int -> [Integer], -- ^ Generates the term-dependent denominators from which each term in the series is composed. - seriesScalingFactor :: Rational, -- ^ The ratio by which the sum to infinity of the series, must be scaled to result in /Pi/. - base :: Integer -- ^ The geometric ratio, by which successive terms are scaled. -} - diff --git a/src/Factory/Math/Implementations/Pi/Borwein/Algorithm.hs b/src/Factory/Math/Implementations/Pi/Borwein/Algorithm.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Borwein/Algorithm.hs +++ /dev/null @@ -1,56 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the set of /Borwein/-type algorithms (currently only one) which have been implemented; . --} - -module Factory.Math.Implementations.Pi.Borwein.Algorithm( --- * Types --- ** Data-types - Algorithm(..) -) where - -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Implementations.Pi.Borwein.Borwein1993 as Math.Implementations.Pi.Borwein.Borwein1993 -import qualified Factory.Math.Implementations.Pi.Borwein.Implementation as Math.Implementations.Pi.Borwein.Implementation -import qualified Factory.Math.Pi as Math.Pi -import qualified Factory.Math.SquareRoot as Math.SquareRoot -import qualified ToolShed.Defaultable - -{- | - * Define those /Borwein/-series which have been implemented. - - * Though currently there's only one, provision has been made for the addition of more. --} -data Algorithm squareRootAlgorithm factorialAlgorithm = - Borwein1993 squareRootAlgorithm factorialAlgorithm -- ^ . - deriving (Eq, Read, Show) - -instance ( - ToolShed.Defaultable.Defaultable squareRootAlgorithm, - ToolShed.Defaultable.Defaultable factorialAlgorithm - ) => ToolShed.Defaultable.Defaultable (Algorithm squareRootAlgorithm factorialAlgorithm) where - defaultValue = Borwein1993 ToolShed.Defaultable.defaultValue ToolShed.Defaultable.defaultValue - -instance ( - Math.SquareRoot.Algorithmic squareRootAlgorithm, - Math.Factorial.Algorithmic factorialAlgorithm - ) => Math.Pi.Algorithmic (Algorithm squareRootAlgorithm factorialAlgorithm) where - openR (Borwein1993 squareRootAlgorithm factorialAlgorithm) = Math.Implementations.Pi.Borwein.Implementation.openR Math.Implementations.Pi.Borwein.Borwein1993.series squareRootAlgorithm factorialAlgorithm - diff --git a/src/Factory/Math/Implementations/Pi/Borwein/Borwein1993.hs b/src/Factory/Math/Implementations/Pi/Borwein/Borwein1993.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Borwein/Borwein1993.hs +++ /dev/null @@ -1,73 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the /Borwein/ series for /Pi/; --} - -module Factory.Math.Implementations.Pi.Borwein.Borwein1993( --- * Constants - series -) where - --- import Control.Arrow((***)) -import Data.Ratio((%)) --- import Factory.Data.PrimeFactors((>*<), (>/<), (>^)) --- import qualified Factory.Data.PrimeFactors as Data.PrimeFactors -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial -import qualified Factory.Math.Implementations.Pi.Borwein.Series as Math.Implementations.Pi.Borwein.Series -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.SquareRoot as Math.SquareRoot - --- | Defines the parameters of the /Borwein/ series. -series :: (Math.SquareRoot.Algorithmic squareRootAlgorithm, Math.Factorial.Algorithmic factorialAlgorithm) => Math.Implementations.Pi.Borwein.Series.Series squareRootAlgorithm factorialAlgorithm -series = Math.Implementations.Pi.Borwein.Series.MkSeries { - Math.Implementations.Pi.Borwein.Series.terms = \squareRootAlgorithm factorialAlgorithm decimalDigits -> let - simplify, squareRoot :: Rational -> Rational - simplify = Math.Precision.simplify $ pred decimalDigits {-ignore single integral digit-} -- This makes a gigantic difference to performance. - squareRoot = simplify . Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits - - sqrt5, a, b, c3 :: Rational - sqrt5 = squareRoot 5 - - a = 63365028312971999585426220 + sqrt5 * (28337702140800842046825600 + 384 * squareRoot (10891728551171178200467436212395209160385656017 + 4870929086578810225077338534541688721351255040 * sqrt5)) - b = 7849910453496627210289749000 + 3510586678260932028965606400 * sqrt5 + 2515968 * squareRoot (3110 * (6260208323789001636993322654444020882161 + 2799650273060444296577206890718825190235 * sqrt5)) - c3 = simplify . Math.Power.cube $ negate 214772995063512240 - sqrt5 * (96049403338648032 + 1296 * squareRoot (10985234579463550323713318473 + 4912746253692362754607395912 * sqrt5)) - in ( - squareRoot $ negate c3, -- The factor into which the series must be divided, to yield Pi. - zipWith ( -{- - \n power -> let - product' = Data.PrimeFactors.product' (recip 2) 10 - in uncurry (/) . ( - (* (a + b * fromIntegral n)) . fromIntegral . product' *** (* power) . fromIntegral . product' - ) $ Math.Implementations.Factorial.primeFactors (6 * n) >/< ( - Math.Implementations.Factorial.primeFactors (3 * n) >*< Math.Implementations.Factorial.primeFactors n >^ 3 - ) --} - \n power -> ( - Math.Implementations.Factorial.risingFactorial (succ $ 3 * n) (3 * n) % Math.Power.cube (Math.Factorial.factorial factorialAlgorithm n) - ) * ( - (a + b * fromIntegral n) / power - ) - ) [0 :: Integer ..] $ iterate (* c3) 1 - ), - Math.Implementations.Pi.Borwein.Series.convergenceRate = 10 ** negate 50 -- Empirical. -} diff --git a/src/Factory/Math/Implementations/Pi/Borwein/Implementation.hs b/src/Factory/Math/Implementations/Pi/Borwein/Implementation.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Borwein/Implementation.hs +++ /dev/null @@ -1,50 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /Borwein/ series for /Pi/; --} - -module Factory.Math.Implementations.Pi.Borwein.Implementation( --- * Functions - openR -) where - -import qualified Control.Arrow -import qualified Control.Parallel.Strategies -import qualified Factory.Math.Implementations.Pi.Borwein.Series as Math.Implementations.Pi.Borwein.Series -import qualified Factory.Math.Precision as Math.Precision - --- | Returns /Pi/, accurate to the specified number of decimal digits. -openR - :: Math.Implementations.Pi.Borwein.Series.Series squareRootAlgorithm factorialAlgorithm -- ^ This /Pi/-algorithm is parameterised by the type of other algorithms to use. - -> squareRootAlgorithm -- ^ The specific /square-root/ algorithm to apply to the above series. - -> factorialAlgorithm -- ^ The specific /factorial/-algorithm to apply to the above series. - -> Math.Precision.DecimalDigits -- ^ The number of decimal digits required. - -> Rational -openR Math.Implementations.Pi.Borwein.Series.MkSeries { - Math.Implementations.Pi.Borwein.Series.terms = terms, - Math.Implementations.Pi.Borwein.Series.convergenceRate = convergenceRate -} squareRootAlgorithm factorialAlgorithm decimalDigits = uncurry (/) . Control.Parallel.Strategies.withStrategy ( - Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rdeepseq Control.Parallel.Strategies.rdeepseq - ) . Control.Arrow.second ( - sum . take ( - Math.Precision.getTermsRequired convergenceRate decimalDigits - ) - ) $ terms squareRootAlgorithm factorialAlgorithm decimalDigits - diff --git a/src/Factory/Math/Implementations/Pi/Borwein/Series.hs b/src/Factory/Math/Implementations/Pi/Borwein/Series.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Borwein/Series.hs +++ /dev/null @@ -1,43 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines a -type series for /Pi/. --} - -module Factory.Math.Implementations.Pi.Borwein.Series( --- * Types --- ** Data-types - Series(..) -) where - -import qualified Factory.Math.Precision as Math.Precision - --- | Defines a series corresponding to a specific /Borwein/-formula. -data Series squareRootAlgorithm factorialAlgorithm = MkSeries { - terms - :: squareRootAlgorithm - -> factorialAlgorithm - -> Math.Precision.DecimalDigits - -> ( - Rational, -- The factor into which the sum to infinity of the sequence, must be divided to result in /Pi/ - [Rational] -- The sequence of terms, the sum to infinity of which defines the series. - ), - convergenceRate :: Math.Precision.ConvergenceRate -- ^ The expected number of digits of /Pi/, per term in the series. -} - diff --git a/src/Factory/Math/Implementations/Pi/Ramanujan/Algorithm.hs b/src/Factory/Math/Implementations/Pi/Ramanujan/Algorithm.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Ramanujan/Algorithm.hs +++ /dev/null @@ -1,55 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the set of /Ramanujan/-type algorithms which have been implemented; . --} - -module Factory.Math.Implementations.Pi.Ramanujan.Algorithm( --- * Types --- ** Data-types - Algorithm(..) -) where - -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Implementations.Pi.Ramanujan.Chudnovsky as Math.Implementations.Pi.Ramanujan.Chudnovsky -import qualified Factory.Math.Implementations.Pi.Ramanujan.Classic as Math.Implementations.Pi.Ramanujan.Classic -import qualified Factory.Math.Implementations.Pi.Ramanujan.Implementation as Math.Implementations.Pi.Ramanujan.Implementation -import qualified Factory.Math.Pi as Math.Pi -import qualified Factory.Math.SquareRoot as Math.SquareRoot -import qualified ToolShed.Defaultable - --- | Define those /Ramanujan/-series which have been implemented. -data Algorithm squareRootAlgorithm factorialAlgorithm = - Classic squareRootAlgorithm factorialAlgorithm -- ^ The original version. - | Chudnovsky squareRootAlgorithm factorialAlgorithm -- ^ A variant found by the /Chudnovsky brothers/. - deriving (Eq, Read, Show) - -instance ( - ToolShed.Defaultable.Defaultable squareRootAlgorithm, - ToolShed.Defaultable.Defaultable factorialAlgorithm - ) => ToolShed.Defaultable.Defaultable (Algorithm squareRootAlgorithm factorialAlgorithm) where - defaultValue = Chudnovsky ToolShed.Defaultable.defaultValue ToolShed.Defaultable.defaultValue - -instance ( - Math.SquareRoot.Algorithmic squareRootAlgorithm, - Math.Factorial.Algorithmic factorialAlgorithm - ) => Math.Pi.Algorithmic (Algorithm squareRootAlgorithm factorialAlgorithm) where - openR (Classic squareRootAlgorithm factorialAlgorithm) = Math.Implementations.Pi.Ramanujan.Implementation.openR Math.Implementations.Pi.Ramanujan.Classic.series squareRootAlgorithm factorialAlgorithm - openR (Chudnovsky squareRootAlgorithm factorialAlgorithm) = Math.Implementations.Pi.Ramanujan.Implementation.openR Math.Implementations.Pi.Ramanujan.Chudnovsky.series squareRootAlgorithm factorialAlgorithm - diff --git a/src/Factory/Math/Implementations/Pi/Ramanujan/Chudnovsky.hs b/src/Factory/Math/Implementations/Pi/Ramanujan/Chudnovsky.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Ramanujan/Chudnovsky.hs +++ /dev/null @@ -1,63 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the /Chudnovsky/ series for /Pi/; . --} - -module Factory.Math.Implementations.Pi.Ramanujan.Chudnovsky( --- * Constants - series -) where - --- import Control.Arrow((***)) -import Data.Ratio((%)) --- import Factory.Data.PrimeFactors((>/<), (>*<), (>^)) --- import qualified Factory.Data.PrimeFactors as Data.PrimeFactors -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial -import qualified Factory.Math.Implementations.Pi.Ramanujan.Series as Math.Implementations.Pi.Ramanujan.Series -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.SquareRoot as Math.SquareRoot - --- | Defines the parameters of the /Chudnovsky/ series. -series :: ( - Math.SquareRoot.Algorithmic squareRootAlgorithm, - Math.Factorial.Algorithmic factorialAlgorithm - ) => Math.Implementations.Pi.Ramanujan.Series.Series squareRootAlgorithm factorialAlgorithm -series = Math.Implementations.Pi.Ramanujan.Series.MkSeries { - Math.Implementations.Pi.Ramanujan.Series.terms = \factorialAlgorithm -> zipWith ( -{- - \n power -> let - product' = Data.PrimeFactors.product' (recip 2) 10 - in uncurry (%) . ( - (* (13591409 + 545140134 * n)) . product' *** (* power) . product' - ) $ Math.Implementations.Factorial.primeFactors (6 * n) >/< ( - Math.Implementations.Factorial.primeFactors (3 * n) >*< Math.Implementations.Factorial.primeFactors n >^ 3 - ) --} - \n power -> ( - Math.Implementations.Factorial.risingFactorial (succ $ 3 * n) (3 * n) % Math.Power.cube (Math.Factorial.factorial factorialAlgorithm n) - ) * ( - (13591409 + 545140134 * n) % power - ) -- CAVEAT: the order in which these terms are evaluated radically affects performance. - ) [0 ..] $ iterate (* (Math.Power.cube $ negate 640320 :: Integer)) 1, - Math.Implementations.Pi.Ramanujan.Series.getSeriesScalingFactor = \squareRootAlgorithm decimalDigits -> 426880 * Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits (10005 :: Integer), - Math.Implementations.Pi.Ramanujan.Series.convergenceRate = 10 ** negate 14.0 -- Empirical. -} - diff --git a/src/Factory/Math/Implementations/Pi/Ramanujan/Classic.hs b/src/Factory/Math/Implementations/Pi/Ramanujan/Classic.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Ramanujan/Classic.hs +++ /dev/null @@ -1,60 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the /Ramanujan/ series for /Pi/; . --} - -module Factory.Math.Implementations.Pi.Ramanujan.Classic( --- * Constants - series -) where - --- import Control.Arrow((***)) -import Data.Ratio((%)) --- import Factory.Data.PrimeFactors((>/<), (>^)) --- import qualified Factory.Data.PrimeFactors as Data.PrimeFactors -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial -import qualified Factory.Math.Implementations.Pi.Ramanujan.Series as Math.Implementations.Pi.Ramanujan.Series -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.SquareRoot as Math.SquareRoot - --- | Defines the parameters of the /Ramanujan/ series. -series :: (Math.SquareRoot.Algorithmic squareRootAlgorithm, Math.Factorial.Algorithmic factorialAlgorithm) => Math.Implementations.Pi.Ramanujan.Series.Series squareRootAlgorithm factorialAlgorithm -series = Math.Implementations.Pi.Ramanujan.Series.MkSeries { - Math.Implementations.Pi.Ramanujan.Series.terms = \factorialAlgorithm -> let - toFourthPower = (^ (4 :: Int)) - in zipWith ( -{- - \n power -> let - product' = Data.PrimeFactors.product' (recip 2) 10 - in uncurry (%) . ( - (* (1103 + 26390 * n)) . product' *** (* power) . product' - ) $ Math.Implementations.Factorial.primeFactors (4 * n) >/< Math.Implementations.Factorial.primeFactors n >^ 4 --} - \n power -> ( - Math.Implementations.Factorial.risingFactorial (succ n) (3 * n) % Math.Power.cube (Math.Factorial.factorial factorialAlgorithm n) - ) * ( - (1103 + 26390 * n) % power - ) -- CAVEAT: the order in which these terms are evaluated radically affects performance. - ) [0 ..] $ iterate (* toFourthPower 396) 1, - Math.Implementations.Pi.Ramanujan.Series.getSeriesScalingFactor = \squareRootAlgorithm decimalDigits -> 9801 / Math.SquareRoot.squareRoot squareRootAlgorithm decimalDigits (8 :: Integer), - Math.Implementations.Pi.Ramanujan.Series.convergenceRate = 10 ** negate 7.9 -- Empirical. -} - diff --git a/src/Factory/Math/Implementations/Pi/Ramanujan/Implementation.hs b/src/Factory/Math/Implementations/Pi/Ramanujan/Implementation.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Ramanujan/Implementation.hs +++ /dev/null @@ -1,52 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements a /Ramanujan/-type series for /Pi/; . --} - -module Factory.Math.Implementations.Pi.Ramanujan.Implementation( --- * Functions - openR -) where - -import qualified Control.Parallel.Strategies -import qualified Factory.Math.Implementations.Pi.Ramanujan.Series as Math.Implementations.Pi.Ramanujan.Series -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.Summation as Math.Summation - --- | Returns /Pi/, accurate to the specified number of decimal digits. -openR - :: Math.Implementations.Pi.Ramanujan.Series.Series squareRootAlgorithm factorialAlgorithm -- ^ This /Pi/-algorithm is parameterised by the type of other algorithms to use. - -> squareRootAlgorithm -- ^ The specific /square-root/ algorithm to apply to the above series. - -> factorialAlgorithm -- ^ The specific /factorial/-algorithm to apply to the above series. - -> Math.Precision.DecimalDigits -- ^ The number of decimal digits required. - -> Rational -openR Math.Implementations.Pi.Ramanujan.Series.MkSeries { - Math.Implementations.Pi.Ramanujan.Series.terms = terms, - Math.Implementations.Pi.Ramanujan.Series.getSeriesScalingFactor = getSeriesScalingFactor, - Math.Implementations.Pi.Ramanujan.Series.convergenceRate = convergenceRate -} squareRootAlgorithm factorialAlgorithm decimalDigits = uncurry (/) $ Control.Parallel.Strategies.withStrategy ( - Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rdeepseq Control.Parallel.Strategies.rdeepseq - ) ( - getSeriesScalingFactor squareRootAlgorithm decimalDigits, - Math.Summation.sumR 64 . take ( - Math.Precision.getTermsRequired convergenceRate decimalDigits - ) $ terms factorialAlgorithm - ) -- Pair. - diff --git a/src/Factory/Math/Implementations/Pi/Ramanujan/Series.hs b/src/Factory/Math/Implementations/Pi/Ramanujan/Series.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Ramanujan/Series.hs +++ /dev/null @@ -1,37 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines a -type series for /Pi/. --} - -module Factory.Math.Implementations.Pi.Ramanujan.Series( --- * Types --- ** Data-types - Series(..) -) where - -import qualified Factory.Math.Precision as Math.Precision - --- | Defines a series corresponding to a specific /Ramanujan/-formula. -data Series squareRootAlgorithm factorialAlgorithm = MkSeries { - terms :: factorialAlgorithm -> [Rational], -- ^ The sequence of terms, the sum to infinity of which defines the series. - getSeriesScalingFactor :: squareRootAlgorithm -> Math.Precision.DecimalDigits -> Rational, -- ^ The ratio by which the sum to infinity of the sequence, must be scaled to result in /Pi/. - convergenceRate :: Math.Precision.ConvergenceRate -- ^ The expected number of digits of /Pi/, per term in the series. -} - diff --git a/src/Factory/Math/Implementations/Pi/Spigot/Algorithm.hs b/src/Factory/Math/Implementations/Pi/Spigot/Algorithm.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Spigot/Algorithm.hs +++ /dev/null @@ -1,50 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the set of /Spigot/-algorithms which have been implemented. --} - -module Factory.Math.Implementations.Pi.Spigot.Algorithm( --- * Types --- ** Data-types - Algorithm(..) -) where - -import Data.Ratio((%)) -import qualified Factory.Math.Implementations.Pi.Spigot.Gosper as Math.Implementations.Pi.Spigot.Gosper -import qualified Factory.Math.Implementations.Pi.Spigot.RabinowitzWagon as Math.Implementations.Pi.Spigot.RabinowitzWagon -import qualified Factory.Math.Implementations.Pi.Spigot.Spigot as Math.Implementations.Pi.Spigot.Spigot -import qualified Factory.Math.Pi as Math.Pi -import qualified ToolShed.Defaultable - --- | Define those /Spigot/-algorithms which have been implemented. -data Algorithm = - Gosper -- ^ A /continued fraction/ discovered by /Gosper/. - | RabinowitzWagon -- ^ A /continued fraction/ discovered by /Rabinowitz/ and /Wagon/. - deriving (Eq, Read, Show) - -instance ToolShed.Defaultable.Defaultable Algorithm where - defaultValue = Gosper - -instance Math.Pi.Algorithmic Algorithm where - openI Gosper = Math.Implementations.Pi.Spigot.Spigot.openI Math.Implementations.Pi.Spigot.Gosper.series - openI RabinowitzWagon = Math.Implementations.Pi.Spigot.Spigot.openI Math.Implementations.Pi.Spigot.RabinowitzWagon.series - - openR algorithm decimalDigits = Math.Pi.openI algorithm decimalDigits % (10 ^ pred decimalDigits) - diff --git a/src/Factory/Math/Implementations/Pi/Spigot/Gosper.hs b/src/Factory/Math/Implementations/Pi/Spigot/Gosper.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Spigot/Gosper.hs +++ /dev/null @@ -1,39 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the /Gosper/ series; --} - -module Factory.Math.Implementations.Pi.Spigot.Gosper( --- * Constants - series -) where - -import qualified Factory.Math.Implementations.Pi.Spigot.Series as Math.Implementations.Pi.Spigot.Series -import qualified Factory.Math.Precision as Math.Precision - --- | Defines a series which converges to /Pi/. -series :: Integral i => Math.Implementations.Pi.Spigot.Series.Series i -series = Math.Implementations.Pi.Spigot.Series.MkSeries { - Math.Implementations.Pi.Spigot.Series.baseNumerators = map (\i -> i * pred (2 * i)) [1 ..], - Math.Implementations.Pi.Spigot.Series.baseDenominators = map ((* 3) . (\i -> succ i * (i + 2))) [3, 6 ..], - Math.Implementations.Pi.Spigot.Series.coefficients = [3, 8 ..], -- 5n - 2 - Math.Implementations.Pi.Spigot.Series.nTerms = Math.Precision.getTermsRequired $ 1 / 13 {-empirical convergence-rate-} -} - diff --git a/src/Factory/Math/Implementations/Pi/Spigot/RabinowitzWagon.hs b/src/Factory/Math/Implementations/Pi/Spigot/RabinowitzWagon.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Spigot/RabinowitzWagon.hs +++ /dev/null @@ -1,40 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the /Rabinowitz-Wagon/ series; - - . --} - -module Factory.Math.Implementations.Pi.Spigot.RabinowitzWagon( --- * Constants - series -) where - -import qualified Factory.Math.Implementations.Pi.Spigot.Series as Math.Implementations.Pi.Spigot.Series -import qualified Factory.Math.Precision as Math.Precision - --- | Defines a series which converges to /Pi/. -series :: Integral i => Math.Implementations.Pi.Spigot.Series.Series i -series = Math.Implementations.Pi.Spigot.Series.MkSeries { - Math.Implementations.Pi.Spigot.Series.baseNumerators = [1 ..], - Math.Implementations.Pi.Spigot.Series.baseDenominators = [3, 5 ..], - Math.Implementations.Pi.Spigot.Series.coefficients = repeat 2, - Math.Implementations.Pi.Spigot.Series.nTerms = Math.Precision.getTermsRequired $ 10 ** negate (3 / 10) {-convergence-rate-} -} diff --git a/src/Factory/Math/Implementations/Pi/Spigot/Series.hs b/src/Factory/Math/Implementations/Pi/Spigot/Series.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Spigot/Series.hs +++ /dev/null @@ -1,53 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the parameters of a series used in a /Spigot/-table to generate /Pi/. --} - -module Factory.Math.Implementations.Pi.Spigot.Series( --- * Types --- ** Data-types - Series(..), --- * Functions - bases -) where - -import Data.Ratio((%)) -import qualified Data.Ratio -import qualified Factory.Math.Precision as Math.Precision - -{- | - * Defines a series composed from a sum of terms, each one of which is the product of a coefficient and a base. - - * The coefficents and bases of the series are described in /Horner form/; @Pi = c1 + (b1 * (c2 + b2 * (c3 + b3 * (...))))@. --} -data Series i = MkSeries { - coefficients :: [i], - baseNumerators :: [i], - baseDenominators :: [i], - nTerms :: Math.Precision.DecimalDigits -> Int -- ^ The width of the spigot-table, required to accurately generate the requested number of digits. -} - --- | Combines 'baseNumerators' and 'baseDenominators', and as a side-effect, expresses the ratio in lowest terms. -bases :: Integral i => Series i -> [Data.Ratio.Ratio i] -bases MkSeries { - baseNumerators = n, - baseDenominators = d -} = zipWith (%) n d - diff --git a/src/Factory/Math/Implementations/Pi/Spigot/Spigot.hs b/src/Factory/Math/Implementations/Pi/Spigot/Spigot.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Pi/Spigot/Spigot.hs +++ /dev/null @@ -1,153 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Implements a /spigot/-algorithm; . - - * Uses the traditional algorithm, rather than the /unbounded/ algorithm described by . --} - -module Factory.Math.Implementations.Pi.Spigot.Spigot( --- * Types --- ** Type-synonyms --- Base, --- Coefficients, --- I, --- Pi, --- PreDigits, --- QuotRem, --- * Constants - decimal, --- * Functions --- carryAndDivide, --- processColumns, - openI, --- ** Accessors --- getQuotient, --- getRemainder, --- ** Constructors --- mkRow -) where - -import qualified Control.Arrow -import qualified Data.Char -import qualified Data.Ratio -import qualified Factory.Math.Implementations.Pi.Spigot.Series as Math.Implementations.Pi.Spigot.Series -import qualified Factory.Math.Precision as Math.Precision - -{- | - * The type in which all arithmetic is performed. - - * A small dynamic range, 32 bits or more, is typically adequate. --} -type I = Int - --- | The constant base in which we want the resulting value of /Pi/ to be expressed. -decimal :: I -decimal = 10 - --- | Coerce the polymorphic type 'Data.Ratio.Ratio' to suit the base used in our series. -type Base = Data.Ratio.Ratio I - --- | Coerce the polymorphic type returned by 'quotRem' to our specific requirements. -type QuotRem = (I, I) - --- Accessors. -getQuotient, getRemainder :: QuotRem -> I -getQuotient = fst -getRemainder = snd - -type PreDigits = [I] -type Pi = [I] -type Coefficients = [I] - -{- | - * For a digit on one row of the spigot-table, add any numerator carried from the similar calculation one column to the right. - - * Divide the result of this summation, by the denominator of the base, to get the quotient and remainder. - - * Determine the quantity to carry to the similar calculation one column to the left, by multiplying the quotient by the numerator of the base. --} -carryAndDivide :: (Base, I) -> QuotRem -> QuotRem -carryAndDivide (base, lhs) rhs - | n < d = (0, n) -- In some degenerate cases, the result of the subsequent calculation can be more simply determined. - | otherwise = Control.Arrow.first (* Data.Ratio.numerator base) $ n `quotRem` d - where - d, n :: I - d = Data.Ratio.denominator base - n = lhs + getQuotient rhs -- Carry numerator from the column to the right and add it to the current digit. - -{- | - * Fold 'carryAndDivide', from right to left, over the columns of a row in the spigot-table, continuously checking for overflow. - - * Release any previously withheld result-digits, after any adjustment for overflow in the current result-digit. - - * Withhold the current result-digit until the risk of overflow in subsequent result-digits has been assessed. - - * Call 'mkRow'. --} -processColumns - :: Math.Implementations.Pi.Spigot.Series.Series I - -> PreDigits - -> [(Base, I)] -- ^ Data-row. - -> Pi -processColumns series preDigits l - | overflowMargin > 1 = preDigits ++ nextRow [digit] -- There's neither overflow, nor risk of impact from subsequent overflow. - | overflowMargin == 1 = nextRow $ preDigits ++ [digit] -- There's no overflow, but risk of impact from subsequent overflow. - | otherwise = map ((`rem` decimal) . succ) preDigits ++ nextRow [0] -- Overflow => propagate the excess to previously withheld preDigits. - where - results :: [QuotRem] - results = init $ scanr carryAndDivide (0, undefined) l - - digit :: I - digit = getQuotient $ head results - - overflowMargin :: I - overflowMargin = decimal - digit - - nextRow :: [I] -> [I] - nextRow preDigits' = mkRow series preDigits' $ map getRemainder results - -{- | - * Multiply the remainders from the previous row. - - * Zip them with the constant bases, with an addition one stuck on the front to perform the conversion to decimal, to create a new row of the spigot-table. - - * Call 'processColumns'. --} -mkRow :: Math.Implementations.Pi.Spigot.Series.Series I -> PreDigits -> Coefficients -> Pi -mkRow series preDigits = processColumns series preDigits . zip (recip (fromIntegral decimal) : Math.Implementations.Pi.Spigot.Series.bases series) . map (* decimal) - -{- | - * Initialises a /spigot/-table with the row of 'Math.Implementations.Pi.Spigot.Series.coefficients'. - - * Ensures that the row has suffient terms to accurately generate the required number of digits. - - * Extracts only those digits which are guaranteed to be accurate. - - * CAVEAT: the result is returned as an 'Integer', i.e. without any decimal point. --} -openI :: Math.Implementations.Pi.Spigot.Series.Series I -> Math.Precision.DecimalDigits -> Integer -openI series decimalDigits = read . map ( - Data.Char.intToDigit . fromIntegral - ) . take decimalDigits . mkRow series [] . take ( - Math.Implementations.Pi.Spigot.Series.nTerms series decimalDigits - ) $ Math.Implementations.Pi.Spigot.Series.coefficients series - diff --git a/src/Factory/Math/Implementations/Primality.hs b/src/Factory/Math/Implementations/Primality.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Primality.hs +++ /dev/null @@ -1,217 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Determines whether an integer is prime. - - * . - - * - - * CAVEAT: it doesn't determine the prime-factors of composite numbers, just that they exist. --} - -module Factory.Math.Implementations.Primality( --- * Types --- ** Data-types - Algorithm(..) --- * Functions --- ** Predicates --- isPrimeByAKS, --- isPrimeByMillerRabin, --- witnessesCompositeness -) where - -import Control.Arrow((&&&)) -import qualified Control.DeepSeq -import qualified Control.Parallel.Strategies -import qualified Data.Numbers.Primes -import qualified Factory.Data.MonicPolynomial as Data.MonicPolynomial -import qualified Factory.Data.Polynomial as Data.Polynomial -import qualified Factory.Data.QuotientRing as Data.QuotientRing -import qualified Factory.Math.MultiplicativeOrder as Math.MultiplicativeOrder -import qualified Factory.Math.PerfectPower as Math.PerfectPower -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.Primality as Math.Primality -import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation -import qualified ToolShed.Defaultable - --- | The algorithms by which /primality/-testing has been implemented. -data Algorithm factorisationAlgorithm = - AKS factorisationAlgorithm -- ^ . - | MillerRabin -- ^ . - deriving (Eq, Read, Show) - -instance ToolShed.Defaultable.Defaultable (Algorithm factorisationAlgorithm) where - defaultValue = MillerRabin - -instance Math.PrimeFactorisation.Algorithmic factorisationAlgorithm => Math.Primality.Algorithmic (Algorithm factorisationAlgorithm) where - isPrime _ 2 = True -- The only even prime. - isPrime algorithm candidate - | candidate < 2 || ( - any ( - (== 0) . (candidate `rem`) -- The candidate has a small prime-factor, and is therefore composite. - ) . filter ( - (candidate >=) . (* 2) -- The candidate must be at least double the small prime, for it to be a potential factor. - ) . take 5 {-arbitrarily-} $ Data.Numbers.Primes.primes -- Excludes even numbers, provided at least the 1st prime is tested. - ) = False - | otherwise = ( - case algorithm of - AKS factorisationAlgorithm -> isPrimeByAKS factorisationAlgorithm - MillerRabin -> isPrimeByMillerRabin - ) candidate - -{- | - * An implementation of the /Agrawal-Kayal-Saxena/ primality-test; , - using the /Lenstra/ and /Pomerance/ algorithm. - - * CAVEAT: this deterministic algorithm has a theoretical time-complexity of @O(log^6)@, - and therefore can't compete with the performance of probabilistic ones. - - * The /formal polynomials/ used in this algorithm, are conceptually different from /polynomial functions/; - the /indeterminate/ and its powers, are merely used to name a sequence of pigeon-holes in which /coefficients/ are stored, - and is never substituted for a specific value. - This mind-shift, allows one to introduce concepts like /modular/ arithmetic on polynomials, - which merely represent an operation on their coefficients and the pigeon-hole in which they're placed. - - [@Manindra Agrawal, Neeraj Kayal and Nitin Saxena@] . - - [@H. W. Lenstra, Jr. and Carl Pomerance@] . - - [@Salembier and Southerington@] , - - [@R. Crandall and J. Papadopoulos@] , - - [@Andreas Klappenecker@] , - - [@Vibhor Bhatt and G. K. Patra@] , --} -isPrimeByAKS :: ( - Control.DeepSeq.NFData i, - Integral i, - Math.PrimeFactorisation.Algorithmic factorisationAlgorithm, - Show i - ) => factorisationAlgorithm -> i -> Bool -isPrimeByAKS factorisationAlgorithm n = and [ - not $ Math.PerfectPower.isPerfectPower n, -- Step 1. - Math.Primality.areCoprime n `all` filter (/= n) [2 .. r], -- Step 3. - and $ Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq {-Benefits from '+RTS -H100M', which reduces garbage-collections-} ( - \a -> let --- lhs, rhs :: Data.Polynomial.Polynomial i i - lhs = Data.Polynomial.raiseModulo (Data.Polynomial.mkLinear 1 a) n {-power-} n {-modulus-} - rhs = Data.Polynomial.mod' (Data.Polynomial.mkPolynomial [(1, n), (a, 0)]) n - in Data.QuotientRing.areCongruentModulo ( - Data.MonicPolynomial.mkMonicPolynomial lhs - ) ( - Data.MonicPolynomial.mkMonicPolynomial rhs - ) ( - Data.MonicPolynomial.mkMonicPolynomial modulus - ) -- Because all these polynomials are /monic/, one can establish /congruence/ using /integer/-division. - ) [ - 1 .. floor . (* lg) . sqrt $ fromIntegral r - ] -- Step 4; (x + a)^n ~ x^n + a mod (x^r - 1, n). - ] where - lg :: Double - lg = logBase 2 $ fromIntegral n - --- r :: i - r = fst . head . dropWhile ( - (<= floor (Math.Power.square lg)) . snd - ) . map ( - id &&& Math.MultiplicativeOrder.multiplicativeOrder factorisationAlgorithm n - ) $ Math.Primality.areCoprime n `filter` [2 ..] -- Step 2. - --- modulus :: Data.Polynomial.Polynomial i i - modulus = Data.Polynomial.mkPolynomial [(1, r), (negate 1, 0)] - -{- | - * Uses the specified 'base' in an attempt to prove the /compositeness/ of an integer. - - * This is the opposite of the /Miller Test/; . - - * If the result is 'True', then the candidate is /composite/; regrettably the converse isn't true. - Amongst the set of possible bases, over three-quarters are /witnesses/ to the compositeness of a /composite/ candidate, - the remainder belong to the subset of /liars/. - In consequence, many false results must be accumulated for different bases, to convincingly identify a prime. --} -witnessesCompositeness :: (Integral i, Show i) - => i -- ^ Candidate integer. - -> i - -> Int - -> i -- ^ Base. - -> Bool -witnessesCompositeness candidate oddRemainder nPowersOfTwo base = all ( - $ ((`rem` candidate) . Math.Power.square) `iterate` Math.Power.raiseModulo base oddRemainder candidate -- Repeatedly modulo-square. - ) [ - (/= 1) . head, -- Check whether the zeroeth modulo-power is incongruent to one. - notElem (pred candidate) . take nPowersOfTwo -- Check whether any modulo-power is incongruent to -1. - ] - -{- | - * Repeatedly calls 'witnessesCompositeness', to progressively increase the probability of detecting a /composite/ number, - until ultimately the candidate integer is proven to be prime. - - * Should all bases be tested, then the test is deterministic, but at an efficiency /lower/ than performing prime-factorisation. - - * The test becomes deterministic, for any candidate integer, when the number of tests reaches the limit defined by /Eric Bach/. - - * A testing of smaller set of bases, is sufficient for candidates smaller than various thresholds; . - - * . - - * - - * . - - * , . --} -isPrimeByMillerRabin :: (Integral i, Show i) => i -> Bool -isPrimeByMillerRabin primeCandidate = not $ witnessesCompositeness primeCandidate ( - fst $ last binaryFactors -- Odd-remainder. - ) ( - length binaryFactors -- The number of times that 'two' can be factored-out from 'predecessor'. - ) `any` testBases where - predecessor = pred primeCandidate - binaryFactors = takeWhile ((== 0) . snd) . tail {-drop the original-} $ iterate ((`quotRem` 2) . fst) (predecessor, 0) -- Factor-out powers of two. - testBases - | null fewestPrimeBases = let - millersTestSet = floor . (* 2 {-Eric Bach-}) . Math.Power.square . toRational {-avoid premature rounding-} $ log (fromIntegral primeCandidate :: Double {-overflows at 10^851-}) - in [2 .. predecessor `min` millersTestSet] - | otherwise = head fewestPrimeBases `take` Data.Numbers.Primes.primes - where - fewestPrimeBases = map fst $ dropWhile ((primeCandidate >=) . snd) [ - (0, 9), -- All odd integers less this, are prime, and require no further verification. - (1, 2047), - (2, 1373653), - (3, 25326001), - (4, 3215031751), - (5, 2152302898747), -- Jaeschke ... - (6, 3474749660383), - (8, 341550071728321), - (11, 3825123056546413051), -- Zhang ... - (12, 318665857834031151167461), - (13, 3317044064679887385961981), - (14, 6003094289670105800312596501), - (15, 59276361075595573263446330101), - (17, 564132928021909221014087501701), - (19, 1543267864443420616877677640751301), - (20, 10 ^ (36 :: Int)) -- At least. - ] - diff --git a/src/Factory/Math/Implementations/PrimeFactorisation.hs b/src/Factory/Math/Implementations/PrimeFactorisation.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/PrimeFactorisation.hs +++ /dev/null @@ -1,145 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Implements several different prime-factorisation algorithms. - - * . --} - -module Factory.Math.Implementations.PrimeFactorisation( --- * Types --- ** Data-types - Algorithm( --- DixonsMethod, - FermatsMethod, - TrialDivision - ) --- * Functions --- factoriseByDixonsMethod --- factoriseByFermatsMethod --- factoriseByTrialDivision -) where - -import Control.Arrow((&&&)) -import qualified Control.Arrow -import qualified Control.DeepSeq -import qualified Control.Parallel.Strategies -import qualified Data.Maybe -import qualified Data.Numbers.Primes -import qualified Factory.Data.Exponential as Data.Exponential -import Factory.Data.Exponential((<^)) -import qualified Factory.Data.PrimeFactors as Data.PrimeFactors -import qualified Factory.Math.PerfectPower as Math.PerfectPower -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation -import qualified ToolShed.Data.Pair -import qualified ToolShed.Defaultable - --- | The algorithms by which prime-factorisation has been implemented. -data Algorithm - = DixonsMethod -- ^ . - | FermatsMethod -- ^ . - | TrialDivision -- ^ . - deriving (Eq, Read, Show) - -instance ToolShed.Defaultable.Defaultable Algorithm where - defaultValue = TrialDivision - -instance Math.PrimeFactorisation.Algorithmic Algorithm where - primeFactors algorithm = case algorithm of - DixonsMethod -> factoriseByDixonsMethod - FermatsMethod -> Data.PrimeFactors.reduce . factoriseByFermatsMethod - TrialDivision -> factoriseByTrialDivision - --- | . -factoriseByDixonsMethod :: Integral base => base -> Data.PrimeFactors.Factors base exponent -factoriseByDixonsMethod = undefined - -{- | - * . - - * . - - * . - - * @i = f1 * f2@ Assume a non-trivial factorisation, ie. one in which both factors exceed one. - => @i = (larger + smaller) * (larger - smaller)@ Represent the co-factors as a sum and difference. - => @i = larger^2 - smaller^2@ Which has an integral solution if @i@ is neither /even/ nor a /perfect square/. - => @sqrt (larger^2 - i) = smaller@ Search for /larger/, which results in an integral value for /smaller/. - - * Given that the smaller factor /f2/, can't be less than 3 (/i/ isn't /even/), then the larger /f1/, can't be greater than @(i `div` 3)@. - So: @(f2 >= 3) && (f1 <= i `div` 3)@ Two equations which can be used to solve for /larger/. - => @(larger - smaller >= 3) && (larger + smaller <= i `div` 3)@ Add these to eliminate /smaller/. - => @larger <= (i + 9) `div` 6@ The upper bound of the search-space. - - * This algorithm works best when there's a factor close to the /square-root/. --} -factoriseByFermatsMethod :: ( - Control.DeepSeq.NFData base, - Control.DeepSeq.NFData exponent, - Integral base, - Num exponent - ) => base -> Data.PrimeFactors.Factors base exponent -factoriseByFermatsMethod i - | i <= 3 = [Data.Exponential.rightIdentity i] - | even i = Data.Exponential.rightIdentity 2 : factoriseByFermatsMethod (i `div` 2) {-recurse-} - | Data.Maybe.isJust maybeSquareNumber = (<^ 2) `map` factoriseByFermatsMethod (Data.Maybe.fromJust maybeSquareNumber) {-recurse-} - | null factors = [Data.Exponential.rightIdentity i] -- Prime. - | otherwise = uncurry (++) . Control.Parallel.Strategies.withStrategy ( - Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rdeepseq Control.Parallel.Strategies.rdeepseq -- CAVEAT: unproductive on the size of integers tested so far. - ) . ToolShed.Data.Pair.mirror factoriseByFermatsMethod $ head factors - where --- maybeSquareNumber :: Integral i => Maybe i - maybeSquareNumber = Math.PerfectPower.maybeSquareNumber i - --- factors :: Integral i => [i] - factors = map ( - ( - uncurry (+) &&& uncurry (-) -- Construct the co-factors as the sum and difference of /larger/ and /smaller/. - ) . Control.Arrow.second Data.Maybe.fromJust - ) . filter ( - Data.Maybe.isJust . snd -- Search for a perfect square. - ) . map ( - Control.Arrow.second $ Math.PerfectPower.maybeSquareNumber {-hotspot-} . (+ negate i) -- Associate the corresponding value of /smaller/. - ) . takeWhile ( - (<= (i + 9) `div` 6) . fst -- Terminate the search at the maximum value of /larger/. - ) . Math.Power.squaresFrom {-hotspot-} . ceiling $ sqrt (fromIntegral i :: Double) -- Start the search at the minimum value of /larger/. - -{- | - * Decomposes the specified integer, into a product of /prime/-factors, - using , AKA . - - * This works best when the factors are small. --} -factoriseByTrialDivision :: (Integral base, Num exponent) => base -> Data.PrimeFactors.Factors base exponent -factoriseByTrialDivision = slave Data.Numbers.Primes.primes where - slave primes i - | null primeCandidates = [Data.Exponential.rightIdentity i] - | otherwise = Data.Exponential.rightIdentity lowestPrimeFactor `Data.PrimeFactors.insert'` slave primeCandidates (i `quot` lowestPrimeFactor) - where - primeCandidates = dropWhile ( - (/= 0) . (i `rem`) - ) $ takeWhile ( - <= Math.PrimeFactorisation.maxBoundPrimeFactor i - ) primes - - lowestPrimeFactor = head primeCandidates - diff --git a/src/Factory/Math/Implementations/Primes/Algorithm.hs b/src/Factory/Math/Implementations/Primes/Algorithm.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Primes/Algorithm.hs +++ /dev/null @@ -1,63 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Generates the constant list of /prime-numbers/, by a variety of different algorithms. - - * . - - * . - - * . --} - -module Factory.Math.Implementations.Primes.Algorithm( --- * Types --- ** Data-types - Algorithm(..) -) where - -import qualified Data.Numbers.Primes -import qualified Factory.Data.PrimeWheel as Data.PrimeWheel -import qualified Factory.Math.Implementations.Primes.SieveOfAtkin as Math.Implementations.Primes.SieveOfAtkin -import qualified Factory.Math.Implementations.Primes.SieveOfEratosthenes as Math.Implementations.Primes.SieveOfEratosthenes -import qualified Factory.Math.Implementations.Primes.TrialDivision as Math.Implementations.Primes.TrialDivision -import qualified Factory.Math.Implementations.Primes.TurnersSieve as Math.Implementations.Primes.TurnersSieve -import qualified Factory.Math.Primes as Math.Primes -import qualified ToolShed.Defaultable - --- | The implemented methods by which the primes may be generated. -data Algorithm - = SieveOfAtkin Integer -- ^ The /Sieve of Atkin/, optimised using a 'Data.PrimeWheel.PrimeWheel' of optimal size, for primes up to the specified maximum bound; . - | SieveOfEratosthenes Data.PrimeWheel.NPrimes -- ^ The /Sieve of Eratosthenes/ (), optimised using a 'Data.PrimeWheel.PrimeWheel'. - | TrialDivision Data.PrimeWheel.NPrimes -- ^ For each candidate, confirm indivisibility, by all /primes/ smaller than its /square-root/, optimised using a 'Data.PrimeWheel.PrimeWheel'. - | TurnersSieve -- ^ For each /prime/, the infinite list of candidates greater than its /square/, is filtered for indivisibility; . - | WheelSieve Int -- ^ 'Data.Numbers.Primes.wheelSieve'. - deriving (Eq, Read, Show) - -instance ToolShed.Defaultable.Defaultable Algorithm where - defaultValue = SieveOfEratosthenes 7 -- Resulting in a wheel of circumference 510510. - -instance Math.Primes.Algorithmic Algorithm where - primes (SieveOfAtkin maxPrime) = Math.Implementations.Primes.SieveOfAtkin.sieveOfAtkin (Data.PrimeWheel.estimateOptimalSize maxPrime) $ fromIntegral maxPrime - primes (SieveOfEratosthenes wheelSize) = Math.Implementations.Primes.SieveOfEratosthenes.sieveOfEratosthenes wheelSize - primes (TrialDivision wheelSize) = Math.Implementations.Primes.TrialDivision.trialDivision wheelSize - primes TurnersSieve = Math.Implementations.Primes.TurnersSieve.turnersSieve - primes (WheelSieve wheelSize) = Data.Numbers.Primes.wheelSieve wheelSize -- Has better space-complexity than 'SieveOfEratosthenes'. diff --git a/src/Factory/Math/Implementations/Primes/SieveOfAtkin.hs b/src/Factory/Math/Implementations/Primes/SieveOfAtkin.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Primes/SieveOfAtkin.hs +++ /dev/null @@ -1,242 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Generates the constant /bounded/ list of /prime-numbers/, using the /Sieve of Atkin/; . - - * . - - * The implementation; - has been optimised using a /wheel/ of static, but parameterised, size; - has been parallelized; - is polymorphic, but with a specialisation for type 'Int'. - - [@CAVEAT@] The 'Int'-specialisation is implemented by a /rewrite-rule/, which is /very/ fragile. --} - -module Factory.Math.Implementations.Primes.SieveOfAtkin( --- * Types --- ** Data-types --- PolynomialType, --- * Constants --- atkinsModulus, --- inherentPrimes, --- nInherentPrimes, --- squares, --- * Functions --- polynomialTypeLookupPeriod, --- polynomialTypeLookup, --- findPolynomialSolutions, --- filterOddRepetitions, --- generateMultiplesOfSquareTo, --- getPrefactoredPrimes, - sieveOfAtkin, --- sieveOfAtkinInt -) where - -import qualified Control.DeepSeq -import qualified Control.Parallel.Strategies -import qualified Data.Array.IArray -import Data.Array.IArray((!)) -import qualified Data.IntSet -import qualified Data.List -import qualified Data.Set -import qualified Factory.Data.PrimeWheel as Data.PrimeWheel -import qualified Factory.Math.Power as Math.Power -import qualified ToolShed.Data.List - --- | Defines the types of /quadratic/, available to test the potential primality of a candidate integer. -data PolynomialType - = ModFour -- ^ Suitable for primality-testing numbers meeting @(n `mod` 4 == 1)@. - | ModSix -- ^ Suitable for primality-testing numbers meeting @(n `mod` 6 == 1)@. - | ModTwelve -- ^ Suitable for primality-testing numbers meeting @(n `mod` 12 == 11)@. - | None -- ^ There's no polynomial which can assess primality, because the candidate is composite. - deriving Eq - --- | The constant modulus used to select the appropriate quadratic for a prime candidate. -atkinsModulus :: Integral i => i -atkinsModulus = foldr1 lcm [4, 6, 12] -- Sure, this is always '12', but this is the reason why. - --- | The constant list of primes factored-out by the unoptimised algorithm. -inherentPrimes :: Integral i => [i] -inherentPrimes = [2, 3] - --- | The constant number of primes factored-out by the unoptimised algorithm. -nInherentPrimes :: Int -nInherentPrimes = length (inherentPrimes :: [Int]) - --- | Typically the set of primes which have been built into the specified /wheel/, but never fewer than 'inherentPrimes'. -getPrefactoredPrimes :: Integral i => Data.PrimeWheel.PrimeWheel i -> [i] -getPrefactoredPrimes = max inherentPrimes . Data.PrimeWheel.getPrimeComponents - --- | The period over which the data returned by 'polynomialTypeLookup' repeats. -polynomialTypeLookupPeriod :: Integral i => Data.PrimeWheel.PrimeWheel i -> i -polynomialTypeLookupPeriod = lcm atkinsModulus . Data.PrimeWheel.getCircumference - -{- | - * Defines which, if any, of the three /quadratics/ is appropriate for the primality-test for each candidate. - - * Since this algorithm uses /modular arithmetic/, the /range/ of results repeat after a short /domain/ related to the /modulus/. - Thus one need calculate at most one period of this cycle, but fewer if the maximum prime required falls within the first cycle of results. - - * Because the results are /bounded/, they're returned in a zero-indexed /array/, to provide efficient random access; - the first few elements should never be required, but it makes query clearer. - - * . --} -polynomialTypeLookup :: (Data.Array.IArray.Ix i, Integral i) - => Data.PrimeWheel.PrimeWheel i - -> i -- ^ The maximum prime required. - -> Data.Array.IArray.Array i PolynomialType -polynomialTypeLookup primeWheel maxPrime = Data.Array.IArray.listArray (0, pred (polynomialTypeLookupPeriod primeWheel) `min` maxPrime) $ map select [0 ..] where --- select :: Integral i => i -> PolynomialType - select n - | any ( - (== 0) . (n `rem`) -- Though this is merely /Trial Division/, it's only performed over a short bounded interval of numerators. - ) primeComponents = None - | r `elem` [1, 5] = ModFour -- We actually require @(n `mod` 4 == 1)@, but this is the equivalent modulo 12, with @(r == 9)@ removed because they're all divisible by /3/. - | r == 7 = ModSix -- We actually require @(n `mod` 6 == 1)@, but this is the equivalent modulo 12, where @(r == 1)@ has been accounted for above. - | r == 11 = ModTwelve -- We require @(n `mod` 12 == 11)@. - | otherwise = None - where - r = n `rem` atkinsModulus - primeComponents = drop nInherentPrimes $ Data.PrimeWheel.getPrimeComponents primeWheel - --- | The constant, infinite list of the /squares/, of integers increasing from /1/. -squares :: Integral i => [i] -squares = map snd $ Math.Power.squaresFrom 1 - -{- | - * Returns the /ordered/ list of those values with an /odd/ number of occurrences in the specified /unordered/ list. - - * CAVEAT: this is expensive in both execution-time and space. - The typical imperative-style implementation accumulates polynomial-solutions in a /mutable array/ indexed by the candidate integer. - This doesn't translate seamlessly to the /pure functional/ domain where /arrays/ naturally immutable, - so we /sort/ a /list/ of polynomial-solutions, then measure the length of the solution-spans, corresponding to viable candidates. - Regrettably, 'Data.List.sort' (implemented in /GHC/ by /mergesort/) has a time-complexity /O(n*log n)/ - which is greater than the theoretical /O(n)/ of the whole /Sieve of Atkin/; - /GHC/'s old /qsort/-implementation is even slower :( --} -filterOddRepetitions :: Ord a => [a] -> [a] --- filterOddRepetitions = map head . filter (foldr (const not) False) . Data.List.group . Data.List.sort -- Too slow. -filterOddRepetitions = slave True . Data.List.sort where - slave isOdd (one : remainder@(two : _)) - | one == two = slave (not isOdd) remainder - | isOdd = one : beginSpan - | otherwise = beginSpan - where - beginSpan = slave True remainder - slave True [singleton] = [singleton] - slave _ _ = [] - -{- | - * Returns the ordered list of solutions aggregated from each of three /bivariate quadratics/; @z = f(x, y)@. - - * For a candidate integer to be prime, it is necessary but insufficient, that there are an /odd/ number of solutions of value /candidate/. - - * At most one of these three polynomials is suitable for the validation of any specific candidate /z/, depending on 'lookupPolynomialType'. - so the three sets of solutions are mutually exclusive. - One coordinate @(x, y)@, can have solutions in more than one of the three polynomials. - - * This algorithm exhaustively traverses the domain @(x, y)@, for resulting /z/ of the required modulus. - Whilst it tightly constrains the bounds of the search-space, it searches the domain methodically rather than intelligently. --} -findPolynomialSolutions :: (Control.DeepSeq.NFData i, Data.Array.IArray.Ix i, Integral i) - => Data.PrimeWheel.PrimeWheel i - -> i -- ^ The maximum prime-number required. - -> [i] -findPolynomialSolutions primeWheel maxPrime = foldr1 ToolShed.Data.List.merge {-The lists were previously sorted, as a side-effect, by 'filterOddRepetitions'-} $ Control.Parallel.Strategies.withStrategy ( - Control.Parallel.Strategies.parList Control.Parallel.Strategies.rdeepseq - ) [ - {-# SCC "4x^2+y^2" #-} filterOddRepetitions [ - z | - x' <- takeWhile (<= pred maxPrime) $ map (* 4) squares, - z <- takeWhile (<= maxPrime) $ map (+ x') oddSquares, - lookupPolynomialType z == ModFour - ], -- List-comprehension. Twice the length of the other two lists. - {-# SCC "3x^2+y^2" #-} filterOddRepetitions [ - z | - x' <- takeWhile (<= pred maxPrime) $ map (* 3) squares, - z <- takeWhile (<= maxPrime) . map (+ x') $ if even x' then oddSelection else evenSelection, - lookupPolynomialType z == ModSix - ], -- List-comprehension. - {-# SCC "3x^2-y^2" #-} filterOddRepetitions [ - z | - x2 <- takeWhile (<= maxPrime `div` 2) squares, - z <- dropWhile (> maxPrime) . map (3 * x2 -) . takeWhile (< x2) $ if even x2 then oddSelection else evenSelection, - lookupPolynomialType z == ModTwelve - ] -- List-comprehension. - ] where - (evenSquares, oddSquares) = Data.List.partition even squares - --- evenSelection, oddSelection :: Integral i => [i] - evenSelection = selection110 evenSquares where - selection110 (x0 : x1 : _ : xs) = x0 : x1 : selection110 xs -- Effectively, those for meeting ((== 4) . (`mod` 6)). - selection110 xs = xs - oddSelection = selection101 oddSquares where - selection101 (x0 : _ : x2 : xs) = x0 : x2 : selection101 xs -- Effectively, those for meeting ((== 1) . (`mod` 6)). - selection101 xs = xs - --- lookupPolynomialType :: (Data.Array.IArray.Ix i, Integral i) => i -> PolynomialType - lookupPolynomialType = (polynomialTypeLookup primeWheel maxPrime !) . (`rem` polynomialTypeLookupPeriod primeWheel) - --- | Generates the /bounded/ list of multiples, of the /square/ of the specified prime, skipping those which aren't required. -generateMultiplesOfSquareTo :: Integral i - => Data.PrimeWheel.PrimeWheel i -- ^ Used to generate the gaps between prime multiples of the square. - -> i -- ^ The /prime/. - -> i -- ^ The maximum bound. - -> [i] -generateMultiplesOfSquareTo primeWheel prime max' = takeWhile (<= max') . scanl (\accumulator -> (+ accumulator) . (* prime2)) prime2 . cycle $ Data.PrimeWheel.getSpokeGaps primeWheel where - prime2 = Math.Power.square prime - -{- | - * Generates the constant /bounded/ list of /prime-numbers/. - - * --} -sieveOfAtkin :: (Control.DeepSeq.NFData i, Data.Array.IArray.Ix i, Integral i) - => Data.PrimeWheel.NPrimes -- ^ Other implementations effectively use a hard-coded value either /2/ or /3/, but /6/ seems better. - -> i -- ^ The maximum prime required. - -> [i] -- ^ The /bounded/ list of primes. -sieveOfAtkin wheelSize maxPrime = (prefactoredPrimes ++) . filterSquareFree Data.Set.empty . dropWhile (<= maximum prefactoredPrimes) $ findPolynomialSolutions primeWheel maxPrime where - primeWheel = Data.PrimeWheel.mkPrimeWheel wheelSize - prefactoredPrimes = getPrefactoredPrimes primeWheel - --- filterSquareFree :: Integral i => Data.Set.Set i -> [i] -> [i] - filterSquareFree _ [] = [] - filterSquareFree primeMultiples (candidate : candidates) - | Data.Set.member candidate primeMultiples = {-# SCC "delete" #-} filterSquareFree (Data.Set.delete candidate primeMultiples) candidates -- Tail-recurse. - | otherwise = {-# SCC "insert" #-} candidate : filterSquareFree (Data.Set.union primeMultiples . Data.Set.fromDistinctAscList $ generateMultiplesOfSquareTo primeWheel candidate maxPrime) candidates - -{-# NOINLINE sieveOfAtkin #-} -{-# RULES "sieveOfAtkin/Int" sieveOfAtkin = sieveOfAtkinInt #-} -- CAVEAT: doesn't fire when built with profiling enabled. - --- | A specialisation of 'sieveOfAtkin', which reduces both the execution-time and the space required. -sieveOfAtkinInt :: Data.PrimeWheel.NPrimes -> Int -> [Int] -sieveOfAtkinInt wheelSize maxPrime = (prefactoredPrimes ++) . filterSquareFree Data.IntSet.empty . dropWhile (<= maximum prefactoredPrimes) $ findPolynomialSolutions primeWheel maxPrime where - primeWheel = Data.PrimeWheel.mkPrimeWheel wheelSize - prefactoredPrimes = getPrefactoredPrimes primeWheel - - filterSquareFree :: Data.IntSet.IntSet -> [Int] -> [Int] - filterSquareFree _ [] = [] - filterSquareFree primeMultiples (candidate : candidates) - | Data.IntSet.member candidate primeMultiples = filterSquareFree (Data.IntSet.delete candidate primeMultiples) candidates - | otherwise = candidate : filterSquareFree (Data.IntSet.union primeMultiples . Data.IntSet.fromDistinctAscList $ generateMultiplesOfSquareTo primeWheel candidate maxPrime) candidates - diff --git a/src/Factory/Math/Implementations/Primes/SieveOfEratosthenes.hs b/src/Factory/Math/Implementations/Primes/SieveOfEratosthenes.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Primes/SieveOfEratosthenes.hs +++ /dev/null @@ -1,162 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Generates the constant, conceptually infinite, list of /prime-numbers/, using the /Sieve of Eratosthenes/; . - - * Based on . - - * The implementation; - has been optimised using a /wheel/ of static, but parameterised, size; - is polymorphic, but with a specialisation for type 'Int'. - - [@CAVEAT@] The 'Int'-specialisation is implemented by a /rewrite-rule/, which is /very/ fragile. --} - -module Factory.Math.Implementations.Primes.SieveOfEratosthenes( --- * Types --- ** Type-synonyms --- PrimeMultiplesQueue, --- PrimeMultiplesMap, --- Repository, --- PrimeMultiplesMapInt, --- RepositoryInt, --- * Functions --- head', --- tail', - sieveOfEratosthenes, --- sieveOfEratosthenesInt -) where - -import Control.Arrow((&&&), (***)) -import qualified Control.Arrow -import qualified Data.IntMap -import qualified Data.Map -import Data.Sequence((|>)) -import qualified Data.Sequence -import qualified Factory.Data.PrimeWheel as Data.PrimeWheel - --- | The 'Data.Sequence.Seq' counterpart to 'Data.List.head'. -head' :: Data.Sequence.Seq [a] -> [a] -head' = (`Data.Sequence.index` 0) - -{- | - * The 'Data.Sequence.Seq' counterpart to 'Data.List.tail'. - - * CAVEAT: because @ Data.List.tail [] @ returns an error, whereas @ tail' Data.Sequence.empty @ returns 'Data.Sequence.empty', - this function is for internal use only. --} -tail' :: Data.Sequence.Seq [a] -> Data.Sequence.Seq [a] -tail' = Data.Sequence.drop 1 - --- | An ordered queue of the multiples of primes. -type PrimeMultiplesQueue i = Data.Sequence.Seq (Data.PrimeWheel.PrimeMultiples i) - --- | A map of the multiples of primes. -type PrimeMultiplesMap i = Data.Map.Map i (Data.PrimeWheel.PrimeMultiples i) - --- | Combine a /queue/, with a /map/, to form a repository to hold prime-multiples. -type Repository i = (PrimeMultiplesQueue i, PrimeMultiplesMap i) - -{- | - * A refinement of the /Sieve Of Eratosthenes/, which pre-sieves candidates, selecting only those /coprime/ to the specified short sequence of low prime-numbers. - - * The short sequence of initial primes are represented by a 'Data.PrimeWheel.PrimeWheel', - of parameterised, but static, size; . - - * The algorithm requires one to record multiples of previously discovered primes, allowing /composite/ candidates to be eliminated by comparison. - - * Because each /list/ of multiples, starts with the /square/ of the prime from which it was generated, - the vast majority will be larger than the maximum prime ultimately demanded, and the effort of constructing and storing this list, is consequently wasted. - Many implementations solve this, by requiring specification of the maximum prime required, - thus allowing the construction of redundant lists of multiples to be avoided. - - * This implementation doesn't impose that constraint, leaving a requirement for /rapid/ storage, - which is supported by /appending/ the /list/ of prime-multiples, to a /queue/. - If a large enough candidate is ever generated, to match the /head/ of the /list/ of prime-multiples, - at the /head/ of this /queue/, then the whole /list/ of prime-multiples is dropped from the /queue/, - but the /tail/ of this /list/ of prime-multiples, for which there is now a high likelyhood of a subsequent match, must now be re-recorded. - A /queue/ doesn't support efficient random /insertion/, so a 'Data.Map.Map' is used for these subsequent multiples. - This solution is faster than just using a "Data.PQueue.Min". - - * CAVEAT: has linear /O(n)/ space-complexity. --} -sieveOfEratosthenes :: Integral i - => Data.PrimeWheel.NPrimes - -> [i] -sieveOfEratosthenes = uncurry (++) . (Data.PrimeWheel.getPrimeComponents &&& start . Data.PrimeWheel.roll) . Data.PrimeWheel.mkPrimeWheel where - start :: Integral i => [Data.PrimeWheel.Distance i] -> [i] - start ~((candidate, rollingWheel) : distances) = candidate : sieve (head distances) (Data.Sequence.singleton $ Data.PrimeWheel.generateMultiples candidate rollingWheel, Data.Map.empty) - - sieve :: Integral i => Data.PrimeWheel.Distance i -> Repository i -> [i] - sieve distance@(candidate, rollingWheel) repository@(primeSquares, squareFreePrimeMultiples) = case Data.Map.lookup candidate squareFreePrimeMultiples of - Just primeMultiples -> sieve' $ Control.Arrow.second (insertUniq primeMultiples . Data.Map.delete candidate) repository -- Re-insert subsequent multiples. - Nothing -- Not a square-free composite. - | candidate == smallestPrimeSquare -> sieve' $ (tail' *** insertUniq subsequentPrimeMultiples) repository -- Migrate subsequent prime-multiples, from 'primeSquares' to 'squareFreePrimeMultiples'. - | otherwise {-prime-} -> candidate : sieve' (Control.Arrow.first (|> Data.PrimeWheel.generateMultiples candidate rollingWheel) repository) - where - (smallestPrimeSquare : subsequentPrimeMultiples) = head' primeSquares - where --- sieve' :: Repository i -> [i] - sieve' = sieve $ Data.PrimeWheel.rotate distance -- Tail-recurse. - - insertUniq :: Ord i => Data.PrimeWheel.PrimeMultiples i -> PrimeMultiplesMap i -> PrimeMultiplesMap i - insertUniq l m = insert $ dropWhile (`Data.Map.member` m) l where --- insert :: Ord i => Data.PrimeWheel.PrimeMultiples i -> PrimeMultiplesMap i - insert [] = error "Factory.Math.Implementations.Primes.SieveOfEratosthenes.sieveOfEratosthenes.sieve.insertUniq.insert:\tnull list" - insert (key : values) = Data.Map.insert key values m - -{-# NOINLINE sieveOfEratosthenes #-} -{-# RULES "sieveOfEratosthenes/Int" sieveOfEratosthenes = sieveOfEratosthenesInt #-} -- CAVEAT: doesn't fire when built with profiling enabled. - --- | A specialisation of 'PrimeMultiplesMap'. -type PrimeMultiplesMapInt = Data.IntMap.IntMap (Data.PrimeWheel.PrimeMultiples Int) - --- | A specialisation of 'Repository'. -type RepositoryInt = (PrimeMultiplesQueue Int, PrimeMultiplesMapInt) - -{- | - * A specialisation of 'sieveOfEratosthenes', which approximately /doubles/ the speed and reduces the space required. - - * CAVEAT: because the algorithm involves /squares/ of primes, - this implementation will overflow when finding primes greater than @2^16@ on a /32-bit/ machine. --} -sieveOfEratosthenesInt :: Data.PrimeWheel.NPrimes -> [Int] -sieveOfEratosthenesInt = uncurry (++) . (Data.PrimeWheel.getPrimeComponents &&& start . Data.PrimeWheel.roll) . Data.PrimeWheel.mkPrimeWheel where - start :: [Data.PrimeWheel.Distance Int] -> [Int] - start ~((candidate, rollingWheel) : distances) = candidate : sieve (head distances) (Data.Sequence.singleton $ Data.PrimeWheel.generateMultiples candidate rollingWheel, Data.IntMap.empty) - - sieve :: Data.PrimeWheel.Distance Int -> RepositoryInt -> [Int] - sieve distance@(candidate, rollingWheel) repository@(primeSquares, squareFreePrimeMultiples) = case Data.IntMap.lookup candidate squareFreePrimeMultiples of - Just primeMultiples -> sieve' $ Control.Arrow.second (insertUniq primeMultiples . Data.IntMap.delete candidate) repository - Nothing - | candidate == smallestPrimeSquare -> sieve' $ (tail' *** insertUniq subsequentPrimeMultiples) repository - | otherwise -> candidate : sieve' (Control.Arrow.first (|> Data.PrimeWheel.generateMultiples candidate rollingWheel) repository) - where - (smallestPrimeSquare : subsequentPrimeMultiples) = head' primeSquares - where - sieve' :: RepositoryInt -> [Int] - sieve' = sieve $ Data.PrimeWheel.rotate distance - - insertUniq :: Data.PrimeWheel.PrimeMultiples Int -> PrimeMultiplesMapInt -> PrimeMultiplesMapInt - insertUniq l m = insert $ dropWhile (`Data.IntMap.member` m) l where - insert :: Data.PrimeWheel.PrimeMultiples Int -> PrimeMultiplesMapInt - insert [] = error "Factory.Math.Implementations.Primes.SieveOfEratosthenes.sieveOfEratosthenesInt.sieve.insertUniq.insert:\tnull list" - insert (key : values) = Data.IntMap.insert key values m diff --git a/src/Factory/Math/Implementations/Primes/TrialDivision.hs b/src/Factory/Math/Implementations/Primes/TrialDivision.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Primes/TrialDivision.hs +++ /dev/null @@ -1,59 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Generates the constant, conceptually infinite, list of /prime-numbers/, using /Trial Division/. --} - -module Factory.Math.Implementations.Primes.TrialDivision( --- * Functions - trialDivision --- ** Predicates --- isIndivisibleBy -) where - -import qualified Control.Arrow -import qualified Data.List -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation -import qualified Factory.Data.PrimeWheel as Data.PrimeWheel - --- | Uses /Trial Division/, to determine whether the specified candidate is indivisible by all potential denominators from the specified list. -isIndivisibleBy :: Integral i - => i -- ^ The numerator. - -> [i] -- ^ The denominators of which it must not be a multiple. - -> Bool -isIndivisibleBy numerator = all ((/= 0) . (numerator `rem`)) . takeWhile (<= Math.PrimeFactorisation.maxBoundPrimeFactor numerator) - -{- | - * For each candidate, confirm indivisibility, by all /primes/ smaller than its /square-root/. - - * The candidates to sieve, are generated by a 'Data.PrimeWheel.PrimeWheel', - of parameterised, but static, size; . --} -trialDivision :: Integral prime => Data.PrimeWheel.NPrimes -> [prime] -trialDivision 0 = [2, 3] ++ filter (`isIndivisibleBy` trialDivision 0 {-recurse-}) [5 ..] -- No faster than using 'Data.PrimeWheel.mkPrimeWheel 0', but apparently better space-complexity ?! -trialDivision wheelSize = Data.PrimeWheel.getPrimeComponents primeWheel ++ indivisible where - primeWheel = Data.PrimeWheel.mkPrimeWheel wheelSize - candidates = map fst $ Data.PrimeWheel.roll primeWheel - indivisible = uncurry (++) . Control.Arrow.second ( - filter (`isIndivisibleBy` indivisible {-recurse-}) - ) $ Data.List.span ( - < Math.Power.square (head candidates) -- The first composite candidate, is the square of the next prime after the wheel's constituent ones. - ) candidates - diff --git a/src/Factory/Math/Implementations/Primes/TurnersSieve.hs b/src/Factory/Math/Implementations/Primes/TurnersSieve.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/Primes/TurnersSieve.hs +++ /dev/null @@ -1,48 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Generates the constant, conceptally infinite, list of /prime-numbers/, using /Turner's Sieve/; . --} - -module Factory.Math.Implementations.Primes.TurnersSieve( --- * Functions - turnersSieve -) where - -import qualified Factory.Math.Power as Math.Power - -{- | - * For each /prime/, the infinite list of candidates greater than its /square/, - is filtered for indivisibility; . - - * CAVEAT: though one can easily add a 'Data.PrimeWheel.PrimeWheel', it proved counterproductive. --} -turnersSieve :: Integral prime => [prime] -turnersSieve = 2 : sieve [3, 5 ..] where - sieve :: Integral i => [i] -> [i] - sieve [] = [] - sieve (prime : candidates) = prime : sieve ( - filter ( - \candidate -> any ($ candidate) [ - (< Math.Power.square prime), -- Unconditionally admit any candidate smaller than the square of the last prime. - (/= 0) . (`rem` prime) -- Ensure indivisibility, of all subsequent candidates, by the last prime discovered. - ] - ) candidates - ) - diff --git a/src/Factory/Math/Implementations/SquareRoot.hs b/src/Factory/Math/Implementations/SquareRoot.hs deleted file mode 100644 --- a/src/Factory/Math/Implementations/SquareRoot.hs +++ /dev/null @@ -1,192 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Math.SquareRoot.Algorithmic' by a variety of methods. - - [@CAVEAT@] - - Caller may benefit from application of 'Math.Precision.simplify' before operating on the result; - which though of the required accuracy, may not be the most concise rational number satisfying that criterion. --} -module Factory.Math.Implementations.SquareRoot( --- * Types --- ** Type-synonyms --- ProblemSpecification, - Terms, --- ** Data-types - Algorithm(..) --- * Functions --- squareRootByContinuedFraction, --- squareRootByIteration, --- squareRootByTaylorSeries, --- taylorSeriesCoefficients -) where - -import Control.Arrow((***)) -import Factory.Data.PrimeFactors((>/<), (>^)) -import qualified Factory.Data.PrimeFactors as Data.PrimeFactors -import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.SquareRoot as Math.SquareRoot -import qualified Factory.Math.Summation as Math.Summation -import qualified ToolShed.Defaultable - --- | The number of terms in a series. -type Terms = Int - --- | The algorithms by which the /square-root/ has been implemented. -data Algorithm - = BakhshaliApproximation -- ^ - | ContinuedFraction -- ^ . - | HalleysMethod -- ^ . - | NewtonRaphsonIteration -- ^ . - | TaylorSeries Terms -- ^ . - deriving (Eq, Read, Show) - -instance ToolShed.Defaultable.Defaultable Algorithm where - defaultValue = NewtonRaphsonIteration - --- | Returns an improved estimate for the /square-root/ of the specified value, to the required precision, using the supplied initial estimate.. -type ProblemSpecification operand - = Math.SquareRoot.Estimate - -> Math.Precision.DecimalDigits -- ^ The required precision. - -> operand -- ^ The value for which to find the /square-root/. - -> Math.SquareRoot.Result - -instance Math.SquareRoot.Algorithmic Algorithm where - squareRootFrom _ _ _ 0 = 0 - squareRootFrom _ _ _ 1 = 1 - squareRootFrom algorithm estimate@(x, decimalDigits) requiredDecimalDigits y - | decimalDigits >= requiredDecimalDigits = x - | requiredDecimalDigits <= 0 = error $ "Factory.Math.Implementations.SquareRoot.squareRootFrom:\tinvalid number of required decimal digits; " ++ show requiredDecimalDigits - | y < 0 = error $ "Factory.Math.Implementations.SquareRoot.squareRootFrom:\tthere's no real square-root of " ++ show y - | otherwise = ( - case algorithm of - ContinuedFraction -> squareRootByContinuedFraction - _ -> squareRootByIteration algorithm - ) estimate requiredDecimalDigits y - -instance Math.SquareRoot.Iterator Algorithm where - step BakhshaliApproximation y x - | dy == 0 = x -- The estimate was precise. - | otherwise = x' - dx' -- Correct the estimate. - where - dy, dydx, dx, x', dydx', dx' :: Math.SquareRoot.Result - dy = Math.SquareRoot.getDiscrepancy y x - dydx = 2 * x - dx = dy / dydx - x' = x + dx -- Identical to Newton-Raphson iteration. - dydx' = 2 * x' - dx' = Math.Power.square dx / dydx' - -{- - * /Halley's/ method; - -> X(n+1) = Xn - f(Xn) / [f'(Xn) - f''(Xn) * f(Xn) / 2 * f'(Xn)] -> => Xn - (Xn^2 - Y) / [2Xn - 2 * (Xn^2 - Y) / 2 * 2Xn] where Y = X^2, f(X) = X^2 - Y, f'(X) = 2X, f''(X) = 2 -> => Xn - 1 / [2Xn / (Xn^2 - Y) - 1 / 2Xn] --} - step HalleysMethod y x - | dy == 0 = x -- The estimate was precise. - | otherwise = x - dx -- Correct the estimate. - where - dy, dydx, dx :: Math.SquareRoot.Result - dy = negate $ Math.SquareRoot.getDiscrepancy y x -- Use the estimate to determine the error in 'y'. - dydx = 2 * x -- The gradient, at the estimated value 'x'. - dx = recip $ dydx / dy - recip dydx - --- step NewtonRaphsonIteration y x = (x + toRational y / x) / 2 -- This is identical to the /Babylonian Method/. --- step NewtonRaphsonIteration y x = x / 2 + toRational y / (2 * x) -- Faster. - step NewtonRaphsonIteration y x = x / 2 + (toRational y / 2) / x -- Faster still. - - step (TaylorSeries terms) y x = squareRootByTaylorSeries terms y x - - step algorithm _ _ = error $ "Factory.Math.Implementations.SquareRoot.step:\tinappropriate algorithm; " ++ show algorithm - - convergenceOrder BakhshaliApproximation = Math.Precision.quarticConvergence - convergenceOrder ContinuedFraction = Math.Precision.linearConvergence - convergenceOrder HalleysMethod = Math.Precision.cubicConvergence - convergenceOrder NewtonRaphsonIteration = Math.Precision.quadraticConvergence - convergenceOrder (TaylorSeries terms) = terms -- The order of convergence, per iteration, equals the number of terms in the series on each iteration. - -{- | - * Uses /continued-fractions/, to iterate towards the principal /square-root/ of the specified positive integer; - , - , - . - - - * The convergence of the /continued-fraction/ is merely /1st order/ (linear). --} -squareRootByContinuedFraction :: Real operand => ProblemSpecification operand -squareRootByContinuedFraction (initialEstimate, initialDecimalDigits) requiredDecimalDigits y = initialEstimate + (convergents initialEstimate !! Math.Precision.getTermsRequired (10 ^^ negate initialDecimalDigits) requiredDecimalDigits) where - convergents :: Math.SquareRoot.Result -> [Math.SquareRoot.Result] - convergents x = iterate ((Math.SquareRoot.getDiscrepancy y x /) . ((2 * x) +)) 0 - -{- | - * The constant coefficients of the /Taylor-series/ for a /square-root/; . - - * @ ((-1)^n * factorial(2*n)) / ((1 - 2*n) * 4^n * factorial(n^2)) @. --} -taylorSeriesCoefficients :: Fractional f => [f] -taylorSeriesCoefficients = zipWith ( - \powers n -> let - doubleN = 2 * n - product' = Data.PrimeFactors.product' (recip 2) {-arbitrary-} 10 {-arbitrary-} - in uncurry (/) . ( - fromIntegral . product' *** fromIntegral . (* ((1 - doubleN) * powers)) . product' - ) $ Math.Implementations.Factorial.primeFactors doubleN >/< Math.Implementations.Factorial.primeFactors n >^ 2 - ) ( - iterate (* negate 4) 1 -- (-4)^n - ) [0 :: Integer ..] -- n - -{- | - * Returns the /Taylor-series/ for the /square-root/ of the specified value, to any requested number of terms. - - * . - - * The convergence of the series is merely /linear/, - in that each term increases the precision, by a constant number of decimal places, equal to the those in the original estimate. - - * By feeding-back the improved estimate, to form a new series, the order of convergence, on each successive iteration, - becomes proportional to the number of terms; - -> Terms Convergence -> ===== =========== -> 2 terms /quadratic/ -> 3 terms /cubic/ --} -squareRootByTaylorSeries :: Real operand - => Terms -- ^ The number of terms of the infinite series, to evaluate. - -> operand -- ^ The value for which the /square-root/ is required. - -> Math.SquareRoot.Result -- ^ An initial estimate. - -> Math.SquareRoot.Result -squareRootByTaylorSeries _ _ 0 = error "Factory.Math.Implementations.SquareRoot.squareRootByTaylorSeries:\talgorithm can't cope with estimated value of zero." -squareRootByTaylorSeries terms y x - | terms < 2 = error $ "Factory.Math.Implementations.SquareRoot.squareRootByTaylorSeries:\tinvalid number of terms; " ++ show terms - | otherwise = Math.Summation.sumR' . take terms . zipWith (*) taylorSeriesCoefficients $ iterate (* relativeError) x - where - relativeError :: Math.SquareRoot.Result - relativeError = pred $ toRational y / Math.Power.square x -- Pedantically, this is the error in y, which is twice the magnitude of the error in x. - --- | Iterates from the estimated value, towards the /square-root/, a sufficient number of times to achieve the required accuracy. -squareRootByIteration :: Real operand => Algorithm -> ProblemSpecification operand -squareRootByIteration algorithm (initialEstimate, initialDecimalDigits) requiredDecimalDigits y = iterate (Math.SquareRoot.step algorithm y) initialEstimate !! Math.Precision.getIterationsRequired (Math.SquareRoot.convergenceOrder algorithm) initialDecimalDigits requiredDecimalDigits - diff --git a/src/Factory/Math/MultiplicativeOrder.hs b/src/Factory/Math/MultiplicativeOrder.hs deleted file mode 100644 --- a/src/Factory/Math/MultiplicativeOrder.hs +++ /dev/null @@ -1,66 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Exports the /Multiplicative Order/ of an integer, in a specific /modular/ arithmetic. - --} - -module Factory.Math.MultiplicativeOrder( --- * Functions - multiplicativeOrder -) where - -import qualified Control.DeepSeq -import qualified Factory.Data.Exponential as Data.Exponential -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.Primality as Math.Primality -import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation - -{- | - * The smallest positive integral power to which the specified integral base must be raised, - to be congruent with one, in the specified /modular/ arithmetic. - - * Based on . - - * . - - * . --} -multiplicativeOrder :: (Math.PrimeFactorisation.Algorithmic primeFactorisationAlgorithm, Control.DeepSeq.NFData i, Integral i, Show i) - => primeFactorisationAlgorithm - -> i -- ^ Base. - -> i -- ^ Modulus. - -> i -- ^ Result. -multiplicativeOrder primeFactorisationAlgorithm base modulus - | modulus < 2 = error $ "Factory.Math.MultiplicativeOrder.multiplicativeOrder:\tinvalid modulus; " ++ show modulus - | not $ Math.Primality.areCoprime base modulus = error $ "Factory.Math.MultiplicativeOrder.multiplicativeOrder:\targuments aren't coprime; " ++ show (base, modulus) - | otherwise = foldr (lcm . multiplicativeOrder') 1 $ Math.PrimeFactorisation.primeFactors primeFactorisationAlgorithm modulus -- Combine the /multiplicative order/ of the constituent /prime-factors/. - where --- multiplicativeOrder' :: (Control.DeepSeq.NFData i, Integral i) => Data.Exponential.Exponential i -> i - multiplicativeOrder' e = product . map ( - \e' -> let - d :: Int - d = length . takeWhile (/= 1) . iterate ( - \y -> Math.Power.raiseModulo y (Data.Exponential.getBase e') pk - ) $ Math.Power.raiseModulo base (totient `div` Data.Exponential.evaluate e') pk - in Data.Exponential.getBase e' ^ d - ) $ Math.PrimeFactorisation.primeFactors primeFactorisationAlgorithm totient where - pk = Data.Exponential.evaluate e - totient = Math.PrimeFactorisation.primePowerTotient e - diff --git a/src/Factory/Math/PerfectPower.hs b/src/Factory/Math/PerfectPower.hs deleted file mode 100644 --- a/src/Factory/Math/PerfectPower.hs +++ /dev/null @@ -1,100 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Exports functions related to /perfect powers/. --} - -module Factory.Math.PerfectPower( --- * Functions - maybeSquareNumber, --- ** Predicates - isPerfectPower --- isPerfectPowerInt -) where - -import qualified Data.IntSet -import qualified Data.Set -import qualified Factory.Math.Power as Math.Power - -{- | - * Returns @(Just . sqrt)@ if the specified integer is a /square number/ (AKA /perfect square/). - - * . - - * . - - * @(Math.Power.square . sqrt)@ is expensive, so the modulus of the operand is tested first, in an attempt to prove it isn't a /perfect square/. - The set of tests, and the valid moduli within each test, are ordered to maximize the rate of failure-detection. --} -maybeSquareNumber :: Integral i => i -> Maybe i -maybeSquareNumber i --- | i < 0 = Nothing -- This function is performance-sensitive, but this test is neither strictly nor frequently required. - | all (\(modulus, valid) -> rem i modulus `elem` valid) [ --- -- Distribution of moduli amongst perfect squares Cumulative failure-detection. - (16, [0,1,4,9]), -- All moduli are equally likely. 75% - (9, [0,1,4,7]), -- Zero occurs 33%, the others only 22%. 88% - (17, [1,2,4,8,9,13,15,16,0]), -- Zero only occurs 5.8%, the others 11.8%. 94% --- These additional tests, aren't always cost-effective. - (13, [1,3,4,9,10,12,0]), -- Zero only occurs 7.7%, the others 15.4%. 97% - (7, [1,2,4,0]), -- Zero only occurs 14.3%, the others 28.6%. 98% - (5, [1,4,0]) -- Zero only occurs 20%, the others 40%. 99% - --- ] && fromIntegral iSqrt == sqrt' = Just iSqrt -- CAVEAT: erroneously True for 187598574531033120 (187598574531033121 is square). - ] && Math.Power.square iSqrt == i = Just iSqrt - | otherwise = Nothing - where - sqrt' :: Double - sqrt' = sqrt $ fromIntegral i - - iSqrt = round sqrt' - -{- | - * An integer @(> 1)@ which can be expressed as an integral power @(> 1)@ of a smaller /natural/ number. - - * CAVEAT: /zero/ and /one/ are normally excluded from this set. - - * . - - * . - - * A generalisation of the concept of /perfect squares/, in which only the exponent '2' is significant. --} -isPerfectPower :: Integral i => i -> Bool -isPerfectPower i - | i < Math.Power.square 2 = False - | otherwise = i `Data.Set.member` foldr ( - \n set -> if n `Data.Set.member` set - then set --- else Data.Set.union set . Data.Set.fromDistinctAscList . takeWhile (<= i) . iterate (* n) $ Math.Power.square n - else foldr Data.Set.insert set . takeWhile (<= i) . iterate (* n) $ Math.Power.square n -- Faster. - ) Data.Set.empty [2 .. round $ sqrt (fromIntegral i :: Double)] - -{-# NOINLINE isPerfectPower #-} -{-# RULES "isPerfectPower/Int" isPerfectPower = isPerfectPowerInt #-} - --- | A specialisation of 'isPerfectPower'. -isPerfectPowerInt :: Int -> Bool -isPerfectPowerInt i - | i < Math.Power.square 2 = False - | otherwise = i `Data.IntSet.member` foldr ( - \n set -> if n `Data.IntSet.member` set - then set - else foldr Data.IntSet.insert set . takeWhile (<= i) . iterate (* n) $ Math.Power.square n - ) Data.IntSet.empty [2 .. round $ sqrt (fromIntegral i :: Double)] - diff --git a/src/Factory/Math/Pi.hs b/src/Factory/Math/Pi.hs deleted file mode 100644 --- a/src/Factory/Math/Pi.hs +++ /dev/null @@ -1,100 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the classes of /Pi/-algorithm which have been implemented. --} - -module Factory.Math.Pi( --- * Type-classes - Algorithmic(..), --- * Types --- ** Data-types - Category(..) -) where - -import qualified Factory.Math.Precision as Math.Precision -import qualified ToolShed.Defaultable - -{- | - * Defines the methods expected of a /Pi/-algorithm. - - * Most of the implementations naturally return a 'Rational', but the spigot-algorithms naturally produce a @[Int]@; - though representing /Pi/ as a big integer with the decimal point removed is clearly incorrect. - - * Since representing /Pi/ as either a 'Rational' or promoted to an 'Integer', is inconvenient, an alternative decimal 'String'-representation is provided. --} -class Algorithmic algorithm where - openR :: algorithm -> Math.Precision.DecimalDigits -> Rational -- ^ Returns the value of /Pi/ as a 'Rational'. - - openI :: algorithm -> Math.Precision.DecimalDigits -> Integer -- ^ Returns the value of /Pi/, promoted by the required precision to form an integer. - openI _ 1 = 3 - openI algorithm decimalDigits - | decimalDigits <= 0 = error $ "Factory.Math.Pi.openI:\tinsufficient decimalDigits=" ++ show decimalDigits - | otherwise = round . Math.Precision.promote (openR algorithm decimalDigits) $ pred decimalDigits - - openS :: algorithm -> Math.Precision.DecimalDigits -> String -- ^ Returns the value of /Pi/ as a decimal 'String'. - openS _ 1 = "3" - openS algorithm decimalDigits - | decimalDigits <= 0 = "" - | decimalDigits <= 16 = take (succ decimalDigits) $ show (pi :: Double) - | otherwise = "3." ++ tail (show $ openI algorithm decimalDigits) -- Insert a decimal point. - --- | Categorises the various algorithms. -data Category agm bbp borwein ramanujan spigot - = AGM agm -- ^ Algorithms based on the /Arithmetic-geometric Mean/. - | BBP bbp -- ^ . - | Borwein borwein -- ^ . - | Ramanujan ramanujan -- ^ . - | Spigot spigot -- ^ Algorithms from which the digits of /Pi/ slowly drip, one by one. - deriving (Eq, Read, Show) - -instance ( - ToolShed.Defaultable.Defaultable agm, - ToolShed.Defaultable.Defaultable bbp, - ToolShed.Defaultable.Defaultable borwein, - ToolShed.Defaultable.Defaultable ramanujan, - ToolShed.Defaultable.Defaultable spigot - ) => ToolShed.Defaultable.Defaultable (Category agm bbp borwein ramanujan spigot) where - defaultValue = BBP ToolShed.Defaultable.defaultValue - -instance ( - Algorithmic agm, - Algorithmic bbp, - Algorithmic borwein, - Algorithmic ramanujan, - Algorithmic spigot - ) => Algorithmic (Category agm bbp borwein ramanujan spigot) where - openR algorithm decimalDigits - | decimalDigits <= 0 = error $ "Factory.Math.Pi.openR:\tinsufficient decimalDigits=" ++ show decimalDigits - | decimalDigits <= 16 = Math.Precision.simplify (pred decimalDigits) (pi :: Double) - | otherwise = ( - case algorithm of - AGM agm -> openR agm - BBP bbp -> openR bbp - Borwein borwein -> openR borwein - Ramanujan ramanujan -> openR ramanujan - Spigot spigot -> openR spigot - ) decimalDigits - - openI _ 1 = 3 - openI (Spigot spigot) decimalDigits = openI spigot decimalDigits - openI algorithm decimalDigits - | decimalDigits <= 0 = error $ "Factory.Math.Pi.openI:\tinsufficient decimalDigits=" ++ show decimalDigits - | otherwise = round . Math.Precision.promote (openR algorithm decimalDigits) $ pred decimalDigits - diff --git a/src/Factory/Math/Power.hs b/src/Factory/Math/Power.hs deleted file mode 100644 --- a/src/Factory/Math/Power.hs +++ /dev/null @@ -1,84 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Exports functions involving integral powers. --} - -module Factory.Math.Power( --- * Functions - square, - squaresFrom, - cube, - cubeRoot, - raiseModulo -) where - --- | Mainly for convenience. -square :: Num n => n -> n -square x = x ^ (2 :: Int) -- CAVEAT: this could be eta-reduced, but it won't then inline when called with a single argument. - -{-# INLINE square #-} - --- | Just for convenience. -cube :: Num n => n -> n -cube = (^ (3 :: Int)) - -{- | - * Iteratively generate sequential /squares/, from the specified initial value, - based on the fact that @(x + 1)^2 = x^2 + 2 * x + 1@. - - * The initial value doesn't need to be either positive or integral. --} -squaresFrom :: (Enum n, Num n) - => n -- ^ Lower bound. - -> [(n, n)] -- ^ @ [(n, n^2)] @. -squaresFrom from = iterate (\(x, y) -> (succ x, succ $ y + 2 * x)) (from, square from) - --- | Just for convenience. -cubeRoot :: Double -> Double -cubeRoot = (** recip 3) - -{- | - * Raise an arbitrary number to the specified positive integral power, using /modular/ arithmetic. - - * Implements exponentiation as a sequence of either /squares/ or multiplications by the base; - . - - * . --} -raiseModulo :: (Integral i, Integral power, Show power) - => i -- ^ Base. - -> power - -> i -- ^ Modulus. - -> i -- ^ Result. -raiseModulo _ _ 0 = error "Factory.Math.Power.raiseModulo:\tzero modulus." -raiseModulo _ _ 1 = 0 -raiseModulo _ 0 modulus = 1 `mod` modulus -raiseModulo base power modulus - | base < 0 = (`mod` modulus) . (if even power then id else negate) $ raiseModulo (negate base) power modulus -- Recurse. - | power < 0 = error $ "Factory.Math.Power.raiseModulo:\tnegative power; " ++ show power - | first `elem` [0, 1] = first - | otherwise = slave power - where - first = base `mod` modulus - - slave 1 = first - slave e = (`mod` modulus) . (if r == 0 {-even-} then id else (* base)) . square $ slave q {-recurse-} where - (q, r) = e `quotRem` 2 - diff --git a/src/Factory/Math/Precision.hs b/src/Factory/Math/Precision.hs deleted file mode 100644 --- a/src/Factory/Math/Precision.hs +++ /dev/null @@ -1,125 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the unit with which precision is measured, and operations on it. --} -module Factory.Math.Precision( --- * Types --- ** Type-synonyms - ConvergenceOrder, - ConvergenceRate, - DecimalDigits, --- * Constants - linearConvergence, - quadraticConvergence, - cubicConvergence, - quarticConvergence, --- * Functions - getIterationsRequired, - getTermsRequired, - roundTo, - promote, - simplify -) where - -import qualified Data.Ratio - --- | The /order of convergence/; . -type ConvergenceOrder = Int - --- | The /rate of convergence/; . -type ConvergenceRate = Double - --- | A number of decimal digits; presumably positive. -type DecimalDigits = Int - --- | /Linear/ convergence-rate; which may be qualified by the /rate of convergence/. -linearConvergence :: ConvergenceOrder -linearConvergence = 1 - --- | /Quadratic/ convergence-rate. -quadraticConvergence :: ConvergenceOrder -quadraticConvergence = 2 - --- | /Cubic/ convergence-rate. -cubicConvergence :: ConvergenceOrder -cubicConvergence = 3 - --- | /Quartic/ convergence-rate. -quarticConvergence :: ConvergenceOrder -quarticConvergence = 4 - --- | The predicted number of iterations, required to achieve a specific accuracy, at a given /order of convergence/. -getIterationsRequired :: Integral i - => ConvergenceOrder - -> DecimalDigits -- ^ The precision of the initial estimate. - -> DecimalDigits -- ^ The required precision. - -> i -getIterationsRequired convergenceOrder initialDecimalDigits requiredDecimalDigits - | initialDecimalDigits <= 0 = error $ "Factory.Math.Precision.getIterationsRequired:\tinsufficient 'initialDecimalDigits'; " ++ show initialDecimalDigits - | precisionRatio <= 1 = 0 - | otherwise = ceiling $ fromIntegral convergenceOrder `logBase` precisionRatio - where - precisionRatio :: Double - precisionRatio = fromIntegral requiredDecimalDigits / fromIntegral initialDecimalDigits - -{- | - * The predicted number of terms which must be extracted from a series, - if it is to converge to the required accuracy, - at the specified linear /convergence-rate/. - - * The /convergence-rate/ of a series, is the error in the series after summation of @(n+1)th@ terms, - divided by the error after only @n@ terms, as the latter tends to infinity. - As such, for a /convergent/ series (in which the error get smaller with successive terms), it's value lies in the range @0 .. 1@. - - * . --} -getTermsRequired :: Integral i - => ConvergenceRate - -> DecimalDigits -- ^ The additional number of correct decimal digits. - -> i -getTermsRequired _ 0 = 0 -getTermsRequired convergenceRate requiredDecimalDigits - | convergenceRate <= 0 || convergenceRate >= 1 = error $ "Factory.Math.Precision.getTermsRequired:\t(0 < convergence-rate < 1); " ++ show convergenceRate - | requiredDecimalDigits < 0 = error $ "Factory.Math.Precision.getTermsRequired:\t'requiredDecimalDigits' must be positive; " ++ show requiredDecimalDigits - | otherwise = ceiling $ fromIntegral requiredDecimalDigits / negate (logBase 10 convergenceRate) - --- | Rounds the specified number, to a positive number of 'DecimalDigits'. -roundTo :: (RealFrac a, Fractional f) => DecimalDigits -> a -> f -roundTo decimals = (/ fromInteger promotionFactor) . fromInteger . round . (* fromInteger promotionFactor) where - promotionFactor :: Integer - promotionFactor = 10 ^ decimals - --- | Promotes the specified number, by a positive number of 'DecimalDigits'. -promote :: Num n => n -> DecimalDigits -> n -promote x = (* x) . (10 ^) - -{- | - * Reduces a 'Rational' to the minimal form required for the specified number of /fractional/ decimal places; - irrespective of the number of integral decimal places. - - * A 'Rational' approximation to an irrational number, may be very long, and provide an unknown excess precision. - Whilst this doesn't sound harmful, it costs in performance and memory-requirement, and being unpredictable isn't actually useful. --} -simplify :: RealFrac operand - => DecimalDigits -- ^ The number of places after the decimal point, which are required. - -> operand - -> Rational -simplify decimalDigits operand = Data.Ratio.approxRational operand . recip $ 4 * 10 ^ succ decimalDigits -- Tolerate any error less than half the least significant digit required. - diff --git a/src/Factory/Math/Primality.hs b/src/Factory/Math/Primality.hs deleted file mode 100644 --- a/src/Factory/Math/Primality.hs +++ /dev/null @@ -1,102 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Exports a common interface for primality-implementations. - - * Provides utilities for these implementations. --} - -module Factory.Math.Primality( --- * Type-classes - Algorithmic(..), --- * Functions - carmichaelNumbers, --- ** Predicates - areCoprime, - isFermatWitness, - isCarmichaelNumber -) where - -import qualified Control.DeepSeq -import qualified Factory.Math.Power as Math.Power - --- | Defines the methods expected of a primality-testing algorithm. -class Algorithmic algorithm where - isPrime :: (Control.DeepSeq.NFData i, Integral i, Show i) => algorithm -> i -> Bool - -{- | - 'True' if the two specified integers are /relatively prime/, - i.e. if they share no common positive factors except one. - - * @1@ and @-1@ are the only numbers which are /coprime/ to themself. - - * . - - * . --} -areCoprime :: Integral i => i -> i -> Bool -areCoprime i = (== 1) . gcd i - -{- | - * Tests /Fermat's Little Theorem/ for all applicable values, as a probabilistic primality-test. - - * . - - * . - - * . - - * CAVEAT: this primality-test fails for the /Carmichael numbers/. - - * TODO: confirm that all values must be tested. --} -isFermatWitness :: (Integral i, Show i) => i -> Bool -isFermatWitness i = not . all isFermatPseudoPrime $ filter (areCoprime i) [2 .. pred i] where - isFermatPseudoPrime base = Math.Power.raiseModulo base (pred i) i == 1 -- CAVEAT: a /Fermat Pseudo-prime/ must also be a /composite/ number. - -{- | - * A /Carmichael number/ is an /odd/ /composite/ number which satisfies /Fermat's little theorem/. - - * . - - * . --} -isCarmichaelNumber :: ( - Algorithmic algorithm, - Control.DeepSeq.NFData i, - Integral i, - Show i - ) => algorithm -> i -> Bool -isCarmichaelNumber algorithm i = not $ or [ - i <= 2, - even i, - isFermatWitness i, - isPrime algorithm i - ] - --- | An ordered list of the /Carmichael/ numbers; . -carmichaelNumbers :: ( - Algorithmic algorithm, - Control.DeepSeq.NFData i, - Integral i, - Show i - ) => algorithm -> [i] -carmichaelNumbers algorithm = isCarmichaelNumber algorithm `filter` [3, 5 ..] diff --git a/src/Factory/Math/PrimeFactorisation.hs b/src/Factory/Math/PrimeFactorisation.hs deleted file mode 100644 --- a/src/Factory/Math/PrimeFactorisation.hs +++ /dev/null @@ -1,151 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * . - - * Exports a common interface to permit decomposition of positive integers, - into the unique combination of /prime/-factors known to exist according to the /Fundamental Theorem of Arithmetic/; . - - * Leveraging this abstract capability, it derives the /smoothness/, /power-smoothness/, /omega/-numbers and /square-free/ integers. - - * Filters the list of /regular-numbers/ from the list of /smoothness/. - - * CAVEAT: to avoid wasting time, it may be advantageous to check /Factory.Math.Primality.isPrime/ first. --} - -module Factory.Math.PrimeFactorisation( --- * Type-classes - Algorithmic(..), --- * Functions - maxBoundPrimeFactor, - smoothness, - powerSmoothness, - regularNumbers, - primePowerTotient, - eulersTotient, - omega, - squareFree -) where - -import qualified Control.DeepSeq -import qualified Data.List -import qualified Factory.Data.Exponential as Data.Exponential -import qualified Factory.Data.PrimeFactors as Data.PrimeFactors - --- | Defines the methods expected of a /factorisation/-algorithm. -class Algorithmic algorithm where - primeFactors :: (Control.DeepSeq.NFData base, Integral base) - => algorithm - -> base -- ^ The operand - -> Data.PrimeFactors.Factors base Int {-arbitrarily-} - -{- | - * The upper limit for a prime to be considered as a candidate factor of the specified number. - - * One might naively think that this limit is @(x `div` 2)@ for an even number, - but though a prime-factor /greater/ than the /square-root/ of the number can exist, - its smaller /cofactor/ decomposes to a prime which must be less than the /square-root/. - - * NB: rather then using @(primeFactor <= sqrt numerator)@ to filter the candidate prime-factors of a given numerator, - one can alternatively use @(numerator >= primeFactor ^ 2)@ to filter what can potentially be factored by a given prime-factor. - - * CAVEAT: suffers from rounding-errors, though no consequence has been witnessed. --} -maxBoundPrimeFactor :: Integral i => i -> i -maxBoundPrimeFactor = floor . (sqrt :: Double -> Double) . fromIntegral - -{- | - * A constant, zero-indexed, conceptually infinite, list, of the /smooth/ness of all positive integers. - - * . - - * . --} -smoothness :: (Algorithmic algorithm, Control.DeepSeq.NFData base, Integral base) => algorithm -> [base] -smoothness algorithm = 0 : map (Data.Exponential.getBase . last . primeFactors algorithm) [1 ..] - -{- | - * A constant, zero-indexed, conceptually infinite, list of the /power-smooth/ness of all positive integers. - - * . --} -powerSmoothness :: (Algorithmic algorithm, Control.DeepSeq.NFData base, Integral base) => algorithm -> [base] -powerSmoothness algorithm = 0 : map (maximum . map Data.Exponential.evaluate . primeFactors algorithm) [1 ..] - -{- | - * Filters 'smoothness', to derive the constant list of /Hamming-numbers/. - - * . --} -regularNumbers :: (Algorithmic algorithm, Control.DeepSeq.NFData base, Integral base) => algorithm -> [base] -regularNumbers algorithm = map fst . filter ((<= (5 :: Integer)) . snd) . zip [1 ..] . tail $ smoothness algorithm - -{- | - * /Euler's Totient/ for a /power/ of a /prime/-number. - - * By /Olofsson/; @(phi(n^k) = n^(k - 1) * phi(n))@ - and since @(phi(prime) = prime - 1)@ - - * CAVEAT: checks neither the primality nor the bounds of the specified value; therefore for internal use only. --} -primePowerTotient :: (Integral base, Integral exponent) => Data.Exponential.Exponential base exponent -> base -primePowerTotient (base, exponent') = pred base * base ^ pred exponent' - -{- | - * The number of /coprimes/ less than or equal to the specified positive integer. - - * . - - * . - - * AKA /EulerPhi/. --} -eulersTotient :: ( - Algorithmic algorithm, - Control.DeepSeq.NFData i, - Integral i, - Show i - ) => algorithm -> i -> i -eulersTotient _ 1 = 1 -eulersTotient algorithm i - | i <= 0 = error $ "Factory.Math.PrimeFactorisation.eulersTotient:\tundefined for; " ++ show i - | otherwise = product . map primePowerTotient $ primeFactors algorithm i - -{- | - * A constant, zero-indexed, conceptually infinite, list of the /small omega/ numbers (i.e. the number of /distinct/ prime factors); cf. /big omega/. - - * . - - * - - * . --} -omega :: (Algorithmic algorithm, Control.DeepSeq.NFData i, Integral i) => algorithm -> [i] -omega algorithm = map (Data.List.genericLength . primeFactors algorithm) [0 :: Integer ..] - -{- | - * A constant, conceptually infinite, list of the /square-free/ numbers, i.e. those which aren't divisible by any /perfect square/. - - * . --} -squareFree :: (Algorithmic algorithm, Control.DeepSeq.NFData i, Integral i) => algorithm -> [i] -squareFree algorithm = filter (all (== 1) . map Data.Exponential.getExponent . primeFactors algorithm) [1 ..] - diff --git a/src/Factory/Math/Primes.hs b/src/Factory/Math/Primes.hs deleted file mode 100644 --- a/src/Factory/Math/Primes.hs +++ /dev/null @@ -1,64 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Exports a common interface for implementations of /prime-number/ generators. --} - -module Factory.Math.Primes( --- * Types-classes - Algorithmic(..), --- * Functions - primorial, - mersenneNumbers -) where - -import qualified Control.DeepSeq -import qualified Data.Array.IArray - --- | Defines the methods expected of a /prime-number/ generator. -class Algorithmic algorithm where - primes :: (Control.DeepSeq.NFData i, Data.Array.IArray.Ix i, Integral i) => algorithm -> [i] -- ^ Returns the constant, infinite, list of primes. - -{- | - * Returns the constant list, defining the /Primorial/. - - * . - - * . --} -primorial :: ( - Algorithmic algorithm, - Control.DeepSeq.NFData i, - Data.Array.IArray.Ix i, - Integral i - ) => algorithm -> [i] -primorial = scanl (*) 1 . primes - -{- | - * Returns the constant ordered infinite list of /Mersenne numbers/. - - * Only the subset composed from a prime exponent is returned; which is a strict superset of the /Mersenne Primes/. - - * . - - * --} -mersenneNumbers :: (Algorithmic algorithm, Integral i) => algorithm -> [i] -mersenneNumbers algorithm = map (pred . (2 ^)) (primes algorithm :: [Int]) -- Whilst the exponentiation could be parallelised, not all values are known to be required. - diff --git a/src/Factory/Math/Probability.hs b/src/Factory/Math/Probability.hs deleted file mode 100644 --- a/src/Factory/Math/Probability.hs +++ /dev/null @@ -1,255 +0,0 @@ -{- - Copyright (C) 2011-2013 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Functions for probability-distributions. - - [@CAVEAT@] Because data-constructors are exposed, 'ToolShed.SelfValidate.isValid' need not be called. --} - -module Factory.Math.Probability( --- * Type-classes - Distribution(..), --- * Types --- ** Data-types - ContinuousDistribution(..), - DiscreteDistribution(..), --- * Functions - maxPreciseInteger, --- minPositiveFloat, - boxMullerTransform, --- reProfile, - generateStandardizedNormalDistribution, - generateContinuousPopulation, --- generatePoissonDistribution, - generateDiscretePopulation -) where - -import qualified Control.Arrow -import Control.Arrow((***), (&&&)) -import qualified Factory.Data.Interval as Data.Interval -import qualified Factory.Math.Power as Math.Power -import qualified System.Random -import qualified ToolShed.Data.List -import qualified ToolShed.Data.Pair -import qualified ToolShed.SelfValidate - --- | The maximum integer which can be accurately represented as a Double. -maxPreciseInteger :: RealFloat a => a -> Integer -maxPreciseInteger = (2 ^) . floatDigits - -{- | - * Determines the minimum positive floating-point number, which can be represented by using the parameter's type. - - * Only the type of the parameter is relevant, not its value. --} -minPositiveFloat :: RealFloat a => a -> a -minPositiveFloat = encodeFloat 1 . uncurry (-) . (fst . floatRange &&& floatDigits) - --- | Describes /continuous probability-distributions/; . -data ContinuousDistribution parameter - = ExponentialDistribution parameter {-lambda-} -- ^ Defines an /Exponential/-distribution with a particular /lambda/; . - | LogNormalDistribution parameter {-location-} parameter {-scale2-} -- ^ Defines a distribution whose logarithm is normally distributed with a particular /mean/ & /variance/; . - | NormalDistribution parameter {-mean-} parameter {-variance-} -- ^ Defines a /Normal/-distribution with a particular /mean/ & /variance/; . - | UniformDistribution (Data.Interval.Interval parameter) -- ^ Defines a /Uniform/-distribution within a /closed interval/; . - deriving (Eq, Read, Show) - -instance (Floating parameter, Ord parameter, Show parameter) => ToolShed.SelfValidate.SelfValidator (ContinuousDistribution parameter) where - getErrors probabilityDistribution = ToolShed.SelfValidate.extractErrors $ case probabilityDistribution of - ExponentialDistribution lambda -> [(lambda <= 0, "'lambda' must exceed zero; " ++ show probabilityDistribution ++ ".")] - LogNormalDistribution location scale2 -> let - maxParameter = log . fromInteger $ maxPreciseInteger (undefined :: Double) - in [ - (scale2 <= 0, "'scale' must exceed zero; " ++ show probabilityDistribution ++ "."), - (location > maxParameter || scale2 > maxParameter, "loss of precision will result from either 'location' or 'scale^2' exceeding '" ++ show maxParameter ++ "'; " ++ show probabilityDistribution ++ ".") - ] - NormalDistribution _ variance -> [(variance <= 0, "variance must exceed zero; " ++ show probabilityDistribution ++ ".")] - UniformDistribution interval -> [(Data.Interval.isReversed interval, "reversed interval='" ++ show probabilityDistribution ++ "'.")] - --- | Describes /discrete probability-distributions/; . -data DiscreteDistribution parameter - = PoissonDistribution parameter {-lambda-} -- ^ Defines an /Poisson/-distribution with a particular /lambda/; . - | ShiftedGeometricDistribution parameter {-probability-} -- ^ Defines an /Geometric/-distribution with a particular probability of success; . - deriving (Eq, Read, Show) - -instance (Num parameter, Ord parameter, Show parameter) => ToolShed.SelfValidate.SelfValidator (DiscreteDistribution parameter) where - getErrors probabilityDistribution = ToolShed.SelfValidate.extractErrors $ case probabilityDistribution of - PoissonDistribution lambda -> [(lambda <= 0, "'lambda' must exceed zero; " ++ show probabilityDistribution ++ ".")] - ShiftedGeometricDistribution probability -> [(any ($ probability) [(<= 0), (> 1)], "probability must be in the semi-closed unit-interval (0, 1]; " ++ show probabilityDistribution ++ ".")] - --- | Defines a common interface for probability-distributions. -class Distribution probabilityDistribution where - generatePopulation - :: (Fractional sample, System.Random.RandomGen randomGen) - => probabilityDistribution - -> randomGen -- ^ A generator of /uniformly distributed/ random numbers. - -> [sample] -- ^ CAVEAT: the integers generated for discrete distributions are represented by a fractional type; use 'generateDiscretePopulation' if this is a problem. - - getMean :: Fractional mean => probabilityDistribution -> mean -- ^ The theoretical mean. - - getStandardDeviation :: Floating standardDeviation => probabilityDistribution -> standardDeviation-- ^ The theoretical standard-deviation. - getStandardDeviation = sqrt . getVariance -- Default implementation. - - getVariance :: Floating variance => probabilityDistribution -> variance -- ^ The theoretical variance. - getVariance = Math.Power.square . getStandardDeviation -- Default implementation. - -instance (RealFloat parameter, Show parameter, System.Random.Random parameter) => Distribution (ContinuousDistribution parameter) where - generatePopulation probabilityDistribution = map realToFrac {-parameter -> sample-} . generateContinuousPopulation probabilityDistribution - - getMean (ExponentialDistribution lambda) = realToFrac $ recip lambda - getMean (LogNormalDistribution location scale2) = realToFrac . exp . (+ location) $ scale2 / 2 - getMean (NormalDistribution mean _) = realToFrac mean - getMean (UniformDistribution (minParameter, maxParameter)) = realToFrac $ (minParameter + maxParameter) / 2 - - getVariance (ExponentialDistribution lambda) = realToFrac . recip $ Math.Power.square lambda - getVariance (LogNormalDistribution location scale2) = realToFrac $ (exp scale2 - 1) * exp (2 * location + scale2) -- NB: for standard-deviation == mean, use scale^2 == ln 2. - getVariance (NormalDistribution _ variance) = realToFrac variance - getVariance (UniformDistribution (minParameter, maxParameter)) = realToFrac $ Math.Power.square (maxParameter - minParameter) / 12 - -instance (RealFloat parameter, Show parameter, System.Random.Random parameter) => Distribution (DiscreteDistribution parameter) where - generatePopulation probabilityDistribution = map fromInteger . generateDiscretePopulation probabilityDistribution - - getMean (PoissonDistribution lambda) = realToFrac lambda - getMean (ShiftedGeometricDistribution probability) = realToFrac $ recip probability - - getVariance (PoissonDistribution lambda) = realToFrac lambda - getVariance (ShiftedGeometricDistribution probability) = realToFrac $ (1 - probability) / Math.Power.square probability - -{- | - * Converts a pair of independent /uniformly distributed/ random numbers, within the /semi-closed unit interval/ /(0,1]/, - to a pair of independent /normally distributed/ random numbers, of standardized /mean/=0, and /variance/=1. - - * . --} -boxMullerTransform :: ( - Floating f, - Ord f, - Show f - ) - => (f, f) -- ^ Independent, /uniformly distributed/ random numbers, which must be within the /semi-closed unit interval/, /(0,1]/. - -> (f, f) -- ^ Independent, /normally distributed/ random numbers, with standardized /mean/=0 and /variance/=1. -boxMullerTransform cartesian - | not . uncurry (&&) $ ToolShed.Data.Pair.mirror inSemiClosedUnitInterval cartesian = error $ "Factory.Math.Probability.boxMullerTransform:\tspecified Cartesian coordinates, must be within semi-closed unit-interval (0, 1]; " ++ show cartesian - | otherwise = polarToCartesianTransform $ (sqrt . negate . (* 2) . log *** (* 2) . (* pi)) cartesian - where - inSemiClosedUnitInterval :: (Num n, Ord n) => n -> Bool - inSemiClosedUnitInterval = uncurry (&&) . ((> 0) &&& (<= 1)) - - polarToCartesianTransform :: Floating f => (f, f) -> (f, f) - polarToCartesianTransform = uncurry (*) . Control.Arrow.second cos &&& uncurry (*) . Control.Arrow.second sin - -{- | - * Uses the supplied random-number generator, - to generate a conceptually infinite list, of /normally distributed/ random numbers, with standardized /mean/=0, and /variance/=1. - - * , . --} -generateStandardizedNormalDistribution :: ( - RealFloat f, - Show f, - System.Random.Random f, - System.Random.RandomGen randomGen - ) => randomGen -> [f] -generateStandardizedNormalDistribution = ToolShed.Data.List.linearise . uncurry (zipWith $ curry boxMullerTransform) . ToolShed.Data.Pair.mirror ( - System.Random.randomRs (minPositiveFloat undefined, 1) - ) . System.Random.split - --- | Stretches and shifts a /distribution/ to achieve the required /mean/ and /standard-deviation/. -reProfile :: (Distribution distribution, Floating n) => distribution -> [n] -> [n] -reProfile distribution = map ((+ getMean distribution) . (* getStandardDeviation distribution)) - --- | Uses the supplied random-number generator, to generate a conceptually infinite population, with the specified continuous probability-distribution. -generateContinuousPopulation :: ( - RealFloat f, - Show f, - System.Random.Random f, - System.Random.RandomGen randomGen - ) - => ContinuousDistribution f - -> randomGen -- ^ A generator of /uniformly distributed/ random numbers. - -> [f] -generateContinuousPopulation probabilityDistribution randomGen - | not $ ToolShed.SelfValidate.isValid probabilityDistribution = error $ "Factory.Math.Probability.generateContinuousPopulation:\t" ++ ToolShed.SelfValidate.getFirstError probabilityDistribution - | otherwise = ( - case probabilityDistribution of - ExponentialDistribution lambda -> let - quantile = (/ lambda) . negate . log . (1 -) -- . - in map quantile . System.Random.randomRs (0, 1) - LogNormalDistribution location scale2 -> map ( - exp . (+ location) . (* sqrt scale2) -- Stretch the standard-deviation & re-locate the mean to that specified for the log-space, then return to the original coordinates. - ) . generateStandardizedNormalDistribution - NormalDistribution _ _ -> reProfile probabilityDistribution . generateStandardizedNormalDistribution - UniformDistribution interval -> System.Random.randomRs interval - ) randomGen - -{- | - * Uses the supplied random-number generator, - to generate a conceptually infinite population, of random integers conforming to the /Poisson distribution/; . - - * CAVEAT: - uses an algorithm by Knuth, which having a /linear time-complexity/ in /lambda/, can be intolerably slow; - also, the term @exp $ negate lambda@, underflows for large /lambda/; - so for large /lambda/, this implementation returns the appropriate 'NormalDistribution'. --} -generatePoissonDistribution :: ( - Integral sample, - RealFloat lambda, - Show lambda, - System.Random.Random lambda, - System.Random.RandomGen randomGen - ) - => lambda -- ^ Defines the required approximate value of both /mean/ and /variance/. - -> randomGen - -> [sample] -generatePoissonDistribution lambda - | lambda <= 0 = error $ "Factory.Math.Probability.generatePoissonDistribution:\tlambda must exceed zero " ++ show lambda - | lambda > ( - negate . log $ minPositiveFloat lambda -- Guard against underflow, in the user-defined type for lambda. - ) = filter (>= 0) . map round . (reProfile (PoissonDistribution lambda) :: [Double] -> [Double]) . generateStandardizedNormalDistribution - | otherwise = generator - where - generator = uncurry (:) . ( - fst . head . dropWhile ( - (> exp (negate lambda)) . snd -- CAVEAT: underflows if lambda > (103 :: Float, 745 :: Double). - ) . scanl ( - \accumulator random -> succ *** (* random) $ accumulator - ) (negate 1, 1) . System.Random.randomRs (0, 1) *** generator {-recurse-} - ) . System.Random.split - --- | Uses the supplied random-number generator, to generate a conceptually infinite population, with the specified discrete probability-distribution. -generateDiscretePopulation :: ( - Integral sample, - Ord parameter, - RealFloat parameter, - Show parameter, - System.Random.Random parameter, - System.Random.RandomGen randomGen - ) - => DiscreteDistribution parameter - -> randomGen -- ^ A generator of /uniformly distributed/ random numbers. - -> [sample] -generateDiscretePopulation probabilityDistribution randomGen - | not $ ToolShed.SelfValidate.isValid probabilityDistribution = error $ "Factory.Math.Probability.generateDiscretePopulation:\t" ++ ToolShed.SelfValidate.getFirstError probabilityDistribution - | otherwise = ( - case probabilityDistribution of - PoissonDistribution lambda -> generatePoissonDistribution lambda - ShiftedGeometricDistribution probability - | probability == 1 -> const $ repeat 1 -- The first Bernoulli Trial is guaranteed to succeed. - | otherwise -> map ceiling {-minimum 1-} . (\x -> x :: [Rational]) . generatePopulation (ExponentialDistribution . negate $ log (1 - probability)) -- The geometric distribution is a discrete version of the exponential distribution. - ) randomGen - diff --git a/src/Factory/Math/Radix.hs b/src/Factory/Math/Radix.hs deleted file mode 100644 --- a/src/Factory/Math/Radix.hs +++ /dev/null @@ -1,139 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Facilitates representation of 'Integral' values in alternative 'Integral' bases. --} - -module Factory.Math.Radix( --- * Constants --- decodes, --- digits, --- encodes, --- * Functions - digitSum, - digitalRoot, - fromBase, - toBase -) where - -import Data.Array.IArray((!)) -import qualified Data.Array.IArray -import qualified Data.Char -import qualified Data.List -import qualified Data.Maybe - --- | Characters used to represent the digits of numbers in @(-36 <= base <= 36)@. -digits :: String -digits = ['0' .. '9'] ++ ['a' .. 'z'] - --- | Constant random-access lookup for 'digits'. -encodes :: (Data.Array.IArray.Ix index, Integral index) => Data.Array.IArray.Array index Char -encodes = Data.Array.IArray.listArray (0, pred $ Data.List.genericLength digits) digits - --- | Constant reverse-lookup for 'digits'. -decodes :: Integral i => [(Char, i)] -decodes = zip digits [0 ..] - -{- | - * Convert the specified integral decimal quantity, to an alternative base, and represent the result as a 'String'. - - * Both negative decimals and negative bases are permissible. - - * The conversion to 'Char' can only succeed where printable and intelligible characters exist to represent all digits in the chosen base; - which in practice means @(-36 <= base <= 36)@. --} -toBase :: ( - Data.Array.IArray.Ix decimal, - Integral base, - Integral decimal, - Show base, - Show decimal - ) => base -> decimal -> String -toBase 10 decimal = show decimal -- Base unchanged. -toBase _ 0 = "0" -- Zero has the same representation in any base. -toBase base decimal - | abs base < 2 = error $ "Factory.Math.Radix.toBase:\tan arbitrary integer can't be represented in base " ++ show base - | abs base > Data.List.genericLength digits = error $ "Factory.Math.Radix.toBase:\tunable to clearly represent the complete set of digits in base " ++ show base - | base > 0 && decimal < 0 = '-' : map toDigit (fromDecimal (negate decimal) []) - | otherwise = toDigit `map` fromDecimal decimal [] - where - fromDecimal 0 = id - fromDecimal n - | remainder < 0 = fromDecimal (succ quotient) . ((remainder - fromIntegral base) :) -- This can only occur when base is negative; cf. 'divMod'. - | otherwise = fromDecimal quotient . (remainder :) - where - (quotient, remainder) = n `quotRem` fromIntegral base - - toDigit :: (Data.Array.IArray.Ix i, Integral i, Show i) => i -> Char - toDigit n - | n >&< encodes = encodes ! n - | otherwise = error $ "Factory.Math.Radix.toBase.toDigit:\tno suitable character-representation for integer " ++ show n - where - (>&<) :: (Data.Array.IArray.Ix i, Integral i) => i -> Data.Array.IArray.Array i Char -> Bool - index >&< array = ($ index) `all` [(>= lower), (<= upper)] where - (lower, upper) = Data.Array.IArray.bounds array - -{- | - * Convert the 'String'-representation of a number in the specified base, to a decimal integer. - - * Both negative numbers and negative bases are permissible. --} -fromBase :: ( - Integral base, - Integral decimal, - Read decimal, - Show base - ) => base -> String -> decimal -fromBase 10 s = read s -- Base unchanged. -fromBase _ "0" = 0 -- Zero has the same representation in any base. -fromBase base s - | abs base < 2 = error $ "Factory.Math.Radix.fromBase:\tan arbitrary integer can't be represented in base " ++ show base - | abs base > Data.List.genericLength digits = error $ "Factory.Math.Radix.fromBase:\tunable to clearly represent the complete set of digits in base " ++ show base - | base > 0 && head s == '-' = negate . fromBase base $ tail s -- Recurse. - | otherwise = Data.List.foldl' (\l -> ((l * fromIntegral base) +) . fromDigit) 0 s where - fromDigit :: Integral i => Char -> i - fromDigit c = case c `lookup` decodes of - Just i - | i >= abs (fromIntegral base) -> error $ "Factory.Math.Radix.fromBase.fromDigit:\tillegal char " ++ show c ++ ", for base " ++ show base - | otherwise -> i - _ -> error $ "Factory.Math.Radix.fromBase.fromDigit:\tunrecognised char " ++ show c - -{- | - * . - - * . --} -digitSum :: ( - Data.Array.IArray.Ix decimal, - Integral base, - Integral decimal, - Show base, - Show decimal - ) => base -> decimal -> decimal -digitSum 10 = fromIntegral . foldr ((+) . Data.Char.digitToInt) 0 . show -digitSum base = sum . Data.Maybe.mapMaybe (`lookup` decodes) . toBase base - --- | . -digitalRoot :: ( - Data.Array.IArray.Ix decimal, - Integral decimal, - Show decimal - ) => decimal -> decimal -digitalRoot = until (<= 9) (digitSum (10 :: Int)) - diff --git a/src/Factory/Math/SquareRoot.hs b/src/Factory/Math/SquareRoot.hs deleted file mode 100644 --- a/src/Factory/Math/SquareRoot.hs +++ /dev/null @@ -1,120 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Exports a common interface for /square-root/ implementations. - - * Provides utilities for these implementations. --} - -module Factory.Math.SquareRoot( --- * Type-classes - Algorithmic(..), - Iterator(..), --- * Types --- ** Type-synonyms - Result, - Estimate, --- * Functions - getAccuracy, - getDiscrepancy, - getEstimate, --- rSqrt, --- ** Predicates - isPrecise -) where - -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.Precision as Math.Precision - --- | The result-type; actually, only the concrete return-type of 'Math.Precision.simplify', stops it being a polymorphic instance of 'Fractional'. -type Result = Rational - --- | Contains an estimate for the /square-root/ of a value, and its accuracy. -type Estimate = (Result, Math.Precision.DecimalDigits) - --- | Defines the methods expected of a /square-root/ algorithm. -class Algorithmic algorithm where - squareRootFrom :: (Real operand, Show operand) - => algorithm - -> Estimate -- ^ An initial estimate from which to start. - -> Math.Precision.DecimalDigits -- ^ The required precision. - -> operand -- ^ The value for which to find the /square-root/. - -> Result -- ^ Returns an improved estimate of the /square-root/, found using the specified algorithm, accurate to at least the required number of decimal digits. - - squareRoot :: (Real operand, Show operand) - => algorithm - -> Math.Precision.DecimalDigits -- ^ The required precision. - -> operand -- ^ The value for which to find the /square-root/. - -> Result -- ^ Returns an estimate of the /square-root/, found using the specified algorithm, accurate to at least the required number of decimal digits. - squareRoot algorithm decimalDigits operand = squareRootFrom algorithm (getEstimate operand) decimalDigits operand -- Default implementation - --- | The interface required to iterate, from an estimate of the required value, to the next approximation. -class Iterator algorithm where - step :: Real operand - => algorithm - -> operand -- ^ The value for which the /square-root/ is required; @y@. - -> Result -- ^ The current estimate; @x(n)@. - -> Result -- ^ An improved estimate; @x(n+1)@. - - convergenceOrder :: algorithm -> Math.Precision.ConvergenceOrder -- ^ The ultimate ratio of successive terms as the iteration converges. - --- | Generalise 'sqrt' to operate on any 'Real' operand. -rSqrt :: Real operand => operand -> Double -rSqrt = sqrt . realToFrac - --- | Uses 'Double'-precision floating-point arithmetic, to obtain an initial estimate for the /square-root/, and its accuracy. -getEstimate :: (Real operand, Show operand) => operand -> Estimate -getEstimate y - | y < 0 = error $ "Factory.Math.SquareRoot.getEstimate:\tthere's no real square-root of " ++ show y - | otherwise = (Math.Precision.simplify decimalDigits {-doubles performance by roughly length of the Rational representation-} . toRational $ rSqrt y, decimalDigits) - where - decimalDigits :: Math.Precision.DecimalDigits - decimalDigits = 16 -- . - -{- | - * The signed difference between the /square/ of an estimate for the /square-root/ of a value, and that value. - - * Positive when the estimate is too low. - - * CAVEAT: the magnitude is twice the error in the /square-root/. --} -getDiscrepancy :: Real operand => operand -> Result -> Result -getDiscrepancy y x = toRational y - Math.Power.square x - --- | True if the specified estimate for the /square-root/, is precise. -isPrecise :: Real operand => operand -> Result -> Bool -isPrecise y x = getDiscrepancy y x == 0 - -{- | - * For a given value and an estimate of its /square-root/, - returns the number of decimals digits to which the /square-root/ is accurate; including the integral digits. - - * CAVEAT: the result returned for an exact match has been bodged. --} -getAccuracy :: Real operand => operand -> Result -> Math.Precision.DecimalDigits -getAccuracy y x - | absoluteError == 0 = maxBound -- Bodge. --- | otherwise = length . takeWhile (< 1) $ iterate (* 10) relativeError -- CAVEAT: too slow. - | otherwise = length $ show (round $ toRational y / absoluteError :: Integer) - where - absoluteError :: Result - absoluteError = abs (getDiscrepancy y x) / 2 -- NB: the magnitude of the error in 'y', is twice the error in its square-root, 'x'. - diff --git a/src/Factory/Math/Statistics.hs b/src/Factory/Math/Statistics.hs deleted file mode 100644 --- a/src/Factory/Math/Statistics.hs +++ /dev/null @@ -1,181 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Miscellaneous statistics functions. --} - -module Factory.Math.Statistics( --- * Functions - getMean, - getWeightedMean, --- getDispersionFromMean, - getVariance, - getStandardDeviation, - getAverageAbsoluteDeviation, - getCoefficientOfVariance, - nCr, - nPr -) where - -import Control.Arrow((***)) -import Control.Parallel(par, pseq) -import qualified Data.Foldable -import qualified Data.List -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial -import qualified Factory.Math.Power as Math.Power - -{- | - * Determines the /mean/ of the specified numbers; . - - * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. --} -getMean :: ( - Data.Foldable.Foldable foldable, - Fractional result, - Real value - ) - => foldable value - -> result -getMean foldable - | denominator == 0 = error "Factory.Math.Statistics.getMean:\tno data => undefined result." - | otherwise = realToFrac numerator / fromIntegral denominator - where - (numerator, denominator) = Data.Foldable.foldr (\s -> (+ s) *** succ) (0, 0 :: Int) foldable - -{- | - * Determines the /weighted mean/ of the specified numbers; . - - * The specified value is only evaluated if the corresponding weight is non-zero. - - * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. --} -getWeightedMean :: ( - Data.Foldable.Foldable foldable, - Fractional result, - Real value, - Real weight - ) - => foldable (value, weight) -- ^ Each pair consists of a value & the corresponding weight. - -> result -getWeightedMean foldable - | denominator == 0 = error "Factory.Math.Statistics.getWeightedMean:\tzero weight => undefined result." - | otherwise = numerator / realToFrac denominator - where - (numerator, denominator) = Data.Foldable.foldr ( - \(value, weight) -> if weight == 0 - then id --Avoid unnecessarily evaluation. - else (+ realToFrac value * realToFrac weight) *** (+ weight) - ) (0, 0) foldable - -{- | - * Measures the /dispersion/ of a /population/ of results from the /mean/ value; . - - * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. --} -getDispersionFromMean :: ( - Data.Foldable.Foldable foldable, - Fractional result, - Functor foldable, - Real value - ) => (Rational -> Rational) -> foldable value -> result -getDispersionFromMean weight foldable = getMean $ fmap (weight . (+ negate mean) . toRational) foldable where - mean :: Rational - mean = getMean foldable - -{- | - * Determines the exact /variance/ of the specified numbers; . - - * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. --} -getVariance :: ( - Data.Foldable.Foldable foldable, - Fractional variance, - Functor foldable, - Real value - ) => foldable value -> variance -getVariance = getDispersionFromMean Math.Power.square - --- | Determines the /standard-deviation/ of the specified numbers; . -getStandardDeviation :: ( - Data.Foldable.Foldable foldable, - Floating result, - Functor foldable, - Real value - ) => foldable value -> result -getStandardDeviation = sqrt . getVariance - -{- | - * Determines the /average absolute deviation/ of the specified numbers; . - - * Should the caller define the result-type as 'Rational', then it will be free from rounding-errors. --} -getAverageAbsoluteDeviation :: ( - Data.Foldable.Foldable foldable, - Fractional result, - Functor foldable, - Real value - ) => foldable value -> result -getAverageAbsoluteDeviation = getDispersionFromMean abs - --- | Determines the /coefficient-of-variance/ of the specified numbers; . -getCoefficientOfVariance :: ( - Data.Foldable.Foldable foldable, - Eq result, - Floating result, - Functor foldable, - Real value - ) => foldable value -> result -getCoefficientOfVariance l - | mean == 0 = error "Factory.Math.Statistics.getCoefficientOfVariance:\tundefined if mean is zero." - | otherwise = getStandardDeviation l / abs mean - where - mean = getMean l - --- | The number of unordered /combinations/ of /r/ objects taken from /n/; . -nCr :: (Math.Factorial.Algorithmic factorialAlgorithm, Integral i, Show i) - => factorialAlgorithm - -> i -- ^ The total number of items from which to select. - -> i -- ^ The number of items in a sample. - -> i -- ^ The number of combinations. -nCr _ 0 _ = 1 -nCr _ _ 0 = 1 -nCr factorialAlgorithm n r - | n < 0 = error $ "Factory.Math.Statistics.nCr:\tinvalid n; " ++ show n - | r < 0 = error $ "Factory.Math.Statistics.nCr:\tinvalid r; " ++ show r - | n < r = 0 - | otherwise = numerator `par` (denominator `pseq` numerator `div` denominator) - where - [smaller, bigger] = Data.List.sort [r, n - r] - numerator = Math.Implementations.Factorial.risingFactorial (succ bigger) (n - bigger) - denominator = Math.Factorial.factorial factorialAlgorithm smaller - --- | The number of /permutations/ of /r/ objects taken from /n/; . -nPr :: (Integral i, Show i) - => i -- ^ The total number of items from which to select. - -> i -- ^ The number of items in a sample. - -> i -- ^ The number of permutations. -nPr 0 _ = 1 -nPr _ 0 = 1 -nPr n r - | n < 0 = error $ "Factory.Math.Statistics.nPr:\tinvalid n; " ++ show n - | r < 0 = error $ "Factory.Math.Statistics.nPr:\tinvalid r; " ++ show r - | n < r = 0 - | otherwise = Math.Implementations.Factorial.fallingFactorial n r - diff --git a/src/Factory/Math/Summation.hs b/src/Factory/Math/Summation.hs deleted file mode 100644 --- a/src/Factory/Math/Summation.hs +++ /dev/null @@ -1,91 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Provides an alternative algorithm for the summation of /rational/ numbers. --} - -module Factory.Math.Summation( --- * Functions - sum', - sumR', - sumR -) where - -import qualified Control.DeepSeq -import qualified Control.Parallel.Strategies -import qualified Data.List -import qualified Data.Ratio -import Data.Ratio((%)) -import qualified ToolShed.Data.List - -{- | - * Sums a list of numbers of arbitrary type. - - * Sparks the summation of @(list-length / chunk-size)@ chunks from the list, each of the specified size (thought the last chunk may be smaller), - then recursively sums the list of results from each spark. - - * CAVEAT: unless the numbers are large, 'Rational' (requiring /cross-multiplication/), or the list long, - 'sum' is too light-weight for sparking to be productive, - therefore it is more likely to be the parallelised deep /evaluation/ of list-elements which saves time. --} -sum' :: (Num n, Control.DeepSeq.NFData n) - => ToolShed.Data.List.ChunkLength - -> [n] - -> n -sum' chunkLength - | chunkLength <= 1 = error $ "Factory.Math.Summation.sum':\tinvalid chunk-size; " ++ show chunkLength - | otherwise = slave - where - slave :: (Num n, Control.DeepSeq.NFData n) => [n] -> n - slave [] = 0 - slave [x] = x - slave l = slave {-recurse-} . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq sum $ ToolShed.Data.List.chunk chunkLength l - -{- | - * Sums a list of /rational/ type numbers. - - * CAVEAT: though faster than 'Data.List.sum', this algorithm has poor space-complexity, making it unsuitable for unrestricted use. --} -{-# INLINE sumR' #-} -- This makes a staggering difference. -sumR' :: Integral i => [Data.Ratio.Ratio i] -> Data.Ratio.Ratio i -sumR' l = foldr (\ratio -> ((Data.Ratio.numerator ratio * (commonDenominator `div` Data.Ratio.denominator ratio)) +)) 0 l % commonDenominator where --- commonDenominator = foldr (lcm . Data.Ratio.denominator) 1 l - commonDenominator = Data.List.foldl' (\multiple -> lcm multiple . Data.Ratio.denominator) 1 l -- Slightly faster. - -{- | - * Sums a list of /rational/ numbers. - - * Sparks the summation of @(list-length / chunk-length)@ chunks from the list, each of the specified size (thought the last chunk may be smaller), - then recursively sums the list of results from each spark. - - * CAVEAT: memory-use is proportional to chunk-size. --} -{-# INLINE sumR #-} -- This makes a staggering difference to calls from other modules. -sumR :: (Integral i, Control.DeepSeq.NFData i) - => ToolShed.Data.List.ChunkLength - -> [Data.Ratio.Ratio i] - -> Data.Ratio.Ratio i -sumR chunkLength - | chunkLength <= 1 = error $ "Factory.Math.Summation.sumR:\tinvalid chunk-size; " ++ show chunkLength - | otherwise = slave - where - slave :: (Integral i, Control.DeepSeq.NFData i) => [Data.Ratio.Ratio i] -> Data.Ratio.Ratio i - slave l - | length l <= chunkLength = sumR' l - | otherwise = slave {-recurse-} . Control.Parallel.Strategies.parMap Control.Parallel.Strategies.rdeepseq sumR' $ ToolShed.Data.List.chunk chunkLength l diff --git a/src/Factory/Test/CommandOptions.hs b/src/Factory/Test/CommandOptions.hs deleted file mode 100644 --- a/src/Factory/Test/CommandOptions.hs +++ /dev/null @@ -1,48 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines the available set of command-line options; of which there's currently only one. --} - -module Factory.Test.CommandOptions( --- * Types --- ** Data-types - CommandOptions(..), --- * Functions --- ** Mutators - setVerbose -) where - -import qualified ToolShed.Defaultable - --- | Declare a record used to contain command-line options. -data CommandOptions = MkCommandOptions { - verbose :: Bool -- ^ Whether additional informative output should be generated, where applicable. -} - -instance ToolShed.Defaultable.Defaultable CommandOptions where - defaultValue = MkCommandOptions { verbose = False } - --- | Mutator. -setVerbose :: CommandOptions -> CommandOptions -setVerbose commandOptions = commandOptions { - verbose = True -} - - diff --git a/src/Factory/Test/Performance/Factorial.hs b/src/Factory/Test/Performance/Factorial.hs deleted file mode 100644 --- a/src/Factory/Test/Performance/Factorial.hs +++ /dev/null @@ -1,73 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Times the methods exported from module "Math.Factorial". --} - -module Factory.Test.Performance.Factorial( --- * Functions - factorialPerformance, - factorialPerformanceControl, - factorialPerformanceGraph, - factorialPerformanceGraphControl -) where - -import qualified Control.DeepSeq -import qualified Data.List -import qualified Factory.Math.Factorial as Math.Factorial -import qualified ToolShed.System.TimePure - --- | Measures the CPU-time required by 'Math.Factorial.factorial'. -factorialPerformance :: ( - Control.DeepSeq.NFData i, - Integral i, - Math.Factorial.Algorithmic algorithm, - Show i - ) => algorithm -> i -> IO (Double, i) -factorialPerformance algorithm = ToolShed.System.TimePure.getCPUSeconds . Math.Factorial.factorial algorithm - --- | Measures the CPU-time required by a naive implementation. -factorialPerformanceControl :: (Control.DeepSeq.NFData i, Integral i) => i -> IO (Double, i) --- factorialPerformanceControl i = ToolShed.System.TimePure.getCPUSeconds $ product [1 .. i] -- CAVEAT: too lazy. -factorialPerformanceControl i = ToolShed.System.TimePure.getCPUSeconds $ Data.List.foldl' (*) 1 [2 .. i] - -{- | - * Measure the CPU-time required by 'Math.Factorial.factorial', against an exponentially increasing operand. - - * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. --} -factorialPerformanceGraph :: Math.Factorial.Algorithmic algorithm => Bool -> algorithm -> IO () -factorialPerformanceGraph verbose algorithm = mapM_ ( - \operand -> factorialPerformance algorithm operand >>= putStrLn . shows operand . showChar '\t' . ( - if verbose - then (`shows` "") - else (`shows` "") . fst - ) - ) $ iterate (* 2) (1 :: Integer) - --- | Graphs the CPU-time required by a naive implementation, against an exponentially increasing operand. -factorialPerformanceGraphControl :: Bool -> IO () -factorialPerformanceGraphControl verbose = mapM_ ( - \operand -> factorialPerformanceControl operand >>= putStrLn . shows operand . showChar '\t' . ( - if verbose - then (`shows` "") - else (`shows` "") . fst - ) - ) $ iterate (* 2) (1 :: Integer) - diff --git a/src/Factory/Test/Performance/Hyperoperation.hs b/src/Factory/Test/Performance/Hyperoperation.hs deleted file mode 100644 --- a/src/Factory/Test/Performance/Hyperoperation.hs +++ /dev/null @@ -1,71 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Times functions exported from module "Math.Hyperoperation". --} - -module Factory.Test.Performance.Hyperoperation( --- * Functions - hyperoperationPerformance, - hyperoperationPerformanceGraphRank, - hyperoperationPerformanceGraphExponent -) where - -import qualified Factory.Math.Hyperoperation as Math.Hyperoperation -import qualified ToolShed.System.TimePure - --- | Measures the CPU-time required by 'Math.Hyperoperation.hyperoperation'. -hyperoperationPerformance :: (Integral rank, Show rank) => rank -> Math.Hyperoperation.Base -> Math.Hyperoperation.HyperExponent -> IO (Double, Integer) -hyperoperationPerformance rank base = ToolShed.System.TimePure.getCPUSeconds . Math.Hyperoperation.hyperoperation rank base - -{- | - * Measure the CPU-time required by 'Math.Hyperoperation.hyperoperation', against a linearly increasing /rank/. - - * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. --} -hyperoperationPerformanceGraphRank - :: Bool -- ^ Verbose. - -> Math.Hyperoperation.Base - -> Math.Hyperoperation.HyperExponent - -> IO () -hyperoperationPerformanceGraphRank verbose base hyperExponent = mapM_ ( - \rank -> hyperoperationPerformance rank base hyperExponent >>= putStrLn . shows rank . showChar '\t' . ( - if verbose - then (`shows` "") - else (`shows` "") . fst - ) - ) [0 :: Int ..] - -{- | - * Measure the CPU-time required by 'Math.Hyperoperation.hyperoperation', against a linearly increasing /hyper-exponent/. - - * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. --} -hyperoperationPerformanceGraphExponent :: (Integral rank, Show rank) - => Bool -- ^ Verbose. - -> rank - -> Math.Hyperoperation.Base - -> IO () -hyperoperationPerformanceGraphExponent verbose rank base = mapM_ ( - \hyperExponent -> hyperoperationPerformance rank base hyperExponent >>= putStrLn . shows hyperExponent . showChar '\t' . ( - if verbose - then (`shows` "") - else (`shows` "") . fst - ) - ) [0 ..] diff --git a/src/Factory/Test/Performance/Pi.hs b/src/Factory/Test/Performance/Pi.hs deleted file mode 100644 --- a/src/Factory/Test/Performance/Pi.hs +++ /dev/null @@ -1,81 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Times the methods exported from module "Math.Pi". --} - -module Factory.Test.Performance.Pi( --- * Types --- ** Type-synonyms - Category, --- * Functions - piPerformance, - piPerformanceGraph -) where - -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Implementations.Pi.AGM.Algorithm as Math.Implementations.Pi.AGM.Algorithm -import qualified Factory.Math.Implementations.Pi.BBP.Algorithm as Math.Implementations.Pi.BBP.Algorithm -import qualified Factory.Math.Implementations.Pi.Borwein.Algorithm as Math.Implementations.Pi.Borwein.Algorithm -import qualified Factory.Math.Implementations.Pi.Ramanujan.Algorithm as Math.Implementations.Pi.Ramanujan.Algorithm -import qualified Factory.Math.Implementations.Pi.Spigot.Algorithm as Math.Implementations.Pi.Spigot.Algorithm -import qualified Factory.Math.Pi as Math.Pi -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.SquareRoot as Math.SquareRoot -import qualified ToolShed.System.TimePure - --- | The type of a /Pi/-algorithm, including where required, the algorithm for /square-root/s and /factorial/s. -type Category squareRootAlgorithm factorialAlgorithm = Math.Pi.Category ( - Math.Implementations.Pi.AGM.Algorithm.Algorithm squareRootAlgorithm - ) Math.Implementations.Pi.BBP.Algorithm.Algorithm ( - Math.Implementations.Pi.Borwein.Algorithm.Algorithm squareRootAlgorithm factorialAlgorithm - ) ( - Math.Implementations.Pi.Ramanujan.Algorithm.Algorithm squareRootAlgorithm factorialAlgorithm - ) Math.Implementations.Pi.Spigot.Algorithm.Algorithm - --- | Measures the CPU-time required to find Pi to the required precision. -piPerformance :: ( - Math.SquareRoot.Algorithmic squareRootAlgorithm, - Math.Factorial.Algorithmic factorialAlgorithm - ) => Category squareRootAlgorithm factorialAlgorithm -> Math.Precision.DecimalDigits -> IO (Double, String) -piPerformance category = ToolShed.System.TimePure.getCPUSeconds . Math.Pi.openS category - -{- | - * Measures the CPU-time required to determine /Pi/ to an exponentially increasing precision-requirement. - - * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. --} -piPerformanceGraph :: ( - Math.SquareRoot.Algorithmic squareRootAlgorithm, - Show squareRootAlgorithm, - Math.Factorial.Algorithmic factorialAlgorithm, - Show factorialAlgorithm - ) => RealFrac i - => Category squareRootAlgorithm factorialAlgorithm -- ^ The algorithm. - -> i -- ^ The factor by which the precision is increased on each iteration. - -> Math.Precision.DecimalDigits -- ^ The maximum precision required. - -> Bool -- ^ Whether to return the digits of /Pi/. - -> IO () -piPerformanceGraph category factor maxDecimalDigits verbose = mapM_ ( - \decimalDigits -> piPerformance category decimalDigits >>= putStrLn . shows decimalDigits . showChar '\t' . ( - if verbose - then (`shows` "") - else (`shows` "") . fst - ) - ) . takeWhile (<= maxDecimalDigits) . map round $ iterate (* factor) 1 diff --git a/src/Factory/Test/Performance/Primality.hs b/src/Factory/Test/Performance/Primality.hs deleted file mode 100644 --- a/src/Factory/Test/Performance/Primality.hs +++ /dev/null @@ -1,54 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Times functions exported from module "Math.Primality". --} - -module Factory.Test.Performance.Primality( --- * Functions - carmichaelNumbersPerformance, - isPrimePerformance, - isPrimePerformanceGraph -) where - -import qualified Control.DeepSeq -import qualified Factory.Math.Fibonacci as Math.Fibonacci -import qualified Factory.Math.Primality as Math.Primality -import qualified ToolShed.System.TimePure - --- | Measures the CPU-time required to find the specified number of /Carmichael/-numbers, which is returned together with the requested list. -carmichaelNumbersPerformance :: Math.Primality.Algorithmic primalityAlgorithm => primalityAlgorithm -> Int -> IO (Double, [Integer]) -carmichaelNumbersPerformance primalityAlgorithm i - | i < 0 = fail $ "Factory.Test.Performance.Primality.carmichaelNumbersPerformance:\tnegative number; " ++ show i - | otherwise = ToolShed.System.TimePure.getCPUSeconds . take i $ Math.Primality.carmichaelNumbers primalityAlgorithm - --- | Measures the CPU-time required to determine whether the specified integer is prime, which is returned together with the Boolean result. -isPrimePerformance :: (Control.DeepSeq.NFData i, Integral i, Show i) => Math.Primality.Algorithmic primalityAlgorithm => primalityAlgorithm -> i -> IO (Double, Bool) -isPrimePerformance primalityAlgorithm = ToolShed.System.TimePure.getCPUSeconds . Math.Primality.isPrime primalityAlgorithm - -{- | - * Measures the CPU-time required to determine whether /prime-indexed Fibonacci-numbers/ are actually /prime/. - - * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. --} -isPrimePerformanceGraph :: Math.Primality.Algorithmic primalityAlgorithm => primalityAlgorithm -> IO () -isPrimePerformanceGraph primalityAlgorithm = mapM_ ( - \operand -> isPrimePerformance primalityAlgorithm operand >>= putStrLn . shows operand . showChar '\t' . (`shows` "") - ) (Math.Fibonacci.primeIndexedFibonacci :: [Integer]) - diff --git a/src/Factory/Test/Performance/PrimeFactorisation.hs b/src/Factory/Test/Performance/PrimeFactorisation.hs deleted file mode 100644 --- a/src/Factory/Test/Performance/PrimeFactorisation.hs +++ /dev/null @@ -1,50 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Times the methods exported by module "Math.PrimeFactorisation". --} - -module Factory.Test.Performance.PrimeFactorisation( --- * Functions - primeFactorsPerformance, - primeFactorsPerformanceGraph -) where - -import qualified Factory.Data.PrimeFactors as Data.PrimeFactors -import qualified Factory.Math.Fibonacci as Math.Fibonacci -import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation -import qualified ToolShed.System.TimePure - --- | Measures the CPU-time required to prime-factorise the specified integer, which is returned together with the resulting list of factors. -primeFactorsPerformance :: Math.PrimeFactorisation.Algorithmic algorithm => algorithm -> Integer -> IO (Double, Data.PrimeFactors.Factors Integer Int) -primeFactorsPerformance algorithm = ToolShed.System.TimePure.getCPUSeconds . Math.PrimeFactorisation.primeFactors algorithm - -{- | - * Measure the CPU-time required by 'Math.PrimeFactorisation.primeFactors', - arbitrarily against the /Fibonacci/-numbers (which seemed to fit the requirements). - - * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. --} -primeFactorsPerformanceGraph :: Math.PrimeFactorisation.Algorithmic algorithm => algorithm -> Int -> IO () -primeFactorsPerformanceGraph algorithm tests - | tests < 0 = fail $ "Factory.Test.Performance.PrimeFactorisation.primeFactorsPerformanceGraph:\tnegative number; " ++ show tests - | otherwise = mapM_ ( - \operand -> primeFactorsPerformance algorithm operand >>= putStrLn . shows operand . showChar '\t' . (`shows` "") - ) . take tests . dropWhile (< 2) $ Math.Fibonacci.fibonacci - diff --git a/src/Factory/Test/Performance/Primes.hs b/src/Factory/Test/Performance/Primes.hs deleted file mode 100644 --- a/src/Factory/Test/Performance/Primes.hs +++ /dev/null @@ -1,47 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Measures the CPU-time required by "Math.Primes.primes". --} - -module Factory.Test.Performance.Primes( --- * Functions - primesPerformance, - mersenneNumbersPerformance -) where - -import qualified Control.DeepSeq -import qualified Data.Array.IArray -import qualified Factory.Math.Primes as Math.Primes -import qualified ToolShed.System.TimePure - --- | Measures the CPU-time required by 'Math.Primes.primes', to find the specified prime. -primesPerformance :: ( - Control.DeepSeq.NFData i, - Data.Array.IArray.Ix i, - Math.Primes.Algorithmic algorithm, - Integral i - ) => algorithm -> Int -> IO (Double, i) -primesPerformance algorithm = ToolShed.System.TimePure.getCPUSeconds . (Math.Primes.primes algorithm !!) - --- | Measures the CPU-time required to find the specified number of /Mersenne/-numbers, which is returned together with the requested list. -mersenneNumbersPerformance :: Math.Primes.Algorithmic algorithm => algorithm -> Int -> IO (Double, [Integer]) -mersenneNumbersPerformance primalityAlgorithm i - | i < 0 = fail $ "Factory.Test.Performance.Primes.mersenneNumbersPerformance:\tnegative number; " ++ show i - | otherwise = ToolShed.System.TimePure.getCPUSeconds . take i $ Math.Primes.mersenneNumbers primalityAlgorithm diff --git a/src/Factory/Test/Performance/SquareRoot.hs b/src/Factory/Test/Performance/SquareRoot.hs deleted file mode 100644 --- a/src/Factory/Test/Performance/SquareRoot.hs +++ /dev/null @@ -1,59 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Measures the CPU-time required by the methods exported from module "Math.SquareRoot". --} - -module Factory.Test.Performance.SquareRoot( --- * Functions - squareRootPerformance, - squareRootPerformanceGraph -) where - -import qualified Control.Arrow -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.SquareRoot as Math.SquareRoot -import qualified ToolShed.System.TimePure - --- | Measures the CPU-time required by 'Math.SquareRoot.squareRootFrom', which is returned together with the approximate rational result. -squareRootPerformance :: ( - Math.SquareRoot.Algorithmic algorithm, - Real operand, - Show operand - ) => algorithm -> operand -> Math.Precision.DecimalDigits -> IO (Double, Math.SquareRoot.Result) -squareRootPerformance algorithm operand requiredDecimalDigits = ToolShed.System.TimePure.getCPUSeconds $ Math.SquareRoot.squareRoot algorithm requiredDecimalDigits operand - -{- | - * Measures the CPU-time required by 'Math.SquareRoot.squareRootFrom', and the resulting accuracy, - using the specified algorithm, to an exponentially increasing precision-requirement. - - * CAVEAT: nothing is returned, since the result is printed ... and it never terminates. --} -squareRootPerformanceGraph :: ( - Math.SquareRoot.Algorithmic algorithm, - Math.SquareRoot.Iterator algorithm, - Real operand, - Show algorithm, - Show operand - ) => algorithm -> operand -> IO () -squareRootPerformanceGraph algorithm operand = mapM_ ( - \requiredDecimalDigits -> putStrLn . ( - \(cpuSeconds, actualDecimalDigits) -> shows algorithm . showChar '\t' . shows requiredDecimalDigits . showChar '\t' . shows actualDecimalDigits . showChar '\t' $ shows cpuSeconds "" - ) . Control.Arrow.second (Math.SquareRoot.getAccuracy operand) =<< squareRootPerformance algorithm operand requiredDecimalDigits - ) $ iterate (* max 2 (Math.SquareRoot.convergenceOrder algorithm)) 16 diff --git a/src/Factory/Test/Performance/Statistics.hs b/src/Factory/Test/Performance/Statistics.hs deleted file mode 100644 --- a/src/Factory/Test/Performance/Statistics.hs +++ /dev/null @@ -1,45 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Times the functions exported from module "Math.Statistics". --} - -module Factory.Test.Performance.Statistics( --- * Functions - nCrPerformance -) where - -import qualified Control.DeepSeq -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Statistics as Math.Statistics -import qualified ToolShed.System.TimePure - --- | Measures the CPU-time required by 'Math.Statistics.nCr'. -nCrPerformance :: ( - Control.DeepSeq.NFData i, - Integral i, - Math.Factorial.Algorithmic factorialAlgorithm, - Show i - ) - => factorialAlgorithm - -> i -- ^ The total number from which to select. - -> i -- ^ The number of items in a sample. - -> IO (Double, i) -nCrPerformance factorialAlgorithm n r = ToolShed.System.TimePure.getCPUSeconds $ Math.Statistics.nCr factorialAlgorithm n r - diff --git a/src/Factory/Test/QuickCheck/ArithmeticGeometricMean.hs b/src/Factory/Test/QuickCheck/ArithmeticGeometricMean.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/ArithmeticGeometricMean.hs +++ /dev/null @@ -1,57 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.ArithmeticGeometricMean". --} - -module Factory.Test.QuickCheck.ArithmeticGeometricMean( --- * Types --- ** Type-synonyms --- Testable, --- * Functions - quickChecks -) where - -import qualified Data.Tuple -import qualified Factory.Math.ArithmeticGeometricMean as Math.ArithmeticGeometricMean -import qualified Factory.Math.Implementations.SquareRoot as Math.Implementations.SquareRoot -import qualified Factory.Math.Precision as Math.Precision -import Factory.Test.QuickCheck.SquareRoot() -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - -type Testable = Math.Implementations.SquareRoot.Algorithm -> Math.Precision.DecimalDigits -> Math.ArithmeticGeometricMean.AGM -> Int -> Test.QuickCheck.Property - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck `mapM_` [prop_symmetrical, prop_bounds] where - prop_symmetrical, prop_bounds :: Testable - prop_symmetrical squareRootAlgorithm decimalDigits agm index = Math.ArithmeticGeometricMean.isValid agm ==> Test.QuickCheck.label "prop_symmetrical" . and . tail . take index' $ zipWith (==) ( - Math.ArithmeticGeometricMean.convergeToAGM squareRootAlgorithm decimalDigits' agm - ) ( - Math.ArithmeticGeometricMean.convergeToAGM squareRootAlgorithm decimalDigits' $ Data.Tuple.swap agm - ) where - decimalDigits' = succ $ decimalDigits `mod` 64 - index' = succ $ index `mod` 8 - - prop_bounds squareRootAlgorithm decimalDigits agm index = all ($ agm) [Math.ArithmeticGeometricMean.isValid, uncurry (/=)] ==> Test.QuickCheck.label "prop_bounds" . all (uncurry (>=)) . tail . take index' $ Math.ArithmeticGeometricMean.convergeToAGM squareRootAlgorithm decimalDigits' agm - where - decimalDigits' = 33 {-test is sensitive to rounding-errors-} + (decimalDigits `mod` 96) - index' = succ $ index `mod` 5 - diff --git a/src/Factory/Test/QuickCheck/Factorial.hs b/src/Factory/Test/QuickCheck/Factorial.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Factorial.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Implementations.Factorial". --} - -module Factory.Test.QuickCheck.Factorial( --- * Types --- ** Type-synonyms --- Testable, --- * Functions - quickChecks -) where - -import Data.Ratio((%)) -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial -import Factory.Math.Implementations.Factorial((!/!)) -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - -instance Test.QuickCheck.Arbitrary Math.Implementations.Factorial.Algorithm where - arbitrary = Test.QuickCheck.elements [Math.Implementations.Factorial.Bisection, Math.Implementations.Factorial.PrimeFactorisation] - -type Testable = Integer -> Integer -> Test.QuickCheck.Property - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck `mapM_` [prop_equivalence, prop_symmetry, prop_x0, prop_0n] >> Test.QuickCheck.quickCheck prop_ratio >> Test.QuickCheck.quickCheck prop_consistency where - prop_equivalence, prop_symmetry, prop_x0, prop_0n :: Testable - prop_equivalence x n = Test.QuickCheck.label "prop_equivalence" $ Math.Implementations.Factorial.risingFactorial x n == sign * Math.Implementations.Factorial.fallingFactorial (negate x) n && Math.Implementations.Factorial.fallingFactorial x n == sign * Math.Implementations.Factorial.risingFactorial (negate x) n where - sign :: Integer - sign - | even n = 1 - | otherwise = negate 1 - - prop_symmetry x n = Test.QuickCheck.label "prop_symmetry" $ Math.Implementations.Factorial.risingFactorial x n == Math.Implementations.Factorial.fallingFactorial (pred $ x + n) n - - prop_x0 x _ = Test.QuickCheck.label "prop_x0" $ all (== 1) $ map ($ 0) [Math.Implementations.Factorial.risingFactorial x, Math.Implementations.Factorial.fallingFactorial x] - - prop_0n _ n = Test.QuickCheck.label "prop_0n" $ all (== if n == 0 then 1 else 0) $ map ($ n) [Math.Implementations.Factorial.risingFactorial 0, Math.Implementations.Factorial.fallingFactorial 0] - - prop_ratio :: Math.Implementations.Factorial.Algorithm -> Integer -> Integer -> Test.QuickCheck.Property - prop_ratio algorithm i j = Test.QuickCheck.label "prop_ratio" $ n !/! d == Math.Factorial.factorial algorithm n % Math.Factorial.factorial algorithm d where - n = pred $ i `mod` 100000 - d = pred $ j `mod` 100000 - - prop_consistency :: Math.Implementations.Factorial.Algorithm -> Math.Implementations.Factorial.Algorithm -> Integer -> Test.QuickCheck.Property - prop_consistency l r i = l /= r ==> Test.QuickCheck.label "prop_consistency" $ Math.Factorial.factorial l n == Math.Factorial.factorial r n where - n = pred $ i `mod` 100000 - diff --git a/src/Factory/Test/QuickCheck/Hyperoperation.hs b/src/Factory/Test/QuickCheck/Hyperoperation.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Hyperoperation.hs +++ /dev/null @@ -1,75 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Hyperoperation". --} - -module Factory.Test.QuickCheck.Hyperoperation( --- * Functions - quickChecks -) where - -import qualified Factory.Math.Hyperoperation as Math.Hyperoperation -import qualified Test.QuickCheck - -type Rank = Int - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = - Test.QuickCheck.quickCheck prop_rankCoincides - >> Test.QuickCheck.quickCheck prop_baseCoincides - >> Test.QuickCheck.quickCheck prop_hyperExponentCoincides - >> Test.QuickCheck.quickCheck `mapM_` [prop_succ, prop_addition, prop_multiplication, prop_exponentiation] where - prop_rankCoincides :: Rank -> Test.QuickCheck.Property - prop_rankCoincides rank = Test.QuickCheck.label "prop_rankCoincides" $ Math.Hyperoperation.hyperoperation rank' 2 2 == 4 where - rank' :: Rank - rank' = succ $ rank `mod` 1000 - - prop_baseCoincides :: Rank -> Integer -> Test.QuickCheck.Property - prop_baseCoincides rank base = Test.QuickCheck.label "prop_baseCoincides" $ Math.Hyperoperation.hyperoperation rank' base 1 == base where - rank' :: Rank - rank' = 2 + (rank `mod` 1000) - - prop_hyperExponentCoincides :: Rank -> Integer -> Test.QuickCheck.Property - prop_hyperExponentCoincides rank hyperExponent = Test.QuickCheck.label "prop_hyperExponentCoincides" $ Math.Hyperoperation.hyperoperation rank' 1 hyperExponent' == 1 where - rank' :: Rank - rank' = 3 + (rank `mod` 1000) - - hyperExponent' :: Math.Hyperoperation.HyperExponent - hyperExponent' = abs hyperExponent - - prop_succ, prop_addition, prop_multiplication, prop_exponentiation :: Integer -> Integer -> Test.QuickCheck.Property - prop_succ base hyperExponent = Test.QuickCheck.label "prop_succ" $ Math.Hyperoperation.hyperoperation Math.Hyperoperation.succession base hyperExponent' == succ (fromIntegral hyperExponent') where - hyperExponent' :: Math.Hyperoperation.HyperExponent - hyperExponent' = abs hyperExponent - - prop_addition base hyperExponent = Test.QuickCheck.label "prop_addition" $ Math.Hyperoperation.hyperoperation Math.Hyperoperation.addition base hyperExponent' == base + fromIntegral hyperExponent' where - hyperExponent' :: Math.Hyperoperation.HyperExponent - hyperExponent' = abs hyperExponent - - prop_multiplication base hyperExponent = Test.QuickCheck.label "prop_multiplication" $ Math.Hyperoperation.hyperoperation Math.Hyperoperation.multiplication base hyperExponent' == base * fromIntegral hyperExponent' where - hyperExponent' :: Math.Hyperoperation.HyperExponent - hyperExponent' = abs hyperExponent - - prop_exponentiation base hyperExponent = Test.QuickCheck.label "prop_exponentiation" $ Math.Hyperoperation.hyperoperation Math.Hyperoperation.exponentiation base hyperExponent' == base ^ hyperExponent' where - hyperExponent' :: Math.Hyperoperation.HyperExponent - hyperExponent' = abs hyperExponent - - diff --git a/src/Factory/Test/QuickCheck/Interval.hs b/src/Factory/Test/QuickCheck/Interval.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Interval.hs +++ /dev/null @@ -1,43 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Data.Interval". --} - -module Factory.Test.QuickCheck.Interval( --- * Functions - quickChecks -) where - -import qualified Data.Ratio -import qualified Factory.Data.Interval as Data.Interval -import qualified Test.QuickCheck - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheckWith Test.QuickCheck.stdArgs {Test.QuickCheck.maxSuccess = 1000} prop_product where - prop_product :: Data.Ratio.Ratio Integer -> Integer -> Data.Interval.Interval Integer -> Test.QuickCheck.Property - prop_product ratio minLength interval = Test.QuickCheck.label "prop_product" $ Data.Interval.product' ratio' minLength' interval' == product (Data.Interval.toList interval') where - interval' = Data.Interval.normalise interval - minLength' = succ $ minLength `mod` 1000 - ratio' - | r > 1 = recip r - | otherwise = r - where - r = abs ratio diff --git a/src/Factory/Test/QuickCheck/MonicPolynomial.hs b/src/Factory/Test/QuickCheck/MonicPolynomial.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/MonicPolynomial.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Data.MonicPolynomial". --} - -module Factory.Test.QuickCheck.MonicPolynomial( --- * Types --- ** Type-synonyms --- P --- * Functions - quickChecks -) where - -import Factory.Data.Ring((=*=), (=+=), (=^)) -import Factory.Test.QuickCheck.Polynomial() -import qualified Factory.Data.MonicPolynomial as Data.MonicPolynomial -import qualified Factory.Data.Polynomial as Data.Polynomial -import qualified Factory.Data.QuotientRing as Data.QuotientRing -import qualified Factory.Data.Ring as Data.Ring -import qualified Test.QuickCheck - -instance ( - Integral c, - Integral e, - Test.QuickCheck.Arbitrary c, - Test.QuickCheck.Arbitrary e, - Show c, - Show e - ) => Test.QuickCheck.Arbitrary (Data.MonicPolynomial.MonicPolynomial c e) where - arbitrary = do - polynomial <- Test.QuickCheck.arbitrary - - return {-to Gen-monad-} . Data.MonicPolynomial.mkMonicPolynomial $ ((1, succ $ Data.Polynomial.getDegree polynomial) :) `Data.Polynomial.lift` polynomial - -type P = Data.MonicPolynomial.MonicPolynomial Integer Integer - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck `mapM_` [prop_quotRem, prop_quotientRingNormalised] >> Test.QuickCheck.quickCheck prop_perfectPower >> Test.QuickCheck.quickCheck prop_isDivisibleBy where - prop_quotRem, prop_quotientRingNormalised :: P -> P -> Test.QuickCheck.Property - prop_quotRem numerator denominator = Test.QuickCheck.label "prop_quotRem" $ numerator == denominator =*= quotient =+= remainder where - (quotient, remainder) = numerator `Data.QuotientRing.quotRem'` denominator - - prop_quotientRingNormalised numerator denominator = Test.QuickCheck.label "prop_quotientRingNormalised" $ all (Data.Polynomial.isNormalised . Data.MonicPolynomial.getPolynomial) [numerator `Data.QuotientRing.quot'` denominator, numerator `Data.QuotientRing.rem'` denominator] - - prop_perfectPower :: P -> Int -> Test.QuickCheck.Property - prop_perfectPower polynomial power = Test.QuickCheck.label "prop_perfectPower" $ iterate (`Data.QuotientRing.quot'` polynomial) (polynomial =^ power') !! pred power' == polynomial where - power' :: Int - power' = succ $ power `mod` 100 - - prop_isDivisibleBy :: [P] -> Test.QuickCheck.Property - prop_isDivisibleBy monicPolynomials = Test.QuickCheck.label "prop_isDivisibleBy" $ all (Data.QuotientRing.isDivisibleBy (Data.Ring.product' (recip 2) {-TODO-} 10 monicPolynomials)) monicPolynomials - - diff --git a/src/Factory/Test/QuickCheck/PerfectPower.hs b/src/Factory/Test/QuickCheck/PerfectPower.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/PerfectPower.hs +++ /dev/null @@ -1,54 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.PerfectPower". --} - -module Factory.Test.QuickCheck.PerfectPower( --- * Functions - quickChecks -) where - -import qualified Data.Maybe -import qualified Factory.Math.PerfectPower as Math.PerfectPower -import qualified Factory.Math.Power as Math.Power -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = - Test.QuickCheck.quickCheck `mapM_` [prop_maybeSquareNumber, prop_rewriteRule] - >> Test.QuickCheck.quickCheckWith Test.QuickCheck.stdArgs {Test.QuickCheck.maxSuccess = 10000} prop_notSquare - >> Test.QuickCheck.quickCheck prop_isPerfectPower - where - prop_maybeSquareNumber, prop_notSquare, prop_rewriteRule :: Integer -> Test.QuickCheck.Property - prop_maybeSquareNumber i = Test.QuickCheck.label "prop_maybeSquareNumber" $ Math.PerfectPower.maybeSquareNumber (Math.Power.square i) == Just (abs i) - - prop_notSquare i = abs i > 0 ==> Test.QuickCheck.label "prop_notSquare" . Data.Maybe.isNothing $ Math.PerfectPower.maybeSquareNumber (succ $ i ^ (10 {-promote rounding-error using big number-} :: Int)) - - prop_rewriteRule i = Test.QuickCheck.label "prop_rewriteRule" $ Math.PerfectPower.isPerfectPower i' == Math.PerfectPower.isPerfectPower (fromIntegral i' :: Int) where - i' = abs i - - prop_isPerfectPower :: Integer -> Integer -> Test.QuickCheck.Property - prop_isPerfectPower b e = Test.QuickCheck.label "prop_isPerfectPower" . Math.PerfectPower.isPerfectPower $ b' ^ e' where - b' = 2 + (b `mod` 10) - e' = 2 + (e `mod` 8) - - diff --git a/src/Factory/Test/QuickCheck/Pi.hs b/src/Factory/Test/QuickCheck/Pi.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Pi.hs +++ /dev/null @@ -1,114 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2011-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Pi". --} - -module Factory.Test.QuickCheck.Pi( --- * Types --- ** Type-synonyms --- Testable, --- * Functions - quickChecks -) where - -import Prelude hiding ((<*>)) -- The "Prelude" from 'base-4.8' exports this symbol. -import Control.Applicative((<$>), (<*>)) -import Factory.Test.QuickCheck.Factorial() -import Factory.Test.QuickCheck.SquareRoot() -import qualified Factory.Math.Factorial as Math.Factorial -import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial -import qualified Factory.Math.Implementations.Pi.AGM.Algorithm as Math.Implementations.Pi.AGM.Algorithm -import qualified Factory.Math.Implementations.Pi.BBP.Algorithm as Math.Implementations.Pi.BBP.Algorithm -import qualified Factory.Math.Implementations.Pi.Borwein.Algorithm as Math.Implementations.Pi.Borwein.Algorithm -import qualified Factory.Math.Implementations.Pi.Ramanujan.Algorithm as Math.Implementations.Pi.Ramanujan.Algorithm -import qualified Factory.Math.Implementations.Pi.Spigot.Algorithm as Math.Implementations.Pi.Spigot.Algorithm -import qualified Factory.Math.Implementations.SquareRoot as Math.Implementations.SquareRoot -import qualified Factory.Math.Pi as Math.Pi -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.SquareRoot as Math.SquareRoot -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - -instance ( - Test.QuickCheck.Arbitrary squareRootAlgorithm, - Math.SquareRoot.Algorithmic squareRootAlgorithm - ) => Test.QuickCheck.Arbitrary (Math.Implementations.Pi.AGM.Algorithm.Algorithm squareRootAlgorithm) where - arbitrary = Math.Implementations.Pi.AGM.Algorithm.BrentSalamin <$> Test.QuickCheck.arbitrary - -instance Test.QuickCheck.Arbitrary Math.Implementations.Pi.BBP.Algorithm.Algorithm where - arbitrary = Test.QuickCheck.elements [Math.Implementations.Pi.BBP.Algorithm.Bellard, Math.Implementations.Pi.BBP.Algorithm.Base65536] - -instance ( - Test.QuickCheck.Arbitrary squareRootAlgorithm, - Math.SquareRoot.Algorithmic squareRootAlgorithm, - Test.QuickCheck.Arbitrary factorialAlgorithm, - Math.Factorial.Algorithmic factorialAlgorithm - ) => Test.QuickCheck.Arbitrary (Math.Implementations.Pi.Borwein.Algorithm.Algorithm squareRootAlgorithm factorialAlgorithm) where - arbitrary = Test.QuickCheck.oneof [ - Math.Implementations.Pi.Borwein.Algorithm.Borwein1993 <$> Test.QuickCheck.arbitrary <*> Test.QuickCheck.arbitrary - ] - -instance ( - Test.QuickCheck.Arbitrary squareRootAlgorithm, - Math.SquareRoot.Algorithmic squareRootAlgorithm, - Test.QuickCheck.Arbitrary factorialAlgorithm, - Math.Factorial.Algorithmic factorialAlgorithm - ) => Test.QuickCheck.Arbitrary (Math.Implementations.Pi.Ramanujan.Algorithm.Algorithm squareRootAlgorithm factorialAlgorithm) where - arbitrary = Test.QuickCheck.oneof [ - Math.Implementations.Pi.Ramanujan.Algorithm.Classic <$> Test.QuickCheck.arbitrary <*> Test.QuickCheck.arbitrary, - Math.Implementations.Pi.Ramanujan.Algorithm.Chudnovsky <$> Test.QuickCheck.arbitrary <*> Test.QuickCheck.arbitrary - ] - -instance Test.QuickCheck.Arbitrary Math.Implementations.Pi.Spigot.Algorithm.Algorithm where - arbitrary = Test.QuickCheck.elements [Math.Implementations.Pi.Spigot.Algorithm.RabinowitzWagon, Math.Implementations.Pi.Spigot.Algorithm.Gosper] - -instance ( - Test.QuickCheck.Arbitrary agm, - Test.QuickCheck.Arbitrary bbp, - Test.QuickCheck.Arbitrary borwein, - Test.QuickCheck.Arbitrary ramanujan, - Test.QuickCheck.Arbitrary spigot - ) => Test.QuickCheck.Arbitrary (Math.Pi.Category agm bbp borwein ramanujan spigot) where - arbitrary = Test.QuickCheck.oneof [ - Math.Pi.AGM <$> Test.QuickCheck.arbitrary, - Math.Pi.BBP <$> Test.QuickCheck.arbitrary, - Math.Pi.Borwein <$> Test.QuickCheck.arbitrary, - Math.Pi.Ramanujan <$> Test.QuickCheck.arbitrary, - Math.Pi.Spigot <$> Test.QuickCheck.arbitrary - ] - -type Category = Math.Pi.Category ( - Math.Implementations.Pi.AGM.Algorithm.Algorithm Math.Implementations.SquareRoot.Algorithm - ) Math.Implementations.Pi.BBP.Algorithm.Algorithm ( - Math.Implementations.Pi.Borwein.Algorithm.Algorithm Math.Implementations.SquareRoot.Algorithm Math.Implementations.Factorial.Algorithm - ) ( - Math.Implementations.Pi.Ramanujan.Algorithm.Algorithm Math.Implementations.SquareRoot.Algorithm Math.Implementations.Factorial.Algorithm - ) Math.Implementations.Pi.Spigot.Algorithm.Algorithm - -type Testable = Category -> Category -> Math.Precision.DecimalDigits -> Test.QuickCheck.Property - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck prop_consistency where - prop_consistency :: Testable - prop_consistency l r decimalDigits = l /= r ==> Test.QuickCheck.label "prop_consistency" $ Math.Pi.openI l decimalDigits' - Math.Pi.openI r decimalDigits' <= 1 {-rounding error-} where - decimalDigits' = succ $ decimalDigits `mod` 250 - diff --git a/src/Factory/Test/QuickCheck/Polynomial.hs b/src/Factory/Test/QuickCheck/Polynomial.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Polynomial.hs +++ /dev/null @@ -1,116 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2011-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Data.Polynomial". --} - -module Factory.Test.QuickCheck.Polynomial( --- * Functions - quickChecks -) where - -import Control.Arrow((***)) -import Factory.Data.Ring((=*=), (=+=), (=-=), (=^)) -import qualified Data.Numbers.Primes -import qualified Factory.Data.Polynomial as Data.Polynomial -import qualified Factory.Data.QuotientRing as Data.QuotientRing -import qualified Factory.Data.Ring as Data.Ring -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - -instance ( - Test.QuickCheck.Arbitrary c, - Integral c, - Test.QuickCheck.Arbitrary e, - Integral e - ) => Test.QuickCheck.Arbitrary (Data.Polynomial.Polynomial c e) where - arbitrary = (Data.Polynomial.mkPolynomial . map ((+ negate 4) . (`mod` 8) *** (`mod` 8))) `fmap` Test.QuickCheck.arbitrary - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks - = Test.QuickCheck.quickCheck prop_congruence - >> Test.QuickCheck.quickCheck `mapM_` [prop_quotRem, prop_degree, prop_ringNormalised, prop_quotientRingNormalised] - >> Test.QuickCheck.quickCheck `mapM_` [prop_power, prop_perfectPower, prop_normalised] - >> Test.QuickCheck.quickCheck prop_raiseModuloNormalised - >> Test.QuickCheck.quickCheck `mapM_` [prop_integralDomain, prop_isDivisibleBy] - where - prop_congruence :: Int -> Test.QuickCheck.Property - prop_congruence i = Test.QuickCheck.label "prop_congruence" $ Data.Polynomial.areCongruentModulo (Data.Polynomial.mkLinear 1 (negate 1) =^ prime) (Data.Polynomial.mkPolynomial [(1, prime), (negate 1, 0)]) prime where - prime :: Integer - prime = Data.Numbers.Primes.primes !! mod i 100 - - prop_quotRem, prop_degree, prop_ringNormalised, prop_quotientRingNormalised :: Data.Polynomial.Polynomial Integer Integer -> Data.Polynomial.Polynomial Integer Integer -> Test.QuickCheck.Property - prop_quotRem numerator denominator = denominator' /= Data.Polynomial.zero ==> Test.QuickCheck.label "prop_quotRem" $ numerator' == denominator' =*= quotient =+= remainder where - numerator', denominator' :: Data.Polynomial.Polynomial Rational Integer - numerator' = Data.Polynomial.realCoefficientsToFrac numerator - denominator' = Data.Polynomial.realCoefficientsToFrac denominator - - (quotient, remainder) = numerator' `Data.QuotientRing.quotRem'` denominator' - - prop_degree numerator denominator = denominator' /= Data.Polynomial.zero ==> Test.QuickCheck.label "prop_degree" $ remainder == Data.Polynomial.zero || Data.Polynomial.getDegree remainder < Data.Polynomial.getDegree denominator' where - numerator', denominator' :: Data.Polynomial.Polynomial Rational Integer - numerator' = Data.Polynomial.realCoefficientsToFrac numerator - denominator' = Data.Polynomial.realCoefficientsToFrac denominator - - remainder = numerator' `Data.QuotientRing.rem'` denominator' - - prop_ringNormalised l r = Test.QuickCheck.label "prop_ringNormalised" $ all Data.Polynomial.isNormalised [l =*= r, l =+= r, l =-= r] - - prop_quotientRingNormalised numerator denominator = denominator' /= Data.Polynomial.zero ==> Test.QuickCheck.label "prop_quotientRingNormalised" $ all Data.Polynomial.isNormalised [numerator' `Data.QuotientRing.quot'` denominator', numerator' `Data.QuotientRing.rem'` denominator'] where - numerator', denominator' :: Data.Polynomial.Polynomial Rational Integer - numerator' = Data.Polynomial.realCoefficientsToFrac numerator - denominator' = Data.Polynomial.realCoefficientsToFrac denominator - - prop_power, prop_perfectPower, prop_normalised :: Data.Polynomial.Polynomial Integer Integer -> Int -> Test.QuickCheck.Property - prop_power polynomial power = Test.QuickCheck.label "prop_power" $ polynomial =^ power' == iterate (=*= polynomial) polynomial !! pred power' where - power' :: Int - power' = succ $ power `mod` 100 - - prop_perfectPower polynomial power = polynomial' /= Data.Polynomial.zero ==> Test.QuickCheck.label "prop_perfectPower" $ iterate (`Data.QuotientRing.quot'` polynomial') (polynomial' =^ power') !! pred power' == polynomial' where - polynomial' :: Data.Polynomial.Polynomial Rational Integer - polynomial' = Data.Polynomial.realCoefficientsToFrac polynomial - - power' :: Int - power' = succ $ power `mod` 100 - - prop_normalised polynomial i = Test.QuickCheck.label "prop_normalised" $ all Data.Polynomial.isNormalised [ - polynomial =^ power', - polynomial `Data.Polynomial.mod'` modulus' - ] where - power' :: Int - power' = succ $ i `mod` 100 - - modulus' :: Integer - modulus' = succ $ fromIntegral i `mod` 100 - - prop_raiseModuloNormalised :: Data.Polynomial.Polynomial Integer Integer -> Integer -> Integer -> Test.QuickCheck.Property - prop_raiseModuloNormalised polynomial power modulus = Test.QuickCheck.label "prop_raiseModuloNormalised" . Data.Polynomial.isNormalised $ Data.Polynomial.raiseModulo polynomial power' modulus' where - power', modulus' :: Integer - power' = succ $ power `mod` 100 - modulus' = succ $ modulus `mod` 100 - - prop_integralDomain, prop_isDivisibleBy :: [Data.Polynomial.Polynomial Integer Integer] -> Test.QuickCheck.Property - prop_integralDomain polynomials = Data.Polynomial.zero `notElem` polynomials ==> Test.QuickCheck.label "prop_integralDomain" $ Data.Ring.product' (recip 2) {-TODO-} 10 polynomials /= Data.Polynomial.zero - - prop_isDivisibleBy polynomials = Test.QuickCheck.label "prop_isDivisibleBy" . all (Data.QuotientRing.isDivisibleBy (Data.Ring.product' (recip 2) {-TODO-} 10 polynomials')) $ filter (/= Data.Polynomial.zero) polynomials' where - polynomials' :: [Data.Polynomial.Polynomial Rational Integer] - polynomials' = map Data.Polynomial.realCoefficientsToFrac polynomials - diff --git a/src/Factory/Test/QuickCheck/Power.hs b/src/Factory/Test/QuickCheck/Power.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Power.hs +++ /dev/null @@ -1,45 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties "Math.Power". --} - -module Factory.Test.QuickCheck.Power( --- * Functions - quickChecks -) where - -import qualified Data.List -import qualified Factory.Math.Power as Math.Power -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck prop_squaresFrom >> Test.QuickCheck.quickCheck prop_raiseModulo - where - prop_squaresFrom :: Integer -> Integer -> Test.QuickCheck.Property - prop_squaresFrom from l = Test.QuickCheck.label "prop_squaresFrom" . (\(x, y) -> y == Math.Power.square x) . Data.List.genericIndex (Math.Power.squaresFrom from) $ abs l - - prop_raiseModulo :: Integer -> Integer -> Integer -> Test.QuickCheck.Property - prop_raiseModulo b e m = m /= 0 ==> Test.QuickCheck.label "prop_raiseModulo" $ Math.Power.raiseModulo b e' m == (b ^ e') `mod` m where - e' :: Integer - e' = abs e - - diff --git a/src/Factory/Test/QuickCheck/Primality.hs b/src/Factory/Test/QuickCheck/Primality.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Primality.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2011-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Math.Implementations.Primality". --} - -module Factory.Test.QuickCheck.Primality( --- * Functions - quickChecks -) where - -import Factory.Test.QuickCheck.PrimeFactorisation() -import qualified Data.List -import qualified Data.Numbers.Primes -import qualified Factory.Math.Implementations.Primality as Math.Implementations.Primality -import qualified Factory.Math.Implementations.PrimeFactorisation as Math.Implementations.PrimeFactorisation -import qualified Factory.Math.Primality as Math.Primality -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - -instance Test.QuickCheck.Arbitrary factorisationAlgorithm => Test.QuickCheck.Arbitrary (Math.Implementations.Primality.Algorithm factorisationAlgorithm) where - arbitrary = Test.QuickCheck.oneof [ - Math.Implementations.Primality.AKS `fmap` Test.QuickCheck.arbitrary, - return {-to Gen-monad-} Math.Implementations.Primality.MillerRabin - ] - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks - = Test.QuickCheck.quickCheck prop_prime - >> Test.QuickCheck.quickCheck prop_composite - >> Test.QuickCheck.quickCheck prop_consistency - where - prop_prime :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm -> Integer -> Test.QuickCheck.Property - prop_prime primalityAlgorithm i = Test.QuickCheck.label "prop_prime" $ Math.Primality.isPrime primalityAlgorithm prime where - normalise n - | primalityAlgorithm == Math.Implementations.Primality.MillerRabin = n `mod` 1000000 -- Limited by the efficiency of 'Data.Numbers.Primes.primes'. - | otherwise = n `mod` 59 - - prime :: Integer - prime = Data.List.genericIndex Data.Numbers.Primes.primes $ normalise i - - prop_composite :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm -> [Integer] -> Test.QuickCheck.Property - prop_composite primalityAlgorithm l = length l > 1 ==> Test.QuickCheck.label "prop_composite" . not $ Math.Primality.isPrime primalityAlgorithm composite where - normalise n - | primalityAlgorithm == Math.Implementations.Primality.MillerRabin = n `mod` 1000000 - | otherwise = n `mod` 10 - - composite :: Integer - composite = product . map (Data.List.genericIndex Data.Numbers.Primes.primes . normalise) $ take 8 l - - prop_consistency :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm -> Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm -> Integer -> Test.QuickCheck.Property - prop_consistency l r i = l /= r ==> Test.QuickCheck.label "prop_consistency" $ Math.Primality.isPrime l i' == Math.Primality.isPrime r i' where - i' = i `mod` 512 - diff --git a/src/Factory/Test/QuickCheck/PrimeFactorisation.hs b/src/Factory/Test/QuickCheck/PrimeFactorisation.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/PrimeFactorisation.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Math.PrimeFactorisation". --} - -module Factory.Test.QuickCheck.PrimeFactorisation( --- * Functions - quickChecks -) where - -import qualified Data.List -import qualified Data.Numbers.Primes -import qualified Factory.Data.PrimeFactors as Data.PrimeFactors -import qualified Factory.Data.Exponential as Data.Exponential -import qualified Factory.Math.Implementations.PrimeFactorisation as Math.Implementations.PrimeFactorisation -import qualified Factory.Math.MultiplicativeOrder as Math.MultiplicativeOrder -import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - -instance Test.QuickCheck.Arbitrary Math.Implementations.PrimeFactorisation.Algorithm where - arbitrary = Test.QuickCheck.oneof [ - Test.QuickCheck.elements [ - Math.Implementations.PrimeFactorisation.TrialDivision, - Math.Implementations.PrimeFactorisation.FermatsMethod - ] - ] - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = - Test.QuickCheck.quickCheck prop_consistency - >> Test.QuickCheck.quickCheck `mapM_` [prop_primeFactors, prop_smoothness, prop_eulersTotientP, prop_eulersTotientInequality] - >> Test.QuickCheck.quickCheck `mapM_` [prop_eulersTotient, prop_lagrange, prop_multiplicativeOrder, prop_perfectPower] - where - prop_consistency :: Integer -> Test.QuickCheck.Property - prop_consistency i = Test.QuickCheck.label "prop_consistency" $ (Math.PrimeFactorisation.primeFactors Math.Implementations.PrimeFactorisation.TrialDivision i' :: Data.PrimeFactors.Factors Integer Int) == Math.PrimeFactorisation.primeFactors Math.Implementations.PrimeFactorisation.FermatsMethod i' where - i' :: Integer - i' = succ $ i `mod` 1000000 - - prop_primeFactors, prop_smoothness, prop_eulersTotientP, prop_eulersTotientInequality :: Math.Implementations.PrimeFactorisation.Algorithm -> Integer -> Test.QuickCheck.Property - prop_primeFactors algorithm i = Test.QuickCheck.label "prop_primeFactors" $ Data.PrimeFactors.product' (recip 2) {-TODO-} 10 (Math.PrimeFactorisation.primeFactors algorithm i') == i' where - i' :: Integer - i' = succ $ i `mod` 1000000 - - prop_smoothness algorithm i = Test.QuickCheck.label "prop_smoothness" $ (Math.PrimeFactorisation.smoothness algorithm !! (2 ^ i')) <= (2 :: Integer) where - i' :: Integer - i' = i `mod` 20 - - prop_eulersTotientP algorithm i = Test.QuickCheck.label "prop_eulersTotientP" $ Math.PrimeFactorisation.eulersTotient algorithm prime == pred prime where - prime :: Integer - prime = Data.List.genericIndex Data.Numbers.Primes.primes (i `mod` 10000) - - prop_eulersTotientInequality algorithm i = i `notElem` [2, 6] ==> Test.QuickCheck.label "prop_eulersTotientInequality" $ Math.PrimeFactorisation.eulersTotient algorithm i' >= floor (sqrt $ fromIntegral i' :: Double) where - i' = succ $ i `mod` 100000 - - prop_eulersTotient, prop_lagrange, prop_multiplicativeOrder, prop_perfectPower :: Math.Implementations.PrimeFactorisation.Algorithm -> Integer -> Integer -> Test.QuickCheck.Property - prop_eulersTotient algorithm i power = Test.QuickCheck.label "prop_eulersTotient" $ Math.PrimeFactorisation.eulersTotient algorithm (base ^ power') == (base ^ pred power') * pred base where - base :: Integer - base = Data.List.genericIndex Data.Numbers.Primes.primes (i `mod` 8) - - power' = succ $ power `mod` 5 - - prop_lagrange algorithm base modulus = gcd base modulus' == 1 ==> Test.QuickCheck.label "prop_lagrange" $ (Math.PrimeFactorisation.eulersTotient algorithm modulus' `rem` Math.MultiplicativeOrder.multiplicativeOrder algorithm base modulus') == 0 where - modulus' :: Integer - modulus' = 2 + abs modulus - - prop_multiplicativeOrder algorithm base modulus = gcd base modulus' == 1 ==> Test.QuickCheck.label "prop_multiplicativeOrder" $ ( - base ^ Math.MultiplicativeOrder.multiplicativeOrder algorithm base modulus' - ) `mod` modulus' == 1 where - modulus' :: Integer - modulus' = 2 + abs modulus - - prop_perfectPower algorithm b e = Test.QuickCheck.label "prop_perfectPower" $ foldr1 gcd ( - map Data.Exponential.getExponent . Math.PrimeFactorisation.primeFactors algorithm $ (2 + b `mod` 10 :: Integer) ^ (2 + e `mod` 5) - ) > 1 diff --git a/src/Factory/Test/QuickCheck/Primes.hs b/src/Factory/Test/QuickCheck/Primes.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Primes.hs +++ /dev/null @@ -1,99 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2011-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Math.Implementations.Primes". --} - -module Factory.Test.QuickCheck.Primes( --- * Constants --- defaultAlgorithm, --- * Functions - quickChecks, --- isPrime, - upperBound -) where - -import qualified Control.DeepSeq -import qualified Data.Set -import qualified Factory.Data.PrimeWheel as Data.PrimeWheel -import qualified Factory.Math.Implementations.Primality as Math.Implementations.Primality -import qualified Factory.Math.Implementations.PrimeFactorisation as Math.Implementations.PrimeFactorisation -import qualified Factory.Math.Implementations.Primes.Algorithm as Math.Implementations.Primes.Algorithm -import qualified Factory.Math.Primality as Math.Primality -import qualified Factory.Math.Primes as Math.Primes -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) -import qualified ToolShed.Defaultable - -instance Test.QuickCheck.Arbitrary Math.Implementations.Primes.Algorithm.Algorithm where - arbitrary = Test.QuickCheck.oneof [ - return {-to Gen-monad-} Math.Implementations.Primes.Algorithm.TurnersSieve, - (Math.Implementations.Primes.Algorithm.TrialDivision . (`mod` 10)) `fmap` Test.QuickCheck.arbitrary, - (Math.Implementations.Primes.Algorithm.SieveOfEratosthenes . (`mod` 10)) `fmap` Test.QuickCheck.arbitrary - ] - -isPrime :: (Control.DeepSeq.NFData i, Integral i, Show i) => i -> Bool -isPrime = Math.Primality.isPrime primalityAlgorithm where - primalityAlgorithm :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm - primalityAlgorithm = ToolShed.Defaultable.defaultValue - -upperBound :: Math.Implementations.Primes.Algorithm.Algorithm -> Int -> Int -upperBound algorithm i = mod i $ if algorithm == Math.Implementations.Primes.Algorithm.TurnersSieve - then 8192 - else 65536 - -defaultAlgorithm :: Math.Implementations.Primes.Algorithm.Algorithm -defaultAlgorithm = ToolShed.Defaultable.defaultValue - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = - Test.QuickCheck.quickCheck `mapM_` [prop_isPrime, prop_isComposite] - >> Test.QuickCheck.quickCheck prop_consistency - >> Test.QuickCheck.quickCheck prop_rewriteRule - >> Test.QuickCheck.quickCheck `mapM_` [prop_sieveOfAtkin, prop_sieveOfAtkinRewrite] - where - prop_isPrime, prop_isComposite :: Math.Implementations.Primes.Algorithm.Algorithm -> Int -> Test.QuickCheck.Property - prop_isPrime algorithm i = Test.QuickCheck.label "prop_isPrime" . all isPrime . takeWhile (<= upperBound algorithm i) $ (Math.Primes.primes algorithm :: [Int]) - prop_isComposite algorithm i = Test.QuickCheck.label "prop_isComposite" . not . any isPrime . Data.Set.toList . Data.Set.difference ( - Data.Set.fromList [2 .. upperBound algorithm i] - ) . Data.Set.fromList . takeWhile (<= upperBound algorithm i) $ Math.Primes.primes algorithm - - prop_consistency :: Math.Implementations.Primes.Algorithm.Algorithm -> Math.Implementations.Primes.Algorithm.Algorithm -> Int -> Test.QuickCheck.Property - prop_consistency l r i = l /= r ==> Test.QuickCheck.label "prop_consistency" . and . take (i `mod` 4096) $ zipWith (==) (Math.Primes.primes l) (Math.Primes.primes r :: [Int]) - - prop_rewriteRule :: Data.PrimeWheel.NPrimes -> Int -> Test.QuickCheck.Property - prop_rewriteRule wheelSize i = Test.QuickCheck.label "prop_rewriteRule" $ toInteger (Math.Primes.primes (Math.Implementations.Primes.Algorithm.SieveOfEratosthenes wheelSize') !! index :: Int) == (Math.Primes.primes (Math.Implementations.Primes.Algorithm.SieveOfEratosthenes wheelSize') !! index :: Integer) where - wheelSize' = wheelSize `mod` 8 - index = i `mod` 131072 - - prop_sieveOfAtkin, prop_sieveOfAtkinRewrite :: Int -> Test.QuickCheck.Property - prop_sieveOfAtkin i = Test.QuickCheck.label "prop_sieveOfAtkin" $ Math.Primes.primes (Math.Implementations.Primes.Algorithm.SieveOfAtkin prime) !! index == prime where - index = i `mod` 131072 - - prime :: Integer - prime = Math.Primes.primes defaultAlgorithm !! index - - prop_sieveOfAtkinRewrite i = Test.QuickCheck.label "prop_sieveOfAtkin'" $ Math.Primes.primes (Math.Implementations.Primes.Algorithm.SieveOfAtkin $ fromIntegral prime) !! index == prime where - index = i `mod` 131072 - - prime :: Int - prime = Math.Primes.primes defaultAlgorithm !! index - diff --git a/src/Factory/Test/QuickCheck/Probability.hs b/src/Factory/Test/QuickCheck/Probability.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Probability.hs +++ /dev/null @@ -1,160 +0,0 @@ -{- - Copyright (C) 2011-2013 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Probability". --} - -module Factory.Test.QuickCheck.Probability( --- * Functions --- normalise, - quickChecks -) where - -import Control.Arrow((&&&)) -import qualified Data.List -import qualified Factory.Math.Probability as Math.Probability -import qualified Factory.Math.Statistics as Math.Statistics -import Factory.Test.QuickCheck.Factorial() -import qualified System.Random -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) -import qualified ToolShed.Data.Pair - --- | Re-profile a distribution to achieve a standard mean & variance. -normalise :: ( - Eq f, - Floating f, - Math.Probability.Distribution distribution - ) => distribution -> [f] -> [f] -normalise distribution - | variance == 0 = error "Factory.Test.Quick.Probability.normalise:\tzero variance => can't stretch to one." - | otherwise = map $ (/ sqrt variance) . (+ negate mean) - where - (mean, variance) = Math.Probability.getMean &&& Math.Probability.getVariance $ distribution - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = do - randomGen <- System.Random.getStdGen - - Test.QuickCheck.quickCheck (prop_logNormalDistributionEqual randomGen) >> (Test.QuickCheck.quickCheck . ($ randomGen)) `mapM_` [ - prop_logNormalDistribution, - prop_logNormalDistribution', - prop_normalDistribution, - prop_uniformDistribution - ] >> (Test.QuickCheck.quickCheck . ($ randomGen)) `mapM_` [ - prop_exponentialDistribution, - prop_exponentialDistribution', - prop_poissonDistribution, - prop_poissonDistribution', - prop_shiftedGeometricDistribution, - prop_shiftedGeometricDistribution' - ] - where - isWithinTolerance :: Double -> Double -> Bool - isWithinTolerance i = (< recip i) . abs - - prop_logNormalDistribution, prop_logNormalDistribution', prop_normalDistribution, prop_uniformDistribution :: System.Random.RandomGen randomGen => randomGen -> Double -> Double -> Test.QuickCheck.Property - prop_logNormalDistribution randomGen location scale2 = scale2 /= 0 ==> Test.QuickCheck.label "prop_logNormalDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 1) . ( - Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. - ) . ( - normalise distribution :: [Double] -> [Double] - ) . take 10000 $ Math.Probability.generatePopulation distribution randomGen where - maxParameter = log . fromInteger $ Math.Probability.maxPreciseInteger (undefined :: Double) - location' - | location >= 0 = maxParameter `min` location - | otherwise = negate maxParameter `max` location - - distribution = Math.Probability.LogNormalDistribution location' . min maxParameter $ abs scale2 - - prop_logNormalDistribution' randomGen location scale2 = scale2 /= 0 ==> Test.QuickCheck.label "prop_logNormalDistribution'" . all ( - >= (0 :: Double) - ) . take 10 $ Math.Probability.generatePopulation (Math.Probability.LogNormalDistribution location' . min maxParameter $ abs scale2) randomGen where - maxParameter = log . fromInteger $ Math.Probability.maxPreciseInteger (undefined :: Double) - - location' - | location >= 0 = maxParameter `min` location - | otherwise = negate maxParameter `max` location - --- The mean & standard-deviation are equal when scale^2 == ln 2, but this seems to break-down when the mean is close to zero. - prop_logNormalDistributionEqual :: System.Random.RandomGen randomGen => randomGen -> Double -> Test.QuickCheck.Property - prop_logNormalDistributionEqual randomGen location = location' > 1 ==> Test.QuickCheck.label "prop_logNormalDistributionEqual" . ( - < (recip 1000000 :: Double) - ) . pred . abs . uncurry (/) . ( - Math.Statistics.getMean &&& Math.Statistics.getStandardDeviation - ) $ take 10000 ( - Math.Probability.generatePopulation (Math.Probability.LogNormalDistribution location' $ log 2) randomGen :: [Double] - ) where - maxParameter = log . fromInteger $ Math.Probability.maxPreciseInteger (undefined :: Double) - - location' - | location >= 0 = maxParameter `min` location - | otherwise = negate maxParameter `max` location - - prop_normalDistribution randomGen mean variance = variance /= 0 ==> Test.QuickCheck.label "prop_normalDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( - Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. - ) . ( - normalise distribution :: [Double] -> [Double] - ) . take 1000 $ Math.Probability.generatePopulation distribution randomGen where - distribution = Math.Probability.NormalDistribution mean $ abs variance - - prop_uniformDistribution randomGen min' max' = min' /= max' ==> Test.QuickCheck.label "prop_uniformDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( - Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. - ) . ( - normalise distribution :: [Double] -> [Double] - ) . take 10000 $ Math.Probability.generatePopulation distribution randomGen where - [min'', max''] = Data.List.sort [min', max'] - distribution = Math.Probability.UniformDistribution (min'', max'') - - prop_exponentialDistribution, prop_exponentialDistribution', prop_poissonDistribution, prop_poissonDistribution', prop_shiftedGeometricDistribution, prop_shiftedGeometricDistribution' :: System.Random.RandomGen randomGen => randomGen -> Double -> Test.QuickCheck.Property - prop_exponentialDistribution randomGen lambda = Test.QuickCheck.label "prop_exponentialDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( - Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. - ) . ( - normalise distribution :: [Double] -> [Double] - ) . take 10000 $ Math.Probability.generatePopulation distribution randomGen where - distribution = Math.Probability.ExponentialDistribution . succ {-exclude zero-} $ abs lambda `max` 10 {-cap-} - - prop_exponentialDistribution' randomGen lambda = lambda /= 0 ==> Test.QuickCheck.label "prop_exponentialDistribution'" . all ( - >= (0 :: Double) - ) . take 10 $ Math.Probability.generatePopulation (Math.Probability.ExponentialDistribution $ abs lambda) randomGen - - prop_poissonDistribution randomGen lambda = Test.QuickCheck.label "prop_poissonDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( - Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. - ) . ( - normalise distribution :: [Double] -> [Double] - ) . take 1000 $ Math.Probability.generatePopulation distribution randomGen where - distribution = Math.Probability.PoissonDistribution . succ {-exclude zero-} $ abs lambda `max` 10 {-cap-} - - prop_poissonDistribution' randomGen lambda = lambda /= 0 ==> Test.QuickCheck.label "prop_poissonDistribution'" . all ( - >= (0 :: Double) - ) . take 10 $ Math.Probability.generatePopulation (Math.Probability.PoissonDistribution $ abs lambda) randomGen - - prop_shiftedGeometricDistribution randomGen probability = probability' /= 1 ==> Test.QuickCheck.label "prop_shiftedGeometricDistribution" . uncurry (&&) . ToolShed.Data.Pair.mirror (isWithinTolerance 10) . ( - Math.Statistics.getMean &&& pred . Math.Statistics.getStandardDeviation -- Both of which, having been normalised, should be zero. - ) . ( - normalise distribution :: [Double] -> [Double] - ) . take 10000 $ Math.Probability.generatePopulation distribution randomGen where - probability' = recip . succ $ abs probability -- Semi-closed unit-interval (0, 1]. - distribution = Math.Probability.ShiftedGeometricDistribution probability' - - prop_shiftedGeometricDistribution' randomGen probability = Test.QuickCheck.label "prop_shiftedGeometricDistribution'" . all ( - >= (1 :: Double) - ) . take 10 $ Math.Probability.generatePopulation (Math.Probability.ShiftedGeometricDistribution probability') randomGen where - probability' = recip . succ $ abs probability -- Semi-closed unit-interval (0, 1]. - diff --git a/src/Factory/Test/QuickCheck/QuickChecks.hs b/src/Factory/Test/QuickCheck/QuickChecks.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/QuickChecks.hs +++ /dev/null @@ -1,70 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Calls the /quickChecks/-functions for modules supporting this feature. --} - -module Factory.Test.QuickCheck.QuickChecks( --- * Functions - run -) where - -import qualified Control.Arrow -import qualified Factory.Test.QuickCheck.ArithmeticGeometricMean -import qualified Factory.Test.QuickCheck.Factorial -import qualified Factory.Test.QuickCheck.Hyperoperation -import qualified Factory.Test.QuickCheck.Interval -import qualified Factory.Test.QuickCheck.MonicPolynomial -import qualified Factory.Test.QuickCheck.PerfectPower -import qualified Factory.Test.QuickCheck.Pi -import qualified Factory.Test.QuickCheck.Polynomial -import qualified Factory.Test.QuickCheck.Power -import qualified Factory.Test.QuickCheck.Primality -import qualified Factory.Test.QuickCheck.PrimeFactorisation -import qualified Factory.Test.QuickCheck.Primes -import qualified Factory.Test.QuickCheck.Probability -import qualified Factory.Test.QuickCheck.Radix -import qualified Factory.Test.QuickCheck.SquareRoot -import qualified Factory.Test.QuickCheck.Statistics -import qualified Factory.Test.QuickCheck.Summation - --- | Run the /quickChecks/-functions for modules supporting this feature. -run :: IO () -run = mapM_ ( - uncurry (>>) . Control.Arrow.first putStrLn - ) [ - ("ArithmeticGeometricMean", Factory.Test.QuickCheck.ArithmeticGeometricMean.quickChecks), - ("Factorial", Factory.Test.QuickCheck.Factorial.quickChecks), - ("Hyperoperation", Factory.Test.QuickCheck.Hyperoperation.quickChecks), - ("Interval", Factory.Test.QuickCheck.Interval.quickChecks), - ("MonicPolynomial", Factory.Test.QuickCheck.MonicPolynomial.quickChecks), - ("PerfectPower", Factory.Test.QuickCheck.PerfectPower.quickChecks), - ("Pi", Factory.Test.QuickCheck.Pi.quickChecks), - ("Polynomial", Factory.Test.QuickCheck.Polynomial.quickChecks), - ("Power", Factory.Test.QuickCheck.Power.quickChecks), - ("Primality", Factory.Test.QuickCheck.Primality.quickChecks), - ("PrimeFactorisation", Factory.Test.QuickCheck.PrimeFactorisation.quickChecks), - ("Primes", Factory.Test.QuickCheck.Primes.quickChecks), - ("Probability", Factory.Test.QuickCheck.Probability.quickChecks), - ("Radix", Factory.Test.QuickCheck.Radix.quickChecks), - ("SquareRoot", Factory.Test.QuickCheck.SquareRoot.quickChecks), - ("Statistics", Factory.Test.QuickCheck.Statistics.quickChecks), - ("Summation", Factory.Test.QuickCheck.Summation.quickChecks) - ] - diff --git a/src/Factory/Test/QuickCheck/Radix.hs b/src/Factory/Test/QuickCheck/Radix.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Radix.hs +++ /dev/null @@ -1,46 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Radix". --} - -module Factory.Test.QuickCheck.Radix( --- * Types --- ** Type-synonyms --- Testable, --- * Functions - quickChecks -) where - -import qualified Factory.Math.Radix as Math.Radix -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - -type Testable = (Int, Integer) -> Test.QuickCheck.Property - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck `mapM_` [prop_reversable, prop_digitalRoot] where - prop_reversable, prop_digitalRoot :: Testable - prop_reversable (b, n) = abs base > 1 ==> Test.QuickCheck.label "prop_reversable" $ Math.Radix.fromBase base (Math.Radix.toBase base n) == n where - base = (b `mod` 73) - 36 - - prop_digitalRoot (_, n) = Test.QuickCheck.label "prop_digitalRoot" $ Math.Radix.digitalRoot n' == 9 where - n' = 9 * succ (abs n) - diff --git a/src/Factory/Test/QuickCheck/SquareRoot.hs b/src/Factory/Test/QuickCheck/SquareRoot.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/SquareRoot.hs +++ /dev/null @@ -1,86 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{- - Copyright (C) 2011-2015 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Implements 'Test.QuickCheck.Arbitrary' and defines /QuickCheck/-properties for "Math.Implementations.SquareRoot". --} - -module Factory.Test.QuickCheck.SquareRoot( --- * Types --- ** Type-synonyms --- Testable, --- * Functions - quickChecks -) where - -import Data.Ratio((%)) -import qualified Data.Ratio -import qualified Factory.Math.Implementations.SquareRoot as Math.Implementations.SquareRoot -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.Precision as Math.Precision -import qualified Factory.Math.SquareRoot as Math.SquareRoot -import qualified Test.QuickCheck - -instance Test.QuickCheck.Arbitrary (Math.Implementations.SquareRoot.Algorithm) where - arbitrary = Test.QuickCheck.oneof [ - Test.QuickCheck.elements [ - Math.Implementations.SquareRoot.BakhshaliApproximation, - Math.Implementations.SquareRoot.ContinuedFraction, - Math.Implementations.SquareRoot.HalleysMethod, - Math.Implementations.SquareRoot.NewtonRaphsonIteration - ], - Math.Implementations.SquareRoot.TaylorSeries `fmap` Test.QuickCheck.elements [2 .. 32] - ] - -type Testable = (Math.Implementations.SquareRoot.Algorithm, Math.Precision.DecimalDigits, Rational) -> Test.QuickCheck.Property - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck `mapM_` [prop_accuracy, prop_factorable, prop_perfectSquare] where - prop_accuracy, prop_factorable, prop_perfectSquare :: Testable - prop_accuracy (algorithm, decimalDigits, operand) = Test.QuickCheck.label "prop_accuracy" . (>= requiredDecimalDigits) . Math.SquareRoot.getAccuracy operand' $ Math.SquareRoot.squareRoot algorithm requiredDecimalDigits operand' where - requiredDecimalDigits :: Math.Precision.DecimalDigits - requiredDecimalDigits = succ $ decimalDigits `mod` 1024 - - operand' :: Rational - operand' = abs operand - - prop_factorable (algorithm, decimalDigits, operand) = Test.QuickCheck.label "prop_factorable" . (<= 5) . ( - * 10 ^ requiredDecimalDigits -- Promote the relative error. - ) . abs $ 1 - ( - Math.SquareRoot.squareRoot algorithm requiredDecimalDigits ( - toRational $ Data.Ratio.numerator operand' - ) / Math.SquareRoot.squareRoot algorithm requiredDecimalDigits ( - toRational $ Data.Ratio.denominator operand' - ) - ) / Math.SquareRoot.squareRoot algorithm requiredDecimalDigits operand' where - requiredDecimalDigits :: Math.Precision.DecimalDigits - requiredDecimalDigits = succ $ decimalDigits `mod` 1024 - - operand' :: Rational - operand' = succ $ abs operand - - prop_perfectSquare (algorithm, decimalDigits, operand) = Test.QuickCheck.label "prop_perfectSquare" . Math.SquareRoot.isPrecise perfectSquare $ Math.SquareRoot.squareRoot algorithm requiredDecimalDigits perfectSquare where - requiredDecimalDigits :: Math.Precision.DecimalDigits - requiredDecimalDigits = succ $ decimalDigits `mod` 32768 - - operand', perfectSquare :: Rational - operand' = (abs (Data.Ratio.numerator operand) `min` (2 ^ (32 :: Int))) % (abs (Data.Ratio.denominator operand) `min` (2 ^ (32 :: Int))) -- Avoid floating-point rounding-errors in 'Math.SquareRoot.rSqrt'. - perfectSquare = Math.Power.square operand' - diff --git a/src/Factory/Test/QuickCheck/Statistics.hs b/src/Factory/Test/QuickCheck/Statistics.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Statistics.hs +++ /dev/null @@ -1,112 +0,0 @@ -{- - Copyright (C) 2011-2014 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Statistics". --} - -module Factory.Test.QuickCheck.Statistics( --- * Functions - quickChecks -) where - -import qualified Data.Array -import qualified Data.List -import qualified Data.Map -import qualified Data.Numbers.Primes -import qualified Data.Set -import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial -import qualified Factory.Math.Power as Math.Power -import qualified Factory.Math.Statistics as Math.Statistics -import Factory.Test.QuickCheck.Factorial() -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck `mapM_` [prop_nC0, prop_nC1, prop_sum] - >> Test.QuickCheck.quickCheck `mapM_` [prop_symmetry, prop_prime] - >> Test.QuickCheck.quickCheck `mapM_` [prop_nP0, prop_nP1] - >> Test.QuickCheck.quickCheck `mapM_` [prop_zeroVariance, prop_zeroAverageAbsoluteDeviation] - >> Test.QuickCheck.quickCheck `mapM_` [prop_balance, prop_varianceRelocated, prop_varianceScaled, prop_varianceOrder, prop_equivalence, prop_varianceOfArray, prop_varianceOfMap, prop_meanOfSet] - >> Test.QuickCheck.quickCheck prop_weightedMeanRational - >> Test.QuickCheck.quickCheck prop_weightedMeanInteger - >> Test.QuickCheck.quickCheck prop_weightedMeanUniformDenominator - where - prop_nC0, prop_nC1, prop_sum :: Math.Implementations.Factorial.Algorithm -> Integer -> Test.QuickCheck.Property - prop_nC0 algorithm n = Test.QuickCheck.label "prop_nC0" $ Math.Statistics.nCr algorithm (abs n) 0 == 1 - - prop_nC1 algorithm i = Test.QuickCheck.label "prop_nC1" $ Math.Statistics.nCr algorithm n 1 == n where - n = succ $ abs i - - prop_sum algorithm i = Test.QuickCheck.label "prop_sum" $ sum (Math.Statistics.nCr algorithm n `map` [0 .. n]) == 2 ^ n where - n = succ $ abs i - - prop_symmetry, prop_prime :: Math.Implementations.Factorial.Algorithm -> (Integer, Integer) -> Test.QuickCheck.Property - prop_symmetry algorithm (i, j) = Test.QuickCheck.label "prop_symmetry" $ Math.Statistics.nCr algorithm n r == Math.Statistics.nCr algorithm n (n - r) where - [r, n] = Data.List.sort $ map abs [i, j] - - prop_prime algorithm (i, j) = r `notElem` [0, n] ==> Test.QuickCheck.label "prop_prime" $ (Math.Statistics.nCr algorithm n r `mod` n) == 0 where - n = Data.Numbers.Primes.primes !! fromIntegral (i `mod` 500000) - r = j `mod` n -- Ensure r is smaller than n. - - prop_nP0, prop_nP1 :: Integer -> Test.QuickCheck.Property - prop_nP0 n = Test.QuickCheck.label "prop_nP0" $ Math.Statistics.nPr (abs n) 0 == 1 - - prop_nP1 i = Test.QuickCheck.label "prop_nP1" $ Math.Statistics.nPr n 1 == n where - n = succ $ abs i - - prop_zeroVariance, prop_zeroAverageAbsoluteDeviation :: Rational -> Test.QuickCheck.Property - prop_zeroVariance x = Test.QuickCheck.label "prop_zeroVariance" $ Math.Statistics.getVariance (replicate 32 x) == (0 :: Rational) - prop_zeroAverageAbsoluteDeviation x = Test.QuickCheck.label "zeroAverageAbsoluteDeviation" $ Math.Statistics.getAverageAbsoluteDeviation (replicate 32 x) == (0 :: Rational) - - prop_balance, prop_varianceRelocated, prop_varianceScaled, prop_varianceOrder, prop_equivalence, prop_varianceOfMap, prop_meanOfSet, prop_varianceOfArray :: [Integer] -> Test.QuickCheck.Property - prop_balance l = not (null l) ==> Test.QuickCheck.label "prop_balance" . (== 0) . abs . sum $ map (\i -> toRational i - Math.Statistics.getMean l) l - prop_varianceRelocated l = not (null l) ==> Test.QuickCheck.label "prop_varianceRelocated" $ (Math.Statistics.getVariance l :: Rational) == Math.Statistics.getVariance (map succ l) - prop_varianceScaled l = not (null l) ==> Test.QuickCheck.label "prop_varianceScaled" $ (4 * Math.Statistics.getVariance l :: Rational) == Math.Statistics.getVariance (map (* 2) l) - prop_varianceOrder l = not (null l) ==> Test.QuickCheck.label "prop_varianceOrder" $ Math.Statistics.getVariance l == (Math.Statistics.getVariance (reverse l) :: Rational) - prop_equivalence l = not (null l) ==> Test.QuickCheck.label "prop_equivalence" $ Math.Statistics.getVariance l == Math.Statistics.getMean (map Math.Power.square l) - Math.Power.square (Math.Statistics.getMean l :: Rational) - prop_varianceOfArray l = not (null l) ==> Test.QuickCheck.label "prop_varianceOfArray" $ Math.Statistics.getVariance (Data.Array.array (1, length l) $ zip [1 ..] l) == (Math.Statistics.getVariance l :: Rational) - prop_varianceOfMap l = not (null l) ==> Test.QuickCheck.label "prop_varianceOfMap" $ Math.Statistics.getVariance (Data.Map.fromList $ zip [0 :: Int ..] l) == (Math.Statistics.getVariance l :: Rational) - prop_meanOfSet l = not (null l') ==> Test.QuickCheck.label "prop_meanOfSet" $ Math.Statistics.getMean (Data.Set.fromList l') == (Math.Statistics.getMean l' :: Rational) where - l' = Data.List.nub l - - prop_weightedMeanRational :: [(Rational, Rational)] -> Test.QuickCheck.Property - prop_weightedMeanRational assoc = (denominator /= 0) ==> Test.QuickCheck.label "prop_weightedMeanRational" $ Math.Statistics.getWeightedMean assoc == ( - sum (map (uncurry (*)) assoc) / denominator - ) where - denominator = sum $ map snd assoc - - - prop_weightedMeanInteger :: [(Integer, Integer)] -> Test.QuickCheck.Property - prop_weightedMeanInteger assoc = (denominator /= 0) ==> Test.QuickCheck.label "prop_weightedMeanInteger" $ Math.Statistics.getWeightedMean assoc == ( - toRational ( - sum $ map ( - uncurry (*) - ) assoc - ) / toRational denominator - ) where - denominator = sum $ map snd assoc - - prop_weightedMeanUniformDenominator :: [Rational] -> Integer -> Test.QuickCheck.Property - prop_weightedMeanUniformDenominator numerators i = (not (null numerators) && i /= 0) ==> Test.QuickCheck.label "prop_weightedMeanUniformDenominator" $ Math.Statistics.getWeightedMean ( - zip numerators $ repeat i - ) == ( - Math.Statistics.getMean numerators :: Rational - ) - diff --git a/src/Factory/Test/QuickCheck/Summation.hs b/src/Factory/Test/QuickCheck/Summation.hs deleted file mode 100644 --- a/src/Factory/Test/QuickCheck/Summation.hs +++ /dev/null @@ -1,42 +0,0 @@ -{- - Copyright (C) 2011 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] Defines /QuickCheck/-properties for "Math.Summation". --} - -module Factory.Test.QuickCheck.Summation( --- * Functions - quickChecks -) where - -import qualified Factory.Math.Summation as Math.Summation -import qualified Test.QuickCheck -import Test.QuickCheck((==>)) - --- | Defines invariant properties. -quickChecks :: IO () -quickChecks = Test.QuickCheck.quickCheck `mapM_` [prop_sum, prop_sumR] where - prop_sum, prop_sumR :: Int -> [Rational] -> Test.QuickCheck.Property - prop_sum chunkSize l = not (null l) ==> Test.QuickCheck.label "prop_sum" $ Math.Summation.sum' chunkSize' l == sum l where - chunkSize' = 2 + (chunkSize `mod` length l) - - prop_sumR chunkSize l = not (null l) ==> Test.QuickCheck.label "prop_sumR" $ Math.Summation.sumR chunkSize' l == sum l where - chunkSize' = 2 + (chunkSize `mod` length l) - - diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -1,241 +0,0 @@ -{- - Copyright (C) 2011-2013 Dr. Alistair Ward - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{- | - [@AUTHOR@] Dr. Alistair Ward - - [@DESCRIPTION@] - - * Contains the entry-point to the program. - - * Facilitates testing. --} - -module Main(main) where - -import qualified Data.Map -import qualified Data.List -import qualified Data.Version -import qualified Distribution.Package -import qualified Distribution.Text -import qualified Distribution.Version -import qualified Factory.Math.Hyperoperation as Math.Hyperoperation -import qualified Factory.Math.Implementations.Factorial as Math.Implementations.Factorial -import qualified Factory.Math.Implementations.Primality as Math.Implementations.Primality -import qualified Factory.Math.Implementations.PrimeFactorisation as Math.Implementations.PrimeFactorisation -import qualified Factory.Math.Implementations.Primes.Algorithm as Math.Implementations.Primes.Algorithm -import qualified Factory.Math.Implementations.SquareRoot as Math.Implementations.SquareRoot -import qualified Factory.Math.Probability as Math.Probability -import qualified Factory.Test.CommandOptions as Test.CommandOptions -import qualified Factory.Test.Performance.Factorial as Test.Performance.Factorial -import qualified Factory.Test.Performance.Hyperoperation as Test.Performance.Hyperoperation -import qualified Factory.Test.Performance.Pi as Test.Performance.Pi -import qualified Factory.Test.Performance.Primality as Test.Performance.Primality -import qualified Factory.Test.Performance.PrimeFactorisation as Test.Performance.PrimeFactorisation -import qualified Factory.Test.Performance.Primes as Test.Performance.Primes -import qualified Factory.Test.Performance.SquareRoot as Test.Performance.SquareRoot -import qualified Factory.Test.Performance.Statistics as Test.Performance.Statistics -import qualified Factory.Test.QuickCheck.QuickChecks as Test.QuickCheck.QuickChecks -import qualified Paths_factory as Paths -- Either local stub, or package-instance autogenerated by 'Setup.hs build'. -import qualified System.Console.GetOpt as G -import qualified System.Environment -import qualified System.Exit -import qualified System.IO -import qualified System.IO.Error -import qualified System.Random -import qualified ToolShed.Defaultable - --- Local convenience definitions. -type PrimalityAlgorithm = Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm -type PiCategory = Test.Performance.Pi.Category Math.Implementations.SquareRoot.Algorithm Math.Implementations.Factorial.Algorithm - --- | Used to thread user-defined command-line options, though the list of functions which implement them. -type CommandLineAction = Test.CommandOptions.CommandOptions -> IO Test.CommandOptions.CommandOptions -- Supplied as the type-argument to 'G.OptDescr'. - --- | On failure to parse the specified string, returns an explanatory error. -read' :: Read a => String -> String -> a -read' errorMessage s = case reads s of - [(x, "")] -> x - _ -> error $ errorMessage ++ show s - --- | On failure to parse a command-line argument, returns an explanatory error. -readCommandArg :: Read a => String -> a -readCommandArg = read' "Failed to parse command-line argument " - --- | Parses the command-line arguments, to determine 'Test.CommandOptions.CommandOptions'. -main :: IO () -main = do - System.IO.hClose System.IO.stdin -- Nothing is read from standard input. - - progName <- System.Environment.getProgName - - let - usageMessage :: String - usageMessage = "Usage:\t" ++ G.usageInfo progName optDescrList - - optDescrList :: [G.OptDescr CommandLineAction] - optDescrList = [ --- String [String] (G.ArgDescr CommandLineAction) String - G.Option "?" ["help"] (G.NoArg $ const printUsage) "Display this help-text & then exit.", - G.Option "" ["verbose"] (G.NoArg $ return {-to IO-monad-} . Test.CommandOptions.setVerbose) ("Provide additional information where available; default '" ++ show (Test.CommandOptions.verbose ToolShed.Defaultable.defaultValue) ++ "'."), - G.Option "" ["version"] (G.NoArg $ const printVersion) "Print version-information & then exit.", - G.Option "q" ["runQuickChecks"] (G.NoArg $ const runQuickChecks) "Run Quick-checks using arbitrary data & then exit.", - G.Option "" ["carmichaelNumbersPerformance"] (carmichaelNumbersPerformance `G.ReqArg` "(Math.Implementations.Primality.Algorithm, Int)") "Test the performance of 'Math.Primality.carmichaelNumbers'.", - G.Option "" ["factorialPerformance"] (factorialPerformance `G.ReqArg` "(Math.Implementations.Factorial.Algorithm, Integer)") "Test the performance of 'Math.Factorial.factorial'.", - G.Option "" ["factorialPerformanceGraph"] (factorialPerformanceGraph `G.ReqArg` "Math.Implementations.Factorial.Algorithm") "Test the performance of 'Math.Factorial.factorial', with an exponentially increasing operand.", - G.Option "" ["factorialPerformanceGraphControl"] (G.NoArg factorialPerformanceGraphControl) "Test the performance of a naive factorial-implementation, with an exponentially increasing operand.", - G.Option "" ["hyperoperationPerformance"] (hyperoperationPerformance `G.ReqArg` "(Integer, Math.Hyperoperation.Base, Math.Hyperoperation.HyperExponent)") "Test the performance of 'Math.Hyperoperation.hyperoperation', against the specified rank, base and hyper-exponent.", - G.Option "" ["hyperoperationPerformanceGraphRank"] (hyperoperationPerformanceGraphRank `G.ReqArg` "(Math.Hyperoperation.Base, Math.Hyperoperation.HyperExponent)") "Test the performance of 'Math.Hyperoperation.hyperoperation', for the specified base and hyper-exponent, and a linearly increasing rank.", - G.Option "" ["hyperoperationPerformanceGraphExponent"] (hyperoperationPerformanceGraphExponent `G.ReqArg` "(Integer, Math.Hyperoperation.Base)") "Test the performance of 'Math.Hyperoperation.hyperoperation', for the specified rank and base, and a linearly increasing hyper-exponent.", - G.Option "" ["isPrimePerformance"] (isPrimePerformance `G.ReqArg` "(Math.Implementations.Primality.Algorithm, Integer)") "Test the performance of 'Math.Primality.isPrime'.", - G.Option "" ["isPrimePerformanceGraph"] (isPrimePerformanceGraph `G.ReqArg` "Math.Implementations.Primality.Algorithm") "Test the performance of 'Math.Primality.isPrime', against the prime-indexed Fibonacci-numbers.", - G.Option "" ["mersenneNumbersPerformance"] (mersenneNumbersPerformance `G.ReqArg` "(Math.Implementations.Primes.Algorithm.Algorithm, Int)") "Test the performance of 'Math.Primes.mersenneNumbers'.", - G.Option "" ["factorialPerformance"] (factorialPerformance `G.ReqArg` "(Math.Implementations.Factorial.Algorithm, Integer)") "Test the performance of 'Math.Factorial.factorial'.", - G.Option "" ["nCrPerformance"] (nCrPerformance `G.ReqArg` "(Math.Implementations.Factorial.Algorithm, Integer, Integer)") "Test the performance of 'Math.Factorial.factorial'.", - G.Option "" ["piPerformance"] (piPerformance `G.ReqArg` "(Math.Pi.Category, Math.Precision.DecimalDigits)") "Test the performance of 'Math.Pi.openI'.", - G.Option "" ["piPerformanceGraph"] (piPerformanceGraph `G.ReqArg` "(Math.Pi.Category, Double, Math.Precision.DecimalDigits)") "Test the performance of 'Math.Pi.openI', with an exponential precision-requirement (of the specified exponent), up to the specified limit.", - G.Option "" ["plotDiscreteDistribution"] (plotDiscreteDistribution `G.ReqArg` "(Int, Math.Probability.DiscreteDistribution)") "Plot the Probability Mass function for the specified discrete distribution.", - G.Option "" ["primeFactorsPerformance"] (primeFactorsPerformance `G.ReqArg` "(Math.Implementations.PrimeFactorisation.Algorithm, Integer)") "Test the performance of 'Math.PrimeFactorisation.primeFactors'.", - G.Option "" ["primeFactorsPerformanceGraph"] (primeFactorsPerformanceGraph `G.ReqArg` "(Math.Implementations.PrimeFactorisation.Algorithm, Int)") "Test the performance of 'Math.PrimeFactorisation.primeFactors', on the specified number of odd integers from the Fibonacci-sequence.", - G.Option "" ["primesPerformance"] (primesPerformance `G.ReqArg` "(Math.Implementations.Primes.Algorithm.Algorithm, Int)") "Test the performance of 'Math.Primes.primes'.", - G.Option "" ["squareRootPerformance"] (squareRootPerformance `G.ReqArg` "(Math.Implementations.SquareRoot.Algorithm, Rational, DecimalDigits)") "Test the performance of 'Math.SquareRoot.squareRoot'.", - G.Option "" ["squareRootPerformanceGraph"] (squareRootPerformanceGraph `G.ReqArg` "(Math.Implementations.SquareRoot.Algorithm, Rational)") "Test the performance of 'Math.SquareRoot.squareRoot', with an exponentially increasing precision-requirement." - ] where - printVersion, printUsage, runQuickChecks :: IO Test.CommandOptions.CommandOptions - printVersion = System.IO.hPutStrLn System.IO.stderr (Distribution.Text.display packageIdentifier ++ "\n\nCopyright (C) 2011-2015 " ++ author ++ ".\nThis program comes with ABSOLUTELY NO WARRANTY.\nThis is free software, and you are welcome to redistribute it under certain conditions.\n\nWritten by " ++ author ++ ".") >> System.Exit.exitWith System.Exit.ExitSuccess where - packageIdentifier :: Distribution.Package.PackageIdentifier - packageIdentifier = Distribution.Package.PackageIdentifier { - Distribution.Package.pkgName = Distribution.Package.PackageName progName, -- CAVEAT: coincidentally. - Distribution.Package.pkgVersion = Distribution.Version.Version (Data.Version.versionBranch Paths.version) [] - } - - author :: String - author = "Dr. Alistair Ward" - - printUsage = System.IO.hPutStrLn System.IO.stderr usageMessage >> System.Exit.exitWith System.Exit.ExitSuccess - - runQuickChecks = Test.QuickCheck.QuickChecks.run >> System.Exit.exitWith System.Exit.ExitSuccess - - factorialPerformanceGraphControl :: Test.CommandOptions.CommandOptions -> IO Test.CommandOptions.CommandOptions - factorialPerformanceGraphControl commandOptions = Test.Performance.Factorial.factorialPerformanceGraphControl (Test.CommandOptions.verbose commandOptions) >> System.Exit.exitWith (System.Exit.ExitFailure 1) - - carmichaelNumbersPerformance, factorialPerformance, factorialPerformanceGraph, hyperoperationPerformance, hyperoperationPerformanceGraphRank, hyperoperationPerformanceGraphExponent, isPrimePerformance, isPrimePerformanceGraph, mersenneNumbersPerformance, piPerformance, piPerformanceGraph, plotDiscreteDistribution, primeFactorsPerformance, primesPerformance, squareRootPerformance, squareRootPerformanceGraph :: String -> CommandLineAction - - carmichaelNumbersPerformance arg _ = Test.Performance.Primality.carmichaelNumbersPerformance algorithm i >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - algorithm :: PrimalityAlgorithm - (algorithm, i) = readCommandArg arg - - factorialPerformance arg _ = Test.Performance.Factorial.factorialPerformance algorithm i >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - algorithm :: Math.Implementations.Factorial.Algorithm - i :: Integer - (algorithm, i) = readCommandArg arg - - factorialPerformanceGraph arg commandOptions = Test.Performance.Factorial.factorialPerformanceGraph (Test.CommandOptions.verbose commandOptions) (readCommandArg arg :: Math.Implementations.Factorial.Algorithm) >> System.Exit.exitWith (System.Exit.ExitFailure 1) - - hyperoperationPerformance arg _ = Test.Performance.Hyperoperation.hyperoperationPerformance rank base hyperExponent >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - rank :: Integer - base :: Math.Hyperoperation.Base - hyperExponent :: Math.Hyperoperation.HyperExponent - (rank, base, hyperExponent) = readCommandArg arg - - hyperoperationPerformanceGraphRank arg commandOptions = Test.Performance.Hyperoperation.hyperoperationPerformanceGraphRank (Test.CommandOptions.verbose commandOptions) base hyperExponent >> System.Exit.exitWith (System.Exit.ExitFailure 1) where - base :: Math.Hyperoperation.Base - hyperExponent :: Math.Hyperoperation.HyperExponent - (base, hyperExponent) = readCommandArg arg - - hyperoperationPerformanceGraphExponent arg commandOptions = Test.Performance.Hyperoperation.hyperoperationPerformanceGraphExponent (Test.CommandOptions.verbose commandOptions) rank base >> System.Exit.exitWith (System.Exit.ExitFailure 1) where - rank :: Integer - base :: Math.Hyperoperation.Base - (rank, base) = readCommandArg arg - - isPrimePerformance arg _ = Test.Performance.Primality.isPrimePerformance algorithm i >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - algorithm :: PrimalityAlgorithm - i :: Integer - (algorithm, i) = readCommandArg arg - - isPrimePerformanceGraph arg _ = Test.Performance.Primality.isPrimePerformanceGraph (readCommandArg arg :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm) >> System.Exit.exitWith (System.Exit.ExitFailure 1) - - mersenneNumbersPerformance arg _ = Test.Performance.Primes.mersenneNumbersPerformance algorithm i >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - algorithm :: Math.Implementations.Primes.Algorithm.Algorithm - (algorithm, i) = readCommandArg arg - - nCrPerformance arg _ = Test.Performance.Statistics.nCrPerformance algorithm n r >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - algorithm :: Math.Implementations.Factorial.Algorithm - n, r :: Integer - (algorithm, n, r) = readCommandArg arg - - piPerformance arg _ = Test.Performance.Pi.piPerformance category decimalDigits >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - category :: PiCategory - (category, decimalDigits) = readCommandArg arg - - piPerformanceGraph arg commandOptions = Test.Performance.Pi.piPerformanceGraph category factor maxDecimalDigits (Test.CommandOptions.verbose commandOptions) >> System.Exit.exitWith (System.Exit.ExitFailure 1) where - category :: PiCategory - factor :: Double - (category, factor, maxDecimalDigits) = readCommandArg arg - - plotDiscreteDistribution arg _ = let - distribution :: Math.Probability.DiscreteDistribution Double - (n, distribution) = readCommandArg arg - in do - System.Random.getStdGen >>= print . Data.Map.toList . Data.Map.map ((/ (fromIntegral n :: Double)) . fromInteger) . Data.Map.fromListWith (+) . (`zip` repeat 1) . (take n :: [Integer] -> [Integer]) . Math.Probability.generateDiscretePopulation distribution - - System.Exit.exitWith System.Exit.ExitSuccess - - primeFactorsPerformance arg _ = Test.Performance.PrimeFactorisation.primeFactorsPerformance algorithm i >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - algorithm :: Math.Implementations.PrimeFactorisation.Algorithm - (algorithm, i) = readCommandArg arg - - primeFactorsPerformanceGraph arg _ = Test.Performance.PrimeFactorisation.primeFactorsPerformanceGraph algorithm index >> System.Exit.exitWith (System.Exit.ExitFailure 1) where - algorithm :: Math.Implementations.PrimeFactorisation.Algorithm - (algorithm, index) = readCommandArg arg - - primesPerformance arg _ = ( - ( -{- - Hard-code specific algorithms, so the simplifier triggers rewrite-rules in "Math.Implementations.Primes", - ready for run-time definitions of 'algorithm' to exploit as appropriate. - CAVEAT: fragile. --} - case algorithm of - Math.Implementations.Primes.Algorithm.SieveOfEratosthenes wheelSize -> Test.Performance.Primes.primesPerformance $ Math.Implementations.Primes.Algorithm.SieveOfEratosthenes wheelSize - Math.Implementations.Primes.Algorithm.SieveOfAtkin maxPrime -> Test.Performance.Primes.primesPerformance $ Math.Implementations.Primes.Algorithm.SieveOfAtkin maxPrime - _ -> Test.Performance.Primes.primesPerformance algorithm - ) index :: IO ( - Double, --- Integer - Int -- Exploits rewrite-rules in "Math.Implementations.Primes.*". - ) - ) >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - algorithm :: Math.Implementations.Primes.Algorithm.Algorithm - (algorithm, index) = readCommandArg arg - - squareRootPerformance arg _ = Test.Performance.SquareRoot.squareRootPerformance algorithm operand decimalDigits >>= print >> System.Exit.exitWith System.Exit.ExitSuccess where - algorithm :: Math.Implementations.SquareRoot.Algorithm - operand :: Rational - (algorithm, operand, decimalDigits) = readCommandArg arg - - squareRootPerformanceGraph arg _ = Test.Performance.SquareRoot.squareRootPerformanceGraph algorithm operand >> System.Exit.exitWith (System.Exit.ExitFailure 1) where - algorithm :: Math.Implementations.SquareRoot.Algorithm - operand :: Rational - (algorithm, operand) = readCommandArg arg - - args <- System.Environment.getArgs - --- G.getOpt :: G.ArgOrder CommandLineAction -> [G.OptDescr Action] -> [String] -> ([Action], [String], [String]) - case G.getOpt G.RequireOrder optDescrList args of - (commandLineActions, _, []) -> Data.List.foldl' (>>=) (return {-to IO-monad-} ToolShed.Defaultable.defaultValue) commandLineActions >> System.Exit.exitWith System.Exit.ExitSuccess - (_, _, errors) -> System.IO.Error.ioError . System.IO.Error.userError $ concat errors ++ usageMessage -- Throw. -