{-
	Copyright (C) 2011-2017 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@]	Provides various /hyperoperations/; <https://en.wikipedia.org/wiki/Hyperoperation>.
-}

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.
(Int
succession : Int
addition : Int
multiplication : Int
exponentiation : Int
tetration : Int
pentation : Int
hexation : [Int]
_)	= [Int
0 ..]

{- |
	* Returns the /power-tower/ of the specified /base/; <https://mathworld.wolfram.com/PowerTower.html>.

	* A synonym for /tetration/;
		<https://en.wikipedia.org/wiki/Tetration>,
		<https://www.tetration.org/Fractals/Atlas/index.html>.
-}
powerTower :: (Integral base, Integral hyperExponent, Show base) => base -> hyperExponent -> base
powerTower :: base -> hyperExponent -> base
powerTower base
0 hyperExponent
hyperExponent
	| hyperExponent -> Bool
forall a. Integral a => a -> Bool
even hyperExponent
hyperExponent	= base
1
	| Bool
otherwise		= base
0
powerTower base
_ (-1)	= base
0	-- The only negative hyper-exponent for which there's a consistent result.
powerTower base
base hyperExponent
hyperExponent
	| base
base base -> base -> Bool
forall a. Ord a => a -> a -> Bool
< base
0 Bool -> Bool -> Bool
&& hyperExponent
hyperExponent hyperExponent -> hyperExponent -> Bool
forall a. Ord a => a -> a -> Bool
> hyperExponent
1	= [Char] -> base
forall a. HasCallStack => [Char] -> a
error ([Char] -> base) -> [Char] -> base
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Math.Hyperoperation.powerTower:\tundefined for negative base; " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ base -> [Char]
forall a. Show a => a -> [Char]
show base
base
	| Bool
otherwise			= [base] -> hyperExponent -> base
forall i a. Integral i => [a] -> i -> a
Data.List.genericIndex ((base -> base) -> base -> [base]
forall a. (a -> a) -> a -> [a]
iterate (base
base base -> base -> base
forall a b. (Num a, Integral b) => a -> b -> a
^) base
1) hyperExponent
hyperExponent

-- | The /hyperoperation/-sequence; <https://en.wikipedia.org/wiki/Hyperoperation>.
hyperoperation :: (Integral rank, Show rank) => rank -> Base -> HyperExponent -> Base
hyperoperation :: rank -> Base -> Base -> Base
hyperoperation rank
rank Base
base Base
hyperExponent
	| rank
rank rank -> rank -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> rank
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
succession	= [Char] -> Base
forall a. HasCallStack => [Char] -> a
error ([Char] -> Base) -> [Char] -> Base
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Math.Hyperoperation.hyperoperation:\tundefined for rank; " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ rank -> [Char]
forall a. Show a => a -> [Char]
show rank
rank
	| Base
hyperExponent Base -> Base -> Bool
forall a. Ord a => a -> a -> Bool
< Base
0			= [Char] -> Base
forall a. HasCallStack => [Char] -> a
error ([Char] -> Base) -> [Char] -> Base
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Math.Hyperoperation.hyperoperation:\tundefined for hyper-exponent; " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Base -> [Char]
forall a. Show a => a -> [Char]
show Base
hyperExponent
	| Bool
otherwise				= rank
rank rank -> Base -> Base
forall rank. Integral rank => rank -> Base -> Base
^# Base
hyperExponent
	where
		(^#) :: Integral rank => rank -> HyperExponent -> Base
		rank
r ^# :: rank -> Base -> Base
^# Base
0	= case rank
r of
			rank
1 {-addition-}		-> Base
base
			rank
2 {-multiplication-}	-> Base
0
			rank
_			-> Base
1
		rank
r ^# Base
e	= case rank
r of
			rank
0 {-succession-}	-> Base -> Base
forall a. Enum a => a -> a
succ {-fromIntegral-} Base
e
			rank
1 {-addition-}		-> Base
base Base -> Base -> Base
forall a. Num a => a -> a -> a
+ {-fromIntegral-} Base
e
			rank
2 {-multiplication-}	-> Base
base Base -> Base -> Base
forall a. Num a => a -> a -> a
* {-fromIntegral-} Base
e
			rank
3 {-exponentiation-}	-> Base
base Base -> Base -> Base
forall a b. (Num a, Integral b) => a -> b -> a
^ Base
e
			rank
4 {-tetration-}		-> Base
base Base -> Base -> Base
forall base hyperExponent.
(Integral base, Integral hyperExponent, Show base) =>
base -> hyperExponent -> base
`powerTower` Base
e
			rank
_
				| Base
e' Base -> Base -> Bool
forall a. Eq a => a -> a -> Bool
== Base
e	-> Int
tetration Int -> Base -> Base
forall rank. Integral rank => rank -> Base -> Base
^# Base
e'	-- To which it would otherwise be reduced by laborious recursion.
				| Bool
otherwise	-> rank -> rank
forall a. Enum a => a -> a
pred rank
r rank -> Base -> Base
forall rank. Integral rank => rank -> Base -> Base
^# Base
e'
				where
					e' :: Base
e'	= {-fromIntegral $-} rank
r rank -> Base -> Base
forall rank. Integral rank => rank -> Base -> Base
^# Base -> Base
forall a. Enum a => a -> a
pred Base
e

-- | The /Ackermann-Peter/-function; <https://en.wikipedia.org/wiki/Ackermann_function#Ackermann_numbers>.
ackermannPeter :: (Integral rank, Show rank) => rank -> HyperExponent -> Base
ackermannPeter :: rank -> Base -> Base
ackermannPeter rank
rank	= Base -> Base -> Base
forall a. Num a => a -> a -> a
subtract Base
3 (Base -> Base) -> (Base -> Base) -> Base -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. rank -> Base -> Base -> Base
forall rank.
(Integral rank, Show rank) =>
rank -> Base -> Base -> Base
hyperoperation rank
rank Base
2 {-base-} (Base -> Base) -> (Base -> Base) -> Base -> Base
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base -> Base -> Base
forall a. Num a => a -> a -> a
+ 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 :: Base -> Base -> [rank] -> Bool
areCoincidental Base
_ Base
_ []				= Bool
True
areCoincidental Base
_ Base
_ [rank
_]				= Bool
True
areCoincidental Base
base Base
hyperExponent [rank]
ranks	= (Base -> Bool) -> [Base] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Base -> Base -> Bool
forall a. Eq a => a -> a -> Bool
== Base
h) [Base]
hs	where
	(Base
h : [Base]
hs)	= (rank -> Base) -> [rank] -> [Base]
forall a b. (a -> b) -> [a] -> [b]
map (\rank
rank -> rank -> Base -> Base -> Base
forall rank.
(Integral rank, Show rank) =>
rank -> Base -> Base -> Base
hyperoperation rank
rank Base
base Base
hyperExponent) [rank]
ranks