In ghci, using the arithmoi package:
Math.NumberTheory.Powers.General> :set +s
Math.NumberTheory.Powers.General> integerRoot 786 ((10^32)^786)
100000000000000000000000000000000
(0.04 secs, 227,064 bytes)
Math.NumberTheory.Powers.General> integerRoot 787 ((10^32)^787)
After five minutes, it still hasn't responded. Why is it taking so long?
(From some ad-hoc testing, it appears to be slow for all choices larger than 787 and fast for all choices smaller.)
arithmoi implements integerRoot by getting an initial approximate root and refining its guess with Newton’s method. For (1032)786, the second approximation gets a really good starting point:
> appKthRoot 786 ((10^32)^786)
100000000000000005366162204393472
For (1032)787, the second approximation gets a really bad starting point. Like, really bad.
> appKthRoot 787 ((10^32)^787)
1797693134862315907729305190789024733617976978942306572734300811577326758055009
6313270847732240753602112011387987139335765878976881441662249284743063947412437
7767893424865485276302219601246094119453082952085005768838150682342462881473913
110540827237163350510684586298239947245938479716304835356329624224137216
It actually gets this approximation for everything starting there.
> length $ nub [appKthRoot x ((10^32)^x) | x <- [787..1000]]
1
Anyway, putting in the important parts of appKthRoot, we get:
> let h = 106; k = 786; n = (10^32)^k; !(I# s) = h * k - k in floor (scaleFloat (h - 1) (fromInteger (n `shiftRInteger` s) ** (1/fromIntegral k) :: Double))
100000000000000005366162204393472
> let h = 106; k = 787; n = (10^32)^k; !(I# s) = h * k - k in floor (scaleFloat (h - 1) (fromInteger (n `shiftRInteger` s) ** (1/fromIntegral k) :: Double))
179769313486231590772930519078902473361797697894230657273430081157732675805500963132708477322407536021120113879871393357658789768814416622492847430639474124377767893424865485276302219601246094119453082952085005768838150682342462881473913110540827237163350510684586298239947245938479716304835356329624224137216
and taking a look at what’s going into scaleFloat:
> let h = 106; k = 786; n = (10^32)^k; !(I# s) = h * k - k in fromInteger (n `shiftRInteger` s) ** (1/fromIntegral k) :: Double
2.465190328815662
> let h = 106; k = 787; n = (10^32)^k; !(I# s) = h * k - k in fromInteger (n `shiftRInteger` s) ** (1/fromIntegral k) :: Double
Infinity
Yeah, that’d do it. (1032)786 ÷ 282530 ≈ 21023.1 fits in a double, but (1032)787 ÷ 282635 ≈ 21024.4 does not.
Related
The number π can be calculated with the following infinite series sum:
I want to define a Haskell function roughlyPI that, given a natural number k, calculates the series sum from 0 to the k value.
Example: roughlyPi 1000 (or whatever) => 3.1415926535897922
What I did was this (in VS Code):
roughlyPI :: Double -> Double
roughlyPI 0 = 2
roughlyPI n = e1/e2 + (roughlyPI (n-1))
where
e1 = 2**(n+1)*(factorial n)**2
e2 = factorial (2*n +1)
factorial 0 = 1
factorial n = n * factorial (n-1)
but it doesn't really work....
*Main> roughlyPI 100
NaN
I don't know what's wrong. I'm new to Haskell, by the way.
All I really want is to be able to type in a number that will give me PI at the end. It can't be that hard...
As mentioned in the comments, we need to avoid large divisions and instead intersperse smaller divisions within the factorials. We use Double for representing PI but even Double has its limits. For instance 1 / 0 == Infinity and (1 / 0) / (1 / 0) == Infinity / Infinity == NaN.
Luckily, we can use algebra to simplify the formula and hopefully delay the blowup of our Doubles. By dividing within our factorial the numbers don't grow too unwieldy too quickly.
This solution will calculate roughlyPI 1000, but it fails on 1023 with NaN because 2 ^ 1024 :: Double == Infinity. Note how each iteration of fac has a division as well as a multiplication to help keep the numbers from blowing up. If you are trying to approximate PI with a computer, I believe there are better algorithms, but I tried to keep it as conceptually close to your attempt as possible.
roughlyPI :: Integer -> Double
roughlyPI 0 = 2
roughlyPI k = e + roughlyPI (k - 1)
where
k' = fromIntegral k
e = 2 ** (k' + 1) * fac k / (2 * k' + 1)
where
fac 1 = 1 / (k' + 1)
fac p = (fromIntegral p / (k' + fromIntegral p)) * fac (p - 1)
We can do better than having a blowup of Double after 1000 by doing computations with Rationals then converting to Double with realToFrac (credit to #leftaroundabout):
roughlyPI' :: Integer -> Double
roughlyPI' = realToFrac . go
where
go 0 = 2
go k = e + go (k - 1)
where
e = 2 ^ (k + 1) * fac k / (2 * fromIntegral k + 1)
where
fac 1 = 1 % (k + 1)
fac p = (p % (k + p)) * fac (p - 1)
For further reference see Wikipedia page on approximations of PI
P.S. Sorry for the bulky equations, stackoverflow does not support LaTex
First note that your code actually works:
*Main> roughlyPI 91
3.1415926535897922
The problem, as was already said, is that when you try to make the approximation better, the factorial terms become too big to be representable in double-precision floats. The simplest – albeit somewhat brute-force – way to fix that is to do all the computation in rational arithmetic instead. Because numerical operations in Haskell are polymorphic, this works with almost the same code as you have, only the ** operator can't be used since that allows fractional exponents (which are in general irrational). Instead, you should use integer exponents, which is anyway the conceptually right thing. That requires a few fromIntegral:
roughlyPI :: Integer -> Rational
roughlyPI 0 = 2
roughlyPI n = e1/e2 + (roughlyPI (n-1))
where
e1 = 2^(n+1)*fromIntegral (factorial n^2)
e2 = fromIntegral . factorial $ 2*n + 1
factorial 0 = 1
factorial n = n * factorial (n-1)
This now works also for much higher degrees of approximation, although it takes a long time to carry around the giant fractions involved:
*Main> realToFrac $ roughlyPI 1000
3.141592653589793
The way to go in such cases is to calculate the ratio of consecutive terms and calculate the terms by rolling multiplications of the ratios:
-- 1. -------------
pi1 n = Sum { k = 0 .. n } T(k)
where
T(k) = 2^(k+1)(k!)^2 / (2k+1)!
-- 2. -------------
ts2 = [ 2^(k+1)*(k!)^2 / (2k+1)! | k <- [0..] ]
pis2 = scanl1 (+) ts2
pi2 n = pis2 !! n
-- 3. -------------
T(k) = 2^(k+1)(k!)^2 / (2k+1)!
T(k+1) = 2^(k+2)((k+1)!)^2 / (2(k+1)+1)!
= T(k) 2 (k+1)^2 / (2k+2) (2k+3)
= T(k) (k+1)^2 / ( k+1) (2k+3)
= T(k) (k+1) / (k+1 + k+2)
= T(k) / (1 + (k+2)/(k+1))
= T(k) / (2 + 1 /(k+1))
-- 4. -------------
ts4 = scanl (/) 2 [ 2 + 1/(k+1) | k <- [0..]] :: [Double]
pis4 = scanl1 (+) ts4
pi4 n = pis4 !! n
This way we share and reuse the calculations as much as possible. This leads to the most efficient code, hopefully leading to the smallest cumulative numerical error. The formula also turned out to be exceptionally simple, and could even be simplified further as ts5 = scanl (/) 2 [ 2 + recip k | k <- [1..]].
Trying it out:
> pis2 = scanl1 (+) $ [ fromIntegral (2^(k+1))*fromIntegral (product[1..k])^2 /
fromIntegral (product[1..(2*k+1)]) | k <- [0..] ] :: [Double]
> take 8 $ drop 30 pis2
[3.1415926533011587,3.141592653447635,3.141592653519746,3.1415926535552634,
3.141592653572765,3.1415926535813923,3.141592653585647,3.141592653587746]
> take 8 $ drop 90 pis2
[3.1415926535897922,3.1415926535897922,NaN,NaN,NaN,NaN,NaN,NaN]
> take 8 $ drop 30 pis4
[3.1415926533011587,3.141592653447635,3.141592653519746,3.1415926535552634,
3.141592653572765,3.1415926535813923,3.141592653585647,3.141592653587746]
> take 8 $ drop 90 pis4
[3.1415926535897922,3.1415926535897922,3.1415926535897922,3.1415926535897922,
3.1415926535897922,3.1415926535897922,3.1415926535897922,3.1415926535897922]
> pis4 !! 1000
3.1415926535897922
In Haskell, ridge regression can be expressed as:
import Numeric.LinearAlgebra
createReadout :: Matrix Double → Matrix Double → Matrix Double
createReadout a b = oA <\> oB
where
μ = 1e-4
oA = (a <> (tr a)) + (μ * (ident $ rows a))
oB = a <> (tr b)
However, this operation is very memory expensive. Here is a minimalistic example that requires more than 2GB on my machine and takes 3 minutes to execute.
import Numeric.LinearAlgebra
import System.Random
createReadout :: Matrix Double -> Matrix Double -> Matrix Double
createReadout a b = oA <\> oB
where
mu = 1e-4
oA = (a <> (tr a)) + (mu * (ident $ rows a))
oB = a <> (tr b)
teacher :: [Int] -> Int -> Int -> Matrix Double
teacher labelsList cols' correctRow = fromBlocks $ f <$> labelsList
where ones = konst 1.0 (1, cols')
zeros = konst 0.0 (1, cols')
rows' = length labelsList
f i | i == correctRow = [ones]
| otherwise = [zeros]
glue :: Element t => [Matrix t] -> Matrix t
glue xs = fromBlocks [xs]
main :: IO ()
main = do
let n = 1500 -- <- The constant to be increased
m = 10000
cols' = 12
g <- newStdGen
-- Stub data
let labels = take m . map (`mod` 10) . randoms $ g :: [Int]
a = (n >< (cols' * m)) $ take (cols' * m * n) $ randoms g :: Matrix Double
teachers = zipWith (teacher [0..9]) (repeat cols') labels
b = glue teachers
print $ maxElement $ createReadout a b
return ()
$ cabal exec ghc -- -O2 Test.hs
$ time ./Test
./Test 190.16s user 5.22s system 106% cpu 3:03.93 total
The problem is to increase the constant n, at least to n = 4000, while RAM is limited by 5GB. What is minimal space that matrix inversion operation requires in theory? How can this operation be optimized in terms of space? Can ridge regression be efficiently replaced with a cheaper method?
Simple Gauss-Jordan elimination only takes space to store the input and output matrices plus constant auxiliary space. If I'm reading correctly, the matrix oA you need to invert is n x n so that's not a problem.
Your memory usage is completely dominated by storing the input matrix a, which uses at least 1500 * 120000 * 8 = 1.34 GB. n = 4000 would be 4000 * 120000 * 8 = 3.58 GB which is over half of your space budget. I don't know what matrix library you are using or how it stores its matrices, but if they are on the Haskell heap then GC effects could easily account for another factor of 2 in space usage.
Well you can get away with 3*m + nxn space, but how numerically stable this will be I'm not sure.
The basis is the identity
inv( inv(Q) + A'*A)) = Q - Q*A'*R*A*Q
where R = inv( I + A*Q*A')
If A is your A matrix and
Q = inv( mu*I*mu*I) = I/(mu*mu)
then the solution to your ridge regression is
inv( inv(Q) + A'*A)) * A'*b
A little more algebra shows
inv( inv(Q) + A'*A)) = (I - A'*inv( (mu2 + A*A'))*A)/mu2
where mu2 = mu*m
Note that since A is n x m, A*A' is n x n.
So one algorithm would be
Compute C = A*A' + mu2
Do a cholesky decompostion of C, ie find upper triangular U so that U'*U = C
Compute the vector y = A'*b
Compute the vector z = A*y
Solve U'*u = z for u in z
Solve U*v = z for v in z
compute w = A'*z
Compute x = (y - w)/mu2.
Please help, I've been trying to get this code to work but I can't find the errors. Below is my code
sumToN f x 1 = f (x 1)
sumToN f x n = f x n + f x (n-1)
facOfN 0 = 1
facOfN n = n * facOfN (n-1) sgfr
sineApprox x n = ((-1) ^ n) * ((x ** (2*n+1))/facOfN(2*n+1)
sine x n = sumToN (sineApprox x n)
When I try to load the file I get the following error.
ERROR file:F:\sine.hs:8 - Syntax error in expression (unexpected `;', possibly due to bad layout)
Any assistance would be greatly appreciated.
As already said in the comments, you've forgotten to close a paren. It'll work like that:
sineApprox x n = ((-1) ^ n) * ((x ** (2*n+1))/facOfN(2*n+1))
Note that this problem would have been obvious with a better text editor. Being a beginner, I suggest you switch to iHaskell, which has a very simple interface and yet reasonably powerful editor features.
The problem would also have been obvious if you hadn't used so many unnecessary parens. The following can be omitted just like that, some can be replaced with $. While we're at style...
sumToN f x n -- checking ==1 is not safe in general
| n<=1 = f $ x 1
| otherwise = f x n + f x (n-1)
facOfN = product [1..n]
sineApprox x n = (-1)^n * x**(2*n+1) / facOfN (2*n+1)
sine x = sumToN . sineApprox x
On another note: in general, you should always use type signatures. This code actually has problems because all the counter variables are automaticall floating point (like everything else). They should really be Ints, which requires a conversions in the factorial†:
sumToN :: Num n => (Int -> n) -> Int -> n
sumToN f x n
| n<1 = 0
| otherwise = f x n + f x (n-1)
facOfN :: Num n => Int -> n
facOfN = product [1 .. fromIntegral n]
sineApprox :: Fractional n => n -> Int -> n
sineApprox x n = (-1)^n * x^(2*n+1) / facOfN (2*n+1)
sine
sine x = sumToN . sineApprox x
†BTW, explicitly using factorials is almost always a bad idea, as the numbers quickly get intractibly huge. Also, you're doing a lot of duplicate work. Better multiply as you add along!
I have some natural number c. I want to find all pairs of natural numbers a and b, where a < b, such as a * b = c.
I have a solution:
solve c = do solveHelper [1..c] c where
solveHelper xs c = do
x <- xs
(division, modulo ) <- return (c `divMod` x)
True <- return (modulo == 0)
True <- return (x <= division)
return (x, division)
Example:
*Main> solve 10
[(1,10),(2,5)]
Is there a way to accelerate my code, or a better algorithm I should use?
You can do much, much better. The basic idea is this: first, factorize the number; then enumerate the partitions of the factorization. The product of each partition is a solution. There are fast factorization algorithms out there, but even the naive one is quite an improvement on your code; so:
factorize :: Integer -> [Integer]
factorize n
| n < 1 = error "no. =("
| otherwise = go 2 n
where
go p n | p * p > n = [n]
go p n = case quotRem n p of
(q, 0) -> p:go p q
_ -> go (p+1) n
I will use the very nice multiset-comb package to compute partitions of the set of factors. It doesn't support the usual Foldable/Traversable stuff out of the box, so we have to roll our own product operation -- but in fact this can be a bit more efficient than using the product that the standard interface would give us anyway.
import Math.Combinatorics.Multiset
productMS :: Multiset Integer -> Integer
productMS (MS cs) = product [n^p | (n, p) <- cs]
divisors :: Integer -> [(Integer, Integer)]
divisors n =
[ (a, b)
| (aMS, bMS) <- splits (fromList (factorize n))
, let a = productMS aMS; b = productMS bMS
, a <= b
]
For unfair timings, we can compare in ghci:
*Main> :set +s
*Main> length $ solve (product [1..10])
135
(3.55 secs, 2,884,836,952 bytes)
*Main> length $ divisors (product [1..10])
135
(0.00 secs, 4,612,104 bytes)
*Main> length $ solve (product [1..15])
^CInterrupted. [after several minutes, I gave up]
*Main> length $ divisors (product [1..15])
2016
(0.03 secs, 33,823,168 bytes)
Here solve is your solution, divisors is mine. For a fair comparison, we should compile; I used this program:
main = print . last . solve . product $ [1..11]
(And similar with divisors in place of solve.) I compiled with -O2; yours used 1.367s total, mine 0.002s total.
There's one optimization you don't use: you don't have to try every value from 0 to c.
a < b and a * b = c, so a * a < c, meaning you only have to try numbers from 0 to sqrt c. Or, if you don't want to compute the square root of c, you can stop as soon as a * a >= c.
To do so, you can replace [1..c] by (takeWhile (\x -> x * x < c) [1..]).
I am trying to solve the problem 2's complement here (sorry, it requires login, but anyone can login with FB/google account). The problem in short is to count the number of ones appearing in the 2's complement representation of all numbers in a given range [A, B] where A and B are within the 32-bit limits (231 in absolute value). I know my algorithm is correct (it's logarithmic in the bigger absolute value, since I already solved the problem in another language).
I am testing the code below on my machine and it's giving perfectly correct results. When it runs on the Amazon server, it gives a few wrong answers (obviously overflows) and also some stack overflows. This is not a bug in the logic here, because I test the same code on my machine on the same test inputs and get different results. For example, for the range [-1548535525, 662630637] I get 35782216444 on my machine, while according to the tests, my result is some negative overflow value.
The only problem I can think of, is that perhaps I am not using Int64 correctly, or I have a wrong assumption about it's operation.
Any help is appreciated. Code is here.
The stack overflows are a bug in the logic.
countOnes !a !b | a == b = countOnes' a
countOnes' :: Int64 -> Integer
countOnes' !0 = 0
countOnes' !a = (fromIntegral (a .&. 1)) + (countOnes' (a `shiftR` 1))
Whenever you call countOnes' with a negative argument, you get a nonterminating computation, since the shiftR is an arithmetic shift and not a logical one, so you always shift in a 1-bit and never reach 0.
But even with a logical shift, for negative arguments, you'd get a result 32 too large, since the top 32 bits are all 1.
Solution: mask out the uninteresting bits before calling countOnes',
countOnes !a !b | a == b = countOnes' (a .&. 0xFFFFFFFF)
There are some superfluous guards in countOnes,
countOnes :: Int64 -> Int64 -> Integer
countOnes !a !b | a > b = 0
-- From here on we know a <= b
countOnes !a !b | a == b = countOnes' (a .&. 0xFFFFFFFF)
-- From here on, we know a < b
countOnes !0 !n = range + leading + (countOnes 0 (n - (1 `shiftL` m)))
where
range = fromIntegral $ m * (1 `shiftL` (m - 1))
leading = fromIntegral $ (n - (1 `shiftL` m) + 1)
m = (getLog n) - 1
-- From here on, we know a /= 0
countOnes !a !b | a > 0 = (countOnes 0 b) - (countOnes 0 (a - 1))
-- From here on, we know a < 0,
-- the guard in the next and the last equation are superfluous
countOnes !a !0 | a < 0 = countOnes (maxInt + a + 1) maxInt
countOnes !a !b | b < 0 = (countOnes a 0) - (countOnes (b + 1) 0)
countOnes !a !b | a < 0 = (countOnes a 0) + (countOnes 0 b)
The integer overflows on the server are caused by
getLog :: Int64 -> Int
--
countOnes !0 !n = range + leading + (countOnes 0 (n - (1 `shiftL` m)))
where
range = fromIntegral $ m * (1 `shiftL` (m - 1))
leading = fromIntegral $ (n - (1 `shiftL` m) + 1)
m = (getLog n) - 1
because the server has a 32-bit GHC, while you have a 64-bit one. The shift distance/bit width m is an Int (and because it's used as the shift distance, it has to be).
Therefore
m * (1 `shiftL` (m-1))
is an Int too. For m >= 28, that overflows a 32-bit Int.
Solution: remove a $
range = fromIntegral m * (1 `shiftL` (m - 1))
Then the 1 that is shifted is an Integer, hence no overflow.