module Data.RAList
(
RAList
, empty
, cons
, (++)
, head
, last
, tail
, init
, null
, length
, map
, reverse
, foldl
, foldl'
, foldl1
, foldl1'
, foldr
, foldr1
, concat
, concatMap
, and
, or
, any
, all
, sum
, product
, maximum
, minimum
, replicate
, take
, drop
, splitAt
, elem
, notElem
, lookup
, filter
, partition
, (!!)
, zip
, zipWith
, unzip
, update
, adjust
, toList
, fromList
) where
import qualified Prelude
import Prelude hiding(
(++), head, last, tail, init, null, length, map, reverse,
foldl, foldl1, foldr, foldr1, concat, concatMap,
and, or, any, all, sum, product, maximum, minimum, take,
drop, elem, splitAt, notElem, lookup, replicate, (!!), filter,
zip, zipWith, unzip
)
import qualified Data.List as List
import Data.Monoid
infixl 9 !!
infixr 5 `cons`, ++
data RAList a = RAList !Int !(Top a)
deriving (Eq)
instance (Show a) => Show (RAList a) where
showsPrec p xs = showParen (p >= 10) $ showString "fromList " . showsPrec 10 (toList xs)
instance (Read a) => Read (RAList a) where
readsPrec p = readParen (p > 10) $ \ r -> [(fromList xs, t) | ("fromList", s) <- lex r, (xs, t) <- reads s]
instance (Ord a) => Ord (RAList a) where
xs < ys = toList xs < toList ys
xs <= ys = toList xs <= toList ys
xs > ys = toList xs > toList ys
xs >= ys = toList xs >= toList ys
xs `compare` ys = toList xs `compare` toList ys
instance Monoid (RAList a) where
mempty = empty
mappend = (++)
instance Functor RAList where
fmap f (RAList s wts) = RAList s (fmap f wts)
instance Monad RAList where
return x = RAList 1 (Cons 1 (Leaf x) Nil)
(>>=) = flip concatMap
data Top a = Nil | Cons !Int !(Tree a) (Top a)
deriving (Eq)
instance Functor Top where
fmap _ Nil = Nil
fmap f (Cons w t xs) = Cons w (fmap f t) (fmap f xs)
data Tree a
= Leaf a
| Node a !(Tree a) !(Tree a)
deriving (Eq)
instance Functor Tree where
fmap f (Leaf x) = Leaf (f x)
fmap f (Node x l r) = Node (f x) (fmap f l) (fmap f r)
empty :: RAList a
empty = RAList 0 Nil
cons :: a -> RAList a -> RAList a
cons x (RAList s wts) = RAList (s+1) $
case wts of
Cons s1 t1 (Cons s2 t2 wts') | s1 == s2 -> Cons (1 + s1 + s2) (Node x t1 t2) wts'
_ -> Cons 1 (Leaf x) wts
(++) :: RAList a -> RAList a -> RAList a
xs ++ ys | null ys = xs
| otherwise = foldr cons ys xs
head :: RAList a -> a
head (RAList _ Nil) = errorEmptyList "head"
head (RAList _ (Cons _ (Leaf x) _)) = x
head (RAList _ (Cons _ (Node x _ _) _)) = x
last :: RAList a -> a
last xs@(RAList s _) = xs !! (s1)
tail :: RAList a -> RAList a
tail (RAList _ Nil) = errorEmptyList "tail"
tail (RAList s (Cons _ (Leaf _) wts)) = RAList (s1) wts
tail (RAList s (Cons w (Node x l r) wts)) = RAList (s1) (Cons w2 l (Cons w2 r wts))
where w2 = w `quot` 2
init :: RAList a -> RAList a
init = fromList . Prelude.init . toList
null :: RAList a -> Bool
null (RAList s _) = s == 0
length :: RAList a -> Int
length (RAList s _) = s
map :: (a->b) -> RAList a -> RAList b
map = fmap
reverse :: RAList a -> RAList a
reverse = fromList . Prelude.reverse . toList
foldl :: (a -> b -> a) -> a -> RAList b -> a
foldl f z xs = Prelude.foldl f z (toList xs)
foldl' :: (a -> b -> a) -> a -> RAList b -> a
foldl' f z xs = List.foldl' f z (toList xs)
foldl1 :: (a -> a -> a) -> RAList a -> a
foldl1 f xs | null xs = errorEmptyList "foldl1"
| otherwise = Prelude.foldl1 f (toList xs)
foldl1' :: (a -> a -> a) -> RAList a -> a
foldl1' f xs | null xs = errorEmptyList "foldl1'"
| otherwise = List.foldl1' f (toList xs)
foldr :: (a -> b -> b) -> b -> RAList a -> b
foldr f z xs = Prelude.foldr f z (toList xs)
foldr1 :: (a -> a -> a) -> RAList a -> a
foldr1 f xs | null xs = errorEmptyList "foldr1"
| otherwise = Prelude.foldr1 f (toList xs)
concat :: RAList (RAList a) -> RAList a
concat = foldr (++) empty
concatMap :: (a -> RAList b) -> RAList a -> RAList b
concatMap f = concat . map f
and :: RAList Bool -> Bool
and = foldr (&&) True
or :: RAList Bool -> Bool
or = foldr (||) False
any :: (a -> Bool) -> RAList a -> Bool
any p = or . map p
all :: (a -> Bool) -> RAList a -> Bool
all p = and . map p
sum :: (Num a) => RAList a -> a
sum = foldl (+) 0
product :: (Num a) => RAList a -> a
product = foldl (*) 1
maximum :: (Ord a) => RAList a -> a
maximum xs | null xs = errorEmptyList "maximum"
| otherwise = foldl1 max xs
minimum :: (Ord a) => RAList a -> a
minimum xs | null xs = errorEmptyList "minimum"
| otherwise = foldl1 min xs
replicate :: Int -> a -> RAList a
replicate n = fromList . Prelude.replicate n
take :: Int -> RAList a -> RAList a
take n = fromList . Prelude.take n . toList
drop :: Int -> RAList a -> RAList a
drop n xs | n <= 0 = xs
drop n xs@(RAList s _) | n >= s = empty
drop n (RAList s wts) = RAList (sn) (loop n wts)
where loop 0 xs = xs
loop n (Cons w _ xs) | w <= n = loop (nw) xs
loop n (Cons w (Node _ l r) xs) = loop (n1) (Cons w2 l (Cons w2 r xs)) where w2 = w `quot` 2
loop _ _ = error "Data.RAList.drop: impossible"
splitAt :: Int -> RAList a -> (RAList a, RAList a)
splitAt n xs = (take n xs, drop n xs)
elem :: (Eq a) => a -> RAList a -> Bool
elem x = any (== x)
notElem :: (Eq a) => a -> RAList a -> Bool
notElem x = any (/= x)
lookup :: (Eq a) => a -> RAList (a, b) -> Maybe b
lookup x xys = Prelude.lookup x (toList xys)
filter :: (a->Bool) -> RAList a -> RAList a
filter p xs =
if null xs then
empty
else
let x = head xs
ys = filter p (tail xs)
in if p x then x `cons` ys else ys
partition :: (a->Bool) -> RAList a -> (RAList a, RAList a)
partition p xs = (filter p xs, filter (not . p) xs)
(!!) :: RAList a -> Int -> a
RAList s wts !! n | n < 0 = error "Data.RAList.!!: negative index"
| n >= s = error "Data.RAList.!!: index too large"
| otherwise = ix n wts
where ix n (Cons w t wts') | n < w = ixt n (w `quot` 2) t
| otherwise = ix (nw) wts'
ix _ _ = error "Data.RAList.!!: impossible"
ixt 0 0 (Leaf x) = x
ixt 0 _ (Node x l r) = x
ixt n w (Node x l r) | n <= w = ixt (n1) (w `quot` 2) l
| otherwise = ixt (n1w) (w `quot` 2) r
ixt n w _ = error "Data.RAList.!!: impossible"
zip :: RAList a -> RAList b -> RAList (a, b)
zip = zipWith (,)
zipWith :: (a->b->c) -> RAList a -> RAList b -> RAList c
zipWith f xs1@(RAList s1 wts1) xs2@(RAList s2 wts2)
| s1 == s2 = RAList s1 (zipTop wts1 wts2)
| otherwise = fromList $ Prelude.zipWith f (toList xs1) (toList xs2)
where zipTree (Leaf x1) (Leaf x2) = Leaf (f x1 x2)
zipTree (Node x1 l1 r1) (Node x2 l2 r2) = Node (f x1 x2) (zipTree l1 l2) (zipTree r1 r2)
zipTree _ _ = error "Data.RAList.zipWith: impossible"
zipTop Nil Nil = Nil
zipTop (Cons w t1 xs1) (Cons _ t2 xs2) = Cons w (zipTree t1 t2) (zipTop xs1 xs2)
zipTop _ _ = error "Data.RAList.zipWith: impossible"
unzip :: RAList (a, b) -> (RAList a, RAList b)
unzip xs = (map fst xs, map snd xs)
update :: Int -> a -> RAList a -> RAList a
update i x = adjust (const x) i
adjust :: (a->a) -> Int -> RAList a -> RAList a
adjust f n (RAList s wts) | n < 0 = error "Data.RAList.adjust: negative index"
| n >= s = error "Data.RAList.adjust: index too large"
| otherwise = RAList s (adj n wts)
where adj n (Cons w t wts') | n < w = Cons w (adjt n (w `quot` 2) t) wts'
| otherwise = Cons w t (adj (nw) wts')
adj _ _ = error "Data.RAList.adjust: impossible"
adjt 0 0 (Leaf x) = Leaf (f x)
adjt 0 _ (Node x l r) = Node (f x) l r
adjt n w (Node x l r) | n <= w = Node x (adjt (n1) (w `quot` 2) l) r
| otherwise = Node x l (adjt (n1w) (w `quot` 2) r)
adjt _ _ _ = error "Data.RAList.adjust: impossible"
toList :: RAList a -> [a]
toList (RAList _ wts) = tops wts []
where flat (Leaf x) a = x : a
flat (Node x l r) a = x : flat l (flat r a)
tops Nil r = r
tops (Cons _ t xs) r = flat t (tops xs r)
fromList :: [a] -> RAList a
fromList = Prelude.foldr cons empty
errorEmptyList :: String -> a
errorEmptyList fun =
error ("Data.RAList." Prelude.++ fun Prelude.++ ": empty list")