Skip to content

Commit 0eedbf3

Browse files
harendra-kumarharendra-kumar
committed
Add logic programming/equation solving benchmarks
1 parent b04c799 commit 0eedbf3

1 file changed

Lines changed: 204 additions & 0 deletions

File tree

  • benchmark/Streamly/Benchmark/Data/Stream

‎benchmark/Streamly/Benchmark/Data/Stream/Expand.hs‎

Lines changed: 204 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,10 @@ import Streamly.Benchmark.Prelude
4242
import Streamly.Data.Stream (Stream)
4343
import Streamly.Data.Unfold (Unfold)
4444
import qualified Streamly.Internal.Data.Stream as S
45+
import qualified Streamly.Internal.Data.Unfold as Unfold
46+
import qualified Streamly.Internal.Data.Fold as Fold
4547
import qualified Streamly.Internal.Data.Stream as Stream
48+
import qualified Streamly.Internal.Data.StreamK as StreamK
4649
#endif
4750

4851
import Test.Tasty.Bench
@@ -437,6 +440,203 @@ o_1_space_bind streamLen =
437440
streamLen4 = round (fromIntegral streamLen**(1/4::Double)) -- 4 times nested loop
438441
streamLen5 = round (fromIntegral streamLen**(1/5::Double)) -- 5 times nested loop
439442

