Skip to content

Instantly share code, notes, and snippets.

@m00nlight
Last active September 27, 2022 23:24

Revisions

  1. m00nlight revised this gist Jun 11, 2015. 1 changed file with 43 additions and 18 deletions.
    61 changes: 43 additions & 18 deletions gistfile1.hs
    Original file line number Diff line number Diff line change
    @@ -2,57 +2,78 @@ import Control.Applicative
    import Control.Monad
    import qualified Data.ByteString.Char8 as BS
    import Data.List
    import qualified Data.Map as M
    import Data.Maybe
    import qualified Data.Vector as V

    data SegTree a =
    Node {
    val :: a
    , lazy :: a
    , lazy :: Maybe a
    , left, right :: Int
    , leftChild, rightChild :: SegTree a
    } |
    Leaf {
    val :: a
    , lazy :: a
    , lazy :: Maybe a
    , left, right :: Int
    } deriving (Show, Eq, Ord)


    initTree :: (Num a, Eq a) => [a] -> SegTree a
    instance (Num a) => Num (Maybe a) where
    Nothing + Nothing = Nothing
    Nothing + (Just a) = Just a
    (Just a) + Nothing = Just a
    (Just a) + (Just b) = Just (a + b)
    fromInteger = undefined
    (*) = undefined
    signum = undefined
    abs = undefined


    fI :: (Integral a, Num b) => a -> b
    fI = fromIntegral

    initTree :: (Num a) => [a] -> SegTree a
    initTree xs = aux 0 (n - 1)
    where
    vs = V.fromList xs
    n = V.length vs
    aux l r
    | l == r = Leaf { val = vs V.! l, lazy = 0, left = l, right = r}
    | l == r =
    Leaf { val = vs V.! l, lazy = Nothing, left = l, right = r}
    | otherwise =
    let mid = (l + r) `div` 2
    lChild = aux l mid
    rChild = aux (mid + 1) r
    in Node { val = val lChild + val rChild
    , left = l, right = r, lazy = 0
    , left = l
    , right = r
    , lazy = Nothing
    , leftChild = lChild, rightChild = rChild
    }



    updateNode :: (Num a, Eq a) => SegTree a -> SegTree a
    updateNode rt =
    if (lazy rt) == 0 then
    if (lazy rt) == Nothing then
    rt
    else
    let (lc, rc) = (leftChild rt, rightChild rt)
    (l, r) = (left rt, right rt)
    in if l == r then
    rt { val = (val rt) + (lazy rt), lazy = 0 }
    rt { val = (val rt) + (fromJust $ lazy rt), lazy = Nothing }
    else
    let nlc = lc {lazy = (lazy lc) + (lazy rt)}
    nrc = rc {lazy = (lazy rc) + (lazy rt)}
    in rt { val = (val rt) + (lazy rt) * (fromIntegral $ r - l +1)
    , leftChild = nlc, rightChild = nrc, lazy = 0
    in rt { val = (val rt) + (fromJust $ lazy rt) * (fI $ r - l +1)
    , leftChild = nlc
    , rightChild = nrc
    , lazy = Nothing
    }



    queryTree :: (Num a, Eq a) => SegTree a -> Int -> Int -> (a, SegTree a)
    queryTree root l r
    | l > r || r < left root || l > right root = (0, root)
    @@ -79,36 +100,40 @@ updateTree root l r inc
    [a, b] = [left root, right root]
    in
    if a /= b then
    root { val = (val root) + inc * (fromIntegral $ b - a + 1)
    , leftChild = lc { lazy = (lazy lc) + inc}
    , rightChild = rc { lazy = (lazy rc) + inc }
    root { val = (val root) + inc * (fI $ b - a + 1)
    , leftChild = lc { lazy = (lazy lc) + (Just inc)}
    , rightChild = rc { lazy = (lazy rc) + (Just inc) }
    }
    else
    root { val = (val root) + inc * (fromIntegral $ b - a + 1)}
    root { val = (val root) + inc * (fI $ b - a + 1)}
    | otherwise =
    let nlc = updateTree (leftChild root) l r inc
    nrc = updateTree (rightChild root) l r inc
    in root { val = (val nlc) + (val nrc)
    , leftChild = nlc, rightChild = nrc
    , leftChild = nlc
    , rightChild = nrc
    }


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

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


    -- solve :: Int -> [[Integer]] -> [Integer]
    solve :: Int -> [[Int]] -> (SegTree Integer, [Integer])
    solve n qs = foldl'
    (\ (root, acc) q ->
    if (head q) == 0 then
    (updateTree root (q !! 1 - 1) (q !! 2 - 1) (q !! 3), acc)
    (updateTree root
    (q !! 1 - 1) (q !! 2 - 1) (toInteger (q !! 3)), acc)
    else
    let (ans, nr) = queryTree root (q !! 1 - 1) (q !! 2 - 1)
    in (nr, ans : acc) )
    (initTree $ take n (repeat 0), [])
    qs


    main :: IO ()
    main = do
    tc <- readLn :: IO Int
  2. m00nlight revised this gist Jun 11, 2015. 1 changed file with 19 additions and 21 deletions.
    40 changes: 19 additions & 21 deletions gistfile1.hs
    Original file line number Diff line number Diff line change
    @@ -41,15 +41,16 @@ updateNode rt =
    if (lazy rt) == 0 then
    rt
    else
    let lc = leftChild rt
    rc = rightChild rt
    nlc = lc {lazy = (lazy lc) + (lazy rt)}
    nrc = rc {lazy = (lazy rc) + (lazy rt)}
    r = right rt
    l = left rt
    in rt { val = (val rt) + (lazy rt) * (fromIntegral $ r - l +1)
    , leftChild = nlc, rightChild = nrc
    }
    let (lc, rc) = (leftChild rt, rightChild rt)
    (l, r) = (left rt, right rt)
    in if l == r then
    rt { val = (val rt) + (lazy rt), lazy = 0 }
    else
    let nlc = lc {lazy = (lazy lc) + (lazy rt)}
    nrc = rc {lazy = (lazy rc) + (lazy rt)}
    in rt { val = (val rt) + (lazy rt) * (fromIntegral $ r - l +1)
    , leftChild = nlc, rightChild = nrc, lazy = 0
    }


    queryTree :: (Num a, Eq a) => SegTree a -> Int -> Int -> (a, SegTree a)
    @@ -97,26 +98,23 @@ readInteger' = fst . fromJust. BS.readInteger


    -- solve :: Int -> [[Integer]] -> [Integer]
    solve n qs = foldl' (\ (root, acc) q ->
    if (head q) == 0 then
    (updateTree root (q !! 1 - 1) (q !! 2 - 1) (q !! 3), acc)
    else
    let (ans, nr) = queryTree root (q !! 1 - 1) (q !! 2 - 1)
    in (nr, ans : acc) )
    solve n qs = foldl'
    (\ (root, acc) q ->
    if (head q) == 0 then
    (updateTree root (q !! 1 - 1) (q !! 2 - 1) (q !! 3), acc)
    else
    let (ans, nr) = queryTree root (q !! 1 - 1) (q !! 2 - 1)
    in (nr, ans : acc) )
    (initTree $ take n (repeat 0), [])
    qs


    main :: IO ()
    main = do
    tc <- readLn :: IO Int
    forM_ [1..tc] $ \i -> do
    forM_ [1..tc] $ \_ -> do
    [n, q] <- map readInt' . BS.words <$> BS.getLine
    contents <- replicateM q BS.getLine
    let queries = map (\ x -> map readInt' (BS.words x)) contents
    (_, ans) = solve n queries
    putStrLn $ show ans
    -- putStrLn $ intercalate " " $ map show (solve n queries)

    -- putStrLn $ intercalate " " $ map show (solve n input)
    putStrLn "hello world"
    putStrLn $ intercalate "\n" (map show $ reverse ans)
  3. m00nlight renamed this gist Jun 10, 2015. 1 changed file with 0 additions and 0 deletions.
    File renamed without changes.
  4. m00nlight created this gist Jun 10, 2015.
    122 changes: 122 additions & 0 deletions gistfile1.txt
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,122 @@
    import Control.Applicative
    import Control.Monad
    import qualified Data.ByteString.Char8 as BS
    import Data.List
    import qualified Data.Map as M
    import Data.Maybe
    import qualified Data.Vector as V

    data SegTree a =
    Node {
    val :: a
    , lazy :: a
    , left, right :: Int
    , leftChild, rightChild :: SegTree a
    } |
    Leaf {
    val :: a
    , lazy :: a
    , left, right :: Int
    } deriving (Show, Eq, Ord)


    initTree :: (Num a, Eq a) => [a] -> SegTree a
    initTree xs = aux 0 (n - 1)
    where
    vs = V.fromList xs
    n = V.length vs
    aux l r
    | l == r = Leaf { val = vs V.! l, lazy = 0, left = l, right = r}
    | otherwise =
    let mid = (l + r) `div` 2
    lChild = aux l mid
    rChild = aux (mid + 1) r
    in Node { val = val lChild + val rChild
    , left = l, right = r, lazy = 0
    , leftChild = lChild, rightChild = rChild
    }

    updateNode :: (Num a, Eq a) => SegTree a -> SegTree a
    updateNode rt =
    if (lazy rt) == 0 then
    rt
    else
    let lc = leftChild rt
    rc = rightChild rt
    nlc = lc {lazy = (lazy lc) + (lazy rt)}
    nrc = rc {lazy = (lazy rc) + (lazy rt)}
    r = right rt
    l = left rt
    in rt { val = (val rt) + (lazy rt) * (fromIntegral $ r - l +1)
    , leftChild = nlc, rightChild = nrc
    }


    queryTree :: (Num a, Eq a) => SegTree a -> Int -> Int -> (a, SegTree a)
    queryTree root l r
    | l > r || r < left root || l > right root = (0, root)
    | otherwise =
    let nr = updateNode root
    in if (left nr) >= l && (right nr) <= r then
    (val nr, nr)
    else
    ((fst $ queryTree (leftChild nr) l r) +
    (fst $ queryTree (rightChild nr) l r), nr)


    updateTree :: (Num a, Eq a) => SegTree a -> Int -> Int -> a -> SegTree a
    updateTree root l r inc
    | l > r = root
    | otherwise = aux nr
    where
    nr = updateNode root
    aux root
    | (right root) < l || (left root) > r = root
    | (left root) >= l && (right root) <= r =
    let lc = leftChild root
    rc = rightChild root
    [a, b] = [left root, right root]
    in
    if a /= b then
    root { val = (val root) + inc * (fromIntegral $ b - a + 1)
    , leftChild = lc { lazy = (lazy lc) + inc}
    , rightChild = rc { lazy = (lazy rc) + inc }
    }
    else
    root { val = (val root) + inc * (fromIntegral $ b - a + 1)}
    | otherwise =
    let nlc = updateTree (leftChild root) l r inc
    nrc = updateTree (rightChild root) l r inc
    in root { val = (val nlc) + (val nrc)
    , leftChild = nlc, rightChild = nrc
    }


    readInt' = fst . fromJust . BS.readInt
    readInteger' = fst . fromJust. BS.readInteger


    -- solve :: Int -> [[Integer]] -> [Integer]
    solve n qs = foldl' (\ (root, acc) q ->
    if (head q) == 0 then
    (updateTree root (q !! 1 - 1) (q !! 2 - 1) (q !! 3), acc)
    else
    let (ans, nr) = queryTree root (q !! 1 - 1) (q !! 2 - 1)
    in (nr, ans : acc) )
    (initTree $ take n (repeat 0), [])
    qs


    main :: IO ()
    main = do
    tc <- readLn :: IO Int
    forM_ [1..tc] $ \i -> do
    [n, q] <- map readInt' . BS.words <$> BS.getLine
    contents <- replicateM q BS.getLine
    let queries = map (\ x -> map readInt' (BS.words x)) contents
    (_, ans) = solve n queries
    putStrLn $ show ans
    -- putStrLn $ intercalate " " $ map show (solve n queries)

    -- putStrLn $ intercalate " " $ map show (solve n input)
    putStrLn "hello world"