-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathprojecteuler.hs
199 lines (162 loc) · 8.05 KB
/
projecteuler.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
module Main where
import Data.List
import Data.Char
-- For timing
import Text.Printf
import System.CPUTime
time :: IO t -> IO t
time a = do
start <- getCPUTime
v <- a
end <- getCPUTime
let diff = (fromIntegral (end - start)) / (10^12)
printf "Computation time: %0.3f sec\n" (diff :: Double)
return v
-- PROBLEM 1
--If we list all the natural numbers below 10 that are multiples of 3 or 5, we get 3, 5, 6 and 9. The sum of these multiples is 23.
--Find the sum of all the multiples of 3 or 5 below 1000.
ans001 = sum [ x | x <- [1..999], (x `mod` 3 == 0) || (x `mod` 5 == 0) ]
-- PROBLEM 2
--Each new term in the Fibonacci sequence is generated by adding the previous two terms. By starting with 1 and 2, the first 10 terms will be:
--1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
--By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms.
ans002 = sum $ takeWhile (<= 4000000) $ filter even fibs
where fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
-- PROBLEM 3
--What is the largest prime factor of the number 600851475143 ?
ans003 = lpf 600851475143 where
lpf n = lpf' n 2 where
lpf' n i | n == i = n
| n `mod` i == 0 = lpf' (n `div` i) i
| otherwise = lpf' n (i + 1)
-- PROBLEM 4
--A palindromic number reads the same both ways.
--The largest palindrome made from the product of two 2-digit numbers is 9009 = 91 × 99.
--Find the largest palindrome made from the product of two 3-digit numbers.
ans004 = maximum [x*y | x <- [900..999], y <- [900..999], is_palindrome (x*y)] where
is_palindrome n = show n == (reverse $ show n)
-- PROBLEM 5
--2520 is the smallest number that can be divided by each of the numbers from 1 to 10 without any remainder.
--What is the smallest positive number that is evenly divisible by all of the numbers from 1 to 20?
-- ANSWER: 232792560
ans005 = product $ weird_multi_union factors_of_1_to_20 where
weird_multi_union :: [[Integer]] -> [Integer]
weird_multi_union = foldl weird_union [] where
-- [2,2,3,5] `weird_union` [2,5,5,7] == [2,2,3,5,5,7]
weird_union [] [] = []
weird_union (x:xs) [] = x : weird_union xs []
weird_union [] (y:ys) = y : weird_union [] ys
weird_union (x:xs) (y:ys) | x < y = x : weird_union xs (y:ys)
| x > y = y : weird_union (x:xs) ys
| otherwise = x : weird_union xs ys
factors_of_1_to_20 = [factorize n | n <- [2..20]] where
factorize :: Integer -> [Integer]
factorize 1 = []
factorize n = a_factor_of_n : factorize (n `div` a_factor_of_n) where
a_factor_of_n = head $ filter (\p -> (n `mod` p) == 0) primes where
primes = sieve [2..] where
sieve (p:xs) = p : sieve [x | x <- xs, x `mod` p > 0]
-- Had I thought about this problem in terms of Least Common Multiples, I might have done
-- better.
-- ans005_so_much_better = foldl lcm [] [1..20]
-- PROBLEM 6
--The sum of the squares of the first ten natural numbers is
--1^2 + 2^2 + ... + 10^2 = 385
--The square of the sum of the first ten natural numbers is
--(1 + 2 + ... + 10)^2 = 55^2 = 3025
--Hence the difference between the sum of the squares of the first
--ten natural numbers and the square of the sum is 3025 − 385 = 2640.
--Find the difference between the sum of the squares of the first one
--hundred natural numbers and the square of the sum.
-- ANSWER: 25164150
ans006 = ans006' 100 where
ans006' n = (square_of_sums n) - (sum_of_squares n) where
sum_of_squares n = sum [x^2 | x <- [1..n]]
square_of_sums n = (sum [1..n]) ^2
-- PROBLEM 7
--What is the 10 001st prime number?
-- ANSWER: 104743
ans007 = primes !! 10000 where -- Lists are zero-indexed!
primes = sieve [2..] where
sieve (p:xs) = p : sieve [x | x <- xs, x `mod` p > 0]
-- PROBLEM 8
--Find the greatest product of five consecutive digits in the 1000-digit number.
-- ANSWER: 40824
ans008 = maximum $ zip_products $ split_into_5s input where
input = ("73167176531330624919225119674426574742355349194934" ++
"96983520312774506326239578318016984801869478851843" ++
"85861560789112949495459501737958331952853208805511" ++
"12540698747158523863050715693290963295227443043557" ++
"66896648950445244523161731856403098711121722383113" ++
"62229893423380308135336276614282806444486645238749" ++
"30358907296290491560440772390713810515859307960866" ++
"70172427121883998797908792274921901699720888093776" ++
"65727333001053367881220235421809751254540594752243" ++
"52584907711670556013604839586446706324415722155397" ++
"53697817977846174064955149290862569321978468622482" ++
"83972241375657056057490261407972968652414535100474" ++
"82166370484403199890008895243450658541227588666881" ++
"16427171479924442928230863465674813919123162824586" ++
"17866458359124566529476545682848912883142607690042" ++
"24219022671055626321111109370544217506941658960408" ++
"07198403850962455444362981230987879927244284909188" ++
"84580156166097919133875499200524063689912560717606" ++
"05886116467109405077541002256983155200055935729725" ++
"71636269561882670428252483600823257530420752963450")
split_into_5s lst | length lst > 5 = take 5 lst : (split_into_5s $ tail lst)
| otherwise = [lst]
zip_product z = product $ map digitToInt z
zip_products lst = map zip_product lst
-- PROBLEM 9
--There exists exactly one Pythagorean triplet for which a + b + c = 1000.
--Find the product abc.
-- ANSWER: 31875000
ans009_brute = head [a*b*(1000-a-b) | a <- [1..1000], b <- [a..1000], a^2 + b^2 == (1000-a-b)^2]
-- More elegant: a increments and b decrements, carefully orbiting 1000 until a+b+c==1000.
ans009 = ans009' 1 499 where
ans009' a b =
let c = (1000-a-b)
test = a^2 + b^2 - c^2
in if test < 0 then ans009' (a+1) b
else if test > 0 then ans009' a (b-1)
else a*b*c
-- PROBLEM 10
--Find the sum of all the primes below two million.
-- ANSWER: 142913828922
-- The thing about it is that you only actually need to sieve [2..sqrt x] to find primes up to x
primes_less_than max =
let
sieve' (p:xs) = p : sieve' [x | x <- xs, x `mod` p > 0]
sieve = sieve' [2..]
sqrt_max = truncate $ sqrt $ fromIntegral max
sieve_low = takeWhile (<= sqrt_max) sieve
in
-- So we take sieve [2..sqrt x] and use those primes to sieve out up to x:
sieve_low ++ [p | p <- [sqrt_max..max], all (\x -> p `mod` x /= 0) sieve_low]
-- WAY faster.
ans010 = sum $ primes_less_than (10^6)
-- PROBLEM Open Garden (Not actually from Project Euler): The 2010 Census puts populations of 26 largest US metro areas at:
pops = [18897109, 12828837, 9461105, 6371773, 5965343, 5946800, 5582170, 5564635, 5268860, 4552402, 4335391, 4296250, 4224851, 4192887, 3439809, 3279833, 3095313, 2812896, 2783243, 2710489, 2543482, 2356285, 2226009, 2149127, 2142508, 2134411]
target = 100000000
-- Can you find a subset of these areas where a total of exactly 100,000,000 people live,
-- assuming the census estimates are exactly right? Provide the answer and code or reasoning used.
-- Takes a list and a target and returns a list of all sublists that sum to target.
subset_sum_to :: [Int] -> Int -> [[Int]]
subset_sum_to [x] trg | x == trg = [[trg]]
| otherwise = []
subset_sum_to (x:xs) trg | x > trg = subset_sum_to xs trg
| x == trg = [[trg]] ++ subset_sum_to xs trg
| x < trg = [(x:l) | l <- subset_sum_to xs (trg-x)] ++ subset_sum_to xs trg
-- MAIN --
main :: IO ()
main = do
time $ print $ ans001
time $ print $ ans002
time $ print $ ans003
time $ print $ ans004
time $ print $ ans005
time $ print $ ans006
time $ print $ ans007
time $ print $ ans008
time $ print $ ans009
time $ print $ ans010