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

git.iko.soy/streamly

on 30c98dc help sign in

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

570 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 __HADDOCK_VERSION__

13#undef INSPECTION

14#endif

16#ifdef INSPECTION

17{-# LANGUAGE TemplateHaskell #-}

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

19#endif

21module Stream.Transform (benchmarks) where

23import Control.DeepSeq (NFData(..))

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

25import Data.Functor.Identity (Identity)

27import System.Random (randomRIO)

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

31import qualified Prelude

32import qualified Stream.Common as Common

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

34#ifdef USE_PRELUDE

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

36import Streamly.Internal.Data.Time.Units

37#else

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

39#endif

41import Gauge

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

43import Stream.Common hiding (scanl')

44import Streamly.Benchmark.Common

45import Prelude hiding (sequence, mapM)

47-------------------------------------------------------------------------------

48-- Pipelines (stream-to-stream transformations)

49-------------------------------------------------------------------------------

51-------------------------------------------------------------------------------

52-- one-to-one transformations

53-------------------------------------------------------------------------------

55-------------------------------------------------------------------------------

56-- Traversable Instance

57-------------------------------------------------------------------------------

59{-# INLINE traversableTraverse #-}

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

61traversableTraverse = traverse return

63{-# INLINE traversableSequenceA #-}

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

65traversableSequenceA = sequenceA . Prelude.fmap return

67{-# INLINE traversableMapM #-}

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

69traversableMapM = Prelude.mapM return

71{-# INLINE traversableSequence #-}

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

73traversableSequence = Prelude.sequence . Prelude.fmap return

75{-# INLINE benchPureSinkIO #-}

76benchPureSinkIO

77 :: NFData b

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

79benchPureSinkIO value name f =

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

82o_n_space_traversable :: Int -> [Benchmark]

83o_n_space_traversable value =

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

85 [ bgroup "traversable"

86 -- Traversable instance

87 [ benchPureSinkIO value "traverse" traversableTraverse

88 , benchPureSinkIO value "sequenceA" traversableSequenceA

89 , benchPureSinkIO value "mapM" traversableMapM

90 , benchPureSinkIO value "sequence" traversableSequence

91 ]

92 ]

94-------------------------------------------------------------------------------

95-- maps and scans

96-------------------------------------------------------------------------------

98#ifdef USE_PRELUDE

99{-# INLINE scanl' #-}

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

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

102

103{-# INLINE scanlM' #-}

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

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

106

107{-# INLINE scanl1' #-}

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

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

110

111{-# INLINE scanl1M' #-}

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

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

114#endif

115

116{-# INLINE scan #-}

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

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

119

120#ifdef USE_PRELUDE

121{-# INLINE postscanl' #-}

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

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

124

125{-# INLINE postscanlM' #-}

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

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

128#endif

129

130{-# INLINE postscan #-}

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

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

133

134{-# INLINE sequence #-}

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

136sequence = Common.drain . Stream.sequence

137

138{-# INLINE tap #-}

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

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

141

142#ifdef USE_PRELUDE

143{-# INLINE pollCounts #-}

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

145pollCounts n =

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

147

148 where

149

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

151

152{-# INLINE timestamped #-}

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

154timestamped = Stream.drain . Stream.timestamped

155#endif

156

157{-# INLINE foldrS #-}

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

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

160

161{-# INLINE foldrSMap #-}

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

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

164

165{-# INLINE foldrT #-}

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

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

168

169{-# INLINE foldrTMap #-}

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

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

172

173{-# INLINE trace #-}

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

175trace n = composeN n $ Stream.trace return

176

177o_1_space_mapping :: Int -> [Benchmark]

178o_1_space_mapping value =

179 [ bgroup

180 "mapping"

181 [

182 -- Right folds

183 benchIOSink value "foldrS" (foldrS 1)

184 , benchIOSink value "foldrSMap" (foldrSMap 1)

185 , benchIOSink value "foldrT" (foldrT 1)

186 , benchIOSink value "foldrTMap" (foldrTMap 1)

187

188 -- Mapping

189 , benchIOSink value "map" (mapN 1)

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

191 sequence (sourceUnfoldrAction value n)

192 , benchIOSink value "mapM" (mapM 1)

193 , benchIOSink value "tap" (tap 1)

194#ifdef USE_PRELUDE

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

196 , benchIOSink value "timestamped" timestamped

197

198 -- Scanning

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

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

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

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

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

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

205#endif

206 , benchIOSink value "scan" (scan 1)

207 , benchIOSink value "postscan" (postscan 1)

208 ]

209 ]

210

211o_1_space_mappingX4 :: Int -> [Benchmark]

212o_1_space_mappingX4 value =

213 [ bgroup "mappingX4"

214 [ benchIOSink value "map" (mapN 4)

215 , benchIOSink value "mapM" (mapM 4)

216 , benchIOSink value "trace" (trace 4)

217

218#ifdef USE_PRELUDE

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

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

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

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

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

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

225#endif

226 ]

227 ]

228

229{-# INLINE sieveScan #-}

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

231sieveScan =

232 Stream.mapMaybe snd

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

234 return $

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

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

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

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

239

240o_n_space_mapping :: Int -> [Benchmark]

241o_n_space_mapping value =

242 [ bgroup "mapping"

243 [ benchIO "naive prime sieve"

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

245 ]

246 ]

247

248-------------------------------------------------------------------------------

249-- Functor

250-------------------------------------------------------------------------------

251

252o_1_space_functor :: Int -> [Benchmark]

253o_1_space_functor value =

254 [ bgroup "Functor"

255 [ benchIOSink value "fmap" (mapN 1)

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

257 ]

258 ]

259

260-------------------------------------------------------------------------------

261-- Size reducing transformations (filtering)

262-------------------------------------------------------------------------------

263

264{-# INLINE filterEven #-}

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

266filterEven n = composeN n $ Stream.filter even

267

268{-# INLINE filterAllOut #-}

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

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

271

272{-# INLINE filterAllIn #-}

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

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

275

276{-# INLINE filterMEven #-}

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

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

279

280{-# INLINE filterMAllOut #-}

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

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

283

284{-# INLINE filterMAllIn #-}

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

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

287

288{-# INLINE _takeOne #-}

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

290_takeOne n = composeN n $ Stream.take 1

291

292{-# INLINE takeAll #-}

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

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

295

296{-# INLINE takeWhileTrue #-}

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

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

299

300{-# INLINE takeWhileMTrue #-}

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

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

303

304#ifdef USE_PRELUDE

305{-# INLINE takeInterval #-}

306takeInterval :: NanoSecond64 -> Int -> Stream IO Int -> IO ()

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

308

309#ifdef INSPECTION

310-- inspect $ hasNoType 'takeInterval ''SPEC

311inspect $ hasNoTypeClasses 'takeInterval

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

313#endif

314#endif

315

316{-# INLINE dropOne #-}

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

318dropOne n = composeN n $ Stream.drop 1

319

320{-# INLINE dropAll #-}

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

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

323

324{-# INLINE dropWhileTrue #-}

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

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

327

328{-# INLINE dropWhileMTrue #-}

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

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

331

332{-# INLINE dropWhileFalse #-}

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

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

335

336#ifdef USE_PRELUDE

337-- XXX Decide on the time interval

338{-# INLINE _intervalsOfSum #-}

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

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

341

342{-# INLINE dropInterval #-}

343dropInterval :: NanoSecond64 -> Int -> Stream IO Int -> IO ()

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

345

346#ifdef INSPECTION

347inspect $ hasNoTypeClasses 'dropInterval

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

349#endif

350#endif

351

352{-# INLINE findIndices #-}

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

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

355

356{-# INLINE elemIndices #-}

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

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

359

360{-# INLINE deleteBy #-}

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

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

363

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

365{-# INLINE uniq #-}

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

367uniq n = composeN n Stream.uniq

368

369{-# INLINE mapMaybe #-}

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

371mapMaybe n =

372 composeN n $

373 Stream.mapMaybe

374 (\x ->

375 if odd x

376 then Nothing

377 else Just x)

378

379{-# INLINE mapMaybeM #-}

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

381mapMaybeM n =

382 composeN n $

383 Stream.mapMaybeM

384 (\x ->

385 if odd x

386 then return Nothing

387 else return $ Just x)

388

389o_1_space_filtering :: Int -> [Benchmark]

390o_1_space_filtering value =

391 [ bgroup "filtering"

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

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

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

395

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

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

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

399

400 -- Trimming

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

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

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

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

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

406#ifdef USE_PRELUDE

407 , benchIOSink

408 value

409 "takeInterval-all"

410 (takeInterval (NanoSecond64 maxBound) 1)

411 , benchIOSink

412 value

413 "dropInterval-all"

414 (dropInterval (NanoSecond64 maxBound) 1)

415#endif

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

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

418 , benchIOSink

419 value

420 "dropWhile-false"

421 (dropWhileFalse value 1)

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

423

424 , benchIOSink value "uniq" (uniq 1)

425

426 -- Map and filter

427 , benchIOSink value "mapMaybe" (mapMaybe 1)

428 , benchIOSink value "mapMaybeM" (mapMaybeM 1)

429

430 -- Searching (stateful map and filter)

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

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

433 ]

434 ]

435

436o_1_space_filteringX4 :: Int -> [Benchmark]

437o_1_space_filteringX4 value =

438 [ bgroup "filteringX4"

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

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

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

442

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

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

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

446

447 -- trimming

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

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

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

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

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

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

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

455 , benchIOSink

456 value

457 "dropWhile-false"

458 (dropWhileFalse value 4)

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

460

461 , benchIOSink value "uniq" (uniq 4)

462

463 -- map and filter

464 , benchIOSink value "mapMaybe" (mapMaybe 4)

465 , benchIOSink value "mapMaybeM" (mapMaybeM 4)

466

467 -- searching

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

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

470 ]

471 ]

472

473-------------------------------------------------------------------------------

474-- Size increasing transformations (insertions)

475-------------------------------------------------------------------------------

476

477{-# INLINE intersperse #-}

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

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

480

481{-# INLINE intersperseM #-}

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

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

484

485{-# INLINE insertBy #-}

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

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

488

489{-# INLINE interposeSuffix #-}

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

491interposeSuffix value n =

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

493

494{-# INLINE intercalateSuffix #-}

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

496intercalateSuffix value n =

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

498

499o_1_space_inserting :: Int -> [Benchmark]

500o_1_space_inserting value =

501 [ bgroup "inserting"

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

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

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

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

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

507 ]

508 ]

509

510o_1_space_insertingX4 :: Int -> [Benchmark]

511o_1_space_insertingX4 value =

512 [ bgroup "insertingX4"

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

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

515 ]

516 ]

517

518-------------------------------------------------------------------------------

519-- Indexing

520-------------------------------------------------------------------------------

521

522{-# INLINE indexed #-}

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

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

525

526{-# INLINE indexedR #-}

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

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

529

530o_1_space_indexing :: Int -> [Benchmark]

531o_1_space_indexing value =

532 [ bgroup "indexing"

533 [ benchIOSink value "indexed" (indexed 1)

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

535 ]

536 ]

537

538o_1_space_indexingX4 :: Int -> [Benchmark]

539o_1_space_indexingX4 value =

540 [ bgroup "indexingx4"

541 [ benchIOSink value "indexed" (indexed 4)

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

543 ]

544 ]

545

546-------------------------------------------------------------------------------

547-- Main

548-------------------------------------------------------------------------------

549

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

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

552--

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

554benchmarks moduleName size =

555 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat

556 [ o_1_space_functor size

557 , o_1_space_mapping size

558 , o_1_space_mappingX4 size

559 , o_1_space_filtering size

560 , o_1_space_filteringX4 size

561 , o_1_space_inserting size

562 , o_1_space_insertingX4 size

563 , o_1_space_indexing size

564 , o_1_space_indexingX4 size

565 ]

566 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat

567 [ o_n_space_traversable size

568 , o_n_space_mapping size

569 ]

570 ]