{-# OPTIONS_GHC -O2 -funbox-strict-fields -cpp #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ForeignFunctionInterface #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Foreign.C.String

#if __GLASGOW_HASKELL__ < 706
import Data.IORef
#else
import Data.IORef hiding (modifyIORef')
#endif

modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}

readInt bs = case B.readInt bs of Just (n,_) -> n

foreign import ccall unsafe "stdio.h printf"
  c_printf_double :: CString -> Double -> IO ()

main = do
  n <- readLn
  qs <- map readInt.B.words <$> B.getContents
  segtree@(Node _ _ aref bref _ _) <- mkSegTree 0 n 0
  fmt <- newCString "%f\n"

  let !len = fromIntegral $ n+1

  let go !cnt (1:a:x:rest) =  do
        updateRange 0 (a-1) (fromIntegral x) segtree
        a <- readIORef aref
        b <- readIORef bref
        c_printf_double fmt $ fromIntegral (a*len+b) / fromIntegral cnt
        go cnt rest
      go !cnt (2:k:rest) = do
        updateKey cnt (fromIntegral k) segtree
        a <- readIORef aref
        b <- readIORef bref
        c_printf_double fmt  $ fromIntegral (a*len+b) / fromIntegral (cnt+1)
        go (cnt+1) rest
      go !cnt (3:rest) = do
        x <- queryKey (cnt-1) segtree
        updateKey (cnt-1) (fromIntegral $ -x) segtree
        a <- readIORef aref
        b <- readIORef bref
        c_printf_double fmt  $ fromIntegral (a*len+b) / fromIntegral (cnt-1)
        go (cnt-1) rest
      go _ _ = return ()
  go 1 qs

data SegTree = Node !Int !Int !(IORef Int64) !(IORef Int64) !SegTree !SegTree
             | Leaf !Int !(IORef Int64)

mkSegTree :: Int -> Int -> Int64 -> IO SegTree
mkSegTree !l !r !x0 = go l r
   where
     go !l !r
       | l<r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           aref <- newIORef x0
           bref <- newIORef x0
           return $! Node l r aref bref lt rt
       | otherwise = do
           !ref <- newIORef x0
           return $! Leaf l ref

updateRange :: Int -> Int -> Int64 -> SegTree -> IO ()
updateRange !kl !kr !x segtree = when (x/=0) $ go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (fromIntegral$min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)
{-# INLINE updateRange #-}

updateKey :: Int -> Int64 -> SegTree -> IO ()
updateKey !key !x segtree = when (x/=0) $ go segtree
   where
     go (Node l r _ bref lt rt) = do
         b <- readIORef bref
         writeIORef bref $! b + x
         if 2*key <= l+r then go lt else go rt
     go (Leaf _ ref) = modifyIORef' ref (x+)
{-# INLINE updateKey #-}

queryRange :: Int -> Int -> SegTree -> IO Int64
queryRange !kl !kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(fromIntegral$r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (fromIntegral$min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0
{-# INLINE queryRange #-}

queryKey :: Int -> SegTree -> IO Int64
queryKey !key segtree = go 0 segtree
   where
     go !acc (Node l r aref bref lt rt) = do
       a <- readIORef aref
       if 2*key <= l+r then go (acc+a) lt else go (acc+a) rt
     go !acc (Leaf _ ref) = do
       r <- readIORef ref
       return $! acc+r
{-# INLINE queryKey #-}

import Data.Bits
import Data.Maybe
import Control.Monad
import Text.Printf
import qualified Data.ByteString.Char8 as B
import Data.Int

data Tree = Node !Int64 !Int64 !Int !Tree !Tree
          | Leaf !Int64
          deriving (Show)

emptyTree :: Int -> Tree
emptyTree 0 = Leaf 0
emptyTree n = Node 0 0 (n-1) (emptyTree (n-1)) (emptyTree (n-1))

append :: Int -> Int64 -> Tree -> Tree
append n x tree = sub tree
    where
        sub (Node _ a d t1 t2)
            | testBit n d = Node (num t1 + num t2') a d t1  t2'
            | otherwise   = Node (num t1'+ num t2 ) a d t1' t2
            where
                t1' = sub t1
                t2' = sub t2
        sub (Leaf _) = Leaf x

num (Node x a d _ _) = x + a * 2^(d+1)
num (Leaf x)       = x

add :: Int -> Int64 -> Tree -> Tree
add n x tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') a d t1' t2'
            | otherwise   = Node (num t1'' + num t2) a d t1'' t2
            where
                t1' = update x t1
                t1''= sub t1
                t2' = sub t2
        sub (Leaf s) = update x (Leaf s)

update x (Node s a d t1 t2) = Node s (a+x) d t1 t2
update x (Leaf s) = Leaf (s+x)

remove :: Int -> Tree -> Tree
remove n tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') 0 d t1' t2'
            | otherwise   = Node (num t1'') 0 d t1'' t2
            where
                t1' = update a t1
                t2'  = sub (update a t2)
                t1'' = sub t1
        sub (Leaf x) = Leaf 0

main :: IO ()
main = do
    n <- B.getLine >>= return . fromMaybe 0 .fmap (fst). B.readInt
    foldM_ query (1,emptyTree 20) [1..n]

query :: (Int,Tree) -> Int -> IO (Int,Tree)
query (n,tree) _ = do
    l <- B.getLine >>= return . map (fromMaybe 0.fmap (fromIntegral. fst) . B.readInt) . B.words
    let (n',tree') = case l of
            [1,a,x] -> (n,add (a-1) (fromIntegral x) tree)
            [2,x]   -> (n+1,append n (fromIntegral x) tree)
            [3]     -> (n-1,remove (n-1) tree)
    B.putStrLn $ B.pack  $ showDouble ((fromIntegral (num tree') / fromIntegral n'):: Double)
    return (n',tree')

showDouble :: Double -> String
showDouble f | f < 0 = "-"++showDouble (-f)
             | otherwise = printf "%d.%07d" frac small
    where
        frac = floor f :: Int64
        small = round ((f - fromIntegral frac)* 10000000) :: Int64

{-# OPTIONS_GHC -O2 -funbox-strict-fields -cpp #-}
{-# LANGUAGE BangPatterns, OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Foreign.C.String

#if __GLASGOW_HASKELL__ < 706
import Data.IORef
#else
import Data.IORef hiding (modifyIORef')
#endif
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}

readInt bs = case B.readInt bs of Just (n,_) -> n

foreign import ccall unsafe "stdio.h printf"
  c_printf_double :: CString -> Double -> IO ()

printDouble :: Double -> IO ()
printDouble x = do
  withCString "%f\n" $ \fmt -> do
    c_printf_double fmt x

data Query = T1 !Int !Int64
           | T2 !Int64
           | T3

parse :: [Int] -> [Query]
parse (1:a:x:rest) = T1 a (fromIntegral x) : parse rest
parse (2:k:rest) = T2 (fromIntegral k) : parse rest
parse (3:rest) = T3 : parse rest
parse _ = []

main = do
  n <- readLn :: IO Int
  qs <- parse.map readInt.B.words <$> B.getContents
  segtree@(Node _ _ aref bref _ _) <- mkSegTree 0 n 0
  cntref <- newIORef 1 :: IO (IORef Int)
  let !len = fromIntegral $ n+1

  let step :: Query -> IO ()
      step (T1 a x) =  do
        updateRange 0 (a-1) x segtree
        cnt <- readIORef cntref
        a <- readIORef aref
        b <- readIORef bref
        printDouble $ fromIntegral (a*len+b) / fromIntegral cnt
      step (T2 k) = do
        cnt <- readIORef cntref
        updateKey cnt k segtree
        cnt <- readIORef cntref
        writeIORef cntref $! cnt+1
        a <- readIORef aref
        b <- readIORef bref
        printDouble $ fromIntegral (a*len+b) / fromIntegral (cnt+1)
      step T3 = do
        cnt <- readIORef cntref
        x <- queryKey (cnt-1) segtree
        updateKey (cnt-1) (fromIntegral$ -x) segtree
        writeIORef cntref $! cnt-1
        a <- readIORef aref
        b <- readIORef bref
        printDouble $ fromIntegral (a*len+b) / fromIntegral (cnt-1)
  mapM_ step qs

data SegTree = Node !Int !Int !(IORef Int64) !(IORef Int64) !SegTree !SegTree
             | Leaf !Int !(IORef Int64)

mkSegTree :: Int -> Int -> Int64 -> IO SegTree
mkSegTree !l !r !x0 = go l r
   where
     go !l !r
       | l<r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           aref <- newIORef x0
           bref <- newIORef x0
           return $! Node l r aref bref lt rt
       | otherwise = do
           !ref <- newIORef x0
           return $! Leaf l ref

updateRange :: Int -> Int -> Int64 -> SegTree -> IO ()
updateRange !kl !kr !x segtree = when (x/=0) $ go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (fromIntegral$min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)
{-# INLINE updateRange #-}

updateKey :: Int -> Int64 -> SegTree -> IO ()
updateKey !key !x segtree = when (x/=0) $ go segtree
   where
     go (Node l r _ bref lt rt) = do
         b <- readIORef bref
         writeIORef bref $! b + x
         if 2*key <= l+r then go lt else go rt
     go (Leaf _ ref) = modifyIORef' ref (x+)
{-# INLINE updateKey #-}

queryRange :: Int -> Int -> SegTree -> IO Int64
queryRange !kl !kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(fromIntegral$r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (fromIntegral$min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0
{-# INLINE queryRange #-}

queryKey :: Int -> SegTree -> IO Int64
queryKey !key segtree = go 0 segtree
   where
     go !acc (Node l r aref bref lt rt) = do
       a <- readIORef aref
       if 2*key <= l+r then go (acc+a) lt else go (acc+a) rt
     go !acc (Leaf _ ref) = do
       r <- readIORef ref
       return $! acc+r
{-# INLINE queryKey #-}

{-# OPTIONS_GHC -O2 -funbox-strict-fields -cpp #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Text.Printf

#if __GLASGOW_HASKELL__ < 706
import Data.IORef
#else
import Data.IORef hiding (modifyIORef')
#endif
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}

readInt bs = case B.readInt bs of Just (n,_) -> n

data Query = T1 !Int !Int64
           | T2 !Int64
           | T3

parse :: [Int] -> [Query]
parse (1:a:x:rest) = T1 a (fromIntegral x) : parse rest
parse (2:k:rest) = T2 (fromIntegral k) : parse rest
parse (3:rest) = T3 : parse rest
parse _ = []

main = do
  n <- readLn :: IO Int
  qs <- parse.map readInt.B.words <$> B.getContents
  segtree <- mkSegTree 0 n 0
  cntref <- newIORef 1 :: IO (IORef Int)

  let step :: Query -> IO Double
      step (T1 a x) =  do
        updateRange 0 (a-1) x segtree
        s <- getRoot segtree
        cnt <- readIORef cntref
        return $! fromIntegral s / fromIntegral cnt
      step (T2 k) = do
        cnt <- readIORef cntref
        updateKey cnt k segtree
        s <- getRoot segtree
        cnt <- readIORef cntref
        writeIORef cntref $! cnt+1
        return $! fromIntegral s / fromIntegral (cnt+1)
      step T3 = do
        cnt <- readIORef cntref
        x <- queryKey (cnt-1) segtree
        updateKey (cnt-1) (fromIntegral$ -x) segtree
        s <- getRoot segtree
        writeIORef cntref $! cnt-1
        return $! fromIntegral s / fromIntegral (cnt-1)
  putStr.unlines.map show <$> mapM step qs

data SegTree = Node !Int !Int !(IORef Int64) !(IORef Int64) !SegTree !SegTree
             | Leaf !Int !(IORef Int64)

mkSegTree :: Int -> Int -> Int64 -> IO SegTree
mkSegTree !l !r !x0 = go l r
   where
     go !l !r
       | l<r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           aref <- newIORef x0
           bref <- newIORef x0
           return $! Node l r aref bref lt rt
       | otherwise = do
           !ref <- newIORef x0
           return $! Leaf l ref

updateRange :: Int -> Int -> Int64 -> SegTree -> IO ()
updateRange !kl !kr !x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (fromIntegral$min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)
{-# INLINE updateRange #-}

updateKey :: Int -> Int64 -> SegTree -> IO ()
updateKey !key !x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<key || key<l) $ do
         b <- readIORef bref
         writeIORef bref $! b + x
         go lt >> go rt
     go (Leaf k ref) = do
       when (k==key) $ do
          modifyIORef' ref (x+)
{-# INLINE updateKey #-}

queryRange :: Int -> Int -> SegTree -> IO Int64
queryRange !kl !kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(fromIntegral$r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (fromIntegral$min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0
{-# INLINE queryRange #-}

queryKey :: Int -> SegTree -> IO Int64
queryKey !key segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | 2*key <= l+r = (+) <$> go lt <*> readIORef aref
       | otherwise = (+) <$> go rt <*> readIORef aref
     go (Leaf k ref) = readIORef ref
{-# INLINE queryKey #-}

getRoot :: SegTree -> IO Int64
getRoot (Node l r aref bref _ _) = do
  a <- readIORef aref
  b <- readIORef bref
  return $! a*(fromIntegral$r-l+1)+b
{-# INLINE getRoot #-}

{-# OPTIONS_GHC -O2 -funbox-strict-fields -cpp #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List
import Text.Printf

#if __GLASGOW_HASKELL__ < 706
import Data.IORef
#else
import Data.IORef hiding (modifyIORef')
#endif
modifyIORef' :: IORef a -> (a -> a) -> IO ()
modifyIORef' r f=do x<-readIORef r;writeIORef r$!f x
{-# INLINE modifyIORef' #-}

readInt bs = case B.readInt bs of Just (n,_) -> n

data Query = T1 !Int !Int64
           | T2 !Int64
           | T3

parse :: [Int] -> [Query]
parse (1:a:x:rest) = T1 a (fromIntegral x) : parse rest
parse (2:k:rest) = T2 (fromIntegral k) : parse rest
parse (3:rest) = T3 : parse rest
parse _ = []

main = do
  n <- readLn :: IO Int
  qs <- parse.map readInt.B.words <$> B.getContents
  segtree <- mkSegTree 0 n 0
  cntref <- newIORef 0 :: IO (IORef Int)

  let step (T1 a x) =  do
        updateRange 0 (a-1) x segtree
        s <- getRoot segtree
        cnt <- readIORef cntref
        return $! fromIntegral s / fromIntegral cnt
      step (T2 k) = do
        cnt <- readIORef cntref
        updateKey cnt k segtree
        s <- getRoot segtree
        cnt <- readIORef cntref
        writeIORef cntref $! cnt+1
        return $! fromIntegral s / fromIntegral (cnt+1)
      step T3 = do
        cnt <- readIORef cntref
        x <- queryKey (cnt-1) segtree
        updateKey (cnt-1) (fromIntegral$ -x) segtree
        s <- getRoot segtree
        writeIORef cntref $! cnt-1
        return $! fromIntegral s / fromIntegral (cnt-1)

  putStr.unlines.map show <$> mapM step qs

data SegTree = Node !Int !Int !(IORef Int64) !(IORef Int64) !SegTree !SegTree
             | Leaf !Int !(IORef Int64)

mkSegTree :: Int -> Int -> Int64 -> IO SegTree
mkSegTree !l !r !x0 = go l r
   where
     go !l !r
       | l<r = do
           let !m = (l+r) `quot` 2
           lt <- go l m
           rt <- go (m+1) r
           aref <- newIORef x0
           bref <- newIORef x0
           return $! Node l r aref bref lt rt
       | otherwise = do
           !ref <- newIORef x0
           return $! Leaf l ref

updateRange :: Int -> Int -> Int64 -> SegTree -> IO ()
updateRange !kl !kr !x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<kl || kr<l) $ do
         if kl<=l && r<=kr
            then modifyIORef' aref (x+)
            else do
              b <- readIORef bref
              writeIORef bref $! b + (fromIntegral$min r kr-max l kl+1)*x
              go lt >> go rt
     go (Leaf k ref) = do
       when (kl<=k && k<=kr) $ do
          modifyIORef' ref (x+)
{-# INLINE updateRange #-}

updateKey :: Int -> Int64 -> SegTree -> IO ()
updateKey !key !x segtree = go segtree
   where
     go (Node l r aref bref lt rt) = do
       unless (r<key || key<l) $ do
         b <- readIORef bref
         writeIORef bref $! b + x
         go lt >> go rt
     go (Leaf k ref) = do
       when (k==key) $ do
          modifyIORef' ref (x+)
{-# INLINE updateKey #-}

queryRange :: Int -> Int -> SegTree -> IO Int64
queryRange !kl !kr segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | r<kl || kr<l   = return 0
       | kl<=l && r<=kr = do
           a <- readIORef aref
           b <- readIORef bref
           return $! a*(fromIntegral$r-l+1)+b
       | otherwise = do
           xy <- (+) <$> go lt <*> go rt
           a <- readIORef aref
           return $! (fromIntegral$min r kr-max l kl+1)*a + xy
     go (Leaf k ref)
       | kl<=k && k<=kr = readIORef ref
       | otherwise = return 0
{-# INLINE queryRange #-}

queryKey :: Int -> SegTree -> IO Int64
queryKey !key segtree = go segtree
   where
     go (Node l r aref bref lt rt)
       | 2*key <= l+r = (+) <$> go lt <*> readIORef aref
       | otherwise = (+) <$> go rt <*> readIORef aref
     go (Leaf k ref) = readIORef ref
{-# INLINE queryKey #-}

getRoot :: SegTree -> IO Int64
getRoot (Node l r aref bref _ _) = do
  a <- readIORef aref
  b <- readIORef bref
  return $! a*(fromIntegral$r-l+1)+b
{-# INLINE getRoot #-}

import Data.Bits
import Data.Maybe
import Control.Monad
import Text.Printf
import qualified Data.ByteString.Char8 as B

data Tree = Node !Int !Int !Int !Tree !Tree
          | Leaf !Int
          deriving (Show)

emptyTree :: Int -> Tree
emptyTree 0 = Leaf 0
emptyTree n = Node 0 0 (n-1) (emptyTree (n-1)) (emptyTree (n-1))

append :: Int -> Int -> Tree -> Tree
append n x tree = sub tree
    where
        sub (Node _ a d t1 t2)
            | testBit n d = Node (num t1 + num t2') a d t1  t2'
            | otherwise   = Node (num t1'+ num t2 ) a d t1' t2
            where
                t1' = sub t1
                t2' = sub t2
        sub (Leaf _) = Leaf x

num (Node x a d _ _) = x + a * 2^(d+1)
num (Leaf x)       = x

add :: Int -> Int -> Tree -> Tree
add n x tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') a d t1' t2'
            | otherwise   = Node (num t1'' + num t2) a d t1'' t2
            where
                t1' = update x t1
                t1''= sub t1
                t2' = sub t2
        sub (Leaf s) = update x (Leaf s)

update x (Node s a d t1 t2) = Node s (a+x) d t1 t2
update x (Leaf s) = Leaf (s+x)

remove :: Int -> Tree -> Tree
remove n tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') 0 d t1' t2'
            | otherwise   = Node (num t1'') 0 d t1'' t2
            where
                t1' = update a t1
                t2'  = sub (update a t2)
                t1'' = sub t1
        sub (Leaf x) = Leaf 0

main :: IO ()
main = do
    n <- B.getLine >>= return . fromMaybe 0 .fmap fst. B.readInt
    (n,tree) <- foldM query (1,emptyTree 20) [1..n]
    return ()

query :: (Int,Tree) -> Int -> IO (Int,Tree)
query (n,tree) _ = do
    l <- B.getLine >>= return . map (fromMaybe 0.fmap fst . B.readInt) . B.words
    let (n',tree') = case l of
            [1,a,x] -> (n,add (a-1) x tree)
            [2,x]   -> (n+1,append n x tree)
            [3]     -> (n-1,remove (n-1) tree)
    B.putStrLn $ B.pack  $ showDouble ((fromIntegral (num tree') / fromIntegral n'):: Double)
    return (n',tree')

showDouble :: Double -> String
showDouble f | f < 0 = "-"++showDouble (-f)
             | otherwise = printf "%d.%07d" frac small
    where
        frac = floor f :: Int
        small = round ((f - fromIntegral frac)* 10000000) :: Int

import Data.Bits
import Data.Maybe
import Control.Monad
import Text.Printf
import qualified Data.ByteString.Char8 as B

data Tree = Node !Int !Int !Int !Tree !Tree
          | Leaf !Int
          deriving (Show)

emptyTree :: Int -> Tree
emptyTree 0 = Leaf 0
emptyTree n = Node 0 0 (n-1) (emptyTree (n-1)) (emptyTree (n-1))

append :: Int -> Int -> Tree -> Tree
append n x tree = sub tree
    where
        sub (Node _ a d t1 t2)
            | testBit n d = Node (num t1 + num t2') a d t1  t2'
            | otherwise   = Node (num t1'+ num t2 ) a d t1' t2
            where
                t1' = sub t1
                t2' = sub t2
        sub (Leaf _) = Leaf x

num (Node x a d _ _) = x + a * 2^(d+1)
num (Leaf x)       = x

add :: Int -> Int -> Tree -> Tree
add n x tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') a d t1' t2'
            | otherwise   = Node (num t1'' + num t2) a d t1'' t2
            where
                t1' = update x t1
                t1''= sub t1
                t2' = sub t2
        sub (Leaf s) = update x (Leaf s)

update x (Node s a d t1 t2) = Node s (a+x) d t1 t2
update x (Leaf s) = Leaf (s+x)

remove :: Int -> Tree -> Tree
remove n tree = sub tree
    where
        sub (Node s a d t1 t2)
            | testBit n d = Node (num t1' + num t2') 0 d t1' t2'
            | otherwise   = Node (num t1'') 0 d t1'' t2
            where
                t1' = update a t1
                t2'  = sub (update a t2)
                t1'' = sub t1
        sub (Leaf x) = Leaf 0

main :: IO ()
main = do
    n <- B.getLine >>= return . fromMaybe 0 .fmap fst. B.readInt
    (n,tree) <- foldM query (1,emptyTree 18) [1..n]
    return ()

query :: (Int,Tree) -> Int -> IO (Int,Tree)
query (n,tree) _ = do
    l <- B.getLine >>= return . map (fromMaybe 0.fmap fst . B.readInt) . B.words
    let (n',tree') = case l of
            [1,a,x] -> (n,add (a-1) x tree)
            [2,x]   -> (n+1,append n x tree)
            [3]     -> (n-1,remove (n-1) tree)
    B.putStrLn $ B.pack  $ showDouble ((fromIntegral (num tree') / fromIntegral n'):: Double)
    return (n',tree')

showDouble :: Double -> String
showDouble f | f < 0 = "-"++showDouble (-f)
             | otherwise = printf "%d.%07d" frac small
    where
        frac = floor f :: Int
        small = round ((f - fromIntegral frac)* 10000000) :: Int


{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m,k] <- readsLine
    as      <- readsLine
    case solve n m k as of
        Nothing -> print (-1)
        Just es -> forM_ es $ \(s,t) ->
            putStrLn $ show s ++ " " ++ show t

        {-
v -> u -> w
not (v -> w)
not (v -> u' -> w) ( u <- as )

-}
edge (u,v) | u <= v = (u,v)
           | otherwise = (v,u)
solve n m k as | n == k = Nothing
solve n m k as = go (S.fromList es0) cands
    where
    u : l     = [1..n] \\ as
    v : w : as' = as
    e1 = edge (u,v)
    e2 = edge (u,w)
    e3 = edge (v,w)
    es0 = map edge $ [(v,u),(u,w)] ++ zip (w:as') as' ++ zip (u:l) l
    cands = [(i,j) | i <- [1..n], j <- [i+1..n] , i /= v , j /= v] ++ [ edge (u',v) | u' <- l]
    go !es _ | S.size es == m = Just (S.toList es)
    go !es [] = Nothing
    go !es (e:cands) = go (e `S.insert` es) cands

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative

import Data.List
import qualified Data.Set as S

readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

main = do
    [n,m,k] <- map read . words <$> getLine
    as      <- map read . words <$> getLine
    case solve n m k as of
        Nothing -> print (-1)
        Just es -> forM_ es $ \(s,t) -> putStrLn $ unwords $ map show [s,t]

edge (u,v) = if u <= v then (u,v) else (v,u)

solve n m k as | n == k = Nothing
solve n m k as = go (S.fromList es0) cands
    where
    u : l       = [1..n] \\ as
    v : w : as' = as
    es0 = map edge $ [(v,u),(u,w)] ++ zip (w:as') as' ++ zip (u:l) l
    cands = [(i,j) | i <- [1..n], j <- [i+1..n] , i /= v , j /= v] ++ [ edge (u',v) | u' <- l]
    go !es _ | S.size es == m = Just (S.toList es)
    go !es [] = Nothing
    go !es (e:cands) = go (e `S.insert` es) cands

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative

import Data.List
import qualified Data.Set as S

readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

main = do
    [n,m,k] <- map read . words <$> getLine
    as      <- map read . words <$> getLine
    case solve n m k as of
        Nothing -> print (-1)
        Just es -> putStr $ unlines $ map (\(s,t) -> unwords $ map show [s,t]) es

edge (u,v) = if u <= v then (u,v) else (v,u)

solve n m k as | n == k = Nothing
solve n m k as = go (S.fromList es0) cands
    where
    u : l       = [1..n] \\ as
    v : w : as' = as
    es0 = map edge $ [(v,u),(u,w)] ++ zip (w:as') as' ++ zip (u:l) l
    cands = [(i,j) | i <- [1..n], j <- [i+1..n] , i /= v , j /= v] ++ [ edge (u',v) | u' <- l]
    go !es _ | S.size es == m = Just (S.toList es)
    go !es [] = Nothing
    go !es (e:cands) = go (e `S.insert` es) cands

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative

import Data.List
import qualified Data.Set as S

readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

main = do
    [n,m,k] <- map read . words <$> getLine
    as      <- map read . words <$> getLine
    case solve n m k as of
        Nothing -> print (-1)
        Just es -> putStr $ unlines $ map (\(s,t) ->
            unwords $ map show [s,t]) es

edge (u,v) = if u <= v then (u,v) else (v,u)

solve :: Int -> Int -> Int -> [Int] -> Maybe [(Int,Int)]
solve n m k as | n == k = Nothing
solve n m k as = go (S.fromList es0) cands
    where
    u : l       = [1..n] \\ as
    v : w : as' = as
    es0 = map edge $ [(v,u),(u,w)] ++ zip (w:as') as' ++ zip (u:l) l
    cands = [(i,j) | i <- [1..n], j <- [i+1..n] , i /= v , j /= v] ++
            [ edge (u',v) | u' <- l]
    go !es _ | S.size es == m = Just (S.toList es)
    go !es []                 = Nothing
    go !es (e:cands)          = go (e `S.insert` es) cands

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m,k] <- readsLine
    as      <- readsLine
    case solve n m k as of
        Nothing -> print (-1)
        Just es -> forM_ es $ \(s,t) ->
            putStrLn $ show s ++ " " ++ show t

        {-
v -> u -> w
not (v -> w)
not (v -> u' -> w) ( u <- as )
-}
edge u v | u <= v = (u,v)
         | otherwise = (v,u)
solve n m k as | n == k = Nothing
solve n m k as = if length es == m then Just es else Nothing
    where
    u : l     = [1..n] \\ as
    v : w : _ = as
    e1 = edge u v
    e2 = edge u w
    e3 = edge v w
    es = take m $ [e1,e2] ++
                  [ (i,j) | i <- [1..n], j <- [i+1..n] , i /= v , j /= v, (i,j) /= e2] ++
                  [ edge u' v | u' <- l]

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m,k] <- readsLine
    as      <- readsLine
    case solve n m k as of
        Nothing -> print (-1)
        Just es -> forM_ es $ \(s,t) ->
            putStrLn $ show s ++ " " ++ show t

edge u v | u <= v = (u,v)
         | otherwise = (v,u)
solve n m k as | n == k = Nothing
solve n m k as = if length es == m then Just es else Nothing
    where
    u :_  = [1..n] \\ as
    v : w : _ = as
    es = take m $ [edge u v,edge u w] ++ do
         i <- [1..n]
         guard $ i /= v
         j <- [i+1..n]
         guard $ edge u v /= (i,j)
         guard $ edge u w /= (i,j)
         return (i,j)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m,k] <- readsLine
    as      <- readsLine
    case solve n m k as of
        Nothing -> print (-1)
        Just es -> forM_ es $ \(s,t) ->
            putStrLn $ show s ++ " " ++ show t

edge u v | u <= v = (u,v)
         | otherwise = (v,u)
solve n m k as | n == k = Nothing
solve n m k as | k == n - 1 = if length es == m then Just es else Nothing
    where
    u :_  = [1..n] \\ as
    v : w : _ = as
    es = take m $ [edge u v,edge u w] ++ do
         i <- [1..n]
         guard $ i /= v
         j <- [i+1..n]
         guard $ edge u v /= (i,j)
         guard $ edge u w /= (i,j)
         return (i,j)
solve n m k as = Just es
    where
    u:v:_ = [1..n] \\ as
    es = take m $ (u,v):[(i,j) | i <- [1..n], j <- [i+1..n], (i,j) /= (u,v)]

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,m,k] <- readsLine
    as      <- readsLine
    case solve n m k as of
        Nothing -> print (-1)
        Just es -> forM_ es $ \(s,t) ->
            putStrLn $ show s ++ " " ++ show t

edge u v | u <= v = (u,v)
         | otherwise = (v,u)
solve n m k as | n == k = Nothing
solve n m k as | k == n - 1 = if length es == m then Just es else Nothing
    where
    u :_  = [1..n] \\ as
    v : w : _ = as
    es = take m $ [edge u v,edge u w] ++ do
         i <- [1..n]
         guard $ i /= v
         j <- [i+1..n]
         guard $ edge u v /= (i,j)
         guard $ edge u w /= (i,j)
         return (i,j)
solve n m k as | m == n * (n-1) `div` 2 = Nothing
               | otherwise = Just es
    where
    u:v:_ = [1..n] \\ as
    w = head as
    es = take m $ [edge u w,edge w v] ++ ([(i,j) | i <- [1..n], j <- [i+1..n]] \\ [edge u v,edge u w,edge w v])


{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  (n:lrs) <- map (fromIntegral.readInteger).B.words <$> B.getContents
  putStr.unlines.map show $ solve lrs

solve :: [Int64] -> [Int64]
solve lrs = go lrs
   where
     go (l:r:lrs) = query l r : go lrs
     go _ = []

query :: Int64 -> Int64 -> Int64
query l r
  | l == r = l
  | l<=cand = cand
  | otherwise = h + query (l-h) (r-h)
   where
     cand = last . takeWhile (<=r) $ iterate (\acc->acc*2+1) 0
     h = cand `xor` unsafeShiftR cand 1

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import System.IO
-- import Debug.Trace

getInts = fmap (map read . words) getLine
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

f l r
  | l == r = l
  | p <= l = f (l-p) (r-p) + p
  | 2*p-1 <= r = 2*p-1
  | otherwise = p-1
  where
    p = last $ takeWhile (<= r) $ map (2^) [0..]

main = do
  n <- readLn
  replicateM n (do
    [l, r] <- getInts :: IO [Int64]
    print $ f l r)


{-# LANGUAGE BangPatterns #-}
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, accumArray, elems)
import Debug.Trace (traceShow)

-- 1, 2, 3, 4
loop :: Int -> Int -> Int -> Int -> Int
loop 0 0 _ _ = 0

loop i j k l --  1 -> 2
    | 0 < i && 0 < j = inc + loop (i - inc) (j - inc) (k + inc) l
    where inc = min i j

loop i 0 k l -- {1, 1, 1}
    | 2 < i = inc * 2 + loop (i - 3 * inc) 0 (k + inc) l
    where inc = i `div` 3

loop 1 0 0 _ = 2  -- 1, 4, 4 -> 3, 3
loop 1 0 _ _ = 1  -- 1 -> 3
loop 2 0 _ _ = 2

loop 0 j k l -- 2, 2, 2 -> 3, 3
    | 2 < j = inc * 2 + loop 0 (j - 3 * inc) (k + 2 * inc) l
    where inc = j `div` 3

loop 0 1 _ 0 = 2
loop 0 1 _ _ = 1
loop 0 2 _ _ = 2

solve :: [Int] -> Int
solve a = if acc < 3 || acc == 5 then -1 else loop i j k l
    where
    arr :: UArray Int Int
    arr = accumArray (+) 0 (0, 4) . zip a . repeat $ 1
    [i, j, k, l] = tail $ elems arr
    acc = sum a

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = B.getLine >> parse <$> B.getLine >>= print . solve

{-# LANGUAGE BangPatterns #-}
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, accumArray, elems)

-- 1, 2, 3, 4
loop :: Int -> Int -> Int -> Int -> Int
loop 0 0 _ _ = 0

-- 50% gain
loop i j k l --  1 -> 2
    | 0 < i && 0 < j = inc + loop (i - inc) (j - inc) (k + inc) l
    where inc = min i j

-- 1/3rd gain
loop i 0 k l -- {1, 1, 1}
    | 2 < i = inc * 2 + loop (i - 3 * inc) 0 (k + inc) l
    where inc = i `div` 3

-- 1/3rd gain
loop 0 j k l -- 2, 2, 2 -> 3, 3
    | 2 < j = inc * 2 + loop 0 (j - 3 * inc) (k + 2 * inc) l
    where inc = j `div` 3

loop 1 0 0 _ = 2  -- 1, 4, 4 -> 3, 3
loop 1 0 _ _ = 1  -- 1 -> 3
loop 2 0 _ _ = 2

loop 0 1 _ 0 = 2
loop 0 1 _ _ = 1
loop 0 2 _ _ = 2

solve :: [Int] -> Int
solve a
    | acc < 3 || acc == 5 = -1
    | otherwise = loop i j k l
    where
    arr :: UArray Int Int
    arr = accumArray (+) 0 (0, 4) . zip a . repeat $ 1
    [i, j, k, l] = tail $ elems arr
    acc = sum a

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = B.getLine >> parse <$> B.getLine >>= print . solve

{-# LANGUAGE BangPatterns #-}
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, accumArray, elems, (!))
import Debug.Trace (traceShow)

-- 1, 2, 3, 4
loop :: Int -> Int -> Int -> Int -> Int
loop 0 0 _ _ = 0
loop i j k l --  1 -> 2
    | 0 < i && 0 < j = inc + loop (i - inc) (j - inc) (k + inc) l
    where inc = min i j

loop i 0 k l -- {1, 1, 1}
    | 2 < i = inc * 2 + loop (i - 3 * inc) 0 inc l
    where inc = i `div` 3

loop i 0 k l -- {1, 1, 1, 1}
    | 3 < i = inc * 3 + loop (i - 4 * inc) 0 0 (l + inc)
    where inc = i `div` 4

loop i 0 k l --  1 -> 3
    | 0 < k = inc + loop (i - inc) 0 (k - inc) (l + inc)
    where inc = min i k

loop i 0 _ _ = 2 -- 1, 2

loop 0 j k l -- 2, 2, 2 -> 3, 3
    | 2 < j = inc * 2 + loop 0 (j - 3 * inc) (k + 2 * inc) l
    where inc = j `div` 3

loop 0 1 _ l = if 0 < l then 1 else 2
loop 0 2 _ _ = 2

--loop 0 j k l --  4 -> 2
--    | 0 < j && 0 < l = inc + loop 0 (j - inc) (k + inc) (l - inc)
--    where inc = min j l

solve :: [Int] -> Int
solve a = if sum (elems arr) < 3 then -1 else loop i j k l
    where
    arr :: UArray Int Int
    arr = accumArray (+) 0 (0, 4) . zip a . repeat $ 1
    [i, j, k, l] = map (arr !) [1, 2, 3, 4]

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = B.getLine >> parse <$> B.getLine >>= print . solve

{-# LANGUAGE BangPatterns #-}
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, accumArray, elems)
import Debug.Trace (traceShow)

-- 1, 2, 3, 4
loop :: Int -> Int -> Int -> Int -> Int
loop 0 0 _ _ = 0

loop i j k l --  1 -> 2
    | 0 < i && 0 < j = inc + loop (i - inc) (j - inc) (k + inc) l
    where inc = min i j

loop i 0 k l -- {1, 1, 1}
    | 2 < i = inc * 2 + loop (i - 3 * inc) 0 (k + inc) l
    where inc = i `div` 3

loop 1 0 0 _ = 2  -- 1, 4, 4 -> 3, 3
loop 1 0 _ _ = 1  -- 1 -> 3
loop 2 0 _ _ = 2

loop 0 j k l -- 2, 2, 2 -> 3, 3
    | 2 < j = inc * 2 + loop 0 (j - 3 * inc) (k + 2 * inc) l
    where inc = j `div` 3

loop 0 1 _ 0 = 2
loop 0 1 _ _ = 1
loop 0 2 _ _ = 2

solve :: [Int] -> Int
solve a = if acc < 3 || acc == 5 then -1 else loop i j k l
    where
    arr :: UArray Int Int
    arr = accumArray (+) 0 (0, 4) . zip a . repeat $ 1
    [i, j, k, l] = tail $ elems arr
    acc = sum . tail $ elems arr

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = B.getLine >> parse <$> B.getLine >>= print . solve

{-# LANGUAGE BangPatterns #-}
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, accumArray, elems, (!))
import Debug.Trace (traceShow)

-- 1, 2, 3, 4
loop :: Int -> Int -> Int -> Int -> Int
loop 0 0 _ _ = 0
loop i j k l --  1 -> 2
    | 0 < i && 0 < j = inc + loop (i - inc) (j - inc) (k + inc) l
    where inc = min i j

loop i 0 k l -- {1, 1, 1}
    | 2 < i = inc * 2 + loop (i - 3 * inc) 0 inc l
    where inc = i `div` 3

loop i 0 k l -- {1, 1, 1, 1}
    | 3 < i = inc * 3 + loop (i - 4 * inc) 0 0 (l + inc)
    where inc = i `div` 4

loop i j k l --  1 -> 3
    | 0 < i && 0 < k = inc + loop (i - inc) j (k - inc) (l + inc)
    where inc = min i k

loop i 0 0 _ = i -- 1, 2

loop 0 j k l -- 2, 2, 2 -> 3, 3
    | 2 < j = inc * 2 + loop 0 (j - 3 * inc) (k + 2 * inc) l
    where inc = j `div` 3

loop 0 1 _ l = if 0 < l then 1 else 2
loop 0 2 _ _ = 2

--loop 0 j k l --  4 -> 2
--    | 0 < j && 0 < l = inc + loop 0 (j - inc) (k + inc) (l - inc)
--    where inc = min j l

solve :: [Int] -> Int
solve a = if sum (elems arr) < 3 then -1 else loop i j k l
    where
    arr :: UArray Int Int
    arr = accumArray (+) 0 (0, 4) . zip a . repeat $ 1
    [i, j, k, l] = map (arr !) [1, 2, 3, 4]

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = B.getLine >> parse <$> B.getLine >>= print . solve

{-# LANGUAGE BangPatterns #-}
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import Control.Applicative ((<$>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Array.Unboxed (UArray, accumArray, elems)
import Debug.Trace (traceShow)

-- 1, 2, 3, 4
loop :: Int -> Int -> Int -> Int -> Int
loop 0 0 _ _ = 0
loop i j k l --  1 -> 2
    | 0 < i && 0 < j = inc + loop (i - inc) (j - inc) (k + inc) l
    where inc = min i j

loop i 0 k l -- {1, 1, 1}
    | 2 < i = inc * 2 + loop (i - 3 * inc) 0 (k + inc) l
    where inc = i `div` 3

-- loop i 0 k l -- {1, 1, 1, 1}
--     | 3 < i = inc * 3 + loop (i - 4 * inc) 0 0 (l + inc)
--     where inc = i `div` 4

loop i 0 k l --  1 -> 3
    | 0 < k = inc + loop (i - inc) 0 (k - inc) (l + inc)
    where inc = min i k

loop i 0 _ _ = 2 -- 1, 2

loop 0 j k l -- 2, 2, 2 -> 3, 3
    | 2 < j = inc * 2 + loop 0 (j - 3 * inc) (k + 2 * inc) l
    where inc = j `div` 3

loop 0 1 _ l = if 0 < l then 1 else 2
loop 0 2 _ _ = 2

--loop 0 j k l --  4 -> 2
--    | 0 < j && 0 < l = inc + loop 0 (j - inc) (k + inc) (l - inc)
--    where inc = min j l

solve :: [Int] -> Int
solve a = (elems arr) `traceShow` if sum (elems arr) < 3 then -1 else loop i j k l
    where
    arr :: UArray Int Int
    arr = accumArray (+) 0 (0, 4) . zip a . repeat $ 1
    [i, j, k, l] = tail $ elems arr

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

main = B.getLine >> parse <$> B.getLine >>= print . solve


module Main where

   solve :: IO ()
   solve = do
       s <- getLine
       let [l, r] = map (\x -> read x :: Integer) $ words s
       putStrLn $ if 2 * l > r then
           "-1 -1"
       else
           show l ++ " " ++ show (2 * l)

   iter :: Integer -> IO ()
   iter 1 = solve
   iter n = do
       solve
       iter $ n - 1

   main :: IO ()
   main = do
       s <- getLine
       iter (read s :: Integer)

type Pair = (Integer, Integer)

parse :: String -> [Pair]
parse = chunksTwo . tail . map read . words

chunksTwo :: [Integer] -> [Pair]
chunksTwo [] = []
chunksTwo (x0:x1:xs) = (x0, x1) : chunksTwo xs
chunksTwo _ = error "malformed input"

solveCase :: Pair -> Pair
solveCase (le, ri)
  | le * 2 > ri  = (0-1, 0-1)
  | otherwise    = (le, 2*le)

displayAns :: Pair -> String
displayAns (x, y) = show x ++ " " ++ show y

main :: IO ()
main = interact (unlines . map (displayAns . solveCase) . parse)

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main = getLine >>= flip replicateM_ test . read

test = do
  [l, r] <- map read . words <$> getLine
  if l * 2 > r then putStrLn "-1 -1" else putStrLn $ show l ++ " " ++ show (2 * l)

module Main where

solve [x,y] = if y < x*2 then "-1 -1" else show x ++ " " ++ show (x*2)
main = interact $ unlines . map (solve . map (read :: String -> Int) . words )  . tail . lines

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

onecase = do
		[x,y]<- map read <$> words <$> getLine ::IO [Int]
		putStrLn $ if x+x<=y then intercalate " " (map show [x,x+x]) else "-1 -1"

main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase

module Main where

solve [x,y] =
    let b = filter (\(_,z) -> z >= x && z <= y) $ let a = [x+1 .. min y (x*2)] in zip a $ map (lcm x) a
    in   if null b
            then "-1 -1"
            else show x ++ " " ++ show (fst $ head b)
main = interact $ unlines . map (solve . map (read :: String -> Int) . words )  . tail . lines

module Main where

solve [x,y] = if y > x*2 then "-1 -1" else show x ++ " " ++ show (x*2)
main = interact $ unlines . map (solve . map (read :: String -> Int) . words )  . tail . lines


import           Control.Monad       (replicateM_, replicateM)

data Tile =
    Tile Int Int Int Int

data Input =
    Input Int Int [Tile]

readT :: IO Int
readT = do
    line <- getLine
    pure (read line :: Int)

isSymmetric :: Tile -> Bool
isSymmetric (Tile a b c d) | b == c    = True
                           | otherwise = False

oppositeTile :: Tile -> Tile
oppositeTile (Tile a b c d) = Tile a c b d

hasSymmetricTile :: [Tile] -> Bool
hasSymmetricTile = any isSymmetric

canBeSolved :: Input -> Bool
canBeSolved (Input n m tiles) | odd m      = False
                              | otherwise  = hasSymmetricTile tiles

readTuple :: IO (Int, Int)
readTuple = do
    num_strings <- words <$> getLine
    let a = read (head num_strings) :: Int
    let b = read (last num_strings) :: Int
    pure (a, b)

readTile :: IO Tile
readTile = do
    (a, b) <- readTuple
    (c, d) <- readTuple

    let tile = Tile a b c d
    pure tile

readInput :: IO Input
readInput = do
    (n, m) <- readTuple
    tiles <- replicateM n readTile
    pure (Input n m tiles)

solveCase :: IO ()
solveCase = do
    input <- readInput

    let ans | canBeSolved input = "YES"
            | otherwise         = "NO"

    putStrLn ans

main :: IO ()
main = do
    t <- readT
    replicateM_ t solveCase

-- vim: set ts=4 sw=4 expandtab:

import Control.Monad
import Data.Char
import Data.List

getList :: (Read t) => IO [t]
getList = getLine >>= return . (map read) . words

getOne :: (Read t) => IO t
getOne = getLine >>= return . read

main :: IO ()
main = do
  t <- getOne
  -- let t = 1
  replicateM_ t solve

solve :: IO ()
solve = do
  [n, m] <- getList
  plits <- replicateM n scanOne
  putStrLn $ countAns m plits
  where
    scanOne :: IO [Int]
    scanOne = do
      a <- getList
      b <- getList
      return $ a ++ b

countAns :: Integral t => t -> [[t]]-> String
countAns m plits
  | m `mod` 2 == 1 = "NO"
  | not $ any (\l -> (l !! 1) == (l !! 2)) plits = "NO"
  | null $ intersect plits $ map rev plits = "NO"
  | otherwise = "YES"
  where
    rev :: Integral t => [t] -> [t]
    rev [a, b, c, d] = [a, c, b, d]

third :: [Int] -> Int
third a = head (tail (tail a))

getAns :: Int -> [[Int]] -> Bool
getAns m [] = False
getAns m a | mod m 2 /= 0 = False
           | (head (tail (head a))) == (third (head a)) = True
           | otherwise = getAns m (tail a)

convert :: Bool -> String
convert True = "YES"
convert False = "NO"

get :: Int -> [String] -> Int
get 0 a = read (head (a)) :: Int
get 1 a = read (head (tail (a))) :: Int

getList :: Int -> [[Int]] -> Int -> IO()
getList 0 a m = do
    putStrLn (convert (getAns m a))

getList n a m = do
    first <- getLine
    second <- getLine

    let list = [(get 0 (words first)), (get 1 (words first)), (get 0 (words second)), (get 1 (words second))]
    getList (n - 1) (a ++ [list]) m

solve :: Int -> IO()
solve 0 = do
    putStr ""
solve t = do
    str <- getLine
    let n = get 0 (words str)
    let m = get 1 (words str)
    getList n [] m
    solve (t - 1)

main = do
    testes <- getLine
    let t = read testes :: Int
    solve t

import Control.Monad

readInts :: IO [Int]
readInts = map read . words <$> getLine

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, m] <- readInts
    symms <- replicateM n $ do
      [_, p] <- readInts
      [q, _] <- readInts
      pure $ p == q
    putStrLn $ if  even m && or symms
      then  "YES"
      else  "NO"

import Control.Arrow ( (>>>) )

main :: IO ()
main = interact $
  lines >>> drop 1
  >>> map (words >>> map read)
  >>> process
  >>> map (\x -> if x then "YES" else "NO") >>> unlines

process :: [[Int]] -> [Bool]
process [] = []
process ([n, m] : rest) =
  (if m `mod` 2 == 0 then solve (take (n*2) rest) else False) : process (drop (n*2) rest)

solve :: [[Int]] -> Bool
solve [] = False
solve ([_, a]:[b, _]:rest) = or [a == b, solve rest]


import Data.List (group, sort)

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [n, k] = map read $ words input
        result = findFirstKBeautifulNumber n (fromIntegral k)
        output = show result

findFirstKBeautifulNumber :: Integer -> KParameter -> Integer
findFirstKBeautifulNumber start k
    | isKBeautiful start k = start
    | start `mod` 10 /= 0 = findFirstKBeautifulNumber (start + 1) k
    | otherwise = result_if_start_ends_with_zero
    where
        result_if_start_ends_with_zero = result_for_short_version * 10 + last_digit
        result_for_short_version = findFirstKBeautifulNumber (start `div` 10) k
        last_digit = read [minimum (show result_for_short_version)]

isKBeautiful :: Integer -> KParameter -> Bool
isKBeautiful number k = measureK number <= k

type KParameter = Int
measureK :: Integer -> KParameter
measureK = length . group . sort . show

import Data.List (group, sort)

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [n, k] = map read $ words input
        result = findFirstKBeautifulNumber n (fromIntegral k)
        output = show result

findFirstKBeautifulNumber :: Integer -> KParameter -> Integer
findFirstKBeautifulNumber start k
    | isKBeautiful start k = start
    | start `mod` 10 /= 0 = findFirstKBeautifulNumber (start + 1) k
    | otherwise = result_if_start_ends_with_zero
    where
        result_if_start_ends_with_zero = result_for_short_version * 10 + last_digit
        result_for_short_version = findFirstKBeautifulNumber (start `div` 10) k
        can_add_new_digit = measureK result_for_short_version < k
        last_digit = if can_add_new_digit then 0 else read [minimum (show result_for_short_version)]

isKBeautiful :: Integer -> KParameter -> Bool
isKBeautiful number k = measureK number <= k

type KParameter = Int
measureK :: Integer -> KParameter
measureK = length . group . sort . show


import Data.List
import Control.Monad
import Data.Int (Int64)

main = do
    n <- getLine >>= return . read
    shc <- replicateM n getLine >>= return . (map countSHC)
    print $ (sum $ map (\(_, _, c) -> c) shc) + (compute $ sortBy getOrd (map (\(s, h, _) -> (s, h)) shc))
    where
        getOrd (sa, ha) (sb, hb) = if (sa * hb < sb * ha) then GT else LT

compute :: [(Int64, Int64)] -> Int64
compute shs =
    sum $ map (\((s, h'), h) -> s*(h-h')) $ zip shs hs
    where
        hs = scanr accumr 0 (map snd shs)
        accumr s c= s + c

countSHC :: String -> (Int64, Int64, Int64)
countSHC str =
    let ss = scanl (count 's') 0 str in
    let hs = scanr (flip $ count 'h') 0 str in
    (last ss, head hs, sum $ map (\(c, n) -> if c == 's' then n else 0) $ zip str hs)
    where
        count c n ch = n + (if c == ch then 1 else 0)

import Data.List
import Control.Monad

main = do
    n <- getLine >>= return . read
    shc <- replicateM n getLine >>= return . (map countSHC)
    print $ (sum $ map (\(_, _, c) -> c) shc) + (compute $ sortBy getOrd (map (\(s, h, _) -> (s, h)) shc))
    where
        getOrd (sa, ha) (sb, hb) = if (sa * hb < sb * ha) then GT else LT

compute :: [(Integer, Integer)] -> Integer
compute shs =
    sum $ map (\((s, h'), h) -> s*(h-h')) $ zip shs hs
    where
        hs :: [Integer]
        hs = scanr accumr 0 (map snd shs)
        accumr :: Integer -> Integer -> Integer
        accumr s c= s + c

countSHC :: String -> (Integer, Integer, Integer)
countSHC str =
    let ss = scanl (count 's') 0 str in
    let hs = scanr (flip $ count 'h') 0 str in
    (last ss, head hs, sum $ map (\(c, n) -> if c == 's' then n else 0) $ zip str hs)
    where
        count :: Char -> Integer -> Char -> Integer
        count c n ch = n + (if c == ch then 1 else 0)

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

countChar :: String -> Char -> Int64
countChar str c = foldl' (\acc cur -> if cur == c then acc + 1 else acc) 0 str

getSHRatio :: String -> Rational
getSHRatio str = (toRational $ countChar str 's') / (toRational $ countChar str 'h')

getHCount :: String -> [Int64]
getHCount [] = [0]
getHCount (x:xs)
    | x == 's' = f : res
    | otherwise = (f + 1) : res
    where res = getHCount xs
          f = head res

solve :: String -> [Int64] -> Int64
solve _ [] = 0
solve (x:xs) (h:hh)
    | x == 's' = h + rest
    | otherwise = rest
    where rest = solve xs hh

main :: IO ()
main = do
    n <- (read :: String -> Int64) <$> getLine
    lst <- mapM (\_ -> getLine) [1..n]
    let onlyS = join $ [x | x <- lst, not $ 'h' `elem` x]
        onlyH = join $ [x | x <- lst, not $ 's' `elem` x]
        both = [x | x <- lst, 'h' `elem` x && 's' `elem` x]
        bothWithCount = reverse . sort $ [(getSHRatio x, x) | x <- both]
        best = onlyS ++  (join $ map (\t -> snd t) bothWithCount) ++ onlyH
        hCount = tail $ getHCount best
        res = solve best hCount
    -- putStrLn . show $ best
    -- putStrLn . show $ hCount
    putStrLn . show $ res

import Control.Monad
import Data.List
import Data.Int

transf :: String -> (Int64, Int64, String)
transf s = (x, y, s)
    where x = fromIntegral . length $ elemIndices 's' s
          y = (fromIntegral . length $ s) - x

compAns :: Int64 -> String -> Int64
compAns _ "" = 0
compAns st ('s':rest) = compAns (st + 1) rest
compAns st ('h':rest) = st + compAns st rest

main = do
    n <- readLn
    l <- replicateM n $ fmap transf getLine
    let sl = sortBy (\(a, b, _) (x, y, _) -> compare (b*x) (a*y)) l
    print . compAns 0 . join . map (\(_,_,x) -> x) $ sl

import Data.List
import Control.Monad

main = do
    n <- getLine >>= return . read
    shc <- replicateM n getLine >>= return . (map countSHC)
    print $ (sum $ map (\(_, _, c) -> c) shc) + (compute $ sortBy getOrd (map (\(s, h, _) -> (s, h)) shc))
    where
        getOrd (sa, ha) (sb, hb) = if (sa * hb < sb * ha) then GT else LT

compute :: [(Int, Int)] -> Int
compute shs =
    sum $ map (\((s, h'), h) -> s*(h-h')) $ zip shs hs
    where
        hs :: [Int]
        hs = scanr accumr 0 (map snd shs)
        accumr :: Int -> Int -> Int
        accumr s c= s + c

countSHC :: String -> (Int, Int, Int)
countSHC str =
    let ss = scanl (count 's') 0 str in
    let hs = scanr (flip $ count 'h') 0 str in
    (last ss, head hs, sum $ map (\(c, n) -> if c == 's' then n else 0) $ zip str hs)
    where
        count :: Char -> Int -> Char -> Int
        count c n ch = n + (if c == ch then 1 else 0)

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

countChar :: String -> Char -> Int
countChar str c = foldl' (\acc cur -> if cur == c then acc + 1 else acc) 0 str

getSHRatio :: String -> Rational
getSHRatio str = (toRational $ countChar str 's') / (toRational $ countChar str 'h')

getHCount :: String -> [Int]
getHCount [] = [0]
getHCount (x:xs)
    | x == 's' = f : res
    | otherwise = (f + 1) : res
    where res = getHCount xs
          f = head res

solve :: String -> [Int] -> Int
solve _ [] = 0
solve (x:xs) (h:hh)
    | x == 's' = h + rest
    | otherwise = rest
    where rest = solve xs hh

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    lst <- mapM (\_ -> getLine) [1..n]
    let onlyS = join $ [x | x <- lst, not $ 'h' `elem` x]
        onlyH = join $ [x | x <- lst, not $ 's' `elem` x]
        both = [x | x <- lst, 'h' `elem` x && 's' `elem` x]
        bothWithCount = reverse . sort $ [(getSHRatio x, x) | x <- both]
        best = onlyS ++  (join $ map (\t -> snd t) bothWithCount) ++ onlyH
        hCount = tail $ getHCount best
        res = solve best hCount
    -- putStrLn . show $ best
    -- putStrLn . show $ hCount
    putStrLn . show $ res

import Control.Monad
import Data.List
import Data.Int

transf :: String -> (Int, Int, String)
transf s = (x, y, s)
    where x = length $ elemIndices 's' s
          y = length s - x

compAns :: Int64 -> String -> Int64
compAns _ "" = 0
compAns st ('s':rest) = compAns (st + 1) rest
compAns st ('h':rest) = st + compAns st rest

main = do
    n <- readLn
    l <- replicateM n $ fmap transf getLine
    let sl = sortBy (\(a, b, _) (x, y, _) -> compare (b*x) (a*y)) l
    print . compAns 0 . join . map (\(_,_,x) -> x) $ sl


import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

evens :: [t] -> [t]
evens (p:q:rs) = p : evens rs
evens x = x

interleave :: [t] -> [t] -> [t]
interleave [] _ = []
interleave (x:xs) ys = x : interleave ys xs

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    a <- readInts
    let
      a1 = sort $ evens a
      a2 = sort $ evens $ tail a
      opt = interleave a1 a2
      ans = and $ zipWith (<=) opt (tail opt)
    lift $ B.hPutBuilder stdout $ if  ans
      then  B.string7 "YES\n"
      else  B.string7 "NO\n"

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.IO.Safe         as IOA
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM, for)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import           Debug.Trace                (trace, traceM, traceShowM)
import           GHC.IO.Handle              (hDuplicateTo)

debug :: c -> String -> c
debug = flip trace
traced x = trace (show x) x
withTrace s x = trace (s ++ " -> " ++ show x) x

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> fst . fromJust

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> fst . fromJust

solve :: Int -> [Int] -> Bool
solve n as =
        all (all (\(k, v) -> v == 0) . IM.toList) cnts
    where
        sortAs :: [Int]
        sortAs = sort as

        md :: Int
        md = 2

        execCnts :: Int -> [Int] -> [IM.IntMap Int] -> [IM.IntMap Int]
        execCnts diff arr prevCnts =
                flip map (zip [0 ..] prevCnts) $ uncurry alterCnts
            where
                alterCnts :: Int -> IM.IntMap Int -> IM.IntMap Int
                alterCnts c mp =
                    foldl (\mp (i, e) -> if i `mod` md == c then IM.insertWith (+) e diff mp else mp) mp $
                        zip [0 ..] arr

        cnts :: [IM.IntMap Int]
        cnts =
            execCnts (-1) as $
            execCnts 1 sortAs $
            replicate md IM.empty

main :: IO ()
main = do
    tests <- B8.getLine <&> readIntB8
    replicateM_ tests $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> map readIntB8 . B8.words

        let answer = solve n as

        putStrLn $ if answer then "YES" else "NO"

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

import Data.List as L
import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Data.ByteString as B
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  sa <- getLine
  let a = map read $ words sa :: [Int]
      a_odd = oddelems a
      b_odd = oddelems $ sort a
      good = (sort a_odd == reverse b_odd)
    in putStrLn (if good then "YES" else "NO")
    where oddelems xs = foldl (\acc (i, x) -> if odd i then x : acc else acc) [] (zip [0..] xs)

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

import Data.List as L

mergeLists :: [Int] -> [Int] -> [Int]
mergeLists [] [] = []
mergeLists x [] = x
mergeLists [] y = y
mergeLists (x:xs) (y:ys) = x:y:(mergeLists xs ys)

isSorted :: [Int] -> Bool
isSorted [] = True
isSorted [x] = True
isSorted (x:y:xs) = x <= y && isSorted (y:xs)

splitList :: [Int] -> ([Int], [Int])
splitList [] = ([], [])
splitList [x] = ([x], [])
splitList (x:y:xs) = (x:axs, y:bxs)
    where (axs, bxs) = splitList xs

solve :: Int -> IO ()
solve _ = do
    n <- (read :: String -> Int) <$> getLine
    -- putStrLn . show $ n
    lst <- map (\x -> (read :: String -> Int) x) . words <$> getLine
    -- putStrLn . show $ lst
    let (e, o) = splitList lst
        se = L.sort e
        so = L.sort o
        merged = mergeLists se so
        res = if isSorted merged then "Yes" else "No"
    putStrLn res

solveTest :: [Int] -> IO ()
solveTest [] = return ()
solveTest (x:xs) = do
    solve x
    solveTest xs

main :: IO ()
main = do
    t <- (read :: String -> Int) <$> getLine
    -- putStrLn . show $ t
    solveTest [1..t]

import Control.Monad
import Data.List
readInts = fmap (map read.words) getLine :: IO [Int]

solve [] _ = True
solve _ [] = True
solve (e:es) (o:os)
                | o >= e = solve (o:os) es
                | otherwise = False

printResult = do
    n <- readLn :: IO Int
    xs <- readInts
    let z = zip xs [0..]
        e = [a|(a,b)<-z,even b]
        o = [a|(a,b)<-z,odd b]
    putStrLn $ if solve (sort e) (sort o) then "YES" else "NO"

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe
import qualified Data.Map.Strict as M
import Data.Bool

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

data OddEven = Odd | Even deriving (Show, Eq, Ord, Enum, Bounded)

summarize :: [Int] -> M.Map (Int, OddEven) Int
summarize xs =
  let ks = zip xs $ fmap (bool Odd Even . even) [1..]
  in M.fromListWith (+) $ zip ks $ repeat 1

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    xs <- getInts n
    let ys = sort xs
    pure $ (<>char7 '\n') $! bool (string7 "NO") (string7 "YES") $ (summarize xs) == (summarize ys)

type SP = State [P.ByteString]

readInt :: P.ByteString -> Int
readInt = fst . fromJust . P.readInt

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map readInt <$> getNext k

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

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

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a:b:interleave as bs
interleave a b = a ++ b

uninterleave :: [a] -> ([a], [a])
uninterleave (a1:a2:as) = let (x, y) = uninterleave as in (a1:x, a2:y)
uninterleave [a] = ([a], [])
uninterleave [] = ([], [])

both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)

toAnswer :: Bool -> String
toAnswer True = "YES"
toAnswer False = "NO"

isSorted :: Ord a => [a] -> Bool
isSorted [] = True
isSorted [a] = True
isSorted (a1:a2:as) = (a1 <= a2) && (isSorted (a2:as))

doit :: [Int] -> String
doit = toAnswer . isSorted . uncurry interleave . both sort . uninterleave

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        getLine
        l <- fmap (map read . words) getLine
        putStrLn $ doit l

import Control.Arrow ((>>>))
import Data.Bool (bool)
import Data.List (group, groupBy, sort)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

main :: IO ()
main =
  interact $
    lines >>> drop 1 >>> chunksOf 2
      >>> map (last >>> words >>> map read >>> solve >>> bool "No" "Yes")
      >>> unlines

solve :: [Int] -> Bool
solve =
  sorted
    . interleave
    . map (map snd)
    . groupBy (equating fst)
    . sort
    . zip ((`mod` 2) <$> [0 ..])

equating :: Eq a => (b -> a) -> b -> b -> Bool
equating f x y = f x == f y

sorted :: (Ord a) => [a] -> Bool
sorted xs = and $ zipWith (<=) xs (tail xs)

interleave :: [[a]] -> [a]
interleave [] = []
interleave xs = let xs' = filter (not . null) xs in map head xs' ++ interleave (map tail xs')


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import           Control.Applicative
import           Control.Monad
import           Data.Array
import qualified Data.ByteString.Char8 as B
import           Data.Int
import qualified Data.IntMap           as IM

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map (fromIntegral.readInt).B.words <$> B.getLine
  ys <- map (subtract 1.readInt).B.words <$> B.getLine
  putStr.unlines.map show $ solve n xs ys

solve :: Int -> [Int64] -> [Int] -> [Int64]
solve n xs ys = go [] 0 IM.empty IM.empty $ reverse ys
  where
    arr = listArray(0, n-1) xs
    go res acc ls rs (k:ks) = go (acc:res) res' ls' rs' ks
      where
        !res' = max acc s
        !v = arr ! k
        !s = sl + v + sr
        (l, sl) = case IM.lookup (k-1) rs of
            Just (lk, s) -> (lk, s)
            Nothing -> (k, 0)
        (r, sr) = case IM.lookup (k+1) ls of
            Just (rk, s) -> (rk, s)
            Nothing -> (k, 0)
        rs' = IM.insert r (l, s) $ IM.delete (k-1) rs
        ls' = IM.insert l (r, s) $ IM.delete (k+1) ls
    go res _ _ _ [] = res

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}

-- import qualified Data.IntMap as M
import qualified Data.Map.Strict as M
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust, fromMaybe)
import Data.List (scanr)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

solve a i (m, curmax) =
  let
    n = a M.! i
    left = M.lookup (i-1) m
    right = M.lookup (i+1) m
    newGroup =
      ( ( fromMaybe i . fmap (fst . fst) $ left
        , fromMaybe i . fmap (snd . fst) $ right
        )
      , n
          + (fromMaybe 0 . fmap snd $ left)
          + (fromMaybe 0 . fmap snd $ right)
      )
  in
    ( M.insert (fst . fst $ newGroup) newGroup
      . M.insert (snd . fst $ newGroup) newGroup
      $ m
    , max curmax $ snd newGroup
    )

main = do
  [n] <- readLine
  array <- readLine
  order <- readLine
  B.putStrLn . B.pack . unlines . map (show . snd) . drop 1 $ scanr (solve $ M.fromAscList (zip [1..] array)) (M.empty, 0) order

{-
TODO:
1. Read from IO
2. Convert [Int] to mutable [(0 | Sum, rootId | 0, 0 | length)]
3. Write fold fn which returns current maximum sum.
-}
module Main where
import Data.Array
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

type Set = ((Integer, Integer), Integer)

-- values as first argument
-- sequence to remove as second
getSum :: [Integer] -> [Integer] -> [Integer]
getSum ys xs =
  let els = listArray (0, pred $ toInteger $ length ys) $ zip (zip [1, 1..] [-1, -1..]) ys :: Array Integer Set
  in run (reverse xs) els

run :: [Integer] -> Array Integer Set -> [Integer]
run xs els' = runST $ do
  els <- thaw els'
  curMaxSum <- newSTRef 0
  res' <- forM xs $ \i' -> do
    let i = pred i'
        l = toInteger $ length xs
    visit i els
    union i (pred i) els $ pred l
    union i (succ i) els $ pred l
    root <- findRoot i els
    ((_,_), sumI) <- readArray els root
    modifySTRef curMaxSum (\x -> max x sumI)
    newMax <- readSTRef curMaxSum
    -- trace (show $ newMax) $ return ()
    readSTRef curMaxSum
  return res'

visit :: Integer -> STArray s Integer Set -> ST s ()
visit i els = do
  ((l, _), y) <- readArray els i
  writeArray els i $ ((l, i), y)

findRoot :: Integer -> STArray s Integer Set -> ST s Integer
findRoot i els = do
  ((_, rootId), _) <- readArray els i
  if (rootId == i || rootId == -1) then return rootId
  else findRoot rootId els

union :: Integer -> Integer -> STArray s Integer Set -> Integer -> ST s ()
union i j els maxJ
  | j < 0 || j > maxJ = return ()
  | otherwise = do
    rootI' <- findRoot i els
    rootJ' <- findRoot j els
    -- one of the elements was not visited yet. Nothing to union
    if (rootI' == -1 || rootJ' == -1) then return ()
    else do
      ((lI, rootI), sumI) <- readArray els rootI'
      ((lJ, rootJ), sumJ) <- readArray els rootJ'
      writeArray els rootI ((lI + lJ, rootI), sumI + sumJ)
      writeArray els rootJ ((0, rootI), 0)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_] <- readLine
  array <- readLine
  order <- readLine
  mapM_ print $ tail $ reverse $ (:) 0 $ getSum array order

import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.Array
import Data.Maybe
import Data.Set hiding (map, foldl)
import qualified Data.Map as M

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [Integer]
 where fn x = let Just (y,_) = B.readInteger x in y

inf = round 1e18

add k m = case M.lookup k m of
            Just _ -> M.update (return . succ) k m
            _ -> M.insert k 1 m

remove :: Integer -> M.Map Integer Integer -> M.Map Integer Integer
remove k m = case M.lookup k m of
            Just x -> if x == 1 then M.delete k m else M.update (return . pred) k m
            _ -> error "Key doesn't exist"

main :: IO ()
main = do
    n <- readLn
    a <- readIntList
    b <- readIntList
    let pre = listArray (0,n+1) ((scanl (+) 0 a)++[0])
        for :: Set (Integer,Integer) -> M.Map Integer Integer -> [Integer] -> IO()
        for st mp (i:is) = do
            let (a,b) = fromJust $ lookupLE (i,inf) st
                st' = delete (a,b) st
                mp' = remove (pre!b - pre!(a-1)) mp
                (nst,nmp) = foldl fn (st',mp') [(a,i-1),(i+1,b)]
                fn (st,mp) (x,y)
                 |y >= x = (insert (x,y) st, add (pre!y - pre!(x-1)) mp)
                 |otherwise = (st,mp)
            -- print (st,mp)
            if M.null nmp
                then print 0
                else do
                    print . fst . M.findMax $ nmp
                    for nst nmp is
    for (fromList [(1,n)]) (M.fromList [(pre!n,1)]) b

import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.Array
import Data.Maybe
import Data.Set hiding (map, foldl)

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [Integer]
 where fn x = let Just (y,_) = B.readInteger x in y

inf = round 2e9

main :: IO ()
main = do
    n <- readLn
    a <- readIntList
    b <- readIntList
    let pre = listArray (0,n+1) ((scanl (+) 0 a)++[0])
        for :: Set (Integer,Integer) -> Set Integer -> [Integer] -> IO ()
        for st1 st2 (i:is) = do
            let (a,b) = fromJust $ lookupLE (i,inf) st1 :: (Integer,Integer)
                st1' = delete (a,b) st1
                st2' = delete (pre!b - pre!(a-1)) st2
                (nst1,nst2) = foldl fn (st1',st2') [(a,i-1),(i+1,b)]
                fn (st1,st2) (x,y)
                 |pre!y - pre!(x-1) > 0 = (insert (x,y) st1, insert (pre!y - pre!(x-1)) st2)
                 |otherwise = (st1,st2)
            case maxView nst2 of
                Just x -> do
                    print . fst $ x
                    for nst1 nst2 is
                _ -> print 0
    for (fromList [(1,n)]) (fromList [pre!n]) b

module Main where
import Data.Array
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
-- import Debug.Trace
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

type Set = ((Int, Int), Int)

-- values as first argument
-- sequence to remove as second
getSum :: [Int] -> [Int] -> [Int]
getSum ys xs =
  let els = listArray (0, pred $ length ys) $ zip (zip [1, 1..] [-1, -1..]) ys :: Array Int Set
  in run (reverse xs) els

run :: [Int] -> Array Int Set -> [Int]
run xs els' = runST $ do
  els <- thaw els'
  curMaxSum <- newSTRef 0
  res' <- forM xs $ \i' -> do
    let i = pred i'
        l = length xs
    visit i els
    union i (pred i) els $ pred l
    union i (succ i) els $ pred l
    root <- findRoot i els
    ((_,_), sumI) <- readArray els root
    modifySTRef curMaxSum (\x -> max x sumI)
    newMax <- readSTRef curMaxSum
    -- trace (show $ newMax) $ return ()
    readSTRef curMaxSum
  return res'

visit :: Int -> STArray s Int Set -> ST s ()
visit i els = do
  ((l, _), y) <- readArray els i
  writeArray els i $ ((l, i), y)

findRoot :: Int -> STArray s Int Set -> ST s Int
findRoot i els = do
  ((_, rootId), _) <- readArray els i
  if (rootId == i || rootId == -1) then return rootId
  else findRoot rootId els

union :: Int -> Int -> STArray s Int Set -> Int -> ST s ()
union i j els maxJ
  | j < 0 || j > maxJ = return ()
  | otherwise = do
    rootI' <- findRoot i els
    rootJ' <- findRoot j els
    -- one of the elements was not visited yet. Nothing to union
    if (rootI' == -1 || rootJ' == -1) then return ()
    else do
      ((lI, rootI), sumI) <- readArray els rootI'
      ((lJ, rootJ), sumJ) <- readArray els rootJ'
      writeArray els rootI ((lI + lJ, rootI), sumI + sumJ)
      writeArray els rootJ ((0, rootI), 0)

readInt = fromIntegral . fst . fromJust . B.readInteger
readLine =
  B.getLine >>= return . map readInt . B.words

main = do
  [_] <- readLine
  array <- readLine
  order <- readLine
  mapM_ print $ tail $ reverse $ (:) 0 $ getSum array order

import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust, fromMaybe)
import Data.List (scanr)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine =
  B.getLine >>= return . map readInt . B.words

solve :: M.IntMap Int -> Int -> (M.IntMap ((Int, Int), Int), Int) -> (M.IntMap ((Int, Int), Int), Int)
solve a i (m, curmax) =
  let
    n = a M.! i
    left = M.lookup (i-1) m
    right = M.lookup (i+1) m
    newGroup =
      ( ( fromMaybe i . fmap (fst . fst) $ left
        , fromMaybe i . fmap (snd . fst) $ right
        )
      , n
          + (fromMaybe 0 . fmap snd $ left)
          + (fromMaybe 0 . fmap snd $ right)
      )
  in
    ( M.insert (fst . fst $ newGroup) newGroup
      . M.insert (snd . fst $ newGroup) newGroup
      $ m
    , max curmax $ snd newGroup
    )

main = do
  [n] <- readLine
  array <- readLine
  order <- readLine
  B.putStrLn . B.pack . unlines . map (show . snd) . drop 1 $ scanr (solve $ M.fromAscList (zip [1..] array)) (M.empty, 0) order


import Data.Ratio

main = do
    n <- fmap (read :: String -> Int) $ getLine
    m <- fmap (toRational . (read :: String -> Double)) $ getLine
    a <- fmap (map (toRational . (read :: String -> Double)) . words) $ getLine
    b <- fmap (map (toRational . (read :: String -> Double)) . words) $ getLine

    let d = product [1 - 1/x | x <- a] * product [1 - 1/x | x <- b]

    let answer = if d > 0 then show . fromRational $ m * (1 - d) / d
        else show (negate 1)

    putStrLn answer

import Data.List

main = do
  getLine
  m <- readLn :: IO Double
  a <- fmap (map read . words) getLine :: IO [Double]
  b <- fmap (map read . words) getLine :: IO [Double]
  let c = concat . zipWith (\a b -> [b, a]) (reverse a) $ head b : (reverse . tail $ b)
  let tot = foldl' (\x a -> x + x / (a - 1)) m c
  print $ if any (== 1) $ a ++ b then -1 else tot - m

main :: IO ()
main = do
    input <- sequence [getLine, getLine, getLine, getLine]
    let count = read (head input) :: Int
    let mass = read (input !! 1) :: Int
    let ka = map (read::String->Int) (words(input !! 2))
    let kb = map (read::String->Int) (words(input !! 3))
    print (calculate count mass ka kb)

calculate :: Int -> Int -> [Int] -> [Int] -> Double
calculate _ mass ka kb = result
    where
        result = if noValue
            then -1.0
            else fly (fromIntegral mass) 0.0 k
        k = prepare ka kb
        noValue = 1 `elem` k

prepare :: [Int] -> [Int] -> [Int]
prepare ka kb = reverseList (merge ka (tail kb ++ [head kb]))

fly :: Double -> Double -> [Int] -> Double
fly mass fuel (k:ks) = fly mass (fuel + fuelIncrement (mass + fuel) k) ks
fly mass fuel [] = fuel

fuelIncrement :: Double -> Int -> Double
fuelIncrement mass k = mass / fromIntegral (k - 1)

merge :: [a] -> [a] -> [a]
merge (x:xs) (y:ys) = x : y : merge xs ys
merge [] [] = []

reverseList :: [a] -> [a]
reverseList [] = []
reverseList (x:xs) = reverseList xs ++ [x]

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Data.Array
import Data.Char
import Data.Functor
import Data.List
import Data.Int
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

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

solve :: Double -> [Int] -> [Int] -> Double
solve m a b = if' (c > 0) (m / c - m) (-1)
	where c = product $ map ((\x -> 1 - 1/x) . fromIntegral) $ (a ++ b)

main :: IO ()
main = do
	[n] <- getInts
	[m] <- getInts
	a <- getInts
	b <- getInts
	print (solve (fromIntegral m) a b)

toint s = (read s) :: Int

itod x = (fromIntegral x) :: Double

can::Double -> [Double] -> [Double] -> Double -> Bool
can m [] [] f = True
can m (a:as) (b:bs) f =
  let x = (m + f) / a in
  if f - x < 0 then
    False
  else
    let ff = f - x in
    let xx = (m+ff) / b in
    if ff-xx < 0 then
      False
    else
      can m as bs (ff-xx)

bs m a b s e i =
  if i == 70 then
    s
  else
    let mid = (s+e)/2 in
    if can m a b mid then
      bs m a b s mid (i+1)
    else
      bs m a b mid e (i+1)

solve::String -> String
solve sss =
    let (n:mm:ss) = Prelude.map toint $ words sss in
    let a = map itod $ take n ss in
    let bb = map itod $ take n $ drop n ss in
    let b = (tail bb) ++ [head bb] in
    let m = itod mm in
    if can m a b 1.1e9 then
      show (bs m a b 0.0 1.1e9 0) ++ "\n"
    else
      "-1\n"

main = interact solve

main = interact foo

foo :: String -> String
foo inp =
    let _:m:as:bs:_ = lines inp
        cargo = read m :: Double
        li:lifts = map read $ words as :: [Double]
        landings = map read $ words bs :: [Double]
        transits = zip (li: (reverse lifts)) (reverse landings)
        fuel = (flip (-) cargo) $ foldl (\c (lif, lan) -> transit c lif lan) cargo transits
    in if fuel == 1/0 then "-1" else show fuel

-- reversed
-- weight before -> takeoff -> landing -> weight after
transit :: Double -> Double -> Double -> Double
transit w a b =
    let w' = lift w a
    in lift w' b

-- weight before -> takeoff/lanfding -> weight after
lift :: Double -> Double -> Double
lift w a =
    let f = w / (a-1)
    in w + f

merge :: [a] -> [a] -> [a]
merge (a:as) (b:bs) = a : b : merge as bs
merge a [] = a
merge _ b = b

compute :: [Int] -> Double -> Double
compute (1:_) _ = -1
compute (c:cs) w = compute cs $ w * (fromIntegral c) / (fromIntegral c-1)
compute _ w = w

main = do
    getLine
    m <- fmap (fromIntegral . read) getLine
    a <- fmap (map read . words) getLine
    b1:bs <- fmap (map read . words) getLine
    let coeffs = b1 : reverse (merge a bs)
    let res = compute coeffs m
    if res < 0 then print (-1)
        else print $ res - m

merge :: [a] -> [a] -> [a]
merge (a:as) (b:bs) = a : b : merge as bs
merge a [] = a
merge _ b = b

compute :: [Int] -> Float -> Float
compute (1:_) _ = -1
compute (c:cs) w = compute cs $ w * (fromIntegral c) / (fromIntegral c-1)
compute _ w = w

main = do
    getLine
    m <- fmap (fromIntegral . read) getLine
    a <- fmap (map read . words) getLine
    b1:bs <- fmap (map read . words) getLine
    let coeffs = b1 : reverse (merge a bs)
    let res = compute coeffs m
    if res < 0 then print (-1)
        else print $ res - m


-- https://codeforces.com/problemset/problem/16/A

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Char(digitToInt)

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

readLine :: Read a => IO [a]
readLine = fmap (fmap read . words) getLine

testCols :: [Char] -> Bool
testCols [a, b] = a /= b
testCols (a:b:xs) = (a /= b) && testCols (b:xs)

workProblem :: IO ()
workProblem = do
                [n, m] <- readLine :: IO [Int]
                input <- getLines n
                let cols = map head input
                let rowTest = and $ map (\xs -> and $ map (== head xs) (tail xs)) input
                let colTest = if length cols == 1 then True else  testCols cols
                let anwser = if rowTest && colTest then "YES" else "NO"
                () <- putStrLn anwser
                return ()

main :: IO ()
main = workProblem

main = do
	dummy <- getLine
	todo <- getContents
	putStrLn $ if gao (lines todo) then "YES" else "NO"

gao [] = True
gao (a:b) = gao b && a == take (length a) (repeat (head a)) && (b == [] || a /= head b)

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeSynonymInstances #-}

import Control.Monad

import Data.IORef
import System.IO.Unsafe

import Data.List
import Data.Ratio

solve = do n <- cin
           m <- cin :: IO Int
           rows <- replicateM n cin :: IO [String]
           let a = all (null.tail.nub) rows
               b = not . or . zipWith (==) rows $ tail rows
           return . output $ a && b
  where
    output True = "YES"
    output False = "NO"

main = putStrLn =<< solve

class Read' a where
  read' :: String -> a

instance Read' Integer where
  read' = read

instance Read' Int where
  read' = read

instance Read' Double where
  read' = read

instance Read' Char where
  read' (c:[]) = c
  read' cs = error $ cs ++ " cannot read' as the type of Char."

instance Read' String where
  read' cs = cs

cin :: forall a. Read' a => IO a
cin = do (x:xs) <- readIORef input
         writeIORef input xs
         return $ read' x

input :: IORef [String]
input = unsafePerformIO $ getContents >>= newIORef . words

solve [] = []
solve (s:ss) = map (head s==) s ++ [nextline]++ solve ss
   where nextline = if null ss then True
   	                else s /= (head ss)

main = do
	a <-getLine
	c <-getContents
	if and (solve (lines c)) then putStrLn "YES"
	else putStrLn "NO"

un = map (read :: String ->Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

isSame (x:xs) = all (==x) xs

isNotSame :: String -> Bool
isNotSame [x] = True
isNotSame (a:b:c) = (a /= b) && (isNotSame (b:c))

main = do
    s <- getLine
    let n:_ = un s
    ss <- getLines n
    let res = if (all isSame ss) && (isNotSame (map head ss)) then "YES" else "NO"
    putStrLn res

main = do
    haha <- getLine
    flag <- getContents

    putStrLn $ if yao (lines flag) then "YES" else "NO"

yao []      = True
yao (x:xs)  = yao xs && x == take (length x) (repeat (head x) ) && (xs == [] ||x /= head xs)

splitOnPred :: (Eq a) => (a -> Bool) -> [a] -> [[a]]
splitOnPred pred xs = splitOn' xs [] []
  where splitOn' [] m ret = if null m then ret else ret ++ [m]
        splitOn' (x:xs) [] ret = splitOn' xs (if pred x then [] else [x]) ret
        splitOn' (x:xs) m  ret = if pred x then splitOn' xs [] (ret ++ [m]) else splitOn' xs (m ++ [x]) ret

splitOn :: String -> String -> [String]
splitOn str sp = splitOnPred (\x -> elem x sp) str

split :: String -> [String]
split str = splitOn str " \n"

solve :: [[Char]] -> Bool
solve g = column g && row g
  where
    column :: [[Char]] -> Bool
    column g = let gg = map (\x -> ((head x), x)) g
                   ok = map (\(x, y) -> all (== x) y) gg
               in and ok
    row    g = let gg = map head g
               in row' gg
                 where row' (x:y:xs)
                         | x /= y    = row' (y:xs)
                         | otherwise = False
                       row' _ = True

main :: IO ()
main = do cs <- getContents
          let sp = split cs
              m  = read (sp !! 0) :: Int
              n  = read (sp !! 1) :: Int
              g  = drop 2 sp
            in putStrLn $ if solve g then "Yes" else "No"

import List (nub)

(<?>) :: a -> a -> Bool -> a
(<?>) a b p  =  if p then a else b

solve :: [String] -> Bool
solve xs  =  all ((== 1) . length . nub) xs
    && all (\(a, b) -> a /= b) (zip xs (tail xs))

main :: IO ()
main  =  do
    n  <-  fmap (head . map read . words) getLine
    lines'  <-  fmap (take n . lines) getContents
    putStrLn . ("YES" <?> "NO") . solve $ lines'

import System.Environment
import Control.Monad
import Control.Monad (liftM, sequence)
import Data.List

rr :: [Char] -> Integer
rr = read

okh [] = True
okh (x:[]) = True
okh (x:y:xs) = if x/=y then False else okh (y:xs)

okv [] = True
okv (x:[]) = True
okv (x:y:xs) = if x==y then False else okv (y:xs)

yesno True = "YES"
yesno False = "NO"

main = do
    s <- getLine
    let (n:m:null) = Prelude.map rr $ words s
    z <- lines `liftM` getContents
    putStrLn $ yesno $ okv z && Data.List.foldl1(&&) (map okh z)

import Data.List (group)
import Control.Monad

yesOrNo :: Bool -> IO ()
yesOrNo True = putStrLn "YES"
yesOrNo False = putStrLn "NO"

solve :: [String] -> Bool
solve xs = (and $ map check1 xs) && (check2 $ map head xs)
    where
        check1 xs = length (group xs) == 1
        check2 xs = length (group xs) == length xs

main = do
    getContents >>= (yesOrNo . solve . tail . lines)

import Data.List

main :: IO()
main = do
    _ <- getLine
    todo <- getContents
    putStrLn $ if gao (lines todo) then "YES" else "NO"

gao :: [String] -> Bool
gao a = f a && (g $ transpose a)
    where
        f a = all (==1) [ if (any (==True) $ map (/=head x) x) then 0 else 1 | x <- a ]
        g a = all (==1) [ if adj x then 0 else 1 | x <- a ]
            where
                adj [x] = False
                adj [x, y] = x == y
                adj [x, y, z] = x == y || y == z
                adj (x:y:z) = x == y || adj (y:z)

import Data.List( nub, group )
main:: IO ()
main = do
    tokens <- return . words =<< getContents
    let rows = read $ tokens!!0
        lines = drop 2 tokens
        tmp = unzip $ map linechk lines
        colorseq = fst tmp
        horizontalchk = and $ snd tmp
        verticalchk = rows == (length $ group colorseq)
    if horizontalchk && verticalchk
        then putStr "YES"
        else putStr "NO"

linechk     :: String -> (Char,Bool)
linechk l   =  (head l, 1 == (length . nub)  l)

import Control.Monad
import Data.Char
import Data.List
import Data.Maybe

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

splitByPredicate :: (a -> Bool) -> [a] -> [[a]]
splitByPredicate _ [] = []
splitByPredicate p l
    | p (head l) == True = [takeWhile p l] ++ (splitByPredicate p (dropWhile p l))
    | otherwise          = [takeWhile (not . p) l] ++ (splitByPredicate p (dropWhile (not . p) l))

allEqual :: (Eq a) => [a] -> Bool
allEqual []         = True
allEqual [x]        = True
allEqual (x: y: xs) = (x == y) && allEqual (y: xs)

check1 :: [String] -> Bool
check1 = all allEqual

check2 :: [String] -> Bool
check2 []         = True
check2 [x]        = True
check2 (x: y: xs) = ((x !! 0) /= (y !! 0)) && check2 (y: xs)

solve :: [String] -> String
solve ls
   |  check1 ls && check2 ls = "YES"
   |  otherwise              = "NO"

main = do
    sn <- getLine
    let [n, m] = map read (words sn)
    sl <- getLines n
    putStrLn $ solve sl

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import Data.Char

main = do
		[n,m]<-map read <$> words <$> getLine ::IO [Int]
		s<- replicateM n getLine
		let x = all (==1) $ map length $ map group s
		let y = all (==1) $ map length $ group $ head $ transpose s
		putStrLn $ if x && y then "YES" else "NO"

import Data.List

main :: IO()
main = showBool . check . tail . lines =<< getContents

showBool :: Bool -> IO()
showBool True  = putStrLn "YES"
showBool False = putStrLn "NO"

check :: [String] -> Bool
check flag = (checkRow flag) && (checkColumn flag)

checkRow :: [String] -> Bool
checkRow = all (\x -> (length . group) x == 1)

checkColumn :: [String] -> Bool
checkColumn flag = all id . zipWith (/=) rows $ (tail rows)
    where rows = map head flag

main = do
    inp <- getContents
    let ln = lines inp
    let sol = check ' ' $ tail ln
    if sol
        then putStrLn "YES"
        else putStrLn "NO"

check c [] = True
check c (x:xs) = (x!!0 /= c) && (allEq x) && (check (x!!0) xs)
    where
    allEq s = (fil s) == []
    fil s = filter (/= (head s)) $ tail s

import Data.List

main :: IO()
main = do
    _ <- getLine
    todo <- getContents
    putStrLn $ if gao (lines todo) then "YES" else "NO"

gao :: [String] -> Bool
gao a = f a && (g $ transpose a)
    where
        f a = all (==1) [ if (any (==True) $ map (/=head x) x) then 0 else 1 | x <- a ]
        g a = all (==1) [ if adj x then 0 else 1 | x <- a ]
            where
                adj [x] = True
                adj [x, y] = x == y
                adj [x, y, z] = x == y && y == z
                adj (x:y:z) = x == y && adj (y:z)