combi :: Int -> Int
combi n = length [[a, b, c, d] |
    a <- [0 .. 9], b <- [0 .. 9], c <- [0 .. 9], d <- [0 .. 9],
        a + b + c + d == n]

main :: IO ()
main = putStr. unlines . map show . map combi . map read . lines =<< getContents

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

Sum of 4 Integers

Write a program which reads an integer n and identifies the number of combinations of a, b, c and d (0 ≤ a, b, c, d ≤ 9) which meet the following equality:

a + b + c + d = n

For example, for n = 35, we have 4 different combinations of (a, b, c, d): (8, 9, 9, 9), (9, 8, 9, 9), (9, 9, 8, 9), and (9, 9, 9, 8).

Input

The input consists of several datasets. Each dataset consists of n (1 ≤ n ≤ 50) in a line. The number of datasets is less than or equal to 50.

Output

Print the number of combination in a line.

Sample Input

35
1

Output for the Sample Input

4
4

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.Monad
import Control.Monad.ST
import qualified Data.Vector.Unboxed as V
import qualified Data.Vector.Unboxed.Mutable as VM

-- haskell can be this iterative!
sieve :: Int -> V.Vector Bool
sieve upto = runST $ do
    s <- VM.replicate (upto+1) True
    VM.write s 0 False
    VM.write s 1 False
    forM_ [2..(ceiling.sqrt.fromIntegral $ upto)] $ \i -> do
        isP <- VM.read s i
        when isP $ forM_ [i*i, i*i+i..upto] (\n -> VM.write s n False)
    V.unsafeFreeze s

numPrimes :: Int -> Int
numPrimes = V.length . V.filter id . sieve

main = getContents >>= mapM_ (print . numPrimes . read) . lines

Prime Number

Write a program which reads an integer n and prints the number of prime numbers which are less than or equal to n. A prime number is a natural number which has exactly two distinct natural number divisors: 1 and itself. For example, the first four prime numbers are: 2, 3, 5 and 7.

Input

Input consists of several datasets. Each dataset has an integer n (1 ≤ n ≤ 999,999) in a line.

The number of datasets is less than or equal to 30.

Output

For each dataset, prints the number of prime numbers.

Sample Input

10
3
11

Output for the Sample Input

4
2
5


import System.IO

prime :: Int -> Int
prime x
  | x < 2 = 0
  | otherwise = length $ remove4Prime [2..x]

remove4Prime :: [Int] -> [Int]
remove4Prime [] = []
remove4Prime (x:xs) = x : remove4Prime [a | a <- xs, mod a x /= 0]

main = do
  done <- isEOF
  if done
    then return()
    else do
      num <- getLine
      print ( prime $ read  num :: Int )
      main


import Data.Functor

main = do
  n <- getRows <$> getContents
  mapM_ print $ map (\x -> length $ takeWhile (<= x) primes') n

getRows s = map (read :: (String -> Int)) $ lines s

primes' :: Integral a => [a]
primes' = 2 : filter isPrime' [3,5..]

isPrime' :: Integral a => a -> Bool
isPrime' x
    | x > 1 = all ((0 /=) . mod x) $ takeWhile ((<= x) . (^ 2)) primes'
        | otherwise = False


sumup _ [] = []
sumup s (x:xs) =
  let s' = (s+x)
  in
    s':(sumup s' xs)

scan :: (Int,Int) -> [Int] -> (Int,Int)
scan (m,a) [] = (m,a)
scan (m,a) (x:xs) =
  let m' = min m x
      a' = max a (x-m)
  in
    scan (m',a') xs

ans (0:_) = []
ans (n:x) =
  let a = take n x
      s = 0:(sumup 0 a)
      s0= s!!0
      (_,d) = scan (0,0) s
      r = drop n x
  in
    d:(ans r)

main = do
  c <- getContents
  let i = map read $ lines c :: [Int]
      o = ans i
  mapM_ print o

Maximum Sum Sequence

Given a sequence of numbers a1, a2, a3, ..., an, find the maximum sum of a contiguous subsequence of those numbers. Note that, a subsequence of one element is also a contiquous subsequence.

Input

The input consists of multiple datasets. Each data set consists of:

n
a1
a2
.
.
an

You can assume that 1 ≤ n ≤ 5000 and -100000 ≤ ai ≤ 100000.

The input end with a line consisting of a single 0.

Output

For each dataset, print the maximum sum in a line.

Sample Input

7
-5
-1
6
4
9
-6
-7
13
1
2
3
2
-2
-1
1
2
3
2
1
-2
1
3
1000
-200
201
0

Output for the Sample Input

19
14
1001


main = interact $ unlines . map (show . goldbach . read) . takeWhile (/="0") . lines

goldbach n = if odd n then 0 else length [(x,y) | x<-primes', y<-primes', x<=y, x+y==n]
 where primes' = takeWhile (<n) primes

primes = 2:3:[x | i<-[1..], j<-[-1,1], let x = 6*i+j, isPrime x]
 where isPrime n = null [i | i<-takeWhile (\x -> x*x <= n) primes, rem n i == 0]

ゴールドバッハの予想

4 以上の偶数は 2 つの素数の和で表すことができるということが知られています。これはゴールドバッハ予想といい、コンピュータの計算によりかなり大きな数まで正しいことが確かめられています。例えば、10 は、7 + 3、5 + 5 の 2 通りの素数の和で表すことができます。

整数 n を入力し、n を 2 つの素数の和で表す組み合わせ数が何通りあるかを出力するプログラムを作成してください。ただし、n は 4 以上、50,000 以下とします。また、入力される n は偶数であるとはかぎりません。

Input

複数のデータセットが与えられます。各データセットに n が１行に与えられます。n が 0 のとき入力の最後とします。データセットの数は 10,000 を超えません。

Output

各データセットに対して、n を 2 つの素数の和で表す組み合わせ数を１行に出力して下さい。

Sample Input

10
11
0

Output for the Sample Input

2
0


split :: String -> String -> [String]
split _ "" = [""]
split t (s:sr)
  |t == [s] = [] : (split t sr)
  |otherwise = (s : (head (split t sr))) : (tail (split t sr))

search :: (Eq a) => a -> [a] -> Bool
search _ [] = False
search f (h:t)
  |(f == h) = True
  |otherwise = search f t

cul :: Int -> Int -> [Int] -> Int
cul 0 0 _ = 1
cul n s l
  |(n * s) == 0 = 0
  |otherwise = sum [cul (n - 1) (s - x * n) (x : l) | x <- [0..9], not (search x l)]

chomp :: [a] -> [a]
chomp (x:[]) = []
chomp (x:xr) = x : (chomp xr)

main = do
  input <- getContents
  mapM_ (\l -> print ((\n -> cul (head n) (head (tail n)) [] ) ((map (\n -> (read n) :: Int) (split " " l))))) (split "\n" (chomp input))

Combination of Number Sequences

0 から 9 までの整数を使った n 個の数の並び k1, k2, ..., kn を考えます。正の整数 n と s を読み込んで、

k1 + 2 × k2 + 3 × k3 + ... + n × kn = s

となっているような n 個の数の並びが何通りあるかを出力するプログラムを作成してください。ただし、1 つの「n 個の数の並び」には同じ数が 2 回以上現われないものとします。

Input

入力は複数のデータセットからなります。各データセットとして、n (1 ≤ n ≤ 10) と s (0 ≤ s ≤ 10,000)が空白区切りで１行に与えられます。

データセットの数は 100 を超えません。

Output

データセットごとに、n 個の整数の和が s になる組み合わせの個数を１行に出力します。

Sample Input

3 10
3 1

Output for the Sample Input

8
0


import Data.List

nAndS :: [Int] -> String
nAndS [n, s] = show $ length [xs | xs <- (perm [0..9] n)
                    ,sum (zipWith (*) xs [1..]) == s]

perm :: Eq a => [a] -> Int -> [[a]]
perm [] _ = [[]]
perm _ 0  = []
perm xs 1 = [[x]| x <- xs]
perm xs n = concat [map (x:) (perm(delete x xs) (n-1)) | x <- xs]

main = do
  s' <- getContents
  let s = map (map read) $ map words $ lines s'
  putStr $ unlines $ map nAndS s


import Data.List

main = interact $ unlines . map (show . comb_of_numseq . map read . words) . lines

