{-
	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 <https://www.gnu.org/licenses/>.
-}
{- |
 [@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/).

	* <https://en.wikipedia.org/wiki/Square_number>.

	* <https://mathworld.wolfram.com/SquareNumber.html>.

	* @(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 -> Maybe i
maybeSquareNumber i
i
--	| i < 0					= Nothing	-- This function is performance-sensitive, but this test is neither strictly nor frequently required.
	| ((i, [i]) -> Bool) -> [(i, [i])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(i
modulus, [i]
valid) -> i -> i -> i
forall a. Integral a => a -> a -> a
rem i
i i
modulus i -> [i] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [i]
valid) [
--							-- Distribution of moduli amongst perfect squares	Cumulative failure-detection.
		(i
16,	[i
0,i
1,i
4,i
9]),			-- All moduli are equally likely.			75%
		(i
9,	[i
0,i
1,i
4,i
7]),			-- Zero occurs 33%, the others only 22%.			88%
		(i
17,	[i
1,i
2,i
4,i
8,i
9,i
13,i
15,i
16,i
0]),	-- Zero only occurs 5.8%, the others 11.8%.		94%
-- These additional tests, aren't always cost-effective.
		(i
13,	[i
1,i
3,i
4,i
9,i
10,i
12,i
0]),		-- Zero only occurs 7.7%, the others 15.4%.		97%
		(i
7,	[i
1,i
2,i
4,i
0]),			-- Zero only occurs 14.3%, the others 28.6%.		98%
		(i
5,	[i
1,i
4,i
0])			-- Zero only occurs 20%, the others 40%.			99%

--	] && fromIntegral iSqrt == sqrt'	= Just iSqrt	-- CAVEAT: erroneously True for 187598574531033120 (187598574531033121 is square).
	] Bool -> Bool -> Bool
&& i -> i
forall n. Num n => n -> n
Math.Power.square i
iSqrt i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
i	= i -> Maybe i
forall a. a -> Maybe a
Just i
iSqrt
	| Bool
otherwise				= Maybe i
forall a. Maybe a
Nothing
	where
		sqrt' :: Double
		sqrt' :: Double
sqrt'	= Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ i -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i

		iSqrt :: i
iSqrt	= Double -> i
forall a b. (RealFrac a, Integral b) => a -> b
round Double
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.

	* <https://en.wikipedia.org/wiki/Perfect_power>.

	* <https://mathworld.wolfram.com/PerfectPower.html>.

	* A generalisation of the concept of /perfect squares/, in which only the exponent '2' is significant.
-}
isPerfectPower :: Integral i => i -> Bool
isPerfectPower :: i -> Bool
isPerfectPower i
i
	| i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i -> i
forall n. Num n => n -> n
Math.Power.square i
2	= Bool
False
	| Bool
otherwise			= i
i i -> Set i -> Bool
forall a. Ord a => a -> Set a -> Bool
`Data.Set.member` (i -> Set i -> Set i) -> Set i -> [i] -> Set i
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
		\i
n Set i
set	-> if i
n i -> Set i -> Bool
forall a. Ord a => a -> Set a -> Bool
`Data.Set.member` Set i
set
			then Set i
set
--			else Data.Set.union set . Data.Set.fromDistinctAscList . takeWhile (<= i) . iterate (* n) $ Math.Power.square n
			else (i -> Set i -> Set i) -> Set i -> [i] -> Set i
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr i -> Set i -> Set i
forall a. Ord a => a -> Set a -> Set a
Data.Set.insert Set i
set ([i] -> Set i) -> (i -> [i]) -> i -> Set i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Bool) -> [i] -> [i]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (i -> i -> Bool
forall a. Ord a => a -> a -> Bool
<= i
i) ([i] -> [i]) -> (i -> [i]) -> i -> [i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> i) -> i -> [i]
forall a. (a -> a) -> a -> [a]
iterate (i -> i -> i
forall a. Num a => a -> a -> a
* i
n) (i -> Set i) -> i -> Set i
forall a b. (a -> b) -> a -> b
$ i -> i
forall n. Num n => n -> n
Math.Power.square i
n	-- Faster.
	) Set i
forall a. Set a
Data.Set.empty [i
2 .. Double -> i
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> i) -> Double -> i
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
sqrt (i -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i :: Double)]

{-# NOINLINE isPerfectPower #-}
{-# RULES "isPerfectPower/Int" isPerfectPower = isPerfectPowerInt #-}

-- | A specialisation of 'isPerfectPower'.
isPerfectPowerInt :: Int -> Bool
isPerfectPowerInt :: Int -> Bool
isPerfectPowerInt Int
i
	| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int
forall n. Num n => n -> n
Math.Power.square Int
2	= Bool
False
	| Bool
otherwise			= Int
i Int -> IntSet -> Bool
`Data.IntSet.member` (Int -> IntSet -> IntSet) -> IntSet -> [Int] -> IntSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (
		\Int
n IntSet
set	-> if Int
n Int -> IntSet -> Bool
`Data.IntSet.member` IntSet
set
			then IntSet
set
			else (Int -> IntSet -> IntSet) -> IntSet -> [Int] -> IntSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> IntSet -> IntSet
Data.IntSet.insert IntSet
set ([Int] -> IntSet) -> (Int -> [Int]) -> Int -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i) ([Int] -> [Int]) -> (Int -> [Int]) -> Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) (Int -> IntSet) -> Int -> IntSet
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall n. Num n => n -> n
Math.Power.square Int
n
	) IntSet
Data.IntSet.empty [Int
2 .. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
sqrt (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Double)]