Last active
September 27, 2022 23:24
Revisions
-
m00nlight revised this gist
Jun 11, 2015 . 1 changed file with 43 additions and 18 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal 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 Data.Maybe import qualified Data.Vector as V data SegTree a = Node { val :: a , lazy :: Maybe a , left, right :: Int , leftChild, rightChild :: SegTree a } | Leaf { val :: a , lazy :: Maybe a , left, right :: Int } deriving (Show, Eq, Ord) 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 = 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 = Nothing , leftChild = lChild, rightChild = rChild } updateNode :: (Num a, Eq a) => SegTree a -> SegTree a updateNode rt = 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) + (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) + (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 * (fI $ b - a + 1) , leftChild = lc { lazy = (lazy lc) + (Just inc)} , rightChild = rc { lazy = (lazy rc) + (Just inc) } } else 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 } readInt' :: BS.ByteString -> Int readInt' = fst . fromJust . BS.readInt readInteger' :: BS.ByteString -> Integer readInteger' = fst . fromJust. BS.readInteger 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) (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 -
m00nlight revised this gist
Jun 11, 2015 . 1 changed file with 19 additions and 21 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -41,15 +41,16 @@ updateNode rt = if (lazy rt) == 0 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 } 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) ) (initTree $ take n (repeat 0), []) qs main :: IO () main = do tc <- readLn :: IO Int 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 $ intercalate "\n" (map show $ reverse ans) -
m00nlight renamed this gist
Jun 10, 2015 . 1 changed file with 0 additions and 0 deletions.There are no files selected for viewing
File renamed without changes. -
m00nlight created this gist
Jun 10, 2015 .There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal 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"