AtCoderに登録したら解くべき精選過去問10問をOCaml / Haskell / C言語で解いてみる

一切の部品が手に入らないので, 今年はもうダメ。
たまにはこんなこともしてみる。

「AtCoder に登録したら次にやること～これだけ解けば十分闘える！過去問精選 10 問～」という記事にある「AtCoder Beginners Selection」10問をOCaml/Haskell/C言語で解いてみた。

OCamlで書いたコードをHaskellとCに移植したので, 冗長になっている所もあるけど気にしないで。

“.ml"はOCaml
“.hs"はHaskell
“.c"はC言語

以下のコードはGitHub上にあります。

https://github.com/ak1211/atcoder-beginners-selection

1問目 ABC 086 A - Product

入出力の練習かな。
パイプ演算子「|>」はOCamlではよく使う。

1
2
3
4
5
6
7
8
9
(* ABC086A - Product *)

let solver = function
  | [ a; b ] -> if a * b mod 2 = 0 then "Even" else "Odd"
  | _ -> failwith "?"

let () =
  read_line () |> String.split_on_char ' ' |> List.map int_of_string |> solver
  |> print_endline

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
{- ABC086A - Product -}

solver :: [Int] -> String
solver xs = case xs of
  [a, b]  | even (a*b) -> "Even"
          | otherwise ->  "Odd"
  _ -> "?"

main :: IO ()
main =
  putStrLn . solver =<< input
  where
    input = map read . words <$> getLine

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
/* ABC086A - Product */
#include <stdio.h>
#include <stdint.h>

int main()
{
    int32_t a, b;
    scanf("%d %d", &a, &b);
    (a * b % 2) ? puts("Odd") : puts("Even");
    return 0;
}

2問目 ABC081A - Placing Marbles

１の数を数える。
OCamlはforもよく使う。
Haskell? foldかな。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
(* ABC081A - Placing Marbles *)

let solver s =
  let counter = ref 0 in
  for i = 0 to String.length s - 1 do
    if s.[i] = '1' then incr counter
  done;
  !counter

let () = read_line () |> solver |> string_of_int |> print_endline

1
2
3
4
5
6
7
8
9
{- ABC081A - Placing Marbles -}

solver :: String -> Int
solver =
	foldl (\a c -> if c == '1' then a+1 else a) 0

main :: IO ()
main =
  putStrLn . show . solver =<< getLine

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
/* ABC081A - Placing Marbles */
#include <stdio.h>
#include <string.h>

int main()
{
    char s[4];
    gets(s);
    int counter = 0;
    for (int i = 0; i < strlen(s); ++i)
    {
        if (s[i] == '1')
        {
            counter++;
        }
    }
    printf("%d\n", counter);
    return 0;
}

3問目 ABC081B - Shift only

2で割り切れる限り2で割り続ける。
ループは再帰。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
(* ABC081B - Shift only *)

let even x = x mod 2 = 0

let half x = x / 2

let rec solver = function
  | xs when List.for_all even xs -> 1 + solver (List.map half xs)
  | _ -> 0

let () =
  let _ = read_int () in
  read_line ()
  |> Str.split (Str.regexp " ")
  |> List.map int_of_string |> solver |> string_of_int |> print_endline

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
{- ABC081B - Shift only -}

solver :: [Int] -> Int
solver xs =
  if all even xs then
    1 + solver (map half xs)
  else
    0
  where
    half x = x`div` 2

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map read . words <$> getLine
  putStrLn . show $ solver xs

 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
/* ABC081B - Shift only */
#include <stdio.h>
#include <stdbool.h>
#include <stdint.h>
#include <string.h>

bool all(int64_t n, int64_t *a)
{
    for (int64_t i = 0; i < n; ++i)
    {
        if (a[i] & 1)
        {
            return false;
        }
    }
    return true;
}

void half(int64_t n, int64_t *a)
{
    for (int64_t i = 0; i < n; ++i)
    {
        a[i] = a[i] >> 1;
    }
}

int64_t solver(int64_t n, int64_t *a)
{
    int64_t counter = 0;
    while (all(n, a))
    {
        half(n, a);
        counter++;
    }
    return counter;
}

