-- |
-- Module:      Math.NumberTheory.Canon.SpecialFunctions
-- Copyright:   (c) 2018-2019 Frederick Schneider
-- Licence:     MIT
-- Maintainer:  Frederick Schneider <fws.nyc@gmail.com>
-- Stability:   Provisional
--
-- This module defines numerous functions associated with massive numbers.
-- This is an excellent resource: http://googology.wikia.com/wiki/Googology_Wiki

module Math.NumberTheory.Canon.SpecialFunctions (
  moserFunc,
  moserTriangle,
  moserSquare,
  moserPentagon,
  mega,
  megiston,
  moser,
  knuth,
  conwayChain,
  conwayGuy,
  genGrahamFunc,
  grahamFunc,
  grahamsNumber,
  ackermann,
  ackermann3
  -- , sudan
)
where

import Math.NumberTheory.Canon

moserFunc :: Canon -> Canon -> Canon -> Canon
moserTriangle, moserSquare :: Canon -> Canon
moserPentagon, mega, megiston, moser :: Canon

-- | Generalized Moser function: https://en.wikipedia.org/wiki/Steinhaus%E2%80%93Moser_notation
moserFunc nP mP pP
  | cIntegral nP && cIntegral mP && cIntegral pP && nP >= c1 && pP >= c3
              = m' nP mP pP
  | otherwise = error "The parameters to the Moser function must all be integral with n >= 1 and p >= 3."
  where m' n m p | n < 1     = error "n must be >= 1 in the Moser function"
                 | m > c1    = m' (m' n c1 p) (m-c1) p
                 | p > c3    = m' n           n     (p-c1)
                 | otherwise = n <^ n
-- to do: non-recursive definition?

-- | Moser Triangle (see Wikipedia link above)
moserTriangle n = moserFunc n c1 c3

-- | Moser Square (see Wikipedia link above)
moserSquare n   = moserFunc n c1 c4

-- | Moser Pentagon (see Wikipedia link above)
moserPentagon = mega

-- | Mega: "2 in a circle" (see Wikipedia link above) 
mega          = moserFunc c2  c1 c5

-- | Megiston: "10 in a circle" (see Wikipedia link above) 
megiston      = moserFunc c10 c1 c5
                where c10 = makeCanon 10

-- | Moser number; "2 in a mega-gon" (see Wikipedia link above)
moser         = moserFunc c2 c1 mega

ackermann :: Canon -> Canon -> Canon
ackermann3 :: Canon -> Canon -> Canon -> Canon

-- | <https://en.wikipedia.org/wiki/Ackermann_function Ackermann function>
ackermann m n
  | cIntegral m && cIntegral n && m >= c0 && n >= c0
              = a m n
  | otherwise = error "m and n must both be integral in the Ackermann function with m >= 0 and n >= 0"
  where a m' n' | m' == c0            = n' + c1
                | m' < c3 && n' == c0 = a (m' - c1) c1
                | m' < c3             = a (m' - c1) $ a m' (n - c1)
                | otherwise           = -3 + conwayChain [2, n+3, m-2]

-- | The original 3 parameter Ackermann function 
ackermann3 mP nP pP
  | cIntegral mP && cIntegral nP && cIntegral pP && nP >= c0 && pP >= c0
              = a3 mP nP pP
  | otherwise = error "m, n and p must all be integral in the Ackermann3 function"
  where a3 m n p | n < c0 || p < c0 = error "ackermann3 Both n and p must be >= 0"
                 | p == c0           = m + n
                 | p == c1           = m * n
                 | p == c2           = m <^ n
                 | p == c3           = m <^> (n + c1)
                 | n == c0           = m
                 | p == c4 && n == 2 = m <^> (1 + m <^> (m + c1)) -- Found while testing.  Helps along calculation 
                 | p == c4 && n > 2  = m <^> (1 + a3 m (n - c1) p)
                 | otherwise         = a3 m (a3 m (n - c1) p) (p - c1)

{- Status
 ackermann3 2 2 4 = 2 <^> 17  -- could also be written as 2 <^> (1 + 2<^>3) so this is between 2 <<^>> 3 and 2 <<^>> 4
 ackermann3 2 3 4 = 2 <^> {1 + 2 <^> 17}
 ackermann3 2 4 4 ... Generated error saying special cases in cHyperOp not covered when more than two items.  XXX
 ackermann3 3 2 4 = 3 <^> (1 + 3 <^> (2*2))
 ackermann3 3 3 4 ... Hung initially but workaround added 
 ackermann3 7 3 4 = 7 <^> {1 + 7 <^> {1 + 7 <^> (2^3)}} 
 ackermann3 5 4 4 = 5 <^> {1 + 5 <^> {1 + 5 <^> {1 + 5 <^> (2 * 3)}}} -- note the folding based on the second term

 ackermann3 2 2 5 ... Hangs

 Here's why (stepping through the logic)
 a3 2 2 5 = a3 2 (a3 2 1 5) 4
 where a3 2 1 5 = a3 2 (a3 2 0 5) 4 = a3 2 2 4

 a3 2 2 5 = a3 2 (a3 2 2 4) 4 = a3 2 (2<^>17) 4.  So, this folding step would have to be done an incredible number of times.

 ToDo: Is there an elegant closed form expression? x n 4 is between x <<^>> n+ 1 and x <<^>> n + 2.
-}

