module Test.Feat.Access(
index,
values,
striped,
bounded,
ioFeat,
ioAll,
ioBounded,
uniform,
toSeries,
valuesWith,
stripedWith,
boundedWith,
uniformWith,
toSeriesWith
)where
import Test.Feat.Enumerate
import Test.Feat.Class
import Data.List
import Test.QuickCheck
group :: Enumerate a -> Part -> Index -> Integer
group e p i = sum (map (card e) [0..p1]) + i
split :: Enumerate a -> Integer -> (Part, Index)
split e i0 = go i0 0 where
go i p = let crd = card e p in
if i < crd then (p,i)
else go (icrd) (p+1)
index :: Enumerate a -> Integer -> a
index e = uncurry (select e) . split e
values :: Enumerable a => [(Integer,[a])]
values = valuesWith optimised
striped :: Enumerable a => Part -> Index -> Integer -> [(Integer,[a])]
striped = stripedWith optimised
bounded :: Enumerable a => Integer -> [(Integer,[a])]
bounded = boundedWith optimised
ioFeat :: [(Integer,[a])] -> (a -> IO ()) -> IO ()
ioFeat vs f = go vs 0 0 where
go ((c,xs):xss) s tot = do
putStrLn $ "--- Testing "++show c++" values at size " ++ show s
mapM f xs
go xss (s+1) (tot + c)
go [] s tot = putStrLn $ "--- Done. Tested "++ show tot++" values"
ioAll :: Enumerable a => (a -> IO ()) -> IO ()
ioAll = ioFeat values
ioBounded :: Enumerable a => Integer -> (a -> IO ()) -> IO ()
ioBounded n = ioFeat (bounded n)
uniform :: Enumerable a => Int -> Gen a
uniform = uniformWith optimised
toSeries :: Enumerable a => Int -> [a]
toSeries = toSeriesWith optimised
valuesWith :: Enumerate a -> [(Integer,[a])]
valuesWith e =
[(crd,[select e p i|i <- [0..crd 1]])
|p <- [0..], let crd = card e p]
stripedWith :: Enumerate a -> Part -> Index -> Integer -> [(Integer,[a])]
stripedWith e p o step = if space <= 0
then (0,[]) : stripedWith e (p+1) (o crd) step
else (d,thisP) : stripedWith e (p+1) (stepm1) step
where
thisP =
[select e p x|x <- genericTake d $ iterate (+step) o]
space = crd o
(d,m) = divMod space step
crd = card e p
boundedWith :: Enumerate a -> Integer -> [(Integer,[a])]
boundedWith e n = map (samplePart e n) [0..]
samplePart :: Enumerate a -> Index -> Part -> (Integer,[a])
samplePart e m p =
let
top = toRational $ (card e p) 1
step = top / toRational (m1)
crd = card e p
in if toRational m >= top
then (crd, map (select e p) [0..crd 1])
else let d = floor ((toRational crd)/ step) in
(d+1,[select e p (round (k * step))|k <- map toRational [0..d]])
uniformWith :: Enumerate a -> Part -> Gen a
uniformWith e maxp = let
cards = [(card e x, x) | x <- [maxp, maxp1 .. 0]]
tot = sum $ fst $ unzip cards
in if tot == 0 then uniformWith e (maxp+1) else do
i <- choose (0,tot1)
return $ uncurry (select e) (lu i cards)
where
lu i ((crd,p):xs) = if i<crd
then (p,i)
else lu (icrd) xs
toSeriesWith :: Enumerate a -> Int -> [a]
toSeriesWith e d = concat (take (d+1) $ map snd $ valuesWith e)