module Data.PrimitiveArray.Index.Subword where
import Control.DeepSeq (NFData(..))
import Data.Aeson (FromJSON,ToJSON)
import Data.Binary (Binary)
import Data.Serialize (Serialize)
import Data.Vector.Fusion.Stream.Monadic (Step(..), flatten, map)
import Data.Vector.Fusion.Stream.Size
import Data.Vector.Unboxed.Deriving
import GHC.Generics (Generic)
import Test.QuickCheck (Arbitrary(..), choose)
import Prelude hiding (map)
import Data.PrimitiveArray.Index.Class
newtype Subword = Subword {fromSubword :: (Int:.Int)}
deriving (Eq,Ord,Show,Generic,Read)
derivingUnbox "Subword"
[t| Subword -> (Int,Int) |]
[| \ (Subword (i:.j)) -> (i,j) |]
[| \ (i,j) -> Subword (i:.j) |]
instance Binary Subword
instance Serialize Subword
instance FromJSON Subword
instance ToJSON Subword
instance NFData Subword where
rnf (Subword (i:.j)) = i `seq` rnf j
subword :: Int -> Int -> Subword
subword i j = Subword (i:.j)
triangularNumber :: Int -> Int
triangularNumber x = (x * (x+1)) `quot` 2
upperTri :: Subword -> Int
upperTri (Subword (i:.j)) = triangularNumber $ ji+1
subwordIndex :: Subword -> Subword -> 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 -> Int -> Subword
subwordFromIndex = error "subwordFromIndex not implemented"
instance Index Subword 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) where
streamUp (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten mk step Unknown $ streamUp ls hs
where mk z = return (z,h,h)
step (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)
streamDown (ls:.Subword (l:._)) (hs:.Subword (_:.h)) = flatten mk step Unknown $ streamDown ls hs
where mk z = return (z,l,h)
step (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 Subword where
streamUp l h = map (\(Z:.i) -> i) $ streamUp (Z:.l) (Z:.h)
streamDown l h = map (\(Z:.i) -> i) $ streamDown (Z:.l) (Z:.h)
instance Arbitrary Subword 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 = []