comb_of_numseq [n,s] = f [0..9] 1 n s
 where
  f _ _ 0 0 = 1
  f _ _ 0 _ = 0
  f cs a n s = sum $ map (\c -> f (delete c cs') (a+1) (n-1) (s-a*c)) cs'
   where cs' = takeWhile (\c -> c*a <= s) cs


import Data.List

ans' :: Int -> [Int] -> Int -> Int
ans' 1 n s =
  if elem s n
  then 1
  else 0

ans' n num s =
  let max' = maximum num
      min' = minimum num
      smax = max' * ( div ( (n+1) * n ) 2 )
      smin = min' * ( div ( (n+1) * n ) 2 )
      num' = filter (\x -> s > x * n) num
  in
    -- Wrong Anser
--    if s > smax || s < smin
    if s < smin
    then 0
    else if num' == []
         then 0
         else sum $ map (\v -> ans' (n-1) (delete v num) (s - n*v) ) num'

    -- Time Limit Exceeded
    -- if num' == []
    -- then 0
    -- else sum $ map (\v -> ans' (n-1) (delete v num) (s - n*v) ) num'

ans [n,s] =
  ans' n [0..9] s

main = do
  c <- getContents
  let i = map (map read) $ map words $ lines c
      o = map ans i
  mapM_ print o


import Data.Ord
import Data.List

main = interact $ unlines . map (show . carden_lantern) . read' . lines
 where
  read' ("0":_) = []
  read' (_:m:xs) = map (parse . map read . splitOn ',') edge : read' xs'
   where
    (edge,xs') = splitAt (read m) xs
    parse [a,b,d] = ((a,b), div d 100)

carden_lantern = count . foldl' foldpath [] . sortBy (comparing snd)
 where
  count abd =  sum (map snd abd) - length abd
  foldpath acc abd@((a,b),_) = if disjoint a b (map fst acc) then (abd:acc) else acc
  disjoint a b ab
   | null ab = True
   | a == b = False
   | otherwise = and $ map (\(a,a') -> disjoint a' b (delete (a,a') ab)) from_a
   where from_a = filter ((==a).fst) ab

splitOn c xs
 | null xs = []
 | head xs == c = splitOn c (tail xs)
 | otherwise = (takeWhile (/= c)) xs : splitOn c (dropWhile (/= c) xs)

灯篭

会津若松市は「歴史の町」として知られています。今から約 400 年前、蒲生氏郷により城下町の骨格が作られましたが、その後、徳川三代将軍家光公の異母弟「保科正之」公を藩祖とする会津藩 23 万石の中心都市として発展しました。今でも市内のいたるところに史跡や昔日の面影が残っているため、毎年、全国から多くの観光客が訪れています。

今年は、ＮＨＫ大河ドラマで「新選組！」が放送されているため、新選組ゆかりの地(*1)として、大幅に観光客が増加しています。そこで市では、市内に点在する史跡を結ぶ通り沿いに 100 m 間隔で灯篭を設置して飾りたてることにしました。灯篭を飾ってある通りを辿れば市内の全ての史跡に到達できるように設置することが条件ですが、一筆書きでたどれる必要はありません。しかし、予算が限られているので設置する灯篭の数を最小限にする必要があります。

史跡と史跡を結ぶ通りのデータを読み込んで、必要最小限の灯篭の数を出力するプログラムを作成して下さい。ただし、史跡と史跡の間の距離は 200 m 以上で、100 の倍数で与えられます。おのおのの史跡から一番近い灯篭までの距離は 100 m で、市内の史跡は 100 箇所以内です。史跡自身には灯篭を設置する必要はありません。

(*1) 新選組は会津藩御預という形で発足、白虎隊の悲劇で知られる会津戊辰戦争に参戦、市内天寧寺に土方歳三が近藤勇の墓を建立

Input

複数のデータセットが与えられます。各データセットは以下の形式で与えられます。

n
m
a1,b1,d1
a2,b2,d2
:
am,bm,dm

各データセットの最初の 1 行には史跡の箇所数 n が与えられます。続いて史跡と史跡を結ぶ通りの数 m が与えられます。続く m 行に カンマで区切られてた3 つの数数 ai, bi, di が与えられます。ai, bi は史跡の番号です。史跡の番号は 0 番から n - 1 番まで振られています。ai bi はそれらを結ぶ通りがあることを示し、di は ai bi 間の道路の距離を表します。

n が 0 のとき入力の最後とします。データセットの数は 20 を超えません。

Output

各データセットに対して、必要最小限の灯篭の数を１行に出力して下さい。

Sample Input

4
4
0,1,1500
0,2,2000
1,2,600
1,3,500
0

Output for the Sample Input

23


import qualified Data.Map.Strict as M
import Data.List
import Data.Maybe

main = interact $ unlines . unfoldr main' . lines
 where
  main' (n':xs)
   | n' == "0" = Nothing
   | otherwise = return (show (square_searching m), xs')
   where
    (m',xs') = splitAt n xs
    n = read n'
    m = [(x,y) | x<-[0..n-1], y<-[0..n-1], m'!!y!!x == '.']

square_searching :: [(Int,Int)] -> Int
square_searching m
 | null m = 0
 | otherwise = maximum $ M.elems (foldl' dp M.empty m)

dp :: M.Map (Int,Int) Int -> (Int,Int) -> M.Map (Int,Int) Int
dp m xy@(x,y) = M.insert xy (v+1) m
 where v = minimum $ map (\k -> M.findWithDefault 0 k m) [(x-1,y),(x,y-1),(x-1,y-1)]

正方形探索

縦に n 行、横に n 列並べられた、合計 n × n のマス目があります。いくつかのマス目には印がついています。各マス目の印の状態を読み込み、印のついていないマス目だけからなる最大の正方形の辺の長さを出力として表示するプログラムを作成してください。

たとえば各データセットで以下のようなデータが与えられます。

10
...*....**
..........
**....**..
........*.
..*.......
..........
.*........
..........
....*..***
.*....*...

入力データの一行が、一行のマス目を表現します。入力データの文字列のうち、.（ピリオド）は印のついていないマス目、*（アスタリスク）は印のついているマス目を示しています。

上記の例では、下図の 0 で示される正方形が最大となります。

...*....**
..........
**....**..
...00000*.
..*00000..
...00000..
.*.00000..
...00000..
....*..***
.*....*...

よって、5 と出力すれば正解になります。

なお、すべてのマス目に印がついている場合には、0 を出力してください。

Input

上記形式で複数のデータセットが与えられます。
n が 0 のとき入力の最後とします。n は 1000 以下とします。入力データの文字列には、ピリオド、アスタリスク、改行以外の文字は含まれません。データセットの数は 50 を超えません。

Output

各データセットに対し、最大の正方形の辺の長さ（整数）を１行に出力して下さい。

Sample Input

10
...*....**
..........
**....**..
........*.
..*.......
..........
.*........
..........
....*..***
.*....*...
10
****.*****
*..*.*....
****.*....
*....*....
*....*****
..........
****.*****
*..*...*..
****...*..
*..*...*..
0

Output for the Sample Input

5
3


import Data.List
main = do
  ns <- getContents
  let a = sum' 4
  mapM_  print . map (\n -> a !! n) . map read $ lines ns
sum' :: Int -> [Int]
sum' 0 = [1]
sum' n =  map sum $ transpose (take 1001 $ iterate ([0]++) (sum' (n-1)))

４つの整数の和 II

4,000 以下の正の整数 n を入力し、0 〜 1000 の範囲の整数 a, b, c, d の組で

a + b + c + d = n

を満たすものの組み合わせ数を出力するプログラムを作成して下さい。

Input

複数のデータセットが与えられます。各データセットに n が１行に与えられます。入力の最後まで処理して下さい。

データセットの数は 50 を超えません。

Output

各データセットごとに、a, b, c, d の組み合わせの個数を１行に出力して下さい。

Sample Input

2
3
35

Output for the Sample Input

10
20
8436


import Control.Monad

main :: IO ()
main = do
  nq <- getLine
  let [n,q] = map strToInt $ words nq
      assocL = []
      counter = 0
  loopq counter q assocL

strToInt :: String -> Int
strToInt str = read str

loopq :: Int -> Int -> [[Int]] -> IO ()
loopq counter q assocL = do
  if counter >= q
    then return ()
    else do
      av <- getLine
      let [a,v] = map strToInt $ words av
          assocL' = update [a,v] assocL
          ans = format $ maxSearch assocL'
      putStrLn ans
      loopq (counter + 1) q assocL'

update :: [Int] -> [[Int]] -> [[Int]]
update xs [] = [xs]
update [x,y] ([x',y']:rest)
  | x > x' = [x',y']:(update [x,y] rest)
  | x < x' = [x,y]:[x',y']:rest
  | otherwise = [x,y+y']:rest
maxSearch :: [[Int]] -> [Int]
maxSearch xs = foldl1 f xs
                where f [a,b] [c,d]
                        | (b < d) || ((b == d) && (c < a)) = [c,d]
                        | otherwise = [a,b]

format :: [Int] -> String
format [a,b] = (show a) ++ " " ++ (show b)

ワカサギ釣り大会 2

桧原湖でワカサギ釣り大会が行われました。今回はキャッチ＆リリースが推奨されているようです。

参加者番号と釣った匹数またはリリースした匹数を１つのイベントとして順番に読み込み、各イベントの直後に最も多くのワカサギを手元に獲得している参加者番号と匹数を出力するプログラムを作成してください。最も多く獲得している参加者が複数いる場合（あるいは全ての参加者が 0 匹の場合）は、その中で参加者番号が最も小さい一人を出力してください。

入力

入力は以下の形式で与えられる。

n q
a1 v1
a2 v2
:
aq vq

n (1 ≤ n ≤ 1000000) は参加者の数、q (1 ≤ q ≤ 100000)はイベントの数を表す。ai (1 ≤ ai ≤ n)   vi ( -100 ≤ vi ≤ 100) は、i 番目のイベントで参加者 ai が vi 匹獲得あるいはリリースしたことを示す。vi は正の値が獲得、負の値がリリースを示し、0 が与えられることはない。

出力

各イベントごとに、最も多くのワカサギを手元に獲得している参加者の参加者番号と匹数を１つの空白区切りで１行に出力する。

入力例1

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

出力例1

1 4
2 5
1 7
1 7
2 12

入力例2

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

出力例2

1 4
2 5
1 4
1 4
3 4


import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString as BS
import Data.Functor
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.List
import qualified Data.Foldable as Foldable
import qualified Data.Set as Set
--import qualified Data.Sequence as Sequence
import Data.List.Split
import Data.Bits
import Data.Char
import Data.Ix
import Data.Ratio
import Data.Ord
import Data.Tuple
--import Data.Array
--import Data.Array.Unboxed
import Data.Array.IArray
import Data.Array.MArray
import Data.Array.IO
import Data.Array.ST
import Data.IORef
import Data.STRef
-- import System.IO.Unsafe

-- templete
readInt = read :: String -> Int
readInteger = read :: String -> Integer
readDouble = read :: String -> Double
getInt = readLn :: IO Int
getInts = map readInt . words <$> getLine
getInteger = readLn :: IO Integer
getIntegers = map readInteger . words <$> getLine
getDouble = readLn :: IO Double
sjoin :: (Show a) => [a] -> String
sjoin = unwords . map show
cond :: a -> a -> Bool -> a
cond t f c = if c then t else f
apply2 :: (a -> a -> b) -> [a] -> b
apply2 f [x,y] = f x y
apply3 :: (a -> a -> a -> b) -> [a] -> b
apply3 f [x,y,z] = f x y z
apply4 :: (a -> a -> a -> a -> b) -> [a] -> b
apply4 f [x,y,z,w] = f x y z w
fnTuple :: (a -> b, a -> c) -> a -> (b, c)
fnTuple (f,g) a = (f a, g a)
replace :: (Eq a) => a -> a -> [a] -> [a]
replace x y = map (\z -> if z==x then y else z)
binMap :: (a -> a -> b) -> [a] -> [b]
binMap f (x:xs@(y:_)) = f x y : binMap f xs
binMap _ _ = []
splitRec :: Int -> [a] -> [[a]]
splitRec _ [] = []
splitRec n xs = let (y,ys) = splitAt n xs in y : splitRec n ys
infixl 7 `divCeil`
divCeil :: Integral a => a -> a -> a
x `divCeil` y = (x+y-1) `div` y
coverC :: Ord a => (a, a) -> a -> Bool
coverC (l,r) x = l<=x && x<=r
coverH :: Ord a => (a, a) -> a -> Bool
coverH (l,r) x = l<=x && x<r
-- templete

main = do
  n <- getInt
  unless (n==0) $ do
      ts <- sort <$> replicateM n getInt
      print $ sum $ init $ scanl (+) 0 ts
      main

ミルクショップ

鈴木さんは会津地域に新しく搾りたてミルクの移動販売のお店を開きました。その日買い求めに来るお客さんは全員持ち帰るためのボトルを持って既にお店に並んでいて、それ以上増えないものとします。お客さんはそれぞれ1回だけしか注文しません。タンクの蛇口が一つしかないので、一人ずつ順番に販売しなければなりません。そこで、鈴木さんはなるべく並んでいるお客さんの待ち時間を少なくしたいと考えています。

お客さんの人数とお客さんが牛乳を注ぎきるのに要する時間が入力として与えられます。あなたはお客さんの「一人一人の待ち時間の合計」(以下「待ち時間の合計」とする)を最小にするための注文の順序を鈴木さんに代わって調べ、そのときの「待ち時間の合計」を出力して終了するプログラムを作成してください。ただし、お客さんは 10,000 人以下で 1 人あたりに要する時間は 60 分以下とします。

例えば、お客さんの人数が 5 人で、各お客さんが要する時間が順に 2,6,4,3,9 分の場合、そのままの順序だと「待ち時間の合計」は 37 分になります。次の例では、最初の列の順の 2 人目と 3 人目を入れ替えています。この場合、「待ち時間の合計」は 35 分になります。最適な順序だと 31 分で済みます。

待ち時間

1 人目 2 分

0 分

2 人目 6 分

2 分

3 人目 4 分

8 分

4 人目 3 分

12 分

5 人目 9 分

15 分

37 分

← 「待ち時間の合計」

2 人目と 3 人目を入れ替えた例

待ち時間

1 人目 2 分

0 分

2 人目 4 分

2 分

3 人目 6 分

6 分

4 人目 3 分

12 分

5 人目 9 分

15 分

35 分

← 「待ち時間の合計」

Input

複数のデータセットが与えられます。各データセットは以下の形式で与えられます。

n
t1
t2
:
tn

1 行目にお客さんの人数 n (n ≤ 10,000) が与えられます。続く n 行に i 人目のお客さんが要する時間を表す整数 ti (0 ≤ ti ≤ 60) がそれぞれ１行に与えられます。

入力は１つの 0 を含む行で終わります。データセットの数は 50 を超えません。

Output

各データセットごとに、待ち時間の合計(整数)を１行に出力してください。

Sample Input

5
2
6
4
3
9
0

Output for the Sample Input

31


dayCount [y1,m1,d1, y2,m2,d2]
  | y1 < y2 || m1 < m2 = monLen y1 m1 + dayCount (nextMon ++ [y2,m2,d2])
  | otherwise          = d2 - d1
  where nextMon | m1 < 12   = [y1, m1+1, d1]
                | otherwise = [y1+1,  1, d1]

monLen y m
  | m == 2    = 28 + leap y
  | otherwise = [31,28,31,30,31,30,31,31,30,31,30,31] !! (m - 1)

leap y = if isLeapYear y then 1 else 0
isLeapYear y = (y `mod` 4 == 0 && y `mod` 100 /= 0) || y `mod` 400 == 0

main = do
  s <- getLine
  let ls = map read . words $ s
  if or $ map (< 0) ls
    then return ()
    else do putStrLn . show . dayCount $ ls
            main

日数

2 つの日付を入力とし、その 2 つの日付けの間の日数を出力するプログラムを作成してください。

日付 1 (y1, m1, d1) は日付 2 (y2, m2, d2) と同じか、あるいはそれ以前の日付とします。日付 1 は日数に含め、日付 2 は含めません。また、うるう年を考慮にいれて計算してください。うるう年の条件は次のとおりとします。

西暦年が 4 で割り切れる年であること。

ただし、100 で割り切れる年はうるう年としない。

しかし、400 で割り切れる年はうるう年である。

Input

複数のデータセットが与えられます。各データセットの形式は以下のとおりです：

y1 m1 d1 y2 m2 d2

y1, m1, d1, y2, m2, d2 のいずれかが負の数のとき入力の終わりとします。

データセットの数は 50 を超えません。

Output

データセットごとに、日数を１行に出力してください。

Sample Input

2006 9 2 2006 9 3
2006 9 2 2006 11 11
2004 1 1 2005 1 1
2000 1 1 2006 1 1
2000 1 1 2101 1 1
-1 -1 -1 -1 -1 -1

Output for the Sample Input

1
70
366
2192
36890


main :: IO ()
main = do
  n <- readLn
  if n == 0
    then return ()
    else do
      putStrLn $ solve n
      main

solve :: Int -> String
solve n = format (findTwin (prime n))
  where
    format :: (Int,Int) -> String
    format (a,b) = (show a) ++ " " ++ (show b)

    findTwin :: [Int] -> (Int,Int)
    findTwin ls = findTwin' (reverse ls)
      where
        findTwin' :: [Int] -> (Int,Int)
        findTwin' (x:y:r)
          | x - y == 2 = (y,x)
          | otherwise = findTwin' (y:r)
    prime :: Int -> [Int]
    prime n = loop [2..n]
      where
        loop :: [Int] -> [Int]
        loop [] = []
        loop (x:xs) = x:(loop (filter (\y -> y `mod` x /= 0) xs))

Twin Prime

Prime numbers are widely applied for cryptographic and communication technology.
A twin prime is a prime number that differs from another prime number by 2.
For example, (5, 7) and (11, 13) are twin prime pairs.

In this problem, we call the greater number of a twin prime "size of the twin prime."

Your task is to create a program which reads an integer n and prints a twin prime which has the maximum size among twin primes less than or equals to n

You may assume that 5 ≤ n ≤ 10000.

Input

The input is a sequence of datasets. The end of the input is indicated by a line containing one zero. Each dataset is formatted as follows:

n (integer)

Output

For each dataset, print the twin prime p and q (p < q). p and q should be separated by a single space.

Sample Input

12
100
200
300
0

Output for the Sample Input

5 7
71 73
197 199
281 283


import Control.Applicative ((<$>))
import Control.Monad (replicateM, unless)
import Data.List (permutations, minimumBy)
import Data.Function (on)

main :: IO ()
main = do
  n <- readLn
  unless (n == 0) $ do
    solve n
    main

solve :: Int -> IO ()
solve n = do
  xs <- replicateM n $ food <$> getLine
  let fs = minimumBy (compare `on` cog) . filter f . permutations $ xs
  mapM_ print fs
  where f :: [Food] -> Bool
        f fs = maybe False (const True) . foldr g (Just 0) $ fs
          where g _ Nothing = Nothing
                g fd (Just w) | w <= (sp fd) = Just (w + (wt fd))
                              | otherwise = Nothing
cog :: [Food] -> Double
cog fs = sum (zipWith (\a b -> (fromIntegral a) * (fromIntegral b)) (map wt fs) [1 ..]) / fromIntegral (sum (map wt fs))

data Food = Food {nm :: String, wt :: Int, sp :: Int}

instance Show Food where
  show (Food n _ _) = n

food :: String -> Food
food s = let (n:w:p:_) = words s
         in Food n (read w) (read p)

ランチ

お昼に食べるお弁当を作るために、お店で食べ物を買いました。お店では、食べ物を入れるのに細長い袋しかもらえなかったので、すべての食べ物を縦に積んで袋に入れる必要があります。袋が倒れにくいように、できるだけ重い物を下にして詰めたいのですが、食べ物の中にはやわらかい物もあって、上に重い物を乗せるとつぶれてしまいます。

そこで、食べ物の情報を入力とし、全ての食べ物がつぶれず、かつ全体の重心が最も低くなるような積み方を出力するプログラムを作成してください。それぞれの食べ物ごとに、名前 f、重さ w、上に載せて耐えられる重さ s が指定されます。
「全ての食べ物がつぶれない」というのは、下から順に、（f1、f2、... 、fn）と n 個の食べ物を積んだ時、すべての f について、

sfi ≥ wfi+1 + wfi+2 + ... + wfn

であることを意味します。また、全体の重心 G は、

G = (1 × wf1 + 2 × wf2 + ... + n × wfn) / (wf1 + wf2+ ... +wfn)

とします。ただし、解はちょうど1つだけ存在するものとします。

Input

複数のデータセットの並びが入力として与えられます。入力の終わりはゼロひとつの行で示されます。各データセットは以下の形式で与えられます。

n
f1 w1 s1
f2 w2 s2
:
fn wn sn

１行目に食べ物の個数 n (1 ≤ n ≤ 10)、続く n 行に i 番目の食べ物の名前 fi (20 文字以内の半角英文字列)、重さ wi (1 ≤ wi ≤ 1000)、耐えられる重さ si (1 ≤ si ≤ 1000) が空白区切りで与えられます。

データセットの数は 20 を超えません。

Output

データセットごとに、次の形式で食べ物の名前を下から積み上げる順に出力します。

1 行目: 1 番下の食べ物の名前（半角英文字列）

2 行目: 下から2 番目の食べ物の名前

：

n 行目: 1 番上の食べ物の名前

Sample Input

4
sandwich 80 120
apple 50 200
cheese 20 40
cake 100 100
9
onigiri 80 300
onigiri 80 300
anpan 70 280
mikan 50 80
kanzume 100 500
chocolate 50 350
cookie 30 80
purin 40 400
cracker 40 160
0

Output for the Sample Input

apple
cake
sandwich
cheese
kanzume
purin
chocolate
onigiri
onigiri
anpan
mikan
cracker
cookie


import Data.List

tab = [("black",    0,  0,  0),
       ("blue",     0,  0,255),
       ("lime",     0,255,  0),
       ("aqua",     0,255,255),
       ("red",    255,  0,  0),
       ("fuchsia",255,  0,255),
       ("yellow", 255,255,  0),
       ("white",  255,255,255)]

h2d x = read ("0x"++x) :: Int

ans x =
  let r = h2d $ take 2 $ drop 1 x
      g = h2d $ take 2 $ drop 3 x
      b = h2d $ take 2 $ drop 5 x
      d = map (\ (c,r1,g1,b1) -> (c, (r1-r)^2+(g1-g)^2+(b1-b)^2 ) ) tab
      s = sortBy (\ (c0,d0) (c1,d1) -> compare d0 d1 ) d
  in
    fst $ head s

main = do
  c <- getContents
  let i = takeWhile (/= "0") $ lines c
      o = map ans i
  mapM_ putStrLn o

何色？

ウェブデザイナーを目指す太郎君はただいま修行中。事務所の先輩から「このページの背景色は#ffe085で」と、ウェブデザイン特有の色番号で指示されるのですが、それがどんな色かパッと思い浮かべることができません。

この色番号は光の三原色である赤、緑、青それぞれの強さを表わしています。具体的には2 桁の 16 進数を3 つ組み合わせたもので、色番号を“#RGB”とするとき、R は赤の強さ、G は緑の強さ、は青の強さを表します。それぞれ 00 から ff までの値になります。

色番号にまだ不慣れな太郎君のために、色番号を入力とし、色の表の中からもっとも近い色の名前
を出力するプログラムを作成してください。使用する色の表は以下の通りです。

色の名前

赤の強さ

緑の強さ

青の強さ

black

00

00

00

blue

00

00

ff

lime

00

ff

00

aqua

00

ff

ff

red

ff

00

00

fuchsia

ff

00

ff

yellow

ff

ff

00

white

ff

ff

ff

「もっとも近い色」とは、以下のように定義します。与えられた色番号での赤、緑、青の強さをそれぞれ R、G、B とし、表の k 番目の色の赤、緑、青の強さをそれぞれ Rk、Gk、Bk とするとき、次の式で計算する dk の値が最も小さい色がもっとも近い色とします。

なお、dk の値が同じになる色が複数存在する場合は表の中でより上にある色がもっとも近い色になり
ます。

Input

複数のデータセットの並びが入力として与えられます。入力の終わりはゼロひとつの行で示されます。各データセットとして、色番号を表す文字列が、#RGB 形式で１行に与えられます。

データセットの数は 1000 を超えません。

Output

データセット毎に最も近い色の名前を１行に出力します。

Sample Input

#ffe085
#787878
#decade
#ff55ff
0

Output for the Sample Input

white
black
white
fuchsia


import Control.Monad
import Data.List
import Data.Ord

g xs
 | rs == [0] = xs !! 0
 | otherwise = xs !! (head rs + 1)
 where
  ys = zipWith (-) (tail xs) xs
  z = head $ maximumBy (comparing length) $ group $ sort ys
  rs = findIndices (/=z) ys

main = do
 n <- getLine
 when (n /= "0") $ do
  l <- getLine
  print $ g $ map read $ words l
  main

家庭菜園に野菜を植えることにしました。n 粒の種があったので1日に1粒ずつ、n 日かけて n 粒の種をまきました。どの種からも芽が出て、すくすくと育っています。収穫の時期が待ち遠しいものです。

ある日、いつものように苗に水やりをしていると、おかしなことに気づきました。n 本の野菜の苗があるはずなのに、1本多いのです。雑草が生えてきてしまいました。直ちに引っこ抜きたいのですが、困ったことにどの苗もよく似ていて、野菜と雑草の見分けがつきません。

手がかりになるのは、野菜の成長速度です。この野菜は、種をまいてからずっと、1日に決まった長さだけ伸び続けるのです。しかし、この「決まった長さ」というのが何センチメートルなのかはわかりません。また、最初の種を何日前にまいたのかも忘れてしまいました。苗は一列に並んでいますが、唯一覚えているのは、種をまくとき毎日一粒ずつ右から順にまいていったことだけです。

n＋１本の苗の長さを入力し、雑草の長さを出力するプログラムを作成して下さい。

入力

入力は複数のデータセットからなる。入力の終わりはゼロ１つ行で示される。入力は以下の形式で与えられる。

n
h1 h2 h3 ... hn+1

１行目の n (4 ≤ n ≤ 100) は野菜の苗の数を表す整数である。２行目は１つの空白で区切られた n+1 個の整数を含み、 hi (1 ≤ hi ≤ 109)は左からi番目の苗の長さを示す。

h1 h2 ... hn+1 が等差数列になっているような入力は与えられない。

データセットの数は 500 を超えない。

出力

各データセットごとに雑草の長さを出力する 。

入力例

5
1 2 3 6 4 5
6
1 3 6 9 12 15 18
4
5 7 9 11 12
0

出力例

6
1
12


main :: IO ()
main = do
  n <- getLine
  if n == "0000"
    then return ()
    else do
      putStrLn $ solve n
      main

solve :: String -> String
solve s
  | all ((==) (head s)) s = "NA"
  | otherwise = count s 0
  where
    count :: String -> Int -> String
    count s counter
      | s == "6174" = show counter
      | otherwise = count (show' ((read sorted) - (read (reverse sorted)))) (counter + 1)
      where
        sorted = sort s
        sort :: String -> String
        sort [] = []
        sort (x:xs) = (sort higher) ++ [x] ++ (sort lower)
          where
            higher = filter (\y -> y >= x) xs
            lower = filter (\y -> y < x) xs

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

すべての数は６１７４に通ず

0 から 9 の数字からなる四桁の数 N に対して以下の操作を行う。

N の桁それぞれの数値を大きい順に並べた結果得た数を L とする

N の桁それぞれの数値を小さい順に並べた結果得た数を S とする

差 L-S を新しい N とする(1回分の操作終了)

新しい N に対して 1. から繰り返す

このとき、全桁が同じ数字(0000, 1111など)である場合を除き、あらゆる四桁の数はいつかは 6174になることが知られている。例えば N = 2012の場合

       1回目 (N = 2012): L = 2210, S = 0122, L-S = 2088

       2回目 (N = 2088): L = 8820, S = 0288, L-S = 8532

       3回目 (N = 8532): L = 8532, S = 2358, L-S = 6174

となり、3 回の操作で 6174 に到達する。

0 から 9 の数字からなる四桁の数が与えられたとき、何回の操作で 6174 に到達するか計算するプログラムを作成して下さい。

入力

入力は複数のデータセットからなる。入力の終わりは 0000 が１つの行で示される。各データセットは以下の形式で与えられる。

N

データセットは１行であり、N (1 ≤ N ≤ 9999) は四桁の数を示す。N < 1000 の場合は上の桁は 0 で埋められている。

データセットの数は 10000 を超えない。

出力

各データセットごとに何回の操作で 6174 に到達したかを１行に出力する。ただし全桁が同じ数字である数が入力として与えられた場合は NA と出力する。

入力例

6174
2012
3333
0000

出力例

0
3
NA


import Control.Applicative ((<$>))
import Control.Monad (unless)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.List (unfoldr)
import Data.Char (isSpace)

main :: IO ()
main = do
  n <- readLn
  unless (n == 0) $ do
    solve n <$> readil B.readInt <$> B.getLine >>= print
    main

solve :: Int -> [Int] -> Int
solve n xs = cnt 0 (n, xs)
  where f (c, as) = foldr g (1, [c]) as
          where g e (d, bs) | e == 1 = (d, bs)
                            | otherwise = (d+1, (e-1):bs)
        cnt i (c, as) | i > 10000 = (-1)
                      | isTriangle as = i
                      | otherwise = cnt (i+1) (f (c, as))

isTriangle :: [Int] -> Bool
isTriangle xs = head xs == 1 && all f (zip xs (tail xs))
  where f (a, b) = a + 1 == b

readil :: Integral a =>  (ByteString -> Maybe (a, ByteString)) -> ByteString -> [a]
readil f = unfoldr g
  where
    g s = do
      (n, s') <- f s
      return (n, B.dropWhile isSpace s')

ブロックの三角形

図a のように積まれたブロックに対し、以下の並べ替え操作を繰り返す。

一番下のブロック全て（図a 中の白のブロック）を右端に新しく積み上げる（残りのブロックは自動的に１段下に落ち、図b のようになる）。

ブロックの間に隙間ができたら、左に詰めて隙間をなくす（図 b から図c のようになる）。

1 以上の整数 k に対して、k×(k＋1)/2 で表される数 (例:1, 3, 6, 10, ...)を三角数という。ブロックの総数が三角数の場合、上記の並べ替えを繰り返すと、左端の高さが1 で右に向かって１つずつ高くなっていくような三角形になると予想されている（図d は総数が15 個の場合）。

ブロックの最初の並びが与えられたとき、あらかじめ決められた回数以下の操作で、上で説明したようなブロックの三角形ができるとき、三角形が得られるまでの最小の操作回数を出力するプログラムを作成してください。

入力

入力は複数のデータセットからなる。入力の終わりはゼロ１つの行で示される。各データセットは以下の形式で与えられる。

N
b1 b2 ... bN

各データセットは２行であり、ブロックの最初の並びを表す。N (1 ≤ N ≤ 100)は、一番下の段にあるブロックの数を示す。bi(1 ≤ bi ≤ 10000) は左から i 番目の位置に積まれているブロックの数を示す。bi と bi+1 は１つの空白で区切られている。ブロックの総数は 3 以上である。

データセットの数は 20 を超えない。

出力

データセットごとに、三角形ができるまでに行った並べ替え操作の回数を１行に出力する。ただし、三角形が作れない場合や、操作回数が 10000 回を超える場合は -1 を出力する。

入力例

6
1 4 1 3 2 4
5
1 2 3 4 5
10
1 1 1 1 1 1 1 1 1 1
9
1 1 1 1 1 1 1 1 1
12
1 4 1 3 2 4 3 3 2 1 2 2
1
5050
3
10000 10000 100
0

出力例

24
0
10
-1
48
5049
-1

最初のデータセットが、図に示した場合に対応する。

４つ目のデータセットが、ブロックの総数が三角数でないため、三角形が作れない場合に対応する。

最後のデータセットが、ブロックの総数は三角数だが、操作回数が 10000 回を超える場合に対応する。


import Data.Char

transpose ([]:_) = []
transpose matrix =
  let row  = map (head) matrix
      rows = transpose $ map (drop 1) matrix
  in
    row:rows

patch' (b:bs) y =
  if y /= 1
  then b:(patch' bs (y-1))
  else (1-b):bs

patch :: [[Int]] -> [Int] -> [[Int]]
patch (b:bs) [x, y] =
  if x /= 1
  then b:(patch bs [x-1,y])
  else (patch' b y):bs

chk' b =
  let n = (length b) `div` 2
      x = take n b
      y = take n $ reverse b
  in
    x == y

chk b = (chk' b) && (chk' b')
  where b' = transpose b

ans' b [] = []
ans' b ([d]:ds) =
  let df = take d ds
      r  = drop d ds
      b' = foldl patch b df
      c  = chk b'
  in
    c:(ans' b' r)

ans i =
  let l = lines i
      [c,n] = map read $ words $ head l :: [Int]
      b = map (map digitToInt) $ take n $ drop 1 l :: [[Int]]
      d = map (map read) $ map words $ drop (n+1) l :: [[Int]]
  in
    (chk b):(ans' b d)

main = do
  i <- getContents
  let o = ans i
  print $ length $ filter (\e -> e) o

MathJax.Hub.Config({ tex2jax: { inlineMath: [["$","$"], ["\\(","\\)"]], processEscapes: true }});

品質管理

会津タカダ市が生産販売する布製コースターは、対称なデザインでとても美しいことで知られている。会津タカダ市では品質管理の一環として、製造ラインにカメラを設置し、各コースターを撮影して得られた画像が対称になっているかを自動で検証している。各コースターは N × N ピクセルの正方形の白黒画像として表される。各ピクセルは白または黒の画像に対応して、0 または 1 の値をとる。

この度、生産ラインの機器更新にともなって、画像解析システムのソフトウェアを更新することになった。新システムでは、通信データ量を削減する工夫がなされ、以下の方法でカメラから解析システムにデータが送られてくる。

ラインに流れてくる最初のコースターの情報は、N × N ピクセルの画像としてシステムに送られてくる。

２枚目以降のコースターの情報は、１つ前に送られた画像との差分だけが送られてくる。差分は、「0 から 1 」または「1 から 0 」へと変化したピクセルの位置の集合として与えられる。

C 枚のコースターについて、１枚目の画像のピクセル情報と続く C - 1 枚分の差分情報を入力し、上下対称かつ左右対称となっているコースターの枚数を報告するプログラムを作成せよ。

Input

入力は以下の形式で与えられる。

C N
p11p12...p1N
p21p22...p2N
:
pN1pN2...pNN
diff1
diff2
:
diffC−1

１行目にコースターの枚数 C (1 ≤ C ≤ 10000) と画像の縦と横のピクセル数 N (2 ≤ N ≤ 1000 かつ N は偶数) が与えられる。２行目から N + 1 行目に最初のコースターの画像のピクセルを表す N行 × N 列の数字 pij (pij は 0 または 1)が与えられる。

N + 2 行目以降に、２枚目以降のコースターの情報を表す差分 diffi が次の形式で与えられる。

D
r1 c1
r2 c2
:
rD cD

１行目に変化したピクセルの数 D (0 ≤ D ≤ 100) が与えられる。続くD 行に変化したピクセルの行と列の番号をそれぞれ表す ri とci (1 ≤ ri, ci ≤ N) が与えられる。diffi の中に、同じ位置は２回以上与えられない。

Output

上下対称かつ左右対称となっているコースターの枚数を１行に出力する。

Sample Input 1

7 8
00100000
00011000
10111101
01100110
01000110
10111101
00011000
00100100
2
5 3
1 6
1
6 8
3
6 8
3 3
3 6
2
6 3
6 6
0
2
3 8
6 8

Sample Output 1

3

入力例１のコースターの画像を以下に示す。この場合、２枚目、５枚目、６枚目のコースターが上下対称かつ左右対称となるため、3と報告する。

Sample Input 2

1 6
000000
000000
010010
010010
000000
000000

Sample Output 2

1

Sample Input 3

2 2
00
00
4
1 1
1 2
2 1
2 2

Sample Output 3

2


import Control.Applicative
import Control.Monad
import Control.Monad.ST
-- import qualified Data.ByteString as BS
import Data.Functor
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.List
import qualified Data.Foldable as Foldable
import qualified Data.Set as Set
--import qualified Data.Sequence as Sequence
import Data.List.Split
import Data.Bits
import Data.Char
import Data.Ix
import Data.Ratio
import Data.Ord
import Data.Tuple
import Data.Array
--import Data.Array.Unboxed
--import Data.Array.IArray
import Data.Array.MArray
import Data.Array.IO
import Data.Array.ST
import Data.IORef
import Data.STRef
import GHC.ST
-- import System.IO.Unsafe

-- templete
readInt = read :: String -> Int
readInteger = read :: String -> Integer
readDouble = read :: String -> Double
getInt = readLn :: IO Int
getInts = map readInt . words <$> getLine
getInteger = readLn :: IO Integer
getIntegers = map readInteger . words <$> getLine
getDouble = readLn :: IO Double
getDoubles = map readDouble . words <$> getLine
sjoin :: (Show a) => [a] -> String
sjoin = unwords . map show
tjoin :: (Show a, Show b) => (a, b) -> String
tjoin (x, y) = show x ++ (' ' : show y)
cond :: a -> a -> Bool -> a
cond t f c = if c then t else f
apply2 :: (a -> a -> b) -> [a] -> b
apply2 f [x,y] = f x y
apply3 :: (a -> a -> a -> b) -> [a] -> b
apply3 f [x,y,z] = f x y z
apply4 :: (a -> a -> a -> a -> b) -> [a] -> b
apply4 f [x,y,z,w] = f x y z w
fnTuple :: (a -> b, a -> c) -> a -> (b, c)
fnTuple (f,g) a = (f a, g a)
replace :: (Eq a) => a -> a -> [a] -> [a]
replace x y = map (\z -> if z==x then y else z)
binMap :: (a -> a -> b) -> [a] -> [b]
binMap f (x:xs@(y:_)) = f x y : binMap f xs
binMap _ _ = []
splitRec :: Int -> [a] -> [[a]]
splitRec _ [] = []
splitRec n xs = let (y,ys) = splitAt n xs in y : splitRec n ys
infixl 7 `divCeil`
divCeil :: Integral a => a -> a -> a
x `divCeil` y = (x+y-1) `div` y
coverC :: Ord a => (a, a) -> a -> Bool
coverC (l,r) x = l<=x && x<=r
coverH :: Ord a => (a, a) -> a -> Bool
coverH (l,r) x = l<=x && x<r
ibsearch :: (Int -> Bool) -> (Int,Int) -> Int
ibsearch f (ok,ng) = if abs (ok-ng) <= 1 then ok else let mid = (ok + ng) `div` 2 in ibsearch f (if f mid then (mid,ng) else (ok,mid))
-- templete

main = getInt >>= \n -> replicateM n getInts >>= print . (n-) . length . group . sort . map (apply3 (,,) . sort)

MathJax.Hub.Config({ tex2jax: { inlineMath: [["$","$"], ["\\(","\\)"]], processEscapes: true }});

形状データ処理

コンピュータグラフィクスでは、三次元の形状を表現する方法として、ポリゴンモデルが使われます。ポリゴンモデルとは、頂点座標と、それらの頂点のつなぎ方を与えて面を作るモデルです。

一般のポリゴンモデルでは、任意の多角形を扱えますが、今回は三角形からなるポリゴンモデルを考えることにします。任意のポリゴンモデルは三角形を表す面情報の集まりとして表すことができます。

一つの面情報は、３つの頂点を並べて表します。ただし、並び方が異なるだけで同じ３点からなる場合は、同じ面情報を表すことにします。例えば、下図の四面体で、頂点１,２,３を繋いでできる面は、頂点２,３,１や、頂点３,２,１などのように表すこともできます。このように、同じ面情報が複数あると無駄になるので、１つにまとめてしまった方が良いでしょう。

面情報が与えられたとき、重複した面を無くすために消さなければならない面情報の個数を求めるプログラムを作成せよ。

Input

入力は以下の形式で与えられる。

N
p11 p12 p13
p21 p22 p23
:
pN1 pN2 pN3

１行目に、ポリゴンモデルの面情報の数 N (1 ≤ N ≤ 1000) が与えられる。続く N 行に、i 番目の面を作るために使う頂点の番号 pij (1 ≤ pij ≤ 1000) が与えられる。ただし、一つの面について、同じ頂点を２度以上使うことはない（pi1 ≠ pi2 かつ pi2 ≠ pi3 かつ pi1 ≠ pi3 である）。

Output

重複した面を無くすために消さなければならない面情報の個数を１行に出力する。

Sample Input 1

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

Sample Output 1

0

Sample Input 2

6
1 3 2
1 2 4
1 4 3
2 3 4
3 2 1
2 3 1

Sample Output 2

2

入出力例２では、１つ目と５つ目と６つ目の面は頂点1, 3, 2を使って三角形を作っていて、点の順番が異なるだけなので重複している。つまり、重複した面のうち２つの面を消せば重複した面は無くなる。


import Data.Ratio ((%),numerator,denominator)
import Data.Char (intToDigit)

type N = Integer
type K = Integer
type M = Int
type R = Int

main = do
    [n,k,m,r] <- getLine >>= return . map read . words :: IO [Int]

    if all (==0) [n,k,m,r] then return () else do
        let
            n' = fromIntegral n
            k' = fromIntegral k
        putStrLn $ solve ((fromIntegral n),(fromIntegral k),m,r)
        main

solve :: (N,K,M,R) -> String
solve (n,k,m,r) = toString r $ p m n

p :: M -> N -> Rational
p 0 n = 1 % n
p 1 n = p 0 n + (harmonicTo (n-1)) / (fromIntegral n)

harmonicTo :: Integer -> Rational
harmonicTo n = harmonicTo' 0 1 1
    where
    harmonicTo' a b n'
        | n' > n = a % b
        | otherwise = harmonicTo' (a*n'+b) (b*n') (n'+1)

toString :: R -> Rational -> String
toString r p = insertDot $ toString' (numerator p) (denominator p) 0
    where
    insertDot (c:cs) = c:'.':cs
    toString' a b r'
        | r' <= r   = d : toString' a' b (r'+1)
        | otherwise = []
        where
        d = intToDigit $ fromIntegral (a `div` b)
        a' = 10 * (a `mod` b)

次のようなゲームを考える． 1 から n までの数が 1 つずつ書かれた n 枚のカードが k 組ある．これら kn 枚のカードをよくシャッフル（よく切ること）して， k 枚ずつの山を作り横一列に並べる．このようにしてできる n 個の山の左から i 番目の（k 枚のカードの）山を「山 i 」と呼ぶことにする．

ゲームは山 1 から始める．山の一番上のカード 1 枚を引き（引いたカードは元の山に戻さない），そのカードに書かれていた数が i だった場合には山 i の一番上のカード 1 枚を引く．このようにして，引いたカードに書かれていた数を番号とする山の一番上のカード 1 枚を引くことを繰り返し，すべての山にカードが無くなれば成功である．まだカードが残っている山があるのに，次にカードを引くべき山が無くなっていた場合は失敗である．

　途中で失敗した場合には，そのまま失敗で終了するか，または残ったカードの山をそのまま（山の番号もそのまま）にしてゲームを再開する．ゲームを再開する場合は，最初に引くカードはカードが残っている山のうちの一番左の山からとする（その山の一番上のカードが最初に引かれるカードとなる）．再開後も再開前と同様の方法でゲームを進め，すべての山にカードが無くなれば成功であり，まだカードが残っている山があるのに，次にカードを引くべき山が無くなった場合は失敗である．

このようなゲームの再開を最大 m 回まで行うものとする．ただし，m は 0 か 1 である．つまり， 1 回も再開しないか， 1 回だけ再開するかのいずれかである．ゲーム開始前のシャッフルの仕方によりカードの初期配置は異なる．当然，カードの初期配置により，再開せずに成功することもあれば，再開して成功することも，再開して失敗することもある．十分シャッフルしているので，どの初期配置も全て同じ確率で現れるものと考えることにして，再開が m 回以内で成功する確率 p を求めたい．この確率 p を小数で表し，小数第 r 位まで求めて出力するプログラムを作りなさい．ただし，次の条件を満たすように出力すること.

十分大きい正整数 K を取ると p×10K が 整数となる場合， 小数部は途中から 0 が続くが，その 0 も出力すること． 例えば， p = 3/8 = 0.375 の場合， r = 5 なら 0.37500 と出力し， r = 2 なら 0.37 と出力する． p = 1.0 の場合も同様に， 例えば r = 3 なら 1.000 と出力すること．

例えば 0.150000… は循環小数 0.1499999… として表すこともできるが， このような場合， 前者の表し方を用いる．

入力ファイルの 1 行目には整数 n，k，m，r がこの順に空白を区切り文字として書いてある． 1 ≦ n ≦ 10000， 1 ≦ k ≦ 100， m = 0 または m = 1， 1 ≦ r ≦ 10000 である．

入力例１

入力例２

入力例３

2 1 0 5

3 1 1 3

2 2 1 3

出力例１

出力例２

出力例３

0.50000

0.833

1.000

入力

入力は複数のデータセットからなる．n, k, m, r がすべて 0 のとき入力が終了する．データセットの数は 5 を超えない．

出力

データセットごとに、指定通りに p を１行に出力する．

入力例

2 1 0 5
3 1 1 3
2 2 1 3
0 0 0 0

出力例

0.50000
0.833
1.000

各データセットについて，指定通りに出力した p の後に改行を入れること．

上記問題文と自動審判に使われるデータは、情報オリンピック日本委員会が作成し公開している問題文と採点用テストデータです。


import Control.Monad
import Control.Applicative

main :: IO ()
main = do
  [a, b] <- getInts
  if (a == 0 && b == 0) then return ()
  else do
    n <- getInt
    ss <- getIntsLines n
    print $ solve [1,1] (ss ++ [[a+1, x] | x <- [1..b]] ++ [[x,b+1]|x<-[1..a]]) a b
    main

solve p ss a b
  | p == [a,b] = 1
  | notElem (add1 p) ss && notElem (add2 p) ss = solve (add1 p) ss a b + solve (add2 p) ss a b
  | elem (add1 p) ss && notElem (add2 p) ss = solve (add2 p) ss a b
  | notElem (add1 p) ss && elem (add2 p) ss = solve (add1 p) ss a b
  | otherwise = 0

---

getInt :: IO Integer
getInt = read <$> getLine

getInts :: IO [Integer]
getInts = map read . words <$> getLine

getIntLines :: Integral a => a -> IO [Integer]
getIntLines n = replicateM (fromIntegral n :: Int) getInt

getIntsLines :: Integral a => a -> IO [[Integer]]
getIntsLines n = replicateM (fromIntegral n :: Int) getInts

add1 [n,m] = [n + 1, m]
add2 [n,m] = [n, m + 1]

通学経路

問題

太郎君の住んでいるJOI市は，南北方向にまっすぐに伸びる a 本の道路と，東西方向にまっすぐに伸びる b 本の道路により，碁盤の目の形に区分けされている．

南北方向の a 本の道路には，西から順に 1, 2, ... , a の番号が付けられている．また，東西方向の b 本の道路には，南から順に 1, 2, ... , b の番号が付けられている．西から i 番目の南北方向の道路と，南から j 番目の東西方向の道路が交わる交差点を (i, j) で表す．

太郎君は，交差点 (1, 1) の近くに住んでおり，交差点 (a, b) の近くのJOI高校に自転車で通っている．自転車は道路に沿ってのみ移動することができる．太郎君は，通学時間を短くするため，東または北にのみ向かって移動して通学している．

現在， JOI市では， n 個の交差点 (x1, y1), (x2, y2), ... , (xn, yn) で工事を行っている．太郎君は工事中の交差点を通ることができない．

太郎君が交差点 (1, 1) から交差点 (a, b) まで，工事中の交差点を避けながら，東または北にのみ向かって移動して通学する方法は何通りあるだろうか．太郎君の通学経路の個数 m を求めるプログラムを作成せよ．

入力

入力は複数のデータセットからなる．各データセットは以下の形式で与えられる．入力はゼロを２つ含む行で終了する．

1行目には，空白を区切りとして2個の整数 a, b が書かれている．これは，南北方向の道路の本数と，東西方向の道路の本数を表す． a, b は 1 ≤ a, b ≤ 16 をみたす．

2行目には, 工事中の交差点の個数を表す整数 n が書かれている． n は 1 ≤ n ≤ 40 をみたす．

続く n 行 (3行目から n+2 行目) には，工事中の交差点の位置が書かれている． i+2 行目には空白で区切られた整数 xi, yi が書かれており，交差点 (xi, yi) が工事中であることを表す． xi, yi は 1 ≤ xi, yi ≤ 16 をみたす．

データセットの数は 5 を超えない．

出力

データセットごとに, 太郎君の通学経路の個数 m を1行に出力する．

入出力例

入力例

5 4
3
2 2
2 3
4 2
5 4
3
2 2
2 3
4 2
0 0

出力例

5
5

下図は a=5, b=4, n=3 で，工事中の交差点が (2,2), (2,3), (4,2) の場合を表している．

この場合，通学経路は m=5 通りある． 5通りの通学経路を全て図示すると，以下の通り．

上記問題文と自動審判に使われるデータは、情報オリンピック日本委員会が作成し公開している問題文と採点用テストデータです。


import Control.Applicative
import Control.Monad
import Data.List
import Data.Set (Set)
import qualified Data.Set as S

main :: IO ()
main = do
  n <- readLn
  unless (n == 0) $ do
    solve <$> replicateM n f >>= print
    main
  where
    f = (\[x, y] -> (x, y)) <$> map read <$> words <$> getLine

solve :: [(Int, Int)] -> Int
solve ps = f 0 ps
  where
    st = S.fromList ps
    f mxa [_] = mxa
    f mxa ((a, b):ps) = let mxa' = foldl' (\ta (c, d) ->
                                          if S.member (b-d+a, c-a+b) st &&
                                             S.member (b-d+c, c-a+d) st
                                          then max ta ((c - a) ^ 2 + (d - b) ^ 2)
                                          else ta
                                        ) mxa ps
                        in f mxa' ps

最古の遺跡

問題

昔, そこには集落があり, 多くの人が暮らしていた. 人々は形も大きさも様々な建物を建てた. だが, それらの建造物は既に失われ, 文献と, 遺跡から見つかった柱だけが建造物の位置を知る手がかりだった.

文献には神殿の記述がある. 神殿は上から見ると正確に正方形になっており, その四隅には柱があった. 神殿がどの向きを向いていたかはわからない. また, 辺上や内部に柱があったかどうかもわからない. 考古学者たちは, 遺跡から見つかった柱の中で, 正方形になっているもののうち, 面積が最大のものが神殿に違いないと考えた.

柱の位置の座標が与えられるので, 4 本の柱でできる正方形のうち面積が最大のものを探し, その面積を出力するプログラムを書け. なお, 正方形の辺は座標軸に平行とは限らないことに注意せよ.

例

下の図の例では, 10 本の柱があり, 座標 (4, 2), (5, 2), (5, 3), (4, 3) にある 4 本と座標 (1, 1), (4, 0), (5, 3), (2, 4) にある 4 本が正方形をなしている. 面積が最大の正方形は後者で, その面積は 10 である.

入力

入力は複数のデータセットからなる．各データセットは以下の形式で与えられる．入力はゼロ１つを含む行で終了する．

1 行目には, 遺跡から見つかった柱の本数 n が書かれている.

2 行目から n + 1 行目までの n 行の各々には, 柱の x 座標と y 座標が空白区切りで書かれている.

1 本の柱が 2 度以上現れることはない.

n は 1 ≤ n ≤ 3000 を満たす整数であり, 柱の x 座標と y 座標は 0 以上 5000 以下の整数である.

採点用データのうち, 配点の 30% 分は 1 ≤ n ≤ 100 を満たし, 配点の 60% 分は1 ≤ n ≤ 500 を満たす.

データセットの数は 10 を超えない．

出力

データセットごとに 1 個の整数を出力する. 4 本の柱からなる正方形が存在する場合は, そのような正方形のうち面積が最大のものの面積を出力し, そのような正方形が存在しない場合は 0 を出力せよ.

入出力例

入力例

10
9 4
4 3
1 1
4 2
2 4
5 8
4 0
5 3
0 5
5 2
10
9 4
4 3
1 1
4 2
2 4
5 8
4 0
5 3
0 5
5 2
0

出力例

10
10

上記問題文と自動審判に使われるデータは、情報オリンピック日本委員会が作成し公開している問題文と採点用テストデータです。


import Data.List
import Text.Printf

f (a,b) (c,d) = if a /= b
                then compare a c
                else compare b d
cnv x = sortBy f $ map (\[a,b] -> (a,b) ) x

srch _ [] = (0,0)
srch t@((tx,ty):tgt) ((sx,sy):str) =
  let dx = sx-tx
      dy = sy-ty
      rr = map (\e -> elem e str) $ map (\(x,y)->(x+dx,y+dy)) tgt
  in
    if foldr (&&) True rr
    then (dx,dy)
    else srch t str

ans ([0]:_) = []
ans ([n]:xs) =
  let tgt = cnv $ take n xs
      m   = head $ head $ drop n xs
      str = cnv $ take m $ drop (n+1) xs
      a   = srch tgt str
      res = drop (n+1+m) xs
  in
    a:ans res

main = do
  c <- getContents
  let i = map (map read) $ map words $ lines c :: [[Int]]
      o = ans i
  mapM_ (\(a,b) -> printf "%d %d\n" a b) o

星座探し

問題

あなたは星空の写真の中から星座を探している．写真には必ず，探したい星座と同じ形・向き・大きさの図形がちょうど一つ含まれている．ただし，写真の中には星座を構成する星以外に余分な星が写っている可能性がある．

例えば，図 1 の星座は図 2 の写真に含まれている（丸で囲んで示した）．与えられた星座の星の座標を x 方向に 2， y 方向に −3 だけ平行移動すると写真の中の位置になる．

探したい星座の形と写真に写っている星の位置が与えられたとき，星座の座標を写真の中の座標に変換するために平行移動するべき量を答えるプログラムを書け．

図 1: 探したい星座

図 2: 星空の写真

入力

入力は複数のデータセットからなる．各データセットは以下の形式で与えられる．

入力の 1 行目には探したい星座を構成する星の個数 m が書かれている．続く m 行には探したい星座を構成する m 個の星の x 座標と y 座標を示す整数が空白区切りで書かれている． m+2 行目には写真に写っている星の個数 n が書かれている．続く n 行には写真に写っている n 個の星の x 座標と y 座標を示す整数が空白区切りで書かれている．

星座を構成する m 個の星の位置はすべて異なる．また，写真に写っている n 個の星の位置はすべて異なる． 1 ≤ m ≤ 200， 1 ≤ n ≤ 1000 である．星の x 座標と y 座標はすべて 0 以上 1000000 以下である．

m が 0　のとき入力の終わりを示す. データセットの数は 5 を超えない．

出力

各データセットの出力は 1 行からなり， 2 個の整数を空白区切りで書く．これらは探したい星座の座標をどれだけ平行移動すれば写真の中の座標になるかを表す．最初の整数が x 方向に平行移動する量，次の整数が y 方向に平行移動する量である．

入出力例

入力例

5
8 5
6 4
4 3
7 10
0 10
10
10 5
2 7
9 7
8 10
10 2
1 2
8 1
6 7
6 0
0 9
5
904207 809784
845370 244806
499091 59863
638406 182509
435076 362268
10
757559 866424
114810 239537
519926 989458
461089 424480
674361 448440
81851 150384
459107 795405
299682 6700
254125 362183
50795 541942
0

出力例

2 -3
-384281 179674

入出力例の１つ目は上の図に対応している．

上記問題文と自動審判に使われるデータは、情報オリンピック日本委員会が作成し公開している問題文と採点用テストデータです。


import Control.Monad (replicateM)
import Data.List (sort)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

type Rect = (Int,Int,Int,Int)
type Span = (Int,Int)
type Color = Int
type ColorRelation = Map.Map Int Int
type ColorCorrection = Map.Map Int Int

main = do
    [w,h] <- getLine >>= return . map read . words
    if all (==0) [w,h] then return () else do
        n <- readLn
        rs <- replicateM n (getLine >>= return . rect . map read . words)
        print $ solve w h rs
        main
    where
    rect [x1,y1,x2,y2] = (x1,y1,x2,y2)

solve :: Int -> Int -> [Rect] -> Int
solve w h rs = step [] (blankSpansSeq ++ [[]]) 0
    where
    rs' = sort rs

    blankSpansSeq :: [[Span]]
    blankSpansSeq = rs' `seq` map (listBlankSpans w rs') (listScanYs h rs)

    step :: [(Span,Color)] -> [[Span]] -> Int -> Int
    step [] [] num = num

    step prev (curr:spans) num = step curr'' spans num'
        where
        curr' = zip curr [1..]
        (rel,cor) = matchColors $ listJointColors prev curr'
        curr'' = correctColors cor curr'
        num' = num + countFixedColors rel prev

listScanYs :: Int -> [Rect] -> [Int]
listScanYs h rs = filter' $ 0 : (sort $ concatMap (\(_,y1,_,y2) -> [y1,y2]) rs)
    where
    filter' (y:[])
        | y < h = [y]
        | otherwise = []
    filter' (y1:y2:ys)
        | y1 < y2 = y1 : filter' (y2:ys)
        | otherwise = filter' (y2:ys)

listRectSpans :: [Rect] -> Int -> [Span]
-- assumes rects are sorted by x1
listRectSpans rs y = merge $ map (\(x1,_,x2,_) -> (x1,x2)) $ filter cross rs
    where
    cross (_,y1,_,y2) = y1 <= y && y < y2
    merge [] = []
    merge ((x1,x2):[]) = [(x1,x2)]
    merge ((x1,x2):(x3,x4):ps)
        | x2 < x3 = (x1,x2) : merge ((x3,x4):ps)
        | otherwise = merge ((x1,max x2 x4):ps)

listBlankSpans :: Int -> [Rect] -> Int -> [Span]
listBlankSpans w rs y = blank' ((0,0) : listRectSpans rs y)
    where
    blank' ((0,0):(0,x):ps) = blank' ((0,x):ps)
    blank' ((x1,x2):(x3,x4):ps) = (x2,x3) : blank' ((x3,x4):ps)
    blank' ((x1,x2):[])
        | x2 == w = []
        | otherwise = [(x2,w)]

listJointColors :: [(Span,Color)] -> [(Span,Color)] -> [(Color,Color)]
listJointColors [] _ = []
listJointColors _ [] = []
listJointColors ps1@(((b1,e1),c1):ps1') ps2@(((b2,e2),c2):ps2')
    | e1 <= b2 = listJointColors ps1' ps2
    | e2 <= b1 = listJointColors ps1 ps2'
    | e1 <= e2 = (c1,c2) : listJointColors ps1' ps2
    | e1 >  e2 = (c1,c2) : listJointColors ps1 ps2'

matchColors :: [(Color,Color)] -> (ColorRelation,ColorCorrection)
matchColors cps = matchColors' cps Map.empty Map.empty
    where
    matchColors' [] rel cor = (rel,cor)
    matchColors' ((c1,c2):cps) rel cor = case Map.lookup c1 rel of
            Nothing -> matchColors' cps (Map.insert c1 c2 rel) cor
            Just c0 -> matchColors' cps rel
                        (if c0 /= c2 then Map.insert c2 c0 cor else cor)

correctColors :: ColorCorrection -> [(Span,Color)] -> [(Span,Color)]
correctColors cor [] = []
correctColors cor ((s,c):ps) = case Map.lookup c cor of
        Nothing -> (s,c)  : correctColors cor ps
        Just c' -> (s,c') : correctColors cor ps

countFixedColors :: ColorRelation -> [(Span,Color)] -> Int
countFixedColors rel ps = Set.size (colors Set.\\ mapped)
    where
    colors = foldr Set.insert Set.empty (map snd ps)
    mapped = foldr Set.insert Set.empty (Map.keys rel)

ペンキの色

問題

情報オリンピックの宣伝のために,長方形のベニヤ板にペンキを塗り看板を制作したい.ベニヤ板には色を塗りたくないところにあらかじめ何枚かの長方形のマスキングテープが貼られている.そこでマスキングテープで区切られた領域ごとに別々の色を使いペンキを塗ることにした.例えば,図 5-1 の場合は 5 色のペンキを使う.

入力としてマスキングテープを貼る位置が与えられた時,使うペンキの色の数を求めるプログラムを作成せよ.ただし,ベニヤ板全体がマスキングテープで覆われることはなく,全てのマスキングテープの辺はベニヤ板のいずれかの辺に平行である.

入力

入力は複数のデータセットからなる．各データセットは以下の形式で与えられる．

1 行目にはベニヤ板の幅 w (1 ≤ w ≤ 1000000 となる整数) と高さ h (1 ≤ h ≤ 1000000 となる整数) がこの順に空白区切りで書かれている.

2 行目にはマスキングテープの数 n (1 ≤ n ≤ 1000 となる整数) が書かれている.
続く 3 行目以降の 2 + i 行目 (1 ≤ i ≤ n) には,i 番目に貼るマスキングテープの左下の座標 (x1 , y1 ) と,右上の座標 (x2 , y2 ) が x1 , y1 , x2 , y2 (0 ≤ x1 < x2 ≤ w, 0 ≤ y1 < y2 ≤ h となる整数) の順に空白区切りで書かれている.

ただし,ベニヤ板の左下の角の座標は (0, 0) で右上の角の座標は (w, h) である. 採点用データのうち, 配点の 30% 分は w ≤ 100, h ≤ 100, n ≤ 100 を満たす.

h, w がともに 0 のとき入力の終了を示す. データセットの数は 20 を超えない．

出力

データセットごとに使うペンキの色数を１行に出力する.

入出力例

次の例は図 5-1 の場合である.

入力例

15 6
10
1 4 5 6
2 1 4 5
1 0 5 1
6 1 7 5
7 5 9 6
7 0 9 2
9 1 10 5
11 0 14 1
12 1 13 5
11 5 14 6
0 0

出力例

5

上記問題文と自動審判に使われるデータは、情報オリンピック日本委員会が作成し公開している問題文と採点用テストデータです。


import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Functor
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.List
import qualified Data.Foldable as Foldable
import qualified Data.Set as Set
import Data.List.Split
import Data.Bits
import Data.Char
import Data.Ix
import Data.Ratio
import Data.Ord
import Data.Tuple
import Data.Array
--import Data.Array.Unboxed
import Data.Array.IO
import Data.Array.ST
import Data.IORef
import Data.STRef
-- import System.IO.Unsafe

readInt = read :: String -> Int
readDouble = read :: String -> Double
getInt = readLn :: IO Int
getInts = map readInt . words <$> getLine
getDouble = readLn :: IO Double
sjoin :: (Show a) => [a] -> String
sjoin = unwords . map show
cond :: a -> a -> Bool -> a
cond t f c = if c then t else f
apply2 :: (a -> a -> b) -> [a] -> b
apply2 f [x,y] = f x y
apply3 :: (a -> a -> a -> b) -> [a] -> b
apply3 f [x,y,z] = f x y z
apply4 :: (a -> a -> a -> a -> b) -> [a] -> b
apply4 f [x,y,z,w] = f x y z w
fnBin :: (b -> c -> d) -> (a -> b) -> (a -> c) -> a -> d
fnBin op f g x = op (f x) $ g x
fnTuple :: (a -> b, a -> c) -> a -> (b, c)
fnTuple (f,g) a = (f a, g a)
replace :: (Eq a) => a -> a -> [a] -> [a]
replace x y = map (\z -> if z==x then y else z)
modifyArray :: (Ix i, MArray a e m) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = readArray arr ix >>= writeArray arr ix . f
-- end of templete

f n t = min t (n-1-t)

main = do
    n <- getInt
    k <- getInt
    replicateM k getInts >>= mapM_ (print . (+1) . (`mod` 3) . minimum . map (f n . (subtract 1)))

タイル (Tile)

問題

JOI 高校では， 1 × 1 の正方形のタイルを使って N × N の正方形の壁画を作り，文化祭で展示することになった．タイルの色は，赤，青，黄の 3 種類である．壁画のデザインは次の通りである．まず，最も外側の周に赤のタイルを貼り，その内側の周に青のタイルを貼る．さらにその内側の周に黄色のタイルを貼る．これを N × N の正方形が埋め尽くされるまで繰り返す．用いるタイルの色は，一番外側の周から順番に赤，青，黄，赤，青，黄，…である．

文化祭が近づいてきたある日，壁画のうち K 枚のタイルがはがれていることが判明した．そこで，新しいタイルを購入して，はがれた箇所に新しいタイルを貼ることにした．

入力として壁画の一辺の長さ N と，はがれたタイルの枚数 K， K 枚のはがれたタイルの位置が与えられたとき，はがれたタイルの色を求めるプログラムを作成せよ．

例えば，N = 11 の場合，11 × 11 の壁画のデザインは下図の通りである．

また，N = 16 の場合，16 × 16 の壁画のデザインは下図の通りである．

入力

入力は全部で 2+K 行からなる． 1 行目には，壁画の一辺の長さ N （1 ≤ N ≤ 1000000000 = 109）が， 2 行目には，はがれたタイルの枚数 K （1 ≤ K ≤ 1000）が書かれている． 2+i 行目（1 ≤ i ≤ K）には，2 つの整数 ai と bi （1 ≤ ai ≤ N, 1 ≤ bi ≤ N）が空白区切りで書かれており， i 枚目のはがれたタイルが，左から ai 列目，上から bi 行目のタイルであることを表す．

入力の 3 行目から 2+K 行目には同じタイルを表す行が重複して現れることはない．また，与えられる入力データ 40% では， N ≤ 1000 をみたしている．

出力

出力は K 行からなる．各行は 1 つの整数からなり， i 行目（1 ≤ i ≤K）の整数は，i 枚目のはがれたタイルが赤のときは 1 を，青のときは 2 を，黄色のときは 3 を表す．

入出力例

入力例 1

11
4
5 2
9 7
4 4
3 9

出力例 1

2
3
1
3

入力例 2

16
7
3 7
5 2
11 6
15 2
9 7
8 12
15 16

出力例 2

3
2
3
2
1
2
1

問題文と自動審判に使われるデータは、情報オリンピック日本委員会が作成し公開している問題文と採点用テストデータです。


import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Functor
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.List
import qualified Data.Foldable as Foldable
import qualified Data.Set as Set
import qualified Data.Sequence as Sequence
import Data.List.Split
import Data.Bits
import Data.Char
import Data.Ix
import Data.Ratio
import Data.Ord
import Data.Tuple
import Data.Array
--import Data.Array.Unboxed
import Data.Array.MArray
import Data.Array.IO
import Data.Array.ST
import Data.IORef
import Data.STRef
-- import System.IO.Unsafe

readInt = read :: String -> Int
readInteger = read :: String -> Integer
readDouble = read :: String -> Double
getInt = readLn :: IO Int
getInts = map readInt . words <$> getLine
getInteger = readLn :: IO Integer
getIntegers = map readInteger . words <$> getLine
getDouble = readLn :: IO Double
sjoin :: (Show a) => [a] -> String
sjoin = unwords . map show
cond :: a -> a -> Bool -> a
cond t f c = if c then t else f
apply2 :: (a -> a -> b) -> [a] -> b
apply2 f [x,y] = f x y
apply3 :: (a -> a -> a -> b) -> [a] -> b
apply3 f [x,y,z] = f x y z
apply4 :: (a -> a -> a -> a -> b) -> [a] -> b
apply4 f [x,y,z,w] = f x y z w
fnBin :: (b -> c -> d) -> (a -> b) -> (a -> c) -> a -> d
fnBin op f g x = op (f x) $ g x
fnTuple :: (a -> b, a -> c) -> a -> (b, c)
fnTuple (f,g) a = (f a, g a)
replace :: (Eq a) => a -> a -> [a] -> [a]
replace x y = map (\z -> if z==x then y else z)
modifyArray :: (Ix i, MArray a e m) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = readArray arr ix >>= writeArray arr ix . f
-- end of templete

f n [] = n
f n (('J',x):('O',y):('I',z):s)
  | x>=y && y<=z = f (max n y) s
  | otherwise = f n s
f n (t:s) = f n s

main = getLine >>= print . f 0 . map (fnTuple (head,length)) . group

JJOOII (JJOOII)

JOI (日本情報オリンピック) の本選に向けてプログラミングの練習をしていたあなたは，今年度のJOI の予選の問題には数値を扱う問題ばかりが出題され，文字列を扱う問題がなかったことに気がついた．そこであなたは，こっそり文字列の問題に強くなってライバルたちに差をつけることにした．

JOI の過去問を眺めていると，J, O, I の3 種類の文字からなる文字列に慣れておく必要がありそうなことがわかった．そこで，そのような文字列について考えよう．あなたは「与えられた文字列がJOI という部分文字列をもつかどうかを答えよ」という問題を思いついたものの，これはすぐに解けてしまった．もっとレベルの高い問題を解きたいあなたは，以下のような問題を作った．

文字列t が文字列s の部分文字列であるとは，t の先頭および末尾に何文字か(0 文字でもよい) を付け足すとs になることである．たとえば，JJOOII はOJJOOIIOJOI の部分文字列である．一方，JOI はJOOI の部分文字列ではない．

また，0 以上の整数k に対し，レベルk のJOI 列とは，k 個の文字J，k 個の文字O，k 個の文字I をこの順に並べた文字列のことであるとする．たとえば，JJOOII はレベル2 のJOI 列である．与えられた文字列の部分文字列であるJOI 列のうち，レベルが最大のものを求めたい．

課題

J, O, I の3 種類の文字からなる長さN の文字列S が与えられたとき，レベルk のJOI 列がS の部分文字列であるような最大のk の値を求めるプログラムを作成せよ．

制限

1 ≤ N ≤ 1000000 (= 106)   S の長さ

入力

標準入力から以下のデータを読み込め．

1 行目にはJ, O, I の3 種類の文字からなる文字列S が書かれている．

出力

標準出力に，レベルk のJOI 列がS の部分文字列であるような最大のk の値を表す整数を1 行で出力せよ．

採点基準

採点用データのうち，配点の20%分については，N ≤ 100 を満たす．

入出力例

入力例 1

OJJOOIIOJOI

出力例 1

2

OJJOOIIOJOI はレベル2 のJOI 列であるJJOOII を部分文字列として含んでおり，レベル3 以上のJOI列は部分文字列として含まない．

入力例 2

IJJIIJJJ

出力例 2

0

入力例 3

JOIJOIJOIJOIJOI

出力例 3

1

入力例 4

OOJJJJJJJOOOOIIIII

出力例 4

4

問題文と自動審判に使われるデータは、情報オリンピック日本委員会が作成し公開している問題文と採点用テストデータです。


import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Functor
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.List
import qualified Data.Foldable as Foldable
import qualified Data.Set as Set
import qualified Data.Sequence as Sequence
import Data.List.Split
import Data.Bits
import Data.Char
import Data.Ix
import Data.Ratio
import Data.Ord
import Data.Tuple
--import Data.Array
import Data.Array.IArray
--import Data.Array.Unboxed
import Data.Array.MArray
import Data.Array.IO
import Data.Array.ST
import Data.IORef
import Data.STRef
-- import System.IO.Unsafe

readInt = read :: String -> Int
readInteger = read :: String -> Integer
readDouble = read :: String -> Double
getInt = readLn :: IO Int
getInts = map readInt . words <$> getLine
getInteger = readLn :: IO Integer
getIntegers = map readInteger . words <$> getLine
getDouble = readLn :: IO Double
sjoin :: (Show a) => [a] -> String
sjoin = unwords . map show
cond :: a -> a -> Bool -> a
cond t f c = if c then t else f
apply2 :: (a -> a -> b) -> [a] -> b
apply2 f [x,y] = f x y
apply3 :: (a -> a -> a -> b) -> [a] -> b
apply3 f [x,y,z] = f x y z
apply4 :: (a -> a -> a -> a -> b) -> [a] -> b
apply4 f [x,y,z,w] = f x y z w
fnBin :: (b -> c -> d) -> (a -> b) -> (a -> c) -> a -> d
fnBin op f g x = op (f x) $ g x
fnTuple :: (a -> b, a -> c) -> a -> (b, c)
fnTuple (f,g) a = (f a, g a)
replace :: (Eq a) => a -> a -> [a] -> [a]
replace x y = map (\z -> if z==x then y else z)
modifyArray :: (Ix i, MArray a e m) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = readArray arr ix >>= writeArray arr ix . f
dictCompare :: [a -> a -> Ordering] -> a -> a -> Ordering
dictCompare [] _ _ = EQ
dictCompare (f:fs) x y = let c = f x y in if c==EQ then dictCompare fs x y else c
binMap :: (a -> a -> b) -> [a] -> [b]
binMap f (x:xs@(y:_)) = f x y : binMap f xs
binMap _ _ = []
-- end of templete

f [] = []
f (x:xs) = f' 1 x xs
f' n _ [] = [n]
f' n x ya@(y:ys)
  | x==y = n : f ya
  | otherwise = f' (n+1) y ys

g (x:xs@(y:z:zs)) = max (x+y+z) $ g xs
g _ = 0

main = do
    n <- getInt
    s <- getInts
    let seqs = f s
    print $ if length seqs <= 3 then n else g seqs

電飾(Illumination)

JOI 高校の文化祭では毎年廊下に電飾が飾られる．電飾は N 個の電球で構成されており，電球は廊下の西側から東側に一列に並んでいる．各電球は明かりがついているか，ついていないかのいずれかの状態である．

JOI 高校の倉庫には電球を操作する機械が眠っている．この機械は電飾内で連続した電球を指定すると，指定された電球のうち，明かりがついている電球全てを明かりがついていない状態にし，明かりがついていない電球全てを明かりがついている状態にする．ただし，機械は老朽化のため，1 回しか使用できない．

JOI 高校の生徒達は明かりがついている電球とついていない電球が交互に並んだ列（このような電球の列を交互列と呼ぶ）が好きである．そこで，この機械を必要ならば1 回だけ使って，できるだけ長い交互列を含む電飾を作ることにした．

例

例えば，電飾の配置が西から東に向かって

となっていたとする（○は明かりがついている電球を，●は明かりがついていない電球を表す）．このとき，4 番目から7 番目までの4 個の電球に対して機械を操作すると，

となり，2 番目から8 番目までの電球が長さ7 の交互列をなす．

また，8 番目の電球のみに対して機械を操作すると，

となり，4 番目から10 番目までの電球が長さ7 の交互列をなす．

機械を最大1 回使用することで，長さが8 以上の交互列を作ることはできない．

課題

電飾の情報が与えられたとき，機械を最大1 回使用することで得られる電球の配列に含まれる交互列の長さとして考えられるものの最大値を求めるプログラムを作成せよ．

制限

2 ≤ N ≤ 100 000      電飾を構成する電球の個数

入力

標準入力から以下のデータを読み込め．

1 行目には整数 N が書かれている．

2 行目には N 個の 0 または 1 が空白を区切りとして書かれている．各整数は機械を操作する前における電球の情報を表している．左からi ( 1 ≤ i ≤ N ) 番目の整数は西側から i 番目の電球の情報を表しており，整数が 1 ならば電球の明かりがついていて，0 ならば明かりがついていないことを表す．

出力

標準出力に，作成可能な電球の列に含まれる交互列の長さの最大値を表す整数を1 行で出力せよ．

入出力例

入力例 1

10
1 1 0 0 1 0 1 1 1 0

出力例 1

7

これは問題文中で説明された例である．

入力例 2

10
1 0 0 0 0 1 0 1 0 1

出力例 2

8

西側から 4 番目の電球のみを操作すると，最大値 8 を満たす交互列が得られる．

入力例 3

5
1 1 0 1 1

出力例 3

5

西側から数えて 2 番目から 4 番目までの電球を操作すると，全ての電球からなる交互列を作ることがで
きる．

入力例 4

3
0 1 0

出力例 4

3

機械を使用しなくても良い場合があることに注意せよ．

問題文と自動審判に使われるデータは、情報オリンピック日本委員会が作成し公開している問題文と採点用テストデータです。


import Control.Applicative ((<$>))
import Control.Monad (unless)
import Data.List (sort, group, maximumBy)
import Data.Function (on)
import Data.Bool (bool)

main :: IO ()
main = do
  n <- readLn
  unless (n == 0) $ do
    solve n <$> map read <$> words <$> getLine >>= putStrLn
    main

solve :: Int -> [Int] -> String
solve n xs = bool "NO COLOR" (show . head $ cs) $ length cs > (n `div` 2)
  where cs = maximumBy (compare `on` length) . group . sort $ xs

What Color Is The Universe?

On a clear night, a boy, Campanella looked up at the sky, there were many stars which have different colors such as red, yellow, green, blue, purple, etc. He was watching the stars and just lost track of time. Presently, he wondered,

"There are many stars in the space. What color is the universe if I look up it from outside?"

Until he found the answer to this question, he couldn't sleep. After a moment's thought, he proposed a hypothesis,

"When I observe the stars in the sky, if more than half of the stars have the same color, that is the color of the universe."

He has collected data of stars in the universe after consistently observing them. However, when he try to count the number of star, he was in bed sick with a cold. You decided to help him by developing a program to identify the color of the universe.

You are given an array A. Let |A| be the number of element in A, and let Nm be the number of m in A. For example, if A = {3, 1, 2, 3, 3, 1, 5, 3}, |A| = 8, N3 = 4, N1 = 2, N5 = 1. Your program have to find m such that:

Nm > (|A| / 2 )

If there is no such m, you also have to report the fact. There is no
such m for the above example, but for a array A = {5, 2, 5, 3, 4, 5, 5}, 5 is the answer.

Input

There are several test cases. For each test case, in the first line |A| is given. In the next line, there will be |A| integers. The integers are less than 231 and |A| < 1,000,000. The input terminate with a line which contains single 0.

Output

For each test case, output m in a line. If there is no answer, output "NO COLOR" in a line.

Sample Input

8
3 1 2 3 3 1 5 3
7
5 2 5 3 4 5 5
0

Output for the Sample Input

NO COLOR
5


main = interact $ unlines . map (show . persimmon) . read' . lines
 where
  read' ("0":_) = []
  read' (n:wh:xs) = (read n, (w,h), (s,t), map (map read . words) ps) : read' xs'
   where
    [w,h] = map read (words wh)
    [s,t] = map read (words st)
    (ps,(st:xs')) = splitAt (read n) xs

persimmon :: (Int, (Int,Int), (Int,Int), [[Int]]) -> Int
persimmon (n,(w,h),(s,t),ps)
 | s*t >= n = n
 | otherwise = maximum (map countTree estate)
 where
  estate = [((x1,y1),(x2,y2)) | x1<-[1..w-s+1], y1<-[1..h-t+1], let (x2,y2)=(x1+s-1,y1+t-1)]
  countTree ((x1,y1),(x2,y2)) = length $ filter (\[px,py] -> elem px [x1..x2] && elem py [y1..y2]) ps

Get Many Persimmon Trees

Seiji Hayashi had been a professor of the Nisshinkan Samurai School
in the domain of Aizu for a long time in the 18th century.
In order to reward him for his meritorious career in education,
Katanobu Matsudaira, the lord of the domain of Aizu, had decided to
grant him a rectangular estate within a large field in the Aizu Basin.
Although the size (width and height) of the estate was strictly specified
by the lord, he was allowed to choose any location for the estate
in the field.
Inside the field which had also a rectangular shape,
many Japanese persimmon trees,
whose fruit was one of the famous products of the Aizu region
known as 'Mishirazu Persimmon', were planted.
Since persimmon was Hayashi's favorite fruit, he wanted to have
as many persimmon trees as possible in the estate given by the lord.

For example, in Figure 1, the entire field is a rectangular grid whose
width and height are 10 and 8 respectively. Each asterisk (*)
represents a place of a persimmon tree. If the specified width and
height of the estate are 4 and 3 respectively, the area surrounded by
the solid line contains the most persimmon trees. Similarly, if the
estate's width is 6 and its height is 4, the area surrounded by the
dashed line has the most, and if the estate's width and height are 3
and 4 respectively, the area surrounded by the dotted line contains
the most persimmon trees. Note that the width and height cannot be
swapped; the sizes 4 by 3 and 3 by 4 are different, as shown in Figure
1.

Figure 1: Examples of Rectangular Estates

Your task is to find the estate of a given size (width and height)
that contains the largest number of persimmon trees.

Input

The input consists of multiple data sets.
Each data set is given in the following format.

N

W H

x1 y1

x2 y2

...

xN yN

S T

N is the number of persimmon trees,
which is a positive integer less than 500.
W and H are the width and the height of the entire field
respectively.
You can assume that both W and H are positive integers
whose values are less than 100.
For each i (1 <= i <= N),
xi and yi are
coordinates of the i-th persimmon tree in the grid.
Note that the origin of each coordinate is 1.
You can assume that 1 <= xi <= W
and 1 <= yi <= H,
and no two trees have the same positions.
But you should not assume that the persimmon trees are sorted in some order
according to their positions.
Lastly, S and T are positive integers of
the width and height respectively of the estate given by the lord.
You can also assume that 1 <= S <= W
and 1 <= T <= H.

The end of the input is indicated by a line that solely contains a zero.

Output

For each data set, you are requested to print one line containing the
maximum possible number of persimmon trees that can be included in an
estate of the given size.

Sample Input

16
10 8
2 2
2 5
2 7
3 3
3 8
4 2
4 5
4 8
6 4
6 7
7 5
7 8
8 1
8 4
9 6
10 3
4 3
8
6 4
1 2
2 1
2 4
3 4
4 2
5 3
6 1
6 2
3 2
0

Output for the Sample Input

4
3


switch :: Int -> Int -> [a] -> [a]
switch p c l = middle ++ top ++ bottom
  where
    top = take (p - 1) l
    middle = take c $ drop (p - 1) l
    bottom = drop (p + c - 1) l

switches :: [Int] -> [Int] -> [Int]
switches [] l = l
switches (p:c:xs) l = switches xs (switch p c l)

ans :: [Int] -> String
ans [0,0] = ""
ans (n:r:xs) = (show . head $ switches ops [n,n-1..1]) ++ "\n" ++ (ans lsx)
  where
    ops = take (2 * r) xs
    lsx = drop (2 * r) xs

rInt :: String -> Int
rInt str = read str :: Int  -- rInt ?????? read Int ?????\?s

main = do
  input <- getContents
  let i = concat $ map ((map rInt) . words) $ lines input
  putStrLn . ans $ i

Problem A: Hanafuda Shuffle

There are a number of ways to shuffle a deck of cards. Hanafuda
shuffling for Japanese card game 'Hanafuda' is one such example.
The following is how to perform Hanafuda shuffling.

There is a deck of n cards. Starting from the p-th card
from the top of the deck, c cards are pulled out
and put on the top of the deck, as shown in Figure 1.
This operation, called a cutting operation, is repeated.

Write a program that simulates Hanafuda shuffling and answers which
card will be finally placed on the top of the deck.

Figure 1: Cutting operation

Input

The input consists of multiple data sets.
Each data set starts with a line containing two positive integers n
(1 <= n <= 50) and r (1 <= r <= 50); n and
r are the number of cards in the deck and the number of cutting
operations, respectively.

There are r more lines in the data set, each of which
represents a cutting operation. These cutting operations
are performed in the listed order.
Each line contains two positive integers p and c
(p + c <= n + 1).
Starting from the p-th card from the top of the deck, c
cards should be pulled out and put on the top.

The end of the input is indicated by a line which contains two zeros.

Each input line contains exactly two integers separated by a space
character.
There are no other characters in the line.

Output

For each data set in the input, your program
should write the number of the top card after the shuffle.
Assume that at the beginning the cards
are numbered from 1 to n, from the bottom to the top.
Each number should be written in a separate line
without any superfluous characters such as leading or following spaces.

Sample Input

5 2
3 1
3 1
10 3
1 10
10 1
8 3
0 0

Output for the Sample Input

4
4


import Data.List

untilFix f x = if f x == x then x else untilFix f (f x)

main = interact $ unlines . map (show . cdp) . unfoldr read' . lines
 where
  read' (x:xs)
   | x == "0" = Nothing
   | otherwise = let (xs1,xs2) = splitAt (read x) xs in Just (map (map read . words) xs1, xs2)

cdp nss = (sum . concat) nss - (sum . concat . untilFix disappear) nss

disappear = reverse . transpose . map (filter (/= 0) . reverse) . transpose .
 map (concatMap (\g -> if length g >=3 then map (const 0) g else g) . group)

Chain Disappearance Puzzle

We are playing a puzzle.
An upright board with H rows by 5 columns of cells, as shown in
the figure below, is used in this puzzle.
A stone engraved with a digit, one of 1 through 9, is placed in each of
the cells.
When three or more stones in horizontally adjacent cells are engraved
with the same digit, the stones will disappear.
If there are stones in the cells above the cell with a disappeared
stone, the stones in the above cells will drop down, filling the
vacancy.

The puzzle proceeds taking the following steps.

When three or more stones in horizontally adjacent cells are
engraved with the same digit, the stones will disappear. Disappearances
of all such groups of stones take place simultaneously.

When stones are in the cells above the emptied cells, these stones drop down so that the emptied cells are filled.

After the completion of all stone drops, if one or more groups of
stones satisfy the disappearance condition, repeat by returning to the
step 1.

The score of this puzzle is the sum of the digits on the disappeared stones.

Write a program that calculates the score of given configurations of stones.

Input

The input consists of multiple datasets.
Each dataset is formed as follows.

Board height H

Stone placement of the row 1

Stone placement of the row 2

...

Stone placement of the row H

The first line specifies the height ( H ) of the puzzle board (1 ≤ H ≤ 10).
The remaining H lines give placement of stones on each of the rows from top to bottom.
The placements are given by five digits (1 through 9), separated by a space.
These digits are engraved on the five stones in the corresponding row, in the same order.

The input ends with a line with a single zero.

Output

For each dataset, output the score in a line.
Output lines may not include any characters except the digits expressing the scores.

Sample Input

1
6 9 9 9 9
5
5 9 5 5 9
5 5 6 9 9
4 6 3 6 9
3 3 2 9 9
2 2 1 1 1
10
3 5 6 5 6
2 2 2 8 3
6 2 5 9 2
7 7 7 6 1
4 6 6 4 9
8 9 1 1 8
5 6 1 8 1
6 8 2 1 2
9 6 3 3 5
5 3 8 8 8
5
1 2 3 4 5
6 7 8 9 1
2 3 4 5 6
7 8 9 1 2
3 4 5 6 7
3
2 2 8 7 4
6 5 7 7 7
8 8 9 9 9
0

Output for the Sample Input

36
38
99
0
72


{-
URL: http://judge.u-aizu.ac.jp/onlinejudge/description.jsp?id=1195&lang=jp
?????????: Encryption System
?????°:
18:50 Haskell?????????????????¨????????§Haskell????????????
19:11 ????\???¢?????±???????¨???\?????????????????????
19:24 ????\???¢?????±?????????????????????????????????????????£????????????????????§??????????????????
19:32 ?????°??£????????§?????´?????????????????????
19:33 AC???????????§?????¬??????????????´???
-}
import Control.Monad
import Control.Applicative
import Data.List

main = do
 info <- getLine
 unless (info == "#") $ do
 let arr = sort $ analyze info
 print (length arr)
 mapM_ putStrLn $ if length arr <= 10 then arr else take 5 arr ++ (reverse . take 5 . reverse)arr
 main

analyze :: String -> [String]
analyze str = fold arr str
 where arr = map (uncurry decipher) $ zip ['b' ..'z'] ['a' .. 'y']

fold :: (Monad m) => [a -> m a] -> a -> m a
fold [] a = return a
fold (g:fs) a = fold fs a >>= g

-- decipher 'b' 'a' "want a aeer" = ["wbnt a aeer","want b aeer","want a beer","want a aeer"]
decipher :: Char -> Char -> String -> [String]
decipher b a str
 | b `elem` str = let (front,back) = break (==b) str in map (++back) (replaceOne a b front) -- b??\???????????????????????????????????¨back?????¨??????????????£???
 | otherwise = replaceOne' a b str

-- replaceOne 'a' 'b' "an algebra" = ["bn algebra", "an blgebra", "an algebrb"]
replaceOne :: (Eq a) => a -> a -> [a] -> [[a]]
replaceOne a b = init . replaceOne' a b -- ????????????????????????

replaceOne' :: (Eq a) => a -> a -> [a] -> [[a]]
replaceOne' _ _ [] = [[]]
replaceOne' a b (c:xs)
 | a == c = (b:xs) : map (c:) (replaceOne' a b xs) -- ???????????????????????????????????¨???????????????????????¨
 | otherwise = map (c:) (replaceOne' a b xs) -- ???????????£????????????????????????????????????

Encryption System

A programmer developed a new encryption system.
However, his system has an issue that
two or more distinct strings are `encrypted' to the same string.

We have a string encrypted by his system.
To decode the original string, we want to enumerate all the candidates of the string before the encryption.
Your mission is to write a program for this task.

The encryption is performed taking the following steps. Given a string that consists only of lowercase letters ('a' to 'z').

Change the first 'b' to 'a'. If there is no 'b', do nothing.

Change the first 'c' to 'b'. If there is no 'c', do nothing.

...

Change the first 'z' to 'y'. If there is no 'z', do nothing.

Input

The input consists of at most 100 datasets.
Each dataset is a line containing an encrypted string.
The encrypted string consists only of lowercase letters, and contains at least 1 and at most 20 characters.

The input ends with a line with a single '#' symbol.

Output

For each dataset,
the number of candidates n of the string before encryption should be printed in a line first,
followed by lines each containing a candidate of the string before encryption.
If n does not exceed 10, print all candidates in dictionary order;
otherwise, print the first five and the last five candidates in dictionary order.

Here, dictionary order is recursively defined as follows.
The empty string comes the first in dictionary order.
For two nonempty strings x = x1 ... xk and y = y1 ... yl,
the string x precedes the string y in dictionary order if

x1 precedes y1 in alphabetical order ('a' to 'z'), or

x1 and y1 are the same character and x2 ... xk precedes y2 ... yl in dictionary order.

Sample Input

enw
abc
abcdefghijklmnopqrst
z
#

Output for the Sample Input

1
fox
5
acc
acd
bbd
bcc
bcd
17711
acceeggiikkmmooqqssu
acceeggiikkmmooqqstt
acceeggiikkmmooqqstu
acceeggiikkmmooqrrtt
acceeggiikkmmooqrrtu
bcdefghijklmnopqrrtt
bcdefghijklmnopqrrtu
bcdefghijklmnopqrssu
bcdefghijklmnopqrstt
bcdefghijklmnopqrstu
0


import Data.List

main = interact $ unlines . map (show . attwo . map read . words) . init . lines

attwo [n,k,m] = attwo' (n-1) $! take (n-1) $ tail $ dropWhile (/=m) (cycle [1..n])
 where
  attwo' _ [x] = x
  attwo' l xs = attwo' (l-1) $! delete x (take l xs')
   where (x:xs') = drop (mod (k-1) l) (cycle xs)

Problem A: And Then There Was One

Let’s play a stone removing game.

Initially, n stones are arranged on a circle and numbered 1, ... , n clockwise (Figure 1). You are also given two numbers k and m. From this state, remove stones one by one following the rules explained below, until only one remains. In step 1, remove stone m. In step 2, locate the k-th next stone clockwise from m and remove it. In subsequent steps, start from the slot of the stone removed in the last step, make k hops clockwise on the remaining stones and remove the one you reach. In other words, skip (k - 1) remaining stones clockwise and remove the next one. Repeat this until only one stone is left and answer its number.

For example, the answer for the case n = 8, k = 5, m = 3 is 1, as shown in Figure 1.

Figure 1: An example game

Initial state: Eight stones are arranged on a circle.

Step 1: Stone 3 is removed since m = 3.

Step 2: You start from the slot that was occupied by stone 3. You skip four stones 4, 5, 6 and 7 (since k = 5), and remove the next one, which is 8.

Step 3: You skip stones 1, 2, 4 and 5, and thus remove 6. Note that you only count stones that are still on the circle and ignore those already removed. Stone 3 is ignored in this case.

Steps 4-7: You continue until only one stone is left. Notice that in later steps when only a few stones remain, the same stone may be skipped multiple times. For example, stones 1 and 4 are skipped twice in step 7.

Final State: Finally, only one stone, 1, is on the circle. This is the final state, so the answer is 1.

Input

The input consists of multiple datasets each of which is formatted as follows.

n k m

The last dataset is followed by a line containing three zeros. Numbers in a line are separated by a single space. A dataset satisfies the following conditions.

2 ≤ n ≤ 10000, 1 ≤ k ≤ 10000, 1 ≤ m ≤ n

The number of datasets is less than 100.

Output

For each dataset, output a line containing the stone number left in the final state. No extra characters such as spaces should appear in the output.

Sample Input

8 5 3
100 9999 98
10000 10000 10000
0 0 0

Output for the Sample Input

1
93
2019


import Control.Monad
import Control.Applicative
import Data.List

main :: IO()
main = getLine >>= main' . read
    where
        main' 0 = return ()
        main' _ = do
            as <- map read . words <$> getLine :: IO [Int]
            print $ solve as
            main

solve :: [Int] -> Int
solve as = head $ sort $ f $ sort as

f :: [Int] -> [Int]
f (_:[])= []
f (a:as) = ((head as) - a) : (f as)

Selection of Participants of an Experiment

Dr. Tsukuba has devised a new method of programming training.
In order to evaluate the effectiveness of this method,
he plans to carry out a control experiment.
Having two students as the participants of the experiment,
one of them will be trained under the conventional method
and the other under his new method.
Comparing the final scores of these two,
he will be able to judge the effectiveness of his method.

It is important to select two students having the closest possible scores,
for making the comparison fair.
He has a list of the scores of all students
who can participate in the experiment.
You are asked to write a program which selects two of them
having the smallest difference in their scores.

Input

The input consists of multiple datasets, each in the following format.

n

a1 a2 … an

A dataset consists of two lines.
The number of students n is given in the first line.
n is an integer satisfying 2 ≤ n ≤ 1000.
The second line gives scores of n students.
ai (1 ≤ i ≤ n) is the score of the i-th student, which is a non-negative integer not greater than 1,000,000.

The end of the input is indicated by a line containing a zero.
The sum of n's of all the datasets does not exceed 50,000.

Output

For each dataset, select two students with the smallest difference in their scores,
and output in a line (the absolute value of) the difference.

Sample Input

5
10 10 10 10 10
5
1 5 8 9 11
7
11 34 83 47 59 29 70
0

Output for the Sample Input

0
1
5


main = interact $ unlines . map (show . coconut_grab . read) . init . lines

coconut_grab e = head cand
 where cand = [x+y+z | let r3e = (ceiling.cbrt.fromIntegral) e,
                       let r2e = (ceiling.sqrt.fromIntegral) e,
                       x<-[0..r3e], y<-[0..r2e], z<-[0..r3e], x + y^2 + z^3 == e]

cbrt q = until approx (\q' -> q' - (q'^3-q) / (3*q'^2)) (q/2)
 where approx x = abs (x^3 - q) < 0.00001*q

Space Coconut Crab

宇宙ヤシガニ

English text is not available in this practice contest.

ケン・マリンブルーは，宇宙ヤシガニを求めて全銀河を旅するスペースハンターである．宇宙ヤシガニは，宇宙最大とされる甲殻類であり，成長後の体長は 400 メートル以上，足を広げれば 1,000 メートル以上にもなると言われている．既に多数の人々が宇宙ヤシガニを目撃しているが，誰一人として捕らえることに成功していない．

ケンは，長期間の調査によって，宇宙ヤシガニの生態に関する重要な事実を解明した．宇宙ヤシガニは，驚くべきことに，相転移航法と呼ばれる最新のワープ技術と同等のことを行い，通常空間と超空間の間を往来しながら生きていた．さらに，宇宙ヤシガニが超空間から通常空間にワープアウトするまでには長い時間がかかり，またワープアウトしてからしばらくは超空間に移動できないことも突き止めた．

そこで，ケンはついに宇宙ヤシガニの捕獲に乗り出すことにした．戦略は次のとおりである．はじめに，宇宙ヤシガニが通常空間から超空間に突入する際のエネルギーを観測する．このエネルギーを e とするとき，宇宙ヤシガニが超空間からワープアウトする座標 (x, y, z) は以下の条件を満たすことがわかっている．

x, y, z はいずれも非負の整数である．

x + y2 + z3 = e である．

上記の条件の下で x + y + z の値を最小にする．

これらの条件だけでは座標が一意に決まるとは限らないが，x + y + z の最小値を m としたときに，ワープアウトする座標が平面 x + y + z = m 上にあることは確かである．そこで，この平面上に十分な大きさのバリアを張る．すると，宇宙ヤシガニはバリアの張られたところにワープアウトすることになる．バリアの影響を受けた宇宙ヤシガニは身動きがとれなくなる．そこをケンの操作する最新鋭宇宙船であるウェポン・ブレーカー号で捕獲しようという段取りである．

バリアは一度しか張ることができないため，失敗するわけにはいかない．そこでケンは，任務の遂行にあたって計算機の助けを借りることにした．あなたの仕事は，宇宙ヤシガニが超空間に突入する際のエネルギーが与えられたときに，バリアを張るべき平面 x + y + z = m を求めるプログラムを書くことである．用意されたテストケースの全てに対して正しい結果を出力したとき，あなたのプログラムは受け入れられるであろう．

Input

入力は複数のデータセットで構成される．各データセットは 1 行のみからなり，1 つの正の整数 e (e ≦ 1,000,000) が含まれる．これは，宇宙ヤシガニが超空間に突入した際のエネルギーを表す．入力は e = 0 の時に終了し，これはデータセットには含まれない．

Output

各データセットについて，m の値を 1 行に出力しなさい．出力には他の文字を含めてはならない．

Sample Input

1
2
4
27
300
1250
0

Output for the Sample Input

1
2
2
3
18
44


import Data.Functor
import Data.List
import Data.Maybe

main = do
  n <- readLn
  s <- getLine
  print $ fromMaybe n $ succ <$> "xx" `elemIndex` (transpose [init s, tail s])

MathJax.Hub.Config({
tex2jax: {inlineMath: [['$','$'], ['\\(','\\)']]}
});

A: 丸付け

問題

AORイカちゃんはテストに合格するため勉強しています。

AORイカちゃんは、 $N$ 問、問題を解きました。
その後、解いた問題の丸付けを以下の手順で行います。

解答の正誤を確認する。

解答が正しい場合はマル印、誤っていた場合はバツ印を解答用紙に書き込む。

解答が $2$ 問連続で誤りであるとわかった瞬間、テストに不合格になってしまう恐怖から、AORイカちゃんは失神してしまいます。そして、それ以降丸付けを行うことはできません。

失神は手順 $1$ と $2$ の間で起こります。

AORイカちゃんが解いた問題の数を表す整数 $N$ と、解答の正誤を表した長さ $N$ の文字列 $S$ が与えられます。
文字列は 'o' と 'x' からなり、 'o' は解答が正しく、 'x' は解答が誤りであることを表しています。
$i$ 文字目が $i$ 問目の正誤を表しており、AORイカちゃんは $1$ 問目から順番に丸付けを行います。

AORイカちゃんが正誤を書き込めた問題数を出力してください。

制約

$1 \leq N \leq 10^5$

入力形式

入力は以下の形式で与えられる。

$N$

$S$

出力

AORイカちゃんが正誤を書き込めた問題数を $1$ 行で出力せよ。また、末尾に改行も出力せよ。

サンプル

サンプル入力 1

3
oxx

サンプル出力 1

2

$3$ 問目の手順 $1$ を行うと失神するため、手順 $2$ は行えません。

サンプル入力 2

8
oxoxoxox

サンプル出力 2

8

サンプル入力 3

4
xxxx

サンプル出力 3

1


{-# LANGUAGE BangPatterns #-}

solve :: (String, String) -> Int
solve (xss, yss) = lcs xss yss befMemo [0]
  where
    lcs [] _ memo _     = last memo
    lcs (x:xs) [] _  as = lcs xs yss (reverse as) [0]
    lcs xs ys (b:bs) as = lcs xs (tail ys) bs (m : as)
      where
        !m = if (head xs) == (head ys) then b + 1 else max (head as) (head bs)
    befMemo = replicate (length yss + 1) 0

main :: IO ()
main =  getLine
        >>  fmap lines getContents
        >>= toPair []
        >>= mapM_ (print . solve)
  where
    toPair pairs [] = return $ reverse pairs
    toPair pairs (xs:ys:rest) = toPair ((xs, ys) : pairs) rest

MathJax.Hub.Config({ tex2jax: { inlineMath: [["$","$"], ["\\(","\\)"]], processEscapes: true }});

Longest Common Subsequence

For given two sequences $X$ and $Y$, a sequence $Z$ is a common subsequence of $X$ and $Y$ if $Z$ is a subsequence of both $X$ and $Y$. For example, if $X = \{a,b,c,b,d,a,b\}$ and $Y = \{b,d,c,a,b,a\}$, the sequence $\{b,c,a\}$ is a common subsequence of both $X$ and $Y$. On the other hand, the sequence $\{b,c,a\}$ is not a longest common subsequence (LCS) of $X$ and $Y$, since it has length 3 and the sequence $\{b,c,b,a\}$, which is also common to both $X$ and $Y$, has length 4. The sequence $\{b,c,b,a\}$ is an LCS of $X$ and $Y$, since there is no common subsequence of length 5 or greater.

Write a program which finds the length of LCS of given two sequences $X$ and $Y$. The sequence consists of alphabetical characters.

Input

The input consists of multiple datasets. In the first line, an integer $q$ which is the number of datasets is given. In the following $2 \times q$ lines, each dataset which consists of the two sequences $X$ and $Y$ are given.

Output

For each dataset, print the length of LCS of $X$ and $Y$ in a line.

Constraints

$1 \leq q \leq 150$

$1 \leq$ length of $X$ and $Y$ $\leq 1,000$

$q \leq 20$ if the dataset includes a sequence whose length is more than 100

Sample Input 1

3
abcbdab
bdcaba
abc
abc
abc
bc

Sample Output 1

4
3
2

Reference

Introduction to Algorithms, Thomas H. Cormen, Charles E. Leiserson, Ronald L. Rivest, and Clifford Stein. The MIT Press.


{-# LANGUAGE FlexibleContexts #-}

module Main where

import Debug.Trace
import Data.List
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.Word
import Data.Char
import Data.Bits
import Data.Array
-- import Data.Array.Unboxed
-- import Data.Array.IO
import Data.Maybe
-- import qualified Data.Map as M
import qualified Data.IntMap as M
-- import Control.Monad.ST
-- import Data.STRef
import Data.Ord
import Data.Functor
import Control.Applicative
import Control.Monad
import Text.Printf

size = 3
sqSize = size*size
maxAdr = sqSize -1
mask = 0xF
shiftSize = 4
shiftTimes= 16

solver :: [[Int]] -> Int
solver lst
    | start == goal = 0
    | otherwise = iter (initialQueue, initialVisited) where
        iter (que, visited) = case Seq.viewr que of
            Seq.EmptyR -> error "No path found."
            que Seq.:> path@(board, distance, forward) -> case next path visited of
                (_, Just d)  -> distance + d +1
                (nextPaths, Nothing) -> iter (insertPaths que visited nextPaths) where
                    insertPaths q v [] = (q, v)
                    insertPaths q v (p@(x, d, f):ps) = insertPaths insertQue insertVisited ps where
                        insertQue = p Seq.<| q
                        insertVisited = M.insert x (d, f) v
        next path@(board, distance, forward) visited = iter [] Nothing nextBoards where
            iter ac af [] = (ac, af)
            iter ac af (x:xs) = case M.lookup x visited of
                Nothing -> iter ((x, distance+1, forward):ac) af xs
                Just (d', f') -> if forward == f' then iter ac af xs else (ac, Just d')
            nextBoards = [swapWith (valueAt p board) board | p <- dest!(searchZero board)]

        initialQueue = (goal, 0, False) Seq.<| (Seq.singleton (start, 0, True))
        initialVisited = M.insert goal (0, False) $ M.singleton start (0, True)
        goal    = toBits [1,2,3,4,5,6,7,8,0]
        start   = toBits $ concat lst
        dest    = listArray (0, maxAdr) [[1,3],[0,2,4],[1,5],[0,4,6],[1,3,5,7],[2,4,8],[3,7],[4,6,8],[5,7]]
        toBits = foldl' (\b a-> shiftL b shiftSize .|. a) 0
        valueAt i w = mask .&. shiftR w (shiftSize*i)

searchZero :: Int -> Int
searchZero = iter 0 where
    iter c w = case mask .&. w of
        hb  | hb == 0 -> c
            | otherwise -> iter (c+1) (rotateR w shiftSize)

swapWith :: Int -> Int -> Int
swapWith v = iter sqSize where
    iter 0 w = rotateR w (shiftSize*(shiftTimes-sqSize))
    iter c w = iter (c-1) $ rotateR (case mask .&. w of
        hb  | hb == 0 -> w .|. v
            | hb == v -> w `xor` v
            | otherwise -> w) shiftSize

readIntLn:: IO Int
readIntLn = (fst . fromJust . B.readInt) <$> B.getLine

readIntList:: IO [Int]
readIntList = map (fst . fromJust . B.readInt) . B.words <$> B.getLine

main :: IO()
main = do
    l <- replicateM size readIntList
    print $ solver l

MathJax.Hub.Config({ tex2jax: { inlineMath: [["$","$"], ["\\(","\\)"]], processEscapes: true }});

8 Puzzle

The goal of the 8 puzzle problem is to complete pieces on $3 \times 3$ cells where one of the cells is empty space.

In this problem, the space is represented by 0 and pieces are represented by integers from 1 to 8 as shown below.

1 3 0
4 2 5
7 8 6

You can move a piece toward the empty space at one step. Your goal is to make the pieces the following configuration in the shortest move (fewest steps).

1 2 3
4 5 6
7 8 0

Write a program which reads an initial state of the puzzle and prints the fewest steps to solve the puzzle.

Input

The $3 \times 3$ integers denoting the pieces or space are given.

Output

Print the fewest steps in a line.

Constraints

There is a solution.

Sample Input

1 3 0
4 2 5
7 8 6

Sample Output

4


import Data.IORef
import Control.Monad

main :: IO()
main = do
        n <- readLn
        x <- readLn
        y <- readLn
        print =<< solve (y - x) (min x y) [1..n-2]

solve :: Int -> Int -> [Int] -> IO Int
solve a b xs = do
                a' <- newIORef (a `seq` a)
                b' <- newIORef (b `seq` b)
                forM_ xs $! \_ -> do
                    z <- readLn
                    x <- readIORef a'
                    y <- readIORef b'
                    when (z - y > x) $! writeIORef a' (z - y)
                    when (z < y) $! writeIORef b' z
                readIORef a'

MathJax.Hub.Config({ tex2jax: { inlineMath: [["$","$"], ["\\(","\\)"]], processEscapes: true }});

Maximum Profit

You can obtain profits from foreign exchange margin transactions. For example, if you buy 1000 dollar at a rate of 100 yen per dollar, and sell them at a rate of 108 yen per dollar, you can obtain (108 - 100) × 1000 = 8000 yen.

Write a program which reads values of a currency $R_t$ at a certain time $t$ ($t = 0, 1, 2, ... n-1$), and reports the maximum value of $R_j - R_i$ where $j > i$ .

Input

The first line contains an integer $n$. In the following $n$ lines, $R_t$ ($t = 0, 1, 2, ... n-1$) are given in order.

Output

Print the maximum value in a line.

Constraints

$2 \leq n \leq 200,000$

$1 \leq R_t \leq 10^9$

Sample Input 1

6
5
3
1
3
4
3

Sample Output 1

3

Sample Input 2

3
4
3
2

Sample Output 2

-1


import qualified Data.ByteString.Char8 as BC
import Data.IORef
import Control.Monad(when)
import Data.Foldable(for_)
import Data.Maybe(fromJust)

main :: IO()
main = BC.getContents >>= solve.map (fst.fromJust.BC.readInt).BC.lines >>= print

solve :: [Int] -> IO Int
solve (_:x:y:xs) = do
                a <- newIORef (y - x)
                b <- newIORef (min x y)
                for_ xs $ \z -> do
                    a' <- readIORef a
                    b' <- readIORef b
                    when (z - b' > a') $ writeIORef a (z - b')
                    when (z < b')      $ writeIORef b z
                readIORef a


import           Control.Applicative
import           Control.Monad
import           Data.List
import           Text.Printf

minAfter::(Ord a)=>[a]->[a]
minAfter []     = []
minAfter [x]    = []
minAfter [x,y]  = [y]
minAfter (x:xs) = min (head xs) (head $ minAfter xs) : minAfter xs

minBefore::(Ord a)=>[a]->[a]
minBefore = reverse . minAfter . reverse

main = do
    n<- getLine
    a<- map (read::String->Int) <$> replicateM (read n) getLine
    print $ maximum $ zipWith (-) (tail a) (minBefore a)


module Main where

import Control.Applicative
import Control.Monad
import Data.Function

data Stat = Stat Int Int

updateStat :: Stat -> Int -> Stat
updateStat (Stat smin sdiff) x =
    Stat newMin newDiff
    where
        newMin  = min x smin
        newDiff = if newMin == smin then max (x - newMin) sdiff else sdiff

initStat :: Int -> Int -> Stat
initStat x y =
    Stat smin sdiff
    where
        smin  = min x y
        sdiff = y - x

diffStat (Stat _ sdiff) = sdiff

max_diff (x:y:xs) =
    foldl updateStat (initStat x y) xs

main = do
    times <- (read <$> getLine) :: IO Int

    xs <- ($ times) . fix $ \loop n -> do
            if n /= 0 then do
                x  <- (read <$> getLine) :: IO Int
                xs <- loop (n-1)
                pure $ x : xs
            else pure []

    print $ diffStat $ max_diff xs


import Control.Monad
import Control.Applicative

main :: IO ()
main = do
  [n, q] <- map read . words <$> getLine
  queue <- map ((\[x, y] -> (x, read y)) . words) <$> replicateM n getLine :: IO [(String, Int)]
  putStrLn . init . unlines $ calc queue q 0 []

calc :: [(String, Int)] -> Int -> Int -> [String] -> [String]
calc [] _ _ ans = reverse ans
calc ((name, time):xs) n total ans
  | time > n = calc (reverse $ (name, time - n):(reverse xs)) n (total + n) ans
  | otherwise = calc xs n (total + time) $ (unwords [name, show $ total + time]) : ans

There are n processes in a queue. Each process has namei and timei. The round-robin scheduling handles the processes in order. A round-robin scheduler gives each process a quantum (a time slot) and interrupts the process if it is not completed by then. The process is resumed and moved to the end of the queue, then the scheduler handles the next process in the queue.

For example, we have the following queue with the quantum of 100ms.

A(150) - B(80) - C(200) - D(200)

First, process A is handled for 100ms, then the process is moved to the end of the queue with the remaining time (50ms).

B(80) - C(200) - D(200) - A(50)

Next, process B is handled for 80ms. The process is completed with the time stamp of 180ms and removed from the queue.

C(200) - D(200) - A(50)

Your task is to write a program which simulates the round-robin scheduling.

Input

n q

name1 time1

name2 time2

...

namen timen

In the first line the number of processes n and the quantum q are given separated by a single space.

In the following n lines, names and times for the n processes are given. namei and timei are separated by a single space.

Output

For each process, prints its name and the time the process finished in order.

Constraints

1 ≤ n ≤ 100000

1 ≤ q ≤ 1000

1 ≤ timei ≤ 50000

1 ≤ length of namei ≤ 10

1 ≤ Sum of timei ≤ 1000000

Sample Input 1

5 100
p1 150
p2 80
p3 200
p4 350
p5 20

Sample Output 1

p2 180
p5 400
p1 450
p3 550
p4 800

Notes

Template in C


import Data.Functor((<$>))
import Text.Printf(printf)

main :: IO ()
main = do
        q  <- (read :: String -> Int).last.words <$> getLine
        xs <- map ((\[n, t] -> (n, (read :: String -> Int) t)).words).lines <$> getContents
        solve xs q 0

solve                     :: [(String, Int)] -> Int -> Int -> IO ()
solve []            _ _   = return ()
solve ((n, t) : xs) q cnt = let t'   = t - q
                                cnt' = cnt + q
                                m    = cnt' + t'
                            in if t' > 0 then solve (xs ++ [(n, t')]) q cnt'
                                         else printf "%s %d\n" n m >> solve xs q m


import Control.Applicative

import Data.Foldable (toList)
import Data.Sequence (Seq)
import qualified Data.Sequence as S

removeOne :: Int -> Seq Int -> Seq Int
removeOne x seq =
  case S.viewl seq of
    S.EmptyL  -> S.empty
    s S.:< ss ->
      if x == s
         then ss
         else s S.<| (removeOne x ss)

exec :: [String] -> Seq Int -> Seq Int
exec ["insert", n]   seq = (read n) S.<| seq
exec ["delete", n]   seq = removeOne (read n) seq
exec ["deleteFirst"] seq = let (s  S.:< ss) = S.viewl seq in ss
exec ["deleteLast"]  seq = let (ss S.:>  s) = S.viewr seq in ss

printSeq :: String -> [Int] -> IO ()
printSeq _ []       = putStrLn "" >> return ()
printSeq sep (x:xs) = do
  putStr sep
  putStr $ show x
  printSeq " " xs

main :: IO ()
main = do
  n   <- read <$> getLine :: IO Int
  seq <- readCommand n S.empty
  printSeq "" (toList seq)
  where
    readCommand :: Int -> Seq Int -> IO (Seq Int)
    readCommand 0 seq = return seq
    readCommand n seq = do
      cmds <- words <$> getLine
      readCommand (n-1) (exec cmds seq)

Doubly Linked List

Your task is to implement a double linked list.

Write a program which performs the following operations:

insert x: insert an element with key x into the front of the list.

delete x: delete the first element which has the key of x from the list. If there is not such element, you need not do anything.

deleteFirst: delete the first element from the list.

deleteLast: delete the last element from the list.

Input

The input is given in the following format:

n

command1

command2

...

commandn

In the first line, the number of operations n is given. In the following n lines, the above mentioned operations are given in the following format:

insert x

delete x

deleteFirst

deleteLast

Output

Print all the element (key) in the list after the given operations. Two consequtive keys should be separated by a single space.

Constraints

The number of operations ≤ 2,000,000

The number of delete operations ≤ 20

0 ≤ value of a key ≤ 109

The number of elements in the list does not exceed 106

For a delete, deleteFirst or deleteLast operation, there is at least one element in the list.

Sample Input 1

7
insert 5
insert 2
insert 3
insert 1
delete 3
insert 6
delete 5

Sample Output 1

6 1 2

Sample Input 2

9
insert 5
insert 2
insert 3
insert 1
delete 3
insert 6
delete 5
deleteFirst
deleteLast

Sample Output 2

1


import qualified Data.Vector         as V
import qualified Data.Vector.Mutable as VM
import Control.Applicative
import Control.Monad
import Data.IORef
import Text.Printf
import Data.List

type Cmd = [String]

doublyLinkedList :: [Cmd] -> [String]
doublyLinkedList cmds = foldl f [] cmds
  where
    f as (c : x)
      | c == "insert" = (head x) : as
      | c == "delete" = delete (head x) as
      | c == "deleteFirst" = tail as
      | c == "deleteLast"  = init as

main :: IO ()
main = do
  n  <- readLn
  xs <- map words <$> replicateM n getLine
  putStrLn $ unwords $ doublyLinkedList xs


{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -funbox-small-strict-fields #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE MultiWayIf #-}
-- {-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE ViewPatterns #-}
-- {-# LANGUAGE TupleSections #-}

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function (on)
import           Data.Ord (comparing)
import           Data.Monoid (mappend)
import           Data.Array
-- import           Data.Array.Unboxed
-- import           Data.Array.IArray
-- import           Data.Array.ST
-- import           Data.Array.MArray
-- import           Data.Array.Unsafe
import           Data.Ix
import           Data.Maybe
-- import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
-- import           Data.Graph
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntSet (IntSet)
-- import qualified Data.IntSet as IntSet
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
-- import           Data.Sequence ((|>), (<|), (><),ViewR(..), ViewL(..), Seq)
-- import qualified Data.Sequence              as Seq
-- import           Data.Foldable (toList, minimumBy)
import           Debug.Trace

data Query = Insert Int | Delete Int | DeleteFirst | DeleteLast

data Deque a = Q [a] Int [a] Int deriving (Show)

emptyQ :: Deque a
emptyQ = Q [] 0 [] 0

viewQ :: Deque a -> [a]
viewQ (Q xs _ ys _) = xs ++ reverse ys

insertQ :: a -> Deque a -> Deque a
insertQ a (Q x lx y ly) = chk $ Q (a:x) (lx + 1) y ly

deleteQ :: Eq a => a -> Deque a -> Deque a
deleteQ a (Q x lx y ly)
  | a `elem` x = chk $ Q (delete a x) (lx - 1) y ly
  | a `elem` y = chk $ Q x lx (reverse $ delete a (reverse y)) (ly - 1)
  | otherwise = chk $ Q x lx y ly

deleteFirstQ :: Deque a -> Deque a
deleteFirstQ (Q (_:xs) lx y ly) = chk $ Q xs (lx - 1) y ly
deleteFirstQ (Q [] _ [_] _) = chk emptyQ

deleteLastQ :: Deque a -> Deque a
deleteLastQ (Q x lx (_:ys) ly) = chk $ Q x lx ys (ly - 1)

chk :: Deque a -> Deque a
chk (Q [] 0 [] 0) = Q [] 0 [] 0
chk (Q [x] 1 [] 0) = Q [] 0 [x] 1
chk (Q [] 0 y ly) = chk $ Q (reverse y) ly [] 0
chk (Q (x:xs) lx y ly) = if lx > ly
  then Q [x] 1 (y++reverse xs) (lx+ly)
  else Q (x:xs) lx y ly

main = do
  n <- readInt1 <$> BS.getLine
  qs <- map myread <$> replicateM n BS.getLine
  putIntN $ solve qs

solve = viewQ . foldl f emptyQ where
  f' q query = traceShowId $ f q query
  f q (Insert a) = insertQ a q
  f q (Delete a) = deleteQ a q
  f q DeleteFirst = deleteFirstQ q
  f q DeleteLast = deleteLastQ q

myread :: BS.ByteString -> Query
myread = f . BS.words where
  f (x:xs)
    | x == "insert" = Insert (readInt1 $ head xs)
    | x == "delete" = Delete (readInt1 $ head xs)
    | x == "deleteFirst" = DeleteFirst
    | x == "deleteLast" = DeleteLast

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

format :: Show a => Maybe a -> IO ()
format Nothing = putStrLn "NO"
format (Just a) = putStrLn "YES" >> print a

-- [1,2,3] -> 1 2 3
putIntN :: [Int] -> IO ()
putIntN [] = return ()
putIntN xs = BL.putStrLn . toLazyByteString . foldl1 mappend . intersperse (char8 ' ') $ map intDec xs

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

readInt641 :: BS.ByteString -> Int64
readInt641 = fromIntegral . fst . fromJust . BS.readInteger

readInt642 :: BS.ByteString -> (Int64,Int64)
readInt642 = toTuple . readInt64N

readInt643 :: BS.ByteString -> (Int64,Int64,Int64)
readInt643 = toTriple . readInt64N

readInt64N :: BS.ByteString -> [Int64]
readInt64N =  map readInt641 . BS.words

readInteger1 :: BS.ByteString -> Integer
readInteger1 = fst . fromJust . BS.readInteger

readInteger2 :: BS.ByteString -> (Integer,Integer)
readInteger2 = toTuple . readIntegerN

readInteger3 :: BS.ByteString -> (Integer,Integer,Integer)
readInteger3 = toTriple . readIntegerN

readIntegerN :: BS.ByteString -> [Integer]
readIntegerN =  map readInteger1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

toTriple :: [a] -> (a, a, a)
toTriple [x, y, z] =(x, y, z)

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

fromTriple :: (a, a, a) -> [a]
fromTriple (x, y, z) = [x, y, z]

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)

-- @since 4.8.0.0
sortOn' :: Ord b => (a -> b) -> [a] -> [a]
sortOn' f =
  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))