├── .github └── CODEOWNERS ├── stack.yaml ├── .ghci ├── test ├── Spec.hs ├── Test │ ├── Rand.hs │ ├── Common.hs │ └── Rand │ │ ├── Laws.hs │ │ ├── Update.hs │ │ ├── Query.hs │ │ └── Cuts.hs └── Doctest.hs ├── CHANGELOG.md ├── .gitignore ├── appveyor.yml ├── .travis.yml ├── .stylish-haskell.yaml ├── src ├── Treap │ ├── Measured.hs │ ├── Pretty.hs │ ├── Rand.hs │ └── Pure.hs └── Treap.hs ├── README.md ├── treap.cabal └── LICENSE /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @chshersh 2 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2019-12-27 -------------------------------------------------------------------------------- /.ghci: -------------------------------------------------------------------------------- 1 | import Treap 2 | import Data.Monoid 3 | :set -XTypeApplications 4 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import System.IO (hSetEncoding, stderr, stdout, utf8) 4 | import Test.Hspec (Spec, hspec) 5 | 6 | import Test.Rand (randSpec) 7 | 8 | 9 | allUnitTests :: Spec 10 | allUnitTests = randSpec 11 | 12 | main :: IO () 13 | main = do 14 | hSetEncoding stdout utf8 15 | hSetEncoding stderr utf8 16 | 17 | hspec allUnitTests 18 | -------------------------------------------------------------------------------- /test/Test/Rand.hs: -------------------------------------------------------------------------------- 1 | module Test.Rand 2 | ( randSpec 3 | ) where 4 | 5 | import Test.Hspec (Spec, describe) 6 | 7 | import Test.Rand.Cuts (cutsSpec) 8 | import Test.Rand.Laws (lawsSpec) 9 | import Test.Rand.Query (querySpec) 10 | import Test.Rand.Update (updateSpec) 11 | 12 | 13 | randSpec :: Spec 14 | randSpec = describe "RTreap" $ do 15 | querySpec 16 | cutsSpec 17 | updateSpec 18 | lawsSpec 19 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | `treap` uses [PVP Versioning][1]. 4 | The changelog is available [on GitHub][2]. 5 | 6 | ## 0.1.0.0 — Unreleased 7 | 8 | * [#33](https://github.com/chshersh/treap/issues/33): 9 | Support GHC-8.8.1. 10 | * Upgrade to newer `hedgehod-1.0.1`. 11 | 12 | ## 0.0.0.0 — Apr 29, 2019 13 | 14 | * Initially created. 15 | 16 | [1]: https://pvp.haskell.org 17 | [2]: https://github.com/chshersh/treap/releases 18 | -------------------------------------------------------------------------------- /test/Doctest.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import System.FilePath.Glob (glob) 4 | import Test.DocTest (doctest) 5 | 6 | 7 | main :: IO () 8 | main = do 9 | sourceFiles <- glob "src/**/*.hs" 10 | doctest 11 | $ "-XInstanceSigs" 12 | : "-XScopedTypeVariables" 13 | : "-XRecordWildCards" 14 | : "-XMultiParamTypeClasses" 15 | : "-XLambdaCase" 16 | : "-XBangPatterns" 17 | : "-XGeneralizedNewtypeDeriving" 18 | : "-XDerivingStrategies" 19 | : "-XDeriveAnyClass" 20 | : "-XDeriveGeneric" 21 | : "-XDeriveFoldable" 22 | : "-XTypeApplications" 23 | : sourceFiles 24 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ### Haskell 2 | dist 3 | dist-* 4 | cabal-dev 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | *.prof 12 | *.aux 13 | *.hp 14 | *.eventlog 15 | .virtualenv 16 | .hsenv 17 | .hpc 18 | .cabal-sandbox/ 19 | cabal.sandbox.config 20 | cabal.config 21 | cabal.project.local 22 | .ghc.environment.* 23 | .HTF/ 24 | # Stack 25 | .stack-work/ 26 | stack.yaml.lock 27 | 28 | ### IDE/support 29 | # Vim 30 | [._]*.s[a-v][a-z] 31 | [._]*.sw[a-p] 32 | [._]s[a-v][a-z] 33 | [._]sw[a-p] 34 | *~ 35 | tags 36 | 37 | # IntellijIDEA 38 | .idea/ 39 | .ideaHaskellLib/ 40 | *.iml 41 | 42 | # Atom 43 | .haskell-ghc-mod.json 44 | 45 | # VS 46 | .vscode/ 47 | 48 | # Emacs 49 | *# 50 | .dir-locals.el 51 | TAGS 52 | 53 | # other 54 | .DS_Store 55 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | clone_folder: "c:\\WORK" 2 | clone_depth: 5 3 | 4 | # Do not build feature branch with open Pull Requests 5 | skip_branch_with_pr: true 6 | 7 | platform: 8 | - x86_64 9 | 10 | cache: 11 | - "C:\\SR" 12 | - dist-newstyle 13 | 14 | environment: 15 | global: 16 | CABOPTS: --store-dir=C:\\SR 17 | 18 | matrix: 19 | - GHCVER: 8.8.1 20 | 21 | install: 22 | - choco source add -n mistuke -s https://www.myget.org/F/mistuke/api/v2 23 | - choco install -y cabal --version 3.0.0.0 24 | - choco install -y ghc --version 8.8.1 25 | - refreshenv 26 | 27 | before_build: 28 | - cabal --version 29 | - ghc --version 30 | - cabal %CABOPTS% v2-update 31 | 32 | build_script: 33 | - cabal %CABOPTS% build --enable-tests --enable-benchmarks --write-ghc-environment-files=always 34 | - cabal %CABOPTS% test --enable-tests 35 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: true 2 | language: haskell 3 | 4 | git: 5 | depth: 5 6 | 7 | cabal: "3.0" 8 | 9 | cache: 10 | directories: 11 | - "$HOME/.cabal/store" 12 | - "$HOME/.stack" 13 | - "$TRAVIS_BUILD_DIR/.stack-work" 14 | 15 | matrix: 16 | include: 17 | # Cabal 18 | - ghc: 8.4.4 19 | - ghc: 8.6.5 20 | - ghc: 8.8.1 21 | 22 | # stack 23 | - ghc: 8.8.1 24 | env: STACK_YAML="$TRAVIS_BUILD_DIR/stack.yaml" 25 | 26 | install: 27 | - | 28 | if [ -z "$STACK_YAML" ]; then 29 | cabal build --enable-tests --enable-benchmarks --write-ghc-environment-files=always 30 | else 31 | # install stack 32 | curl -sSL https://get.haskellstack.org/ | sh 33 | 34 | # build project with stack 35 | stack --version 36 | stack build --system-ghc --test --no-run-tests 37 | fi 38 | 39 | script: 40 | - | 41 | if [ -z "$STACK_YAML" ]; then 42 | cabal test --enable-tests 43 | else 44 | stack test --no-terminal --system-ghc 45 | fi 46 | 47 | notifications: 48 | email: false -------------------------------------------------------------------------------- /test/Test/Common.hs: -------------------------------------------------------------------------------- 1 | module Test.Common 2 | ( TestTreap 3 | , smallTreap 4 | , extractSum 5 | , with 6 | , describedAs 7 | ) where 8 | 9 | import Data.Monoid (Sum (..)) 10 | import GHC.Exts (IsList (..)) 11 | import Test.Hspec.Expectations (Expectation, shouldBe) 12 | 13 | import Treap (RTreap, measure) 14 | 15 | 16 | -- | Specialized version of 'RTreap' for testing. 17 | type TestTreap = RTreap (Sum Int) Int 18 | 19 | -- | Small treap of total size 5. 20 | smallTreap :: TestTreap 21 | smallTreap = fromList [1..5] 22 | 23 | extractSum :: TestTreap -> Int 24 | extractSum = getSum . measure 25 | 26 | with :: [Int] -> Int -> ([Int], Sum Int) 27 | with l m = (l, Sum m) 28 | infixr 9 `with` 29 | 30 | describedAs :: TestTreap -> ([Int], Sum Int) -> Expectation 31 | describedAs t expectedNodesMeasure 32 | = treapNodes `with` treapMeasure `shouldBe` expectedNodesMeasure 33 | where 34 | treapMeasure :: Int 35 | treapMeasure = extractSum t 36 | treapNodes :: [Int] 37 | treapNodes = toList t 38 | infixr 8 `describedAs` 39 | -------------------------------------------------------------------------------- /test/Test/Rand/Laws.hs: -------------------------------------------------------------------------------- 1 | module Test.Rand.Laws 2 | ( lawsSpec 3 | ) where 4 | 5 | import GHC.Exts (IsList (..)) 6 | import HaskellWorks.Hspec.Hedgehog (require) 7 | import Hedgehog (Gen, forAll, property, (===)) 8 | import Test.Hspec (Spec, describe, it) 9 | 10 | import Test.Common (TestTreap()) 11 | 12 | import qualified Hedgehog.Gen as Gen 13 | import qualified Hedgehog.Range as Range 14 | 15 | 16 | lawsSpec :: Spec 17 | lawsSpec = 18 | describe "Law abiding instances" $ do 19 | semigroupSpec 20 | monoidSpec 21 | 22 | prop_int_list :: Gen [Int] 23 | prop_int_list = Gen.list (Range.linear 1 100) Gen.enumBounded 24 | 25 | semigroupSpec :: Spec 26 | semigroupSpec = 27 | describe "Semigroup" $ 28 | it "associativity" $ 29 | require $ property $ do 30 | a :: TestTreap <- fromList <$> forAll prop_int_list 31 | b <- fromList <$> forAll prop_int_list 32 | c <- fromList <$> forAll prop_int_list 33 | (a <> b) <> c === a <> (b <> c) 34 | 35 | monoidSpec :: Spec 36 | monoidSpec = 37 | describe "Monoid" $ 38 | it "identity" $ 39 | require $ property $ do 40 | a :: TestTreap <- fromList <$> forAll prop_int_list 41 | a <> mempty === a 42 | mempty <> a === a 43 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | steps: 2 | - simple_align: 3 | cases: true 4 | top_level_patterns: true 5 | records: true 6 | 7 | # Import cleanup 8 | - imports: 9 | align: none 10 | list_align: after_alias 11 | pad_module_names: false 12 | long_list_align: inline 13 | empty_list_align: inherit 14 | list_padding: 4 15 | separate_lists: true 16 | space_surround: false 17 | 18 | - language_pragmas: 19 | style: vertical 20 | remove_redundant: true 21 | 22 | # Remove trailing whitespace 23 | - trailing_whitespace: {} 24 | 25 | columns: 100 26 | 27 | newline: native 28 | 29 | language_extensions: 30 | - BangPatterns 31 | - ConstraintKinds 32 | - DataKinds 33 | - DefaultSignatures 34 | - DeriveAnyClass 35 | - DeriveDataTypeable 36 | - DeriveGeneric 37 | - DerivingStrategies 38 | - ExplicitNamespaces 39 | - FlexibleContexts 40 | - FlexibleInstances 41 | - FunctionalDependencies 42 | - GADTs 43 | - GeneralizedNewtypeDeriving 44 | - InstanceSigs 45 | - KindSignatures 46 | - LambdaCase 47 | - MultiParamTypeClasses 48 | - MultiWayIf 49 | - NamedFieldPuns 50 | - NoImplicitPrelude 51 | - OverloadedStrings 52 | - QuasiQuotes 53 | - RecordWildCards 54 | - ScopedTypeVariables 55 | - StandaloneDeriving 56 | - TemplateHaskell 57 | - TupleSections 58 | - TypeApplications 59 | - TypeFamilies 60 | - ViewPatterns 61 | -------------------------------------------------------------------------------- /test/Test/Rand/Update.hs: -------------------------------------------------------------------------------- 1 | module Test.Rand.Update 2 | ( updateSpec 3 | ) where 4 | 5 | import Test.Hspec (Spec, describe, it, shouldBe) 6 | 7 | import Test.Common (describedAs, with, smallTreap) 8 | 9 | import qualified Treap 10 | 11 | 12 | updateSpec :: Spec 13 | updateSpec = describe "Modification operations tests" $ do 14 | insertSpec 15 | deleteSpec 16 | 17 | insertSpec :: Spec 18 | insertSpec = describe "insert" $ do 19 | it "insert negative inserts at the beginning" $ 20 | Treap.insert (-1) 42 smallTreap `describedAs` (42 : [1..5]) `with` 57 21 | it "insert 0 inserts at the beginning" $ 22 | Treap.insert 0 42 smallTreap `describedAs` (42 : [1..5]) `with` 57 23 | it "insert size inserts at the end" $ 24 | Treap.insert 5 42 smallTreap `describedAs` [1, 2, 3, 4, 5, 42] `with` 57 25 | it "insert in the middle works" $ 26 | Treap.insert 2 42 smallTreap `describedAs` [1, 2, 42, 3, 4, 5] `with` 57 27 | 28 | deleteSpec :: Spec 29 | deleteSpec = describe "delete" $ do 30 | it "delete negative does nothing" $ 31 | Treap.delete (-1) smallTreap `shouldBe` smallTreap 32 | it "delete size does nothing" $ 33 | Treap.delete 5 smallTreap `shouldBe` smallTreap 34 | it "delete 0 removes first element" $ 35 | Treap.delete 0 smallTreap `describedAs` [2..5] `with` 14 36 | it "deletes from the middle works" $ 37 | Treap.delete 2 smallTreap `describedAs` [1, 2, 4, 5] `with` 12 38 | -------------------------------------------------------------------------------- /test/Test/Rand/Query.hs: -------------------------------------------------------------------------------- 1 | module Test.Rand.Query 2 | ( querySpec 3 | ) where 4 | 5 | import Data.Monoid (Sum (..)) 6 | import GHC.Exts (IsList (..)) 7 | import Test.Hspec (Spec, describe, it, shouldBe) 8 | 9 | import Test.Common (TestTreap, extractSum, smallTreap) 10 | 11 | import qualified Treap 12 | 13 | 14 | querySpec :: Spec 15 | querySpec = describe "Query tests" $ do 16 | basicSpec 17 | advancedSpec 18 | 19 | basicSpec :: Spec 20 | basicSpec = describe "Sanity checks" $ do 21 | it "size of empty treap is 0" $ 22 | Treap.size Treap.empty `shouldBe` 0 23 | it "size of singletone treap is 1" $ 24 | Treap.size (Treap.one 1 :: TestTreap) `shouldBe` 1 25 | it "size of smallTreap is 5" $ 26 | Treap.size smallTreap `shouldBe` 5 27 | it "measure of empty treap is mempty" $ 28 | extractSum Treap.empty `shouldBe` 0 29 | it "measure of singleton treap is mempty" $ 30 | extractSum (Treap.one 42) `shouldBe` 42 31 | it "toList smallTreap is [1..5]" $ 32 | toList smallTreap `shouldBe` [1..5] 33 | it "total sum of smallTreap is [1..5]" $ 34 | extractSum smallTreap `shouldBe` sum [1..5] 35 | 36 | advancedSpec :: Spec 37 | advancedSpec = describe "Different checks on query functions" $ do 38 | it "elements by indices are correct" $ 39 | map (`Treap.at` smallTreap) [-1..5] `shouldBe` 40 | [Nothing, Just 1, Just 2, Just 3, Just 4, Just 5, Nothing] 41 | it "query on empty segment returns 'mempty'" $ 42 | Treap.query 0 (-1) smallTreap `shouldBe` mempty 43 | it "query on the non-intersected segment returns 'mempty'" $ do 44 | Treap.query (-2) (-1) smallTreap `shouldBe` mempty 45 | Treap.query 5 6 smallTreap `shouldBe` mempty 46 | it "query on subsegments works" $ do 47 | Treap.query 0 0 smallTreap `shouldBe` 0 48 | Treap.query 0 1 smallTreap `shouldBe` 1 49 | Treap.query 0 2 smallTreap `shouldBe` 3 50 | Treap.query 1 3 smallTreap `shouldBe` 5 51 | Treap.query (-1) 10 smallTreap `shouldBe` Sum (sum [1..5]) 52 | -------------------------------------------------------------------------------- /src/Treap/Measured.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | 3 | {- | Typeclass that tells how to measure different values as 'Monoid'. 4 | -} 5 | 6 | module Treap.Measured 7 | ( Measured (..) 8 | ) where 9 | 10 | import Data.Functor.Identity (Identity (..)) 11 | import Data.Monoid (All (..), Any (..), Dual (..), Endo (..), First (..), Last (..), Product (..), 12 | Sum (..)) 13 | import Data.Semigroup (Max (..), Min (..)) 14 | 15 | 16 | {- | This typeclass allows to specify how to convert value of type @a@ into 17 | monoidal value of type @m@. 18 | -} 19 | class Monoid m => Measured m a where 20 | measure :: a -> m 21 | 22 | -- | Measure every 'Monoid' as itself. 23 | instance Monoid a => Measured (Identity a) a where 24 | measure = Identity 25 | {-# INLINE measure #-} 26 | 27 | -- | Measure every 'Monoid' as its dual. 28 | instance Monoid a => Measured (Dual a) a where 29 | measure = Dual 30 | {-# INLINE measure #-} 31 | 32 | -- | Measure every endomorphic function with compostion. 33 | instance Measured (Endo a) (a -> a) where 34 | measure = Endo 35 | {-# INLINE measure #-} 36 | 37 | -- | Measure every numeric value with addition. 38 | instance Num a => Measured (Sum a) a where 39 | measure = Sum 40 | {-# INLINE measure #-} 41 | 42 | -- | Measure every numeric value with multiplication. 43 | instance Num a => Measured (Product a) a where 44 | measure = Product 45 | {-# INLINE measure #-} 46 | 47 | -- | Measure every comparable value with minimum. 48 | instance (Ord a, Bounded a) => Measured (Min a) a where 49 | measure = Min 50 | {-# INLINE measure #-} 51 | 52 | -- | Measure every comparable value with maximum. 53 | instance (Ord a, Bounded a) => Measured (Max a) a where 54 | measure = Max 55 | {-# INLINE measure #-} 56 | 57 | -- | Measure every value as the 'First' monoid. 58 | instance Measured (First a) a where 59 | measure = First . Just 60 | {-# INLINE measure #-} 61 | 62 | -- | Measure every value as the 'Last' monoid. 63 | instance Measured (Last a) a where 64 | measure = Last . Just 65 | {-# INLINE measure #-} 66 | 67 | -- | Measure boolean value with '&&'. 68 | instance Measured All Bool where 69 | measure = All 70 | 71 | -- | Measure boolean value with '||'. 72 | instance Measured Any Bool where 73 | measure = Any 74 | -------------------------------------------------------------------------------- /src/Treap.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | 3 | == General description 4 | 5 | Package @treap@ implements a tree-like data structure called /implicit treap/. This 6 | data structure implements interface similar to random-access arrays, but with 7 | fast (logarithmic time complexity) 8 | @'insert'@ \/ @'delete'@ \/ @'Treap.splitAt'@ \/ @'merge'@ \/ @'Treap.take'@ \/ @'Treap.drop'@ \/ @'rotate'@ operations. 9 | 10 | In addition, 'Treap.Pure.Treap' and 'RTreap' allow you to specify and measure 11 | values of any monoids on a segment, like a sum of elements or minimal element on 12 | some contiguous part of the array. 13 | 14 | == Package structure 15 | 16 | This package contains the following modules: 17 | 18 | * __"Treap.Measured":__ typeclass 'Measured' that allows telling how to measure 19 | tree values as monoids. 20 | * __"Treap.Pure":__ the 'Treap.Pure.Treap' data type and functions – pure 21 | implementation of the implicit treap data structure. 22 | * __"Treap.Rand":__ the 'RTreap' data type and functions – pure implementation 23 | of the implicit treap which uses a pure random generator to generate 24 | priorities automatically. 25 | * __"Treap.Pretty":__ pretty-printer for the treap. 26 | 27 | Module __"Treap"__ reexports only __"Treap.Measured"__ and __"Treap.Rand"__ modules. 28 | 29 | == Usage example 30 | 31 | Consider the following example of creating 'RTreap' from list @[1..5]@ where 32 | each element stores the sum of elements in its subtree: 33 | 34 | >>> import Data.Monoid (Sum (..)) 35 | >>> import GHC.Exts (IsList (..)) 36 | >>> t = fromList [1..5] :: RTreap (Sum Int) Int 37 | >>> prettyPrint t 38 | 5,15:2 39 | ╱╲ 40 | ╱ ╲ 41 | ╱ ╲ 42 | ╱ ╲ 43 | 1,1:1 3,12:4 44 | ╱╲ 45 | ╱ ╲ 46 | ╱ ╲ 47 | 1,3:3 1,5:5 48 | 49 | Each node shows: 50 | 51 | 1. The overall size of the tree 52 | 2. The total monoidal measure of the tree 53 | 3. The element itself after @:@ 54 | 55 | You can try to play with this tree now! 56 | 57 | >>> at 0 t 58 | Just 1 59 | >>> at 10 t 60 | Nothing 61 | >>> query 1 4 t 62 | Sum {getSum = 9} 63 | 64 | >>> prettyPrint $ Treap.take 2 t 65 | 2,3:2 66 | ╱ 67 | 1,1:1 68 | 69 | >>> prettyPrint $ Treap.drop 2 t 70 | 3,12:4 71 | ╱╲ 72 | ╱ ╲ 73 | ╱ ╲ 74 | 1,3:3 1,5:5 75 | 76 | >>> prettyPrint $ rotate 2 t 77 | 5,15:2 78 | ╱ 79 | 4,13:4 80 | ╱╲ 81 | ╱ ╲ 82 | ╱ ╲ 83 | 1,3:3 2,6:5 84 | ╲ 85 | 1,1:1 86 | 87 | -} 88 | 89 | module Treap 90 | ( module Treap 91 | ) where 92 | 93 | import Treap.Measured as Treap 94 | import Treap.Rand as Treap 95 | -------------------------------------------------------------------------------- /test/Test/Rand/Cuts.hs: -------------------------------------------------------------------------------- 1 | module Test.Rand.Cuts 2 | ( cutsSpec 3 | ) where 4 | 5 | import GHC.Exts (IsList (..)) 6 | import Test.Hspec (Spec, describe, it, shouldBe) 7 | 8 | import Test.Common (describedAs, with, TestTreap, smallTreap) 9 | 10 | import qualified Treap 11 | 12 | 13 | cutsSpec :: Spec 14 | cutsSpec = describe "Cuts and joins tests" $ do 15 | splitAtSpec 16 | mergeSpec 17 | takeSpec 18 | dropSpec 19 | rotateSpec 20 | 21 | splitAtSpec :: Spec 22 | splitAtSpec = describe "splitAt" $ do 23 | it "splitAt negative returns treap itself" $ 24 | snd (Treap.splitAt (-1) smallTreap) `shouldBe` smallTreap 25 | it "splitAt 0 returns treap itself" $ 26 | snd (Treap.splitAt 0 smallTreap) `shouldBe` smallTreap 27 | it "splitAt n returns treap itself" $ 28 | fst (Treap.splitAt 5 smallTreap) `shouldBe` smallTreap 29 | it "splitAt 2 returns two treaps" $ do 30 | let 31 | (a, b) = Treap.splitAt 2 smallTreap 32 | a `describedAs` [1..2] `with` 3 33 | b `describedAs` [3..5] `with` 12 34 | 35 | mergeSpec :: Spec 36 | mergeSpec = describe "merge" $ do 37 | it "merge with empty should be treap itself" $ do 38 | Treap.merge Treap.empty smallTreap `shouldBe` smallTreap 39 | Treap.merge smallTreap Treap.empty `shouldBe` smallTreap 40 | it "merge two treaps works" $ 41 | (Treap.merge (fromList [1..2]) (fromList [3..5]) :: TestTreap) `describedAs` [1..5] `with` 15 42 | 43 | takeSpec :: Spec 44 | takeSpec = describe "take" $ do 45 | it "take negative returns empty treap" $ 46 | Treap.take (-1) smallTreap `describedAs` [] `with` 0 47 | it "take 0 returns empty treap" $ 48 | Treap.take 0 smallTreap `describedAs` [] `with` 0 49 | it "take size returns treap itself" $ 50 | Treap.take 5 smallTreap `shouldBe` smallTreap 51 | it "take 2 returns first two elements" $ 52 | Treap.take 2 smallTreap `describedAs` [1..2] `with` 3 53 | 54 | dropSpec :: Spec 55 | dropSpec = describe "drop" $ do 56 | it "drop negative returns treap itself" $ 57 | Treap.drop (-1) smallTreap `shouldBe` smallTreap 58 | it "drop 0 returns treap itself" $ 59 | Treap.drop 0 smallTreap `shouldBe` smallTreap 60 | it "drop size returns empty treap" $ 61 | Treap.drop 5 smallTreap `describedAs` [] `with` 0 62 | it "drop 2 returns first two elements" $ 63 | Treap.drop 2 smallTreap `describedAs` [3..5] `with` 12 64 | 65 | rotateSpec :: Spec 66 | rotateSpec = describe "rotate" $ do 67 | it "rotate 0 does nothing" $ 68 | Treap.rotate 0 smallTreap `shouldBe` smallTreap 69 | it "rotate 1 moves first element to the end" $ 70 | Treap.rotate 1 smallTreap `describedAs` [2, 3, 4, 5, 1] `with` 15 71 | it "rotate -1 moves last element to the beginning" $ 72 | Treap.rotate (-1) smallTreap `describedAs` [5, 1, 2, 3, 4] `with` 15 73 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # treap 2 | 3 | ![Treap: tree logo](https://user-images.githubusercontent.com/4276606/56883228-9f32f180-6a98-11e9-9554-13735ff1ed30.png) 4 | [![Hackage](https://img.shields.io/hackage/v/treap.svg)](https://hackage.haskell.org/package/treap) 5 | [![Build status](https://secure.travis-ci.org/chshersh/treap.svg)](https://travis-ci.org/chshersh/treap) 6 | [![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](LICENSE) 7 | 8 | Efficient implementation of the implicit treap data structure. 9 | 10 | ## What does this package provide? 11 | 12 | This package implements a tree-like data structure called _implicit treap_. This 13 | data structure implements interface similar to random-access arrays, but with 14 | fast (logarithmic time complexity) 15 | `insert`/`delete`/`split`/`merge`/`take`/`drop`/`rotate` operations. In addition, 16 | _treap_ allows you to specify and measure values of any monoids on a segment, 17 | like a sum of elements or minimal element on some contiguous part of the array. 18 | 19 | ## When to use this package? 20 | 21 | Use this package when you want the following operations to be fast: 22 | 23 | 1. Access elements by index. 24 | 2. Insert elements by index. 25 | 3. Delete elements by index. 26 | 4. Calculate monoidal operation (like sum, product, min, etc.) of all elements 27 | between two indices. 28 | 5. Call slicing operations like `take` or `drop` or `split`. 29 | 30 | Below you can find the table of time complexity for all operations (where `n` is 31 | the size of the treap): 32 | 33 | | Operation | Time complexity | Description | 34 | |-----------|-----------------|--------------------------------------| 35 | | `size` | `O(1)` | Get number of elements in the treap | 36 | | `at` | `O(log n)` | Access by index | 37 | | `insert` | `O(log n)` | Insert by index | 38 | | `delete` | `O(log n)` | Delete by index | 39 | | `query` | `O(log n)` | Measure monoid on the segment | 40 | | `splitAt` | `O(log n)` | Split treap by index into two treaps | 41 | | `merge` | `O(log n)` | Merge two treaps into a single one | 42 | | `take` | `O(log n)` | Take first `i` elements of the treap | 43 | | `drop` | `O(log n)` | Drop first `i` elements of the treap | 44 | | `rotate` | `O(log n)` | Put first `i` elements to the end | 45 | 46 | The package also comes with nice pretty-printing! 47 | 48 | ```haskell 49 | ghci> t = fromList [1..5] :: RTreap (Sum Int) Int 50 | ghci> prettyPrint t 51 | 5,15:2 52 | ╱╲ 53 | ╱ ╲ 54 | ╱ ╲ 55 | ╱ ╲ 56 | 1,1:1 3,12:4 57 | ╱╲ 58 | ╱ ╲ 59 | ╱ ╲ 60 | 1,3:3 1,5:5 61 | 62 | ``` 63 | 64 | ## Alternatives 65 | 66 | If you don't need to calculate monoidal operations, you may alternatively use 67 | [`Seq`](https://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Sequence.html#t:Seq) 68 | from the `containers` package as it provides more extended interface but doesn't 69 | allow to measure monoidal values on segments. 70 | 71 | ## Acknowledgement 72 | 73 | Icons made by [Freepik](http://www.freepik.com) from [www.flaticon.com](https://www.flaticon.com/) is licensed by [CC 3.0 BY](http://creativecommons.org/licenses/by/3.0/). 74 | -------------------------------------------------------------------------------- /treap.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: treap 3 | version: 0.1.0.0 4 | synopsis: Efficient implementation of the implicit treap data structure 5 | description: 6 | Efficient implementation of the implicit treap data structure. 7 | Use this data structure if you want dynamic arrays with fast operations on segments. 8 | homepage: https://github.com/chshersh/treap 9 | bug-reports: https://github.com/chshersh/treap/issues 10 | license: MPL-2.0 11 | license-file: LICENSE 12 | author: Dmitrii Kovanikov 13 | maintainer: kovanikov@gmail.com 14 | copyright: 2019 Dmitrii Kovanikov 15 | category: Data Structures, Tree 16 | build-type: Simple 17 | extra-doc-files: README.md 18 | CHANGELOG.md 19 | tested-with: GHC == 8.4.4 20 | GHC == 8.6.4 21 | GHC == 8.8.1 22 | 23 | source-repository head 24 | type: git 25 | location: https://github.com/chshersh/treap.git 26 | 27 | common common-options 28 | build-depends: base >= 4.11 && < 4.14 29 | 30 | ghc-options: -Wall 31 | -Wincomplete-uni-patterns 32 | -Wincomplete-record-updates 33 | -Wcompat 34 | -Widentities 35 | -Wredundant-constraints 36 | -Wpartial-fields 37 | -fhide-source-paths 38 | -freverse-errors 39 | if impl(ghc >= 8.8.1) 40 | ghc-options: -Wmissing-deriving-strategies 41 | -Werror=missing-deriving-strategies 42 | 43 | default-language: Haskell2010 44 | default-extensions: BangPatterns 45 | ConstraintKinds 46 | DataKinds 47 | DeriveFunctor 48 | DeriveFoldable 49 | DeriveTraversable 50 | DeriveGeneric 51 | DerivingStrategies 52 | GeneralizedNewtypeDeriving 53 | InstanceSigs 54 | KindSignatures 55 | LambdaCase 56 | MultiParamTypeClasses 57 | OverloadedStrings 58 | RecordWildCards 59 | ScopedTypeVariables 60 | TypeApplications 61 | 62 | library 63 | import: common-options 64 | build-depends: deepseq ^>= 1.4 65 | , mersenne-random-pure64 ^>= 0.2.2 66 | 67 | hs-source-dirs: src 68 | exposed-modules: Treap 69 | Treap.Measured 70 | Treap.Pretty 71 | Treap.Pure 72 | Treap.Rand 73 | 74 | test-suite treap-test 75 | import: common-options 76 | type: exitcode-stdio-1.0 77 | hs-source-dirs: test 78 | main-is: Spec.hs 79 | other-modules: Test.Common 80 | Test.Rand 81 | Test.Rand.Cuts 82 | Test.Rand.Query 83 | Test.Rand.Update 84 | Test.Rand.Laws 85 | 86 | build-depends: treap 87 | , hspec 88 | , hspec-core 89 | , hedgehog ^>= 1.0.1 90 | , hw-hspec-hedgehog 91 | , hspec-expectations 92 | 93 | test-suite treap-doctest 94 | import: common-options 95 | type: exitcode-stdio-1.0 96 | hs-source-dirs: test 97 | main-is: Doctest.hs 98 | 99 | build-depends: doctest 100 | , Glob 101 | 102 | ghc-options: -threaded 103 | default-language: Haskell2010 104 | -------------------------------------------------------------------------------- /src/Treap/Pretty.hs: -------------------------------------------------------------------------------- 1 | -- | Very nice 'Treap' visualisation. 2 | 3 | module Treap.Pretty 4 | ( pretty 5 | , prettyPrint 6 | , prettyWith 7 | , compactShowNode 8 | 9 | -- * Internal implementation details 10 | , BinTree (..) 11 | , showTree 12 | , middleLabelPos 13 | , branchLines 14 | ) where 15 | 16 | import Data.Char (isSpace) 17 | import Data.Coerce (Coercible, coerce) 18 | import Data.List (dropWhileEnd, intercalate) 19 | 20 | import Treap.Pure (Priority (..), Size (..), Treap (..)) 21 | 22 | 23 | {- | Show 'Treap' in a pretty way using 'compactShowNode' function. 24 | -} 25 | pretty :: forall m a . (Coercible m a, Show a) => Treap m a -> String 26 | pretty = prettyWith compactShowNode 27 | 28 | -- | Call 'pretty' function and output the result directly to @stdout@. 29 | prettyPrint :: forall m a . (Coercible m a, Show a) => Treap m a -> IO () 30 | prettyPrint = putStrLn . pretty 31 | 32 | {- | Show 'Treap' node in a format: 33 | 34 | @ 35 | \,\:a 36 | @ 37 | -} 38 | compactShowNode 39 | :: forall m a . (Coercible m a, Show a) 40 | => Size 41 | -> Priority 42 | -> m 43 | -> a 44 | -> String 45 | compactShowNode (Size sz) _ m a = 46 | show sz ++ "," ++ show (coerce @m @a m) ++ ":" ++ show a 47 | 48 | -- | Show 'Treap' in a nice way using given function to display node. 49 | prettyWith 50 | :: forall m a . 51 | (Size -> Priority -> m -> a -> String) 52 | -> Treap m a 53 | -> String 54 | prettyWith display = showTree . toBinTree 55 | where 56 | toBinTree :: Treap m a -> BinTree 57 | toBinTree Empty = Leaf 58 | toBinTree (Node sz p m a left right) = Branch (display sz p m a) (toBinTree left) (toBinTree right) 59 | 60 | -- | Intermidiate structure to help string conversion. 61 | data BinTree 62 | = Leaf 63 | | Branch String BinTree BinTree 64 | 65 | -- | Hardcore function responsible for pretty showing of the 'BinTree' data type. 66 | showTree :: BinTree -> String 67 | showTree Leaf = "" 68 | showTree (Branch label left right) = case (left, right) of 69 | (Leaf, Leaf) -> label 70 | 71 | (_, Leaf) -> toLines $ 72 | [ spaces rootShiftOnlyLeft ++ label 73 | , spaces branchShiftOnlyLeft ++ "╱" 74 | ] ++ map (spaces leftShiftOnlyLeft ++) leftLines 75 | 76 | (Leaf, _) -> toLines $ 77 | [ spaces rootShiftOnlyRight ++ label 78 | , spaces branchShiftOnlyRight ++ "╲" 79 | ] ++ map (spaces rightShiftOnlyRight ++) rightLines 80 | 81 | (_, _) -> toLines $ 82 | [ spaces rootOffset ++ label 83 | ] 84 | ++ map (spaces rootOffset ++ ) (branchLines branchHeight) 85 | ++ map (spaces childrenOffset ++) (zipChildren leftLines rightLines) 86 | where 87 | leftStr, rightStr :: String 88 | leftStr = showTree left 89 | rightStr = showTree right 90 | 91 | leftLines :: [String] 92 | leftLines = lines leftStr 93 | rightLines = lines rightStr 94 | 95 | rootLabelMiddle, leftLabelMiddle, rightLabelMiddle :: Int 96 | rootLabelMiddle = middleLabelPos label 97 | leftLabelMiddle = middleLabelPos $ head leftLines 98 | rightLabelMiddle = middleLabelPos $ head rightLines 99 | 100 | -- Case 1: all offsets when node has only left branch 101 | rootShiftOnlyLeft, leftShiftOnlyLeft, branchShiftOnlyLeft :: Int 102 | (rootShiftOnlyLeft, leftShiftOnlyLeft) = case compare rootLabelMiddle leftLabelMiddle of 103 | EQ -> (1, 0) 104 | GT -> (0, rootLabelMiddle - leftLabelMiddle - 1) 105 | LT -> (leftLabelMiddle - rootLabelMiddle + 1, 0) 106 | branchShiftOnlyLeft = rootLabelMiddle + rootShiftOnlyLeft - 1 107 | 108 | -- Case 2: all offsets when node has only right branch 109 | rootShiftOnlyRight, rightShiftOnlyRight, branchShiftOnlyRight :: Int 110 | (rootShiftOnlyRight, rightShiftOnlyRight) = case compare rootLabelMiddle rightLabelMiddle of 111 | EQ -> (0, 1) 112 | GT -> (0, rootLabelMiddle - rightLabelMiddle + 1) 113 | LT -> (rightLabelMiddle - rootLabelMiddle - 1, 0) 114 | branchShiftOnlyRight = rootLabelMiddle + rootShiftOnlyRight + 1 115 | 116 | -- Case 3: both 117 | leftWidth, rightOffMiddle, childDistance, branchHeight, rootMustMiddle :: Int 118 | leftWidth = 1 + maximum (map length leftLines) 119 | rightOffMiddle = leftWidth + rightLabelMiddle 120 | childDistance = rightOffMiddle - leftLabelMiddle 121 | branchHeight = childDistance `div` 2 122 | rootMustMiddle = (leftLabelMiddle + rightOffMiddle) `div` 2 123 | 124 | rootOffset, childrenOffset :: Int 125 | (rootOffset, childrenOffset) = case compare rootLabelMiddle rootMustMiddle of 126 | EQ -> (0, 0) 127 | LT -> (rootMustMiddle - rootLabelMiddle, 0) 128 | GT -> (0, rootLabelMiddle - rootMustMiddle) 129 | 130 | zipChildren :: [String] -> [String] -> [String] 131 | zipChildren l [] = l 132 | zipChildren [] r = map (spaces leftWidth ++ ) r 133 | zipChildren (x:xs) (y:ys) = 134 | let xLen = length x 135 | newX = x ++ spaces (leftWidth - xLen) 136 | in (newX ++ y) : zipChildren xs ys 137 | 138 | -- | Generates strings containing of @n@ spaces. 139 | spaces :: Int -> String 140 | spaces n = replicate n ' ' 141 | 142 | {- | Calculates position of middle of non-space part of the string. 143 | 144 | >>> s = " abc " 145 | >>> length s 146 | 7 147 | >>> middleLabelPos s 148 | 4 149 | -} 150 | middleLabelPos :: String -> Int 151 | middleLabelPos s = 152 | let (spacePrefix, rest) = span isSpace s 153 | in length spacePrefix + (length (dropWhileEnd isSpace rest) `div` 2) 154 | 155 | -- | Like 'unlines' but doesn't add "\n" to the end. 156 | toLines :: [String] -> String 157 | toLines = intercalate "\n" 158 | 159 | {- | Draws branches of the given height. 160 | 161 | >>> putStrLn $ toLines $ branchLines 1 162 | ╱╲ 163 | 164 | >>> putStrLn $ toLines $ branchLines 2 165 | ╱╲ 166 | ╱ ╲ 167 | 168 | >>> putStrLn $ toLines $ branchLines 3 169 | ╱╲ 170 | ╱ ╲ 171 | ╱ ╲ 172 | -} 173 | branchLines :: Int -> [String] 174 | branchLines n = go 0 175 | where 176 | go :: Int -> [String] 177 | go i 178 | | i == n = [] 179 | | otherwise = line : go (i + 1) 180 | where 181 | line :: String 182 | line = spaces (n - i - 1) ++ "╱" ++ spaces (2 * i) ++ "╲" 183 | -------------------------------------------------------------------------------- /src/Treap/Rand.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | 4 | {- | Fair implementation of the 'Treap' data structure that uses random 5 | generator for priorities. 6 | -} 7 | 8 | module Treap.Rand 9 | ( -- * Data structure 10 | RTreap (..) 11 | 12 | -- * Smart constructors 13 | , emptyWithGen 14 | , oneWithGen 15 | , empty 16 | , one 17 | 18 | -- * Query functions 19 | , size 20 | , at 21 | , query 22 | 23 | -- * Cuts and joins 24 | , splitAt 25 | , merge 26 | , take 27 | , drop 28 | , rotate 29 | 30 | -- * Modification functions 31 | , insert 32 | , delete 33 | 34 | -- * General purpose functions 35 | , withTreap 36 | , overTreap 37 | 38 | -- * Pretty printing functions 39 | , prettyPrint 40 | ) where 41 | 42 | import Prelude hiding (drop, lookup, splitAt, take) 43 | 44 | import Control.DeepSeq (NFData (..)) 45 | import Data.Coerce (Coercible) 46 | import Data.Foldable (foldl') 47 | import GHC.Exts (IsList (..)) 48 | import GHC.Generics (Generic) 49 | 50 | import Treap.Measured (Measured (..)) 51 | import Treap.Pure (Priority (..), Size (..), Treap) 52 | 53 | import qualified System.Random.Mersenne.Pure64 as Random 54 | import qualified Treap.Pretty as Treap 55 | import qualified Treap.Pure as Treap 56 | 57 | -- $setup 58 | -- >>> import Data.Monoid 59 | 60 | ---------------------------------------------------------------------------- 61 | -- Data structure and instances 62 | ---------------------------------------------------------------------------- 63 | 64 | {- | Specialized version of 'Treap' where priority is 65 | generated by the stored random generator. 66 | -} 67 | data RTreap m a = RTreap 68 | { rTreapGen :: !Random.PureMT 69 | , rTreapTree :: !(Treap m a) 70 | } deriving stock (Show, Generic, Foldable) 71 | 72 | {- | (<>) is implemented via 'merge'. 73 | -} 74 | instance Measured m a => Semigroup (RTreap m a) where 75 | (<>) = merge 76 | 77 | {- | mempty is implemented via 'empty'. 78 | -} 79 | instance Measured m a => Monoid (RTreap m a) where 80 | mempty = empty 81 | 82 | -- | \( O(n) \). This instance doesn't compare random generators inside trees. 83 | instance (Eq m, Eq a) => Eq (RTreap m a) where 84 | (==) :: RTreap m a -> RTreap m a -> Bool 85 | RTreap _ t1 == RTreap _ t2 = t1 == t2 86 | 87 | -- | \( O(1) \). Takes cached value from the root. 88 | instance Monoid m => Measured m (RTreap m a) where 89 | measure :: RTreap m a -> m 90 | measure = withTreap measure 91 | {-# INLINE measure #-} 92 | 93 | {- | Pure implementation of 'RTreap' construction functions. Uses 94 | @'empty' :: RTreap k a@ as a starting point. Functions have the following 95 | time complexity: 96 | 97 | 1. 'fromList': \( O(n\ \log \ n) \) 98 | 2. 'toList': \( O(n) \) 99 | 100 | >>> prettyPrint $ fromList @(RTreap (Sum Int) Int) [1..5] 101 | 5,15:2 102 | ╱╲ 103 | ╱ ╲ 104 | ╱ ╲ 105 | ╱ ╲ 106 | 1,1:1 3,12:4 107 | ╱╲ 108 | ╱ ╲ 109 | ╱ ╲ 110 | 1,3:3 1,5:5 111 | -} 112 | instance Measured m a => IsList (RTreap m a) where 113 | type Item (RTreap m a) = a 114 | 115 | fromList :: [a] -> RTreap m a 116 | fromList = foldl' (\t (i, a) -> insert i a t) empty . zip [0..] 117 | {-# INLINE fromList #-} 118 | 119 | toList :: RTreap m a -> [a] 120 | toList = map snd . toList . rTreapTree 121 | {-# INLINE toList #-} 122 | 123 | instance (NFData m, NFData a) => NFData (RTreap m a) where 124 | rnf RTreap{..} = rnf rTreapTree `seq` () 125 | 126 | ---------------------------------------------------------------------------- 127 | -- Smart constructors 128 | ---------------------------------------------------------------------------- 129 | 130 | defaultRandomGenerator :: Random.PureMT 131 | defaultRandomGenerator = Random.pureMT 0 132 | 133 | -- | \( O(1) \). Create empty 'RTreap' with given random generator. 134 | emptyWithGen :: Random.PureMT -> RTreap m a 135 | emptyWithGen gen = RTreap gen Treap.Empty 136 | {-# INLINE emptyWithGen #-} 137 | 138 | -- | \( O(1) \). Create empty 'RTreap' using random generator with seed @0@. 139 | empty :: RTreap m a 140 | empty = emptyWithGen defaultRandomGenerator 141 | {-# INLINE empty #-} 142 | 143 | -- | \( O(1) \). Create singleton 'RTreap' with given random generator. 144 | oneWithGen :: Measured m a => Random.PureMT -> a -> RTreap m a 145 | oneWithGen gen a = 146 | let (priority, newGen) = Random.randomWord64 gen 147 | in RTreap newGen $ Treap.one (Priority priority) a 148 | {-# INLINE oneWithGen #-} 149 | 150 | -- | \( O(1) \). Create singleton 'RTreap' using random generator with seed @0@. 151 | one :: Measured m a => a -> RTreap m a 152 | one = oneWithGen defaultRandomGenerator 153 | {-# INLINE one #-} 154 | 155 | ---------------------------------------------------------------------------- 156 | -- Query functions 157 | ---------------------------------------------------------------------------- 158 | 159 | {- | \( O(1) \). Returns the size of the 'RTreap'. 160 | 161 | __Properties:__ 162 | 163 | * \( \forall (t\ ::\ \mathrm{Treap}\ m\ a)\ .\ \mathrm{size}\ t \geqslant 0 \) 164 | -} 165 | size :: RTreap m a -> Int 166 | size = unSize . withTreap Treap.size 167 | {-# INLINE size #-} 168 | 169 | -- | \( O(\log \ n) \). Lookup a value by a given key inside 'RTreap'. 170 | at :: Int -> RTreap m a -> Maybe a 171 | at i = withTreap $ Treap.at i 172 | {-# INLINE at #-} 173 | 174 | -- | \( O(\log \ n) \). Return value of monoidal accumulator on a segment @[l, r)@. 175 | query :: forall m a . Measured m a => Int -> Int -> RTreap m a -> m 176 | query l r = withTreap (Treap.query l r) 177 | {-# INLINE query #-} 178 | 179 | ---------------------------------------------------------------------------- 180 | -- Cuts and joins 181 | ---------------------------------------------------------------------------- 182 | 183 | -- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.splitAt'. 184 | splitAt :: forall m a . Measured m a => Int -> RTreap m a -> (RTreap m a, RTreap m a) 185 | splitAt i (RTreap gen t) = let (l, r) = Treap.splitAt i t in (RTreap gen l, RTreap gen r) 186 | {-# INLINE splitAt #-} 187 | 188 | -- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.merge'. 189 | merge :: Measured m a => RTreap m a -> RTreap m a -> RTreap m a 190 | merge (RTreap gen t1) (RTreap _ t2) = RTreap gen (Treap.merge t1 t2) 191 | {-# INLINE merge #-} 192 | 193 | -- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.take'. 194 | take :: forall m a . Measured m a => Int -> RTreap m a -> RTreap m a 195 | take n = overTreap (Treap.take n) 196 | {-# INLINE take #-} 197 | 198 | -- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.drop'. 199 | drop :: forall m a . Measured m a => Int -> RTreap m a -> RTreap m a 200 | drop n = overTreap (Treap.drop n) 201 | {-# INLINE drop #-} 202 | 203 | -- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.rotate'. 204 | rotate :: forall m a . Measured m a => Int -> RTreap m a -> RTreap m a 205 | rotate n = overTreap (Treap.rotate n) 206 | {-# INLINE rotate #-} 207 | 208 | ---------------------------------------------------------------------------- 209 | -- Modification functions 210 | ---------------------------------------------------------------------------- 211 | 212 | -- | \( O(\log \ n) \). Insert a value into 'RTreap' by given key. 213 | insert :: forall m a . Measured m a => Int -> a -> RTreap m a -> RTreap m a 214 | insert i a (RTreap gen t) = 215 | let (priority, newGen) = Random.randomWord64 gen 216 | in RTreap newGen $ Treap.insert i (Priority priority) a t 217 | {-# INLINE insert #-} 218 | 219 | {- | \( O(\log \ n) \). Delete 'RTreap' node that contains given key. If there is no 220 | such key, 'RTreap' remains unchanged. 221 | -} 222 | delete :: forall m a . Measured m a => Int -> RTreap m a -> RTreap m a 223 | delete i (RTreap gen t) = RTreap gen $ Treap.delete i t 224 | {-# INLINE delete #-} 225 | 226 | ---------------------------------------------------------------------------- 227 | -- Generic functions 228 | ---------------------------------------------------------------------------- 229 | 230 | -- | Lift a function that works with 'Treap' to 'RTreap'. 231 | withTreap :: (Treap m a -> r) -> (RTreap m a -> r) 232 | withTreap f = f . rTreapTree 233 | {-# INLINE withTreap #-} 234 | 235 | -- | Lift a function that works with 'Treap' to 'RTreap'. 236 | overTreap :: (Treap m a -> Treap m a) -> (RTreap m a -> RTreap m a) 237 | overTreap set t = t { rTreapTree = set $ rTreapTree t } 238 | {-# INLINE overTreap #-} 239 | 240 | ---------------------------------------------------------------------------- 241 | -- Pretty printing functions 242 | ---------------------------------------------------------------------------- 243 | 244 | -- | Pretty prints 'RTreap' without printing random generator. 245 | prettyPrint :: forall m a . (Coercible m a, Show a) => RTreap m a -> IO () 246 | prettyPrint = withTreap Treap.prettyPrint 247 | -------------------------------------------------------------------------------- /src/Treap/Pure.hs: -------------------------------------------------------------------------------- 1 | {- | Pure efficient implementation of the implicit treap data structure with the 2 | segment tree interface. 3 | 4 | __NOTE:__ Letter \( d \) in the documentation below means depth of the tree. Real 5 | depth depends on the strategy for creating 'Priority'. If the strategy is poor, 6 | the depth can be linear. However, if priorities are generated randomly, expected 7 | depth is \( O(\log \ n) \). 8 | -} 9 | 10 | {-# LANGUAGE DeriveAnyClass #-} 11 | {-# LANGUAGE FlexibleInstances #-} 12 | {-# LANGUAGE TypeFamilies #-} 13 | 14 | module Treap.Pure 15 | ( -- * Data structure 16 | Size (..) 17 | , Priority (..) 18 | , Treap (..) 19 | 20 | -- * Smart constructors 21 | , empty 22 | , one 23 | 24 | -- * Query functions 25 | , size 26 | , sizeInt 27 | , monoid 28 | , at 29 | , query 30 | 31 | -- * Cuts and joins 32 | , splitAt 33 | , merge 34 | , take 35 | , drop 36 | , rotate 37 | 38 | -- * Modification functions 39 | , insert 40 | , delete 41 | 42 | -- * Core internal functions 43 | , recalculate 44 | ) where 45 | 46 | import Prelude hiding (drop, lookup, splitAt, take) 47 | 48 | import Control.DeepSeq (NFData) 49 | import Data.Foldable (foldl') 50 | import Data.Word (Word64) 51 | import GHC.Exts (IsList (..)) 52 | import GHC.Generics (Generic) 53 | 54 | import Treap.Measured (Measured (..)) 55 | 56 | -- $setup 57 | -- >>> import Data.Monoid 58 | -- >>> import Treap.Pretty 59 | 60 | ---------------------------------------------------------------------------- 61 | -- Data structure and instances 62 | ---------------------------------------------------------------------------- 63 | 64 | {- | Size of the 'Treap' data structure. Guaranteed to be always non-negative. 65 | -} 66 | newtype Size = Size 67 | { unSize :: Int 68 | } deriving stock (Show, Read, Generic) 69 | deriving newtype (Eq, Ord, Num, NFData) 70 | 71 | {- | Priority in the 'Treap' data structure. 72 | -} 73 | newtype Priority = Priority 74 | { unPriority :: Word64 75 | } deriving stock (Show, Read, Generic) 76 | deriving newtype (Eq, Ord, NFData) 77 | 78 | -- | 'Treap' data structure. 79 | data Treap m a 80 | = Node !Size !Priority !m a !(Treap m a) !(Treap m a) 81 | | Empty 82 | deriving stock (Show, Read, Eq, Generic, Foldable) 83 | deriving anyclass (NFData) 84 | 85 | {- | (<>) is implemented via 'merge'. 86 | -} 87 | instance Measured m a => Semigroup (Treap m a) where 88 | (<>) = merge 89 | 90 | {- | mempty is implemented via 'empty'. 91 | -} 92 | instance Measured m a => Monoid (Treap m a) where 93 | mempty = empty 94 | 95 | -- | \( O(1) \). Takes cached value from the root. 96 | instance Monoid m => Measured m (Treap m a) where 97 | measure = monoid 98 | {-# INLINE measure #-} 99 | 100 | -- #if __GLASGOW_HASKELL__ >= 806 101 | -- -- | Safe 'Functor' instance that performs recalculation of monoidal accumulator. 102 | -- instance (forall b . Measured m b) => Functor (Treap m) where 103 | -- fmap :: forall a b . (a -> b) -> Treap m a -> Treap m b 104 | -- fmap f = go 105 | -- where 106 | -- go :: Treap m a -> Treap m b 107 | -- go Empty = Empty 108 | -- go (Node _ p _ a l r) = recalculate $ new p (f a) (go l) (go r) 109 | -- #endif 110 | 111 | {- | This instance allows to create 'Treap' from the list of triples. If all 112 | priorities are random then the expected performance of the @fromList@ function 113 | is \( O(n\ \log \ n)\). 114 | 115 | __TODO:__ It's possible to implement \( O(n) \) algorithm however. 116 | See issue #15: 117 | -} 118 | instance Measured m a => IsList (Treap m a) where 119 | type Item (Treap m a) = (Priority, a) 120 | 121 | -- TODO: implement O(n) algorithm 122 | fromList :: [(Priority, a)] -> Treap m a 123 | fromList = 124 | foldl' (\t (i, p, a) -> insert i p a t) Empty 125 | . zipWith (\i (p, a) -> (i, p, a)) [0..] 126 | {-# INLINE fromList #-} 127 | 128 | -- TODO: make more efficient 129 | toList :: Treap m a -> [(Priority, a)] 130 | toList Empty = [] 131 | toList (Node _ p _ a l r) = toList l ++ (p, a) : toList r 132 | 133 | ---------------------------------------------------------------------------- 134 | -- Smart constructors 135 | ---------------------------------------------------------------------------- 136 | 137 | -- | \( O(1) \). Creates empty 'Treap'. 138 | empty :: Treap m a 139 | empty = Empty 140 | {-# INLINE empty #-} 141 | 142 | -- | \( O(1) \). Creates singleton 'Treap'. 143 | one :: Measured m a => Priority -> a -> Treap m a 144 | one p a = Node (Size 1) p (measure a) a Empty Empty 145 | {-# INLINE one #-} 146 | 147 | ---------------------------------------------------------------------------- 148 | -- Query functions 149 | ---------------------------------------------------------------------------- 150 | 151 | {- | \( O(1) \). Returns the number of the elements in the 'Treap'. Always 152 | non-negative. 153 | 154 | __Properties:__ 155 | 156 | * \( \forall (t\ ::\ \mathrm{Treap}\ m\ a)\ .\ \mathrm{size}\ t \geqslant 0 \) 157 | -} 158 | size :: Treap m a -> Size 159 | size = \case 160 | Empty -> Size 0 161 | Node s _ _ _ _ _ -> s 162 | {-# INLINE size #-} 163 | 164 | -- | Take size of the 'Treap' as 'Int'. 165 | sizeInt :: Treap m a -> Int 166 | sizeInt = unSize . size 167 | {-# INLINE sizeInt #-} 168 | 169 | -- | \( O(1) \). Returns accumulated value in the root of the tree. 170 | monoid :: Monoid m => Treap m a -> m 171 | monoid = \case 172 | Empty -> mempty 173 | Node _ _ m _ _ _ -> m 174 | {-# INLINE monoid #-} 175 | 176 | -- | \( O(d) \). Lookup a value inside 'Treap' by a given index. 177 | at :: forall m a . Int -> Treap m a -> Maybe a 178 | at i t 179 | | i < 0 = Nothing 180 | | i >= sizeInt t = Nothing 181 | | otherwise = go i t 182 | where 183 | go :: Int -> Treap m a -> Maybe a 184 | go _ Empty = Nothing 185 | go k (Node _ _ _ a l r) = 186 | let lSize = sizeInt l 187 | in case compare k lSize of 188 | EQ -> Just a 189 | LT -> go k l 190 | GT -> go (k - lSize - 1) r 191 | 192 | -- | \( O(d) \). Return value of monoidal accumulator on a segment @[l, r)@. 193 | query :: forall m a . Measured m a => Int -> Int -> Treap m a -> m 194 | query from to t 195 | | to <= from = mempty 196 | | otherwise = 197 | let (l, _) = splitAt to t 198 | (_, m) = splitAt from l 199 | in monoid m 200 | 201 | ---------------------------------------------------------------------------- 202 | -- Cuts and joins 203 | ---------------------------------------------------------------------------- 204 | 205 | -- | Create new 'Node' and recalculate its values. 206 | new :: Measured m a => Priority -> a -> Treap m a -> Treap m a -> Treap m a 207 | new p a l r = recalculate $ Node 0 p mempty a l r 208 | {-# INLINE new #-} 209 | 210 | {- | \( O(d) \). @splitAt i t@ splits 'Treap' by the given index into two treaps 211 | @(t1, t2)@ such that the following properties hold: 212 | 213 | 1. \( \mathrm{size}\ t_1 = i \) 214 | 2. \( \mathrm{size}\ t_2 = n - i \) 215 | 3. \( \mathrm{merge}\ t_1\ t_2 \equiv t \) 216 | 217 | __Special cases:__ 218 | 219 | 1. If \( i \leqslant 0 \) then the result is @('empty', t)@. 220 | 2. If \( i \geqslant n \) then the result is @(t, 'empty')@. 221 | -} 222 | splitAt :: forall m a . Measured m a => Int -> Treap m a -> (Treap m a, Treap m a) 223 | splitAt i t 224 | | i <= 0 = (empty, t) 225 | | i >= sizeInt t = (t, empty) 226 | | otherwise = go i t 227 | where 228 | go :: Int -> Treap m a -> (Treap m a, Treap m a) 229 | go k = \case 230 | Empty -> (Empty, Empty) 231 | Node _ p _ a left right -> 232 | let lSize = sizeInt left 233 | in case compare k lSize of 234 | EQ -> (left, new p a Empty right) 235 | LT -> 236 | let (!t1, !newLeft) = go k left 237 | in (t1, new p a newLeft right) 238 | GT -> 239 | let (!newRight, !t2) = go (k - lSize - 1) right 240 | in (new p a left newRight, t2) 241 | 242 | {- | \( O(\max\ d_1\ d_2) \). Merge two 'Treap's into single one. 243 | 244 | >>> pone p a = one (Priority p) a :: Treap (Sum Int) Int 245 | >>> prettyPrint $ merge (merge (pone 1 3) (pone 4 5)) (merge (pone 3 0) (pone 5 9)) 246 | 4,17:9 247 | ╱ 248 | 3,8:5 249 | ╱╲ 250 | ╱ ╲ 251 | ╱ ╲ 252 | 1,3:3 1,0:0 253 | -} 254 | merge :: Measured m a => Treap m a -> Treap m a -> Treap m a 255 | merge Empty r = r 256 | merge l Empty = l 257 | merge l@(Node _ p1 _ a1 l1 r1) r@(Node _ p2 _ a2 l2 r2) 258 | | p1 > p2 = recalculate $ new p1 a1 l1 (merge r1 r) 259 | | otherwise = recalculate $ new p2 a2 (merge l l2) r2 260 | 261 | {- | \( O(d) \). @'take' n t@ returns 'Treap' that contains first @n@ elements of the given 262 | 'Treap' @t@. 263 | 264 | __Special cases:__ 265 | 266 | 1. If \( i \leqslant 0 \) then the result is 'empty'. 267 | 2. If \( i \geqslant n \) then the result is @t@. 268 | -} 269 | take :: forall m a . Measured m a => Int -> Treap m a -> Treap m a 270 | take n t 271 | | n <= 0 = Empty 272 | | n >= sizeInt t = t 273 | | otherwise = go n t 274 | where 275 | go :: Int -> Treap m a -> Treap m a 276 | go _ Empty = Empty 277 | go 0 _ = Empty 278 | go i (Node _ p _ a l r) = 279 | let lSize = sizeInt l 280 | in case compare i lSize of 281 | LT -> go i l 282 | EQ -> l 283 | GT -> new p a l $ go (i - lSize - 1) r 284 | 285 | {- | \( O(d) \). @'drop' n t@ returns 'Treap' without first @n@ elements of the given 286 | 'Treap' @t@. 287 | 288 | __Special cases:__ 289 | 290 | 1. If \( i \leqslant 0 \) then the result is @t@. 291 | 2. If \( i \geqslant n \) then the result is 'empty'. 292 | -} 293 | drop :: forall m a . Measured m a => Int -> Treap m a -> Treap m a 294 | drop n t 295 | | n <= 0 = t 296 | | n >= sizeInt t = Empty 297 | | otherwise = go n t 298 | where 299 | go :: Int -> Treap m a -> Treap m a 300 | go _ Empty = Empty 301 | go 0 tree = tree 302 | go i (Node _ p _ a l r) = 303 | let lSize = sizeInt l 304 | in case compare i lSize of 305 | LT -> new p a (go i l) r 306 | EQ -> new p a Empty r 307 | GT -> go (i - lSize - 1) r 308 | 309 | {- | \( O(d) \). Rotate a 'Treap' to the right by a given number of elements 310 | modulo treap size. In simple words, @'rotate' n t@ takes first @n@ elements of 311 | @t@ and puts them at the end of @t@ in the same order. If the given index is 312 | negative, then this function rotates left. 313 | -} 314 | rotate :: forall m a . Measured m a => Int -> Treap m a -> Treap m a 315 | rotate n t = case t of 316 | Empty -> Empty 317 | _ | n == 0 -> t 318 | | otherwise -> let (left, right) = splitAt shift t in merge right left 319 | where 320 | shift :: Int 321 | shift = n `mod` sizeInt t 322 | 323 | ---------------------------------------------------------------------------- 324 | -- Modification functions 325 | ---------------------------------------------------------------------------- 326 | 327 | {- | \( O(d) \). Insert a value into 'Treap' with given key and priority. 328 | Updates monoidal accumulator accordingly. 329 | -} 330 | insert :: forall m a . Measured m a => Int -> Priority -> a -> Treap m a -> Treap m a 331 | insert i p a t 332 | | i < 0 = go 0 t 333 | | i >= sizeInt t = go (sizeInt t) t 334 | | otherwise = go i t 335 | where 336 | go :: Int -> Treap m a -> Treap m a 337 | go _ Empty = one p a 338 | go k node@(Node _ tp _ ta l r) 339 | | p <= tp = 340 | let lSize = sizeInt l 341 | in if k <= lSize 342 | then recalculate $ new tp ta (go k l) r 343 | else recalculate $ new tp ta l (go (k - lSize - 1) r) 344 | | otherwise = 345 | let (!newL, !newR) = splitAt k node 346 | in recalculate $ new p a newL newR 347 | 348 | {- | \( O(d) \). Delete element from 'Treap' by the given index. If index is out 349 | of bounds, 'Treap' remains unchanged. 350 | -} 351 | delete :: forall m a . Measured m a => Int -> Treap m a -> Treap m a 352 | delete i t 353 | | i < 0 = t 354 | | i >= sizeInt t = t 355 | | otherwise = go i t 356 | where 357 | go :: Int -> Treap m a -> Treap m a 358 | go _ Empty = Empty 359 | go k (Node _ p _ a l r) = 360 | let lSize = sizeInt l 361 | in case compare k lSize of 362 | EQ -> merge l r 363 | LT -> recalculate $ new p a (go k l) r 364 | GT -> recalculate $ new p a l (go (k - lSize - 1) r) 365 | 366 | ---------------------------------------------------------------------------- 367 | -- Core internal functions 368 | ---------------------------------------------------------------------------- 369 | 370 | {- | \( O(1) \). Calculate size and the value of the monoidal accumulator 371 | in the given root node. This function doesn't perform any recursive calls and it 372 | assumes that the values in the children are already correct. So use this 373 | function only in bottom-up manner. 374 | -} 375 | recalculate :: Measured m a => Treap m a -> Treap m a 376 | recalculate Empty = Empty 377 | recalculate (Node _ p _ a l r) = 378 | Node (1 + size l + size r) p (measure l <> measure a <> measure r) a l r 379 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | --------------------------------------------------------------------------------