Codeforces Beta Round #86 (Div. 2 Only)(参戦報告+A,B,C解法)

プログラミング

Codeforces Beta Round #86 Div.2に参戦。
言語はHaskell。

結果
A:488
B:824
C:1024
D:TLE
E:-2
位
2336 pts
Rating:1573 -> 1659

Eはpretestの時点でTLEが最後まで取れず、DもTLEで落ちました。
でもDiv2内で順位が2ケタ台までいけたし、なにより紫昇格＆Div 1昇格できたので個人的には上々の出来。






通した問題の解法をちょろっと。


A:
kがnの累乗数になってるか確認するだけですね。

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Debug.Trace
import Data.List
import Data.Array
import Data.Char
class Scan a where scan' :: String -> a
instance Scan Int where scan' = read
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' = read
instance Scan Double where scan' = read
instance Scan Integer where scan' = read
instance Scan String where scan' x = x
instance (Scan a,Scan b) => Scan (a,b) where scan' x = (\(x:y:_) -> (scan' x,scan' y)) (words x)
instance (Scan a,Scan b,Scan c) => Scan (a,b,c) where scan' x = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)) (words x)
instance (Scan a,Scan b,Scan c,Scan d) => Scan (a,b,c,d) where scan' x = (\(w:x:y:z:_) -> (scan' w,scan' x,scan' y,scan' z)) (words x)
instance (Scan a,Scan b,Scan c,Scan d,Scan e) => Scan (a,b,c,d,e) where scan' x = (\(v:w:x:y:z:_) -> (scan' v,scan' w,scan' x,scan' y,scan' z)) (words x)
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance Ans String where showans x = x
instance (Ans a, Ans b) => Ans (a,b) where showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z
scan :: (Scan a) => IO a
scan = getLine>>=(return.scan')
scans :: (Scan a) => Int -> IO [a]
scans n = if n==0 then return [] else scan>>=(\x->scans (n-1)>>=return.(x:))
scanlist :: (Scan a) => IO [a]
scanlist = getLine>>=return.(map scan').words
scanlists :: (Scan a) => Int -> IO [[a]]
scanlists n = if n==0 then return [] else scanlist>>=(\x->scanlists (n-1)>>=return.(x:))
putAnsLn :: (Ans a) => a -> IO ()
putAnsLn = putStrLn.showans
putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns = mapM_ putAnsLn

--ここまで入出力ライブラリ

solve k n m = if mod n k /= 0 then
                  ["NO"]
              else if div n k == 1 then
                       "YES":[show m]
                   else
                       solve k (div n k) (m+1)
                  

main = do k <- scan :: IO Int
          n <- scan ::IO Int
          putAnsLns (solve k n 0)

以下、入出力ライブラリ部分は省きます。
import宣言は書きます。

B:
n≦16と、問題のサイズが小さかったのでDFSで全探索。
リストを先頭から見ていき、「先頭の人をチームに入れた場合の最大値」と「先頭の人をチームに入れなかった場合の最大値」を比べて大きい方を返す関数recでDFSを行ってます。

同時にチームに入れられない２人の組み合わせはMapにリストで格納し、チームに入れた人間と一緒に入れられない人間をリストから外しながら再帰しています。リストの差分を返す演算子(\\)は重複があった場合一つしかリストから除きませんが、問題文に「n人のメンバーに重複はない」とあるので、そもそも重複を考えなくて良いことがわかります。

import Debug.Trace
import Data.List
import Data.Array
import Data.Char
import Data.Map

rec _ [] l = (length l,l)
rec antis (x:xs) l = let (a1,team1) = rec antis xs l in
                     let diff' = (Data.Map.lookup x antis) in
                     let diff = case diff' of
                                  Nothing -> []
                                  Just l -> l
                     in
                       let (a2,team2) = rec antis (xs Data.List.\\ diff) (x:l) in
                       if a1>a2 then
                           (a1,team1)
                       else
                           (a2,team2)

solve members n anti = let antis = foldl (\mp -> \(na,an) -> insertWith (++) an [na] (insertWith (++) na [an] mp)) empty anti in
                       let (ans,team) = rec antis members [] in
                       if ans==0 then
                           ["0"]
                       else
                           (show ans):(sort team)
                           

main = do (n,m) <- scan :: IO (Int,Int)
          members <- scans n :: IO [String]
          anti <- scans m :: IO [(String,String)]
          putAnsLns (solve members n anti)

C:
１単語 or 1文 であるときにYESを出力する問題。１単語の場合を忘れて一回pretestで弾かれました。

HaskellにはData.Listモジュールに、ある文字列の接尾語が指定したsuffixと一致しているかどうか調べるisSuffixOfという関数がありますので、これを使って接尾辞を調べられます。
性はBool値fで区別します。

isAdj f = isSuffixOf (if f then "lios" else "liala")
isNoun f = isSuffixOf (if f then "etr" else "etra")
isVerb f = isSuffixOf (if f then "initis" else "inites")

文章として適した順番かどうか調べるときは、f=True,Falseについて
(1)dropWhile (isAdj f) (入力)で先頭のAdj部分を切り落とし
(2)isNounで次の一語がNounであるか調べ
(3)all (isVerb f) (残り)で残りが全てVerbであるか調べる。

という手順であっさりと書けます。

import Debug.Trace
import Data.List
import Data.Array
import Data.Char

isAdj f = isSuffixOf (if f then "lios" else "liala")
isNoun f = isSuffixOf (if f then "etr" else "etra")
isVerb f = isSuffixOf (if f then "initis" else "inites")

parse f s = let s' = dropWhile (isAdj f) s in
            case s' of
              [] -> "NO"
              (x:xs) -> if isNoun f x && all (isVerb f) xs then
                            "YES"
                        else
                            "NO"
                
validword [] = False
validword (x:_) = (isVerb True x)
                  ||(isVerb False x)
                  ||(isNoun True x)
                  ||(isNoun False x)
                  ||(isAdj True x)
                  ||(isAdj False x)

solve s = if length s == 1 && validword s then
              "YES"
          else
              if parse True s == "NO" then
                  parse False s
              else
                  "YES"

main = do statement <- scanlist :: IO [String]
          putAnsLn (solve statement)

そういえば、少しIOライブラリを整理・追加しました。
可変個の引数取れないなどの問題があったので。
あと、mapM_などを用いたりdo記法を省いたりして全体的にコード量を減らしました。



最近ちょっとは読みやすいコードを書けるようになってきた気がします。おそらくまだまだなのでしょうが。
map・fold・filterなど、リストをまとめて処理する関数はなるべく使うようにしています。Haskellerらしくボイラープレートはなるべく排除していきたいです。


ではでは（・ω・）ﾉｼ