bench_foundation.hs

module Main where

import qualified Foundation as F
import qualified Foundation.Collection as F
import qualified Foundation.String as F
import qualified Foundation.Compat.ByteString as F
import Criterion.Main

import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Control.Exception (evaluate)
import qualified Data.ByteString as B
import Data.Monoid 

double :: Monoid m => m -> m
double = \a -> a <> a

bytesEnglish = T.encodeUtf8 $ T.pack textEnglish
bytesJapanese = T.encodeUtf8 $ T.pack textJapanese

textEnglish = "Set in the year 0 F.E. (\"Foundation Era\"), The Psychohistorians opens on Trantor, the capital of the 12,000-year-old Galactic Empire. Though the empire appears stable and powerful, it is slowly decaying in ways that parallel the decline of the Western Roman Empire. Hari Seldon, a mathematician and psychologist, has developed psychohistory, a new field of science and psychology that equates all possibilities in large societies to mathematics, allowing for the prediction of future events."
textJapanese = "数学者ハリ・セルダンは、膨大な集団の行動を予測する心理歴史学を作りあげ発展させることで、銀河帝国が近いうちに崩壊することを予言する[1]。セルダンは、帝国崩壊後に3万年続くはずの暗黒時代を、あらゆる知識を保存することで千年に縮めようとし、知識の集大成となる銀河百科事典 (Encyclopedia Galactica) を編纂するグループ「ファウンデーション」をつくったが、帝国崩壊を公言し平和を乱したという罪で裁判にかけられ、グループは銀河系辺縁部にある資源の乏しい無人惑星ターミナスへ追放されることになった。しかし、この追放劇すらもセルダンの計画に予定されていた事柄であった。病で死期をさとっていたセルダンは、己の仕事が終わったことを確信する。"

textual :: B.ByteString -> (T.Text -> T.Text) ->  B.ByteString
textual bs f = T.encodeUtf8 (f (T.decodeUtf8 bs))
foundational bs f = case F.fromBytes F.UTF8 (F.fromByteString bs) of
  (str, m, rest) -> F.toBytes F.UTF8 (f str)

toF bs = case F.fromBytes F.UTF8 (F.fromByteString bs) of (a,_,_) -> a
fromF = F.toBytes F.UTF8 

main = defaultMain
    [bgroup "unimpeded-fusion"
      [ bgroup "filter"
          [ bench "foundation" $ whnf  (fromF . F.filter (/= 'a') . toF) bytesEnglish
          , bench "text" $ whnf (T.encodeUtf8 . T.filter (/= 'a'). T.decodeUtf8) bytesEnglish
          ]
        
      , bgroup "drop.filter"
          [ bench "foundation" $ whnf (fromF . F.drop 30 . F.filter (/= 'a') . toF)  bytesEnglish
          , bench "text" $ whnf (T.encodeUtf8 . T.drop 30 . T.filter (/= 'a') . T.decodeUtf8) bytesEnglish
          ]
      , bgroup "map.drop.filter"
         [ bench "foundation" $ whnf (fromF . F.imap succ . F.drop 30 . F.filter (/= 'a') . toF)  bytesEnglish
         , bench "text" $ whnf (T.encodeUtf8 . T.map succ .  T.drop 30 . T.filter (/= 'a') . T.decodeUtf8) bytesEnglish
          ]
      , bgroup "take.map.drop.filter"
         [ bench "foundation" $ whnf (fromF . F.take 10 . F.imap succ . F.drop 30 . F.filter (/= 'a') . toF)  bytesEnglish
        , bench "text" $ whnf (T.encodeUtf8 . T.take 10 . T.map succ .  T.drop 30 . T.filter (/= 'a') . T.decodeUtf8) bytesEnglish
          ]
      , bgroup "take.double.map.drop.filter"
         [ bench "foundation" $ whnf (fromF . F.take 10 . double . F.imap succ . F.drop 30 . F.filter (/= 'a') . toF)  bytesEnglish
         , bench "text" $ whnf (T.encodeUtf8 . T.take 10 . double . T.map succ .  T.drop 30 . T.filter (/= 'a') . T.decodeUtf8) bytesEnglish
         ]
      ]
    ,
     bgroup "impeded-fusion"
        [ bgroup "filter"
            [ bench "foundation" $ whnf  (foundational bytesEnglish) (F.filter (/= 'a'))
            , bench "text" $ whnf (textual bytesEnglish) (T.filter (/= 'a'))
            ]
        , bgroup "drop.filter"
            [ bench "foundation" $ whnf  (foundational bytesEnglish) (F.drop 30 . F.filter (/= 'a')) 
            , bench "text" $ whnf (textual bytesEnglish) (T.drop 30 . T.filter (/= 'a'))
     
            ]
        , bgroup "map.drop.filter"
            [ bench "foundation" $ whnf  (foundational bytesEnglish) (F.imap succ . F.drop 30 . F.filter (/= 'a')) 
            , bench "text" $ whnf (textual bytesEnglish) (T.map succ . T.drop 30 . T.filter (/= 'a'))
         
            ]
          , bgroup "take.map.drop"
              [ bench "foundation" $ whnf  (foundational bytesEnglish) (F.take 10 . F.imap succ . F.drop 10 ) 
              , bench "text" $ whnf (textual bytesEnglish) (T.take 10 . T.map succ . T.drop 30)
   
              ]
        , bgroup "take.map.drop.filter"
            [ bench "foundation" $ whnf  (foundational bytesEnglish) (F.take 10 . F.imap succ . F.drop 10 . F.filter (/= 'a')) 
            , bench "text" $ whnf (textual bytesEnglish) (T.take 10 . T.map succ . T.drop 30 . T.filter (/= 'a'))
     
            ]
        , bgroup "take.double.map.drop.filter"
            [ bench "foundation" $ whnf  (foundational bytesEnglish) (F.take 10 . double . F.imap succ . F.drop 10 . F.filter (/= 'a')) 
            , bench "text" $ whnf (textual bytesEnglish) (T.take 10 . double. T.map succ . T.drop 30 . T.filter (/= 'a'))

            ]
         ]
       ]

