import Control.Arrow
import Data.Foldable
import Data.Graph
import qualified Data.Vector as V
import qualified Data.ByteString.Char8 as B

solve :: Int -> Int -> V.Vector B.ByteString -> Int
solve h w ss = sum $ map ((\(x,y) -> x*y) . foldl' (\(b,w) i -> (if ss !! getNode i == '#' then first (+1) else second (+1)) (b,w)) (0,0)) $ components graph
  where
    toIndex :: Int -> (Int,Int)
    toIndex n = (n `mod` w, n `div` w)

    fromIndex :: (Int,Int) -> Int
    fromIndex (x,y) = y * w + x

    (!!) :: V.Vector B.ByteString -> (Int,Int) -> Char
    vec !! (x,y) = (vec V.! y) `B.index` x

    getNode = (\(_,i,_) -> i) . getNodeKey

    (graph, getNodeKey, getVertex) = graphFromEdges $ map (\i -> (toIndex i, toIndex i, neighbors $ toIndex i)) [0..w*h-1]
      where
        neighbors (x,y) =
          [(x',y') |
            (ix,iy) <- [(0,1),(0,-1),(1,0),(-1,0)],
            let x' = x + ix, let y' = y + iy,
            0 <= x' && x' < w, 0 <= y' && y' < h,
            ss !! (x',y') /= ss !! (x,y)
          ]

main = do
  let readInt = fmap (second B.tail) . B.readInt

  hw <- V.unfoldrN 2 readInt <$> B.getLine
  ss <- V.replicateM (hw V.! 0) B.getLine
  print $ solve (hw V.! 0) (hw V.! 1) ss

Score : 300 points

Problem Statement

There is a grid with H rows and W columns, where each square is painted black or white.

You are given H strings S_1, S_2, ..., S_H, each of length W.
If the square at the i-th row from the top and the j-th column from the left is painted black, the j-th character in the string S_i is #; if that square is painted white, the j-th character in the string S_i is ..

Find the number of pairs of a black square c_1 and a white square c_2 that satisfy the following condition:

There is a path from the square c_1 to the square c_2 where we repeatedly move to a vertically or horizontally adjacent square through an alternating sequence of black and white squares: black, white, black, white...

Constraints

1 \leq H, W \leq 400

|S_i| = W (1 \leq i \leq H)

For each i (1 \leq i \leq H), the string S_i consists of characters # and ..

Input

Input is given from Standard Input in the following format:

H W
S_1
S_2
:
S_H

Output

Print the answer.

Sample Input 1

3 3
.#.
..#
#..

Sample Output 1

10

Some of the pairs satisfying the condition are ((1, 2), (3, 3)) and ((3, 1), (3, 2)), where (i, j) denotes the square at the i-th row from the top and the j-th column from the left.

Sample Input 2

2 4
....
....

Sample Output 2

0

Sample Input 3

4 3
###
###
...
###

Sample Output 3

6


import Control.Arrow
import Data.Bits
import Data.List
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VM
import qualified Data.ByteString.Char8 as B

solve :: Int -> Int -> V.Vector B.ByteString -> Int
solve h w ss = VU.sum $ VU.map (\(a,b) -> a*b) $ VU.foldl' go count $ VU.indexed $ (\(v,eqs) -> VU.map (mapper eqs) v) label
  where
    go counter (i,n) = VU.modify (\vec -> VM.modify vec (if ss !! (x,y) == '#' then first (+1) else second (+1)) n) counter
      where
        x = i `mod` w
        y = i `div` w

    (!!) :: V.Vector B.ByteString -> (Int, Int) -> Char
    vec !! (x,y) = (vec V.! y) `B.index` x

    (!+) :: VM.Unbox a => VU.Vector a -> (Int, Int) -> a
    vec !+ (x,y) = vec VU.! (y * w + x)

    count :: VU.Vector (Int,Int)
    count = VU.replicate (w*h+1) (0,0)

    mapper :: [(Int,Int)] -> Int -> Int
    mapper [] n = n
    mapper ((a,b):eqs) n
      | n == b = a
      | otherwise = mapper eqs n

    label :: (VU.Vector Int, [(Int,Int)])
    label = (\(a,b,_) -> (a, nub b)) $ foldl' go (VU.replicate (w*h) 0, [], 1) [0..w*h-1]
      where
        go (visited, eqs, f) i =
          if length neighbors == 0 then (VU.modify (\vec -> VM.write vec i f) visited, eqs, f+1)
          else if length neighbors == 1 then (VU.modify (\vec -> VM.write vec i (head neighbors)) visited, eqs, f)
          else (VU.modify (\vec -> VM.write vec i (head neighbors)) visited, map ((,) (head neighbors)) (tail neighbors), f)
            where
              x = i `mod` w
              y = i `div` w
              ch = ss !! (x,y)

              neighbors = nub $
                [ visited !+ (x',y')
                | (ix,iy) <- [(1,0),(-1,0),(0,1),(0,-1)],
                  let x' = x + ix, let y' = y + iy,
                  0 <= x' && x' < w, 0 <= y' && y' < h,
                  visited !+ (x',y') /= 0,
                  ss !! (x',y') /= ch
                ]

main = do
  let readInt = fmap (second B.tail) . B.readInt

  hw <- V.unfoldrN 2 readInt <$> B.getLine
  ss <- V.replicateM (hw V.! 0) B.getLine
  print $ solve (hw V.! 0) (hw V.! 1) ss

Global OOD problem IDs are disjoint from train, validation, and in-distribution test problem IDs.

Submitted source-code file size, in bytes.

Execution CPU time reported by official Project CodeNet metadata, in milliseconds.

Peak memory usage reported by official Project CodeNet metadata, in kilobytes.


import Control.Arrow
import Data.Bits
import Data.List
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VM
import qualified Data.ByteString.Char8 as B

--solve :: Int -> Int -> V.Vector B.ByteString -> Int
solve h w ss = label
  where
    (!!) :: V.Vector B.ByteString -> (Int, Int) -> Char
    vec !! (x,y) = (vec V.! y) `B.index` x

    (!+) :: VM.Unbox a => VU.Vector a -> (Int, Int) -> a
    vec !+ (x,y) = vec VU.! (y * w + x)

    label :: (VU.Vector Int, [(Int,Int)])
    label = (\(a,b,_) -> (a,b)) $ foldl' go (VU.replicate (w*h) 0, [], 1) [0..w*h-1]
      where
        go (visited, eqs, f) i =
          if length neighbors == 0 then (VU.modify (\vec -> VM.write vec i f) visited, eqs, f+1)
          else if length neighbors == 1 then (VU.modify (\vec -> VM.write vec i (head neighbors)) visited, eqs, f)
          else error "error" -- (VU.modify (\vec -> VM.write vec i (head neighbors)) visited, map ((,) (head neighbors)) (tail neighbors), f)
            where
              x = i `mod` w
              y = i `div` w
              ch = ss !! (x,y)

              neighbors = nub $
                [ visited !+ (x',y')
                | (ix,iy) <- [(1,0),(-1,0),(0,1),(0,-1)],
                  let x' = x + ix, let y' = y + iy,
                  0 <= x' && x' < w, 0 <= y' && y' < h,
                  visited !+ (x',y') /= 0,
                  ss !! (x',y') /= ch
                ]

main = do
  let readInt = fmap (second B.tail) . B.readInt

  hw <- V.unfoldrN 2 readInt <$> B.getLine
  ss <- V.replicateM (hw V.! 0) B.getLine
  print $ solve (hw V.! 0) (hw V.! 1) ss


import qualified Data.ByteString.Char8 as BC
import Data.Maybe

readIntsLines :: IO [[Int]]
readIntsLines = map (map (fst . fromJust . BC.readInt) . BC.words) . BC.lines <$> BC.getContents

calc :: [Int] -> [Int] -> [Int]
calc [pa, pb, pc] [ca, cb, cc] = [na, nb, nc]
  where na = max (pb + ca) (pc + ca)
        nb = max (pa + cb) (pc + cb)
        nc = max (pa + cc) (pb + cc)

solve :: [Int] -> [[Int]] -> [[Int]]
solve _ [] = []
solve pabc (cabc:abcs) = nabc : solve nabc abcs
  where nabc = calc pabc cabc

main :: IO ()
main = do
  getLine
  abcs <- readIntsLines
  print . maximum . last $ solve [0,0,0] abcs

Score : 100 points

Problem Statement

Taro's summer vacation starts tomorrow, and he has decided to make plans for it now.

The vacation consists of N days.
For each i (1 \leq i \leq N), Taro will choose one of the following activities and do it on the i-th day:

A: Swim in the sea. Gain a_i points of happiness.

B: Catch bugs in the mountains. Gain b_i points of happiness.

C: Do homework at home. Gain c_i points of happiness.

As Taro gets bored easily, he cannot do the same activities for two or more consecutive days.

Find the maximum possible total points of happiness that Taro gains.

Constraints

All values in input are integers.

1 \leq N \leq 10^5

1 \leq a_i, b_i, c_i \leq 10^4

Input

Input is given from Standard Input in the following format:

N
a_1 b_1 c_1
a_2 b_2 c_2
:
a_N b_N c_N

Output

Print the maximum possible total points of happiness that Taro gains.

Sample Input 1

3
10 40 70
20 50 80
30 60 90

Sample Output 1

210

If Taro does activities in the order C, B, C, he will gain 70 + 50 + 90 = 210 points of happiness.

Sample Input 2

1
100 10 1

Sample Output 2

100

Sample Input 3

7
6 7 8
8 8 3
2 5 2
7 8 6
4 6 8
2 3 4
7 5 1

Sample Output 3

46

Taro should do activities in the order C, A, B, A, C, B, A.


import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.List
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words
getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

main = do
    [n,maxW] <- getIntList
    items <- replicateM n $ do
        [w,v] <- getIntList
        return (w,v)
    let mV = sum $ map snd items
    print . pred . VU.length . VU.filter (<= maxW) . VU.scanr min 1000000000 $ solve mV items

solve mV [] = VU.create $ do
    vec <- VUM.replicate (mV+1) 10000
    VUM.write vec 0 0
    return vec
solve mV ((w,v):xs)
  = let a = solve mV xs
    in VU.generate (mV+1)
      $ \i -> if v <= i then
                  min (a VU.! i) (a VU.! (i-v) + w)
              else a VU.! i

Score : 100 points

Problem Statement

There are N items, numbered 1, 2, \ldots, N.
For each i (1 \leq i \leq N), Item i has a weight of w_i and a value of v_i.

Taro has decided to choose some of the N items and carry them home in a knapsack.
The capacity of the knapsack is W, which means that the sum of the weights of items taken must be at most W.

Find the maximum possible sum of the values of items that Taro takes home.

Constraints

All values in input are integers.

1 \leq N \leq 100

1 \leq W \leq 10^9

1 \leq w_i \leq W

1 \leq v_i \leq 10^3

Input

Input is given from Standard Input in the following format:

N W
w_1 v_1
w_2 v_2
:
w_N v_N

Output

Print the maximum possible sum of the values of items that Taro takes home.

Sample Input 1

3 8
3 30
4 50
5 60

Sample Output 1

90

Items 1 and 3 should be taken.
Then, the sum of the weights is 3 + 5 = 8, and the sum of the values is 30 + 60 = 90.

Sample Input 2

1 1000000000
1000000000 10

Sample Output 2

10

Sample Input 3

6 15
6 5
5 6
6 4
6 6
3 5
7 2

Sample Output 3

17

Items 2, 4 and 5 should be taken.
Then, the sum of the weights is 5 + 6 + 3 = 14, and the sum of the values is 6 + 6 + 5 = 17.


{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
import           Control.Monad
import           Control.Monad.ST
import           Control.Monad.State
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.List
import qualified Data.Vector                 as V
import qualified Data.Vector.Mutable         as VM
import qualified Data.Vector.Unboxed         as VU
import qualified Data.Vector.Unboxed.Mutable as VUM

main :: IO ()
main = do
  [n,m] <- readLnAsListWith unconsInt
  edges <- readLnAsUVecWith2Tuple unconsInt m
  let g = graph' edges n
      path = dfs [0..n-1] g
  -- print $ VU.maximum path
  print path

type Graph a = V.Vector [(Int, a)]
-- type Graph a = V.Vector (a, [Vertex])
type FlagVec s = VUM.MVector s Bool
type Vertex = Int

-- 解くべき問題により、シグネチャは変更する
dfs :: VU.Unbox a => [Vertex] -> Graph a -> VU.Vector Int
dfs vs g = VU.create $ do
  seen <- VUM.replicate (V.length g) False
  path <- VUM.replicate (V.length g) 0
  mapM_ (go seen path) vs
  return path
  where go :: FlagVec s -> VUM.MVector s Int -> Vertex -> ST s ()
        go seen path v = do
          VUM.write seen v True
          forM_ (g V.! v) $ \(nv, _) -> do
            s <- VUM.read seen nv
            if s
              then do lv <- VUM.read path v
                      lnv <- VUM.read path nv
                      VUM.write path v (max lv (lnv + 1))
              else do go seen path nv
                      lnv <- VUM.read path nv
                      VUM.write path v (lnv + 1)

-- 重みなしグラフ
graph' :: VU.Vector (Vertex, Vertex) -> Int -> Graph ()
graph' = graph . VU.map (\(x,y) -> (x,y,()))

-- 有向グラフの場合は、to側の隣接リスト追加部分をコメントアウト
graph :: VU.Unbox a => VU.Vector (Vertex, Vertex, a) -> Int -> Graph a
graph vec n = V.create $ do
  g <- VM.replicate n []
  let l = VU.length vec
  forM_ [0..l-1] $ \i -> do
    let (from,to,w) = vec VU.! i
        f = from - 1
        t = to - 1
    VM.modify g ((t,w):) f
    -- VM.modify g ((f,w):) t
  return g

-- converter
unconsInt :: StateT BS.ByteString Maybe Int
unconsInt = StateT $ BS.readInt . BS.dropWhile isSpace

-- 1D Data
-- for list
readLnAsListWith :: StateT BS.ByteString Maybe a -> IO [a]
readLnAsListWith !st = unfoldr (runStateT st) <$> BS.getLine

-- for unboxed vector
readLnAsUVecWith :: VU.Unbox a => StateT BS.ByteString Maybe a -> Int -> IO (VU.Vector a)
readLnAsUVecWith !st !n = VU.unfoldrN n (runStateT st) <$> BS.getLine

-- example: 1D tuple vector
readLnAsUVecWith2Tuple :: VU.Unbox a => StateT BS.ByteString Maybe a -> Int -> IO (VU.Vector (a,a))
readLnAsUVecWith2Tuple !st !n = VU.replicateM n $ (\vec -> (vec VU.! 0, vec VU.! 1)) <$> readLnAsUVecWith st 2

Score : 100 points

Problem Statement

There is a directed graph G with N vertices and M edges.
The vertices are numbered 1, 2, \ldots, N, and for each i (1 \leq i \leq M), the i-th directed edge goes from Vertex x_i to y_i.
G does not contain directed cycles.

Find the length of the longest directed path in G.
Here, the length of a directed path is the number of edges in it.

Constraints

All values in input are integers.

2 \leq N \leq 10^5

1 \leq M \leq 10^5

1 \leq x_i, y_i \leq N

All pairs (x_i, y_i) are distinct.

G does not contain directed cycles.

Input

Input is given from Standard Input in the following format:

N M
x_1 y_1
x_2 y_2
:
x_M y_M

Output

Print the length of the longest directed path in G.

Sample Input 1

4 5
1 2
1 3
3 2
2 4
3 4

Sample Output 1

3

The red directed path in the following figure is the longest:

Sample Input 2

6 3
2 3
4 5
5 6

Sample Output 2

2

The red directed path in the following figure is the longest:

Sample Input 3

5 8
5 3
2 3
2 4
5 2
5 1
1 4
4 3
1 3

Sample Output 3

3

The red directed path in the following figure is one of the longest:


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where

import Control.Monad (replicateM, forM_)
import Data.Bool (bool)
import Data.Char (isSpace)
import Data.Function (on)
import Data.Graph (Vertex, Edge, buildG, topSort)
import Data.List (unfoldr, foldl', sort, (\\), delete)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Unsafe as B
import System.IO (hPutStr, hPutStrLn, stdin, stdout, withFile, IOMode(..))

type Parser a = C.ByteString -> Maybe (a, C.ByteString)

parseInt :: Parser Int
parseInt = C.readInt . C.dropWhile isSpace

getInts :: IO [Int]
getInts = unfoldr parseInt <$> C.getLine

getIntVec :: Int -> IO (U.Vector Int)
getIntVec n = U.unfoldrN n parseInt <$> C.getLine

---------------------------------------------------------
swap (x, y) = (y, x)
pair (f, g) x = (f x, g x)
cross (f, g) (x, y) = (f x, g y)

newtype Fix f = In { out :: f (Fix f) }

newtype Cofree f a = Cf { unCf :: (a, f (Cofree f a)) }
extract :: Cofree f t -> t
extract = fst . unCf
sub :: Functor f => Cofree f a -> f (Cofree f a)
sub = snd . unCf

newtype Free f a = Fr { unFr :: Either a (f (Free f a)) }
inject :: a -> Free f a
inject = Fr . Left

-- catamorphism
cata :: Functor f => (f a -> a) -> Fix f -> a
cata phi = phi . fmap (cata phi) . out
-- anamorphism
ana :: Functor f => (a -> f a) -> a -> Fix f
ana psi = In . fmap (ana psi) . psi
-- hylomorphism
hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo phi psi = phi . fmap (hylo phi psi) . psi -- cata phi . ana psi
-- metamorphism
meta :: Functor f => (f a -> a) -> (a -> f a) -> Fix f -> Fix f
meta phi psi = In . fmap (meta phi psi) . out -- ana psi . cata phi
-- paramorphism
para :: Functor f => (f (Fix f, t) -> t) -> Fix f -> t
para phi = phi . fmap (pair (id, para phi)) . out
-- apomorphism
apo :: Functor f => (t -> f (Either (Fix f) t)) -> t -> Fix f
apo psi = In . fmap (uncurry either (id, apo psi)) . psi
-- histomorphism
histo :: Functor f => (f (Cofree f t) -> t) -> Fix f -> t
histo phi = extract . cata (Cf . pair (phi, id))
-- futumorphism
futu :: Functor f => (t -> f (Free f t)) -> t -> Fix f
futu psi = ana (uncurry either (psi, id) . unFr) . inject
-- chronomorphism
chrono :: Functor f => (f (Cofree f b) -> b) -> (a -> f (Free f a)) -> a -> b
chrono phi psi = extract . hylo phi' psi' . inject
  where
    phi' = Cf . pair (phi, id)
    psi' = uncurry either (psi, id) . unFr
-- cochronomorphism
cochrono :: Functor f => (f (Cofree f t) -> t) -> (t -> f (Free f t)) -> Fix f -> Fix f
cochrono phi psi = futu psi . histo phi
-- zygomorphism
zygo :: Functor f => (f a -> a) -> (f (a, b) -> b) -> Fix f -> b
zygo f phi = snd . cata (pair (f . fmap fst, phi))
-- cozygomorphism
cozygo :: Functor f => (a -> f a) -> (b -> f (Either a b)) -> b -> Fix f
cozygo f psi = ana (uncurry either (fmap Left . f, psi)) . Right
-- dynamorphism
dyna :: Functor f => (f (Cofree f b) -> b) -> (a -> f a) -> a -> b
dyna f g = chrono f (fmap inject . g) -- histo f . ana g
-- codynamorphism
codyna :: Functor f => (f b -> b) -> (a -> f (Free f a)) -> a -> b
codyna f g = chrono (f . fmap extract) g
-- mutumorphism
mutu :: Functor f => (a -> b) -> (f a -> a) -> Fix f -> b
mutu proj phi = proj . cata phi
-- comutumorphism
comutu :: Functor f => (b -> a) -> (a -> f a) -> b -> Fix f
comutu proj psi = ana psi . proj

foldn (c, f) 0 = c
foldn (c, f) n = f (foldn (c, f) (n-1))

paran (c, f) 0 = c
paran (c, f) n = f n (paran (c, f) (n-1))

---------------------------------------------------------

getTuple :: IO Edge
getTuple = do
  (x:y:_) <- getInts
  return (x, y)

getIdxTuple :: IO Edge
getIdxTuple = cross (pred, pred) <$> getTuple

getProblem :: IO (Int, Int, U.Vector Edge)
getProblem = do
  (n, m) <- getTuple
  xys <- U.replicateM m getIdxTuple
  return (n, m, xys)

data NonEmptyListF a = NonEmptyListF (Vertex, [Vertex], [Int]) (Maybe a) deriving (Show, Functor)

targets :: Int -> U.Vector Edge -> V.Vector [Vertex]
targets n es = V.create $ do
  vec <- VM.replicate n []
  U.forM_ es $ \(s, t) -> do
    VM.modify vec (t:) s
  return vec

transposition :: Map.Map Vertex Int -> Vertex -> Vertex -> Int
transposition dict !s !e = (dict Map.! e) - (dict Map.! s)

transpositions :: Map.Map Vertex Int -> Vertex -> [Vertex] -> [Int]
transpositions dict !v !vs = map (transposition dict v) vs

compileWith :: Map.Map Vertex Int -> V.Vector [Vertex] -> U.Vector Vertex -> V.Vector [Int]
compileWith dict ds vs = V.create $ do
  vec <- VM.replicate (U.length vs) []
  U.forM_ vs $ \s -> do
    VM.write vec (dict Map.! s) $! transpositions dict s (ds V.! s)
  return vec

calcStart :: U.Vector (Vertex, Vertex) -> Int -> [Vertex]
calcStart xys n = filter (\k -> Map.notMember k me) [0..n]
  where
    !me = U.foldl' (\me' (_, v) -> bool me' (Map.insert v True me') (Map.notMember v me')) Map.empty xys

main :: IO ()
main = do
  (!n, !m, !xys) <- getProblem
  print $ solve n xys

solve :: Int -> U.Vector Edge -> Int
solve n xys = dyna phi psi n'
  where
    !n' = n-1
    vs :: U.Vector Vertex
    !vs = U.fromList . topSort . buildG (0, n') . U.toList $ xys
    ds :: V.Vector [Vertex]
    ds = targets n xys
    dict :: Map.Map Vertex Int
    !dict = Map.fromList . U.toList . U.map swap . U.indexed $ vs
    ds' :: V.Vector [Int]
    ds' = compileWith dict ds vs
    startlist :: [Int]
    !startlist = sort $ delete 0 $ transpositions dict (vs U.! 0) $! calcStart xys n'

    psi 0 = NonEmptyListF (vs U.! n', sort $ ds' V.! n', []) Nothing
    psi i = NonEmptyListF (vs U.! (n'-i), sort $ ds' V.! (n'-i), bool [] startlist (i == n')) (Just (i-1))

    phi :: NonEmptyListF (Cofree NonEmptyListF Int) -> Int
    phi (NonEmptyListF _ Nothing) = 0
    phi prev@(NonEmptyListF (_, bps, ss) (Just t))
      | null bps = back 0 1 ss prev
      | otherwise = max (back 0 1 bps prev + 1) (back 0 1 ss prev)

    back :: Int -> Int -> [Int] -> NonEmptyListF (Cofree NonEmptyListF Int) -> Int
    back ret i [] _ = ret
    back ret i _ (NonEmptyListF _ Nothing) = ret
    back ret i bps@(j:js) nel@(NonEmptyListF _ (Just t))
      | i == j = let !ret' = max ret (extract t) in back ret' (i+1) js (sub t)
      | otherwise = back ret (i+1) bps (sub t)


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where

import Control.Monad (replicateM, forM_)
import Data.Bool (bool)
import Data.Char (isSpace)
import Data.Function (on)
import Data.Graph (Vertex, Edge, buildG, topSort)
import Data.List (unfoldr, foldl', sort, (\\), delete)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Unsafe as B
import System.IO (hPutStr, hPutStrLn, stdin, stdout, withFile, IOMode(..))

type Parser a = C.ByteString -> Maybe (a, C.ByteString)

parseInt :: Parser Int
parseInt = C.readInt . C.dropWhile isSpace

getInts :: IO [Int]
getInts = unfoldr parseInt <$> C.getLine

getIntVec :: Int -> IO (U.Vector Int)
getIntVec n = U.unfoldrN n parseInt <$> C.getLine

---------------------------------------------------------
{-# INLINE swap #-}
swap (x, y) = (y, x)
{-# INLINE pair #-}
pair (f, g) x = (f x, g x)
{-# INLINE cross #-}
cross (f, g) (x, y) = (f x, g y)

newtype Fix f = In { out :: f (Fix f) }

newtype Cofree f a = Cf { unCf :: (a, f (Cofree f a)) }
extract :: Cofree f t -> t
extract = fst . unCf
sub :: Functor f => Cofree f a -> f (Cofree f a)
sub = snd . unCf

newtype Free f a = Fr { unFr :: Either a (f (Free f a)) }
inject :: a -> Free f a
inject = Fr . Left

-- catamorphism
cata :: Functor f => (f a -> a) -> Fix f -> a
cata phi = phi . fmap (cata phi) . out
-- anamorphism
ana :: Functor f => (a -> f a) -> a -> Fix f
ana psi = In . fmap (ana psi) . psi
-- hylomorphism
hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo phi psi = cata phi . ana psi -- phi . fmap (hylo phi psi) . psi
-- metamorphism
meta :: Functor f => (f a -> a) -> (a -> f a) -> Fix f -> Fix f
meta phi psi = ana psi . cata phi -- In . fmap (meta phi psi) . out
-- paramorphism
para :: Functor f => (f (Fix f, t) -> t) -> Fix f -> t
para phi = phi . fmap (pair (id, para phi)) . out
-- apomorphism
apo :: Functor f => (t -> f (Either (Fix f) t)) -> t -> Fix f
apo psi = In . fmap (uncurry either (id, apo psi)) . psi
-- histomorphism
histo :: Functor f => (f (Cofree f t) -> t) -> Fix f -> t
histo phi = extract . cata (Cf . pair (phi, id))
-- futumorphism
futu :: Functor f => (t -> f (Free f t)) -> t -> Fix f
futu psi = ana (uncurry either (psi, id) . unFr) . inject
-- chronomorphism
chrono :: Functor f => (f (Cofree f b) -> b) -> (a -> f (Free f a)) -> a -> b
chrono phi psi = histo phi . futu psi
-- cochronomorphism
cochrono :: Functor f => (f (Cofree f t) -> t) -> (t -> f (Free f t)) -> Fix f -> Fix f
cochrono phi psi = futu psi . histo phi
-- zygomorphism
zygo :: Functor f => (f a -> a) -> (f (a, b) -> b) -> Fix f -> b
zygo f phi = snd . cata (pair (f . fmap fst, phi))
-- cozygomorphism
cozygo :: Functor f => (a -> f a) -> (b -> f (Either a b)) -> b -> Fix f
cozygo f psi = ana (uncurry either (fmap Left . f, psi)) . Right
-- dynamorphism
dyna :: Functor f => (f (Cofree f b) -> b) -> (a -> f a) -> a -> b
dyna f g = chrono f (fmap inject . g) -- histo f . ana g
-- codynamorphism
codyna :: Functor f => (f b -> b) -> (a -> f (Free f a)) -> a -> b
codyna f g = chrono (f . fmap extract) g
-- mutumorphism
mutu :: Functor f => (a -> b) -> (f a -> a) -> Fix f -> b
mutu proj phi = proj . cata phi
-- comutumorphism
comutu :: Functor f => (b -> a) -> (a -> f a) -> b -> Fix f
comutu proj psi = ana psi . proj

foldn (c, f) 0 = c
foldn (c, f) n = f (foldn (c, f) (n-1))

paran (c, f) 0 = c
paran (c, f) n = f n (paran (c, f) (n-1))

---------------------------------------------------------

getTuple :: IO Edge
getTuple = do
  (x:y:_) <- getInts
  return (x, y)

getIdxTuple :: IO Edge
getIdxTuple = cross (pred, pred) <$> getTuple

getProblem :: IO (Int, Int, U.Vector Edge)
getProblem = do
  (n, m) <- getTuple
  xys <- U.replicateM m getIdxTuple
  return (n, m, xys)

data NonEmptyListF a = NonEmptyListF (Vertex, [Vertex], [Int]) (Maybe a) deriving (Show, Functor)

targets :: Int -> U.Vector Edge -> V.Vector [Vertex]
targets n es = V.create $ do
  vec <- VM.replicate n []
  U.forM_ es $ \(s, t) -> do
    VM.modify vec (t:) s
  return vec

transposition :: Map.Map Vertex Int -> Vertex -> Vertex -> Int
transposition dict = flip ((-) `on` (dict Map.!))

transpositions :: Map.Map Vertex Int -> Vertex -> [Vertex] -> [Int]
transpositions dict = map . (transposition dict)

compileWith :: Map.Map Vertex Int -> V.Vector [Vertex] -> U.Vector Vertex -> V.Vector [Int]
compileWith dict ds vs = V.create $ do
  vec <- VM.replicate (U.length vs) []
  U.forM_ vs $ \s -> do
    VM.write vec (dict Map.! s) $ transpositions dict s (ds V.! s)
  return vec

calcStart :: U.Vector (Vertex, Vertex) -> Int -> [Vertex]
calcStart xys n = filter (\k -> Map.notMember k me) [0..n]
  where
    me = U.foldl' (\me' (_, v) -> Map.insert v True me') Map.empty xys

main :: IO ()
main = do
  (n, m, xys) <- getProblem
  print $ solve n xys

solve :: Int -> U.Vector Edge -> Int
solve n xys = dyna phi psi (n-1)
  where
    !n' = n-1
    vs :: U.Vector Vertex
    !vs = U.fromList . topSort . buildG (0, n') . U.toList $ xys
    ds :: V.Vector [Vertex]
    ds = targets n xys
    dict :: Map.Map Vertex Int
    dict = Map.fromList . U.toList . U.map swap . U.indexed $ vs
    ds' :: V.Vector [Int]
    ds' = compileWith dict ds vs
    startlist :: [Int]
    !startlist = sort $ delete 0 $ transpositions dict (vs U.! 0) $ calcStart xys n'

    psi 0 = NonEmptyListF (vs U.! n', sort $ ds' V.! n', []) Nothing
    psi i = NonEmptyListF (vs U.! (n'-i), sort $ ds' V.! (n'-i), bool [] startlist (i == n')) (Just (i-1))

    phi :: NonEmptyListF (Cofree NonEmptyListF Int) -> Int
    phi (NonEmptyListF _ Nothing) = 0
    phi prev@(NonEmptyListF (_, bps, ss) (Just t))
      | null bps = back 0 1 ss prev
      | otherwise = max (back 0 1 bps prev + 1) (back 0 1 ss prev)

    back :: Int -> Int -> [Int] -> NonEmptyListF (Cofree NonEmptyListF Int) -> Int
    back ret i [] _ = ret
    back ret i bps@(j:js) nel@(NonEmptyListF _ mv)
      | i == j = maybe ret (\t -> back (max ret (extract t)) (i+1) js (sub t)) mv
      | otherwise = let Just t = mv in back ret (i+1) bps (sub t)

gensample = withFile "DP/lp-sample.txt" WriteMode $ \h -> do
  let xs = [(i,i+j) | i <- [1..1000], j <- [1..1000]]
  let (x, y) = (max 10000 (max (maximum (map fst xs)) (maximum (map snd xs))), length xs)
  hPutStr h (show x)
  hPutStr h " "
  hPutStrLn h (show y)
  forM_ xs $ \(x, y) -> do
    hPutStr h (show x)
    hPutStr h " "
    hPutStrLn h (show y)


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where

import Control.Monad (replicateM, forM_)
import Data.Bool (bool)
import Data.Char (isSpace)
import Data.Function (on)
import Data.Graph (Vertex, Edge, buildG, topSort)
import Data.List (unfoldr, foldl', sort, (\\), delete)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Unsafe as B
import System.IO (hPutStr, hPutStrLn, stdin, stdout, withFile, IOMode(..))

type Parser a = C.ByteString -> Maybe (a, C.ByteString)

parseInt :: Parser Int
parseInt = C.readInt . C.dropWhile isSpace

getInts :: IO [Int]
getInts = unfoldr parseInt <$> C.getLine

getIntVec :: Int -> IO (U.Vector Int)
getIntVec n = U.unfoldrN n parseInt <$> C.getLine

---------------------------------------------------------
{-# INLINE swap #-}
swap (x, y) = (y, x)
{-# INLINE pair #-}
pair (f, g) x = (f x, g x)
{-# INLINE cross #-}
cross (f, g) (x, y) = (f x, g y)

newtype Fix f = In { out :: f (Fix f) }

newtype Cofree f a = Cf { unCf :: (a, f (Cofree f a)) }
extract :: Cofree f t -> t
extract = fst . unCf
sub :: Functor f => Cofree f a -> f (Cofree f a)
sub = snd . unCf

newtype Free f a = Fr { unFr :: Either a (f (Free f a)) }
inject :: a -> Free f a
inject = Fr . Left

-- catamorphism
cata :: Functor f => (f a -> a) -> Fix f -> a
cata phi = phi . fmap (cata phi) . out
-- anamorphism
ana :: Functor f => (a -> f a) -> a -> Fix f
ana psi = In . fmap (ana psi) . psi
-- hylomorphism
hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo phi psi = cata phi . ana psi -- phi . fmap (hylo phi psi) . psi
-- metamorphism
meta :: Functor f => (f a -> a) -> (a -> f a) -> Fix f -> Fix f
meta phi psi = ana psi . cata phi -- In . fmap (meta phi psi) . out
-- paramorphism
para :: Functor f => (f (Fix f, t) -> t) -> Fix f -> t
para phi = phi . fmap (pair (id, para phi)) . out
-- apomorphism
apo :: Functor f => (t -> f (Either (Fix f) t)) -> t -> Fix f
apo psi = In . fmap (uncurry either (id, apo psi)) . psi
-- histomorphism
histo :: Functor f => (f (Cofree f t) -> t) -> Fix f -> t
histo phi = extract . cata (Cf . pair (phi, id))
-- futumorphism
futu :: Functor f => (t -> f (Free f t)) -> t -> Fix f
futu psi = ana (uncurry either (psi, id) . unFr) . inject
-- chronomorphism
chrono :: Functor f => (f (Cofree f b) -> b) -> (a -> f (Free f a)) -> a -> b
chrono phi psi = histo phi . futu psi
-- cochronomorphism
cochrono :: Functor f => (f (Cofree f t) -> t) -> (t -> f (Free f t)) -> Fix f -> Fix f
cochrono phi psi = futu psi . histo phi
-- zygomorphism
zygo :: Functor f => (f a -> a) -> (f (a, b) -> b) -> Fix f -> b
zygo f phi = snd . cata (pair (f . fmap fst, phi))
-- cozygomorphism
cozygo :: Functor f => (a -> f a) -> (b -> f (Either a b)) -> b -> Fix f
cozygo f psi = ana (uncurry either (fmap Left . f, psi)) . Right
-- dynamorphism
dyna :: Functor f => (f (Cofree f b) -> b) -> (a -> f a) -> a -> b
dyna f g = chrono f (fmap inject . g) -- histo f . ana g
-- codynamorphism
codyna :: Functor f => (f b -> b) -> (a -> f (Free f a)) -> a -> b
codyna f g = chrono (f . fmap extract) g
-- mutumorphism
mutu :: Functor f => (a -> b) -> (f a -> a) -> Fix f -> b
mutu proj phi = proj . cata phi
-- comutumorphism
comutu :: Functor f => (b -> a) -> (a -> f a) -> b -> Fix f
comutu proj psi = ana psi . proj

foldn (c, f) 0 = c
foldn (c, f) n = f (foldn (c, f) (n-1))

paran (c, f) 0 = c
paran (c, f) n = f n (paran (c, f) (n-1))

---------------------------------------------------------

getTuple :: IO Edge
getTuple = do
  (x:y:_) <- getInts
  return (x, y)

getIdxTuple :: IO Edge
getIdxTuple = cross (pred, pred) <$> getTuple

getProblem :: IO (Int, Int, U.Vector Edge)
getProblem = do
  (n, m) <- getTuple
  xys <- U.replicateM m getIdxTuple
  return (n, m, xys)

data NonEmptyListF a = NonEmptyListF (Vertex, [Vertex], [Int]) (Maybe a) deriving (Show, Functor)

targets :: Int -> U.Vector Edge -> V.Vector [Vertex]
targets n es = V.create $ do
  vec <- VM.replicate n []
  U.forM_ es $ \(s, t) -> do
    VM.modify vec (t:) s
  return vec

transposition :: Map.Map Vertex Int -> Vertex -> Vertex -> Int
transposition dict = flip ((-) `on` (dict Map.!))

transpositions :: Map.Map Vertex Int -> Vertex -> [Vertex] -> [Int]
transpositions dict = map . (transposition dict)

compileWith :: Map.Map Vertex Int -> V.Vector [Vertex] -> U.Vector Vertex -> V.Vector [Int]
compileWith dict ds vs = V.create $ do
  vec <- VM.replicate (U.length vs) []
  U.forM_ vs $ \s -> do
    VM.write vec (dict Map.! s) $ transpositions dict s (ds V.! s)
  return vec

main :: IO ()
main = do
  (n, m, xys) <- getProblem
  print $ solve n xys

gensample = withFile "DP/lp-sample.txt" WriteMode $ \h -> do
  let xs = [(i,i+j) | i <- [1..1000], j <- [1..1000]]
  let (x, y) = (max 10000 (max (maximum (map fst xs)) (maximum (map snd xs))), length xs)
  hPutStr h (show x)
  hPutStr h " "
  hPutStrLn h (show y)
  forM_ xs $ \(x, y) -> do
    hPutStr h (show x)
    hPutStr h " "
    hPutStrLn h (show y)

solve :: Int -> U.Vector Edge -> Int
solve n xys = dyna phi psi (n-1)
  where
    !n' = n-1
    vs :: U.Vector Vertex
    !vs = U.fromList . topSort . buildG (0, n') . U.toList $ xys
    ds :: V.Vector [Vertex]
    ds = targets n xys
    dict :: Map.Map Vertex Int
    dict = Map.fromList . U.toList . U.map swap . U.indexed $ vs
    ds' :: V.Vector [Int]
    ds' = compileWith dict ds vs
    !nosupports = Set.toList $ Set.fromAscList [0..n'] Set.\\ (Set.fromList $ map snd $ U.toList xys)
    !startlist = sort $ delete 0 $ transpositions dict (vs U.! 0) nosupports

    psi 0 = NonEmptyListF (vs U.! n', sort $ ds' V.! n', []) Nothing
    psi i = NonEmptyListF (vs U.! (n'-i), sort $ ds' V.! (n'-i), bool [] startlist (i == n')) (Just (i-1))

    phi :: NonEmptyListF (Cofree NonEmptyListF Int) -> Int
    phi (NonEmptyListF _ Nothing) = 0
    phi prev@(NonEmptyListF (_, bps, ss) (Just t))
      | null bps = back 0 1 ss prev
      | otherwise = max (back 0 1 bps prev + 1) (back 0 1 ss prev)

    back :: Int -> Int -> [Int] -> NonEmptyListF (Cofree NonEmptyListF Int) -> Int
    back ret i [] _ = ret
    back ret i bps@(j:js) nel@(NonEmptyListF _ mv)
      | i == j = maybe ret (\t -> back (max ret (extract t)) (i+1) js (sub t)) mv
      | otherwise = let Just t = mv in back ret (i+1) bps (sub t)


import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import Data.List
import Control.Monad

main = do
    n <- readLn :: IO Int
    ps <- map read . words <$> getLine :: IO [Double]
    print . VU.sum . VU.drop (n `div` 2 + 1) $ toss n ps

toss n ps = VU.create $ do
    vec <- VUM.replicate (n + 1) 0
    VUM.write vec 0 1
    forM_ ps $ \p -> do
        forM_ [n,n-1..1] $ \i -> do
            p1 <- VUM.read vec i
            p2 <- VUM.read vec (i-1)
            VUM.write vec i (p1 * (1-p) + p2 * p)
        p0 <- VUM.read vec 0
        VUM.write vec 0 (p0*(1-p))
    return vec

Score : 100 points

Problem Statement

Let N be a positive odd number.

There are N coins, numbered 1, 2, \ldots, N.
For each i (1 \leq i \leq N), when Coin i is tossed, it comes up heads with probability p_i and tails with probability 1 - p_i.

Taro has tossed all the N coins.
Find the probability of having more heads than tails.

Constraints

N is an odd number.

1 \leq N \leq 2999

p_i is a real number and has two decimal places.

0 < p_i < 1

Input

Input is given from Standard Input in the following format:

N
p_1 p_2 \ldots p_N

Output

Print the probability of having more heads than tails.
The output is considered correct when the absolute error is not greater than 10^{-9}.

Sample Input 1

3
0.30 0.60 0.80

Sample Output 1

0.612

The probability of each case where we have more heads than tails is as follows:

The probability of having (Coin 1, Coin 2, Coin 3) = (Head, Head, Head) is 0.3 × 0.6 × 0.8 = 0.144;

The probability of having (Coin 1, Coin 2, Coin 3) = (Tail, Head, Head) is 0.7 × 0.6 × 0.8 = 0.336;

The probability of having (Coin 1, Coin 2, Coin 3) = (Head, Tail, Head) is 0.3 × 0.4 × 0.8 = 0.096;

The probability of having (Coin 1, Coin 2, Coin 3) = (Head, Head, Tail) is 0.3 × 0.6 × 0.2 = 0.036.

Thus, the probability of having more heads than tails is 0.144 + 0.336 + 0.096 + 0.036 = 0.612.

Sample Input 2

1
0.50

Sample Output 2

0.5

Outputs such as 0.500, 0.500000001 and 0.499999999 are also considered correct.

Sample Input 3

5
0.42 0.01 0.42 0.99 0.42

Sample Output 3

0.3821815872


{-# LANGUAGE BangPatterns      #-}

import Prelude as P
import Data.List
import Data.Vector.Unboxed as V hiding(sum,forM,forM_,map)
import Data.Array.Unboxed  as A
import Data.Array.MArray
import Data.Array.ST
import Control.Monad
import Control.Monad.ST

type P = Vector Double
type DP s = STUArray s (Int,Int) Double

setArr :: DP s -> P -> Int -> ST s ()
setArr dparr ps n = do
  let p i  = ps V.! (i-1)
      p_ i = 1-(p i)
  forM_ [1..n] $ \i -> writeArray dparr (0,i) $ (V.scanl (\x y -> x*(1-y)) 1 ps) V.! i
  forM_ [1..div (n-1) 2] $ \i -> do
    writeArray dparr (i,i)   $ (V.scanl (\x y -> x*y) 1 ps) V.! i

dp_i :: DP s -> P -> Int -> Int -> ST s ()
dp_i dparr ps k i = do
  let p i  = ps V.! (i-1)
      p_ i = 1-(p i)
  ek  <- readArray dparr (k,i-1)
  ek1 <- readArray dparr (k-1,i-1)
  writeArray dparr (k,i) $ ek*(p_ i) + ek1*(p i)

solve :: P -> Int -> ST s Double
solve ps n = do
  dparr <- newArray ((0,1),(div (n-1) 2,n)) 0
  setArr dparr ps n
  forM_ [1..div (n-1) 2] $ \k ->
   forM_ [k+1..n] $ \i -> dp_i dparr ps k i
  ans0 <- forM [0..div (n-1) 2] $ \k -> readArray dparr (k,n)
  return $ 1-(sum ans0)

main :: IO ()
main = do
  n <- read <$> getLine
  ps <- map read.words <$> getLine
  putStrLn $ show $ runST $ solve (V.fromList ps)  n

mod0 :: Int -> Int
mod0 n = mod n 1000000007


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where

import Control.Monad (replicateM, forM_)
import Data.Bool (bool)
import Data.Char (isSpace)
import Data.Function (on)
import Data.List (unfoldr, foldl', sort, (\\), delete, nub)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Unsafe as B
import System.IO (hPutStr, hPutStrLn, stdin, stdout, withFile, IOMode(..))

type Parser a = C.ByteString -> Maybe (a, C.ByteString)

parseInt :: Parser Int
parseInt = C.readInt . C.dropWhile isSpace

getInts :: IO [Int]
getInts = unfoldr parseInt <$> C.getLine

getIntVec :: Int -> IO (U.Vector Int)
getIntVec n = U.unfoldrN n parseInt <$> C.getLine

---------------------------------------------------------
swap (x, y) = (y, x)
pair (f, g) x = (f x, g x)
cross (f, g) (x, y) = (f x, g y)

newtype Fix f = In { out :: f (Fix f) }

data Hisx f a x = Hisx { unHisx :: (a, f x) } deriving (Show, Functor)
newtype Cofree f a = Cf { unCf :: Fix (Hisx f a) }
instance Functor f => Functor (Cofree f) where
  fmap f = Cf . ana (phi . out) . unCf
    where phi (Hisx (a, x)) = Hisx (f a, x)

extract :: Functor f => Cofree f t -> t
extract cf = case out (unCf cf) of
  Hisx (a, _) -> a

sub :: Functor f => Cofree f a -> f (Cofree f a)
sub cf = case out (unCf cf) of
  Hisx (_, b) -> fmap Cf b

data Futx f a x = Futx { unFutx :: Either a (f x) } deriving (Show, Functor)
newtype Free f a = Fr { unFr :: Fix (Futx f a) }
instance Functor f => Functor (Free f) where
  fmap f = Fr . cata (In . phi) . unFr
    where phi (Futx (Left a)) = Futx (Left (f a))
          phi (Futx (Right x)) = Futx (Right x)

inject :: a -> Free f a
inject = Fr . In . Futx . Left

-- catamorphism
cata :: Functor f => (f a -> a) -> Fix f -> a
cata phi = phi . fmap (cata phi) . out
-- anamorphism
ana :: Functor f => (a -> f a) -> a -> Fix f
ana psi = In . fmap (ana psi) . psi
-- hylomorphism
hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo phi psi = phi . fmap (hylo phi psi) . psi -- cata phi . ana psi
-- metamorphism
meta :: Functor f => (f a -> a) -> (a -> f a) -> Fix f -> Fix f
meta phi psi = In . fmap (meta phi psi) . out -- ana psi . cata phi
-- paramorphism
para :: Functor f => (f (Fix f, t) -> t) -> Fix f -> t
para phi = phi . fmap (pair (id, para phi)) . out
-- apomorphism
apo :: Functor f => (t -> f (Either (Fix f) t)) -> t -> Fix f
apo psi = In . fmap (uncurry either (id, apo psi)) . psi
-- histomorphism
histo :: Functor f => (f (Cofree f t) -> t) -> Fix f -> t
histo phi = extract . cata ap
  where ap = cast . Hisx . pair (phi, id)
        cast = Cf . In . fmap unCf
-- futumorphism
futu :: Functor f => (t -> f (Free f t)) -> t -> Fix f
futu psi = ana ap . inject
  where ap = uncurry either (psi, id) . unFutx . cast
        cast = fmap Fr . out . unFr
-- chronomorphism
chrono :: Functor f => (f (Cofree f b) -> b) -> (a -> f (Free f a)) -> a -> b
chrono phi psi = extract . hylo phi' psi' . inject
  where
    phi' = toCofree . Hisx . pair (phi, id)
    toCofree = Cf . In . fmap unCf
    psi' = uncurry either (psi, id) . unFutx . fromFree
    fromFree = fmap Fr . out . unFr
-- cochronomorphism
cochrono :: Functor f => (f (Cofree f t) -> t) -> (t -> f (Free f t)) -> Fix f -> Fix f
cochrono phi psi = futu psi . histo phi
-- zygomorphism
zygo :: Functor f => (f a -> a) -> (f (a, b) -> b) -> Fix f -> b
zygo f phi = snd . cata (pair (f . fmap fst, phi))
-- cozygomorphism
cozygo :: Functor f => (a -> f a) -> (b -> f (Either a b)) -> b -> Fix f
cozygo f psi = ana (uncurry either (fmap Left . f, psi)) . Right
-- dynamorphism
dyna :: Functor f => (f (Cofree f b) -> b) -> (a -> f a) -> a -> b
dyna f g = chrono f (fmap inject . g) -- histo f . ana g
-- codynamorphism
codyna :: Functor f => (f b -> b) -> (a -> f (Free f a)) -> a -> b
codyna f g = chrono (f . fmap extract) g
-- mutumorphism
mutu :: Functor f => (a -> b) -> (f a -> a) -> Fix f -> b
mutu proj phi = proj . cata phi
-- comutumorphism
comutu :: Functor f => (b -> a) -> (a -> f a) -> b -> Fix f
comutu proj psi = ana psi . proj

foldn (c, f) 0 = c
foldn (c, f) n = f (foldn (c, f) (n-1))

paran (c, f) 0 = c
paran (c, f) n = f n (paran (c, f) (n-1))

---------------------------------------------------------

getProblem :: IO (Int, U.Vector Int)
getProblem = do
  n <- readLn :: IO Int
  xs <-  getIntVec n
  return (n, xs)

data TreeF a x = Node a (Maybe x, Maybe x, Maybe x) deriving (Show, Functor)
type Tree a = Fix (TreeF a)
instance Show a => Show (Tree a) where
  show (In (Node a ns)) = "Node " ++ show a ++ " " ++ show ns

collect :: U.Vector Int -> (Int, Int, Int)
collect = U.foldl' f (0,0,0)
  where
    f (n1,n2,n3) x = case x of
      1 -> (n1+1, n2, n3)
      2 -> (n1, n2+1, n3)
      3 -> (n1, n2, n3+1)
      _ -> error "illegal number"

node :: a -> (Maybe (Tree a), Maybe (Tree a), Maybe (Tree a)) -> Tree a
node a xs = In (Node a xs)

node' :: ((Maybe a, Maybe a, Maybe a) -> a) -> b ->
         (Maybe (Cofree (TreeF b) a), Maybe (Cofree (TreeF b) a), Maybe (Cofree (TreeF b) a)) -> Cofree (TreeF b) a
node' f a (n1, n2, n3) = Cf (In (Hisx (f (fmap extract n1, fmap extract n2, fmap extract n3), Node a (fmap unCf n1, fmap unCf n2, fmap unCf n3))))

main :: IO ()
main = do
  (n, xys) <- getProblem
  print $ solve n (collect xys)

solve :: Int -> (Int, Int, Int) -> Double
solve n ijk = extract (mkMap n ijk Map.! ijk)

mkMap :: Int -> (Int, Int, Int) -> Map.Map (Int, Int, Int) (Cofree (TreeF (Int, Int, Int)) Double)
mkMap n ijk = foldl' p (Map.singleton (0, 0, 0) nd000) (mkSeq n ijk)
  where
    conv i = maybe 0.0 (* fromIntegral i)
    f (i, j, k) (mt1, mt2, mt3) = (conv i mt1 + conv j mt2 + conv k mt3 + fromIntegral n) / fromIntegral (i + j + k)
    nd000 = node' (const 0.0) (0, 0, 0) (Nothing, Nothing, Nothing)
    nd ijk@(i, j, k) m = node' (f ijk) ijk (Map.lookup (i-1, j, k) m, Map.lookup (i+1, j-1, k) m, Map.lookup (i, j+1, k-1) m)
    p m key@(i, j, k) = Map.insert key (nd key m) m

mkSeq :: (Ord a, Num a) => a -> (a, a, a) -> [(a, a, a)]
mkSeq n xyz@(x, y, z) = concat $ unfoldr psi ini
  where
    ini = [(0, 0, 0)]
    psi xs | null xs' = Nothing
           | otherwise = Just (xs', xs')
      where
        xs' = nub $ concatMap next xs
    next (i, j, k)
      | i == x && j == y && k == z = []
      | otherwise = filter p [(i+1, j, k),(i-1, j+1, k),(i, j-1, k+1)]
      where
        p (i', j', k') = i' >= 0 && j' >= 0 && k' >= 0 && i'+j'+k' <= n && ijk' <= xyz && jk' <= yz && k' <= z
          where
            (jk', ijk') = (j'+k', i'+jk')
            (yz, xyz) = (y+z, x+yz)

{--
solve :: Int -> U.Vector Int -> Double
solve n xys = dyna phi psi (collect xys)
  where
    psi :: (Int, Int, Int) -> TreeF (Int, (Int, Int, Int)) (Int, Int, Int)
    psi ijk@(i, j, k) = Node (n, ijk) (next1 (i, j, k), next2 (i, j, k), next3 (i, j, k))
      where
        next1 (i, j, k) | i <= 0 = Nothing
                        | otherwise = Just (i-1, j, k)
        next2 (i, j, k) | j <= 0 = Nothing
                        | otherwise = Just (i+1, j-1, k)
        next3 (i, j, k) | k <= 0 = Nothing
                        | otherwise = Just (i, j+1, k-1)

    phi (Node _ (Nothing, Nothing, Nothing)) = 0.0
    phi (Node (n, (i,j,k)) (Just t1, Nothing, Nothing)) =
      (extract t1*fromIntegral i+fromIntegral n) / fromIntegral (i+j+k)
    phi (Node (n, (i,j,k)) (Nothing, Just t2, Nothing)) =
      (extract t2*fromIntegral j+fromIntegral n) / fromIntegral (i+j+k)
    phi (Node (n, (i,j,k)) (Nothing, Nothing, Just t3)) =
      (extract t3*fromIntegral k+fromIntegral n) / fromIntegral (i+j+k)
    phi (Node (n, (i,j,k)) (Nothing, Just t2, Just t3)) =
      (extract t2*fromIntegral j+extract t3*fromIntegral k+fromIntegral n) / fromIntegral (i+j+k)
    phi (Node (n, (i,j,k)) (Just t1, Nothing, Just t3)) =
      (extract t1*fromIntegral i+extract t3*fromIntegral k+fromIntegral n) / fromIntegral (i+j+k)
    phi (Node (n, (i,j,k)) (Just t1, Just t2, Nothing)) =
      (extract t1*fromIntegral i+extract t2*fromIntegral j+fromIntegral n) / fromIntegral (i+j+k)
    phi (Node (n, (i,j,k)) (Just t1, Just t2, Just t3)) =
      (extract t1*fromIntegral i+extract t2*fromIntegral j+extract t3*fromIntegral k+fromIntegral n) / fromIntegral (i+j+k)
--}

-- 1 1 1 => 3 0 0
example1 :: Double
example1 = extract nd300
  where
    conv i = maybe 0.0 (* fromIntegral i)
    f n (i, j, k) (mt1, mt2, mt3) = (conv i mt1 + conv j mt2 + conv k mt3 + fromIntegral n) / fromIntegral (i + j + k)
    nd300 = node' (f 3 (3, 0, 0)) (3, 0, 0) (Just nd200, Nothing, Nothing)
    nd200 = node' (f 3 (2, 0, 0)) (2, 0, 0) (Just nd100, Nothing, Nothing)
    nd100 = node' (f 3 (1, 0, 0)) (1, 0, 0) (Just nd000, Nothing, Nothing)
    nd000 = node' (const 0.0) (0, 0, 0) (Nothing, Nothing, Nothing)

-- 3 => 0 0 1
example2 :: Double
example2 = extract nd001
  where
    conv i = maybe 0.0 (* fromIntegral i)
    f n (i, j, k) (mt1, mt2, mt3) = (conv i mt1 + conv j mt2 + conv k mt3 + fromIntegral n) / fromIntegral (i + j + k)
    nd001 = node' (f 1 (0, 0, 1)) (0, 0, 1) (Nothing, Nothing, Just nd010)
    nd010 = node' (f 1 (0, 1, 0)) (0, 1, 0) (Nothing, Just nd100, Nothing)
    nd100 = node' (f 1 (1, 0, 0)) (1, 0, 0) (Just nd000, Nothing, Nothing)
    nd000 = node' (const 0.0) (0, 0, 0) (Nothing, Nothing, Nothing)

-- 1 2 => 1 1 0
example3 :: Double
example3 = extract nd110
  where
    conv i = maybe 0.0 (* fromIntegral i)
    f n (i, j, k) (mt1, mt2, mt3) = (conv i mt1 + conv j mt2 + conv k mt3 + fromIntegral n) / fromIntegral (i + j + k)
    nd110 = node' (f 2 (1, 1, 0)) (1, 1, 0) (Just nd010, Just nd200, Nothing)
    nd010 = node' (f 2 (0, 1, 0)) (0, 1, 0) (Nothing, Just nd100, Nothing)
    nd200 = node' (f 2 (2, 0, 0)) (2, 0, 0) (Just nd100, Nothing, Nothing)
    nd100 = node' (f 2 (1, 0, 0)) (1, 0, 0) (Just nd000, Nothing, Nothing)
    nd000 = node' (const 0.0) (0, 0, 0) (Nothing, Nothing, Nothing)

-- 1 1 1
sample111 :: Double
sample111 = extract nd111
  where
    conv i = maybe 0.0 (* fromIntegral i)
    f n (i, j, k) (mt1, mt2, mt3) = (conv i mt1 + conv j mt2 + conv k mt3 + fromIntegral n) / fromIntegral (i + j + k)
    nd111 = node' (f 3 (1, 1, 1)) (1, 1, 1) (Just nd011, Just nd201, Just nd120)
    nd011 = node' (f 3 (0, 1, 1)) (0, 1, 1) (Nothing, Just nd101, Just nd020)
    nd201 = node' (f 3 (2, 0, 1)) (2, 0, 1) (Just nd101, Nothing, Just nd210)
    nd120 = node' (f 3 (1, 2, 0)) (1, 2, 0) (Just nd020, Just nd210, Nothing)
    nd101 = node' (f 3 (1, 0, 1)) (1, 0, 1) (Just nd001, Nothing, Just nd110)
    nd020 = node' (f 3 (0, 2, 0)) (0, 2, 0) (Nothing, Just nd110, Nothing)
    nd210 = node' (f 3 (2, 1, 0)) (2, 1, 0) (Just nd110, Just nd300, Nothing)
    nd001 = node' (f 3 (0, 0, 1)) (0, 0, 1) (Nothing, Nothing, Just nd010)
    nd110 = node' (f 3 (1, 1, 0)) (1, 1, 0) (Just nd010, Just nd200, Nothing)
    nd300 = node' (f 3 (3, 0, 0)) (3, 0, 0) (Just nd200, Nothing, Nothing)
    nd010 = node' (f 3 (0, 1, 0)) (0, 1, 0) (Nothing, Just nd100, Nothing)
    nd200 = node' (f 3 (2, 0, 0)) (2, 0, 0) (Just nd100, Nothing, Nothing)
    nd100 = node' (f 3 (1, 0, 0)) (1, 0, 0) (Just nd000, Nothing, Nothing)
    nd000 = node' (const 0.0) (0, 0, 0) (Nothing, Nothing, Nothing)

-- 1 3 2 3 3 2 3 2 1 3 => 2 3 5
example4 :: Double
example4 = solve 10 (2, 3, 5)

Score : 100 points

Problem Statement

There are N dishes, numbered 1, 2, \ldots, N.
Initially, for each i (1 \leq i \leq N), Dish i has a_i (1 \leq a_i \leq 3) pieces of sushi on it.

Taro will perform the following operation repeatedly until all the pieces of sushi are eaten:

Roll a die that shows the numbers 1, 2, \ldots, N with equal probabilities, and let i be the outcome. If there are some pieces of sushi on Dish i, eat one of them; if there is none, do nothing.

Find the expected number of times the operation is performed before all the pieces of sushi are eaten.

Constraints

All values in input are integers.

1 \leq N \leq 300

1 \leq a_i \leq 3

Input

Input is given from Standard Input in the following format:

N
a_1 a_2 \ldots a_N

Output

Print the expected number of times the operation is performed before all the pieces of sushi are eaten.
The output is considered correct when the relative difference is not greater than 10^{-9}.

Sample Input 1

3
1 1 1

Sample Output 1

5.5

The expected number of operations before the first piece of sushi is eaten, is 1.
After that, the expected number of operations before the second sushi is eaten, is 1.5.
After that, the expected number of operations before the third sushi is eaten, is 3.
Thus, the expected total number of operations is 1 + 1.5 + 3 = 5.5.

Sample Input 2

1
3

Sample Output 2

3

Outputs such as 3.00, 3.000000003 and 2.999999997 will also be accepted.

Sample Input 3

2
1 2

Sample Output 3

4.5

Sample Input 4

10
1 3 2 3 3 2 3 2 1 3

Sample Output 4

54.48064457488221


import Control.Monad
import Control.Monad.ST
import Data.List
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as MV

main=do
    [n,k]<-map read.words<$>getLine::IO[Int]
    as<-map read.words<$>getLine::IO[Int]
    putStrLn $ ["Second", "First"] !! min 1 (f k as)

f k as = runST $ do
    kv <- MV.new (k+1) :: ST s (MV.STVector s Int)
    forM_ [0..k] $ \i -> do
        g <- fmap (gr.((-1):).sort) $ forM as $ \a -> if i-a>=0 then MV.read kv (i-a) else pure (-1)
        MV.write kv i g
    MV.read kv k

gr [a] = a+1
gr (a:b:x) | a+1>=b = gr (b:x) |otherwise = a+1

Score : 100 points

Problem Statement

There is a set A = \{ a_1, a_2, \ldots, a_N \} consisting of N positive integers.
Taro and Jiro will play the following game against each other.

Initially, we have a pile consisting of K stones.
The two players perform the following operation alternately, starting from Taro:

Choose an element x in A, and remove exactly x stones from the pile.

A player loses when he becomes unable to play.
Assuming that both players play optimally, determine the winner.

Constraints

All values in input are integers.

1 \leq N \leq 100

1 \leq K \leq 10^5

1 \leq a_1 < a_2 < \cdots < a_N \leq K

Input

Input is given from Standard Input in the following format:

N K
a_1 a_2 \ldots a_N

Output

If Taro will win, print First; if Jiro will win, print Second.

Sample Input 1

2 4
2 3

Sample Output 1

First

If Taro removes three stones, Jiro cannot make a move.
Thus, Taro wins.

Sample Input 2

2 5
2 3

Sample Output 2

Second

Whatever Taro does in his operation, Jiro wins, as follows:

If Taro removes two stones, Jiro can remove three stones to make Taro unable to make a move.

If Taro removes three stones, Jiro can remove two stones to make Taro unable to make a move.

Sample Input 3

2 7
2 3

Sample Output 3

First

Taro should remove two stones. Then, whatever Jiro does in his operation, Taro wins, as follows:

If Jiro removes two stones, Taro can remove three stones to make Jiro unable to make a move.

If Jiro removes three stones, Taro can remove two stones to make Jiro unable to make a move.

Sample Input 4

3 20
1 2 3

Sample Output 4

Second

Sample Input 5

3 21
1 2 3

Sample Output 5

First

Sample Input 6

1 100000
1

Sample Output 6

Second


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RankNTypes #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
-- import Data.List
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import Control.Monad
import Control.Monad.ST
-- import Debug.Trace
-- trace _ = id

solve :: Int -> [Int] -> Int
solve bN as = cost
  where
  vA = VU.fromListN bN as
  acc = VU.scanl' (+) 0 vA

  cost = runST $ do
    vec <- VM.replicateM (bN+1) (VUM.replicate bN (-1))
    calc vec bN 0

    where
      calc vec 1 _ = return 0
      calc vec len i = do
        v <- VM.read vec len
        val <- VUM.read v i
        if val >= 0 then return val
          else do
          newVal <- top <$> mapM f [1 .. len-1]
          VUM.write v i newVal
          return newVal
        where
          top lst = (minimum lst) + (acc VU.! (i+len)) - (acc VU.! i)
          f k = (+) <$> calc vec k i <*> calc vec (len-k) (i+k)

readBInt :: B.ByteString -> Int
readBInt = fst . fromJust . B.readInt

tmain :: B.ByteString -> Int
tmain cont =
  let remLines0 = map B.words (B.lines cont)
      [bs_bN]:remLines1 = remLines0
      bN = readBInt bs_bN
      line2:remLines2 = remLines1
      as = map readBInt line2
  in solve bN as

outAnswer :: Int -> IO ()
outAnswer = putStrLn . show

main :: IO ()
main = outAnswer . tmain =<< B.getContents

-------------------------------------------------------------------------------

inp1 = "4\n10 20 30 40\n"
inp2 = "5\n10 10 10 10 10\n"
inp3 = "3\n1000000000 1000000000 1000000000\n"
inp4 = "6\n7 6 8 6 1 1\n"
tv1 = tmain $ B.pack inp1
tv2 = tmain $ B.pack inp2
tv3 = tmain $ B.pack inp3
tv4 = tmain $ B.pack inp4
test1 = tv1 == 190
test2 = tv2 == 120
test3 = tv3 == 5000000000
test4 = tv4 == 68
alltest = test1 && test2 && test3 && test4

Score : 100 points

Problem Statement

There are N slimes lining up in a row.
Initially, the i-th slime from the left has a size of a_i.

Taro is trying to combine all the slimes into a larger slime.
He will perform the following operation repeatedly until there is only one slime:

Choose two adjacent slimes, and combine them into a new slime. The new slime has a size of x + y, where x and y are the sizes of the slimes before combining them. Here, a cost of x + y is incurred. The positional relationship of the slimes does not change while combining slimes.

Find the minimum possible total cost incurred.

Constraints

All values in input are integers.

2 \leq N \leq 400

1 \leq a_i \leq 10^9

Input

Input is given from Standard Input in the following format:

N
a_1 a_2 \ldots a_N

Output

Print the minimum possible total cost incurred.

Sample Input 1

4
10 20 30 40

Sample Output 1

190

Taro should do as follows (slimes being combined are shown in bold):

(10, 20, 30, 40) → (30, 30, 40)

(30, 30, 40) → (60, 40)

(60, 40) → (100)

Sample Input 2

5
10 10 10 10 10

Sample Output 2

120

Taro should do, for example, as follows:

(10, 10, 10, 10, 10) → (20, 10, 10, 10)

(20, 10, 10, 10) → (20, 20, 10)

(20, 20, 10) → (20, 30)

(20, 30) → (50)

Sample Input 3

3
1000000000 1000000000 1000000000

Sample Output 3

5000000000

The answer may not fit into a 32-bit integer type.

Sample Input 4

6
7 6 8 6 1 1

Sample Output 4

68

Taro should do, for example, as follows:

(7, 6, 8, 6, 1, 1) → (7, 6, 8, 6, 2)

(7, 6, 8, 6, 2) → (7, 6, 8, 8)

(7, 6, 8, 8) → (13, 8, 8)

(13, 8, 8) → (13, 16)

(13, 16) → (29)


main=do
 s<-getLine
 print (length (filter (=='2') s))

Score : 100 points

Problem Statement

You are given an integer N that has exactly four digits in base ten.
How many times does 2 occur in the base-ten representation of N?

Constraints

1000 \leq N \leq 9999

Input

Input is given from Standard Input in the following format:

N

Output

Print the answer.

Sample Input 1

1222

Sample Output 1

3

2 occurs three times in 1222. By the way, this contest is held on December 22 (JST).

Sample Input 2

3456

Sample Output 2

0

Sample Input 3

9592

Sample Output 3

1


import Control.Arrow
import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = readLine >>= print . solve

solve :: [Int] -> Int
solve [n, p]
    | n == 1 || p == 1 = p
    | otherwise = product $ pf n p

pf :: Int -> Int -> [Int]
pf n = loop [2..]
    where
        loop (x : xs) v
            | v == 1 = []
            | y == 0 = loop xs w
            | otherwise = x ^ y : loop xs w
            where
                (w, z) = count v x
                y = z `div` n

        count v x = cloop v 0
            where
                cloop w acc
                    | w `mod` x == 0 = cloop (w `div` x) (acc + 1)
                    | otherwise = (w, acc)

readLine :: IO [Int]
readLine = unfoldr (\s -> second (maybe B.empty snd . B.uncons) <$> B.readInt s) <$> B.getLine

readContents :: Int -> IO [[Int]]
readContents = flip replicateM readLine

Score : 300 points

Problem Statement

There are N integers a_1, a_2, ..., a_N not less than 1.
The values of a_1, a_2, ..., a_N are not known, but it is known that a_1 \times a_2 \times ... \times a_N = P.

Find the maximum possible greatest common divisor of a_1, a_2, ..., a_N.

Constraints

1 \leq N \leq 10^{12}

1 \leq P \leq 10^{12}

Input

Input is given from Standard Input in the following format:

N P

Output

Print the answer.

Sample Input 1

3 24

Sample Output 1

2

The greatest common divisor would be 2 when, for example, a_1=2, a_2=6 and a_3=2.

Sample Input 2

5 1

Sample Output 2

1

As a_i are positive integers, the only possible case is a_1 = a_2 = a_3 = a_4 = a_5 = 1.

Sample Input 3

1 111

Sample Output 3

111

Sample Input 4

4 972439611840

Sample Output 4

206


-- CADDI 2018 C
{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.Maybe
import Debug.Trace
import Data.List
import qualified Data.Map.Strict as Map
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Set as Set
import qualified Data.IntSet as IntSet
import Data.Functor
import Data.Array

main :: IO ()
main = do
  (n:p:_) <- fmap (map read . words) getLine :: IO [Integer]
  print $ solve n p

-- solve :: Int -> Int -> Int
solve n p = go 0 cm
  where
    cm = toCountMap $ primeFactors p
    go i cm
      | Map.null filtered = 1
      | otherwise = (Map.foldrWithKey (\k _ acc -> k * acc) 1 filtered) * go (i+n) filtered
      where
        filtered = Map.filter (n+i <=) cm

toCountMap :: (Ord k, Integral a) => [k] -> Map.Map k a
toCountMap xs = Map.fromListWith (+) $ zip xs (repeat 1)

factorization :: Integer -> [Integer]
factorization 1 = []
factorization x = let v = head $ naiveFactors x
                  in  v : factorization (x `div` v)
naiveFactors :: Integer -> [Integer]
naiveFactors n = [x | x <- [2..n], n `mod` x == 0]

primes :: Integral int => [int]
primes = wheelSieve 6

{-# SPECIALISE primes :: [Int]     #-}
{-# SPECIALISE primes :: [Integer] #-}

-- |
-- This function returns an infinite list of prime numbers by sieving
-- with a wheel that cancels the multiples of the first @n@ primes
-- where @n@ is the argument given to @wheelSieve@. Don't use too
-- large wheels. The number @6@ is a good value to pass to this
-- function. Larger wheels improve the run time at the cost of higher
-- memory requirements.
--
wheelSieve :: Integral int
           => Int    -- ^ number of primes canceled by the wheel
           -> [int]  -- ^ infinite list of primes
wheelSieve k = reverse ps ++ map head (sieve p (cycle ns))
 where (p:ps,ns) = wheel k

{-# SPECIALISE wheelSieve :: Int -> [Int]     #-}
{-# SPECIALISE wheelSieve :: Int -> [Integer] #-}

-- |
-- Checks whether a given number is prime.
--
-- This function uses trial division to check for divisibility with
-- all primes below the square root of the given number. It is
-- impractical for numbers with a very large smallest prime factor.
--
isPrime :: Integral int => int -> Bool
isPrime n | n > 1     = primeFactors n == [n]
          | otherwise = False

{-# SPECIALISE isPrime :: Int     -> Bool #-}
{-# SPECIALISE isPrime :: Integer -> Bool #-}

-- |
-- Yields the sorted list of prime factors of the given positive
-- number.
--
-- This function uses trial division and is impractical for numbers
-- with very large prime factors.
--
primeFactors :: Integral int => int -> [int]
primeFactors n = factors n (wheelSieve 6)
 where
  factors 1 _                  = []
  factors m (p:ps) | m < p*p   = [m]
                   | r == 0    = p : factors q (p:ps)
                   | otherwise = factors m ps
   where (q,r) = quotRem m p

{-# SPECIALISE primeFactors :: Int     -> [Int]     #-}
{-# SPECIALISE primeFactors :: Integer -> [Integer] #-}

-- Auxiliary Definitions
------------------------------------------------------------------------------

-- Sieves prime candidates by computing composites from the result of
-- a recursive call with identical arguments. We could use sharing
-- instead of a recursive call with identical arguments but that would
-- lead to much higher memory requirements. The results of the
-- different calls are consumed at different speeds and we want to
-- avoid multiple far apart pointers into the result list to avoid
-- retaining everything in between.
--
-- Each list in the result starts with a prime. To obtain composites
-- that need to be cancelled, one can multiply all elements of the
-- list with its head.
--
sieve :: (Ord int, Num int) => int -> [int] -> [[int]]
sieve p ns@(m:ms) = spin p ns : sieveComps (p+m) ms (composites p ns)

{-# SPECIALISE sieve :: Int     -> [Int]     -> [[Int]]     #-}
{-# SPECIALISE sieve :: Integer -> [Integer] -> [[Integer]] #-}

-- Composites are stored in increasing order in a priority queue. The
-- queue has an associated feeder which is used to avoid filling it
-- with entries that will only be used again much later.
--
type Composites int = (Queue int,[[int]])

-- The feeder is computed from the result of a call to 'sieve'.
--
composites :: (Ord int, Num int) => int -> [int] -> Composites int
composites p ns = (Empty, map comps (spin p ns : sieve p ns))
 where comps xs@(x:_) = map (x*) xs

{-# SPECIALISE composites :: Int     -> [Int]     -> Composites Int     #-}
{-# SPECIALISE composites :: Integer -> [Integer] -> Composites Integer #-}

-- We can split all composites into the next and remaining
-- composites. We use the feeder when appropriate and discard equal
-- entries to not return a composite twice.
--
splitComposites :: Ord int => Composites int -> (int,Composites int)
splitComposites (Empty, xs:xss) = splitComposites (Fork xs [], xss)
splitComposites (queue, xss@((x:xs):yss))
  | x < z     = (x, discard x (enqueue xs queue, yss))
  | otherwise = (z, discard z (enqueue zs queue', xss))
 where (z:zs,queue') = dequeue queue

{-# SPECIALISE splitComposites :: Composites Int -> (Int,Composites Int) #-}
{-# SPECIALISE
    splitComposites :: Composites Integer -> (Integer,Composites Integer) #-}

-- Drops all occurrences of the given element.
--
discard :: Ord int => int -> Composites int -> Composites int
discard n ns | n == m    = discard n ms
             | otherwise = ns
 where (m,ms) = splitComposites ns

{-# SPECIALISE discard :: Int -> Composites Int -> Composites Int #-}
{-# SPECIALISE
    discard :: Integer -> Composites Integer -> Composites Integer #-}

-- This is the actual sieve. It discards candidates that are
-- composites and yields lists which start with a prime and contain
-- all factors of the composites that need to be dropped.
--
sieveComps :: (Ord int, Num int) => int -> [int] -> Composites int -> [[int]]
sieveComps cand ns@(m:ms) xs
  | cand == comp = sieveComps (cand+m) ms ys
  | cand <  comp = spin cand ns : sieveComps (cand+m) ms xs
  | otherwise    = sieveComps cand ns ys
 where (comp,ys) = splitComposites xs

{-# SPECIALISE sieveComps :: Int -> [Int] -> Composites Int -> [[Int]] #-}
{-# SPECIALISE
    sieveComps :: Integer -> [Integer] -> Composites Integer -> [[Integer]] #-}

-- This function computes factors of composites of primes by spinning
-- a wheel.
--
spin :: Num int => int -> [int] -> [int]
spin x (y:ys) = x : spin (x+y) ys

{-# SPECIALISE spin :: Int     -> [Int]     -> [Int]     #-}
{-# SPECIALISE spin :: Integer -> [Integer] -> [Integer] #-}

-- A wheel consists of a list of primes whose multiples are canceled
-- and the actual wheel that is rolled for canceling.
--
type Wheel int = ([int],[int])

-- Computes a wheel that cancels the multiples of the given number
-- (plus 1) of primes.
--
-- For example:
--
-- wheel 0 = ([2],[1])
-- wheel 1 = ([3,2],[2])
-- wheel 2 = ([5,3,2],[2,4])
-- wheel 3 = ([7,5,3,2],[4,2,4,2,4,6,2,6])
--
wheel :: Integral int => Int -> Wheel int
wheel n = iterate next ([2],[1]) !! n

{-# SPECIALISE wheel :: Int -> Wheel Int     #-}
{-# SPECIALISE wheel :: Int -> Wheel Integer #-}

next :: Integral int => Wheel int -> Wheel int
next (ps@(p:_),xs) = (py:ps,cancel (product ps) p py ys)
 where (y:ys) = cycle xs
       py = p + y

{-# SPECIALISE next :: Wheel Int     -> Wheel Int     #-}
{-# SPECIALISE next :: Wheel Integer -> Wheel Integer #-}

cancel :: Integral int => int -> int -> int -> [int] -> [int]
cancel 0 _ _ _ = []
cancel m p n (x:ys@(y:zs))
  | nx `mod` p > 0 = x : cancel (m-x) p nx ys
  | otherwise      = cancel m p n (x+y:zs)
 where nx = n + x

{-# SPECIALISE cancel :: Int -> Int -> Int -> [Int] -> [Int] #-}
{-# SPECIALISE
    cancel :: Integer -> Integer -> Integer -> [Integer] -> [Integer] #-}

-- We use a special version of priority queues implemented as /pairing/
-- /heaps/ (see /Purely Functional Data Structures/ by Chris Okasaki).
--
-- The queue stores non-empty lists of composites; the first element
-- is used as priority.
--
data Queue int = Empty | Fork [int] [Queue int]

enqueue :: Ord int => [int] -> Queue int -> Queue int
enqueue ns = merge (Fork ns [])

{-# SPECIALISE enqueue :: [Int]     -> Queue Int     -> Queue Int     #-}
{-# SPECIALISE enqueue :: [Integer] -> Queue Integer -> Queue Integer #-}

merge :: Ord int => Queue int -> Queue int -> Queue int
merge Empty y                        = y
merge x     Empty                    = x
merge x     y     | prio x <= prio y = join x y
                  | otherwise        = join y x
 where prio (Fork (n:_) _) = n
       join (Fork ns qs) q = Fork ns (q:qs)

{-# SPECIALISE merge :: Queue Int     -> Queue Int     -> Queue Int     #-}
{-# SPECIALISE merge :: Queue Integer -> Queue Integer -> Queue Integer #-}

dequeue :: Ord int => Queue int -> ([int], Queue int)
dequeue (Fork ns qs) = (ns,mergeAll qs)

{-# SPECIALISE dequeue :: Queue Int     -> ([Int],     Queue Int)     #-}
{-# SPECIALISE dequeue :: Queue Integer -> ([Integer], Queue Integer) #-}

mergeAll :: Ord int => [Queue int] -> Queue int
mergeAll []       = Empty
mergeAll [x]      = x
mergeAll (x:y:qs) = merge (merge x y) (mergeAll qs)

{-# SPECIALISE mergeAll :: [Queue Int]     -> Queue Int     #-}
{-# SPECIALISE mergeAll :: [Queue Integer] -> Queue Integer #-}


import Data.List
import qualified Data.IntSet as S
import qualified Data.ByteString.Char8 as B

p2s = map (2^) [1..31]
main=do
    _<-getLine
    as<-S.fromList.unfoldr (B.readInt.B.dropWhile(==' '))<$>B.getLine
    print $ sol 0 as
sol c as
    | S.null as = c
    | otherwise = if S.member (fc-m) b
                    then sol (c+1) (S.delete (fc-m) b)
                    else sol c b
    where
        (m,b) = S.deleteFindMax as
        fc = head $ dropWhile (<m) p2s

Score : 600 points

Problem Statement

Takahashi has N balls with positive integers written on them. The integer written on the i-th ball is A_i.
He would like to form some number of pairs such that the sum of the integers written on each pair of balls is a power of 2.
Note that a ball cannot belong to multiple pairs.
Find the maximum possible number of pairs that can be formed.

Here, a positive integer is said to be a power of 2 when it can be written as 2^t using some non-negative integer t.

Constraints

1 \leq N \leq 2\times 10^5

1 \leq A_i \leq 10^9

A_i is an integer.

Input

Input is given from Standard Input in the following format:

N
A_1 A_2 ... A_N

Output

Print the maximum possible number of pairs such that the sum of the integers written on each pair of balls is a power of 2.

Sample Input 1

3
1 2 3

Sample Output 1

1

We can form one pair whose sum of the written numbers is 4 by pairing the first and third balls.
Note that we cannot pair the second ball with itself.

Sample Input 2

5
3 11 14 5 13

Sample Output 2

2


{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE RecordWildCards #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector.Unboxed as VU
import Control.Monad
import Control.Monad.ST
import Control.Applicative

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- VU.unfoldrN n (BS.readInt . BS.dropWhile (==' ')) <$> BS.getLine
  print $ binSearch 0 n ls

binSearch :: Int -> Int -> VU.Vector Int -> Int
binSearch ng ok ls | ok - ng <= 1 = ok
binSearch ng ok ls =
  if isPossibleWith mid ls then
    binSearch ng mid ls
  else
    binSearch mid ok ls
  where
    mid = (ng + ok) `shiftR` 1

isPossibleWith :: Int -> VU.Vector Int -> Bool
isPossibleWith 1 ls = VU.and $ VU.zipWith (<) ls (VU.tail ls)
isPossibleWith numChars ls
  = VU.foldr loop (\_ _ -> True) ls 0 Nil
  where
    loop !reqLen cont wordLen charList
      | reqLen > wordLen = cont reqLen charList
      | otherwise = loop1 (cont reqLen)
                    (cutOff charList reqLen) (reqLen - 1)
    loop1 _ !xs ind | ind < 0 = False
    loop1 cont xs@(Snoc xs' i e) ind = case compare i ind of
      LT -> cont $! Snoc xs ind 1
      EQ | e < numChars - 1 -> cont $! Snoc xs' i (e+1)
         | otherwise        -> loop1 cont xs' (ind-1)
    loop1 cont Nil ind = cont $! Snoc Nil ind 1

data List = Nil | Snoc !List {-# UNPACK #-} !Int {-# UNPACK #-} !Int
 deriving Show

cutOff :: List -> Int -> List
cutOff (Snoc xs i e) till | till <= i = cutOff xs till
cutOff xs !till = xs

Score : 700 points

Problem Statement

There are N strings arranged in a row.
It is known that, for any two adjacent strings, the string to the left is lexicographically smaller than the string to the right.
That is, S_1<S_2<...<S_N holds lexicographically, where S_i is the i-th string from the left.

At least how many different characters are contained in S_1,S_2,...,S_N, if the length of S_i is known to be A_i?

Constraints

1 \leq N \leq 2\times 10^5

1 \leq A_i \leq 10^9

A_i is an integer.

Note

The strings do not necessarily consist of English alphabet; there can be arbitrarily many different characters (and the lexicographic order is defined for those characters).

Input

Input is given from Standard Input in the following format:

N
A_1 A_2 ... A_N

Output

Print the minimum possible number of different characters contained in the strings.

Sample Input 1

3
3 2 1

Sample Output 1

2

The number of different characters contained in S_1,S_2,...,S_N would be 3 when, for example, S_1=abc, S_2=bb and S_3=c.

However, if we choose the strings properly, the number of different characters can be 2.

Sample Input 2

5
2 3 2 1 2

Sample Output 2

2


main=interact$show.f.map read.words
f(_:l)=sum l-maximum l`div`2

Score : 200 points

Problem Statement

In some other world, today is the day before Christmas Eve.

Mr. Takaha is buying N items at a department store. The regular price of the i-th item (1 \leq i \leq N) is p_i yen (the currency of Japan).

He has a discount coupon, and can buy one item with the highest price for half the regular price. The remaining N-1 items cost their regular prices. What is the total amount he will pay?

Constraints

2 \leq N \leq 10

100 \leq p_i \leq 10000

p_i is an even number.

Input

Input is given from Standard Input in the following format:

N
p_1
p_2
:
p_N

Output

Print the total amount Mr. Takaha will pay.

Sample Input 1

3
4980
7980
6980

Sample Output 1

15950

The 7980-yen item gets the discount and the total is 4980 + 7980 / 2 + 6980 = 15950 yen.

Note that outputs such as 15950.0 will be judged as Wrong Answer.

Sample Input 2

4
4320
4320
4320
4320

Sample Output 2

15120

Only one of the four items gets the discount and the total is 4320 / 2 + 4320 + 4320 + 4320 = 15120 yen.


import Control.Monad
import Data.List

f :: [Int] -> [Int] -> Int
f [x] [y] = x - y
f tails@(x:xs) heads@(y:ys)
  | diff == 0 = 0
  | otherwise = min diff (f xs ys)
  where diff = x - y

main :: IO ()
main = do
  [all, number] <- map read . words <$> getLine
  heights <- replicateM all readLn
  let sorted = sort heights
  let heads = take (all - number + 1) sorted
  let tails = drop (number - 1) sorted
  print $ f tails heads

Score : 300 points

Problem Statement

In some other world, today is Christmas Eve.

There are N trees planted in Mr. Takaha's garden. The height of the i-th tree (1 \leq i \leq N) is h_i meters.

He decides to choose K trees from these trees and decorate them with electric lights. To make the scenery more beautiful, the heights of the decorated trees should be as close to each other as possible.

More specifically, let the height of the tallest decorated tree be h_{max} meters, and the height of the shortest decorated tree be h_{min} meters. The smaller the value h_{max} - h_{min} is, the better. What is the minimum possible value of h_{max} - h_{min}?

Constraints

2 \leq K < N \leq 10^5

1 \leq h_i \leq 10^9

h_i is an integer.

Input

Input is given from Standard Input in the following format:

N K
h_1
h_2
:
h_N

Output

Print the minimum possible value of h_{max} - h_{min}.

Sample Input 1

5 3
10
15
11
14
12

Sample Output 1

2

If we decorate the first, third and fifth trees, h_{max} = 12, h_{min} = 10 so h_{max} - h_{min} = 2. This is optimal.

Sample Input 2

5 3
5
7
5
7
7

Sample Output 2

0

If we decorate the second, fourth and fifth trees, h_{max} = 7, h_{min} = 7 so h_{max} - h_{min} = 0. This is optimal.

There are not too many trees in these sample inputs, but note that there can be at most one hundred thousand trees (we just can't put a sample with a hundred thousand lines here).


import Data.List

differ :: Int -> [Int] -> Int
differ k l = dif (eval c) c (drop k sl) where
    sl = sort l
    c  = take k sl
    dif m _ [] = m
    dif m (x:xs) (y:ys)
        | d < m     = dif d cl ys
        | otherwise = dif m cl ys
        where
            cl = xs ++ [y]
            d  = eval cl
    eval = iter (10^9) 1 where
        iter min max [] = max - min
        iter min max (x:xs)
            | x < min = iter x max xs
            | x > max = iter min x xs
            | otherwise = iter min max xs

readData :: Int -> IO [Int]
readData 0 = return []
readData n = do
    x <- readLn :: IO Int
    fmap (x:) $ readData (n-1)

main :: IO()
main = do
    line1 <- getLine
    let [stN, stK] = words line1
        n = read stN :: Int
        k = read stK :: Int
    l <- readData n
    let ans = differ k l
    print ans


import Data.Int

main = do
    [n,x] <- map read . words <$> getLine :: IO [Int]
    print $ eat x $ mkBurgerNum n

-- (total，pate)
mkBurgerNum :: Int -> [[Int]]
mkBurgerNum n
    | n == 0 = [[1,1]]
    | otherwise = [2*m+3, 2*l+1]:x
    where
        x = mkBurgerNum (n-1)
        m = x !! 0 !! 0
        l = x !! 0 !! 1

-- x mkBurgerNum
eat :: Int -> [[Int]] -> Int
eat x (berger:[]) = 1
eat x (berger:child_berger:xs)
    | x == 1 = 0
    | x > child_berger_num + 2 = child_pate_num + 1 + eat (x - 2 - child_berger_num) (child_berger:xs)
    | x == child_berger_num + 2 = 1 + child_pate_num
    | otherwise = eat (x-1) $ child_berger:xs
    where
        child_berger_num = child_berger !! 0
        child_pate_num = child_berger !! 1

Score : 400 points

Problem Statement

In some other world, today is Christmas.

Mr. Takaha decides to make a multi-dimensional burger in his party. A level-L burger (L is an integer greater than or equal to 0) is the following thing:

A level-0 burger is a patty.

A level-L burger (L \geq 1) is a bun, a level-(L-1) burger, a patty, another level-(L-1) burger and another bun, stacked vertically in this order from the bottom.

For example, a level-1 burger and a level-2 burger look like BPPPB and BBPPPBPBPPPBB (rotated 90 degrees), where B and P stands for a bun and a patty.

The burger Mr. Takaha will make is a level-N burger. Lunlun the Dachshund will eat X layers from the bottom of this burger (a layer is a patty or a bun). How many patties will she eat?

Constraints

1 \leq N \leq 50

1 \leq X \leq ( the total number of layers in a level-N burger )

N and X are integers.

Input

Input is given from Standard Input in the following format:

N X

Output

Print the number of patties in the bottom-most X layers from the bottom of a level-N burger.

Sample Input 1

2 7

Sample Output 1

4

There are 4 patties in the bottom-most 7 layers of a level-2 burger (BBPPPBPBPPPBB).

Sample Input 2

1 1

Sample Output 2

0

The bottom-most layer of a level-1 burger is a bun.

Sample Input 3

50 4321098765432109

Sample Output 3

2160549382716056

A level-50 burger is rather thick, to the extent that the number of its layers does not fit into a 32-bit integer.


import Data.List
import Data.Ord
import Data.Char
import Data.Ratio
import Data.Maybe

main = do
  s <-getLine
  print $minimum $map (abs .(753-) .(read::String->Int)) $subString 3 s

subString _ [] = []
subString n s@(x:xs)
  |n<=length s = take n s : subString n xs
  |otherwise   = []

Score : 200 points

Problem Statement

There is a string S consisting of digits 1, 2, ..., 9.
Lunlun, the Dachshund, will take out three consecutive digits from S, treat them as a single integer X and bring it to her master. (She cannot rearrange the digits.)

The master's favorite number is 753. The closer to this number, the better.
What is the minimum possible (absolute) difference between X and 753?

Constraints

S is a string of length between 4 and 10 (inclusive).

Each character in S is 1, 2, ..., or 9.

Input

Input is given from Standard Input in the following format:

S

Output

Print the minimum possible difference between X and 753.

Sample Input 1

1234567876

Sample Output 1

34

Taking out the seventh to ninth characters results in X = 787, and the difference between this and 753 is 787 - 753 = 34. The difference cannot be made smaller, no matter where X is taken from.

Note that the digits cannot be rearranged. For example, taking out 567 and rearranging it to 765 is not allowed.

We cannot take out three digits that are not consecutive from S, either. For example, taking out the seventh digit 7, the ninth digit 7 and the tenth digit 6 to obtain 776 is not allowed.

Sample Input 2

35753

Sample Output 2

0

If 753 itself can be taken out, the answer is 0.

Sample Input 3

1111111111

Sample Output 3

642

No matter where X is taken from, X = 111, with the difference 753 - 111 = 642.


part :: Int -> [a] -> [[a]]
part n a = [(take n . drop i) a | i <- [0..length a - n]]

main :: IO ()
main = do
    s <- getLine
    let nums = map (abs . (-) 753 . read) $ part 3 s :: [Int]
    print $ minimum nums


minDiffFrom753 :: String -> Int
minDiffFrom753 ('7':'5':'3':xs) = 0
minDiffFrom753 target@(x1:x2:x3:xs)
  | null xs   = diff
  | otherwise = min diff $ minDiffFrom753 $ tail target
  where extracted = read [x1,x2,x3]
        diff      = abs $ extracted - 753

main :: IO ()
main = do
  target <- getLine
  print $ minDiffFrom753 target


import Data.List
import Data.Char
-- import Debug.Trace

l = [3,5,7]

scan :: Int -> Int
scan n = iter (log10 n) where
    iter 2 = 0
    iter s = length ts + iter (s-1) where
        ts = filter (\e -> constraint e) (comb l s)
        constraint e = (all (\x -> elem x e) l) && (toN e < n)

toN :: [Int] -> Int
toN = iter 0 where
    iter ac [] = ac
    iter ac (x:xs) = iter (ac*10 + x) xs

log10 :: Int -> Int
log10 n = iter 0 1 where
    iter e x
        | x >= n = e
        | otherwise = iter (e+1) (x*10)

comb :: [a] -> Int -> [[a]]
comb xs 0 = [[]]
comb xs n = [x:y| x <- xs, y <- (comb xs (n-1))]

main :: IO()
main = do
    s <- readLn :: IO Int
    let ans = scan s
    print ans

Score : 300 points

Problem Statement

You are given an integer N. Among the integers between 1 and N (inclusive), how many Shichi-Go-San numbers (literally "Seven-Five-Three numbers") are there?

Here, a Shichi-Go-San number is a positive integer that satisfies the following condition:

When the number is written in base ten, each of the digits 7, 5 and 3 appears at least once, and the other digits never appear.

Constraints

1 \leq N < 10^9

N is an integer.

Input

Input is given from Standard Input in the following format:

N

Output

Print the number of the Shichi-Go-San numbers between 1 and N (inclusive).

Sample Input 1

575

Sample Output 1

4

There are four Shichi-Go-San numbers not greater than 575: 357, 375, 537 and 573.

Sample Input 2

3600

Sample Output 2

13

There are 13 Shichi-Go-San numbers not greater than 3600: the above four numbers, 735, 753, 3357, 3375, 3537, 3557, 3573, 3575 and 3577.

Sample Input 3

999999999

Sample Output 3

26484


main = do
    n <- read <$> getLine :: IO Int
    print $ length (filter ((<n) . read) (num753Numbers 9 ""))

num753Numbers :: Int -> String -> [String]
num753Numbers maxDigit xs
    | length xs > maxDigit = []
    | otherwise = let list7 = num753Numbers maxDigit ('7':xs)
                      list5 = num753Numbers maxDigit ('5':xs)
                      list3 = num753Numbers maxDigit ('3':xs)
                      includes753 = '7' `elem` xs && '5' `elem` xs && '3' `elem` xs
                      includesOnly753 = and (map (`elem` "753") xs)
                      list = if includes753 && includesOnly753 then [xs] else []
                  in concat [list7, list5, list3, list]


import           Data.Bits ((.&.))
import           Data.List (foldl1', inits, tails)

main :: IO ()
main = do
  [n, k] <- take 2 . map read . words <$> getLine
  as <- take n . map read . words <$> getLine
  print $ f k as

f :: Int -> [Int] -> Int
f k =
  maximum .
  map (foldl1' (.&.)) .
  combinations k .
  map sum .
  concatMap (tail . inits) .
  init . tails

combinations :: Int -> [a] -> [[a]]
combinations 0 _      = [[]]
combinations _ []     = []
combinations n (x:xs) = map (x:) (combinations (n - 1) xs) ++ combinations n xs

Score : 400 points

Problem Statement

One day, Niwango-kun, an employee of Dwango Co., Ltd., found an integer sequence (a_1, ..., a_N) of length N.
He is interested in properties of the sequence a.

For a nonempty contiguous subsequence a_l, ..., a_r (1 \leq l \leq r \leq N) of the sequence a, its beauty is defined as a_l + ... + a_r. Niwango-kun wants to know the maximum possible value of the bitwise AND of the beauties of K nonempty contiguous subsequences among all N(N+1)/2 nonempty contiguous subsequences. (Subsequences may share elements.)

Find the maximum possible value for him.

Constraints

2 \leq N \leq 1000

1 \leq a_i \leq 10^9

1 \leq K \leq N(N+1)/2

All numbers given in input are integers

Input

Input is given from Standard Input in the following format:

N K
a_1 a_2 ... a_N

Output

Print the answer.

Sample Input 1

4 2
2 5 2 5

Sample Output 1

12

There are 10 nonempty contiguous subsequences of a. Let us enumerate them:

contiguous subsequences starting from the first element: \{2\}, \{2, 5\}, \{2, 5, 2\}, \{2, 5, 2, 5\}

contiguous subsequences starting from the second element: \{5\}, \{5, 2\}, \{5, 2, 5\}

contiguous subsequences starting from the third element: \{2\}, \{2, 5\}

contiguous subsequences starting from the fourth element: \{5\}

(Note that even if the elements of subsequences are equal, subsequences that have different starting indices are considered to be different.)

The maximum possible bitwise AND of the beauties of two different contiguous subsequences is 12.
This can be achieved by choosing \{5, 2, 5\} (with beauty 12) and \{2, 5, 2, 5\} (with beauty 14).

Sample Input 2

8 4
9 1 8 2 7 5 6 4

Sample Output 2

32


{-# LANGUAGE BangPatterns #-}
import           Control.Exception (assert, evaluate)
import           Data.List         (foldl')

main :: IO ()
main = do
  n <- readLn
  s <- getLine
  evaluate $ assert (length s == n) ()
  q <- readLn
  ks <- take q . map read . words <$> getLine
  putStr . unlines . map (show . (\k -> f k s)) $ ks

f :: Int -> String -> Int
f k = dmc . foldl g initialState . defer k
  where
    g :: State -> (Char, Maybe Char) -> State
    g state (c, c') = (countIn c (maybe id countOut c' state))

-- Strict にしないと TLE がでる
data State =
  State
  { d     :: !Int
  , m     :: !Int
  , dm    :: !Int
  , dmc   :: !Int
  }

defer :: Int -> [a] -> [(a, Maybe a)]
defer n xs = zip xs $ replicate n Nothing ++ map Just xs

initialState :: State
initialState = State { d = 0, m = 0, dm = 0, dmc = 0 }

countIn :: Char -> State -> State
countIn 'D' count = count { d = d count + 1 }
countIn 'M' count = count { m = m count + 1, dm = dm count + d count }
countIn 'C' count = count { dmc = dmc count + dm count }
countIn _   count = count

countOut :: Char -> State -> State
countOut 'D' count = count { d = d count - 1, dm = dm count - m count }
countOut 'M' count = count { m = m count - 1 }
countOut _   count = count

Score : 600 points

Problem Statement

In Dwango Co., Ltd., there is a content distribution system named 'Dwango Media Cluster', and it is called 'DMC' for short.

The name 'DMC' sounds cool for Niwango-kun, so he starts to define DMC-ness of a string.

Given a string S of length N and an integer k (k \geq 3),
he defines the k-DMC number of S as the number of triples (a, b, c) of integers that satisfy the following conditions:

0 \leq a < b < c \leq N - 1

S[a] = D

S[b] = M

S[c] = C

c-a < k

Here S[a] is the a-th character of the string S. Indexing is zero-based, that is, 0 \leq a \leq N - 1 holds.

For a string S and Q integers k_0, k_1, ..., k_{Q-1}, calculate the k_i-DMC number of S for each i (0 \leq i \leq Q-1).

Constraints

3 \leq N \leq 10^6

S consists of uppercase English letters

1 \leq Q \leq 75

3 \leq k_i \leq N

All numbers given in input are integers

Input

Input is given from Standard Input in the following format:

N
S
Q
k_{0} k_{1} ... k_{Q-1}

Output

Print Q lines.
The i-th line should contain the k_i-DMC number of the string S.

Sample Input 1

18
DWANGOMEDIACLUSTER
1
18

Sample Output 1

1

(a,b,c) = (0, 6, 11) satisfies the conditions.

Strangely, Dwango Media Cluster does not have so much DMC-ness by his definition.

Sample Input 2

18
DDDDDDMMMMMCCCCCCC
1
18

Sample Output 2

210

The number of triples can be calculated as 6\times 5\times 7.

Sample Input 3

54
DIALUPWIDEAREANETWORKGAMINGOPERATIONCORPORATIONLIMITED
3
20 30 40

Sample Output 3

0
1
2

(a, b, c) = (0, 23, 36), (8, 23, 36) satisfy the conditions except the last one, namely, c-a < k_i.

By the way, DWANGO is an acronym for "Dial-up Wide Area Network Gaming Operation".

Sample Output 4

30
DMCDMCDMCDMCDMCDMCDMCDMCDMCDMC
4
5 10 15 20

Sample Output 4

10
52
110
140


{-# LANGUAGE BangPatterns #-}

import qualified Data.Vector.Unboxed as VU
import qualified Data.ByteString.Char8 as BS
import Control.Monad

data Counter = Counter { cD :: {-# UNPACK #-} !Int,
                         cM :: {-# UNPACK #-} !Int,
                         cDM :: {-# UNPACK #-} !Int,
                         cAcc :: {-# UNPACK #-} !Int }

query :: BS.ByteString -> Int -> Int
query str k = cAcc $ VU.foldl' update cInit padded
  where
    cInit = Counter 0 0 0 0
    padded = VU.generate (BS.length str) $ \i ->
      (BS.index str i, if i < k then ' ' else BS.index str (i-k))
    update c0 (now,old) = c2
      where
        c2 = case now of
          'D' -> c1 { cD = cD c1 + 1 }
          'M' -> c1 { cM = cM c1 + 1, cDM = cDM c1 + cD c1 }
          'C' -> c1 { cAcc = cAcc c1 + cDM c1 }
          _   -> c1
        c1 = case old of
          'D' -> c0 { cD = cD c0 - 1, cDM = cDM c0 - cM c0 }
          'M' -> c0 { cM = cM c0 - 1 }
          _   -> c0

main :: IO ()
main = do
  getLine
  str <- BS.getLine
  q <- read <$> getLine
  ks <- VU.unfoldrN q (BS.readInt . BS.dropWhile (==' ')) <$> BS.getLine
  VU.mapM_ (putStrLn . show . query str) ks


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.List
import qualified Data.Vector.Unboxed as VU
-- import qualified Data.Vector.Unboxed.Mutable as VUM
-- import Control.Monad
-- import Control.Monad.ST
import Debug.Trace

solve :: Int -> String -> Int -> [Int] -> [Int]
solve n s q ks = map count ks
  where

  sv = VU.fromList s

  count k = sum lst
    where
    (_, lst) = mapAccumL op (0,0,0) [0..n-1]
      where
      op (numD, numM, numDM) i
        | cur == 'D' = ((numD1 + 1, numM1, numDM1), 0)
        | cur == 'M' = ((numD1, numM1 + 1, numDM1 + numD1), 0)
        | cur == 'C' = ((numD1, numM1, numDM1), numDM1)
        | otherwise  = ((numD1, numM1, numDM1), 0)
        where
          cur = sv VU.! i
          left = sv VU.! (i-k)
          (numD1, numM1, numDM1)
            | i-k < 0 = (numD, numM, numDM)
            | left == 'D' = (numD - 1, numM, numDM - numM)
            | left == 'M' = (numD, numM - 1, numDM)
            | otherwise   = (numD, numM, numDM)

readBInt :: B.ByteString -> Int
readBInt = fst . fromJust . B.readInt

tmain :: B.ByteString -> [Int]
tmain cont =
  let remLines0 = map B.words (B.lines cont)
      [bs_n]:remLines1 = remLines0
      n = readBInt bs_n
      [bs_s]:remLines2 = remLines1
      s = B.unpack bs_s
      [bs_q]:remLines3 = remLines2
      q = readBInt bs_q
      line4:remLines4 = remLines3
      ks = map readBInt line4
  in solve n s q ks

outAnswer :: [Int] -> IO ()
outAnswer xs = putStr $ unlines $ map show xs

main :: IO ()
main = outAnswer . tmain =<< B.getContents


main::IO ()
main = do
    [x,y] <- map read . words <$> getLine
    print (x + div y 2)

Score: 100 points

Problem Statement

There is a train going from Station A to Station B that costs X yen (the currency of Japan).

Also, there is a bus going from Station B to Station C that costs Y yen.

Joisino got a special ticket. With this ticket, she can take the bus for half the fare if she travels from Station A to Station B by train and then travels from Station B to Station C by bus.

How much does it cost to travel from Station A to Station C if she uses this ticket?

Constraints

1 \leq X,Y \leq 100

Y is an even number.

All values in input are integers.

Input

Input is given from Standard Input in the following format:

X Y

Output

If it costs x yen to travel from Station A to Station C, print x.

Sample Input 1

81 58

Sample Output 1

110

The train fare is 81 yen.

The train fare is 58 ⁄ 2=29 yen with the 50% discount.

Thus, it costs 110 yen to travel from Station A to Station C.

Sample Input 2

4 54

Sample Output 2

31


toInt :: Float -> Int
toInt n = round n

main = do
	[x, y] <- map read . words <$> getLine
	putStrLn . show $ toInt $ x + y / 2


main :: IO ()
main = do
  [x, y] <- map read . words <$> getLine
  print $ f x y

f :: Int -> Int -> Int
f x y = x + y `div` 2


import Data.Int (Int64)
import Data.List
import Data.Function

main :: IO ()
main = do
    _ <- getLine
    [t,a] <- map read . words <$> getLine :: IO [Int64]
    h <- map read . words <$> getLine :: IO [Int64]
    print . snd . minimumBy (compare `on` fst)
          $ zip [ abs (a * 1000 - t * 1000 - x * 6) | x <- h ] [1..]

Score: 200 points

Problem Statement

A country decides to build a palace.

In this country, the average temperature of a point at an elevation of x meters is T-x \times 0.006 degrees Celsius.

There are N places proposed for the place. The elevation of Place i is H_i meters.

Among them, Princess Joisino orders you to select the place whose average temperature is the closest to A degrees Celsius, and build the palace there.

Print the index of the place where the palace should be built.

It is guaranteed that the solution is unique.

Constraints

1 \leq N \leq 1000

0 \leq T \leq 50

-60 \leq A \leq T

0 \leq H_i \leq 10^5

All values in input are integers.

The solution is unique.

Input

Input is given from Standard Input in the following format:

N
T A
H_1 H_2 ... H_N

Output

Print the index of the place where the palace should be built.

Sample Input 1

2
12 5
1000 2000

Sample Output 1

1

The average temperature of Place 1 is 12-1000 \times 0.006=6 degrees Celsius.

The average temperature of Place 2 is 12-2000 \times 0.006=0 degrees Celsius.

Thus, the palace should be built at Place 1.

Sample Input 2

3
21 -11
81234 94124 52141

Sample Output 2

3


import Data.List

solver::Int -> Int -> [Int] -> Int
solver t a= fst.head.(sortBy (\ (_,x) -> \ (_,y) -> compare (f x) (f y))).(zip [1..])
                where f x = abs ((fromIntegral a) - (fromIntegral t) + 0.006*(fromIntegral x))

main::IO()
main=do
  _<-getLine
  ta<-getLine
  let t:a:[]= map read (words ta)
  dat<-getLine
  let d = map read (words dat)
  print (solver t a d)


import qualified Data.ByteString.Char8 as B
import qualified Data.Map as MP
import qualified Data.Vector.Unboxed as VU
import Data.Char
import Data.List

toTuple :: B.ByteString -> (Int, Int)
toTuple bs =
    let
        Just (a, bs') = B.readInt bs
        Just (b, _) = B.readInt $ B.dropWhile isSpace bs'
    in
        (a, b)

make :: MP.Map Int [Int] -> (Int, Int) -> MP.Map Int [Int]
make m (a,b) =
    case MP.lookup a m of
        Just _ -> MP.adjust (b:) a m
        Nothing -> MP.insert a [b] m

rebuild :: MP.Map Int [Int] -> MP.Map Int (VU.Vector Int) -> MP.Map Int (VU.Vector Int)
rebuild m n
    | MP.null m = n
    | otherwise = rebuild m' (MP.insert i xs' n)
        where
            ((i,xs),m') = MP.deleteFindMin m
            xs' = VU.fromList $ sort xs

lowerBound :: VU.Vector Int -> (Int, Int) -> Int -> Int
lowerBound vec (from, to) target
    | from == to = from
    | mValue >= target = lowerBound vec (from, mid) target
    | mValue < target = lowerBound vec (mid + 1, to) target
        where
            mid = (from + to) `quot` 2
            mValue = vec VU.! mid

comp :: Int -> String
comp n = zero ++ n'
    where
        n' = show n
        zero = replicate (6 - (length n')) '0'

main = do
    [n,m] <- map read . words <$> getLine
    xs <- VU.replicateM m (toTuple <$> B.getLine)
    let m = VU.foldl' make MP.empty xs
    let m' = rebuild m MP.empty
    VU.forM_ xs $ \(p,y) -> do
        let Just ys = MP.lookup p m'
        let lb = lowerBound ys (0, VU.length ys) y
        putStrLn $ comp p ++ comp (lb+1)

Score: 300 points

Problem Statement

In Republic of Atcoder, there are N prefectures, and a total of M cities that belong to those prefectures.

City i is established in year Y_i and belongs to Prefecture P_i.

You can assume that there are no multiple cities that are established in the same year.

It is decided to allocate a 12-digit ID number to each city.

If City i is the x-th established city among the cities that belong to Prefecture i, the first six digits of the ID number of City i is P_i, and the last six digits of the ID number is x.

Here, if P_i or x (or both) has less than six digits, zeros are added to the left until it has six digits.

Find the ID numbers for all the cities.

Note that there can be a prefecture with no cities.

Constraints

1 \leq N \leq 10^5

1 \leq M \leq 10^5

1 \leq P_i \leq N

1 \leq Y_i \leq 10^9

Y_i are all different.

All values in input are integers.

Input

Input is given from Standard Input in the following format:

N M
P_1 Y_1
:
P_M Y_M

Output

Print the ID numbers for all the cities, in ascending order of indices (City 1, City 2, ...).

Sample Input 1

2 3
1 32
2 63
1 12

Sample Output 1

000001000002
000002000001
000001000001

As City 1 is the second established city among the cities that belong to Prefecture 1, its ID number is 000001000002.

As City 2 is the first established city among the cities that belong to Prefecture 2, its ID number is 000002000001.

As City 3 is the first established city among the cities that belong to Prefecture 1, its ID number is 000001000001.

Sample Input 2

2 3
2 55
2 77
2 99

Sample Output 2

000002000001
000002000002
000002000003