Codeforces 219A - A. k-String

Codeforces

219A - A. k-String

  • 文字列をソートする。
  • 同じ文字でグルーピング。
  • グルーピングした文字列の長さが k の倍数なら、k-string は作れる。そうでなければ k-string は作れない
import Data.List

calc :: Int -> String -> Maybe String
calc k s = if all (\t -> length t `mod` k == 0) xs
           then Just $ (foldl1 (++) . replicate k) $ kString1 xs
           else Nothing
  where
    xs = group $ sort s
    kString1 []     = ""
    kString1 (x:xs) = take (length x `div` k) x ++ kString1 xs

main = do s <- getLine
          t <- getLine
          case calc (read s) t of
            Just x  -> putStrLn x
            Nothing -> print (-1) -- -1 は括弧で囲む必要がある

Codeforces 50A - A. Domino piling

Codeforces

50A - A. Domino piling

M x N サイズのボードに 2 x 1 サイズのドミノを出来るだけ沢山敷き詰める問題。ボードに配置可能なドミノの個数を出力する。

制約:
1 <= M, N <= 16

ボードのサイズが偶数であれば、隙間なくドミノを敷き詰められます。なので、まず偶数サイズのボードに隙間なくドミノを敷き詰めます。もしボードのサイズが奇数であれば、その残りの 1 行にドミノを敷き詰めていきます。

下の図は、5 x 5 サイズのボードです。赤線で囲ったのが偶数サイズのボードです。

f:id:noriok:20120826025916p:plain

calc :: Int -> Int -> Int
calc w h = (w' * h' `div` 2) + a + b
  where
    w' = w - (w `mod` 2)
    h' = h - (h `mod` 2)
    a  = if w /= w' then h' `div` 2 else 0
    b  = if h /= h' then w' `div` 2 else 0

main = do s <- getLine
          let [w, h] = map read $ words s :: [Int]
          print $ calc w h

もっと短く書けそうな気もしますが…。

上の図はProcessingで書きました。以下がそのコードです。

// -*- mode: Java -*-

final int SIZE = 40; // rectのサイズ

void setup() {
    size(600, 600);
}

void draw() {
    background(255);
    stroke(0);
    strokeWeight(1);
    
    final int x = 100, y = 100;
    final int rows = 5, cols = 5;
    // ボード描画
    for (int i = 0; i < rows; i++) {
        for (int j = 0; j < cols; j++) {
            if ((i+j) % 2 == 0) noFill(); else fill(0);
            rect(x+j*SIZE, y+i*SIZE, SIZE, SIZE);
        }
    }

    stroke(255, 0, 0);
    strokeWeight(3);
    noFill();
    rect(x, y, 4*SIZE, 4*SIZE);

    // ドミノ描画
    noStroke();
    fill(183, 177, 177);
    for (int i = 0; i < rows-1; i += 2) {
        for (int j = 0; j < cols-1; j++) {
            rect(x+10+j*SIZE, y+10+i*SIZE, SIZE-20, SIZE*2-20);
        }
    }

    fill(102, 224, 247);
    rect(x+10+4*SIZE, y+10+0*SIZE, SIZE-20, SIZE*2-20);
    rect(x+10+4*SIZE, y+10+2*SIZE, SIZE-20, SIZE*2-20);
    rect(x+10+0*SIZE, y+10+4*SIZE, SIZE*2-20, SIZE-20);
    rect(x+10+2*SIZE, y+10+4*SIZE, SIZE*2-20, SIZE-20);
}

Codeforces 189A - A. Cut Ribbon

Codeforces DP

189A - A. Cut Ribbon

長さ n のリボンある。そのリボンを出来るだけたくさんカットしたい。カットされたリボンの長さは、a, b, cのいずれかでなければならない。最大でいくつのリボンにカットできるか、という問題。

制約:
1 <= n, a, b, c <= 4000

DPの問題なのでC++で解きました。

#include <algorithm>
#include <cassert>
#include <cstdio>
#include <iostream>
using namespace std;

const int N = 4001;

int calc(int n, int a, int b, int c) {
    int dp[N] = {};

    int xs[] = { a, b, c };
    for (int i = 0; i < 3; i++) {
        dp[xs[i]] = max(dp[xs[i]], 1);
        for (int j = xs[i]+1; j <= n; j++) {
            if (dp[j-xs[i]] > 0)
                dp[j] = max(dp[j], 1 + dp[j-xs[i]]);
        }
    }

    assert(dp[n] != 0);
    return dp[n];
}

int main() {
    int n, a, b, c;
    scanf("%d %d %d %d", &n, &a, &b, &c);
    printf("%d\n", calc(n, a, b, c));
}

こういうDPの問題ってHaskellだとどういう風にかけばいいのかな。

Haskellのdoの中のif式のインデント

Haskell

Haskellについて調べていたら、do の中の if 式の then と else は if よりもインデントを深くする必要があるという情報があった。手元で試す限り、if, then, elseを揃えても特にエラーにならない。仕様が変わったのだろうか。もしかしたらと思い、-Wall をつけるも警告などは表示されなかった。

試したコード:

main :: IO ()
main = do if True
          then putStrLn "true"
          else putStrLn "false"

実行結果です。

% ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.4.1
% runghc -Wall a.hs
true

調べると、以下のページを見つけました。

doの中のif - あどけない話

上記ページのPDFを読むと、なぜ「doの中のif」なのかが分かりやすく書かれてあります。doの中で、if, then, elseのインデントを揃えてても問題なく動くのは、ifを3つの式から構成されるものとして扱うことにしたためらしい。ひとまずは、何が問題になっているかを把握することが出来てよかった。

Codeforces 208A - A. Dubstep

Codeforces

208A - A. Dubstep

  • WUBを空白に置き換える
  • 連続する空白をひとつの空白にまとめる
  • 両端の空白を取り除く
-- "WUB"を取り除く(代わりに空白をおく)
removeWUB :: String -> String
removeWUB "" = ""
removeWUB ('W':'U':'B':xs) = ' ' : removeWUB xs
removeWUB (c:xs) = c : removeWUB xs

-- 連続する空白を一つにまとめる
packContinuousSpaces :: String -> String
packContinuousSpaces "" = ""
packContinuousSpaces xxs@(' ':' ':xs) = packContinuousSpaces $ tail xxs
packContinuousSpaces (x:xs) = x : packContinuousSpaces xs

trim :: String -> String
trim s = reverse $ trim' $ reverse $ trim' s
  where
    trim' (' ':xs) = trim' xs
    trim' s = s
   
calc = trim . packContinuousSpaces . removeWUB

main = do s <- getLine
          putStrLn $ calc s

trimするときにreverseが2回必要なのは仕方がないのかな…。

Codeforces 1A - A. Theatre Square

Codeforces

1A - A. Theatre Square

calc n m a = x * y
  where
    x = (n `div` a) + (signum $ n `mod` a)
    y = (m `div` a) + (signum $ m `mod` a)

main = do s <- getLine
          let [n, m, a] = map read $ words s :: [Integer]
          print $ calc n m a

signumを括弧で囲まないとエラーになります。:info で優先順位を確認出来ます。

Prelude> :info +
class Num a where
  (+) :: a -> a -> a
  ...
  	-- Defined in `GHC.Num'
infixl 6 +
Prelude> :info $
($) :: (a -> b) -> a -> b 	-- Defined in `GHC.Base'
infixr 0 $

参考: