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

git.iko.soy/streamly

on 4eaeb10 help sign in

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

565 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.IsStream.Parallel as Stream

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

40#endif

42import Gauge

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

44import Stream.Common hiding (scanl')

45import Streamly.Benchmark.Common

46import Prelude hiding (sequence, mapM)

48-------------------------------------------------------------------------------

49-- Pipelines (stream-to-stream transformations)

50-------------------------------------------------------------------------------

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

53-- one-to-one transformations

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

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

57-- Traversable Instance

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

60{-# INLINE traversableTraverse #-}

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

62traversableTraverse = traverse return

64{-# INLINE traversableSequenceA #-}

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

66traversableSequenceA = sequenceA . Prelude.fmap return

68{-# INLINE traversableMapM #-}

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

70traversableMapM = Prelude.mapM return

72{-# INLINE traversableSequence #-}

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

74traversableSequence = Prelude.sequence . Prelude.fmap return

76{-# INLINE benchPureSinkIO #-}

77benchPureSinkIO

78 :: NFData b

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

80benchPureSinkIO value name f =

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

83o_n_space_traversable :: Int -> [Benchmark]

84o_n_space_traversable value =

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

86 [ bgroup "traversable"

87 -- Traversable instance

88 [ benchPureSinkIO value "traverse" traversableTraverse

89 , benchPureSinkIO value "sequenceA" traversableSequenceA

90 , benchPureSinkIO value "mapM" traversableMapM

91 , benchPureSinkIO value "sequence" traversableSequence

92 ]

93 ]

95-------------------------------------------------------------------------------

96-- maps and scans

97-------------------------------------------------------------------------------

99#ifdef USE_PRELUDE

100{-# INLINE scanl' #-}

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

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

103

104{-# INLINE scanlM' #-}

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

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

107

108{-# INLINE scanl1' #-}

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

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

111

112{-# INLINE scanl1M' #-}

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

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

115#endif

116

117{-# INLINE scan #-}

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

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

120

121#ifdef USE_PRELUDE

122{-# INLINE postscanl' #-}

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

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

125

126{-# INLINE postscanlM' #-}

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

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

129#endif

130

131{-# INLINE postscan #-}

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

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

134

135{-# INLINE sequence #-}

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

137sequence = Common.drain . Stream.sequence

138

139{-# INLINE tap #-}

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

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

142

143#ifdef USE_PRELUDE

144{-# INLINE pollCounts #-}

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

146pollCounts n =

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

148

149 where

150

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

152

153{-# INLINE timestamped #-}

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

155timestamped = Stream.drain . Stream.timestamped

156#endif

157

158{-# INLINE foldrS #-}

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

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

161

162{-# INLINE foldrSMap #-}

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

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

165

166{-# INLINE foldrT #-}

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

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

169

170{-# INLINE foldrTMap #-}

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

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

173

174{-# INLINE trace #-}

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

176trace n = composeN n $ Stream.trace return

177

178o_1_space_mapping :: Int -> [Benchmark]

179o_1_space_mapping value =

180 [ bgroup

181 "mapping"

182 [

183 -- Right folds

184 benchIOSink value "foldrS" (foldrS 1)

185 , benchIOSink value "foldrSMap" (foldrSMap 1)

186 , benchIOSink value "foldrT" (foldrT 1)

187 , benchIOSink value "foldrTMap" (foldrTMap 1)

188

189 -- Mapping

190 , benchIOSink value "map" (mapN 1)

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

192 sequence (sourceUnfoldrAction value n)

193 , benchIOSink value "mapM" (mapM 1)

194 , benchIOSink value "tap" (tap 1)

195#ifdef USE_PRELUDE

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

197 , benchIOSink value "timestamped" timestamped

198

199 -- Scanning

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

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

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

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

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

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

206#endif

207 , benchIOSink value "scan" (scan 1)

208 , benchIOSink value "postscan" (postscan 1)

209 ]

210 ]

211

212o_1_space_mappingX4 :: Int -> [Benchmark]

213o_1_space_mappingX4 value =

214 [ bgroup "mappingX4"

215 [ benchIOSink value "map" (mapN 4)

216 , benchIOSink value "mapM" (mapM 4)

217 , benchIOSink value "trace" (trace 4)

218

219#ifdef USE_PRELUDE

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

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

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

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

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

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

226#endif

227 ]

228 ]

229

230{-# INLINE sieveScan #-}

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

232sieveScan =

233 Stream.mapMaybe snd

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

235 return $

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

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

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

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

240

241o_n_space_mapping :: Int -> [Benchmark]

242o_n_space_mapping value =

243 [ bgroup "mapping"

244 [ benchIO "naive prime sieve"

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

246 ]

247 ]

248

249-------------------------------------------------------------------------------

250-- Functor

251-------------------------------------------------------------------------------

252

253o_1_space_functor :: Int -> [Benchmark]

254o_1_space_functor value =

255 [ bgroup "Functor"

256 [ benchIOSink value "fmap" (mapN 1)

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

258 ]

259 ]

260

261-------------------------------------------------------------------------------

262-- Size reducing transformations (filtering)

263-------------------------------------------------------------------------------

264

265{-# INLINE filterEven #-}

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

267filterEven n = composeN n $ Stream.filter even

268

269{-# INLINE filterAllOut #-}

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

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

272

273{-# INLINE filterAllIn #-}

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

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

276

277{-# INLINE filterMEven #-}

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

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

280

281{-# INLINE filterMAllOut #-}

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

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

284

285{-# INLINE filterMAllIn #-}

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

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

288

289{-# INLINE _takeOne #-}

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

291_takeOne n = composeN n $ Stream.take 1

292

293{-# INLINE takeAll #-}

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

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

296

297{-# INLINE takeWhileTrue #-}

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

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

300

301{-# INLINE takeWhileMTrue #-}

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

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

304

305{-# INLINE takeInterval #-}

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

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

308

309-- Inspection testing is disabled for takeInterval

310-- Enable it when looking at it throughly

311#ifdef INSPECTION

312-- inspect $ hasNoType 'takeInterval ''SPEC

313-- inspect $ hasNoTypeClasses 'takeInterval

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

315#endif

316

317{-# INLINE dropOne #-}

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

319dropOne n = composeN n $ Stream.drop 1

320

321{-# INLINE dropAll #-}

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

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

324

325{-# INLINE dropWhileTrue #-}

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

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

328

329{-# INLINE dropWhileMTrue #-}

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

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

332

333{-# INLINE dropWhileFalse #-}

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

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

336

337#ifdef USE_PRELUDE

338-- XXX Decide on the time interval

339{-# INLINE _intervalsOfSum #-}

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

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

342#endif

343

344{-# INLINE dropInterval #-}

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

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

347

348-- Inspection testing is disabled for dropInterval

349-- Enable it when looking at it throughly

350#ifdef INSPECTION

351-- inspect $ hasNoTypeClasses 'dropInterval

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

353#endif

354

355{-# INLINE findIndices #-}

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

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

358

359{-# INLINE elemIndices #-}

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

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

362

363{-# INLINE deleteBy #-}

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

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

366

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

368{-# INLINE uniq #-}

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

370uniq n = composeN n Stream.uniq

371

372{-# INLINE mapMaybe #-}

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

374mapMaybe n =

375 composeN n $

376 Stream.mapMaybe

377 (\x ->

378 if odd x

379 then Nothing

380 else Just x)

381

382{-# INLINE mapMaybeM #-}

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

384mapMaybeM n =

385 composeN n $

386 Stream.mapMaybeM

387 (\x ->

388 if odd x

389 then return Nothing

390 else return $ Just x)

391

392o_1_space_filtering :: Int -> [Benchmark]

393o_1_space_filtering value =

394 [ bgroup "filtering"

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

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

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

398

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

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

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

402

403 -- Trimming

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

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

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

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

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

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

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

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

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

413 , benchIOSink

414 value

415 "dropWhile-false"

416 (dropWhileFalse value 1)

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

418

419 , benchIOSink value "uniq" (uniq 1)

420

421 -- Map and filter

422 , benchIOSink value "mapMaybe" (mapMaybe 1)

423 , benchIOSink value "mapMaybeM" (mapMaybeM 1)

424

425 -- Searching (stateful map and filter)

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

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

428 ]

429 ]

430

431o_1_space_filteringX4 :: Int -> [Benchmark]

432o_1_space_filteringX4 value =

433 [ bgroup "filteringX4"

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

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

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

437

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

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

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

441

442 -- trimming

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

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

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

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

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

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

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

450 , benchIOSink

451 value

452 "dropWhile-false"

453 (dropWhileFalse value 4)

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

455

456 , benchIOSink value "uniq" (uniq 4)

457

458 -- map and filter

459 , benchIOSink value "mapMaybe" (mapMaybe 4)

460 , benchIOSink value "mapMaybeM" (mapMaybeM 4)

461

462 -- searching

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

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

465 ]

466 ]

467

468-------------------------------------------------------------------------------

469-- Size increasing transformations (insertions)

470-------------------------------------------------------------------------------

471

472{-# INLINE intersperse #-}

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

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

475

476{-# INLINE intersperseM #-}

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

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

479

480{-# INLINE insertBy #-}

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

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

483

484{-# INLINE interposeSuffix #-}

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

486interposeSuffix value n =

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

488

489{-# INLINE intercalateSuffix #-}

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

491intercalateSuffix value n =

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

493

494o_1_space_inserting :: Int -> [Benchmark]

495o_1_space_inserting value =

496 [ bgroup "inserting"

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

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

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

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

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

502 ]

503 ]

504

505o_1_space_insertingX4 :: Int -> [Benchmark]

506o_1_space_insertingX4 value =

507 [ bgroup "insertingX4"

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

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

510 ]

511 ]

512

513-------------------------------------------------------------------------------

514-- Indexing

515-------------------------------------------------------------------------------

516

517{-# INLINE indexed #-}

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

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

520

521{-# INLINE indexedR #-}

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

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

524

525o_1_space_indexing :: Int -> [Benchmark]

526o_1_space_indexing value =

527 [ bgroup "indexing"

528 [ benchIOSink value "indexed" (indexed 1)

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

530 ]

531 ]

532

533o_1_space_indexingX4 :: Int -> [Benchmark]

534o_1_space_indexingX4 value =

535 [ bgroup "indexingx4"

536 [ benchIOSink value "indexed" (indexed 4)

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

538 ]

539 ]

540

541-------------------------------------------------------------------------------

542-- Main

543-------------------------------------------------------------------------------

544

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

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

547--

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

549benchmarks moduleName size =

550 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat

551 [ o_1_space_functor size

552 , o_1_space_mapping size

553 , o_1_space_mappingX4 size

554 , o_1_space_filtering size

555 , o_1_space_filteringX4 size

556 , o_1_space_inserting size

557 , o_1_space_insertingX4 size

558 , o_1_space_indexing size

559 , o_1_space_indexingX4 size

560 ]

561 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat

562 [ o_n_space_traversable size

563 , o_n_space_mapping size

564 ]

565 ]