Copyright | (c) 2011 Daniel Fischer |
---|---|
License | MIT |
Maintainer | Daniel Fischer <daniel.is.fischer@googlemail.com> |
Safe Haskell | None |
Language | Haskell2010 |
Calculating integer roots, modular powers and related things. This module reexports the most needed functions from the implementation modules. The implementation modules provide some additional functions, in particular some unsafe functions which omit some tests for performance reasons.
Synopsis
- integerSquareRoot :: Integral a => a -> a
- isSquare :: Integral a => a -> Bool
- exactSquareRoot :: Integral a => a -> Maybe a
- integerCubeRoot :: Integral a => a -> a
- isCube :: Integral a => a -> Bool
- exactCubeRoot :: Integral a => a -> Maybe a
- integerFourthRoot :: Integral a => a -> a
- isFourthPower :: Integral a => a -> Bool
- exactFourthRoot :: Integral a => a -> Maybe a
- integerRoot :: (Integral a, Integral b) => b -> a -> a
- isKthPower :: (Integral a, Integral b) => b -> a -> Bool
- exactRoot :: (Integral a, Integral b) => b -> a -> Maybe a
- isPerfectPower :: Integral a => a -> Bool
- highestPower :: Integral a => a -> (a, Word)
- powMod :: (Integral a, Integral b) => a -> b -> a -> a
Integer Roots
Square roots
integerSquareRoot :: Integral a => a -> a Source #
Calculate the integer square root of a nonnegative number n
,
that is, the largest integer r
with r*r <= n
.
Throws an error on negative input.
isSquare :: Integral a => a -> Bool Source #
Test whether the argument is a square.
After a number is found to be positive, first isPossibleSquare
is checked, if it is, the integer square root is calculated.
exactSquareRoot :: Integral a => a -> Maybe a Source #
Returns Nothing
if the argument is not a square,
if Just
rr*r == n
and r >= 0
. Avoids the expensive calculation
of the square root if n
is recognized as a non-square
before, prevents repeated calculation of the square root
if only the roots of perfect squares are needed.
Checks for negativity and isPossibleSquare
.
Cube roots
integerCubeRoot :: Integral a => a -> a Source #
Calculate the integer cube root of an integer n
,
that is the largest integer r
such that r^3 <= n
.
Note that this is not symmetric about 0
, for example
integerCubeRoot (-2) = (-2)
while integerCubeRoot 2 = 1
.
exactCubeRoot :: Integral a => a -> Maybe a Source #
Returns Nothing
if the argument is not a cube,
Just r
if n == r^3
.
Fourth roots
integerFourthRoot :: Integral a => a -> a Source #
Calculate the integer fourth root of a nonnegative number,
that is, the largest integer r
with r^4 <= n
.
Throws an error on negaitve input.
isFourthPower :: Integral a => a -> Bool Source #
Test whether an integer is a fourth power. First nonnegativity is checked, then the unchecked test is called.
exactFourthRoot :: Integral a => a -> Maybe a Source #
Returns Nothing
if n
is not a fourth power,
Just r
if n == r^4
and r >= 0
.
General roots
integerRoot :: (Integral a, Integral b) => b -> a -> a Source #
Calculate an integer root,
computes the (floor of) the integerRoot
k nk
-th
root of n
, where k
must be positive.
r =
means integerRoot
k nr^k <= n < (r+1)^k
if that is possible at all.
It is impossible if k
is even and n < 0
, since then r^k >= 0
for all r
,
then, and if k <= 0
,
raises an error. For integerRoot
k < 5
, a specialised
version is called which should be more efficient than the general algorithm.
However, it is not guaranteed that the rewrite rules for those fire, so if k
is
known in advance, it is safer to directly call the specialised versions.
isKthPower :: (Integral a, Integral b) => b -> a -> Bool Source #
checks whether isKthPower
k nn
is a k
-th power.
isPerfectPower :: Integral a => a -> Bool Source #
checks whether isPerfectPower
nn == r^k
for some k > 1
.
highestPower :: Integral a => a -> (a, Word) Source #
produces the pair highestPower
n(b,k)
with the largest
exponent k
such that n == b^k
, except for
,
in which case arbitrarily large exponents exist, and by an
arbitrary decision abs
n <= 1(n,3)
is returned.
First, by trial division with small primes, the range of possible
exponents is reduced (if p^e
exactly divides n
, then k
must
be a divisor of e
, if several small primes divide n
, k
must
divide the greatest common divisor of their exponents, which mostly
will be 1
, generally small; if none of the small primes divides
n
, the range of possible exponents is reduced since the base is
necessarily large), if that has not yet determined the result, the
remaining factor is examined by trying the divisors of the gcd
of the prime exponents if some have been found, otherwise by trying
prime exponents recursively.
Modular powers
powMod :: (Integral a, Integral b) => a -> b -> a -> a Source #
powMod
b
e
m
computes (b^e
) `mod` m
in effective way.
An exponent e
must be non-negative, a modulo m
must be positive.
Otherwise the behaviour of powMod
is undefined.
>>>
powMod 2 3 5
3>>>
powMod 3 12345678901234567890 1001
1
See also powMod
and powSomeMod
.
For finite numeric types (Int
, Word
, etc.)
modulo m
should be such that m^2
does not overflow,
otherwise the behaviour is undefined. If you
need both to fit into machine word and to handle large moduli,
take a look at powModInt
and powModWord
.
>>>
powMod 3 101 (2^60-1 :: Integer)
1018105167100379328 -- correct>>>
powMod 3 101 (2^60-1 :: Int)
1115647832265427613 -- incorrect due to overflow>>>
powModInt 3 101 (2^60-1 :: Int)
1018105167100379328 -- correct