Project Euler (Problem ID 16..20)

ID16から20まで。

ID17でfourteenの綴りを間違えてforteenにしてしまい、悩んだ。

ID18の問題文のNOTEに、「この問題はbrute forceでも解けるけど、ID67は賢くやらないと解けないよ」と書いてあったので、今回はとりあえずbrute forceで解いてみた。

ID19では細かいミスを連発し、なかなか答えが合わなかった。無念。

ID 16..20

import List
import Char

prog016 = foldl (+) 0 $ map (\c -> (ord c) - (ord '0')) $ show $ 2^1000

genNumWord n
	| n == 0 = ""
	| n < 20 = str0to19 !! n
	| 20 <= n && n < 100 = str20to90 !! ((div n 10) - 2) ++ genNumWord (rem n 10)
	| 100 <= n && n < 1000 = str0to19 !! (div n 100) ++ "hundred" ++ if (rem n 100) == 0 then "" else "and" ++ genNumWord (rem n 100)
	| n == 1000 = "one" ++ "thousand"
		where
			str0to19 = ["zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"]
			str20to90 = ["twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety"]

prog017 = length $ foldl (++) "" $ map genNumWord [1..1000]

prog018 = total 0 theTriangle
	where
		theTriangle = [
			[75],
			[95,64],
			[17,47,82],
			[18,35,87,10],
			[20,04,82,47,65],
			[19,01,23,75,03,34],
			[88,02,77,73,07,63,67],
			[99,65,04,28,06,16,70,92],
			[41,41,26,56,83,40,80,70,33],
			[41,48,72,33,47,32,37,16,94,29],
			[53,71,44,65,25,43,91,52,97,51,14],
			[70,11,33,28,77,73,17,78,39,68,17,57],
			[91,71,52,38,17,14,91,43,58,50,27,29,48],
			[63,66,04,68,89,53,67,30,73,16,69,87,40,31],
			[04,62,98,27,23,09,70,98,73,93,38,53,60,04,23]]
		total n [] = 0
		total n (l:ls) = (l !! n) + max (total n ls) (total (n + 1) ls)

days y m
	| m == 0 = days (y - 1) 12
	| m == 2 = if isLeap y then 29 else 28
	| otherwise = [0,31,0,31,30,31,30,31,31,30,31,30,31] !! m
		where isLeap y
			| div y 400 == 0 = True
			| div y 100 == 0 = False
			| div y 4 == 0 = True
			| otherwise = False

totalDays y m
	| y == 1900 && m == 1 = 1
	| m == 0 = totalDays (y - 1) 12
	| otherwise = (days y (m - 1)) + totalDays y (m - 1)

prog019 = length $ filter (\n -> rem n 7 == 0) $ [totalDays y m | y <- [1901..2000], m <- [1..12]]

frac 0 = 1
frac n = n * frac (n - 1)

prog020 = foldl (+) 0 $ map (\c -> (ord c) - (ord '0')) $ show $ frac 100

main = putStrLn $ show $ prog020