{- ToDo: Fix and add later
-- | The Sudan function created by Gabriel Sudan, a student of David Hilbert (https://en.wikipedia.org/wiki/Sudan_function)
sudan :: Canon -> Canon -> Canon -> Canon
sudan n x y | not (cIntegral n) || not (cIntegral x) || not (cIntegral y) || n < 0 || x < 0 || y < 0 
                        = error "All input to the sudan function must be integral and >= 0"
            | otherwise = s n x y 
            where s n x y | n == 0          = x + y
                          | n > 0 && y == 0 = x
                          | n == 1          = s c1 c0 y + x * 2 <^ y
                          | otherwise       = s (n-1) snxym1 (snxym1 + y)
                           where snxym1 = s n x (y-1) 
-}

genGrahamFunc :: Canon -> Integer -> Canon
grahamFunc :: Integer -> Canon
grahamsNumber :: Canon

-- | Calls the generalized Graham function with value 3
grahamFunc = genGrahamFunc c3

-- | <https://en.wikipedia.org/wiki/Graham%27s_number Graham's Number>
grahamsNumber = grahamFunc 64

-- | Generalized Graham Function
genGrahamFunc cP nP
  | cIntegral cP && cP >= c1 && nP >= 1
              = gGF cP nP
  | otherwise = error "c and n must be Integral and both c and n >= 1 in the generalized Graham function"
  where gGF c n | n > 1     = cApplyHy (gGF c (n -1)) [c,c] True -- recursively defined
                | otherwise = c <<<^>>> c -- Hexation or 4 arrows

knuth :: Canon -> Canon -> Canon -> Canon

-- | <https://en.wikipedia.org/wiki/Knuth%27s_up-arrow_notation Knuth's Up Arrow Notation>, analagous to hyperoperations
knuth a n b        = cApplyHy (c2 + n) [a,b] True

-- | <https://en.wikipedia.org/wiki/Conway_chained_arrow_notation Conway Chained-Arrow Notation>: 
--   This function will try to reduce generalized conway chain notation down to humble hyperoperations (or better).
conwayChain :: [Canon] -> Canon
conwayChain l'
  | all (\c -> cIntegral c && c > c0) l' = cc l'
  | otherwise                            = error "ConwayChain: Each element in the input list/chain must be integral and > 0"
  where cc ch | null ch       = error "Logic Error: conwayChain requires a non-zero list."
              | head ch == c1 = c1
              | otherwise     = f (takeWhile (/= c1) ch)
        f c   = case l of
                0 -> c1 -- in this context we have stripped out the 1s so we can assume 1
                1 -> p
                2 -> p <^ q
                3 -> knuth p r q -- "simple" hyperoperation

                     -- Beyond length 3, we may never come back. Note: We string out the 1s
                _ |  p == c2 && q == c2 -> c4 -- Property #6
                  |  otherwise          -> cc $ x ++ [cc (x ++ [s-1, v])] ++ [v-1] -- Rule #4 
                where l         = length c
                      (p, q, r) = (head c, c !! 1, c!! 2)
                      x         = take (l-2) c -- x is like the prefix chain from the wiki formula
                      (s, v)    = (c !! (l-2), last c) -- second to last AND "very" last terms

-- Note: conwayChain [x,2,2,2] = x <H(x^2 + 1)> x.  (e.g. conwayChain [3,2,2,2] = 3 ~^~ 3, which is the hyperoperator for level 10)

{-  Some low-level level 4 examples

v = map (\l -> (l, conwayChain $ map makeCanon l)) [[3,2,2,2], [3,2,3,2], [3,3,2,2], [3,3,3,2],  [3,2,2,3], [3,3,2,3]]
mapM_ (putStrLn . show) v
([3,2,2,2],  3 ~^~ 3)  -- Level 10 = 3^2 + 1 Hyper Operation.  Note: The library converts: x <HO: h> 2 TO x <HO: h-1> x

([3,2,3,2], 3 <H{1 + 3 ~^~ 3}> 3)  -- which is 3 <H{1 + conwayChain[3,2,2,2])> 3

([3,3,2,2],3 ~~|<<<<^>>>>|~~ 3) -- Level 29 = 3^3 + 2 Hyper Operation

([3,3,3,2],3 <H{2 + 3 ~~|<<<<^>>>>|~~ 3}> 3)  -- which is  3 <H{2 + conwayChain[3,3,2,2])> 3

([3,2,2,3],3 <H{1 + 3 <H{1 + 3 <H{1 + 3 <H{1 + 3 <H{1 + 3 <H{1 + 3 <H{1 + 3 ~^~ 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3)

([3,3,2,3],3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 <H{2 + 3 ~~|<<<<^>>>>|~~ 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3}> 3)

Note: conwayChain [3,3,3,3] = conwayChain [3,3, [3,3,2,3], 2] so you have to iteratively embed the hyper operations a massive number of times
Note: For perspective, Graham's number has been shown to be between [3,3,64,2] and [3,3,65,2]!
-}

conwayGuy :: Canon -> Canon

-- | Conway-Guy function is a conwayChain of n copies of n.  
conwayGuy n = conwayChain (replicate (fromIntegral n) n)

-- Kind of unrelated but interesting: goodstein rep: https://en.wikipedia.org/wiki/Knuth%27s_up-arrow_notation#Numeration_systems_based_on_the_hyperoperation_sequence