pi-digits/app/Main.hs

module Main where
import Numeric (showHex, showIntAtBase)
import Data.List (isInfixOf, genericIndex)
import Data.List.Split(splitOn)
import Text.Read (readMaybe)
import System.IO (hFlush, stdout)
import Control.Parallel

import Options.Applicative
import Data.Semigroup ((<>))

-- Get the hex digit of Pi at place n.
hexPi :: Integer -> Integer
hexPi n =
  let
    summation = let
      sone = (4 * sumPi n 1)
      sfour = (2 * sumPi n 4)
      sfive = (sumPi n 5)
      ssix = (sumPi n 6)
      in
      sone `par` sfour `par` sfive `par` ssix `par` sone - sfour - sfive - ssix

    skimmedSum = summation - (fromIntegral (floor summation :: Integer)) -- Take only the decimal portion
  in
    floor (16 * skimmedSum) :: Integer


-- Calculate the summation.
-- 5000 is used in place of Infinity. This value drops off quickly, so no need to go too far.
sumPi :: Integer -> Integer -> Double
sumPi n x =
  let
    summation1 = sum [(fromIntegral ((16^(n-k) `mod` ((8*k)+x)))) / (fromIntegral ((8*k)+x)) | k <- [0..n]]
    summation2 = sum [16^^(n-k) / (fromIntegral ((8*k)+x)) | k <- [(n+1)..5000]]
  in
    summation1 + summation2


-- Get a range of digits.
rangePi :: (Integer -> String) -> String -> Maybe Integer -> Maybe Integer -> String
rangePi printFun delim (Just low) (Just high) =
  if low >= high then
    "Error: Please give a proper range."
  else
    init $ foldr (++) [] $ separate (map printFun (drop (fromIntegral low) . take (fromIntegral high) $ hexDigits)) delim
    -- foldl (.) id (map (showString . printFun) (drop (fromIntegral low) . take (fromIntegral high) $ hexDigits)) ""  -- Alternative implementation: not sure about speed

rangePi _ _ _ _ = printErr


-- Separate a list with some delimiter.
separate :: [a] -> a -> [a]
separate (x:xs) delim = x : delim : separate xs delim
separate [] _ = []


-- Check if response is valid, then call the appropriate function.
parseIndex :: (Integer -> String) -> String -> String -> String
parseIndex printFun delim response =
  if (isInfixOf ".." response) then
    let
      range = splitOn ".." response
      low = readMaybe $ range !! 0 :: Maybe Integer
      high = readMaybe $ range !! 1 :: Maybe Integer
    in
      rangePi printFun delim low high
    else do
      case (readMaybe response :: Maybe Integer) of
        Nothing -> printErr
        Just x -> printFun $ hexDigits `genericIndex` x


-- Continuously prompt for input.
prompt :: (Integer -> String) -> String -> IO ()
prompt printFun delim = do
  putStr ">> "
  hFlush stdout
  response <- getLine
  putStrLn $ parseIndex printFun delim response
  prompt printFun delim


-- The list of answers.
hexDigits :: [Integer]
hexDigits = [hexPi x | x <- [0..]]


-- Complain about argument type.
printErr :: String
printErr = "Error: Please give an Integer (ex: 3) or a range (ex: 3..5)."


main :: IO ()
main = argHandle =<< execParser opts
  where
    opts = info (arguments <**> helper)
      ( fullDesc
     <> progDesc "Generate hexadecimal Pi digits.")


-- Arguments to parse.
data Arguments = Arguments
  { eval  :: Maybe String
  , print :: Maybe PrintFunc
  , delimiter :: String}

arguments :: Parser Arguments
arguments = Arguments
      <$> optional ( argument str (
                       help "Evaluate an index/range, and exit."
                       <> (metavar "eval")))
      <*> printFunc
      <*> strOption ( long "delimiter"
                        <> metavar "delim"
                        <> value ""
                        <> help "Delimiter to separate printed values.")



-- Decide which printing function to use.
data PrintFunc = DecPrint | BinPrint

printFunc :: Parser (Maybe PrintFunc)
printFunc = optional (decPrint <|> binPrint)

decPrint :: Parser PrintFunc
decPrint = flag' DecPrint ( long "decimal"
                            <> short 'd'
                            <> help "Output in decimal.")

binPrint :: Parser PrintFunc
binPrint = flag' BinPrint ( long "binary"
                            <> short 'b'
                            <> help "Output in binary.")


-- Handle args, either prompt or eval & quit.
argHandle :: Arguments -> IO ()
argHandle (Arguments toEval outputType delim) = do
  let
    printFunIO =
      case outputType of
        Just DecPrint -> do
          putStrLn "Outputting in decimal."
          return (\n -> show n ++ "")
        Just BinPrint -> do
          putStrLn "Outputting in binary."
          return (\n -> showIntAtBase 2 (\x -> show x !! 0) n "")
        _ -> do
          putStrLn "Outputting in hex."
          return (\n -> showHex n "")
    in do
    printFun <- printFunIO
    case toEval of
      (Just s) -> putStrLn $ parseIndex printFun delim s
      _ -> do
        putStrLn "Enter a digit or range (Ctrl-C to exit)."
        prompt printFun delim