benchmarking unimpeded-fusion/filter/foundation
mean                 145.2 μs   (143.7 μs .. 146.7 μs)
benchmarking unimpeded-fusion/filter/text
mean                 2.050 μs   (2.003 μs .. 2.117 μs)

benchmarking unimpeded-fusion/drop.filter/foundation
mean                 142.3 μs   (141.1 μs .. 143.9 μs)
benchmarking unimpeded-fusion/drop.filter/text
mean                 4.612 μs   (4.589 μs .. 4.644 μs)

benchmarking unimpeded-fusion/drop.filter/map.drop.filter/foundation
mean                 190.6 μs   (187.1 μs .. 203.8 μs)
benchmarking unimpeded-fusion/drop.filter/map.drop.filter/text
mean                 5.405 μs   (5.121 μs .. 6.002 μs)

benchmarking unimpeded-fusion/drop.filter/take.map.drop.filter/foundation
mean                 186.5 μs   (185.3 μs .. 188.3 μs)
benchmarking unimpeded-fusion/drop.filter/take.map.drop.filter/text
mean                 602.7 ns   (587.8 ns .. 636.2 ns)

benchmarking unimpeded-fusion/drop.filter/take.double.map.drop.filter/foundation
mean                 186.5 μs   (185.1 μs .. 188.2 μs)
benchmarking unimpeded-fusion/drop.filter/take.double.map.drop.filter/text
mean                 5.002 μs   (4.939 μs .. 5.088 μs)

benchmarking impeded-fusion/filter/foundation
mean                 199.0 μs   (182.2 μs .. 216.5 μs)
benchmarking impeded-fusion/filter/text
mean                 5.243 μs   (5.156 μs .. 5.579 μs)

benchmarking impeded-fusion/drop.filter/foundation
mean                 158.1 μs   (148.4 μs .. 177.6 μs)
benchmarking impeded-fusion/drop.filter/text
mean                 4.006 μs   (3.762 μs .. 4.396 μs)

benchmarking impeded-fusion/map.drop.filter/foundation
mean                 196.6 μs   (190.0 μs .. 213.7 μs)
benchmarking impeded-fusion/map.drop.filter/text
mean                 4.249 μs   (4.120 μs .. 4.534 μs)

benchmarking impeded-fusion/take.map.drop/foundation
mean                 160.4 μs   (148.2 μs .. 178.0 μs)
benchmarking impeded-fusion/take.map.drop/text
mean                 437.5 ns   (433.5 ns .. 441.9 ns)

benchmarking impeded-fusion/take.map.drop.filter/foundation
mean                 197.1 μs   (193.2 μs .. 205.9 μs)
benchmarking impeded-fusion/take.map.drop.filter/text
mean                 929.3 ns   (858.2 ns .. 1.026 μs)

benchmarking impeded-fusion/take.double.map.drop.filter/foundation
mean                 196.8 μs   (194.9 μs .. 198.5 μs)
benchmarking impeded-fusion/take.double.map.drop.filter/text
mean                 4.251 μs   (4.217 μs .. 4.293 μs)