diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,15 @@ +0.7.1 +===== + +* [#68](https://github.com/serokell/universum/issues/68): + Separate all 'nub' functions to `Nub` module, add `sortNub` and `unstableNub` there. +* [#54](https://github.com/serokell/universum/issues/54): + Reorganize .cabal. +* [#21](https://github.com/serokell/universum/issues/21): + Add benchmarks. +* [#65](https://github.com/serokell/universum/issues/65): + Use `TypeNats` instead of `TypeLits` when possible. + 0.7.0 ===== diff --git a/benchmark/Main.hs b/benchmark/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark/Main.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE ScopedTypeVariables #-} + +import Control.DeepSeq (NFData) +import Control.Monad.Identity (Identity (..)) +import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf) +import Data.Hashable (Hashable) +import Data.List (group, head, nub, sort, zip5) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Text (Text) +import qualified Data.Text as T + +import Monad (concatMapM) +import Nub (hashNub, ordNub, sortNub, unstableNub) +import VarArg ((...)) + +main :: IO () +main = defaultMain + [ bgroupList listOfSmall "small" + , bgroupList listOfBig "big" + , bgroupList (nStrings 'z') "small str" + , bgroupList (nStrings 'c') "big str" + , bgroupSuperComposition + , bgroupConcatMap + ] + +bgroupList :: forall a . + (Ord a, Hashable a, NFData a) + => (Int -> [a]) + -> String + -> Benchmark +bgroupList f name = bgroup name $ + map ($ f) + [ bgroupNubAll 100 + , bgroupNubAll 500 + , bgroupNubAll 1000 + , bgroupNubHugeList 5000 + , bgroupNubHugeList 500000 + , bgroupNubHugeList 1000000 + ] + where + bgroupNubAll :: Int -> (Int -> [a]) -> Benchmark + bgroupNubAll = bgroupNub True + + bgroupNubHugeList :: Int -> (Int -> [a]) -> Benchmark + bgroupNubHugeList = bgroupNub False + + bgroupNub :: Bool -> Int -> (Int -> [a]) -> Benchmark + bgroupNub isNub n listOf = + bgroup (show n) nubBenchs + where + listN :: [a] + listN = listOf n + + nubBenchs :: [Benchmark] + nubBenchs = + (if isNub + then (:) (bench "nub" $ nf nub listN) + else id) + [ bench "ordNub" $ nf ordNub (listN :: [a]) + , bench "hashNub" $ nf hashNub (listN :: [a]) + , bench "sortNub" $ nf sortNub (listN :: [a]) + , bench "hashSet" $ nf unstableNub (listN :: [a]) + , bench "groupSort" $ nf groupSort (listN :: [a]) + , bench "safeSort" $ nf safeSort (listN :: [a]) + ] + + groupSort :: [a] -> [a] + groupSort = map head . group . sort + + safeSort :: [a] -> [a] + safeSort = map NonEmpty.head . NonEmpty.group . sort + +listOfSmall :: Int -> [Int] +listOfSmall n = let part = n `div` 100 in concat $ replicate part [1..100] + +listOfBig :: Int -> [Int] +listOfBig n = let part = n `div` 2 in [1..part] ++ [1..part] + +allStrings :: Char -> [String] +allStrings ch = [ c : s | s <- "" : allStrings ch, c <- ['a'..ch] ] + +nStrings :: Char -> Int -> [Text] +nStrings ch n = take n $ map T.pack $ allStrings ch + +bgroupSuperComposition :: Benchmark +bgroupSuperComposition = bgroup "(...)" + [ bgroup "show+" [ bench "super" $ nf (show ... (+ 1)) (2 :: Int) + , bench "norm" $ nf (show . (+ 1)) (2 :: Int) + ] + , bgroup "show" [ bench "super" $ nf (show ...) (5 :: Int) + , bench "norm" $ nf show (5 :: Int) + ] + , bgroup "zip5" [ bench "super" $ nf ((null ... zip5) [()] [()] [()] []) [()] + , bench "norm" $ nf (null . zip5 [()] [()] [()] []) [()] + ] + , bgroup "10x" [ bench "super" $ nf super10 [()] + , bench "norm" $ nf norm10 [()] + ] + , bgroup "5arg" [ bench "super" $ nf (\x -> super5arg x x x x x) [()] + , bench "norm" $ nf (\x -> norm5args x x x x x) [()] + , bench "unty" $ nf (\x -> unty5args x x x x x) [()] + , bench "line" $ nf (\x -> line5args x x x x x) [()] + ] + ] + where + super10 = null + ... (: []) ... head ... pure ... head + ... (: [(), (), (), ()]) ... head ... (: []) ... head + ... (: [()]) ... head ... (: [(), ()]) ... head + + norm10 = null + . (: []) . head . pure . head + . (: [(), (), (), ()]) . head . (: []) . head + . (: [()]) . head . (: [(), ()]) . head + + super5arg :: [()] -> [()] -> [()] -> [()] -> [()] -> Bool + super5arg = super10 ... map fst5 ... zip5 + + unty5args = super10 ... map fst5 ... zip5 + + line5args = super10 ... map fst5 ... zip5 + {-# INLINE line5args #-} + + norm5args :: [()] -> [()] -> [()] -> [()] -> [()] -> Bool + norm5args a b c d = norm10 . map fst5 . zip5 a b c d + + fst5 :: (a,b,c,d,e) -> a + fst5 (a, _, _, _, _) = a + +bgroupConcatMap :: Benchmark +bgroupConcatMap = bgroup "concat" + [ concatGroup 10 + , concatGroup 100 + , concatGroup 1000 + ] + where + concatGroup :: Int -> Benchmark + concatGroup n = bgroup (show n) + [ bench "simple" $ nf concatSimple n + , bench "identity" $ nf concatIdentity n + ] + + concatSimple :: Int -> [()] + concatSimple n = concatMap pure $ replicate n () + + concatIdentity :: Int -> Identity [()] + concatIdentity n = concatMapM (Identity . pure) $ replicate n () diff --git a/src/Base.hs b/src/Base.hs --- a/src/Base.hs +++ b/src/Base.hs @@ -14,7 +14,11 @@ , module GHC.Num , module GHC.Real , module GHC.Show +#if MIN_VERSION_base(4,10,0) + , module GHC.TypeNats +#else , module GHC.TypeLits +#endif , module GHC.Types #if ( __GLASGOW_HASKELL__ >= 800 ) @@ -37,8 +41,13 @@ import GHC.Num (Integer, Num (..), subtract) import GHC.Real hiding ((%)) import GHC.Show (Show (..)) +#if MIN_VERSION_base(4,10,0) +import GHC.TypeNats (CmpNat, KnownNat, Nat, SomeNat (..), natVal, + someNatVal) +#else import GHC.TypeLits (CmpNat, KnownNat, Nat, SomeNat (..), natVal, someNatVal) +#endif import GHC.Types (Bool, Char, Coercible, IO, Int, Ordering, Word) diff --git a/src/List.hs b/src/List.hs --- a/src/List.hs +++ b/src/List.hs @@ -7,8 +7,6 @@ ( module Data.List , list - , hashNub - , ordNub , sortWith #if ( __GLASGOW_HASKELL__ >= 800 ) , whenNotNull @@ -25,12 +23,7 @@ takeWhile, transpose, unfoldr, unzip, unzip3, zip, zip3, zipWith) -import Data.Eq (Eq) import Data.Functor (fmap) -import Data.Hashable (Hashable) -import Data.HashSet as HS -import Data.Ord (Ord) -import qualified Data.Set as Set import GHC.Exts (sortWith) #if ( __GLASGOW_HASKELL__ >= 800 ) @@ -40,26 +33,6 @@ import Applicative (pass) #endif - --- | Like 'Prelude.nub' but runs in @O(n * log n)@ time and requires 'Ord'. -ordNub :: (Ord a) => [a] -> [a] -ordNub l = go Set.empty l - where - go _ [] = [] - go s (x:xs) = - if x `Set.member` s - then go s xs - else x : go (Set.insert x s) xs - --- | Like 'Prelude.nub' but runs in @O(n * log_16(n))@ time and requires 'Hashable'. -hashNub :: (Eq a, Hashable a) => [a] -> [a] -hashNub l = go HS.empty l - where - go _ [] = [] - go s (x:xs) = - if x `HS.member` s - then go s xs - else x : go (HS.insert x s) xs -- | Returns default list if given list is empty. -- Otherwise applies given function to every element. diff --git a/src/Nub.hs b/src/Nub.hs new file mode 100644 --- /dev/null +++ b/src/Nub.hs @@ -0,0 +1,76 @@ +{-| Functions to remove duplicates from a list. + + = Performance + To check the performance there was done a bunch of benchmarks. + Benchmarks were made on lists of 'Prelude.Int's and 'Data.Text.Text's. + There were two types of list to use: + + * Lists which consist of many different elements + + * Lists which consist of many same elements + + + Here are some recomendations for usage of particular functions based on benchmarking resutls. + + * 'hashNub' is faster than 'ordNub' when there're not so many different values in the list. + + * 'hashNub' is the fastest with 'Data.Text.Text'. + + * 'sortNub' has better performance than 'ordNub' but should be used when sorting is also needed. + + * 'unstableNub' has better performance than 'hashNub' but doesn't save the original order. +-} + +module Nub + ( hashNub + , ordNub + , sortNub + , unstableNub + ) where + +import Data.Eq (Eq) +import Data.Hashable (Hashable) +import Data.HashSet as HashSet +import Data.Ord (Ord) +import qualified Data.Set as Set +import Prelude ((.)) + +-- | Like 'Prelude.nub' but runs in @O(n * log n)@ time and requires 'Ord'. +-- +-- >>> ordNub [3, 3, 3, 2, 2, -1, 1] +-- [3, 2, -1, 1] +ordNub :: (Ord a) => [a] -> [a] +ordNub = go Set.empty + where + go _ [] = [] + go s (x:xs) = + if x `Set.member` s + then go s xs + else x : go (Set.insert x s) xs + +-- | Like 'Prelude.nub' but runs in @O(n * log_16(n))@ time and requires 'Hashable'. +-- +-- >>> hashNub [3, 3, 3, 2, 2, -1, 1] +-- [3, 2, -1, 1] +hashNub :: (Eq a, Hashable a) => [a] -> [a] +hashNub = go HashSet.empty + where + go _ [] = [] + go s (x:xs) = + if x `HashSet.member` s + then go s xs + else x : go (HashSet.insert x s) xs + +-- | Like 'ordNub' but also sorts a list. +-- +-- >>> sortNub [3, 3, 3, 2, 2, -1, 1] +-- [-1, 1, 2, 3] +sortNub :: (Ord a) => [a] -> [a] +sortNub = Set.toList . Set.fromList + +-- | Like 'hashNub' but has better performance and also doesn't save the order. +-- +-- >>> unstableNub [3, 3, 3, 2, 2, -1, 1] +-- [1, 2, 3, -1] +unstableNub :: (Eq a, Hashable a) => [a] -> [a] +unstableNub = HashSet.toList . HashSet.fromList diff --git a/universum.cabal b/universum.cabal --- a/universum.cabal +++ b/universum.cabal @@ -1,5 +1,5 @@ name: universum -version: 0.7.0 +version: 0.7.1 synopsis: Custom prelude used in Serokell description: Custom prelude used in Serokell homepage: https://github.com/serokell/universum @@ -13,75 +13,87 @@ build-type: Simple extra-source-files: CHANGES.md cabal-version: >=1.10 -Bug-Reports: https://github.com/serokell/universum/issues -tested-with: - GHC == 7.10.3, - GHC == 8.0.1, - GHC == 8.0.2, - GHC == 8.2.1 +bug-reports: https://github.com/serokell/universum/issues +tested-with: GHC == 7.10.3 + , GHC == 8.0.1 + , GHC == 8.0.2 + , GHC == 8.2.1 -Source-Repository head - type: git - location: git@github.com:serokell/universum.git +source-repository head + type: git + location: git@github.com:serokell/universum.git library + hs-source-dirs: src exposed-modules: - Universum + Universum - Applicative - Base - Bool - Containers - Conv - Debug - Exceptions - Functor - List - Print - TypeOps - Unsafe - VarArg + Applicative + Base + Bool + Containers + Conv + Debug + Exceptions + Functor + List + Nub + Print + TypeOps + Unsafe + VarArg - Lifted - Lifted.Concurrent - Lifted.Env - Lifted.File - Lifted.IORef + Lifted + Lifted.Concurrent + Lifted.Env + Lifted.File + Lifted.IORef - Monad - Monad.Either - Monad.Maybe - Monad.Trans + Monad + Monad.Either + Monad.Maybe + Monad.Trans - default-extensions: - NoImplicitPrelude - OverloadedStrings + ghc-options: -Wall -fwarn-implicit-prelude - ghc-options: - -Wall - -fwarn-implicit-prelude + build-depends: base > 4.7 && < 5 + , bytestring + , containers + , deepseq + , exceptions + , ghc-prim + , hashable + , microlens + , microlens-mtl + , mtl + , safe + , safe-exceptions + , stm + , text + , text-format + , transformers + , type-operators + , unordered-containers + , utf8-string + , vector - build-depends: - base >= 4.7 && <4.11, - bytestring >= 0.10 && <0.11, - containers >= 0.5 && <0.6, - deepseq >= 1.3 && <1.5, - exceptions, - ghc-prim >= 0.3 && <0.6, - hashable, - microlens >= 0.4 && <0.5, - microlens-mtl >= 0.1.7 && <0.2, - mtl >= 2.1 && <2.3, - safe >= 0.3 && <0.4, - safe-exceptions, - stm >= 2.4 && <2.5, - text >= 1.2 && <1.3, - text-format, - transformers >= 0.4 && <0.6, - type-operators == 0.1.0.4, - unordered-containers, - utf8-string >= 1.0 && <1.1, - vector + default-language: Haskell2010 + default-extensions: NoImplicitPrelude + OverloadedStrings - hs-source-dirs: src +benchmark universum-benchmark + type: exitcode-stdio-1.0 default-language: Haskell2010 + ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N + hs-source-dirs: benchmark + main-is: Main.hs + build-depends: base + , universum + , containers + , criterion + , deepseq + , hashable + , mtl + , semigroups + , text + , unordered-containers