https://wiki.haskell.org/api.php?action=feedcontributions&user=Laney&feedformat=atomHaskellWiki - User contributions [en]2024-03-29T00:55:24ZUser contributionsMediaWiki 1.35.5https://wiki.haskell.org/index.php?title=Euler_problems/11_to_20&diff=14572Euler problems/11 to 202007-07-21T12:20:48Z<p>Laney: </p>
<hr />
<div>[[Category:Programming exercise spoilers]]<br />
== [http://projecteuler.net/index.php?section=view&id=11 Problem 11] ==<br />
What is the greatest product of four numbers on the same straight line in the [http://projecteuler.net/index.php?section=view&id=11 20 by 20 grid]?<br />
<br />
Solution:<br />
<haskell><br />
import System.Process<br />
import IO<br />
import List<br />
<br />
slurpURL url = do<br />
(_,out,_,_) <- runInteractiveCommand $ "curl " ++ url<br />
hGetContents out<br />
<br />
parse_11 src =<br />
let npre p = or.(zipWith (/=) p)<br />
clip p q xs = takeWhile (npre q) $ dropWhile (npre p) xs<br />
trim s =<br />
let (x,y) = break (== '<') s<br />
(_,z) = break (== '>') y<br />
in if null z then x else x ++ trim (tail z)<br />
in map ((map read).words.trim) $ clip "08" "</p>" $ lines src<br />
<br />
solve_11 xss =<br />
let mult w x y z = w*x*y*z<br />
zipf f (w,x,y,z) = zipWith4 f w x y z<br />
zifm = zipf mult<br />
zifz = zipf (zipWith4 mult)<br />
tupl = zipf (\w x y z -> (w,x,y,z)) <br />
skew (w,x,y,z) = (w, drop 1 x, drop 2 y, drop 3 z)<br />
sker (w,x,y,z) = skew (z,y,x,w)<br />
skex x = skew (x,x,x,x)<br />
maxl = foldr1 max<br />
maxf f g = maxl $ map (maxl.f) $ g xss<br />
in maxl<br />
[ maxf (zifm.skex) id<br />
, maxf id (zifz.skex)<br />
, maxf (zifm.skew) (tupl.skex)<br />
, maxf (zifm.sker) (tupl.skex) ] <br />
<br />
problem_11 = do<br />
src <- slurpURL "http://projecteuler.net/print.php?id=11"<br />
print $ solve_11 $ parse_11 src<br />
</haskell><br />
<br />
Alternative, slightly easier to comprehend:<br />
<haskell><br />
import Data.List (transpose)<br />
import Data.List (tails, inits, maximumBy)<br />
<br />
num = undefined --list of lists of numbers, one list per row<br />
<br />
rows = num<br />
cols = transpose rows<br />
<br />
diag b = [b !! n !! n | n <- [0 .. length b - 1], n < (length (transpose b))]<br />
<br />
diagLs = diag rows : diagup ++ diagdown<br />
where diagup = getAllDiags diag rows<br />
diagdown = getAllDiags diag cols<br />
<br />
diagRs = diag (reverse rows) : diagup ++ diagdown<br />
where diagup = getAllDiags diag (reverse num)<br />
diagdown = getAllDiags diag (transpose $ reverse num)<br />
<br />
getAllDiags f g = map f [drop n . take (length g) $ g | n <- [1.. (length g - 1)]]<br />
<br />
allposs = rows ++ cols ++ diagLs ++ diagRs<br />
allfours = [x | xss <- allposs, xs <- inits xss, x <- tails xs, length x == 4]<br />
<br />
answer = maximumBy (\(x, _) (y, _) -> compare x y) (zip (map product allfours) allfours)<br />
</haskell><br />
== [http://projecteuler.net/index.php?section=view&id=12 Problem 12] ==<br />
What is the first triangle number to have over five-hundred divisors?<br />
<br />
Solution:<br />
<haskell><br />
problem_12 = head $ filter ((> 500) . nDivisors) triangleNumbers<br />
where triangleNumbers = scanl1 (+) [1..]<br />
nDivisors n = product $ map ((+1) . length) (group (primeFactors n))<br />
primes = 2 : filter ((== 1) . length . primeFactors) [3,5..]<br />
primeFactors n = factor n primes<br />
where factor n (p:ps) | p*p > n = [n]<br />
| n `mod` p == 0 = p : factor (n `div` p) (p:ps)<br />
| otherwise = factor n ps<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=view&id=13 Problem 13] ==<br />
Find the first ten digits of the sum of one-hundred 50-digit numbers.<br />
<br />
Solution:<br />
<haskell><br />
nums = ... -- put the numbers in a list<br />
problem_13 = take 10 . show . sum $ nums<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=view&id=14 Problem 14] ==<br />
Find the longest sequence using a starting number under one million.<br />
<br />
Solution:<br />
<haskell><br />
p14s :: Integer -> [Integer]<br />
p14s n = n : p14s' n<br />
where p14s' n = if n' == 1 then [1] else n' : p14s' n'<br />
where n' = if even n then n `div` 2 else (3*n)+1<br />
<br />
problem_14 = fst $ head $ sortBy (\(_,x) (_,y) -> compare y x) [(x, length $ p14s x) | x <- [1 .. 999999]]<br />
<br />
</haskell><br />
<br />
Alternate solution, illustrating use of strict folding:<br />
<br />
<haskell><br />
import Data.List<br />
<br />
problem_14 = j 1000000 where<br />
f :: Int -> Integer -> Int<br />
f k 1 = k<br />
f k n = f (k+1) $ if even n then div n 2 else 3*n + 1<br />
g x y = if snd x < snd y then y else x<br />
h x n = g x (n, f 1 n)<br />
j n = fst $ foldl' h (1,1) [2..n-1]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=view&id=15 Problem 15] ==<br />
Starting in the top left corner in a 20 by 20 grid, how many routes are there to the bottom right corner?<br />
<br />
Solution:<br />
<haskell><br />
problem_15 = iterate (scanl1 (+)) (repeat 1) !! 20 !! 20<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=view&id=16 Problem 16] ==<br />
What is the sum of the digits of the number 2<sup>1000</sup>?<br />
<br />
Solution:<br />
<haskell><br />
problem_16 = sum.(map (read.(:[]))).show $ 2^1000<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=view&id=17 Problem 17] ==<br />
How many letters would be needed to write all the numbers in words from 1 to 1000?<br />
<br />
Solution:<br />
<haskell><br />
-- not a very concise or beautiful solution, but food for improvements :)<br />
<br />
names = concat $<br />
[zip [(0, n) | n <- [0..19]]<br />
["", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight"<br />
,"Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen"<br />
,"Sixteen", "Seventeen", "Eighteen", "Nineteen"]<br />
,zip [(1, n) | n <- [0..9]]<br />
["", "Ten", "Twenty", "Thirty", "Fourty", "Fifty", "Sixty", "Seventy"<br />
,"Eighty", "Ninety"]<br />
,[((2,0), "")]<br />
,[((2, n), look (0,n) ++ " Hundred and") | n <- [1..9]]<br />
,[((3,0), "")]<br />
,[((3, n), look (0,n) ++ " Thousand") | n <- [1..9]]]<br />
<br />
look n = fromJust . lookup n $ names<br />
<br />
spell n = unwords $ if last s == "and" then init s else s<br />
where<br />
s = words . unwords $ map look digs'<br />
digs = reverse . zip [0..] . reverse . map digitToInt . show $ n<br />
digs' = case lookup 1 digs of<br />
Just 1 -><br />
let [ten,one] = filter (\(a,_) -> a<=1) digs in<br />
(digs \\ [ten,one]) ++ [(0,(snd ten)*10+(snd one))]<br />
otherwise -> digs<br />
<br />
problem_17 xs = sum . map (length . filter (`notElem` " -") . spell) $ xs<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=view&id=18 Problem 18] ==<br />
Find the maximum sum travelling from the top of the triangle to the base.<br />
<br />
Solution:<br />
<haskell><br />
problem_18 = head $ foldr1 g tri where<br />
f x y z = x + max y z<br />
g xs ys = zipWith3 f xs ys $ tail ys<br />
tri = [<br />
[75],<br />
[95,64],<br />
[17,47,82],<br />
[18,35,87,10],<br />
[20,04,82,47,65],<br />
[19,01,23,75,03,34],<br />
[88,02,77,73,07,63,67],<br />
[99,65,04,28,06,16,70,92],<br />
[41,41,26,56,83,40,80,70,33],<br />
[41,48,72,33,47,32,37,16,94,29],<br />
[53,71,44,65,25,43,91,52,97,51,14],<br />
[70,11,33,28,77,73,17,78,39,68,17,57],<br />
[91,71,52,38,17,14,91,43,58,50,27,29,48],<br />
[63,66,04,68,89,53,67,30,73,16,69,87,40,31],<br />
[04,62,98,27,23,09,70,98,73,93,38,53,60,04,23]]<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=view&id=19 Problem 19] ==<br />
You are given the following information, but you may prefer to do some research for yourself.<br />
* 1 Jan 1900 was a Monday.<br />
* Thirty days has September,<br />
* April, June and November.<br />
* All the rest have thirty-one,<br />
* Saving February alone,<br />
Which has twenty-eight, rain or shine.<br />
And on leap years, twenty-nine.<br />
* A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.<br />
<br />
How many Sundays fell on the first of the month during the twentieth century?<br />
<br />
Solution:<br />
<haskell><br />
problem_19 = undefined<br />
</haskell><br />
<br />
== [http://projecteuler.net/index.php?section=view&id=20 Problem 20] ==<br />
Find the sum of digits in 100!<br />
<br />
Solution:<br />
<haskell><br />
problem_20 = let fac n = product [1..n] in<br />
foldr ((+) . Data.Char.digitToInt) 0 $ show $ fac 100<br />
</haskell><br />
<br />
Alternate solution, summing digits directly, which is faster than the show, digitToInt route.<br />
<br />
<haskell><br />
dsum 0 = 0<br />
dsum n = let ( d, m ) = n `divMod` 10 in m + ( dsum d )<br />
<br />
problem_20' = dsum . product $ [ 1 .. 100 ]<br />
</haskell><br />
<br />
[[Category:Tutorials]]<br />
[[Category:Code]]</div>Laney