module Data.PrimitiveArray.Index.Subword where
import Control.DeepSeq (NFData(..))
import Data.Aeson (FromJSON,ToJSON)
import Data.Binary (Binary)
import Data.Hashable (Hashable)
import Data.Serialize (Serialize)
import Data.Vector.Fusion.Stream.Monadic (Step(..), map)
import Data.Vector.Unboxed.Deriving
import GHC.Generics (Generic)
import Prelude hiding (map)
import Test.QuickCheck (Arbitrary(..), choose)
import Data.PrimitiveArray.Index.Class
import Data.PrimitiveArray.Index.IOC
import Data.PrimitiveArray.Vector.Compat
newtype Subword t = Subword {fromSubword :: (Int:.Int)}
deriving (Eq,Ord,Show,Generic,Read)
derivingUnbox "Subword"
[t| forall t . Subword t -> (Int,Int) |]
[| \ (Subword (i:.j)) -> (i,j) |]
[| \ (i,j) -> Subword (i:.j) |]
instance Binary (Subword t)
instance Serialize (Subword t)
instance FromJSON (Subword t)
instance ToJSON (Subword t)
instance Hashable (Subword t)
instance NFData (Subword t) where
rnf (Subword (i:.j)) = i `seq` rnf j
subword :: Int -> Int -> Subword t
subword i j = Subword (i:.j)
subwordI :: Int -> Int -> Subword I
subwordI i j = Subword (i:.j)
subwordO :: Int -> Int -> Subword O
subwordO i j = Subword (i:.j)
subwordC :: Int -> Int -> Subword C
subwordC i j = Subword (i:.j)
triangularNumber :: Int -> Int
triangularNumber x = (x * (x+1)) `quot` 2
upperTri :: Subword t -> Int
upperTri (Subword (i:.j)) = triangularNumber $ ji+1
subwordIndex :: Subword s -> Subword t -> Int
subwordIndex (Subword (l:.n)) (Subword (i:.j)) = adr n (i,j)
where
adr n (i,j) = (n+1)*i triangularNumber i + j
subwordFromIndex :: Subword s -> Int -> Subword t
subwordFromIndex = error "subwordFromIndex not implemented"
instance Index (Subword t) where
linearIndex _ h i = subwordIndex h i
smallestLinearIndex _ = error "still needed?"
largestLinearIndex h = upperTri h 1
size _ h = upperTri h
inBounds _ (Subword (_:.h)) (Subword (i:.j)) = 0<=i && i<=j && j<=h
instance IndexStream z => IndexStream (z:.Subword I) where
streamUp (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamUpMk h) (streamUpStep l h) $ streamUp ls hs
streamDown (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamDownMk l h) (streamDownStep h) $ streamDown ls hs
instance IndexStream z => IndexStream (z:.Subword O) where
streamUp (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamDownMk l h) (streamDownStep h) $ streamUp ls hs
streamDown (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamUpMk h) (streamUpStep l h) $ streamDown ls hs
instance IndexStream z => IndexStream (z:.Subword C) where
streamUp (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamUpMk h) (streamUpStep l h) $ streamUp ls hs
streamDown (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten (streamDownMk l h) (streamDownStep h) $ streamDown ls hs
streamUpMk h z = return (z,h,h)
streamUpStep l h (z,i,j)
| i < l = return $ Done
| j > h = return $ Skip (z,i1,i1)
| otherwise = return $ Yield (z:.subword i j) (z,i,j+1)
streamDownMk l h z = return (z,l,h)
streamDownStep h (z,i,j)
| i > h = return $ Done
| j < i = return $ Skip (z,i+1,h)
| otherwise = return $ Yield (z:.subword i j) (z,i,j1)
instance (IndexStream (Z:.Subword t)) => IndexStream (Subword t)
instance Arbitrary (Subword t) where
arbitrary = do
a <- choose (0,100)
b <- choose (0,100)
return $ Subword (min a b :. max a b)
shrink (Subword (i:.j))
| i<j = [Subword (i:.j1), Subword (i+1:.j)]
| otherwise = []