443+
-- search space |x| = 1000, |y| = 1000
444+
{-# INLINE boundedInts #-}
445+
boundedInts :: Monad m => Int -> Int -> Stream m Int
446+
boundedInts n _ =
447+
Stream.interleave
448+
(Stream.enumerateFromTo (0 :: Int) n)
449+
(Stream.enumerateFromThenTo (-1) (-2) (-n))
450+
451+
{-# INLINE infiniteInts #-}
452+
infiniteInts :: Monad m => Int -> Int -> Stream m Int
453+
infiniteInts _ _ =
454+
Stream.interleave
455+
(Stream.enumerateFrom (0 :: Int))
456+
(Stream.enumerateFromThen (-1) (-2))
457+
458+
{-# INLINE boundedIntsUnfold #-}
459+
boundedIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int
460+
boundedIntsUnfold n _ =
461+
Unfold.interleave
462+
(Unfold.supply (0 :: Int, n) Unfold.enumerateFromTo)
463+
(Unfold.supply (-1, -2, -n) Unfold.enumerateFromThenTo)
464+
465+
{-# INLINE infiniteIntsUnfold #-}
466+
infiniteIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int
467+
infiniteIntsUnfold _ _ =
468+
Unfold.interleave
469+
(Unfold.supply (0 :: Int) Unfold.enumerateFrom)
470+
(Unfold.supply (-1, -2) Unfold.enumerateFromThen)
471+
472+
{-# INLINE checkStream #-}
473+
checkStream :: Applicative m =>
474+
Int -> Int -> Stream m (Maybe (Maybe (Int, Int)))
475+
checkStream x y =
476+
let eq1 = x + y == 0
477+
eq2 = x - y == 1994
478+
in if eq1 && eq2
479+
then Stream.fromPure (Just (Just (x,y)))
480+
else if abs x > 1000 && abs y > 1000
481+
then Stream.fromPure (Just Nothing)
482+
else Stream.fromPure Nothing
483+
484+
{-# INLINE checkStreamK #-}
485+
checkStreamK :: Int -> Int -> StreamK.StreamK m (Maybe (Maybe (Int, Int)))
486+
checkStreamK x y =
487+
let eq1 = x + y == 0
488+
eq2 = x - y == 1994
489+
in if eq1 && eq2
490+
then StreamK.fromPure (Just (Just (x,y)))
491+
else if abs x > 1000 && abs y > 1000
492+
then StreamK.fromPure (Just Nothing)
493+
else StreamK.fromPure Nothing
494+
495+
{-# INLINE checkPair #-}
496+
checkPair :: Monad m => (Int, Int) -> m (Maybe (Maybe (Int, Int)))
497+
checkPair (x, y) =
498+
let eq1 = x + y == 0
499+
eq2 = x - y == 1994
500+
in if eq1 && eq2
501+
then pure (Just (Just (x,y)))
502+
else if abs x > 1000 && abs y > 1000
503+
then pure (Just Nothing)
504+
else pure Nothing
505+
506+
result :: Monad m => Stream m (Maybe a) -> m ()
507+
result = Stream.fold (Fold.take 1 Fold.drain) . Stream.catMaybes
508+
509+
fairConcatForEqn :: Monad m => Stream m Int -> m ()
510+
fairConcatForEqn input =
511+
result
512+
$ Stream.fairConcatFor input $ \x ->
513+
Stream.fairConcatForM input $ \y -> do
514+
return $ checkStream x y
515+
516+
fairConcatForEqnK :: Monad m => Stream m Int -> m ()
517+
fairConcatForEqnK input =
518+
let inputK = StreamK.fromStream input
519+
in result
520+
$ StreamK.toStream
521+
$ StreamK.fairConcatFor inputK $ \x ->
522+
StreamK.fairConcatForM inputK $ \y -> do
523+
return $ checkStreamK x y
524+
525+
concatForEqn :: Monad m => Stream m Int -> m ()
526+
concatForEqn input =
527+
result
528+
$ Stream.concatFor input $ \x ->
529+
Stream.concatForM input $ \y -> do
530+
return $ checkStream x y
531+
532+
fairSchedForEqn :: Monad m => Stream m Int -> m ()
533+
fairSchedForEqn input =
534+
result
535+
$ Stream.fairSchedFor input $ \x ->
536+
Stream.fairSchedForM input $ \y -> do
537+
return $ checkStream x y
538+
539+
_schedForEqn :: Monad m => Stream m Int -> m ()
540+
_schedForEqn input =
541+
result
542+
$ Stream.schedFor input $ \x ->
543+
Stream.schedForM input $ \y -> do
544+
return $ checkStream x y
545+
546+
streamCrossEqn :: Monad m => Stream m Int -> m ()
547+
streamCrossEqn input =
548+
result
549+
$ Stream.mapM checkPair
550+
$ Stream.cross input input
551+
552+
fairStreamCrossEqn :: Monad m => Stream m Int -> m ()
553+
fairStreamCrossEqn input =
554+
result
555+
$ Stream.mapM checkPair
556+
$ Stream.fairCross input input
557+
558+
unfoldCrossEqn :: Monad m => Unfold m ((), ()) Int -> m ()
559+
unfoldCrossEqn input =
560+
result
561+
$ Stream.mapM checkPair
562+
$ Stream.unfold (Unfold.cross input input) (undefined, undefined)
563+
564+
fairUnfoldCrossEqn :: Monad m => Unfold m ((), ()) Int -> m ()
565+
fairUnfoldCrossEqn input =
566+
result
567+
$ Stream.mapM checkPair
568+
$ Stream.unfold (Unfold.fairCross input input) (undefined, undefined)
569+
570+
unfoldEachEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()
571+
unfoldEachEqn input ints =
572+
let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input
573+
in result
574+
$ Stream.mapM checkPair
575+
$ Stream.unfoldEach intu ints
576+
577+
fairUnfoldEachEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()
578+
fairUnfoldEachEqn input ints =
579+
let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input
580+
in result
581+
$ Stream.mapM checkPair
582+
$ Stream.fairUnfoldEach intu ints
583+
584+
unfoldSchedEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()
585+
unfoldSchedEqn input ints =
586+
let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input
587+
in result
588+
$ Stream.mapM checkPair
589+
$ Stream.unfoldSched intu ints
590+
591+
fairUnfoldSchedEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()
592+
fairUnfoldSchedEqn input ints =
593+
let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input
594+
in result
595+
$ Stream.mapM checkPair
596+
$ Stream.fairUnfoldSched intu ints
597+
598+
-- Solve simultaneous equations by exploring all possibilities
599+
o_1_space_equations :: Int -> [Benchmark]
600+
o_1_space_equations _ =
601+
[ bgroup "equations"
602+
[ benchFold "concatFor (bounded)" concatForEqn (boundedInts 1000)
603+
, benchFold "fairConcatFor (bounded)"
604+
fairConcatForEqn (boundedInts 1000)
605+
, benchFold "fairConcatForK (bounded)"
606+
fairConcatForEqnK (boundedInts 1000)
607+
, benchFold "fairConcatFor (infinite)"
608+
fairConcatForEqn (infiniteInts 1000)
609+
, benchFold "fairSchedFor (bounded)"
610+
fairSchedForEqn (boundedInts 1000)
611+
, benchFold "fairSchedFor (infinite)"
612+
fairSchedForEqn (infiniteInts 1000)
613+
, benchFold "streamCross (bounded)"
614+
streamCrossEqn (boundedInts 1000)
615+
, benchFold "fairStreamCross (bounded)"
616+
fairStreamCrossEqn (boundedInts 1000)
617+
, benchFold "fairStreamCross (infinite)"
618+
fairStreamCrossEqn (infiniteInts 1000)
619+
, bench "unfoldCross (bounded)"
620+
$ nfIO $ unfoldCrossEqn (boundedIntsUnfold 1000 0)
621+
, bench "fairUnfoldCross (bounded)"
622+
$ nfIO $ fairUnfoldCrossEqn (boundedIntsUnfold 1000 0)
623+
, bench "fairUnfoldCross (infinite)"
624+
$ nfIO $ fairUnfoldCrossEqn (infiniteIntsUnfold 1000 0)
625+
, benchFold "unfoldEach (bounded)"
626+
(unfoldEachEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)
627+
, benchFold "fairUnfoldEach (bounded)"
628+
(fairUnfoldEachEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)
629+
, benchFold "fairUnfoldEach (infinite)"
630+
(fairUnfoldEachEqn (infiniteIntsUnfold 1000 0)) (infiniteInts 1000)
631+
, benchFold "unfoldSched (bounded)"
632+
(unfoldSchedEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)
633+
, benchFold "fairUnfoldSched (bounded)"
634+
(fairUnfoldSchedEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)
635+
, benchFold "fairUnfoldSched (infinite)"
636+
(fairUnfoldSchedEqn (infiniteIntsUnfold 1000 0)) (infiniteInts 1000)
637+
]
638+
]
639+
440640
-------------------------------------------------------------------------------
441641
-- Joining
442642
-------------------------------------------------------------------------------
@@ -486,6 +686,9 @@ o_n_heap_buffering value =
486686
$ joinWith S.filterInStreamGenericBy sqrtVal
487687
, benchIOSrc1 "filterInStreamAscBy"
488688
$ joinMapWith (S.filterInStreamAscBy compare) halfVal
689+
-- Note: schedFor does a bfs scheduling, therefore, can take a lot of
690+
-- memory.
691+
, benchFold "schedFor (bounded)" schedForEqn (boundedInts 1000)
489692
]
490693
]
491694
@@ -516,6 +719,7 @@ benchmarks moduleName size =
516719
, o_1_space_applicative size
517720
, o_1_space_monad size
518721
, o_1_space_bind size
722+
, o_1_space_equations size
519723
]
520724
, bgroup (o_n_space_prefix moduleName) $ Prelude.concat
521725
[

0 commit comments

Comments
 (0)