{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf            #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.Primitive
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Data.Bool
import qualified Data.ByteString             as B
import qualified Data.ByteString.Builder     as B
import qualified Data.ByteString.Char8       as C
import qualified Data.ByteString.Internal    as B
import qualified Data.ByteString.Unsafe      as B
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import qualified Data.IntMap.Strict          as IM
import qualified Data.IntSet                 as IS
import qualified Data.List                   as L
import qualified Data.Map.Strict             as M
import           Data.Monoid
import           Data.Ord
import           Data.Primitive.MutVar
import qualified Data.Set                    as S
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Debug.Trace
import           Foreign                     hiding (void)
import           GHC.Exts
import qualified System.IO                   as IO
import           Unsafe.Coerce

main :: IO ()
main = do
    [n, q] <- map read.words <$> getLine :: IO [Int]
    (tree, query) <- U.splitAt(n-1).U.unfoldr parseInt2 <$> C.getContents
    putStrLn.unwords.map show.U.toList $ solve n q
        (U.map(\(x,y)->(x-1,y-1))tree)
        (U.map(\(x,y)->(x-1,y)) query)

solve :: Int -> Int -> U.Vector Edge -> U.Vector (Int, Int) -> U.Vector Int
solve n q edges queries = U.generate n ((processed U.!).(left U.!))
  where
    tree = fromEdges n edges
    EulerTour vertices !left = eulerTour tree
    !right = U.accumulate (flip const) (U.replicate n nothing)
        $ U.imap (flip (,)) vertices
    query (root, x) = U.fromList [(left U.! root, x), (right U.! root + 1, -x)]
    !processed = U.init
        . U.postscanl' (+) 0
        . U.accumulate (+) (U.replicate (2 * n) 0)
        $ U.concatMap query queries

type Vertex = Int
type Edge = (Vertex, Vertex)
type Graph = V.Vector (U.Vector Vertex)

nothing :: Int
nothing = -1

fromEdges :: Int -> U.Vector Edge -> Graph
fromEdges numV edges = V.map (U.force . U.fromList)
    . V.unsafeAccumulate (flip (:)) (V.replicate numV [])
    $ U.convert edges

data EulerTour = EulerTour (U.Vector Vertex) (U.Vector Int) deriving Show

eulerTour :: Graph -> EulerTour
eulerTour tree =  runST $ do
    eulertour <- UM.replicate (2 * V.length tree - 1) nothing
    idx <-UM.replicate (V.length tree) nothing
    depth <- UM.replicate (2 * V.length tree - 1) nothing

    void $ fix `flip` 0 `flip` nothing `flip` 0 `flip` 0 $ \dfs v p d i -> do
        UM.unsafeWrite eulertour i v
        UM.unsafeWrite idx v i
        UM.unsafeWrite depth i d

        U.foldM' `flip` (i + 1) `flip` V.unsafeIndex tree v $ \j u ->
            if u == p
            then return j
            else do
                k <- dfs u v (d + 1) j
                UM.unsafeWrite eulertour k v
                UM.unsafeWrite depth k d
                return $ k + 1

    EulerTour
        <$> U.unsafeFreeze eulertour
        <*> U.unsafeFreeze idx

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

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

parseInt2 :: Parser (Int, Int)
parseInt2 = runStateT $
    (,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)

parseInt3 :: Parser (Int, Int, Int)
parseInt3 = runStateT $
    (,,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)

parseInt4 :: Parser (Int, Int, Int, Int)
parseInt4 = runStateT $
    (,,,) <$> StateT (C.readInt . C.dropWhile isSpace)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)
        <*> StateT (C.readInt . B.unsafeTail)


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Monad hiding (join)
import Data.Maybe
import Debug.Trace
import Data.List (foldl')
import qualified Data.Map.Strict as Map
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Set as Set
import qualified Data.IntSet as IntSet
import Data.Functor
-- import Data.Array
import Data.Array.Unboxed
import Control.Monad.ST
import Data.Array.ST
import qualified Data.ByteString.Char8 as B
read2dInts = map (map (fst . fromJust . B.readInt) . B.words) . B.lines <$> B.getContents :: IO [[Int]]

type Edge = (Int, Int, Int)
type Edges = Set.Set Edge

from :: Edge -> Int
from (f, _, _) = f

to :: Edge -> Int
to (_, t, _) = t

weight :: Edge -> Int
weight (_, _, w) = w

-- weightedEdge :: Int -> Int -> Int -> WeightedEdge
-- weightedEdge f t w = ((f, t), w)

data Graph = Graph Int (Map.Map Int Edges)
  deriving (Show)

empty :: Int -> Graph
empty v = Graph v Map.empty

addEdge :: Edge -> Graph -> Graph
addEdge edge (Graph v mp) = Graph v $
  Map.insertWith Set.union (from edge) (Set.singleton edge) mp

adj :: Int -> Graph -> Edges
adj i (Graph _ mp) = mp Map.! i

edges :: Graph -> Edges
edges (Graph _ mp)= Set.unions . Map.elems $ mp

-- number of vertices
vertices :: Graph -> Int
vertices (Graph vv _) = vv

-- fromInput :: [[from, to, weight]] -> Graph
fromInput :: Int -> [[Int]] -> Graph
fromInput v = foldl' (\graph (a:b:c:_) -> addEdge (a, b, c) graph) (empty v)

bellmanFord :: Int -> Graph -> UArray Int Int
bellmanFord start graph = runSTUArray $ do
  let v = vertices graph
  dist <- newArray (1, v) (inf :: Int)
  -- dist <- thaw initial
  writeArray dist start 0
  forM_ [1..v] $ \_ -> do
    forM_ (edges graph) (flip relaxEdge dist)
  return dist

-- relaxEdge :: Edge -> UArray Int Int -> ST s (STUArray t Int Int)
relaxEdge :: MArray a Int m => Edge -> a Int Int -> m (a Int Int)
relaxEdge e dist = do
  f <- readArray dist $ from e
  t <- readArray dist $ to e
  if f == inf
    then return ()
    else writeArray dist (to e) $ min (f + weight e) t
  return dist

inf :: Int
inf = 10^10

detect :: Int -> Graph -> UArray Int Int -> UArray Int Int
detect start graph initial = runSTUArray $ do
  let v = vertices graph
  -- dist <- newArray (1, v) (maxBound :: Int)
  dist <- thaw initial
  forM_ [1..v] $ \_ -> do
    forM_ (edges graph) $ \e -> do
        f <- readArray dist $ from e
        t <- readArray dist $ to e
        if (f /= inf) && (f + weight e < t)
          then writeArray dist (to e) $ negate inf
          else return ()
        return dist
  return dist

-- ABC137 E - Coins Respawn
main :: IO ()
main = do
  (n:m:p:_) <- map read . words <$> getLine :: IO [Int]
  -- abcs <- replicateM m $ map read . words <$> getLine :: IO [[Int]]
  abcs <- read2dInts
  print $ solve n m p abcs

solve n m p abcs = if hasEffectiveNegativeCycle then -1 else  max 0 . negate . (!n) $ dist
  where
    graph = fromInput n . map (\[a,b,c] -> [a,b,p-c] ) $ abcs
    dist = bellmanFord 1 graph :: UArray Int Int
    test = detect 1 graph dist
    hasEffectiveNegativeCycle = test!n <= negate inf

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

Score : 500 points

Problem Statement

There is a directed graph with N vertices numbered 1 to N and M edges.
The i-th edge is directed from Vertex A_i to Vertex B_i, and there are C_i coins placed along that edge.
Additionally, there is a button on Vertex N.

We will play a game on this graph.
You start the game on Vertex 1 with zero coins, and head for Vertex N by traversing the edges while collecting coins.
It takes one minute to traverse an edge, and you can collect the coins placed along the edge each time you traverse it.
As usual in games, even if you traverse an edge once and collect the coins, the same number of coins will reappear next time you traverse that edge, which you can collect again.

When you reach Vertex N, you can end the game by pressing the button. (You can also choose to leave Vertex N without pressing the button and continue traveling.)
However, when you end the game, you will be asked to pay T \times P coins, where T is the number of minutes elapsed since the start of the game. If you have less than T \times P coins, you will have to pay all of your coins instead.

Your score will be the number of coins you have after this payment.
Determine if there exists a maximum value of the score that can be obtained. If the answer is yes, find that maximum value.

Constraints

2 \leq N \leq 2500

1 \leq M \leq 5000

1 \leq A_i, B_i \leq N

1 \leq C_i \leq 10^5

0 \leq P \leq 10^5

All values in input are integers.

Vertex N can be reached from Vertex 1.

Input

Input is given from Standard Input in the following format:

N M P
A_1 B_1 C_1
:
A_M B_M C_M

Output

If there exists a maximum value of the score that can be obtained, print that maximum value; otherwise, print -1.

Sample Input 1

3 3 10
1 2 20
2 3 30
1 3 45

Sample Output 1

35

There are two ways to travel from Vertex 1 to Vertex 3:

Vertex 1 \rightarrow 2 \rightarrow 3: You collect 20 + 30 = 50 coins on the way. After two minutes from the start of the game, you press the button, pay 2 \times 10 = 20 coins, and you have 50 - 20 = 30 coins left.

Vertex 1 \rightarrow 2: You collect 45 coins on the way. After one minute from the start of the game, you press the button, pay 1 \times 10 = 10 coins, and you have 45 - 10 = 35 coins left.

Thus, the maximum score that can be obtained is 35.

Sample Input 2

2 2 10
1 2 100
2 2 100

Sample Output 2

-1

The edge extending from Vertex 1 takes you to Vertex 2. If you then traverse the edge extending from Vertex 2 to itself t times and press the button, your score will be 90 + 90t. Thus, you can infinitely increase your score, which means there is no maximum value of the score that can be obtained.

Sample Input 3

4 5 10
1 2 1
1 4 1
3 4 1
2 2 100
3 3 100

Sample Output 3

0

There is no way to travel from Vertex 1 to Vertex 4 other than traversing the edge leading from Vertex 1 to Vertex 4 directly. You will pick up one coin along this edge, but after being asked to paying 10 coins, your score will be 0.

Note that you can collect an infinite number of coins if you traverse the edge leading from Vertex 1 to Vertex 2, but this is pointless since you can no longer reach Vertex 4 and end the game.

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.


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Monad hiding (join)
import Data.Maybe
import Debug.Trace
import Data.List (foldl')
import qualified Data.Map.Strict as Map
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Set as Set
import qualified Data.IntSet as IntSet
import Data.Functor
-- import Data.Array
import Data.Array.Unboxed
import Control.Monad.ST
import Data.Array.ST
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
read2dInts = map (map (fst . fromJust . B.readInt) . B.words) . B.lines <$> B.getContents :: IO [[Int]]

type Edge = (Int, Int, Int)
type Edges = Set.Set Edge

from :: Edge -> Int
from (f, _, _) = f

to :: Edge -> Int
to (_, t, _) = t

weight :: Edge -> Int
weight (_, _, w) = w

-- weightedEdge :: Int -> Int -> Int -> WeightedEdge
-- weightedEdge f t w = ((f, t), w)

data Graph = Graph Int (Map.Map Int Edges)
  deriving (Show)

empty :: Graph
empty = Graph 0 Map.empty

addEdge :: Edge -> Graph -> Graph
addEdge edge (Graph v mp) = Graph (v + 1) $
  Map.insertWith Set.union (from edge) (Set.singleton edge) mp

adj :: Int -> Graph -> Edges
adj i (Graph _ mp) = mp Map.! i

edges :: Graph -> Edges
edges (Graph _ mp)= Set.unions . Map.elems $ mp

-- number of vertices
vertices :: Graph -> Int
vertices (Graph vv _) = vv

-- fromInput :: [[from, to, weight]] -> Graph
fromInput :: [[Int]] -> Graph
fromInput = foldl' (\graph (a:b:c:_) -> addEdge (a, b, c) graph) empty

bellmanFord :: Int -> Graph -> UArray Int Int -> UArray Int Int
bellmanFord start graph initial = runSTUArray $ do
  let v = vertices graph
  -- dist <- newArray (1, v) (maxBound :: Int)
  dist <- thaw initial
  writeArray dist start 0
  forM_ [1..v] $ \_ -> do
    forM_ (edges graph) (flip relaxEdge dist)
  return dist

-- relaxEdge :: Edge -> UArray Int Int -> ST s (STUArray t Int Int)
relaxEdge :: MArray a Int m => Edge -> a Int Int -> m (a Int Int)
relaxEdge e dist = do
  f <- readArray dist $ from e
  t <- readArray dist $ to e
  if f == inf
    then return ()
    else writeArray dist (to e) $ min (f + weight e) t
  return dist

inf :: Int
inf = maxBound `div` 10

-- ABC137 E - Coins Respawn
main :: IO ()
main = do
  (n:m:p:_) <- map read . words <$> getLine :: IO [Int]
  -- abcs <- replicateM m $ map read . words <$> getLine :: IO [[Int]]
  abcs <- read2dInts
  print $ solve n m p abcs

solve n m p abcs = if hasNegativeCycle then -1 else  max 0 . negate . (!n) $ dist
  where
    graph = fromInput . map (\[a,b,c] -> [a,b,p-c] ) $ abcs
    dist = bellmanFord 1 graph $ listArray (1, n) (replicate n inf) :: UArray Int Int
    test = bellmanFord 1 graph dist
    hasNegativeCycle = dist!n /= test!n


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Monad hiding (join)
import Data.Maybe
import Debug.Trace
import Data.List (foldl')
import qualified Data.Map.Strict as Map
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Set as Set
import qualified Data.IntSet as IntSet
import Data.Functor
-- import Data.Array
import Data.Array.Unboxed
import Control.Monad.ST
import Data.Array.ST

type Edge = (Int, Int, Int)
type Edges = Set.Set Edge

from :: Edge -> Int
from (f, _, _) = f

to :: Edge -> Int
to (_, t, _) = t

weight :: Edge -> Int
weight (_, _, w) = w

data Graph = Graph Int (Map.Map Int Edges)
  deriving (Show)

empty :: Graph
empty = Graph 0 Map.empty

addEdge :: Edge -> Graph -> Graph
addEdge edge (Graph v mp) = Graph (v + 1) $
  Map.insertWith Set.union (from edge) (Set.singleton edge) mp

adj :: Int -> Graph -> Edges
adj i (Graph _ mp) = mp Map.! i

edges :: Graph -> Edges
edges (Graph _ mp)= Set.unions . Map.elems $ mp

-- number of vertices
vertices :: Graph -> Int
vertices (Graph vv _) = vv

-- fromInput :: [[from, to, weight]] -> Graph
fromInput :: [[Int]] -> Graph
fromInput = foldl' (\graph (a:b:c:_) -> addEdge (a, b, c) graph) empty

bellmanFord :: Int -> Graph -> UArray Int Int -> UArray Int Int
bellmanFord start graph initial = runSTUArray $ do
  let v = vertices graph
  -- dist <- newArray (1, v) (maxBound :: Int)
  dist <- thaw initial
  writeArray dist start 0
  forM_ [1..v] $ \_ -> do
    loopEdges (edges graph) dist
  return dist

loopEdges :: (Foldable t, MArray a Int m) => t Edge -> a Int Int -> m (a Int Int)
loopEdges es dist = do
  forM_ es $ \e -> do
    relaxEdge e dist
  return dist

relaxEdge :: MArray a Int m => Edge -> a Int Int -> m (a Int Int)
relaxEdge e dist = do
  f <- readArray dist $ from e
  t <- readArray dist $ to e
  if f == maxBound
    then return ()
    else writeArray dist (to e) $ min (f + weight e) t
  return dist

-- ABC137 E - Coins Respawn
main :: IO ()
main = do
  (n:m:p:_) <- map read . words <$> getLine :: IO [Int]
  abcs <- replicateM m $ map read . words <$> getLine :: IO [[Int]]
  print $ solve n m p abcs

solve n m p abcs = if hasNegativeCycle then -1 else  max 0 . negate . (!n) $ dist
  where
    graph = fromInput . map (\[a,b,c] -> [a,b,p-c] ) $ abcs
    dist = bellmanFord 1 graph $ listArray (1, n) (replicate n maxBound) :: UArray Int Int
    test = bellmanFord 1 graph dist
    hasNegativeCycle = dist!n /= test!n


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

readInt = fst . fromJust . BS.readInt

readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine

getIntList = readIntList <$> BS.getLine

simulate :: [Int] -> Int -> String
simulate [] b = "Yes"
simulate (h:hs) b | h - b >= 2 = simulate hs (h - 1)
                  | h - b == 1 || h - b == 0 = simulate hs b
                  | otherwise = "No"

main = do
  n <- getInt
  hs <- getIntList
  putStrLn $ simulate hs (head hs)

Score : 300 points

Problem Statement

There are N squares arranged in a row from left to right. The height of the i-th square from the left is H_i.

For each square, you will perform either of the following operations once:

Decrease the height of the square by 1.

Do nothing.

Determine if it is possible to perform the operations so that the heights of the squares are non-decreasing from left to right.

Constraints

All values in input are integers.

1 \leq N \leq 10^5

1 \leq H_i \leq 10^9

Input

Input is given from Standard Input in the following format:

N
H_1 H_2 ... H_N

Output

If it is possible to perform the operations so that the heights of the squares are non-decreasing from left to right, print Yes; otherwise, print No.

Sample Input 1

5
1 2 1 1 3

Sample Output 1

Yes

You can achieve the objective by decreasing the height of only the second square from the left by 1.

Sample Input 2

4
1 3 2 1

Sample Output 2

No

Sample Input 3

5
1 2 3 4 5

Sample Output 3

Yes

Sample Input 4

1
1000000000

Sample Output 4

Yes


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

readInt = fst . fromJust . BS.readInt

readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine

getIntList = readIntList <$> BS.getLine

simulate :: [Int] -> String
simulate [h] = "Yes"
simulate (h0 : h1 : [])
  | h0 - h1 <= 1 = "Yes"
  | otherwise = "No"
simulate (h0 : h1 : h2 : [])
  | h1 > h0 && h1 - h2 == 1 = "Yes"
  | h1 >= h0 && h2 >= h1 = "Yes"
  | otherwise = "No"
simulate (h0 : h1 : h2 : h3 : [])
  | h1 > h0 && h1 - h2 == 1 && h3 >= h2 = "Yes"
  | h1 > h0 && h2 > h1 = simulate (h1:h2:h3:[])
  | otherwise = "No"
simulate (h0 : h1 : h2 : h3 : h4 : hs)
  | h1 > h0 && h1 - h2 == 1 && h3 >= h2 && h4 >= h3 = simulate (h4 :hs)
  | h1 >= h0 && h2 >= h1 = simulate (h1 : h2 : h3 : hs)
  | otherwise = "No"

main = do
  n <- getInt
  hs <- getIntList
  putStrLn $ simulate hs


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

readInt = fst . fromJust . BS.readInt

readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine

getIntList = readIntList <$> BS.getLine

simulate :: [Int] -> String
simulate [h] = "Yes"
simulate (h0 : h1 : [])
  | h0 - h1 <= 1 = "Yes"
  | otherwise = "No"
simulate (h0 : h1 : h2 : [])
  | h1 > h0 && h1 - h2 <= 1 = "Yes"
  | otherwise = "No"
simulate (h0 : h1 : h2 : h3 : hs)
  | h1 > h0 && h1 - h2 == 1 && h3 >= h2 = simulate (h3 : hs)
  | h1 >= h0 && h2 >= h1 = simulate (h1 : h2 : h3 : hs)
  | otherwise = "No"

main = do
  n <- getInt
  hs <- getIntList
  putStrLn $ simulate hs


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

readInt = fst . fromJust . BS.readInt

readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine

getIntList = readIntList <$> BS.getLine

simulate :: [Int] -> String
simulate [h] = "Yes"
simulate (h0 : h1 : [])
  | h1 > h0 || h0 - h1 == 1 = "Yes"
  | otherwise = "No"
simulate (h0 : h1 : h2 : [])
  | h1 > h0 && h1 - h2 <= 1 = "Yes"
  | otherwise = "No"
simulate (h0 : h1 : h2 : h3 : hs)
  | h1 > h0 && h1 - h2 == 1 && h3 >= h2 = simulate (h3 : hs)
  | h1 > h0 && h2 > h1 = simulate (h1 : h2 : hs)
  | otherwise = "No"

main = do
  n <- getInt
  hs <- getIntList
  putStrLn $ simulate hs


import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

--Input functions with ByteString
readInt = fst . fromJust . BS.readInteger
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

decrease :: [Integer] -> Bool
decrease [h] = True
decrease (x:y:hs)
         | x >= y = decrease (y:hs)
         | x >= y - 1 = decrease (y - 1:hs)
         | x < y  = False
         | otherwise = False

buildStairs :: Integer -> [Integer] -> String
buildStairs n h = if decrease (reverse h) then "Yes" else "No"

main = do
     n <- getInt
     h <- getIntList
     putStrLn $buildStairs n h


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

solve xs
    | l == 1 = "Yes"
    | l == 2 = if (VU.last xs) - (VU.head xs) >= (-1) then "Yes" else "No"
    | otherwise = loop xs
        where
            l = VU.length xs
            loop ys
                | VU.length ys <= 2 = "Yes"
                | (x >= y) && (y > z) = "No"
                | otherwise = loop (VU.tail ys)
                    where
                        x = ys VU.! 0
                        y = ys VU.! 1
                        z = ys VU.! 2

main = do
    n <- readLn :: IO Int
    xs <- VU.unfoldrN n (B.readInt . B.dropWhile isSpace) <$> B.getLine
    putStrLn $ solve xs


-- C Build Stairs

import Data.List

main:: IO()
main = do
  l <- getLine
  let n = read l :: Int
  l2 <- getLine
  let a = take n (map read (words l2) :: [Int])
  let ans = solve a
  case ans of
    True -> putStr ("Yes\n")
    False -> putStr ("No\n")

solve:: [Int] -> Bool
solve (x1:x2:xs)
  | (x1 - x2 >= 1) = False
  | (x1 - x2 == 0) = solve (x2:xs)
  | otherwise = solve ((x2 - 1):xs)
solve x = True


{-# LANGUAGE BangPatterns #-}
import qualified Data.Vector.Unboxed as VU
import qualified Data.ByteString.Char8 as BS
import Data.Char (isSpace)
import Control.Applicative ((<$>))

main :: IO ()
main = do
  n <- readLn
  hs <- VU.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
  putStrLn
   $ if VU.foldr
         (\ !h cont !left ->
             case compare left h of
               GT -> False
               EQ -> cont h
               LT -> cont $! h-1)
         (\ !left -> True)
         hs 0
     then "Yes" else "No"


main = do
    _ <- getLine
    arr <- map (read :: String -> Int). words <$> getLine
    print $ if (solve 0 arr True) then "Yes" else "No"
    where
        solve p [] True = True
        solve p [] False = True
        solve p (x:xs) False =
            if x < p
            then
                False
            else
                solve x xs False
        solve p (x:xs) True =
            if x < (p - 1)
            then
                False
            else
                solve x xs (p <= x)


-- Build Stairs
import Data.List

data YesNo = Yes | No deriving Show

upDownMap :: [Int] -> [Int]
upDownMap(x1:(x2:xs)) =  [x2 - x1] ++ upDownMap(x2:xs)
upDownMap(x1:[]) = [x1] ++ upDownMap([])
upDownMap([]) = []

judge :: [Int] -> YesNo
judge a
  | (length $ filter(< -1) $ upDownMap $ a) > 0 = No
  | (length $ filter(\l -> ((length l) > 1)) $ filter(\l -> -1 `elem` l) $ group $ upDownMap $ a) > 0 = No
  | otherwise = Yes

main::IO()
main = do
  n <- words <$> getLine
  h <- words <$> getLine
  let heights = map(\e -> read e :: Int) h
  print $ judge $ heights


-- Build Stairs
import Data.List

upDownMap :: [Int] -> [Int]
upDownMap(x1:(x2:xs)) =  [x2 - x1] ++ upDownMap(x2:xs)
upDownMap(x1:[]) = [x1] ++ upDownMap([])
upDownMap([]) = []

judge :: [Int] -> [Char]
judge a
  | (length $ filter(< -1) $ a) > 0 = "No"
  | (length $ filter(\l -> ((length l) > 1)) $ filter(\l -> -1 `elem` l) $ group $ upDownMap $ a) > 0 = "No"
  | otherwise = "Yes"

main::IO()
main = do
  n <- words <$> getLine
  h <- words <$> getLine
  let heights = map(\e -> read e :: Int) h
  print  $ judge $ heights


import Control.Monad

main :: IO ()
main = do
  _ <- getLine
  n <- map read . words <$> getLine
  putStrLn $ solve n

solve :: [Int] -> [Char]
solve n
  | length n == 1 = "Yes"
  | otherwise =
    if myCheck (head n) (tail n)
      then "Yes"
      else "No"

myCheck :: Int -> [Int] -> Bool
myCheck h t
  | length t == 0 = True
  | otherwise =
    if h > head t + 1
      then False
      else myCheck (head t) (tail t)


import Control.Monad

main :: IO ()
main = do
  _ <- getLine
  n <- map read . words <$> getLine
  putStrLn $ solve n

solve :: [Int] -> [Char]
solve n
  | length n == 1 = "Yes"
  | otherwise =
    if myCheck (head n) (tail n)
      then "Yes"
      else "No"

myCheck :: Int -> [Int] -> Bool
myCheck h t
  | length t == 0 = True
  | otherwise =
    if h > head t + 1
      then myCheck (head t) (tail t)
      else False


-- [Char]あるいは String を Int にする
toInt :: (String -> Int)
toInt x = read x ::Int

--入力を受け取り、[Int]にする
getInts = do
  x <- getLine
  let y = (map$toInt)$words x -- 半角スペースで分割してInt にする
  return y

main = do
  _ <- getInts
  x <- getInts

  if ok x 10^9 == 1
    then print "Yes"
    else print "No"
  where
    ok x n =
      if null x
        then 1
        else if last x <= (n + 1)
          then ok (init x) $ min n $ last x
          else 0


import Data.Maybe
import Control.Monad
import qualified Data.ByteString.Char8 as C

readInt' = fst.fromJust.C.readInt
readLnInt = map readInt'.C.words<$>C.getLine
readCsInt n = concat<$>replicateM n readLnInt

x ? (a,b) = if x then a else b

main = do
 getLine
 inputs <- readLnInt
 putStr $ solve inputs

solve s = (check$reverse s)?("Yes","No")

check (a:b)
 | null b = True
 | head b-a == 1 = True
 | a<head b = False
check s@(a:b:x)
 | b-a == 1 = check (a:x)
 | a<b = False
 | otherwise = check (b:x)


import Data.Maybe
import Control.Monad
import qualified Data.ByteString.Char8 as C

readInt' = fst.fromJust.C.readInt
readLnInt = map readInt'.C.words<$>C.getLine
readCsInt n = concat<$>replicateM n readLnInt

x ? (a,b) = if x then a else b

main = do
 getLine
 inputs <- readLnInt
 putStr $ solve inputs

solve s = (check 0 s)?("Yes","No")

check _ [] = True
check _ [a] = True
check 1 (a:as)
 | a-1 == head as = check 2 as
 | otherwise = False
check 3 s@(a:as)
 | alltaller s = check 2 as
 | otherwise = False
check n s@(a:as)
 | a>head as = check (n+1) s
 | otherwise = check n as

alltaller (a:b) = (null b)?(True,True)
alltaller (a:b:as) = (a-1>b)?(False,alltaller (b:as))


import Data.Maybe
import Control.Monad
import qualified Data.ByteString.Char8 as C

readInt' = fst.fromJust.C.readInt
readLnInt = map readInt'.C.words<$>C.getLine
readCsInt n = concat<$>replicateM n readLnInt

x ? (a,b) = if x then a else b

main = do
 getLine
 inputs <- readLnInt
 putStr $ solve inputs

solve s = (check 0 s)?("Yes","No")

check _ [] = True
check _ [a] = True
check 1 (a:as)
 | a-1 == head as = check 2 as
 | otherwise = False
check 3 s@(a:as)
 | alltaller s = check 2 as
 | otherwise = False
check n s@(a:as)
 | a>head as = check (n+1) s
 | otherwise = check n as

alltaller (a:as) = (a-1>head as)?(False,(null as)?(True,alltaller as))


import Data.Maybe
import Control.Monad
import qualified Data.ByteString.Char8 as C

readInt' = fst.fromJust.C.readInt
readLnInt = map readInt'.C.words<$>C.getLine
readCsInt n = concat<$>replicateM n readLnInt

x ? (a,b) = if x then a else b

main = do
 getLine
 inputs <- readLnInt
 putStr $ solve inputs

solve s = (check 0 s)?("Yes","No")

check _ [] = True
check _ [a] = True
check 1 (a:as)
 | a-1 == head as = check 2 as
 | otherwise = False
check 3 (a:as)
 | any (a-1>) as = False
 | otherwise = check 2 as
check n s@(a:as)
 | a>head as = check (n+1) s
 | otherwise = check n as


import Data.Maybe
import Control.Monad
import qualified Data.ByteString.Char8 as C

readInt' = fst.fromJust.C.readInt
readLnInt = map readInt'.C.words<$>C.getLine
readCsInt n = concat<$>replicateM n readLnInt

x ? (a,b) = if x then a else b

main = do
 getLine
 inputs <- readLnInt
 putStr $ solve inputs

solve s = (check 0 s)?("Yes","No")

check _ [] = True
check _ [a] = True
check 1 (a:as)
 | a-1 == head as = check 2 as
 | otherwise = False
check 3 (a:as) = False
check n s@(a:as)
 | a>head as = check (n+1) s
 | otherwise = check n as


module Main where

import Data.List
import Control.Monad
import Debug.Trace
import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromJust)

readTuple2 :: IO (Int, Int)
readTuple2 = do
    [a, b] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b)

readTuple3 :: IO (Int, Int, Int)
readTuple3 = do
    [a, b, c] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b, c)

readInt :: IO Int
readInt = fst . fromJust . BC.readInt <$> BC.getLine

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

split :: (a -> Bool) -> [a] -> [[a]]
split f [] = []
split f as = let
    (fo, la) = span f as
    las = case la of
        [] -> []
        xs -> split f $ tail xs
    in
        case fo of
            [] -> las
            xs -> xs : las

solve :: [Int] -> Bool
solve [] = True
solve heights = let
    lastH = last heights
    newList = ( ++ [lastH]) $ tail $ snd $ mapAccumL
                                (\left right -> if left > right then (right, left - 1) else (right, left) )
                                0 heights
    leftAndRight = zip (0: newList) newList
    in
        all (\(left, right) -> right >= left) leftAndRight

main = do
    _ <- readInt
    heights <- readInts
    putStrLn $ if solve heights then "Yes" else "No"


main = do
 [l,r] <- map read . words <$> getLine :: IO [Int]
 print $ minimum $ [(i * j) `mod` 2019 | i <- [l..r], j <- [l..r], j > i ]

Score : 300 points

Problem Statement

You are given two non-negative integers L and R.
We will choose two integers i and j such that L \leq i < j \leq R.
Find the minimum possible value of (i \times j) \mbox{ mod } 2019.

Constraints

All values in input are integers.

0 \leq L < R \leq 2 \times 10^9

Input

Input is given from Standard Input in the following format:

L R

Output

Print the minimum possible value of (i \times j) \mbox{ mod } 2019 when i and j are chosen under the given condition.

Sample Input 1

2020 2040

Sample Output 1

2

When (i, j) = (2020, 2021), (i \times j) \mbox{ mod } 2019 = 2.

Sample Input 2

4 5

Sample Output 2

20

We have only one choice: (i, j) = (4, 5).


import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import qualified Data.Vector.Unboxed.Mutable as VUM

readInt = fromIntegral . fst . fromJust . BS.readInteger
readIntList = map readInt . BS.words

getIntList = readIntList <$> BS.getLine

sim l l' r m | l' > r = m
             | m == (-1) = sim l (l'+1) r m'
             | m' < m = sim l (l'+1) r m'
             | otherwise = sim l (l' + 1) r m
             where
              m' = (l * l') `mod` 2019

simulate l r m | l == r = m
               | otherwise = simulate (l+1) r m'
               where
                m' = sim l (l+1) r m

main = do
  [l, r] <- getIntList
  if r >= l + 2019
    then print 0
    else do
      let l' = l `mod` 2019
      let r' = r `mod` 2019
      let s | r' == l' + 1 = (r' * l') `mod` 2019
            | l' > r' = 0
            | otherwise = simulate l' r' (-1)
      print s


--{-# LANGUAGE BangPatterns #-}
--{-# LANGUAGE ScopedTypeVariables #-}
--{-# LANGUAGE FlexibleContexts #-}
--{-# LANGUAGE ViewPatterns #-}
--{-# LANGUAGE OverloadedStrings #-}
--{-# LANGUAGE Strict #-}
--{-# LANGUAGE NumericUnderscores #-}
--{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}

import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BC
import qualified Data.Map.Strict as MPS
import qualified Data.Map as MP
import qualified Data.Set as ST
import qualified Data.Sequence as SQ
import Data.Array
-- import Data.Array.Unboxed
import Data.Array.ST
import Data.Array.IO
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Char
import Data.Bits
import Data.List
import Data.Tuple
import Data.Functor
import Data.IORef
import Data.STRef
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Control.Monad.State.Strict
import Debug.Trace

#if __GLASGOW_HASKELL__ >= 808
import qualified Data.OrdPSQ as PSQ
import qualified Data.Vector.Algorithms.Merge as VAM
import qualified Data.Heap as HP
import Numeric.Extra
import Data.Tuple.Extra
import Data.List.Extra

data OrdQ = Ascending | Descending
#endif

---------------------------------------------------------------------------
main=do
    [l,r]<-sLineToIntL
    print $
        if  | r-l>=2019 -> 0
            | otherwise -> minimum [(i `mod` 2019) * (j `mod` 2019) `mod` 2019 | i<-[l..r-1], j<-[i+1..r]]
--------------------------------------------------------------------------

-- Input Util
int :: IO Int
int = bsToInt <$> BC.getLine

double :: IO Double
double = bsToDouble <$> BC.getLine

str :: IO String
str = BC.unpack <$> BC.getLine

strBS :: IO BC.ByteString
strBS = BC.getLine

-- convert
bsToInt :: BC.ByteString -> Int
bsToInt = fst . fromJust . BC.readInt

bsToDouble :: BC.ByteString -> Double
bsToDouble = read . BC.unpack

bsToIntTuple :: BC.ByteString -> (Int, Int)
bsToIntTuple bs = (a,b)
    where
        Just (a,bs') = parseInt bs
        Just (b,_) = parseInt bs'

bsToIntTriple :: BC.ByteString -> (Int, Int, Int)
bsToIntTriple bs = (a,b,c)
    where
        Just (a,bs') = parseInt bs
        Just (b,bs'') = parseInt bs'
        Just (c,_) = parseInt bs''

parseInt :: BC.ByteString -> Maybe (Int, BC.ByteString)
parseInt = BC.readInt . BC.dropWhile isSpace

-- single line
fromSLineL :: (BC.ByteString -> a) -> IO [a]
fromSLineL f =  map f . BC.words <$> strBS

-- from single line to List / VU.Vector
sLineToIntL :: IO [Int]
sLineToIntL = fromSLineL bsToInt

sLineToDoubleL :: IO [Double]
sLineToDoubleL = fromSLineL bsToDouble

sLineToStrL :: IO [String]
sLineToStrL = fromSLineL BC.unpack

sLineToStrBSL :: IO [BC.ByteString]
sLineToStrBSL = fromSLineL id

sLineToIntV :: Int -> IO (VU.Vector Int)
sLineToIntV n = VU.unfoldrN n parseInt <$> BC.getLine

sLineToDoubleV :: IO (VU.Vector Double)
sLineToDoubleV = VU.fromList . map bsToDouble . BC.words <$> BC.getLine

-- multiple lines
fromMLinesL :: Int -> (BC.ByteString -> a) -> IO [a]
fromMLinesL n f = replicateM n (f <$> strBS)

fromMLinesV :: VU.Unbox a => Int -> (BC.ByteString -> a) -> IO (VU.Vector a)
fromMLinesV n f = VU.replicateM n (f <$> strBS)

-- from multiple lines to List / VU.Vector
mLinesToIntL :: Int -> IO [Int]
mLinesToIntL n = fromMLinesL n bsToInt

mLinesToDoubleL :: Int -> IO [Double]
mLinesToDoubleL n = fromMLinesL n bsToDouble

mLinesToStrL :: Int -> IO [String]
mLinesToStrL n = fromMLinesL n BC.unpack

mLinesToStrBSL :: Int -> IO [BC.ByteString]
mLinesToStrBSL n = fromMLinesL n id

mLinesToTupleL :: Int -> IO [(Int, Int)]
mLinesToTupleL n = fromMLinesL n bsToIntTuple

mLinesToTripleL :: Int -> IO [(Int, Int, Int)]
mLinesToTripleL n = fromMLinesL n bsToIntTriple

mLinesToIntV :: Int -> IO (VU.Vector Int)
mLinesToIntV n = fromMLinesV n bsToInt

mLinesToDoubleV :: Int -> IO (VU.Vector Double)
mLinesToDoubleV n = fromMLinesV n bsToDouble

mLinesToTupleV :: Int -> IO (VU.Vector (Int, Int))
mLinesToTupleV n = fromMLinesV n bsToIntTuple

mLinesToTripleV :: Int -> IO (VU.Vector (Int, Int, Int))
mLinesToTripleV n = fromMLinesV n bsToIntTriple

-- output
yesnoL :: Bool -> IO ()
yesnoL cond
    | cond = putStrLn "Yes"
    | otherwise = putStrLn "No"

yesnoU :: Bool -> IO ()
yesnoU cond
    | cond = putStrLn "YES"
    | otherwise = putStrLn "NO"

-- others
strToChr :: String -> Char
strToChr [x] = x

chrToStr :: Char -> String
chrToStr x = [x]

m1 :: Int -> Int
m1 = subtract 1

toDouble :: Int -> Double
toDouble = fromIntegral

toInt :: Double -> Int
toInt = floor

sqToList :: SQ.Seq a -> [a]
sqToList sq =
    case SQ.viewl sq of
        l SQ.:< sq' -> l : sqToList sq'
        SQ.EmptyL -> []

#if __GLASGOW_HASKELL__ >= 808
sortV :: (Ord a, VU.Unbox a) => VU.Vector a -> VU.Vector a
sortV v = VU.create $ do
    w <- VU.thaw v
    VAM.sort w
    return w

buildPQL :: Ord a => OrdQ -> [a] -> PSQ.OrdPSQ Int Int a
buildPQL oq xs =
    case oq of
        Ascending -> f $ zip3 [1..l] [1..l] $ sort xs
        Descending -> f $ zip3  [1..l] (map negate [1..l]) $ sort xs
    where
        l = length xs
        f = foldl' g PSQ.empty
        g acc (k,p,v) = PSQ.insert k p v acc

buildPQV :: (Ord a, VU.Unbox a) => OrdQ -> VU.Vector a -> PSQ.OrdPSQ Int Int a
buildPQV oq xs =
    case oq of
        Ascending -> f $ VU.zip3 (VU.generate l (+1)) (VU.generate l (+1)) $ sortV xs
        Descending -> f $ VU.zip3  (VU.generate l (+1)) (VU.generate l $ negate . (+1)) $ sortV xs
    where
        l = VU.length xs
        f = VU.foldl' g PSQ.empty
        g acc (k,p,v) = PSQ.insert k p v acc
#endif


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
import           Data.Maybe
import           Data.Int
import           Data.List
import           Data.Char
  -- import qualified Data.Vector.Unboxing as VU
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BS
import           Data.List (scanl')
import           Data.IORef
import           Control.Monad
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Control.Applicative
import           Debug.Trace

readInt = BS.readInt . BS.dropWhile isSpace
getVector f = VU.unfoldr f <$> BS.getLine
getIntVector = getVector readInt
getBSVector = getVector BS.uncons

main = do
  (l,r) <- (\vec -> (vec VU.! 0, vec VU.! 1)) <$> getIntVector

  print $ solve l r

solve l r
  | 2019 <= r-(l-1) = 0
  | otherwise = head list
    where
      list = sort [i*j `mod` 2019 | i <- [l..(r-1)], j <- [(i+1)..r]]


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
import           Data.Maybe
import           Data.Int
import           Data.List
import           Data.Char
  -- import qualified Data.Vector.Unboxing as VU
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BS
import           Data.List (scanl')
import           Data.IORef
import           Control.Monad
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Control.Applicative
import           Debug.Trace

readInt = BS.readInt . BS.dropWhile isSpace
getVector f = VU.unfoldr f <$> BS.getLine
getIntVector = getVector readInt
getBSVector = getVector BS.uncons

main = do
  (l,r) <- (\vec -> (vec VU.! 0, vec VU.! 1)) <$> getIntVector

  print $ solve l r

solve l r
  | 2019 <= r-l = 0
  | otherwise = head list
    where
      list = sort [i*j `mod` 2019 | i <- [l..(r-1)], j <- [i..r]]


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
import           Data.Maybe
import           Data.Int
import           Data.List
import           Data.Char
  -- import qualified Data.Vector.Unboxing as VU
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BS
import           Data.List (scanl')
import           Data.IORef
import           Control.Monad
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Control.Applicative
import           Debug.Trace

readInt = BS.readInt . BS.dropWhile isSpace
getVector f = VU.unfoldr f <$> BS.getLine
getIntVector = getVector readInt
getBSVector = getVector BS.uncons

main = do
  (l,r) <- (\vec -> (vec VU.! 0, vec VU.! 1)) <$> getIntVector

  print $ solve l r

solve l r
  | 2019 <= r-l = 0
  | otherwise = if null list then l*(l+1) `mod` 2019 else 0
    where
      list = [x | x <- [l..r], x `mod` 2019 == 0]


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
import           Data.Maybe
import           Data.Int
import           Data.List
import           Data.Char
  -- import qualified Data.Vector.Unboxing as VU
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.ByteString.Char8 as BS
import           Data.List (scanl')
import           Data.IORef
import           Control.Monad
import           Control.Monad.ST
import           Control.Monad.State.Strict
import           Control.Applicative
import           Debug.Trace

readInt = BS.readInt . BS.dropWhile isSpace
getVector f = VU.unfoldr f <$> BS.getLine
getIntVector = getVector readInt
getBSVector = getVector BS.uncons

main = do
  (l,r) <- (\vec -> (vec VU.! 0, vec VU.! 1)) <$> getIntVector

  print $ solve l r

solve l r
  | 2019 <= r-(l-1) = 0
  | otherwise = if null list then l*(l+1) `mod` 2019 else 0
    where
      list = [x | x <- [l..r], x `mod` 2019 == 0]


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module Main where

import           Data.List
import           Control.Monad
import           Debug.Trace
import qualified Data.ByteString.Char8         as BC
import           Data.Maybe                     ( fromJust )
import qualified Data.Set                      as S
import qualified Data.IntMap.Strict            as IM
import qualified Data.IntMap.Lazy            as IML
import qualified Data.Map.Strict               as M
import           Data.Char
import qualified Data.Array.IArray as A
import qualified Data.Array.Unboxed as UA
import Data.Bits
import Control.Monad.State.Strict
import qualified Data.Array.ST as STA
import qualified Data.Array.MArray as MA
import Control.Monad.ST

readTuple2 :: IO (Int, Int)
readTuple2 = do
    [a, b] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b)

readTuple3 :: IO (Int, Int, Int)
readTuple3 = do
    [a, b, c] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b, c)

readInt :: IO Int
readInt = fst . fromJust . BC.readInt <$> BC.getLine

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

split :: (a -> Bool) -> [a] -> [[a]]
split f [] = []
split f as =
    let (fo, la) = span f as
        las      = case la of
            [] -> []
            xs -> split f $ tail xs
    in  case fo of
            [] -> las
            xs -> xs : las

modN = 2019

pow :: Num a => a -> Int -> a
pow base 1 = base
pow base time
    | odd time = let
        a = pow base (div time 2)
        in
        a * a * base
    | otherwise = let
        a = pow base (div time 2)
        in
        a * a

inv :: ModNum -> ModNum
inv a = pow a $ modN - 2

newtype ModNum = ModNum {getInt :: Int} deriving (Show, Eq, Ord)
instance Num ModNum where
    (+) (ModNum a) (ModNum b) = ModNum $ mod (a + b) modN
    (-) (ModNum a) (ModNum b)
            | a < b = (ModNum $ a + modN) - ModNum b
            | otherwise = ModNum $ mod (a - b) modN
    (*) (ModNum a) (ModNum b) = ModNum $ mod (a * b) modN
    abs (ModNum a)
        | a < 0 = abs . ModNum $ a + modN
        | otherwise = ModNum a
    signum (ModNum a) = ModNum $ signum a
    fromInteger i = abs . ModNum . fromIntegral $ mod i (fromIntegral modN)

mDiv :: ModNum -> ModNum -> ModNum
mDiv a b = a * inv b

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

main :: IO ()
main = do
    (l, r) <- readTuple2
    if r - l > 2019 then print 0 else print $ getInt $ minimum $ do
        [a, b] <- comb 2 $ fromIntegral <$> [l..r]
        pure $ a * b


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module Main where

import           Data.List
import           Control.Monad
import           Debug.Trace
import qualified Data.ByteString.Char8         as BC
import           Data.Maybe                     ( fromJust )
import qualified Data.Set                      as S
import qualified Data.IntMap.Strict            as IM
import qualified Data.IntMap.Lazy            as IML
import qualified Data.Map.Strict               as M
import           Data.Char
import qualified Data.Array.IArray as A
import qualified Data.Array.Unboxed as UA
import Data.Bits
import Control.Monad.State.Strict
import qualified Data.Array.ST as STA
import qualified Data.Array.MArray as MA
import Control.Monad.ST

readTuple2 :: IO (Int, Int)
readTuple2 = do
    [a, b] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b)

readTuple3 :: IO (Int, Int, Int)
readTuple3 = do
    [a, b, c] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b, c)

readInt :: IO Int
readInt = fst . fromJust . BC.readInt <$> BC.getLine

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

split :: (a -> Bool) -> [a] -> [[a]]
split f [] = []
split f as =
    let (fo, la) = span f as
        las      = case la of
            [] -> []
            xs -> split f $ tail xs
    in  case fo of
            [] -> las
            xs -> xs : las

modN = 2019

pow :: Num a => a -> Int -> a
pow base 1 = base
pow base time
    | odd time = let
        a = pow base (div time 2)
        in
        a * a * base
    | otherwise = let
        a = pow base (div time 2)
        in
        a * a

inv :: ModNum -> ModNum
inv a = pow a $ modN - 2

newtype ModNum = ModNum {getInt :: Int} deriving (Show, Eq, Ord)
instance Num ModNum where
    (+) (ModNum a) (ModNum b) = ModNum $ mod (a + b) modN
    (-) (ModNum a) (ModNum b)
            | a < b = (ModNum $ a + modN) - ModNum b
            | otherwise = ModNum $ mod (a - b) modN
    (*) (ModNum a) (ModNum b) = ModNum $ mod (a * b) modN
    abs (ModNum a)
        | a < 0 = abs . ModNum $ a + modN
        | otherwise = ModNum a
    signum (ModNum a) = ModNum $ signum a
    fromInteger i = abs . ModNum . fromIntegral $ mod i (fromIntegral modN)

mDiv :: ModNum -> ModNum -> ModNum
mDiv a b = a * inv b

main :: IO ()
main = do
    (l, r) <- readTuple2
    if r - l > 2019 then print 0 else do
        let a : b : xs = sort $ fromIntegral <$> [l..r]
        print $ getInt $ a * b


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module Main where

import           Data.List
import           Control.Monad
import           Debug.Trace
import qualified Data.ByteString.Char8         as BC
import           Data.Maybe                     ( fromJust )
import qualified Data.Set                      as S
import qualified Data.IntMap.Strict            as IM
import qualified Data.IntMap.Lazy            as IML
import qualified Data.Map.Strict               as M
import           Data.Char
import qualified Data.Array.IArray as A
import qualified Data.Array.Unboxed as UA
import Data.Bits
import Control.Monad.State.Strict
import qualified Data.Array.ST as STA
import qualified Data.Array.MArray as MA
import Control.Monad.ST

readTuple2 :: IO (Int, Int)
readTuple2 = do
    [a, b] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b)

readTuple3 :: IO (Int, Int, Int)
readTuple3 = do
    [a, b, c] <- map (fst . fromJust . BC.readInt) . BC.words <$> BC.getLine
    return (a, b, c)

readInt :: IO Int
readInt = fst . fromJust . BC.readInt <$> BC.getLine

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

split :: (a -> Bool) -> [a] -> [[a]]
split f [] = []
split f as =
    let (fo, la) = span f as
        las      = case la of
            [] -> []
            xs -> split f $ tail xs
    in  case fo of
            [] -> las
            xs -> xs : las

modN = 2019

pow :: Num a => a -> Int -> a
pow base 1 = base
pow base time
    | odd time = let
        a = pow base (div time 2)
        in
        a * a * base
    | otherwise = let
        a = pow base (div time 2)
        in
        a * a

inv :: ModNum -> ModNum
inv a = pow a $ modN - 2

newtype ModNum = ModNum {getInt :: Int} deriving (Show, Eq, Ord)
instance Num ModNum where
    (+) (ModNum a) (ModNum b) = ModNum $ mod (a + b) modN
    (-) (ModNum a) (ModNum b)
            | a < b = (ModNum $ a + modN) - ModNum b
            | otherwise = ModNum $ mod (a - b) modN
    (*) (ModNum a) (ModNum b) = ModNum $ mod (a * b) modN
    abs (ModNum a)
        | a < 0 = abs . ModNum $ a + modN
        | otherwise = ModNum a
    signum (ModNum a) = ModNum $ signum a
    fromInteger i = abs . ModNum . fromIntegral $ mod i (fromIntegral modN)

mDiv :: ModNum -> ModNum -> ModNum
mDiv a b = a * inv b

main :: IO ()
main = do
    (l, r) <- readTuple2
    let a : b : xs = sort $ fromIntegral <$> [l..r]
    print $ getInt $ a * b


import           Control.Monad
import qualified Data.Array.IO               as IO
import           Data.Bits
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.Foldable
import           Data.List
import           Data.Maybe
import qualified Data.Sequence               as Seq
import qualified Data.Vector.Unboxed         as V
import qualified Data.Vector.Unboxed.Mutable as VM

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words
getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
getIntVec n = V.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

readInteger = fst . fromJust . BS.readInteger
readIntegerList = map readInteger . BS.words
getInteger = readInteger <$> BS.getLine
getIntegerList = readIntegerList <$> BS.getLine

main = do
  [l, r] <- getIntList
  let r'= min (l + 2020) r
      ans = minimum [x * y `mod` 2019 | x <- [l..(r'-1)], y <- [(x+1)..r']]
  print ans


import           Control.Monad
import qualified Data.Array.IO               as IO
import           Data.Bits
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.Foldable
import           Data.List
import           Data.Maybe
import qualified Data.Sequence               as Seq
import qualified Data.Vector.Unboxed         as V
import qualified Data.Vector.Unboxed.Mutable as VM

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words
getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
getIntVec n = V.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

readInteger = fst . fromJust . BS.readInteger
readIntegerList = map readInteger . BS.words
getInteger = readInteger <$> BS.getLine
getIntegerList = readIntegerList <$> BS.getLine

main = do
  [l, r] <- getIntList
  let r'= min (r + 2020) r
      ans = V.minimum $ V.fromList [x * y `mod` 2019 | x <- [l..(r'-1)], y <- [(x+1)..r']]
  print ans


import           Control.Monad
import qualified Data.Array.IO               as IO
import           Data.Bits
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.Foldable
import           Data.List
import           Data.Maybe
import qualified Data.Sequence               as Seq
import qualified Data.Vector.Unboxed         as V
import qualified Data.Vector.Unboxed.Mutable as VM

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words
getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
getIntVec n = V.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

readInteger = fst . fromJust . BS.readInteger
readIntegerList = map readInteger . BS.words
getInteger = readInteger <$> BS.getLine
getIntegerList = readIntegerList <$> BS.getLine

main = do
  [l, r] <- getIntList
  let r'= min (r + 2020) r

  res <- VM.new 1
  VM.write res 0 (10^9 :: Int)

  forM_ [l..(r-1)] $ \x ->
    forM_ [(l+1)..r] $ \y -> do
      t <- VM.read res 0
      VM.write res 0 (min t (x * y `mod` 2019))

  ans <- VM.read res 0
  print ans


import           Control.Monad
import qualified Data.Array.IO               as IO
import           Data.Bits
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.Foldable
import           Data.List
import           Data.Maybe
import qualified Data.Sequence               as Seq
import qualified Data.Vector.Unboxed         as V
import qualified Data.Vector.Unboxed.Mutable as VM

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words
getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
getIntVec n = V.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

readInteger = fst . fromJust . BS.readInteger
readIntegerList = map readInteger . BS.words
getInteger = readInteger <$> BS.getLine
getIntegerList = readIntegerList <$> BS.getLine

main = do
  [l, r] <- getIntList
  let r'= min (r + 2020) r
      ans = V.minimum $ V.fromList [x * y `mod` 2019 | x <- [l..(r-1)], y <- [(x+1)..r']]
  print ans


import           Control.Monad
import qualified Data.Array.IO               as IO
import           Data.Bits
import qualified Data.ByteString.Char8       as BS
import           Data.Char
import           Data.Foldable
import           Data.List
import           Data.Maybe
import qualified Data.Sequence               as Seq
import qualified Data.Vector.Unboxed         as V
import qualified Data.Vector.Unboxed.Mutable as VM

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words
getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
getIntVec n = V.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

readInteger = fst . fromJust . BS.readInteger
readIntegerList = map readInteger . BS.words
getInteger = readInteger <$> BS.getLine
getIntegerList = readIntegerList <$> BS.getLine

main = do
  [l, r] <- getIntList
  let r'= min (r + 2018) r
      ans = minimum [x * y `mod` 2019 | x <- [l..(r-1)], y <- [(x+1)..r']]
  print ans


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

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

main = do
    [l, r] <- getIntList
    let r' = min r (l + 2018)
    let lr = VU.fromList $ map (`mod` 2019) [l..r']
    print $ minimum [ mod2019 (lr VU.! i) (lr VU.! j)|i <- [0..(VU.length lr - 2)], j <- [i+1..(VU.length lr - 1)]]

mod2019 n m = fm $ (fm n) * (fm m)
    where fm x = x `mod` 2019


import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.List

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

main = do
    [l, r] <- getIntList
    let r' = min r (l + 2018)
    let lr = map (`mod` 2019) [l..r']
    print $ minimum [ mod2019 (lr !! i) (lr !!j)|i <- [0..(length lr - 2)], j <- [i+1..(length lr - 1)]]

mod2019 n m = fm $ (fm n) * (fm m)
    where fm x = x `mod` 2019


main=do
 [l,r]<-map read.words<$>getLine
 print$minimum$[x*y`mod`2019|x<-[l..min(l+2019)r],y<-[x+1..min(l+2019)r]]


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
--atcoder {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoImplicitPrelude #-}

import Prelude
import System.IO
import System.Environment
import System.Exit
import Data.List
import Data.Maybe
import qualified Data.Char as Char
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Control.Monad
--atcoder import qualified Data.Semigroup
import qualified Data.Map as Map
import qualified Data.Set as Set

readInt :: IO Int
--readInt = read <$> getLine
readInt = getLine >>= (return . read)

readInts :: IO [Int]
readInts = map (read :: String -> Int) <$> words <$> getLine

bf :: Int -> Int -> Map.Map (Int, Int) Int -> Int
bf l r mp | l >= r = maxBound :: Int
          | memo /= Nothing = fromJust memo
          | otherwise = minimum [ret, bf (l+1) r new_memo, bf l (r-1) new_memo]
          where ret = mod (l*r) 2019
                memo = Map.lookup (l, r) mp
                new_memo = Map.insert (l, r) ret mp

solve :: Int -> Int -> Int
solve l r = if r - l + 1 >= 2019
            then 0
            else bf l r (Map.empty :: Map.Map (Int, Int) Int)

main :: IO ()
main = do
    lr <- getLine >>= (return . words) >>= (return . map (read :: String -> Int))
    let l = lr !! 0
    let r = lr !! 1
    let ret = solve l r
    print ret


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
--atcoder {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoImplicitPrelude #-}

import Prelude
import System.IO
import System.Environment
import System.Exit
import Data.List
import qualified Data.Char as Char
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Control.Monad
--atcoder import qualified Data.Semigroup
import qualified Data.Map as Map
import qualified Data.Set as Set

readInt :: IO Int
--readInt = read <$> getLine
readInt = getLine >>= (return . read)

readInts :: IO [Int]
readInts = map (read :: String -> Int) <$> words <$> getLine

solve :: Int -> Int -> Int -> Int
solve n a b = min (a*n) b

main :: IO ()
main = do
    lr <- getLine >>= (return . words) >>= (return . map (read :: String -> Int))
    let l = lr !! 0
    let r = lr !! 1
    let upper_bound = min (l + 2 * 2019) r
    let list = sort (map (\x -> mod x 2019) [l .. upper_bound])
--    print list
    let ret = (list !! 0) * (list !! 1)
    print (mod ret 2019)


solove::Int -> Int -> Int
solove l r = minimum [(i*j)| i<-[l..r-1],j<-[i+1..r]]

main::IO ()
main = do
    [l,r] <- map read . words <$> getLine
    let [nl,nr] = map (`mod` 2019) [l,r]
    print $ solove nl nr


solove::Int -> Int -> Int
solove l r = minimum [(i*j) `mod` 2019| i<-[l..r-1],j<-[i+1..r]]

main::IO ()
main = do
    [l,r] <- map read . words <$> getLine
    let [nl,nr] = map (`mod` 2019) [l,r]
    print $ solove nl nr


main::IO ()
main = do
    [l,r] <- map read . words <$> getLine
    let [nl,nr] = [l `mod` 2019,r `mod` 2019]
    let ans = minimum $ map product [[i,j]| i<-[nl..nr],j<-[i+1..nr]]
    print ans


main :: IO ()
main = do
  [l, r] <- map read . words <$> getLine
  print $ solve l r

solve :: Int -> Int -> Int
solve l r | r - l >= 2019 = 0
solve l r | otherwise =
  minimum [(x * y) `mod` 2019 | x <- [l..r-1], y <- [l+1..r]]


main :: IO ()
main = do
  [l, r] <- map read . words <$> getLine
  print $ solve l r

solve :: Int -> Int -> Int
solve l r | r - l >= 2019 = 0
solve l r | otherwise =
  minimum [(x * y) `mod` 2019 | x <- [l..r-1], y <- [l+1, r]]


main :: IO ()
main = do
  [l,r] <- map (read :: String -> Int) . words <$> getLine
  let r_ = mod r 2019
  let l_ = r_ - ((mod r 2019) - (mod l 2019))
  if r-l < 2019 then print (ans l_ r_) else print 0

ans :: Int -> Int -> Int
ans m n = minimum [mod (i*j) 2019 | i <- [m..n], j <- [m..n], i < j]


main :: IO ()
main = do
  [l,r] <- map (read :: String -> Int) . words <$> getLine
  let r_ = mod r 2019
  let l_ = r_ - ((mod r 2019) - (mod l 2019))
  if r-l < 2019 then print (ans l_ r_) else print 1

ans :: Int -> Int -> Int
ans m n = minimum [mod (i*j) 2019 | i <- [m..n], j <- [m..n], i < j]


toInt :: (String -> Int)
toInt x = read x ::Int

main = do
    x <- getLine
    let [l, r] = (map$toInt)$words x
    let i = if (r - l) >= abs (l - 2019)
        then
            2019
        else
            l
    let j = if (i - l) >= 2019
        then
            2019 * (l `div` 2019)
        else
            i + 1
    print ((i * j) `mod` 2019)


import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T

main :: IO ()
main = do
  (l : r : _) <- map unsafeSignedDecimal . T.words <$> T.getLine :: IO [Int]
  print $ f l r

f :: Int -> Int -> Int
f l r | p 673 && p 3 = 0
      | otherwise = (l * (l + 1)) `mod` 2019
  where
    p :: Int -> Bool
    p d = let (m, n) = l `divMod` d in n == 0 || m < r `div` d

unsafeSignedDecimal :: T.Text -> Int
unsafeSignedDecimal s = case T.signed T.decimal s of
  Right (n, _) -> n


import Control.Applicative
import Data.List

solve _ m1 0 = [m1, 0]
solve _ 0 m2 = [0, m2]
solve [] m1 m2 = [m1, m2]
solve (x:xs) m1 m2 = do
  let x' =  x `mod` 2019
  let (m1':m2':_) = sort [m1, m2, x']
  solve xs m1' m2'

main = do
  [l, r] <- (map read).words <$> getLine :: IO [Int]
  let xs = [l..r]
  print $ (`mod` 2019) $ product $ solve (drop 2 xs) ((xs !! 0) `mod` 2019) ((xs !! 1) `mod` 2019)


import Control.Applicative
import Data.List

solve [] m1 m2 = [m1, m2]
solve (x:xs) m1 m2 = do
  let x' =  x `mod` 2019
  let (m1', m2') = if m1 > x' then (x', m1) else (m1, m2)
  solve xs m1' m2'

main = do
  [l, r] <- (map read).words <$> getLine :: IO [Int]
  let xs = [l..r]
  --print $ product $ take 2 $ sort $ map (`mod` 2019) [r..l]
  print $ (`mod` 2019) $ product $ solve (drop 2 xs) ((xs !! 0) `mod` 2019) ((xs !! 1) `mod` 2019)


import Data.Maybe
import Control.Monad
import qualified Data.ByteString.Char8 as C

readInteger' = fst.fromJust.C.readInteger
readLnInteger = map readInteger'.C.words<$>C.getLine
readCsInteger n = concat<$>replicateM n readLnInteger

x ? (a,b) = if x then a else b
half = flip div 2
aliq = ((0==).).mod

main = do
 [l,r] <- readLnInteger
 print $ solve [l,r]

solve [l,r] = minimum' 2019 [mod (i*j) 2019 | i <- [l..r], j <- [l..r], i<j]

minimum' t (a:x) = (null x)?(ans, minimum' ans x) where
  ans = (t<a)?(t,a)


main = do
  [l, r] <- map read . words <$> getLine :: IO [Int]
  let r' = if l + 2019 < r then l + 2019 else r
  print $ minimum [abs (i * j) `mod` 2019| i <- [l..r'], j <- [i..r'], i /= j]


import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.List

toInts :: IO [Int]
toInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

trunc :: Int -> Int -> (Int, Int)
trunc l r = (l, min r (l + 2018))

solver :: Int -> Int -> Int
solver l r =
  if l - r > 2018
    then 0
    else let (l_, r_) = trunc l r
          in minimum [mod (i * j) 2019 | i <- [l_ .. r_], j <- [(i + 1) .. r_]]

main :: IO ()
main = do
  l:r:[] <- toInts
  print $ solver l r


import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.List

toInts :: IO [Int]
toInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

trunc :: Int -> Int -> (Int, Int)
trunc l r = (l, l + (mod (r - l) 2019))

solver :: Int -> Int -> Int
solver l r =
  if l - r > 2018
    then 0
    else let (l_, r_) = trunc l r
          in minimum [mod (i * j) 2019 | i <- [l_ .. r_], j <- [(i + 1) .. r_]]

main :: IO ()
main = do
  l:r:[] <- toInts
  print $ solver l r


import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.List

toInts :: IO [Int]
toInts = unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

trunc :: Int -> Int -> (Int, Int)
trunc l r =
  if l - r <= 2018
    then (l, r)
    else (l, l + (mod (r - l) 2019))

solver :: Int -> Int -> Int
solver l r =
  if l - r > 2018
    then 0
    else let (l_, r_) = trunc l r
          in minimum [mod (i * j) 2019 | i <- [l_ .. r_], j <- [(i + 1) .. r_]]

main :: IO ()
main = do
  l:r:[] <- toInts
  print $ solver l r


import Data.Bits
import Data.List
import Control.Monad
import qualified Data.Vector.Unboxed as V
import Control.Monad.ST
import Data.Maybe (fromMaybe)
import qualified Data.ByteString.Lazy.Char8 as B
import Debug.Trace

check :: [Int] -> [Int] -> Bool
check xs ys = (foldl (\x (y,y') -> x + (y-y')^2) 0 (zip xs ys)) == (((^2) . floor . sqrt . fromIntegral) $ foldl (\x (y,y') -> x + (y-y')^2) 0 (zip xs ys))

main :: IO ()
main = do
  [l,r] <- map read.words <$> getLine :: IO [Int]
  if r-l > 2019 then print 0
    else print $ minimum [ (i*j) `mod` 2019 | i <- [l,l+1..r], j <- [l,l+1..r], i < j]


-- https://github.com/minoki/my-atcoder-solutions
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Char8 as BS

countBCs :: BS.ByteString -> (Int, BS.ByteString)
countBCs s = loop 0 s
  where
    loop !i s | "BC" `BS.isPrefixOf` s = loop (i+1) (BS.drop 2 s)
              | otherwise = (i, s)

parse :: BS.ByteString -> [[(Int, Int)]]
parse s = doParse [] s
  where
    doParse acc s = case BS.uncons s of
      Nothing -> [reverse acc]
      Just ('A', xs) -> let (as, xs') = BS.span (== 'A') xs
                            (bcs, xs'') = countBCs xs'
                        in if bcs == 0
                           then reverse acc : doParse [] xs''
                           else doParse ((BS.length as + 1, bcs) : acc) xs''
      Just (_, xs) -> reverse acc : doParse [] xs

calc :: [(Int, Int)] -> Int
calc xs = loop 0 0 xs
  where
    loop :: Int -> Int -> [(Int,Int)] -> Int
    loop !s !sa [] = s
    loop !s !sa ((a,b):xs) = loop (s + (sa + a) * b) (sa + a) xs

main = do
  s <- BS.getLine
  print $ sum $ map calc $ parse s

Score : 600 points

Problem Statement

You are given a string s consisting of A, B and C.

Snuke wants to perform the following operation on s as many times as possible:

Choose a contiguous substring of s that reads ABC and replace it with BCA.

Find the maximum possible number of operations.

Constraints

1 \leq |s| \leq 200000

Each character of s is A, B and C.

Input

Input is given from Standard Input in the following format:

s

Output

Find the maximum possible number of operations.

Sample Input 1

ABCABC

Sample Output 1

3

You can perform the operations three times as follows: ABCABC → BCAABC → BCABCA → BCBCAA. This is the maximum result.

Sample Input 2

C

Sample Output 2

0

Sample Input 3

ABCACCBABCBCAABCB

Sample Output 3

6


{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import           Data.Monoid
import           Control.Monad
import Data.Array.Unboxed
import Data.Array.Unsafe
import Data.Array.ST
import Data.Array.MArray
import Data.Array.Base
import Control.Monad.ST
import Data.Sequence ((<|), (|>), (><), ViewL(..), ViewR(..), Seq)
import qualified Data.Sequence as S
tuplify2 (x:y:_) = (x,y)
tuplify2 _ = undefined

readInt = fst . fromJust . BS.readInt
readIntTuple = tuplify2 . map readInt . BS.words
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
getIntNList n = map readIntList <$> replicateM (fromIntegral n) BS.getLine
getIntMatrix = map readIntList . BS.lines <$> BS.getContents
getIntTuple = readIntTuple <$> BS.getLine
getIntNTuples n = map readIntTuple <$> replicateM (fromIntegral n) BS.getLine
getIntTuples = map readIntTuple . BS.lines <$> BS.getContents

type Pos = (Int,Int)
type Graph = UArray Pos Char
main = do
    [h,w] <- getIntList
    a <- concatMap (map (/= '#') .BS.unpack) <$> replicateM h BS.getLine
    let grid = listArray ((0,0),(h-1,w-1)) a
        init = S.fromList $ zip [(y,x) | x <- [0..w-1],y <- [0..h-1],not $ grid ! (y,x)] (repeat 0)

    print $ bfs grid init
    return()

next' :: STUArray s Pos Bool -> Pos -> Pos -> ST s (Seq Pos)
next' g (h',w') (y,x) = do
    let list = [(ny,nx) | (dy,dx) <- zip [0,1,0,-1] [1,0,-1,0],let ny=y+dy,let nx=x+dx,0 <= ny && ny <= h' && 0 <= nx && nx <= w']
    vals <- zip list <$> mapM (readArray g) list
    let list' = [p | (p,v) <- vals,v]
    return $ S.fromList list'

bfs :: UArray Pos Bool -> Seq (Pos,Int) -> Int
bfs grid init = runST (do
    g <- unsafeThawSTUArray grid :: ST s (STUArray s Pos Bool)
    f g init)
    where   f :: STUArray s Pos Bool -> Seq (Pos,Int) -> ST s Int
            f !g !seq = case S.viewl seq of
                S.EmptyL  -> return 0
                ((p,d) :< ps) ->
                    do
                        !ne <- next' g (snd $ bounds grid) p
                        let !ne' = S.zip ne (S.replicate 4 (d+1))
                        forM_ ne $ \(ny,nx) -> writeArray g (ny,nx) False
                        !v <- f g (ps><ne')
                        return $ max d v

Score : 300 points

Problem Statement

You are given a grid of squares with H horizontal rows and W vertical columns, where each square is painted white or black.
HW characters from A_{11} to A_{HW} represent the colors of the squares.
A_{ij} is # if the square at the i-th row from the top and the j-th column from the left is black, and A_{ij} is . if that square is white.

We will repeatedly perform the following operation until all the squares are black:

Every white square that shares a side with a black square, becomes black.

Find the number of operations that will be performed.
The initial grid has at least one black square.

Constraints

1 \leq H,W \leq 1000

A_{ij} is # or ..

The given grid has at least one black square.

Input

Input is given from Standard Input in the following format:

H W
A_{11}A_{12}...A_{1W}
:
A_{H1}A_{H2}...A_{HW}

Output

Print the number of operations that will be performed.

Sample Input 1

3 3
...
.#.
...

Sample Output 1

2

After one operation, all but the corners of the grid will be black. After one more operation, all the squares will be black.

Sample Input 2

6 6
..#..#
......
#..#..
......
.#....
....#.

Sample Output 2

3


{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import           Data.Monoid
import           Control.Monad
import Data.Array.Unboxed
import Data.Array.Unsafe
import Data.Array.ST
import Data.Array.MArray
import Data.Array.Base
import Control.Monad.ST
import Data.Sequence ((<|), (|>), (><), ViewL(..), ViewR(..), Seq)
import qualified Data.Sequence as S
tuplify2 (x:y:_) = (x,y)
tuplify2 _ = undefined

readInt = fst . fromJust . BS.readInt
readIntTuple = tuplify2 . map readInt . BS.words
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
getIntNList n = map readIntList <$> replicateM (fromIntegral n) BS.getLine
getIntMatrix = map readIntList . BS.lines <$> BS.getContents
getIntTuple = readIntTuple <$> BS.getLine
getIntNTuples n = map readIntTuple <$> replicateM (fromIntegral n) BS.getLine
getIntTuples = map readIntTuple . BS.lines <$> BS.getContents

type Pos = (Int,Int)
type Graph = UArray Pos Char
main = do
    [h,w] <- getIntList
    a <- map (/= '#') . concatMap BS.unpack <$> replicateM h BS.getLine
    let grid = listArray ((0,0),(h-1,w-1)) a
        init = S.fromList $ zip [(y,x) | x <- [0..w-1],y <- [0..h-1],not $ grid ! (y,x)] (repeat 0)

    print $ bfs grid init
    return()

next' :: STUArray s Pos Bool -> Pos -> Pos -> ST s (Seq Pos)
next' g (h',w') (y,x) = do
    let list = [(ny,nx) | (dy,dx) <- zip [0,1,0,-1] [1,0,-1,0],let ny=y+dy,let nx=x+dx,0 <= ny && ny <= h' && 0 <= nx && nx <= w']
    vals <- zip list <$> mapM (readArray g) list
    let list' = [p | (p,v) <- vals,v]
    return $ S.fromList list'

bfs :: UArray Pos Bool -> Seq (Pos,Int) -> Int
bfs grid init = runST (do
    g <- unsafeThawSTUArray grid :: ST s (STUArray s Pos Bool)
    f g init)
    where   f :: STUArray s Pos Bool -> Seq (Pos,Int) -> ST s Int
            f !g !seq = case S.viewl seq of
                S.EmptyL  -> return 0
                ((p,d) :< ps) ->
                    do
                        !ne <- next' g (snd $ bounds grid) p
                        let !ne' = S.zip ne (S.replicate 4 (d+1))
                        forM_ ne $ \(ny,nx) -> writeArray g (ny,nx) False
                        !v <- f g (ps><ne')
                        return $ max d v


{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import           Data.Monoid
import           Control.Monad
import Data.Array.Unboxed
import Data.Array.ST
import Control.Monad.ST.Strict
import Data.Sequence ((<|), (|>), (><), ViewL(..), ViewR(..), Seq)
import qualified Data.Sequence as S
tuplify2 (x:y:_) = (x,y)
tuplify2 _ = undefined

readInt = fst . fromJust . BS.readInt
readIntTuple = tuplify2 . map readInt . BS.words
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine
getIntNList n = map readIntList <$> replicateM (fromIntegral n) BS.getLine
getIntMatrix = map readIntList . BS.lines <$> BS.getContents
getIntTuple = readIntTuple <$> BS.getLine
getIntNTuples n = map readIntTuple <$> replicateM (fromIntegral n) BS.getLine
getIntTuples = map readIntTuple . BS.lines <$> BS.getContents

type Pos = (Int,Int)
type Graph = UArray Pos Char
main = do
    [h,w] <- getIntList
    a <- concatMap BS.unpack <$> replicateM h BS.getLine
    let grid = listArray ((0,0),(h-1,w-1)) a
        init = S.fromList $ zip [(y,x) | x <- [0..w-1],y <- [0..h-1],grid ! (y,x) == '#'] (repeat 0)
    --print grid
    print $ bfs grid init
    return()

next :: Graph -> Pos -> Seq Pos
next g (y,x) = S.fromList [(ny,nx) | (dy,dx) <- zip [0,1,0,-1] [1,0,-1,0],let ny=y+dy,let nx=x+dx,0 <= ny && ny <= h' && 0 <= nx && nx <= w' && g ! (ny,nx) /= '#']
    where (h',w') = snd $ bounds g

next' :: STUArray s Pos Char -> Pos -> Pos -> ST s (Seq Pos)
next' g (h',w') (y,x) = do
    let list = [(ny,nx) | (dy,dx) <- zip [0,1,0,-1] [1,0,-1,0],let ny=y+dy,let nx=x+dx,0 <= ny && ny <= h' && 0 <= nx && nx <= w']
    vals <- zip list <$> mapM (readArray g) list
    let list' = [p | (p,v) <- vals,v /= '#']
    return $ S.fromList list'

bfs :: UArray Pos Char -> Seq (Pos,Int) -> Int
bfs grid init = runST (do
    g <- thaw grid :: ST s (STUArray s Pos Char)
    f g init)
    where   f :: STUArray s Pos Char -> Seq (Pos,Int) -> ST s Int
            f !g !seq = case S.viewl seq of
                S.EmptyL  -> return 0
                ((p,d) :< ps) ->
                    do
                        !ne <- next' g (snd $ bounds grid) p
                        let !ne' = S.zip ne (S.replicate 4 (d+1))
                        forM_ ne $ \(ny,nx) -> writeArray g (ny,nx) '#'
                        !v <- f g (ps><ne')
                        return $ max d v


{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.Set as Set
import qualified Data.Array.Unboxed as UA
import qualified Data.Vector as V

import qualified Data.ByteString.Char8 as BS

tuplify2 :: [b] -> (b, b)
tuplify2 (x:y:_) = (x,y)
tuplify2 _ = undefined
readInt :: BS.ByteString -> Integer
readInt = fst . fromJust . BS.readInteger
readIntTuple :: BS.ByteString -> (Integer, Integer)
readIntTuple = tuplify2 . map readInt . BS.words

getIntTuple :: IO (Integer, Integer)
getIntTuple = readIntTuple <$> BS.getLine

getByteStringNList :: (Integral a) => a -> IO [BS.ByteString]
getByteStringNList n = replicateM (fromIntegral n) BS.getLine

type Point = (Integer, Integer)
type Block = UA.UArray Point Bool
toBlock :: Integer -> Integer -> [Bool] -> Block
toBlock h w = UA.array ((1,1), (w,h)) . zip [(m, n) | n <- [1..h], m <- [1..w]]

main = do
    (h, w) <- getIntTuple
    wall <- concatMap ((map (=='#')) . BS.unpack) <$> getByteStringNList h
    let block = toBlock h w wall
    print . solve block $ findWall block

solve :: Block -> [Point] -> Integer
solve block ps
  | isAllWall block = 0
  | otherwise = 1 + solve nextB nextP
      where (!nextB, !nextP) = nextBlock block ps

nextBlock :: Block -> [Point] -> (Block, [Point])
nextBlock block ps = ((UA.//) block [(p, True) | p <- nextPs], nextPs)
  where nextPs = filter ((not.id).((UA.!) block)) . filter (UA.inRange (UA.bounds block)) . Set.toList . Set.fromList . concatMap walk $ ps

walk :: Point -> [Point]
walk (px, py) = [(px+dx, py+dy) | (dx,dy) <- [(1,0),(0,1),(-1,0),(0,-1)]]

findWall :: Block -> [Point]
findWall = map fst . filter snd . UA.assocs

isAllWall :: Block -> Bool
isAllWall = all id . UA.elems


import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.Set as Set
import qualified Data.Array.Unboxed as UA
import qualified Data.Vector as V

import qualified Data.ByteString.Char8 as BS

tuplify2 :: [b] -> (b, b)
tuplify2 (x:y:_) = (x,y)
tuplify2 _ = undefined
readInt :: BS.ByteString -> Integer
readInt = fst . fromJust . BS.readInteger
readIntTuple :: BS.ByteString -> (Integer, Integer)
readIntTuple = tuplify2 . map readInt . BS.words

getIntTuple :: IO (Integer, Integer)
getIntTuple = readIntTuple <$> BS.getLine

getByteStringNList :: (Integral a) => a -> IO [BS.ByteString]
getByteStringNList n = replicateM (fromIntegral n) BS.getLine

type Point = (Integer, Integer)
type Block = UA.UArray Point Bool
toBlock :: Integer -> Integer -> [Bool] -> Block
toBlock h w = UA.array ((1,1), (w,h)) . zip [(m, n) | n <- [1..h], m <- [1..w]]

main = do
    (h, w) <- getIntTuple
    wall <- concatMap ((map (=='#')) . BS.unpack) <$> getByteStringNList h
    let block = toBlock h w wall
    print . solve block $ findWall block

solve :: Block -> [Point] -> Integer
solve block ps
  | isAllWall block = 0
  | otherwise = 1 + solve nextB nextP
      where (nextB, nextP) = nextBlock block ps

nextBlock :: Block -> [Point] -> (Block, [Point])
nextBlock block ps = ((UA.//) block [(p, True) | p <- nextPs], nextPs)
  where nextPs = filter ((not.id).((UA.!) block)) . filter (UA.inRange (UA.bounds block)) . Set.toList . Set.fromList . concatMap walk $ ps

walk :: Point -> [Point]
walk (px, py) = [(px+dx, py+dy) | (dx,dy) <- [(1,0),(0,1),(-1,0),(0,-1)]]

findWall :: Block -> [Point]
findWall = map fst . filter snd . UA.assocs

isAllWall :: Block -> Bool
isAllWall = all id . UA.elems


{-# LANGUAGE ScopedTypeVariables #-}

import Data.Array.IO
import Data.Array
import Data.IORef
import Data.List
import Control.Monad
import Control.Applicative
import qualified Data.Sequence as Seq

paint :: IOUArray (Int, Int) Char -> Seq.Seq (Int,Int) -> Seq.Seq (Int,Int) -> IO (Seq.Seq (Int, Int))
paint grid queue newq =
  case Seq.viewl queue of
    Seq.EmptyL -> return newq
    ((y,x) Seq.:< queue') -> do
      ((miny,minx),(maxy,maxx)) <- getBounds grid
      next <- filterM (\(ny,nx) ->
                if (ny < miny || nx < minx || ny > maxy || nx > maxx) then
                  return False
                else do
                  ng <- readArray grid (ny,nx)
                  return (ng /= '#')
                ) [(y-1,x),(y+1,x),(y,x-1),(y,x+1)]
      forM_ next $ \n -> writeArray grid n '#'
      paint grid queue' (foldl' (Seq.|>) newq next)

solve :: IOUArray (Int, Int) Char -> Seq.Seq (Int,Int) -> Int -> IO Int
solve grid black cnt
  | Seq.null black = return cnt
  | otherwise = do
    black' <- paint grid black Seq.empty
    solve grid black' (cnt+1)

main = do
  [h,w] <- map read . words <$> getLine :: IO [Int]
  strs <- replicateM h getLine :: IO [String]
  (grid :: IOUArray (Int, Int) Char) <- thaw $ listArray ((1,1),(h,w)) $ concat strs
  as <- getAssocs grid
  let black = [i | (i,e) <- as, e == '#']
  res <- solve grid (foldl' (Seq.|>) Seq.empty black) (-1)
  print res


{-# LANGUAGE ScopedTypeVariables #-}

import Data.Array.IO
import Data.Array
import Data.IORef
import Control.Monad
import Control.Applicative

paint :: IOUArray (Int, Int) Char -> [(Int,Int)] -> [(Int,Int)] -> IO [(Int,Int)]
paint grid [] newq = return newq
paint grid (p@(y,x):queue) newq = do
  ((miny,minx),(maxy,maxx)) <- getBounds grid
  rd <- readArray grid p
  writeArray grid p '#'
  next <- filterM (\(ny,nx) ->
            if (ny < miny || nx < minx || ny > maxy || nx > maxx) then
              return False
            else do
              ng <- readArray grid (ny,nx)
              return (ng /= '#' && (ny,nx) `notElem` newq)
            ) [(y-1,x),(y+1,x),(y,x-1),(y,x+1)]
  paint grid queue (newq ++ next)

solve :: IOUArray (Int, Int) Char -> [(Int,Int)] -> Int -> IO Int
solve _ [] cnt = return cnt
solve grid black cnt = do
  black' <- paint grid black []
  solve grid black' (cnt+1)

main = do
  [h,w] <- map read . words <$> getLine :: IO [Int]
  strs <- replicateM h getLine :: IO [String]
  (grid :: IOUArray (Int, Int) Char) <- thaw $ listArray ((1,1),(h,w)) $ concat strs
  grid' <- freeze grid
  let black = [i | (i,e) <- assocs grid', e == '#']
  res <- solve grid black (-1)
  print res


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Maybe (mapMaybe, isNothing)
import Data.List (foldl', partition)
import Data.Array.Unboxed ((!), UArray)
import qualified Data.Array.Unboxed as U

main = do
    [h, w] <- map (read :: String -> Int) . words <$> getLine
    -- a <- concat . words <$> getContents
    a <- concat <$> replicateM h getLine
    let ls = U.listArray ((1, 1), (w, h)) a :: UArray (Int, Int) Char
    let (black, white) = partition (\(i, e) -> e == '#') $ U.assocs ls
    let (!blacks, !whites) = (map fst black, map fst white)
    let answer = foldl' (hoge h w blacks) 0 whites
    print answer
    where getRange (ex, ey) (x, y) = abs (ex - x) + abs (ey - y)
          minRange h w blacks !ec = foldl' (hoho ec) (h + w) blacks
          hoge h w blacks a b = max a (minRange h w blacks b)
          hoho ec a b = min a (getRange ec b)


{-# LANGUAGE
  ScopedTypeVariables, BangPatterns, TupleSections, ExplicitForAll,
  LambdaCase, MultiWayIf, Unsafe, RecordWildCards, FlexibleContexts, CPP,
  NoMonomorphismRestriction, GADTs, PatternGuards,
  RankNTypes, EmptyDataDecls, EmptyCase, ViewPatterns #-}
{-# OPTIONS_GHC -O2 #-}

import Data.Bits
import Data.List
import Data.Maybe
import Data.Tuple
import Data.Ord
import Data.Int
import Data.Word
import Data.Char
import Data.Function
import Data.STRef
import Data.IORef
import Data.Monoid
import Data.Functor
import System.IO
import Control.Arrow
import Control.Applicative
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.State.Strict
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
-- import Control.Monad.ST.Safe
import Control.DeepSeq
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.ByteString.Builder as BSB
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IMS
import qualified Data.IntMap.Lazy as IML
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Primitive.Mutable as VPM
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import qualified Data.Primitive as Pr

main :: IO ()
main = do
  [h,w] <- map readInt . words <$> getLine
  mas <- VUM.replicate ((h+2)*(w+2)) False :: IO (VUM.MVector RealWorld Bool)
  VU.forM_ (VU.enumFromStepN (w+3) (w+2) h) $ \ !pre ->
    VU.copy (VUM.unsafeSlice pre w mas)
    =<< VU.map (=='#') . VU.unfoldrN w BS.uncons <$> BS.getLine
  as <- VU.unsafeFreeze mas
  print $ query h w as

query :: Int -> Int -> VU.Vector Bool -> Int
query h w !as = VU.maximum $ VU.slice (w+3) (h*(w+2)-2) checksheet
  where
    checksheet = VU.create $ do
      chksht <- VUM.replicate ((h+2)*(w+2)) (shiftR maxBound 1 :: Int)
      VU.forM_ (VU.enumFromStepN (w+3) (w+2) h) $ \ !p ->
        VU.forM_ (VU.enumFromN p w) $ \ !p ->
        if as VU.! p
          then VUM.write chksht p 0
          else VUM.write chksht p . (+1)
               =<< liftA2 min (VUM.read chksht (p-1))
                              (VUM.read chksht (p-(w+2)))
      VU.forM_ (VU.enumFromStepN ((h+1)*(w+2)-2) (-(w+2)) h) $ \ !p ->
        VU.forM_ (VU.enumFromStepN p (-1) w) $ \ !p ->
        VUM.write chksht p
        =<< liftA2 min
             (VUM.read chksht p)
             ((+1) <$> liftA2 min (VUM.read chksht (p+1))
                                  (VUM.read chksht (p+w+2)))
      VU.forM_ (VU.enumFromStepN (shiftL w 1 + 3) (w+2) (h-1)) $ \ !p -> do
        VUM.write chksht p     0
        VUM.write chksht (p+1) 0
      return chksht

#define IL(f) {-# INLINE f #-}; f

rInt :: StateT BSL.ByteString Maybe Int
IL(rInt) = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
IL(rIntS) = StateT $ BS.readInt . BS.dropWhile (<'!')

-- unlessM, whenM :: (Monad m) => m Bool -> m () -> m ()
IL(whenM) = (. flip when) . (>>=)
IL(unlessM) = (. flip unless) . (>>=)

IL(wrA) = A.writeArray
IL(rdA) = A.readArray
IL(mdA) = \arr f !i -> do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' = \arr f !i -> do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
IL(swapA) = \arr !i !j -> do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define D(f,r,d)\
  IL(f) :: Integral a=>a->d; f=fromIntegral;\
  IL(r) :: String->d; r=read
#define C(f,r,g,h,d) D(f,r,d);\
  g,h :: RealFrac a=>a->d; IL(g)=floor; IL(h)=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,h,a,m)\
  IL(f) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e);\
  f=A.newArray;\
  IL(g) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e);\
  g=A.newArray_;\
  IL(h) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> [e] -> m (a i e);\
  h=A.newListArray
#define C(a,m)
N(newIOA,newIOA_,newIOAL,IOArray,IO)
N(newSTA,newSTA_,newSTAL,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,newIOUAL,IOUArray,IO)
N(newSTUA,newSTUA_,newSTUAL,STUArray s,ST s)
#undef C
#undef N

#undef IL


{-# LANGUAGE
  ScopedTypeVariables, BangPatterns, TupleSections, ExplicitForAll,
  LambdaCase, MultiWayIf, Unsafe, RecordWildCards, FlexibleContexts, CPP,
  NoMonomorphismRestriction, GADTs, PatternGuards,
  RankNTypes, EmptyDataDecls, EmptyCase, ViewPatterns #-}
{-# OPTIONS_GHC -O2 #-}

import Data.Bits
import Data.List
import Data.Maybe
import Data.Tuple
import Data.Ord
import Data.Int
import Data.Word
import Data.Char
import Data.Function
import Data.STRef
import Data.IORef
import Data.Monoid
import Data.Functor
import System.IO
import Control.Arrow
import Control.Applicative
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.State.Strict
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
-- import Control.Monad.ST.Safe
import Control.DeepSeq
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.ByteString.Builder as BSB
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IMS
import qualified Data.IntMap.Lazy as IML
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Primitive.Mutable as VPM
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import qualified Data.Primitive as Pr

main :: IO ()
main = do
  [h,w] <- map readInt . words <$> getLine
  mas <- VUM.replicate ((h+2)*(w+2)) False :: IO (VUM.MVector RealWorld Bool)
  VU.forM_ (VU.enumFromStepN (w+3) (w+2) h) $ \ !pre -> do
    input <- BS.getLine
    forM_ (BS.elemIndices '#' input) $ \ !i ->
      VUM.write mas (pre+i) True
  as <- VU.unsafeFreeze mas
  print $ query h w as

query :: Int -> Int -> VU.Vector Bool -> Int
query h w !as = VU.maximum $ VU.slice (w+3) (h*(w+2)-2) checksheet
  where
    checksheet = VU.create $ do
      chksht <- VUM.replicate ((h+2)*(w+2)) (shiftR maxBound 1 :: Int)
      VU.forM_ (VU.enumFromStepN (w+3) (w+2) h) $ \ !p ->
        VU.forM_ (VU.enumFromN p w) $ \ !p ->
        if as VU.! p
          then VUM.write chksht p 0
          else VUM.write chksht p . (+1)
               =<< liftA2 min (VUM.read chksht (p-1))
                              (VUM.read chksht (p-(w+2)))
      VU.forM_ (VU.enumFromStepN ((h+1)*(w+2)-2) (-(w+2)) h) $ \ !p ->
        VU.forM_ (VU.enumFromStepN p (-1) w) $ \ !p ->
        VUM.write chksht p
        =<< liftA2 min
             (VUM.read chksht p)
             ((+1) <$> liftA2 min (VUM.read chksht (p+1))
                                  (VUM.read chksht (p+w+2)))
      VU.forM_ (VU.enumFromStepN (shiftL w 1 + 3) (w+2) (h-1)) $ \ !p -> do
        VUM.write chksht p     0
        VUM.write chksht (p+1) 0
      return chksht

#define IL(f) {-# INLINE f #-}; f

rInt :: StateT BSL.ByteString Maybe Int
IL(rInt) = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
IL(rIntS) = StateT $ BS.readInt . BS.dropWhile (<'!')

-- unlessM, whenM :: (Monad m) => m Bool -> m () -> m ()
IL(whenM) = (. flip when) . (>>=)
IL(unlessM) = (. flip unless) . (>>=)

IL(wrA) = A.writeArray
IL(rdA) = A.readArray
IL(mdA) = \arr f !i -> do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' = \arr f !i -> do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
IL(swapA) = \arr !i !j -> do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define D(f,r,d)\
  IL(f) :: Integral a=>a->d; f=fromIntegral;\
  IL(r) :: String->d; r=read
#define C(f,r,g,h,d) D(f,r,d);\
  g,h :: RealFrac a=>a->d; IL(g)=floor; IL(h)=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,h,a,m)\
  IL(f) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e);\
  f=A.newArray;\
  IL(g) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e);\
  g=A.newArray_;\
  IL(h) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> [e] -> m (a i e);\
  h=A.newListArray
#define C(a,m)
N(newIOA,newIOA_,newIOAL,IOArray,IO)
N(newSTA,newSTA_,newSTAL,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,newIOUAL,IOUArray,IO)
N(newSTUA,newSTUA_,newSTUAL,STUArray s,ST s)
#undef C
#undef N

#undef IL


import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T
import qualified Data.Vector.Unboxed as V
import qualified Data.IntSet as S
import Data.Bool (bool)

main :: IO ()
main = do
  (h : w : _) <- map unsafeSignedDecimal . T.words <$> T.getLine :: IO [Int]
  let
    encode :: (Int, Int) -> Int
    encode (i, j) = i + h + j
    decode :: Int -> (Int, Int)
    decode n = divMod n h
    shiftU :: Int -> Maybe Int
    shiftU n = let {(i, j) = decode n; i' = pred i} in bool Nothing (Just . encode $ (i', j)) (i' >= 0)
    shiftD :: Int -> Maybe Int
    shiftD n = let {(i, j) = decode n; i' = succ i} in bool Nothing (Just . encode $ (i', j)) (i' < h)
    shiftL :: Int -> Maybe Int
    shiftL n = let {(i, j) = decode n; j' = pred j} in bool Nothing (Just . encode $ (i, j')) (j' >= 0)
    shiftR :: Int -> Maybe Int
    shiftR n = let {(i, j) = decode n; j' = succ j} in bool Nothing (Just . encode $ (i, j')) (j' < w)
    candidates :: Int -> [Int]
    candidates n = [shiftU n, shiftD n, shiftL n, shiftR n] >>= maybe [] pure
  as <- V.fromList . concat . map (T.foldr ((:) . (== '#')) []) . T.lines <$> T.getContents :: IO (V.Vector Bool)
  let
    bijs = filter (as V.!) $ [0..(pred (h * w))] :: [Int]
    n = search 0 bijs (S.fromAscList bijs) :: Int
    search :: Int -> [Int] -> S.IntSet -> Int
    search k targets blacks | null targets' = k
                            | otherwise = search (succ k) targets' blacks'
      where
        (targets', blacks') =  foldr step ([], blacks) . concat . map candidates $ targets
  print n

step :: Int -> ([Int], S.IntSet) -> ([Int], S.IntSet)
step t (ts, bs) = if S.member t bs then (ts, bs) else (t : ts, S.insert t bs)

unsafeSignedDecimal :: T.Text -> Int
unsafeSignedDecimal s = case T.signed T.decimal s of
  Right (n, _) -> n


import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T
import qualified Data.Vector.Unboxed as V
import qualified Data.IntSet as S
import Data.Bool (bool)

main :: IO ()
main = do
  (h : w : _) <- map unsafeSignedDecimal . T.words <$> T.getLine :: IO [Int]
  let
    encode :: (Int, Int) -> Int
    encode (i, j) = i + h + j
    decode :: Int -> (Int, Int)
    decode n = divMod n h
    shiftU :: Int -> Maybe Int
    shiftU n = let {(i, j) = decode n; i' = pred i} in bool Nothing (Just . encode $ (i', j)) (i' >= 0)
    shiftD :: Int -> Maybe Int
    shiftD n = let {(i, j) = decode n; i' = succ i} in bool Nothing (Just . encode $ (i', j)) (i' < h)
    shiftL :: Int -> Maybe Int
    shiftL n = let {(i, j) = decode n; j' = pred j} in bool Nothing (Just . encode $ (i, j')) (j' >= 0)
    shiftR :: Int -> Maybe Int
    shiftR n = let {(i, j) = decode n; j' = succ j} in bool Nothing (Just . encode $ (i, j')) (j' < w)
    candidates :: Int -> [Int]
    candidates n = [shiftU n, shiftD n, shiftL n, shiftR n] >>= maybe [] pure
  as <- V.fromList . concat . map (T.foldr ((:) . (== '#')) []) . T.lines <$> T.getContents :: IO (V.Vector Bool)
  let
    bijs = filter (as V.!) $ [0..(pred (h * w))] :: [Int]
    n = search 0 bijs (S.fromAscList bijs) :: Int
    search :: Int -> [Int] -> S.IntSet -> Int
    search k [] _ = k
    search k targets blacks = search (succ k) targets' blacks'
      where
        (targets', blacks') =  foldr step ([], blacks) . concat . map candidates $ targets
  print n

step :: Int -> ([Int], S.IntSet) -> ([Int], S.IntSet)
step t (ts, bs) = if S.member t bs then (ts, bs) else (t : ts, S.insert t bs)

unsafeSignedDecimal :: T.Text -> Int
unsafeSignedDecimal s = case T.signed T.decimal s of
  Right (n, _) -> n