module Math.NumberTheory.Powers.Cubes
( integerCubeRoot
, integerCubeRoot'
, exactCubeRoot
, isCube
, isCube'
, isPossibleCube
) where
#include "MachDeps.h"
import Data.Array.Unboxed
import Data.Array.Base
import Data.Array.ST
import Data.Bits
#if __GLASGOW_HASKELL__ < 705
import Data.Word
#endif
import GHC.Base
import GHC.Integer
import GHC.Integer.GMP.Internals
import Math.NumberTheory.Logarithms.Internal (integerLog2#)
#if __GLASGOW_HASKELL__ < 707
import Math.NumberTheory.Utils (isTrue#)
#endif
integerCubeRoot :: Integral a => a -> a
integerCubeRoot 0 = 0
integerCubeRoot n
| n > 0 = integerCubeRoot' n
| otherwise =
let m = negate n
r = if m < 0
then negate . fromInteger $ integerCubeRoot' (negate $ fromIntegral n)
else negate (integerCubeRoot' m)
in if r*r*r == n then r else (r1)
integerCubeRoot' :: Integral a => a -> a
integerCubeRoot' 0 = 0
integerCubeRoot' n = newton3 n (approxCuRt n)
exactCubeRoot :: Integral a => a -> Maybe a
exactCubeRoot 0 = Just 0
exactCubeRoot n
| n < 0 =
if m < 0
then fmap (negate . fromInteger) $ exactCubeRoot (negate $ fromIntegral n)
else fmap negate (exactCubeRoot m)
| isPossibleCube n && r*r*r == n = Just r
| otherwise = Nothing
where
m = negate n
r = integerCubeRoot' n
isCube :: Integral a => a -> Bool
isCube 0 = True
isCube n
| n > 0 = isCube' n
| m > 0 = isCube' m
| otherwise = isCube' (negate (fromIntegral n) :: Integer)
where
m = negate n
isCube' :: Integral a => a -> Bool
isCube' !n = isPossibleCube n
&& (r*r*r == n)
where
r = integerCubeRoot' n
isPossibleCube :: Integral a => a -> Bool
isPossibleCube !n =
unsafeAt cr512 (fromIntegral n .&. 511)
&& unsafeAt cubeRes837 (fromIntegral (n `rem` 837))
&& unsafeAt cubeRes637 (fromIntegral (n `rem` 637))
&& unsafeAt cubeRes703 (fromIntegral (n `rem` 703))
cubeRootInt' :: Int -> Int
cubeRootInt' 0 = 0
cubeRootInt' n
| n < c || c < 0 = r1
| 0 < d && d < n = r+1
| otherwise = r
where
x = fromIntegral n :: Double
r = truncate (x ** (1/3))
c = r*r*r
d = c+3*r*(r+1)
cubeRootWord :: Word -> Word
cubeRootWord 0 = 0
cubeRootWord w
#if WORD_SIZE_IN_BITS == 64
| r > 2642245 = 2642245
#else
| r > 1625 = 1625
#endif
| w < c = r1
| c < w && e < w && c < e = r+1
| otherwise = r
where
r = truncate ((fromIntegral w) ** (1/3) :: Double)
c = r*r*r
d = 3*r*(r+1)
e = c+d
cubeRootIgr :: Integer -> Integer
cubeRootIgr 0 = 0
cubeRootIgr n = newton3 n (approxCuRt n)
newton3 :: Integral a => a -> a -> a
newton3 n a = go (step a)
where
step k = (2*k + n `quot` (k*k)) `quot` 3
go k
| m < k = go m
| otherwise = k
where
m = step k
approxCuRt :: Integral a => a -> a
approxCuRt 0 = 0
approxCuRt n = fromInteger $ appCuRt (fromIntegral n)
#if WORD_SIZE_IN_BITS == 64
#define THRESH 5
#else
#define THRESH 9
#endif
appCuRt :: Integer -> Integer
appCuRt (S# i#) = case double2Int# (int2Double# i# **## (1.0## /## 3.0##)) of
r# -> S# r#
#if __GLASGOW_HASKELL__ < 709
appCuRt n@(J# s# _)
| isTrue# (s# <# THRESH#) = floor (fromInteger n ** (1.0/3.0) :: Double)
#else
appCuRt n@(Jp# bn#)
| isTrue# ((sizeofBigNat# bn#) <# THRESH#) =
floor (fromInteger n ** (1.0/3.0) :: Double)
#endif
| otherwise = case integerLog2# n of
l# -> case (l# `quotInt#` 3#) -# 51# of
h# -> case shiftRInteger n (3# *# h#) of
m -> case floor (fromInteger m ** (1.0/3.0) :: Double) of
r -> shiftLInteger r h#
#if __GLASGOW_HASKELL__ >= 709
appCuRt _ = error "integerCubeRoot': negative argument"
#endif
cr512 :: UArray Int Bool
cr512 = runSTUArray $ do
ar <- newArray (0,511) True
let note s i
| i < 512 = unsafeWrite ar i False >> note s (i+s)
| otherwise = return ()
note 4 2
note 8 4
note 32 16
note 64 32
note 256 128
unsafeWrite ar 256 False
return ar
cubeRes837 :: UArray Int Bool
cubeRes837 = runSTUArray $ do
ar <- newArray (0,836) False
let note 837 = return ar
note k = unsafeWrite ar ((k*k*k) `rem` 837) True >> note (k+1)
note 0
cubeRes637 :: UArray Int Bool
cubeRes637 = runSTUArray $ do
ar <- newArray (0,636) False
let note 637 = return ar
note k = unsafeWrite ar ((k*k*k) `rem` 637) True >> note (k+1)
note 0
cubeRes703 :: UArray Int Bool
cubeRes703 = runSTUArray $ do
ar <- newArray (0,702) False
let note 703 = return ar
note k = unsafeWrite ar ((k*k*k) `rem` 703) True >> note (k+1)
note 0