|
@@ -1,55 +1,46 @@
|
|
|
|
|
|
module Logic (hexDigits) where
|
|
|
|
|
|
-import Control.Parallel (par)
|
|
|
-import Data.Char (intToDigit)
|
|
|
-import Numeric (showIntAtBase)
|
|
|
+import Data.Bits (testBit, shiftR)
|
|
|
+import Control.Parallel.Strategies
|
|
|
|
|
|
|
|
|
|
|
|
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))
|
|
|
+ summation = (4 * sumPi n 1) - (2 * sumPi n 4) - (sumPi n 5) - (sumPi n 6)
|
|
|
in
|
|
|
- floor (16 * skimmedSum) :: Integer
|
|
|
+ floor (16 * skim summation) :: Integer
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
+
|
|
|
sumPi :: Integer -> Integer -> Double
|
|
|
sumPi n x =
|
|
|
let
|
|
|
- summation1 = sum [(fromIntegral (fastModExp 16 (n-k) ((8*k)+x))) / (fromIntegral ((8*k)+x)) | k <- [0..n]]
|
|
|
- summation2 = sum [16^^(n-k) / (fromIntegral ((8*k)+x)) | k <- [(n+1)..5000]]
|
|
|
+ summation1 = sum ([skim $ (fromIntegral (modExp 16 (n-k) ((8*k)+x))) / (fromIntegral ((8*k)+x)) | k <- [0..n]] `using` parList rseq)
|
|
|
+ summation2 = sum ([skim $ (16^^(n-k)) / (fromIntegral ((8*k)+x)) | k <- [(n+1)..(n+5000)]] `using` parList rseq)
|
|
|
in
|
|
|
summation1 + summation2
|
|
|
|
|
|
|
|
|
+
|
|
|
+skim :: Double -> Double
|
|
|
+skim n
|
|
|
+ | n == (read "Infinity" :: Double) = 0
|
|
|
+ | otherwise = n - fromIntegral (floor n :: Integer)
|
|
|
+
|
|
|
+
|
|
|
|
|
|
hexDigits :: [Integer]
|
|
|
hexDigits = [hexPi x | x <- [0..]]
|
|
|
|
|
|
|
|
|
|
|
|
-fastModExp :: Integer -> Integer -> Integer -> Integer
|
|
|
-fastModExp a b c =
|
|
|
+modExp :: Integer -> Integer -> Integer -> Integer
|
|
|
+modExp _ 0 _ = 1
|
|
|
+modExp a b c =
|
|
|
let
|
|
|
-
|
|
|
-
|
|
|
- revBinaryB = reverse (showIntAtBase 2 intToDigit b "")
|
|
|
-
|
|
|
- powersOfA = [a^(2^n) `mod` c | n <- [0..]]
|
|
|
-
|
|
|
-
|
|
|
- bPowersOfA = map (\(_, n) -> n) $ filter (\(char, _) -> char == '1') $ zip revBinaryB powersOfA
|
|
|
+ n = if testBit b 0 then a `mod` c else 1
|
|
|
in
|
|
|
- foldr (\m n -> (m * n) `mod` c) 1 bPowersOfA
|
|
|
+ n * modExp ((a^2) `mod` c) (shiftR b 1) c `mod` c
|