int main()
{
    static int64_t a[200];
    int64_t n;
    scanf("%ld", &n);
    for (int64_t i = 0; i < n; ++i)
    {
        scanf("%ld", &a[i]);
    }
    printf("%ld\n", solver(n, a));
    return 0;
}

4問目 ABC087B - Coins

ループループ３重ループ。
OCamlはfor for for。
Haskellでもfor for for。
Haskellではforを書けないとかのうわさはデマだし。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
(* ABC087B - Coins *)

let solver a b c x =
  let counter = ref 0 in
  for a' = 0 to a do
    for b' = 0 to b do
      for c' = 0 to c do
        if (500 * a') + (100 * b') + (50 * c') = x then counter := !counter + 1
      done
    done
  done;
  !counter

let () =
  let a = read_int () in
  let b = read_int () in
  let c = read_int () in
  let x = read_int () in
  solver a b c x |> string_of_int |> print_endline

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
{- ABC087B - Coins -}
import Control.Monad.State.Strict
import Data.Foldable (forM_)

solver :: Int -> Int -> Int -> Int -> Int
solver a b c x =
  flip execState 0 $ do
    forM_ [0..a] $ \i -> do
      forM_ [0..b] $ \j -> do
        forM_ [0..c] $ \k -> do
          if 500*i + 100*j + 50*k == x then modify' succ else pure ()
    get

main :: IO ()
main = do
  a <- readLn :: IO Int
  b <- readLn :: IO Int
  c <- readLn :: IO Int
  x <- readLn :: IO Int
  putStrLn . show $ solver a b c x

 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
/* ABC087B - Coins */
#include <stdio.h>
#include <stdint.h>

int32_t solver(int32_t A, int32_t B, int32_t C, int32_t X)
{
    int32_t counter = 0;
    for (int32_t a = 0; a <= A; ++a)
    {
        for (int32_t b = 0; b <= B; ++b)
        {
            for (int32_t c = 0; c <= C; ++c)
            {
                if ((500 * a) + (100 * b) + (50 * c) == X)
                {
                    ++counter;
                }
            }
        }
    }
    return counter;
}

int main()
{
    int32_t A, B, C, X;
    scanf("%d", &A);
    scanf("%d", &B);
    scanf("%d", &C);
    scanf("%d", &X);
    printf("%d\n", solver(A, B, C, X));
    return 0;
}

5問目 ABC083B - Some Sums

10で割れる限り, 10で割った余りをたし続ける。
OCamlは再帰で足し続ける。
Haskellはunfoldrで各桁のリストを作ってsumで総和を。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
(* ABC083B - Some Sums *)

let rec sum_of_digits x =
  if x >= 10 then (x mod 10) + sum_of_digits (x / 10) else x

let solver = function
  | [ n; a; b ] ->
      let test x = a <= x && x <= b in
      let summary = ref 0 in
      for n' = 1 to n do
        if test (sum_of_digits n') then summary := !summary + n'
      done;
      !summary
  | _ -> failwith "?"

let () =
  read_line ()
  |> Str.split (Str.regexp " ")
  |> List.map int_of_string |> solver |> string_of_int |> print_endline

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
{- ABC083B - Some Sums -}
import           Data.List  (unfoldr)
import           Data.Maybe (Maybe (..))

sum_of_digits :: Int -> Int
sum_of_digits =
  sum . unfoldr f
  where
    f x | x == 0 = Nothing
        | otherwise = Just (x `mod` 10, x `div` 10)

solver :: [Int] -> Int
solver [n, a, b] =
  sum [x | x <- [1..n], let z = sum_of_digits x, a <= z && z <= b]

solver _ = 0

main :: IO ()
main = do
  xs <- map read . words <$> getLine
  putStrLn . show $ solver xs

 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
/* ABC083B - Some Sums */
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>

int32_t sum_of_digits(int32_t x)
{
    int32_t y = 0;
    for (; x; x /= 10)
        y += x % 10;
    return y;
}

int32_t solver(int32_t N, int32_t A, int32_t B)
{
    int32_t summary = 0;
    for (int32_t i = 1; i <= N; ++i)
    {
        int32_t s = sum_of_digits(i);
        if (A <= s && s <= B)
        {
            summary += i;
        }
    }
    return summary;
}

int main()
{
    int32_t N, A, B;
    scanf("%d %d %d", &N, &A, &B);
    printf("%d\n", solver(N, A, B));
    return 0;
}

6問目 ABC088B - Card Game for Two

大きい順にソートしてaliceとbobに配り, 足し合わせて差を求める。
OCamlはカウンタを見ながらそれぞれに配る。
Haskellはunfoldrでそれぞれに配る。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
(* ABC088B - Card Game for Two *)

let solver _ xs =
  let reversed = List.sort (fun x y -> compare y x) xs in
  let f (counter, alice, bob) x =
    if counter mod 2 = 0 then (succ counter, alice + x, bob)
    else (succ counter, alice, bob + x)
  in
  let counter, alice, bob = List.fold_left f (0, 0, 0) reversed in
  alice - bob

let () =
  let n = read_int () in
  read_line ()
  |> Str.split (Str.regexp " ")
  |> List.map int_of_string |> solver n |> string_of_int |> print_endline

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
{- ABC088B - Card Game for Two -}
import           Data.List  (sortBy, unfoldr)
import           Data.Maybe (Maybe (..))

solver :: [Int] -> Int
solver xs =
  let reversed      = sortBy (\x y -> compare y x) xs
      (alice, bob)  = deal reversed
  in
  sum alice - sum bob
  where
    deal = unzip . unfoldr f
    f []         = Nothing
    f [a]        = Just ((a,0), [])
    f (a:b :rest) = Just ((a,b), rest)

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map read . words <$> getLine
  putStrLn . show $ solver xs

 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
/* ABC088B - Card Game for Two */
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>

int32_t compare(const void *x, const void *y)
{
    return *(int32_t *)y - *(int32_t *)x;
}

int32_t solver(int32_t N, int32_t *A)
{
    qsort(A, N, sizeof(int32_t), compare);
    int32_t alice = 0, bob = 0;
    for (int32_t i = 0; i < N; i += 2)
    {
        alice += A[i];
        bob += A[i + 1];
    }
    return alice - bob;
}

int main()
{
    static int32_t A[100];
    int32_t N;
    scanf("%d", &N);
    for (int32_t i = 0; i < N; ++i)
    {
        scanf("%d", &A[i]);
    }
    printf("%d\n", solver(N, A));
    return 0;
}

7問目 ABC085B - Kagami Mochi

重複を除いた数を数える。
元記事でstd::setを使っていたので
OCamlはSetを使うことにする。
HaskellはData.List.nubを使うことにする。
ライブラリを使うと一撃で終わる。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
(* ABC085B - Kagami Mochi *)

module IntSet = Set.Make (Int)

let solver stream =
  let rec go sets = function
    | Some s ->
      go
        (IntSet.add (int_of_string s) sets)
        (Stream.junk stream;
         Stream.peek stream)
    | None -> sets
  in
  go IntSet.empty (Stream.peek stream) |> IntSet.cardinal

let () =
  let n = read_int () in
  Stream.from (fun i -> if i < n then Some (read_line ()) else None)
  |> solver |> string_of_int |> print_endline

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
{- ABC085B - Kagami Mochi -}
import           Control.Monad (replicateM)
import           Data.List     (nub)

solver :: [Int] -> Int
solver = length . nub

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- replicateM n readLn
  putStrLn . show $ solver xs

 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
/* ABC085B - Kagami Mochi */
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>

int32_t compare(const void *x, const void *y)
{
    return *(int32_t *)x - *(int32_t *)y;
}

int32_t solver(int32_t N, int32_t *d)
{
    qsort(d, N, sizeof(int32_t), compare);
    int32_t counter = 1, prev = d[0];
    for (int32_t i = 0; i < N; ++i)
    {
        if (prev != d[i])
        {
            prev = d[i];
            ++counter;
        }
    }
    return counter;
}

int main()
{
    static int32_t d[100];
    int32_t N;
    scanf("%d", &N);
    for (int32_t i = 0; i < N; ++i)
    {
        scanf("%d", &d[i]);
    }
    printf("%d\n", solver(N, d));
    return 0;
}

8問目 ABC085C - Otoshidama

OCamlは例外でループ脱出はありだと思っている。 Haskellは特に必要ではないがデータ型宣言とクラスShowのインスタンスにしてみた。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
(* ABC085C - Otoshidama *)

exception Ok of (int * int * int)

let solver (n, y) =
  try
    for a = 0 to n do
      for b = 0 to n - a do
        let c = n - a - b in
        if (10000 * a) + (5000 * b) + (1000 * c) = y then raise (Ok (a, b, c))
      done
    done;
    (-1, -1, -1)
  with
  | Ok a -> a

let () =
  Scanf.sscanf (read_line ()) "%d %d" (fun n y -> (n, y)) |> solver
  |> fun (a, b, c) -> Printf.printf "%d %d %d\n" a b c

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
{- ABC085C - Otoshidama -}
import qualified Data.ByteString.Char8 as B8
import           Data.Maybe            (fromMaybe, listToMaybe)

data ABC = ABC Int Int Int
instance Show ABC where
	show (ABC a b c) = show a ++ " " ++ show b ++ " " ++ show c

solver :: Int -> Int -> ABC
solver n y =
  fromMaybe notFound $ listToMaybe
    [ABC a b c | a <- [0..n], b <- [0..(n-a)], let c = n-a-b, cond a b c]
  where
    cond a b c = 10000*a + 5000*b + 1000*c == y
    notFound = ABC (-1) (-1) (-1)

main :: IO ()
main = do
  [n, y] <- map read . words <$> getLine
  putStrLn . show $ solver n y

 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
/* ABC085C - Otoshidama */
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>

struct S
{
    int32_t a, b, c;
};

struct S solver(int32_t N, int32_t Y)
{
    struct S r;
    for (r.a = 0; r.a <= N; ++r.a)
    {
        for (r.b = 0; r.b <= (N - r.a); ++r.b)
        {
            r.c = N - r.a - r.b;
            if (10000 * r.a + 5000 * r.b + 1000 * r.c == Y)
            {
                return r;
            }
        }
    }
    r.a = r.b = r.c = -1;
    return r;
}

int main()
{
    int32_t N, Y;
    scanf("%d %d", &N, &Y);
    struct S s = solver(N, Y);
    printf("%d %d %d\n", s.a, s.b, s.c);
    return 0;
}

9問目 ABC049C - 白昼夢

元記事は後ろから見ているけど, 自分は正面突破した。
再帰的に見ながら最後までたどり着けたら"YES"ということで。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
(* ABC049C - 白昼夢 *)

let words = List.map Str.regexp [ "dream"; "dreamer"; "erase"; "eraser" ]

let solver str =
  let rec go = function
    | idx when idx = String.length str -> true
    | idx ->
      List.map
        (function
          | r when Str.string_match r str idx -> go (Str.match_end ())
          | _ -> false)
        words
      |> List.exists (( = ) true)
  in
  if go 0 then "YES" else "NO"

let () = read_line () |> solver |> print_endline

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
{- ABC049C - Daydream -}
import qualified Data.ByteString.Char8 as B8
import           Prelude               hiding (words)

words :: [B8.ByteString]
words = map B8.pack [ "dream", "dreamer", "erase", "eraser" ]

solver :: B8.ByteString -> B8.ByteString
solver s =
  if go 0 then B8.pack "YES" else B8.pack "NO"
  where
    go idx | idx == B8.length s = True
    go idx =
      let
        s' = B8.drop idx s
        cond w = B8.isPrefixOf w s'
        nextIdx w = idx + B8.length w
      in
        any (== True) [if cond w then go (nextIdx w) else False | w <- words]

main :: IO ()
main = B8.putStrLn . solver =<< B8.getLine

 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
/* ABC049C - Daydream */
#include <stdio.h>
#include <stdbool.h>
#include <stdint.h>
#include <string.h>

bool walk(const char *s, const size_t length, size_t offset)
{
    static const char *words[4] = {"dream", "dreamer", "erase", "eraser"};

    if (length == offset)
        return true;
    else if (length < offset)
        return false;
    else
    {
        for (int32_t i = 0; i < 4; ++i)
        {
            size_t len = strlen(words[i]);
            if (strncmp(words[i], &s[offset], len) == 0)
            {
                if (walk(s, length, offset + len))
                    return true;
            }
        }
        return false;
    }
}

bool solver(char *s)
{
    return walk(s, strlen(s), 0);
}

int main()
{
    static char s[100001];
    gets(s);
    printf("%s\n", solver(s) ? "YES" : "NO");
    return 0;
}

10問目 ABC086C - Traveling

OCamlは例外でfold_leftの脱出はありだと思っている。
Haskellは遅延評価的な何かで実行のキャンセルが行われるんじゃないかな。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(* ABC086C - Traveling *)

type coord = { x : int; y : int }

let distance a b = abs (a.x - b.x) + abs (a.y - b.y)

let solver (txy : (int * coord) array) =
  let zero = (0, { x = 0; y = 0 }) in
  let walk previous current =
    let dt = fst current - fst previous in
    let dist = distance (snd current) (snd previous) in
    if dt < dist then raise Not_found
    else if (dt - dist) mod 2 = 0 then current
    else raise Not_found
  in
  try Array.fold_left walk zero txy |> Fun.const "Yes" with Not_found -> "No"

let () =
  let n = read_int () in
  let init _ =
    Scanf.sscanf (read_line ()) "%d %d %d" (fun t x y -> (t, { x; y }))
  in
  Array.init n init |> solver |> print_endline

 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
{- ABC086C - Traveling -}
import qualified Data.ByteString.Char8 as B8
import           Data.Maybe            (Maybe (..), fromJust, fromMaybe,
                                        isNothing)

data Coord = MkCoord { cx :: Int, cy:: Int }

distance :: Coord -> Coord -> Int
distance a b = abs (cx a - cx b) + abs (cy a - cy b)

solver :: [(Int, Coord)] -> String
solver = yesOrNo . scanl walk zero
  where
    zero = Just (0, MkCoord 0 0)
    --
    walk Nothing _ = Nothing
    walk (Just previous) current =
      let
        dt = fst current - fst previous
        dist = distance (snd current) (snd previous)
      in
      if dt < dist then Nothing
      else if (dt - dist) `mod` 2 == 0 then (Just current)
      else Nothing
    --
    yesOrNo :: [(Maybe (Int, Coord))] -> String
    yesOrNo xs = if any isNothing xs then "No" else "Yes"

main :: IO ()
main = do
  _ <- readLn :: IO Int
  putStrLn . solver =<< map (fromJust . pack . B8.words) . B8.lines <$> B8.getContents
  where
    pack :: [B8.ByteString] -> Maybe (Int, Coord)
    pack [a,b,c] = do
      (t,_) <- B8.readInt a
      (x,_) <- B8.readInt b
      (y,_) <- B8.readInt c
      pure (t, MkCoord x y)
    pack _ = Nothing

 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
/* ABC086C - Traveling */
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <stdint.h>

#define abs(x) ((x) < 0 ? (-(x)) : (x))

struct Coord
{
    int32_t x, y;
};

int32_t distance(struct Coord a, struct Coord b)
{
    return abs(a.x - b.x) + abs(a.y - b.y);
}

struct TXY
{
    int32_t t;
    struct Coord c;
};

bool solver(int32_t N, struct TXY A[])
{
    struct TXY previous = {0};
    for (int32_t i = 0; i < N; ++i)
    {
        int32_t dt = A[i].t - previous.t;
        int32_t dist = distance(A[i].c, previous.c);
        if (dt < dist)
            return false;
        else if ((dt - dist) % 2 != 0)
            return false;
        previous = A[i];
    }
    return true;
}

int main()
{
    static struct TXY A[100000];
    int32_t N;
    scanf("%d", &N);
    for (int32_t i = 0; i < N; ++i)
    {
        scanf("%d %d %d", &A[i].t, &A[i].c.x, &A[i].c.y);
    }
    solver(N, A) ? puts("Yes") : puts("No");
    return 0;
}

まとめ

この３つの言語の速度は最速がC言語それに一回り遅れてOCamlそれからHaskellと予想していたけど, 実行結果を見るとC言語とHaskellとOCamlはほぼ同着位のパフォーマンスを出すんだとわかった。