Euler problems/191 to 200
(solution to problem 193)
Revision as of 10:16, 13 December 2009
A couple of notes. I was too lazy to memoize this, so I just ran it twice, once with 15 and then again with 30. I pasted the output of the 15 run into the code. The way to get a handle on this is to just case it out. Ask yourself what can I add to award (n-1) to generate award (n). You can add an O to the end of all of award (n-1). You can add an L to any award (n-1) that doesn't contain an L, and you can add an A to award (n-1) provided it doesn't end with two A's. So the function hasM_LsAndEndsInN_As is just what is needed to cover all of the cases. Henry Laxen April 29, 2008
award 1 = 3 award 15 = 107236 award k = award (k-1) -- + O + sum [ hasM_LsAndEndsInN_As 0 i (k-1) | i<-[0..2] ] -- +L + sum [ hasM_LsAndEndsInN_As i j (k-1) | i<-[0,1], j<-[0,1] ] -- +A hasM_LsAndEndsInN_As 0 0 1 = 1 -- O hasM_LsAndEndsInN_As 1 0 1 = 1 -- L hasM_LsAndEndsInN_As 0 1 1 = 1 -- A hasM_LsAndEndsInN_As _ _ 1 = 0 hasM_LsAndEndsInN_As 0 0 15 = 5768 hasM_LsAndEndsInN_As 0 1 15 = 3136 hasM_LsAndEndsInN_As 0 2 15 = 1705 hasM_LsAndEndsInN_As 1 0 15 = 54736 hasM_LsAndEndsInN_As 1 1 15 = 27820 hasM_LsAndEndsInN_As 1 2 15 = 14071 hasM_LsAndEndsInN_As m n k | m < 0 || n < 0 = 0 | n == 0 = sum [ hasM_LsAndEndsInN_As (m-1) i (k-1) | i<-[0..2]] -- +L + sum [ hasM_LsAndEndsInN_As m i (k-1) | i<-[0..2]] -- +O | n 0 = hasM_LsAndEndsInN_As m (n-1) (k-1) -- + A -- Count awards of length k that have "m" L's in them, and end in "n" A's problem191 n = do let p a b c d = "hasM_LsAndEndsInN_As " ++ concatMap (\y -> (show y) ++ " ") [a,b,c] ++ "= " ++ (show d) putStrLn $ "award " ++ (show n) ++ " = " ++ show (award n) mapM_ (\(i,j) -> putStrLn $ p i j n (hasM_LsAndEndsInN_As i j n)) [ (i,j) | i<-[0..1], j<-[0..2]]
A brief tutorial on solving this problem is available here
Before going through the code below, it is important to have a good understanding of continued fractions. Have a look at the wikipedia article below. Pay particular attention to the secion on semiconvergents, for that is the key to the code in closest2, which calculates the other candidate for closest rational. HenryLaxen May 5, 2008
import Data.List import Data.Ratio -- Continued fraction representations of square roots are periodic -- Here we calculate the periodic expansion squareRootPeriod :: Int -> Int -> Int -> [Int] squareRootPeriod r n d = m : rest where m = truncate ((sqrt (fromIntegral r) + fromIntegral n ) / fromIntegral d) a = n - d * m rest = if d == 1 && n /= 0 then  else squareRootPeriod r (-a) ((r - a ^ 2) `div` d) -- Turn the period into an infinite stream continuedFraction :: [Int] -> [Integer] continuedFraction l = map fromIntegral $ (head l) : (concat $ repeat (tail l)) -- calculate successive convergents as a ratio convergents :: [Integer] -> [Ratio Integer] convergents l = zipWith (%) (drop 2 $ hn) (drop 2 $ kn) where hn = 0:1:zipWith3 (\x y z -> x*y+z) l (tail hn) hn kn = 1:0:zipWith3 (\x y z -> x*y+z) l (tail kn) kn -- here are the guts of the solution -- we calculate convergents until the size of the denominator exceeds -- the given bound. This is one candidate for the closest rational -- approximation. The other candidate is a semiconvergent, which is -- calculated as p3%q3 closest2 :: Integer -> Integer -> [Ratio Integer] closest2 bound n = let a = convergents $ continuedFraction $ squareRootPeriod (fromIntegral n) 0 1 b = takeWhile (\x -> (denominator x) <= bound) a c = reverse b (p:q:_) = c (p1,q1) = (numerator p, denominator p) (p2,q2) = (numerator q, denominator q) p3 = ((bound-q2) `div` q1) * p1 + p2 q3 = ((bound-q2) `div` q1) * q1 + q2 in [p,(p3%q3)] -- pick the ratio returned from closest2 which is -- actually closer to the square root, and return the denominator denomClosest :: Integer -> Integer -> Integer denomClosest bound n = let (l:r:) = closest2 bound n c1 = if abs (l*l - (n%1)) < abs (r*r - (n%1)) then l else r in denominator c1 isSquare :: Integer -> Bool isSquare n = n `elem` takeWhile (<= n) [n*n | n <- [x..] ] where x = floor . sqrt . fromIntegral $ n nonSquares :: Integer -> [Integer] nonSquares k = [ n | n<-[2..k] , (not . isSquare) n] bound = (10^12) problem_192 :: Integer problem_192 = sum $ map (denomClosest bound) (nonSquares 100000)
Square free numbers Before trying to understand the solution below, you may want to have a look at
The Moebius function:
The Inclusion-exclusion principle:
It turns out they are basically the same thing. To count the number of square free numbers less than N, we instead count the number of numbers less than N that have a square factor (are squareFull) , and then subtract that from N. The number of squareFull numbers less than N that have 2^2 = 4 as a factor is just floor (N/4). To that we add (N/9) , (N/25), (N/49) ... The problem is that we have counted some squareFull numbers twice, namely (N/4*9), (N/4*25), (N/9*25) ... We need to exclude those numbers. This goes on an on, we need to include (or re-include) divisors with an odd number of prime square factors, and we need to exclude divisors with an even number of odd prime factors. Not co-incidentally, this is exactly what the Moebius function does. So, another way of writing the answer is:
N = sum floor(N/k^2) * moebius(k) where the sum runs from 1 to sqrt N
Unfortunately, if you try to compute it this way using the mobius function found in the wonderful Maths library ArithmeticFunctions, the Earth will be a cold dark cinder before it finally finishes.
Instead the calculation below computes all primes squared less than 2^50 and stuffs them into an array for O(1) access. It then goes through the inclusion-exclusion calculation described above, fortunately terminating early once the divisor exceed 2^50.
A couple of comments about the code below. The first time I wrote it I didn't include the lines:
f (result,partialProduct,i,isOdd) | seq result $ seq partialProduct $ seq i $ seq isOdd $ False = undefined
which makes f evaluate its arguements. Again, I think the Earth would have been cold and dark before that program finished. That is one complaint I have about Haskell, namely that (at least to me) it isn't at all obvious what goes on "under the hood" and the performance of programs can change very drastically with seemingly minor changes in the source code.
My second comment is that someone more skilled than me needs to write a really good prime number generator. Reading through the Euler Project Forums I see that the C/C++/C# guys can generate all primes < 2^25 in about 8 seconds. On my machine using the wonderful "Haskell for Maths" library by David Amos, it takes about 260 seconds to generate those primes. The actual Moebius calculation then only take about 47 seconds once the primes are generated. Surely we (haskellers) can do better than the C# guys, no? HenryLaxen July 2,2008
import Primes (isPrime) import Data.Array.Unboxed (Array, listArray, (!)) import System.CPUTime (getCPUTime) maxN = 2^50 primesSquared :: Array Int Integer primesSquared = listArray (0,length p2) p2 where p2 = (takeWhile (<= maxN) (map (\x -> x*x) $ 2:[p | p<-[3,5..], isPrime p])) ++ [maxN+1] f (result,partialProduct,i,isOdd) | seq result $ seq partialProduct $ seq i $ seq isOdd $ False = undefined f (result,partialProduct,i,isOdd) = let nextProduct = ((primesSquared ! i) * partialProduct) numberOfSquareFull = maxN `div` nextProduct adjustCount = if isOdd then numberOfSquareFull else negate numberOfSquareFull descendLevel x = f (x, nextProduct, i+1, not isOdd) nextPrimeSquared x = f (x, partialProduct, i+1, isOdd) in if nextProduct < maxN then (nextPrimeSquared . descendLevel) (result+adjustCount) else result+adjustCount main = do a <- seq primesSquared $ getCPUTime let b = maxN - (f (0,1,0,True)) putStrLn $ "Result = " ++ show b c <- getCPUTime putStrLn $ "Prime Calculation took " ++ show (a `div` 10^12) ++ " seconds" putStrLn $ "Moebius Calculation took " ++ show ((c-a) `div` 10^12) ++ " seconds"