benchmark/Streamly/Benchmark/Data/Stream/Transform.hs · streamly

git.iko.soy/streamly

on fe28607 help sign in

streamly/benchmark/Streamly/Benchmark/Data/Stream/Transform.hs

569 lines 20 kB history raw

1-- |

2-- Module : Stream.Transform

4-- License : BSD-3-Clause

5-- Maintainer : streamly@composewell.com

7{-# LANGUAGE CPP #-}

8{-# LANGUAGE FlexibleContexts #-}

9{-# LANGUAGE ScopedTypeVariables #-}

10{-# LANGUAGE RankNTypes #-}

12#ifdef USE_PRELUDE

13{-# OPTIONS_GHC -Wno-deprecations #-}

14#endif

16#ifdef __HADDOCK_VERSION__

17#undef INSPECTION

18#endif

20#ifdef INSPECTION

21{-# LANGUAGE TemplateHaskell #-}

22{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

23#endif

25module Stream.Transform (benchmarks) where

27import Control.DeepSeq (NFData(..))

28import Control.Monad.IO.Class (MonadIO(..))

29import Data.Functor.Identity (Identity)

31import System.Random (randomRIO)

33import qualified Streamly.Internal.Data.Fold as FL

35import qualified Prelude

36import qualified Stream.Common as Common

37import qualified Streamly.Internal.Data.Unfold as Unfold

38#ifdef USE_PRELUDE

39import qualified Streamly.Internal.Data.Stream.IsStream as Stream

40import Streamly.Internal.Data.Time.Units

41#else

42import qualified Streamly.Internal.Data.Stream.Time as Stream

43import qualified Streamly.Internal.Data.Stream as Stream

44#endif

46import Gauge

47import Streamly.Internal.Data.Stream (Stream)

48import Stream.Common hiding (scanl')

49import Streamly.Benchmark.Common

50import Prelude hiding (sequence, mapM)

52-------------------------------------------------------------------------------

53-- Pipelines (stream-to-stream transformations)

54-------------------------------------------------------------------------------

56-------------------------------------------------------------------------------

57-- one-to-one transformations

58-------------------------------------------------------------------------------

60-------------------------------------------------------------------------------

61-- Traversable Instance

62-------------------------------------------------------------------------------

64{-# INLINE traversableTraverse #-}

65traversableTraverse :: Stream Identity Int -> IO (Stream Identity Int)

66traversableTraverse = traverse return

68{-# INLINE traversableSequenceA #-}

69traversableSequenceA :: Stream Identity Int -> IO (Stream Identity Int)

70traversableSequenceA = sequenceA . Prelude.fmap return

72{-# INLINE traversableMapM #-}

73traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)

74traversableMapM = Prelude.mapM return

76{-# INLINE traversableSequence #-}

77traversableSequence :: Stream Identity Int -> IO (Stream Identity Int)

78traversableSequence = Prelude.sequence . Prelude.fmap return

80{-# INLINE benchPureSinkIO #-}

81benchPureSinkIO

82 :: NFData b

83 => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark

84benchPureSinkIO value name f =

85 bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value

87o_n_space_traversable :: Int -> [Benchmark]

88o_n_space_traversable value =

89 -- Buffering operations using heap proportional to number of elements.

90 [ bgroup "traversable"

91 -- Traversable instance

92 [ benchPureSinkIO value "traverse" traversableTraverse

93 , benchPureSinkIO value "sequenceA" traversableSequenceA

94 , benchPureSinkIO value "mapM" traversableMapM

95 , benchPureSinkIO value "sequence" traversableSequence

96 ]

97 ]

99-------------------------------------------------------------------------------

100-- maps and scans

101-------------------------------------------------------------------------------

102

103#ifdef USE_PRELUDE

104{-# INLINE scanl' #-}

105scanl' :: MonadIO m => Int -> Stream m Int -> m ()

106scanl' n = composeN n $ Stream.scanl' (+) 0

107

108{-# INLINE scanlM' #-}

109scanlM' :: MonadIO m => Int -> Stream m Int -> m ()

110scanlM' n = composeN n $ Stream.scanlM' (\b a -> return $ b + a) (return 0)

111

112{-# INLINE scanl1' #-}

113scanl1' :: MonadIO m => Int -> Stream m Int -> m ()

114scanl1' n = composeN n $ Stream.scanl1' (+)

115

116{-# INLINE scanl1M' #-}

117scanl1M' :: MonadIO m => Int -> Stream m Int -> m ()

118scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a)

119#endif

120

121{-# INLINE scan #-}

122scan :: MonadIO m => Int -> Stream m Int -> m ()

123scan n = composeN n $ Stream.scan FL.sum

124

125#ifdef USE_PRELUDE

126{-# INLINE postscanl' #-}

127postscanl' :: MonadIO m => Int -> Stream m Int -> m ()

128postscanl' n = composeN n $ Stream.postscanl' (+) 0

129

130{-# INLINE postscanlM' #-}

131postscanlM' :: MonadIO m => Int -> Stream m Int -> m ()

132postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0)

133#endif

134

135{-# INLINE postscan #-}

136postscan :: MonadIO m => Int -> Stream m Int -> m ()

137postscan n = composeN n $ Stream.postscan FL.sum

138

139{-# INLINE sequence #-}

140sequence :: MonadAsync m => Stream m (m Int) -> m ()

141sequence = Common.drain . Stream.sequence

142

143{-# INLINE tap #-}

144tap :: MonadIO m => Int -> Stream m Int -> m ()

145tap n = composeN n $ Stream.tap FL.sum

146

147#ifdef USE_PRELUDE

148{-# INLINE pollCounts #-}

149pollCounts :: Int -> Stream IO Int -> IO ()

150pollCounts n =

151 composeN n (Stream.pollCounts (const True) f)

152

153 where

154

155 f = Stream.drain . Stream.rollingMap2 (-) . Stream.delayPost 1

156

157{-# INLINE timestamped #-}

158timestamped :: (MonadAsync m) => Stream m Int -> m ()

159timestamped = Stream.drain . Stream.timestamped

160#endif

161

162{-# INLINE foldrS #-}

163foldrS :: MonadIO m => Int -> Stream m Int -> m ()

164foldrS n = composeN n $ Stream.foldrS Stream.cons Stream.nil

165

166{-# INLINE foldrSMap #-}

167foldrSMap :: MonadIO m => Int -> Stream m Int -> m ()

168foldrSMap n = composeN n $ Stream.foldrS (\x xs -> x + 1 `Stream.cons` xs) Stream.nil

169

170{-# INLINE foldrT #-}

171foldrT :: MonadIO m => Int -> Stream m Int -> m ()

172foldrT n = composeN n $ Stream.foldrT Stream.cons Stream.nil

173

174{-# INLINE foldrTMap #-}

175foldrTMap :: MonadIO m => Int -> Stream m Int -> m ()

176foldrTMap n = composeN n $ Stream.foldrT (\x xs -> x + 1 `Stream.cons` xs) Stream.nil

177

178{-# INLINE trace #-}

179trace :: MonadAsync m => Int -> Stream m Int -> m ()

180trace n = composeN n $ Stream.trace return

181

182o_1_space_mapping :: Int -> [Benchmark]

183o_1_space_mapping value =

184 [ bgroup

185 "mapping"

186 [

187 -- Right folds

188 benchIOSink value "foldrS" (foldrS 1)

189 , benchIOSink value "foldrSMap" (foldrSMap 1)

190 , benchIOSink value "foldrT" (foldrT 1)

191 , benchIOSink value "foldrTMap" (foldrTMap 1)

192

193 -- Mapping

194 , benchIOSink value "map" (mapN 1)

195 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->

196 sequence (sourceUnfoldrAction value n)

197 , benchIOSink value "mapM" (mapM 1)

198 , benchIOSink value "tap" (tap 1)

199#ifdef USE_PRELUDE

200 , benchIOSink value "pollCounts 1 second" (pollCounts 1)

201 , benchIOSink value "timestamped" timestamped

202

203 -- Scanning

204 , benchIOSink value "scanl'" (scanl' 1)

205 , benchIOSink value "scanl1'" (scanl1' 1)

206 , benchIOSink value "scanlM'" (scanlM' 1)

207 , benchIOSink value "scanl1M'" (scanl1M' 1)

208 , benchIOSink value "postscanl'" (postscanl' 1)

209 , benchIOSink value "postscanlM'" (postscanlM' 1)

210#endif

211 , benchIOSink value "scan" (scan 1)

212 , benchIOSink value "postscan" (postscan 1)

213 ]

214 ]

215

216o_1_space_mappingX4 :: Int -> [Benchmark]

217o_1_space_mappingX4 value =

218 [ bgroup "mappingX4"

219 [ benchIOSink value "map" (mapN 4)

220 , benchIOSink value "mapM" (mapM 4)

221 , benchIOSink value "trace" (trace 4)

222

223#ifdef USE_PRELUDE

224 , benchIOSink value "scanl'" (scanl' 4)

225 , benchIOSink value "scanl1'" (scanl1' 4)

226 , benchIOSink value "scanlM'" (scanlM' 4)

227 , benchIOSink value "scanl1M'" (scanl1M' 4)

228 , benchIOSink value "postscanl'" (postscanl' 4)

229 , benchIOSink value "postscanlM'" (postscanlM' 4)

230#endif

231 ]

232 ]

233

234{-# INLINE sieveScan #-}

235sieveScan :: Monad m => Stream m Int -> Stream m Int

236sieveScan =

237 Stream.mapMaybe snd

238 . Stream.scan (FL.foldlM' (\(primes, _) n -> do

239 return $

240 let ps = takeWhile (\p -> p * p <= n) primes

241 in if all (\p -> n `mod` p /= 0) ps

242 then (primes ++ [n], Just n)

243 else (primes, Nothing)) (return ([2], Just 2)))

244

245o_n_space_mapping :: Int -> [Benchmark]

246o_n_space_mapping value =

247 [ bgroup "mapping"

248 [ benchIO "naive prime sieve"

249 (\n -> Stream.fold FL.sum $ sieveScan $ Stream.enumerateFromTo 2 (value + n))

250 ]

251 ]

252

253-------------------------------------------------------------------------------

254-- Functor

255-------------------------------------------------------------------------------

256

257o_1_space_functor :: Int -> [Benchmark]

258o_1_space_functor value =

259 [ bgroup "Functor"

260 [ benchIOSink value "fmap" (mapN 1)

261 , benchIOSink value "fmap x 4" (mapN 4)

262 ]

263 ]

264

265-------------------------------------------------------------------------------

266-- Size reducing transformations (filtering)

267-------------------------------------------------------------------------------

268

269{-# INLINE filterEven #-}

270filterEven :: MonadIO m => Int -> Stream m Int -> m ()

271filterEven n = composeN n $ Stream.filter even

272

273{-# INLINE filterAllOut #-}

274filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()

275filterAllOut value n = composeN n $ Stream.filter (> (value + 1))

276

277{-# INLINE filterAllIn #-}

278filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()

279filterAllIn value n = composeN n $ Stream.filter (<= (value + 1))

280

281{-# INLINE filterMEven #-}

282filterMEven :: MonadIO m => Int -> Stream m Int -> m ()

283filterMEven n = composeN n $ Stream.filterM (return . even)

284

285{-# INLINE filterMAllOut #-}

286filterMAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()

287filterMAllOut value n = composeN n $ Stream.filterM (\x -> return $ x > (value + 1))

288

289{-# INLINE filterMAllIn #-}

290filterMAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()

291filterMAllIn value n = composeN n $ Stream.filterM (\x -> return $ x <= (value + 1))

292

293{-# INLINE _takeOne #-}

294_takeOne :: MonadIO m => Int -> Stream m Int -> m ()

295_takeOne n = composeN n $ Stream.take 1

296

297{-# INLINE takeAll #-}

298takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()

299takeAll value n = composeN n $ Stream.take (value + 1)

300

301{-# INLINE takeWhileTrue #-}

302takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()

303takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1))

304

305{-# INLINE takeWhileMTrue #-}

306takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()

307takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1)))

308

309{-# INLINE takeInterval #-}

310takeInterval :: Double -> Int -> Stream IO Int -> IO ()

311takeInterval i n = composeN n (Stream.takeInterval i)

312

313-- Inspection testing is disabled for takeInterval

314-- Enable it when looking at it throughly

315#ifdef INSPECTION

316-- inspect $ hasNoType 'takeInterval ''SPEC

317-- inspect $ hasNoTypeClasses 'takeInterval

318-- inspect $ 'takeInterval `hasNoType` ''D.Step

319#endif

320

321{-# INLINE dropOne #-}

322dropOne :: MonadIO m => Int -> Stream m Int -> m ()

323dropOne n = composeN n $ Stream.drop 1

324

325{-# INLINE dropAll #-}

326dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()

327dropAll value n = composeN n $ Stream.drop (value + 1)

328

329{-# INLINE dropWhileTrue #-}

330dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()

331dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1))

332

333{-# INLINE dropWhileMTrue #-}

334dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()

335dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1)))

336

337{-# INLINE dropWhileFalse #-}

338dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()

339dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1))

340

341#ifdef USE_PRELUDE

342-- XXX Decide on the time interval

343{-# INLINE _intervalsOfSum #-}

344_intervalsOfSum :: MonadAsync m => Double -> Int -> Stream m Int -> m ()

345_intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum)

346#endif

347

348{-# INLINE dropInterval #-}

349dropInterval :: Double -> Int -> Stream IO Int -> IO ()

350dropInterval i n = composeN n (Stream.dropInterval i)

351

352-- Inspection testing is disabled for dropInterval

353-- Enable it when looking at it throughly

354#ifdef INSPECTION

355-- inspect $ hasNoTypeClasses 'dropInterval

356-- inspect $ 'dropInterval `hasNoType` ''D.Step

357#endif

358

359{-# INLINE findIndices #-}

360findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()

361findIndices value n = composeN n $ Stream.findIndices (== (value + 1))

362

363{-# INLINE elemIndices #-}

364elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()

365elemIndices value n = composeN n $ Stream.elemIndices (value + 1)

366

367{-# INLINE deleteBy #-}

368deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()

369deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1)

370

371-- uniq . uniq == uniq, composeN 2 ~ composeN 1

372{-# INLINE uniq #-}

373uniq :: MonadIO m => Int -> Stream m Int -> m ()

374uniq n = composeN n Stream.uniq

375

376{-# INLINE mapMaybe #-}

377mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()

378mapMaybe n =

379 composeN n $

380 Stream.mapMaybe

381 (\x ->

382 if odd x

383 then Nothing

384 else Just x)

385

386{-# INLINE mapMaybeM #-}

387mapMaybeM :: MonadAsync m => Int -> Stream m Int -> m ()

388mapMaybeM n =

389 composeN n $

390 Stream.mapMaybeM

391 (\x ->

392 if odd x

393 then return Nothing

394 else return $ Just x)

395

396o_1_space_filtering :: Int -> [Benchmark]

397o_1_space_filtering value =

398 [ bgroup "filtering"

399 [ benchIOSink value "filter-even" (filterEven 1)

400 , benchIOSink value "filter-all-out" (filterAllOut value 1)

401 , benchIOSink value "filter-all-in" (filterAllIn value 1)

402

403 , benchIOSink value "filterM-even" (filterMEven 1)

404 , benchIOSink value "filterM-all-out" (filterMAllOut value 1)

405 , benchIOSink value "filterM-all-in" (filterMAllIn value 1)

406

407 -- Trimming

408 , benchIOSink value "take-all" (takeAll value 1)

409 , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)

410 -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)

411 , benchIOSink value "drop-one" (dropOne 1)

412 , benchIOSink value "drop-all" (dropAll value 1)

413 , benchIOSink value "takeInterval-all" (takeInterval 10000 1)

414 , benchIOSink value "dropInterval-all" (dropInterval 10000 1)

415 , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)

416 -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)

417 , benchIOSink

418 value

419 "dropWhile-false"

420 (dropWhileFalse value 1)

421 , benchIOSink value "deleteBy" (deleteBy value 1)

422

423 , benchIOSink value "uniq" (uniq 1)

424

425 -- Map and filter

426 , benchIOSink value "mapMaybe" (mapMaybe 1)

427 , benchIOSink value "mapMaybeM" (mapMaybeM 1)

428

429 -- Searching (stateful map and filter)

430 , benchIOSink value "findIndices" (findIndices value 1)

431 , benchIOSink value "elemIndices" (elemIndices value 1)

432 ]

433 ]

434

435o_1_space_filteringX4 :: Int -> [Benchmark]

436o_1_space_filteringX4 value =

437 [ bgroup "filteringX4"

438 [ benchIOSink value "filter-even" (filterEven 4)

439 , benchIOSink value "filter-all-out" (filterAllOut value 4)

440 , benchIOSink value "filter-all-in" (filterAllIn value 4)

441

442 , benchIOSink value "filterM-even" (filterMEven 4)

443 , benchIOSink value "filterM-all-out" (filterMAllOut value 4)

444 , benchIOSink value "filterM-all-in" (filterMAllIn value 4)

445

446 -- trimming

447 , benchIOSink value "take-all" (takeAll value 4)

448 , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)

449 , benchIOSink value "takeWhileM-true" (takeWhileMTrue value 4)

450 , benchIOSink value "drop-one" (dropOne 4)

451 , benchIOSink value "drop-all" (dropAll value 4)

452 , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)

453 , benchIOSink value "dropWhileM-true" (dropWhileMTrue value 4)

454 , benchIOSink

455 value

456 "dropWhile-false"

457 (dropWhileFalse value 4)

458 , benchIOSink value "deleteBy" (deleteBy value 4)

459

460 , benchIOSink value "uniq" (uniq 4)

461

462 -- map and filter

463 , benchIOSink value "mapMaybe" (mapMaybe 4)

464 , benchIOSink value "mapMaybeM" (mapMaybeM 4)

465

466 -- searching

467 , benchIOSink value "findIndices" (findIndices value 4)

468 , benchIOSink value "elemIndices" (elemIndices value 4)

469 ]

470 ]

471

472-------------------------------------------------------------------------------

473-- Size increasing transformations (insertions)

474-------------------------------------------------------------------------------

475

476{-# INLINE intersperse #-}

477intersperse :: MonadAsync m => Int -> Int -> Stream m Int -> m ()

478intersperse value n = composeN n $ Stream.intersperse (value + 1)

479

480{-# INLINE intersperseM #-}

481intersperseM :: MonadAsync m => Int -> Int -> Stream m Int -> m ()

482intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1)

483

484{-# INLINE insertBy #-}

485insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()

486insertBy value n = composeN n $ Stream.insertBy compare (value + 1)

487

488{-# INLINE interposeSuffix #-}

489interposeSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()

490interposeSuffix value n =

491 composeN n $ Stream.interposeSuffix (value + 1) Unfold.identity

492

493{-# INLINE intercalateSuffix #-}

494intercalateSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()

495intercalateSuffix value n =

496 composeN n $ Stream.intercalateSuffix Unfold.identity (value + 1)

497

498o_1_space_inserting :: Int -> [Benchmark]

499o_1_space_inserting value =

500 [ bgroup "inserting"

501 [ benchIOSink value "intersperse" (intersperse value 1)

502 , benchIOSink value "intersperseM" (intersperseM value 1)

503 , benchIOSink value "insertBy" (insertBy value 1)

504 , benchIOSink value "interposeSuffix" (interposeSuffix value 1)

505 , benchIOSink value "intercalateSuffix" (intercalateSuffix value 1)

506 ]

507 ]

508

509o_1_space_insertingX4 :: Int -> [Benchmark]

510o_1_space_insertingX4 value =

511 [ bgroup "insertingX4"

512 [ benchIOSink value "intersperse" (intersperse value 4)

513 , benchIOSink value "insertBy" (insertBy value 4)

514 ]

515 ]

516

517-------------------------------------------------------------------------------

518-- Indexing

519-------------------------------------------------------------------------------

520

521{-# INLINE indexed #-}

522indexed :: MonadIO m => Int -> Stream m Int -> m ()

523indexed n = composeN n (fmap snd . Stream.indexed)

524

525{-# INLINE indexedR #-}

526indexedR :: MonadIO m => Int -> Int -> Stream m Int -> m ()

527indexedR value n = composeN n (fmap snd . Stream.indexedR value)

528

529o_1_space_indexing :: Int -> [Benchmark]

530o_1_space_indexing value =

531 [ bgroup "indexing"

532 [ benchIOSink value "indexed" (indexed 1)

533 , benchIOSink value "indexedR" (indexedR value 1)

534 ]

535 ]

536

537o_1_space_indexingX4 :: Int -> [Benchmark]

538o_1_space_indexingX4 value =

539 [ bgroup "indexingx4"

540 [ benchIOSink value "indexed" (indexed 4)

541 , benchIOSink value "indexedR" (indexedR value 4)

542 ]

543 ]

544

545-------------------------------------------------------------------------------

546-- Main

547-------------------------------------------------------------------------------

548

549-- In addition to gauge options, the number of elements in the stream can be

550-- passed using the --stream-size option.

551--

552benchmarks :: String -> Int -> [Benchmark]

553benchmarks moduleName size =

554 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat

555 [ o_1_space_functor size

556 , o_1_space_mapping size

557 , o_1_space_mappingX4 size

558 , o_1_space_filtering size

559 , o_1_space_filteringX4 size

560 , o_1_space_inserting size

561 , o_1_space_insertingX4 size

562 , o_1_space_indexing size

563 , o_1_space_indexingX4 size

564 ]

565 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat

566 [ o_n_space_traversable size

567 , o_n_space_mapping size

568 ]

569 ]