Euler problems/191 to 200

Problem 191

Prize Strings

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 " ++
                    foldl (\x y -> x ++ (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

Problem 192

Best Approximations

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

http://en.wikipedia.org/wiki/Continued_fraction

http://en.wikipedia.org/wiki/Methods_of_computing_square_roots#Continued_fraction_expansion

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)