morris555's diary

高校生のブログです。

Problem 18

Problem 18です。

import Control.Applicative

group _ [] = []
group n xs =
  let (xs1, xs2) = splitAt n xs
      in xs1 : group (n+1) xs2

main = do
  input <- map read <$> (words <$> getContents) :: IO [Int]
  print . head . foldr1 max' $ group 1 input
    where
      max' num1 num2 = zipWith (+) num1 . zipWith max num2 . tail $ num2
# p18.hs < text.txt

こんな感じです。

これでPloblem 67もできると思います。

追記

text.txtは、こんな感じです。

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

Problem 17

Problem 17は「1から1000までの数字をすべて英単語で書けば、全部で何文字になるか」という問題です。

nums1 = ["", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"]

nums2 = ["", "", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety"]

toStr n | n == 1000 = "onethousand"
        | n >= 100 = nums1 !! eraseD n 100 ++ "hundred" ++ case toStr (getD n 100) of
            "" -> ""
            s -> "and" ++ s
        | n >= 20 = nums2 !! eraseD n 10 ++ toStr (getD n 10)
        | otherwise = nums1 !! n
          where
            eraseD x y = x `div` y
            getD x y = x - eraseD x y * y

main = print . length . concatMap toStr $ [1..1000]

こんな感じかな。

Problem 15

Problem 15です。

20 × 20 のマス目の左上から右下までの最短ルートの数を求める問題です。

main = print $ product [21..40] `div` product [1..20]

高1の数学で習ったような気がしたので、記憶を頼りにやってみました。

Problem 14

Problem 14はいわゆる「コラッツの問題」ってやつです。

import Data.List (maximumBy)
import Data.Ord (comparing)

collatz 1 a = a
collatz n a
  | even n = collatz (n `div` 2) (a + 1)
  | otherwise = collatz (3*n + 1) (a + 1)

main = print $ maximumBy (comparing snd) [(x, collatz x 1) | x <- [2 .. 1000000]]

こんな感じですか。

Problem 13

今回はProblem 13です。

50桁の数字100個の総和の上10桁を求める問題ですね。

main = putStrLn . take 10 . show . sum $ num

num = [
-- ここに50桁の数字100個
]

見難くなるので数字は省略しましたが、100個のリストを作れば簡単でした。

Problem 12

Problem 12は500個以上の約数を持つ最小の三角数を求める問題です。

import Data.List (group)

factorize 1 = [(1, 0)]
factorize n = format . factorize' n $ 2:3:[x + y | x <- [6, 12 ..], y <- [-1, 1]]
        where
                factorize' n xs'@(x : xs)
                        | n < x * x    = [n]
                        | rem n x == 0 = x : factorize' (div n x) xs'
                        | otherwise    = factorize' n xs
                format xss = [(head xs, length xs) | xs <- group xss]

numOfDivs n = product [b + 1 | (_, b) <- factorize n]

triNums = tri 1 2 1
        where tri v add d = v : tri (v + add) (add + d) d

main = print . head . dropWhile ((<= 500) . numOfDivs) $ triNums

今回も遅いです。

上手な書き方ができません。

まだまだ勉強不足ですね。