treap (empty) → 0.0.0.0

raw patch · 16 files changed

+1744/−0 lines, 16 filesdep +Globdep +basedep +deepseq

Dependencies added: Glob, base, deepseq, doctest, hspec, hspec-core, mersenne-random-pure64, treap

Files

CHANGELOG.md +11/−0
LICENSE +373/−0
README.md +73/−0
src/Treap.hs +94/−0
src/Treap/Measured.hs +73/−0
src/Treap/Pretty.hs +182/−0
src/Treap/Pure.hs +368/−0
src/Treap/Rand.hs +236/−0
test/Doctest.hs +23/−0
test/Spec.hs +17/−0
test/Test/Common.hs +21/−0
test/Test/Rand.hs +16/−0
test/Test/Rand/Cuts.hs +70/−0
test/Test/Rand/Query.hs +51/−0
test/Test/Rand/Update.hs +38/−0
treap.cabal +98/−0

+ CHANGELOG.md view

@@ -0,0 +1,11 @@+# Changelog++`treap` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++## 0.0.0.0 — Apr 29, 2019++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/chshersh/treap/releases

+ LICENSE view

@@ -0,0 +1,373 @@+Mozilla Public License Version 2.0+==================================++1. Definitions+--------------++1.1. "Contributor"+    means each individual or legal entity that creates, contributes to+    the creation of, or owns Covered Software.++1.2. "Contributor Version"+    means the combination of the Contributions of others (if any) used+    by a Contributor and that particular Contributor's Contribution.++1.3. "Contribution"+    means Covered Software of a particular Contributor.++1.4. "Covered Software"+    means Source Code Form to which the initial Contributor has attached+    the notice in Exhibit A, the Executable Form of such Source Code+    Form, and Modifications of such Source Code Form, in each case+    including portions thereof.++1.5. "Incompatible With Secondary Licenses"+    means++    (a) that the initial Contributor has attached the notice described+        in Exhibit B to the Covered Software; or++    (b) that the Covered Software was made available under the terms of+        version 1.1 or earlier of the License, but not also under the+        terms of a Secondary License.++1.6. "Executable Form"+    means any form of the work other than Source Code Form.++1.7. "Larger Work"+    means a work that combines Covered Software with other material, in+    a separate file or files, that is not Covered Software.++1.8. "License"+    means this document.++1.9. "Licensable"+    means having the right to grant, to the maximum extent possible,+    whether at the time of the initial grant or subsequently, any and+    all of the rights conveyed by this License.++1.10. "Modifications"+    means any of the following:++    (a) any file in Source Code Form that results from an addition to,+        deletion from, or modification of the contents of Covered+        Software; or++    (b) any new file in Source Code Form that contains any Covered+        Software.++1.11. "Patent Claims" of a Contributor+    means any patent claim(s), including without limitation, method,+    process, and apparatus claims, in any patent Licensable by such+    Contributor that would be infringed, but for the grant of the+    License, by the making, using, selling, offering for sale, having+    made, import, or transfer of either its Contributions or its+    Contributor Version.++1.12. "Secondary License"+    means either the GNU General Public License, Version 2.0, the GNU+    Lesser General Public License, Version 2.1, the GNU Affero General+    Public License, Version 3.0, or any later versions of those+    licenses.++1.13. "Source Code Form"+    means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+    means an individual or a legal entity exercising rights under this+    License. For legal entities, "You" includes any entity that+    controls, is controlled by, or is under common control with You. For+    purposes of this definition, "control" means (a) the power, direct+    or indirect, to cause the direction or management of such entity,+    whether by contract or otherwise, or (b) ownership of more than+    fifty percent (50%) of the outstanding shares or beneficial+    ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+    Licensable by such Contributor to use, reproduce, make available,+    modify, display, perform, distribute, and otherwise exploit its+    Contributions, either on an unmodified basis, with Modifications, or+    as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+    for sale, have made, import, and otherwise transfer either its+    Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+    or++(b) for infringements caused by: (i) Your and any other third party's+    modifications of Covered Software, or (ii) the combination of its+    Contributions with other software (except as part of its Contributor+    Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+    its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+    Form, as described in Section 3.1, and You must inform recipients of+    the Executable Form how they can obtain a copy of such Source Code+    Form by reasonable means in a timely manner, at a charge no more+    than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+    License, or sublicense it under different terms, provided that the+    license for the Executable Form does not attempt to limit or alter+    the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+*                                                                      *+*  6. Disclaimer of Warranty                                           *+*  -------------------------                                           *+*                                                                      *+*  Covered Software is provided under this License on an "as is"       *+*  basis, without warranty of any kind, either expressed, implied, or  *+*  statutory, including, without limitation, warranties that the       *+*  Covered Software is free of defects, merchantable, fit for a        *+*  particular purpose or non-infringing. The entire risk as to the     *+*  quality and performance of the Covered Software is with You.        *+*  Should any Covered Software prove defective in any respect, You     *+*  (not any Contributor) assume the cost of any necessary servicing,   *+*  repair, or correction. This disclaimer of warranty constitutes an   *+*  essential part of this License. No use of any Covered Software is   *+*  authorized under this License except under this disclaimer.         *+*                                                                      *+************************************************************************++************************************************************************+*                                                                      *+*  7. Limitation of Liability                                          *+*  --------------------------                                          *+*                                                                      *+*  Under no circumstances and under no legal theory, whether tort      *+*  (including negligence), contract, or otherwise, shall any           *+*  Contributor, or anyone who distributes Covered Software as          *+*  permitted above, be liable to You for any direct, indirect,         *+*  special, incidental, or consequential damages of any character      *+*  including, without limitation, damages for lost profits, loss of    *+*  goodwill, work stoppage, computer failure or malfunction, or any    *+*  and all other commercial damages or losses, even if such party      *+*  shall have been informed of the possibility of such damages. This   *+*  limitation of liability shall not apply to liability for death or   *+*  personal injury resulting from such party's negligence to the       *+*  extent applicable law prohibits such limitation. Some               *+*  jurisdictions do not allow the exclusion or limitation of           *+*  incidental or consequential damages, so this exclusion and          *+*  limitation may not apply to You.                                    *+*                                                                      *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++  This Source Code Form is subject to the terms of the Mozilla Public+  License, v. 2.0. If a copy of the MPL was not distributed with this+  file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++  This Source Code Form is "Incompatible With Secondary Licenses", as+  defined by the Mozilla Public License, v. 2.0.

+ README.md view

@@ -0,0 +1,73 @@+# treap++![Treap: tree logo](https://user-images.githubusercontent.com/4276606/56883228-9f32f180-6a98-11e9-9554-13735ff1ed30.png)+[![Hackage](https://img.shields.io/hackage/v/treap.svg)](https://hackage.haskell.org/package/treap)+[![Build status](https://secure.travis-ci.org/chshersh/treap.svg)](https://travis-ci.org/chshersh/treap)+[![MPL-2.0 license](https://img.shields.io/badge/license-MPL--2.0-blue.svg)](LICENSE)++Efficient implementation of the implicit treap data structure.++## What does this package provide?++This package implements a tree-like data structure called _implicit treap_. This+data structure implements interface similar to random-access arrays, but with+fast (logarithmic time complexity)+`insert`/`delete`/`split`/`merge`/`take`/`drop`/`rotate` operations. In addition,+_treap_ allows you to specify and measure values of any monoids on a segment,+like a sum of elements or minimal element on some contiguous part of the array.++## When to use this package?++Use this package when you want the following operations to be fast:++1. Access elements by index.+2. Insert elements by index.+3. Delete elements by index.+4. Calculate monoidal operation (like sum, product, min, etc.) of all elements+   between two indices.+5. Call slicing operations like `take` or `drop` or `split`.++Below you can find the table of time complexity for all operations (where `n` is+the size of the treap):++| Operation | Time complexity | Description                          |+|-----------|-----------------|--------------------------------------|+| `size`    | `O(1)`          | Get number of elements in the treap  |+| `at`      | `O(log n)`      | Access by index                      |+| `insert`  | `O(log n)`      | Insert by index                      |+| `delete`  | `O(log n)`      | Delete by index                      |+| `query`   | `O(log n)`      | Measure monoid on the segment        |+| `splitAt` | `O(log n)`      | Split treap by index into two treaps |+| `merge`   | `O(log n)`      | Merge two treaps into a single one   |+| `take`    | `O(log n)`      | Take first `i` elements of the treap |+| `drop`    | `O(log n)`      | Drop first `i` elements of the treap |+| `rotate`  | `O(log n)`      | Put first `i` elements to the end    |++The package also comes with nice pretty-printing!++```haskell+ghci> t = fromList [1..5] :: RTreap (Sum Int) Int+ghci> prettyPrint t+   5,15:2+      ╱╲+     ╱  ╲+    ╱    ╲+   ╱      ╲+1,1:1   3,12:4+          ╱╲+         ╱  ╲+        ╱    ╲+      1,3:3 1,5:5++```++## Alternatives++If you don't need to calculate monoidal operations, you may alternatively use+[`Seq`](https://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Sequence.html#t:Seq)+from the `containers` package as it provides more extended interface but doesn't+allow to measure monoidal values on segments.++## Acknowledgement++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/).

+ src/Treap.hs view

@@ -0,0 +1,94 @@+{- |++== General description++Package @treap@ implements a tree-like data structure called /implicit treap/. This+data structure implements interface similar to random-access arrays, but with+fast (logarithmic time complexity)+@'insert'@ \/ @'delete'@ \/ @'Treap.splitAt'@ \/ @'merge'@ \/ @'Treap.take'@ \/ @'Treap.drop'@ \/ @'rotate'@ operations.++In addition, 'Treap.Pure.Treap' and 'RTreap' allow you to specify and measure+values of any monoids on a segment, like a sum of elements or minimal element on+some contiguous part of the array.++== Package structure++This package contains the following modules:++* __"Treap.Measured":__ typeclass 'Measured' that allows telling how to measure+  tree values as monoids.+* __"Treap.Pure":__ the 'Treap.Pure.Treap' data type and functions – pure+  implementation of the implicit treap data structure.+* __"Treap.Rand":__ the 'RTreap' data type and functions – pure implementation+  of the implicit treap which uses a pure random generator to generate+  priorities automatically.+* __"Treap.Pretty":__ pretty-printer for the treap.++Module __"Treap"__ reexports only __"Treap.Measured"__ and __"Treap.Rand"__ modules.++== Usage example++Consider the following example of creating 'RTreap' from list @[1..5]@ where+each element stores the sum of elements in its subtree:++>>> import Data.Monoid (Sum (..))+>>> import GHC.Exts (IsList (..))+>>> t = fromList [1..5] :: RTreap (Sum Int) Int+>>> prettyPrint t+   5,15:2+      ╱╲+     ╱  ╲+    ╱    ╲+   ╱      ╲+1,1:1   3,12:4+          ╱╲+         ╱  ╲+        ╱    ╲+      1,3:3 1,5:5++Each node shows:++1. The overall size of the tree+2. The total monoidal measure of the tree+3. The element itself after @:@++You can try to play with this tree now!++>>> at 0 t+Just 1+>>> at 10 t+Nothing+>>> query 1 4 t+Sum {getSum = 9}++>>> prettyPrint $ Treap.take 2 t+ 2,3:2+  ╱+1,1:1++>>> prettyPrint $ Treap.drop 2 t+  3,12:4+    ╱╲+   ╱  ╲+  ╱    ╲+1,3:3 1,5:5++>>> prettyPrint $ rotate 2 t+   5,15:2+     ╱+  4,13:4+    ╱╲+   ╱  ╲+  ╱    ╲+1,3:3 2,6:5+         ╲+       1,1:1++-}++module Treap+       ( module Treap+       ) where++import Treap.Measured as Treap+import Treap.Rand as Treap

+ src/Treap/Measured.hs view

@@ -0,0 +1,73 @@+{-# LANGUAGE FlexibleInstances #-}++{- | Typeclass that tells how to measure different values as 'Monoid'.+-}++module Treap.Measured+       ( Measured (..)+       ) where++import Data.Functor.Identity (Identity (..))+import Data.Monoid (All (..), Any (..), Dual (..), Endo (..), First (..), Last (..), Product (..),+                    Sum (..))+import Data.Semigroup (Max (..), Min (..))+++{- | This typeclass allows to specify how to convert value of type @a@ into+monoidal value of type @m@.+-}+class Monoid m => Measured m a where+    measure :: a -> m++-- | Measure every 'Monoid' as itself.+instance Monoid a => Measured (Identity a) a where+    measure = Identity+    {-# INLINE measure #-}++-- | Measure every 'Monoid' as its dual.+instance Monoid a => Measured (Dual a) a where+    measure = Dual+    {-# INLINE measure #-}++-- | Measure every endomorphic function with compostion.+instance Measured (Endo a) (a -> a) where+    measure = Endo+    {-# INLINE measure #-}++-- | Measure every numeric value with addition.+instance Num a => Measured (Sum a) a where+    measure = Sum+    {-# INLINE measure #-}++-- | Measure every numeric value with multiplication.+instance Num a => Measured (Product a) a where+    measure = Product+    {-# INLINE measure #-}++-- | Measure every comparable value with minimum.+instance (Ord a, Bounded a) => Measured (Min a) a where+    measure = Min+    {-# INLINE measure #-}++-- | Measure every comparable value with maximum.+instance (Ord a, Bounded a) => Measured (Max a) a where+    measure = Max+    {-# INLINE measure #-}++-- | Measure every value as the 'First' monoid.+instance Measured (First a) a where+    measure = First . Just+    {-# INLINE measure #-}++-- | Measure every value as the 'Last' monoid.+instance Measured (Last a) a where+    measure = Last . Just+    {-# INLINE measure #-}++-- | Measure boolean value with '&&'.+instance Measured All Bool where+    measure = All++-- | Measure boolean value with '||'.+instance Measured Any Bool where+    measure = Any

+ src/Treap/Pretty.hs view

@@ -0,0 +1,182 @@+-- | Very nice 'Treap' visualisation.++module Treap.Pretty+       ( pretty+       , prettyPrint+       , prettyWith+       , compactShowNode++         -- * Internal implementation details+       , BinTree (..)+       , showTree+       , middleLabelPos+       , branchLines+       ) where++import Data.Char (isSpace)+import Data.Coerce (Coercible, coerce)+import Data.List (dropWhileEnd, intercalate)++import Treap.Pure (Priority (..), Size (..), Treap (..))+++{- | Show 'Treap' in a pretty way using 'compactShowNode' function.+-}+pretty :: forall m a . (Coercible m a, Show a) => Treap m a -> String+pretty = prettyWith compactShowNode++-- | Call 'pretty' function and output the result directly to @stdout@.+prettyPrint :: forall m a . (Coercible m a, Show a) => Treap m a -> IO ()+prettyPrint = putStrLn . pretty++{- | Show 'Treap' node in a format:++@+\<size\>,\<acc\>:a+@+-}+compactShowNode+    :: forall m a . (Coercible m a, Show a)+    => Size+    -> Priority+    -> m+    -> a+    -> String+compactShowNode (Size sz) _ m a =+    show sz ++ "," ++ show (coerce @m @a m) ++ ":" ++ show a++-- | Show 'Treap' in a nice way using given function to display node.+prettyWith+    :: forall m a .+       (Size -> Priority -> m -> a -> String)+    -> Treap m a+    -> String+prettyWith display = showTree . toBinTree+  where+    toBinTree :: Treap m a -> BinTree+    toBinTree Empty = Leaf+    toBinTree (Node sz p m a left right) = Branch (display sz p m a) (toBinTree left) (toBinTree right)++-- | Intermidiate structure to help string conversion.+data BinTree+    = Leaf+    | Branch String BinTree BinTree++-- | Hardcore function responsible for pretty showing of the 'BinTree' data type.+showTree :: BinTree -> String+showTree Leaf                  = ""+showTree (Branch label left right) = case (left, right) of+    (Leaf, Leaf) -> label++    (_, Leaf) -> toLines $+        [ spaces rootShiftOnlyLeft   ++ label+        , spaces branchShiftOnlyLeft ++ "╱"+        ] ++ map (spaces leftShiftOnlyLeft ++) leftLines++    (Leaf, _) -> toLines $+        [ spaces rootShiftOnlyRight   ++ label+        , spaces branchShiftOnlyRight ++ "╲"+        ] ++ map (spaces rightShiftOnlyRight ++) rightLines++    (_, _) -> toLines $+        [ spaces rootOffset ++ label+        ]+        ++ map (spaces rootOffset ++ ) (branchLines branchHeight)+        ++ map (spaces childrenOffset ++) (zipChildren leftLines rightLines)+  where+    leftStr, rightStr :: String+    leftStr  = showTree left+    rightStr = showTree right++    leftLines :: [String]+    leftLines  = lines leftStr+    rightLines = lines rightStr++    rootLabelMiddle, leftLabelMiddle, rightLabelMiddle :: Int+    rootLabelMiddle  = middleLabelPos label+    leftLabelMiddle  = middleLabelPos $ head leftLines+    rightLabelMiddle = middleLabelPos $ head rightLines++    -- Case 1: all offsets when node has only left branch+    rootShiftOnlyLeft, leftShiftOnlyLeft, branchShiftOnlyLeft :: Int+    (rootShiftOnlyLeft, leftShiftOnlyLeft) = case compare rootLabelMiddle leftLabelMiddle of+        EQ -> (1, 0)+        GT -> (0, rootLabelMiddle - leftLabelMiddle - 1)+        LT -> (leftLabelMiddle - rootLabelMiddle + 1, 0)+    branchShiftOnlyLeft = rootLabelMiddle + rootShiftOnlyLeft - 1++    -- Case 2: all offsets when node has only right branch+    rootShiftOnlyRight, rightShiftOnlyRight, branchShiftOnlyRight :: Int+    (rootShiftOnlyRight, rightShiftOnlyRight) = case compare rootLabelMiddle rightLabelMiddle of+        EQ -> (0, 1)+        GT -> (0, rootLabelMiddle - rightLabelMiddle + 1)+        LT -> (rightLabelMiddle - rootLabelMiddle - 1, 0)+    branchShiftOnlyRight = rootLabelMiddle + rootShiftOnlyRight + 1++    -- Case 3: both+    leftWidth, rightOffMiddle, childDistance, branchHeight, rootMustMiddle :: Int+    leftWidth      = 1 + maximum (map length leftLines)+    rightOffMiddle = leftWidth + rightLabelMiddle+    childDistance  = rightOffMiddle - leftLabelMiddle+    branchHeight   = childDistance `div` 2+    rootMustMiddle = (leftLabelMiddle + rightOffMiddle) `div` 2++    rootOffset, childrenOffset :: Int+    (rootOffset, childrenOffset) = case compare rootLabelMiddle rootMustMiddle of+        EQ -> (0, 0)+        LT -> (rootMustMiddle - rootLabelMiddle, 0)+        GT -> (0, rootLabelMiddle - rootMustMiddle)++    zipChildren :: [String] -> [String] -> [String]+    zipChildren l []          = l+    zipChildren [] r          = map (spaces leftWidth ++ ) r+    zipChildren (x:xs) (y:ys) =+        let xLen = length x+            newX = x ++ spaces (leftWidth - xLen)+        in (newX ++ y) : zipChildren xs ys++-- | Generates strings containing of @n@ spaces.+spaces :: Int -> String+spaces n = replicate n ' '++{- | Calculates position of middle of non-space part of the string.++>>> s = "   abc "+>>> length s+7+>>> middleLabelPos s+4+-}+middleLabelPos :: String -> Int+middleLabelPos s =+    let (spacePrefix, rest) = span isSpace s+    in length spacePrefix + (length (dropWhileEnd isSpace rest) `div` 2)++-- | Like 'unlines' but doesn't add "\n" to the end.+toLines :: [String] -> String+toLines = intercalate "\n"++{- | Draws branches of the given height.++>>> putStrLn $ toLines $ branchLines 1+╱╲++>>> putStrLn $ toLines $ branchLines 2+ ╱╲+╱  ╲++>>> putStrLn $ toLines $ branchLines 3+  ╱╲+ ╱  ╲+╱    ╲+-}+branchLines :: Int -> [String]+branchLines n = go 0+  where+    go :: Int -> [String]+    go i+        | i == n    = []+        | otherwise = line : go (i + 1)+      where+        line :: String+        line = spaces (n - i - 1) ++ "╱" ++ spaces (2 * i) ++ "╲"

+ src/Treap/Pure.hs view

@@ -0,0 +1,368 @@+{- | Pure efficient implementation of the implicit treap data structure with the+segment tree interface.++__NOTE:__ Letter \( d \) in the documentation below means depth of the tree. Real+depth depends on the strategy for creating 'Priority'. If the strategy is poor,+the depth can be linear. However, if priorities are generated randomly, expected+depth is \( O(\log \ n) \).+-}++{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies      #-}++module Treap.Pure+       ( -- * Data structure+         Size (..)+       , Priority (..)+       , Treap (..)++         -- * Smart constructors+       , empty+       , one++         -- * Query functions+       , size+       , sizeInt+       , monoid+       , at+       , query++         -- * Cuts and joins+       , splitAt+       , merge+       , take+       , drop+       , rotate++         -- * Modification functions+       , insert+       , delete++         -- * Core internal functions+       , recalculate+       ) where++import Prelude hiding (drop, lookup, splitAt, take)++import Control.DeepSeq (NFData)+import Data.Foldable (foldl')+import Data.Word (Word64)+import GHC.Exts (IsList (..))+import GHC.Generics (Generic)++import Treap.Measured (Measured (..))++-- $setup+-- >>> import Data.Monoid+-- >>> import Treap.Pretty++----------------------------------------------------------------------------+-- Data structure and instances+----------------------------------------------------------------------------++{- | Size of the 'Treap' data structure. Guaranteed to be always non-negative.+-}+newtype Size = Size+    { unSize :: Int+    } deriving stock (Show, Read, Generic)+      deriving newtype (Eq, Ord, Num, NFData)++{- | Priority in the 'Treap' data structure.+-}+newtype Priority = Priority+    { unPriority :: Word64+    } deriving stock (Show, Read, Generic)+      deriving newtype (Eq, Ord, NFData)++-- | 'Treap' data structure.+data Treap m a+    = Node !Size !Priority !m a !(Treap m a) !(Treap m a)+    | Empty+    deriving stock (Show, Read, Eq, Generic, Foldable)+    deriving anyclass (NFData)++-- | \( O(1) \). Takes cached value from the root.+instance Monoid m => Measured m (Treap m a) where+    measure = monoid+    {-# INLINE measure #-}++-- #if __GLASGOW_HASKELL__ >= 806+-- -- | Safe 'Functor' instance that performs recalculation of monoidal accumulator.+-- instance (forall b . Measured m b) => Functor (Treap m) where+--     fmap :: forall a b . (a -> b) -> Treap m a -> Treap m b+--     fmap f = go+--       where+--         go :: Treap m a -> Treap m b+--         go Empty = Empty+--         go (Node _ p _ a l r) = recalculate $ new p (f a) (go l) (go r)+-- #endif++{- | This instance allows to create 'Treap' from the list of triples. If all+priorities are random then the expected performance of the @fromList@ function+is \( O(n\ \log \ n)\).++__TODO:__ It's possible to implement \( O(n) \) algorithm however.+See issue #15: <https://github.com/chshersh/treap/issues/15>+-}+instance Measured m a => IsList (Treap m a) where+    type Item (Treap m a) = (Priority, a)++    -- TODO: implement O(n) algorithm+    fromList :: [(Priority, a)] -> Treap m a+    fromList =+        foldl' (\t (i, p, a) -> insert i p a t) Empty+        . zipWith (\i (p, a) -> (i, p, a)) [0..]+    {-# INLINE fromList #-}++    -- TODO: make more efficient+    toList :: Treap m a -> [(Priority, a)]+    toList Empty              = []+    toList (Node _ p _ a l r) = toList l ++ (p, a) : toList r++----------------------------------------------------------------------------+-- Smart constructors+----------------------------------------------------------------------------++-- | \( O(1) \). Creates empty 'Treap'.+empty :: Treap m a+empty = Empty+{-# INLINE empty #-}++-- | \( O(1) \). Creates singleton 'Treap'.+one :: Measured m a => Priority -> a -> Treap m a+one p a = Node (Size 1) p (measure a) a Empty Empty+{-# INLINE one #-}++----------------------------------------------------------------------------+-- Query functions+----------------------------------------------------------------------------++{- | \( O(1) \). Returns the number of the elements in the 'Treap'. Always+non-negative.++__Properties:__++* \( \forall (t\ ::\ \mathrm{Treap}\ m\ a)\ .\ \mathrm{size}\ t \geqslant 0 \)+-}+size :: Treap m a -> Size+size = \case+    Empty -> Size 0+    Node s _ _ _ _ _ -> s+{-# INLINE size #-}++-- | Take size of the 'Treap' as 'Int'.+sizeInt :: Treap m a -> Int+sizeInt = unSize . size+{-# INLINE sizeInt #-}++-- | \( O(1) \). Returns accumulated value in the root of the tree.+monoid :: Monoid m => Treap m a -> m+monoid = \case+    Empty -> mempty+    Node _ _ m _ _ _ -> m+{-# INLINE monoid #-}++-- | \( O(d) \). Lookup a value inside 'Treap' by a given index.+at :: forall m a . Int -> Treap m a -> Maybe a+at i t+    | i < 0          = Nothing+    | i >= sizeInt t = Nothing+    | otherwise      = go i t+  where+    go :: Int -> Treap m a -> Maybe a+    go _ Empty = Nothing+    go k (Node _ _ _ a l r) =+        let lSize = sizeInt l+        in case compare k lSize of+            EQ -> Just a+            LT -> go k l+            GT -> go (k - lSize - 1) r++-- | \( O(d) \). Return value of monoidal accumulator on a segment @[l, r)@.+query :: forall m a . Measured m a => Int -> Int -> Treap m a -> m+query from to t+    | to <= from = mempty+    | otherwise  =+        let (l, _) = splitAt to t+            (_, m) = splitAt from l+        in monoid m++----------------------------------------------------------------------------+-- Cuts and joins+----------------------------------------------------------------------------++-- | Create new 'Node' and recalculate its values.+new :: Measured m a => Priority -> a -> Treap m a -> Treap m a -> Treap m a+new p a l r = recalculate $ Node 0 p mempty a l r+{-# INLINE new #-}++{- | \( O(d) \). @splitAt i t@ splits 'Treap' by the given index into two treaps+@(t1, t2)@ such that the following properties hold:++1. \( \mathrm{size}\ t_1 = i \)+2. \( \mathrm{size}\ t_2 = n - i \)+3. \( \mathrm{merge}\ t_1\ t_2 \equiv t \)++__Special cases:__++1. If \( i \leqslant 0 \) then the result is @('empty', t)@.+2. If \( i \geqslant n \) then the result is @(t, 'empty')@.+-}+splitAt :: forall m a . Measured m a => Int -> Treap m a -> (Treap m a, Treap m a)+splitAt i t+    | i <= 0         = (empty, t)+    | i >= sizeInt t = (t, empty)+    | otherwise      = go i t+  where+    go :: Int -> Treap m a -> (Treap m a, Treap m a)+    go k = \case+        Empty -> (Empty, Empty)+        Node _ p _ a left right ->+            let lSize = sizeInt left+            in case compare k lSize of+                EQ -> (left, new p a Empty right)+                LT ->+                    let (!t1, !newLeft) = go k left+                    in (t1, new p a newLeft right)+                GT ->+                    let (!newRight, !t2) = go (k - lSize - 1) right+                    in (new p a left newRight, t2)++{- | \( O(\max\ d_1\ d_2) \). Merge two 'Treap's into single one.++>>> pone p a = one (Priority p) a :: Treap (Sum Int) Int+>>> prettyPrint $ merge (merge (pone 1 3) (pone 4 5)) (merge (pone 3 0) (pone 5 9))+   4,17:9+     ╱+   3,8:5+     ╱╲+    ╱  ╲+   ╱    ╲+1,3:3 1,0:0+-}+merge :: Measured m a => Treap m a -> Treap m a -> Treap m a+merge Empty r = r+merge l Empty = l+merge l@(Node _ p1 _ a1 l1 r1) r@(Node _ p2 _ a2 l2 r2)+    | p1 > p2   = recalculate $ new p1 a1 l1 (merge r1 r)+    | otherwise = recalculate $ new p2 a2 (merge l l2) r2++{- | \( O(d) \). @'take' n t@ returns 'Treap' that contains first @n@ elements of the given+'Treap' @t@.++__Special cases:__++1. If \( i \leqslant 0 \) then the result is 'empty'.+2. If \( i \geqslant n \) then the result is @t@.+-}+take :: forall m a . Measured m a => Int -> Treap m a -> Treap m a+take n t+    | n <= 0         = Empty+    | n >= sizeInt t = t+    | otherwise      = go n t+  where+    go :: Int -> Treap m a -> Treap m a+    go _ Empty = Empty+    go 0 _     = Empty+    go i (Node _ p _ a l r) =+        let lSize = sizeInt l+        in case compare i lSize of+            LT -> go i l+            EQ -> l+            GT -> new p a l $ go (i - lSize - 1) r++{- | \( O(d) \). @'drop' n t@ returns 'Treap' without first @n@ elements of the given+'Treap' @t@.++__Special cases:__++1. If \( i \leqslant 0 \) then the result is @t@.+2. If \( i \geqslant n \) then the result is 'empty'.+-}+drop :: forall m a . Measured m a => Int -> Treap m a -> Treap m a+drop n t+    | n <= 0         = t+    | n >= sizeInt t = Empty+    | otherwise      = go n t+  where+    go :: Int -> Treap m a -> Treap m a+    go _ Empty = Empty+    go 0 tree  = tree+    go i (Node _ p _ a l r) =+        let lSize = sizeInt l+        in case compare i lSize of+            LT -> new p a (go i l) r+            EQ -> new p a Empty r+            GT -> go (i - lSize - 1) r++{- | \( O(d) \). Rotate a 'Treap' to the right by a given number of elements+modulo treap size. In simple words, @'rotate' n t@ takes first @n@ elements of+@t@ and puts them at the end of @t@ in the same order. If the given index is+negative, then this function rotates left.+-}+rotate :: forall m a . Measured m a => Int -> Treap m a -> Treap m a+rotate n t = case t of+    Empty -> Empty+    _ | n == 0    -> t+      | otherwise -> let (left, right) = splitAt shift t in merge right left+  where+    shift :: Int+    shift = n `mod` sizeInt t++----------------------------------------------------------------------------+-- Modification functions+----------------------------------------------------------------------------++{- | \( O(d) \). Insert a value into 'Treap' with given key and priority.+Updates monoidal accumulator accordingly.+-}+insert :: forall m a . Measured m a => Int -> Priority -> a -> Treap m a -> Treap m a+insert i p a t+    | i < 0          = go 0 t+    | i >= sizeInt t = go (sizeInt t) t+    | otherwise      = go i t+  where+    go :: Int -> Treap m a -> Treap m a+    go _ Empty = one p a+    go k node@(Node _ tp _ ta l r)+      | p <= tp =+          let lSize = sizeInt l+          in if k <= lSize+              then recalculate $ new tp ta (go k l) r+              else recalculate $ new tp ta l (go (k - lSize - 1) r)+      | otherwise =+          let (!newL, !newR) = splitAt k node+          in recalculate $ new p a newL newR++{- | \( O(d) \). Delete element from 'Treap' by the given index. If index is out+of bounds, 'Treap' remains unchanged.+-}+delete :: forall m a . Measured m a => Int -> Treap m a -> Treap m a+delete i t+    | i < 0          = t+    | i >= sizeInt t = t+    | otherwise      = go i t+  where+    go :: Int -> Treap m a -> Treap m a+    go _ Empty = Empty+    go k (Node _ p _ a l r) =+        let lSize = sizeInt l+        in case compare k lSize of+            EQ -> merge l r+            LT -> recalculate $ new p a (go k l) r+            GT -> recalculate $ new p a l (go (k - lSize - 1) r)++----------------------------------------------------------------------------+-- Core internal functions+----------------------------------------------------------------------------++{- | \( O(1) \). Calculate size and the value of the monoidal accumulator+in the given root node. This function doesn't perform any recursive calls and it+assumes that the values in the children are already correct. So use this+function only in bottom-up manner.+-}+recalculate :: Measured m a => Treap m a -> Treap m a+recalculate Empty = Empty+recalculate (Node _ p _ a l r) =+    Node (1 + size l + size r) p (measure l <> measure a <> measure r) a l r

+ src/Treap/Rand.hs view

@@ -0,0 +1,236 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies      #-}++{- | Fair implementation of the 'Treap' data structure that uses random+generator for priorities.+-}++module Treap.Rand+       ( -- * Data structure+         RTreap (..)++         -- * Smart constructors+       , emptyWithGen+       , oneWithGen+       , empty+       , one++         -- * Query functions+       , size+       , at+       , query++       -- * Cuts and joins+       , splitAt+       , merge+       , take+       , drop+       , rotate++       -- * Modification functions+       , insert+       , delete++         -- * General purpose functions+       , withTreap+       , overTreap++         -- * Pretty printing functions+       , prettyPrint+       ) where++import Prelude hiding (drop, lookup, splitAt, take)++import Control.DeepSeq (NFData (..))+import Data.Coerce (Coercible)+import Data.Foldable (foldl')+import GHC.Exts (IsList (..))+import GHC.Generics (Generic)++import Treap.Measured (Measured (..))+import Treap.Pure (Priority (..), Size (..), Treap)++import qualified System.Random.Mersenne.Pure64 as Random+import qualified Treap.Pretty as Treap+import qualified Treap.Pure as Treap++-- $setup+-- >>> import Data.Monoid++----------------------------------------------------------------------------+-- Data structure and instances+----------------------------------------------------------------------------++{- | Specialized version of 'Treap' where priority is+generated by the stored random generator.+-}+data RTreap m a = RTreap+    { rTreapGen  :: !Random.PureMT+    , rTreapTree :: !(Treap m a)+    } deriving (Show, Generic, Foldable)++-- | \( O(n) \). This instance doesn't compare random generators inside trees.+instance (Eq m, Eq a) => Eq (RTreap m a) where+    (==) :: RTreap m a -> RTreap m a -> Bool+    RTreap _ t1 == RTreap _ t2 = t1 == t2++-- | \( O(1) \). Takes cached value from the root.+instance Monoid m => Measured m (RTreap m a) where+    measure :: RTreap m a -> m+    measure = withTreap measure+    {-# INLINE measure #-}++{- | Pure implementation of 'RTreap' construction functions. Uses+@'empty' :: RTreap k a@ as a starting point. Functions have the following+time complexity:++1. 'fromList': \( O(n\ \log \ n) \)+2. 'toList': \( O(n) \)++>>> prettyPrint $ fromList @(RTreap (Sum Int) Int) [1..5]+   5,15:2+      ╱╲+     ╱  ╲+    ╱    ╲+   ╱      ╲+1,1:1   3,12:4+          ╱╲+         ╱  ╲+        ╱    ╲+      1,3:3 1,5:5+-}+instance Measured m a => IsList (RTreap m a) where+    type Item (RTreap m a) = a++    fromList :: [a] -> RTreap m a+    fromList = foldl' (\t (i, a) -> insert i a t) empty . zip [0..]+    {-# INLINE fromList #-}++    toList :: RTreap m a -> [a]+    toList = map snd . toList . rTreapTree+    {-# INLINE toList #-}++instance (NFData m, NFData a) => NFData (RTreap m a) where+    rnf RTreap{..} = rnf rTreapTree `seq` ()++----------------------------------------------------------------------------+-- Smart constructors+----------------------------------------------------------------------------++defaultRandomGenerator :: Random.PureMT+defaultRandomGenerator = Random.pureMT 0++-- | \( O(1) \). Create empty 'RTreap' with given random generator.+emptyWithGen :: Random.PureMT -> RTreap m a+emptyWithGen gen = RTreap gen Treap.Empty+{-# INLINE emptyWithGen #-}++-- | \( O(1) \). Create empty 'RTreap' using random generator with seed @0@.+empty :: RTreap m a+empty = emptyWithGen defaultRandomGenerator+{-# INLINE empty #-}++-- | \( O(1) \). Create singleton 'RTreap' with given random generator.+oneWithGen :: Measured m a => Random.PureMT -> a -> RTreap m a+oneWithGen gen a =+    let (priority, newGen) = Random.randomWord64 gen+    in RTreap newGen $ Treap.one (Priority priority) a+{-# INLINE oneWithGen #-}++-- | \( O(1) \). Create singleton 'RTreap' using random generator with seed @0@.+one :: Measured m a => a -> RTreap m a+one = oneWithGen defaultRandomGenerator+{-# INLINE one #-}++----------------------------------------------------------------------------+-- Query functions+----------------------------------------------------------------------------++{- | \( O(1) \). Returns the size of the 'RTreap'.++__Properties:__++* \( \forall (t\ ::\ \mathrm{Treap}\ m\ a)\ .\ \mathrm{size}\ t \geqslant 0 \)+-}+size :: RTreap m a -> Int+size = unSize . withTreap Treap.size+{-# INLINE size #-}++-- | \( O(\log \ n) \). Lookup a value by a given key inside 'RTreap'.+at :: Int -> RTreap m a -> Maybe a+at i = withTreap $ Treap.at i+{-# INLINE at #-}++-- | \( O(\log \ n) \). Return value of monoidal accumulator on a segment @[l, r)@.+query :: forall m a . Measured m a => Int -> Int -> RTreap m a -> m+query l r = withTreap (Treap.query l r)+{-# INLINE query #-}++----------------------------------------------------------------------------+-- Cuts and joins+----------------------------------------------------------------------------++-- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.splitAt'.+splitAt :: forall m a . Measured m a => Int -> RTreap m a -> (RTreap m a, RTreap m a)+splitAt i (RTreap gen t) = let (l, r) = Treap.splitAt i t in (RTreap gen l, RTreap gen r)+{-# INLINE splitAt #-}++-- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.merge'.+merge :: Measured m a => RTreap m a -> RTreap m a -> RTreap m a+merge (RTreap gen t1) (RTreap _ t2) = RTreap gen (Treap.merge t1 t2)+{-# INLINE merge #-}++-- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.take'.+take :: forall m a . Measured m a => Int -> RTreap m a -> RTreap m a+take n = overTreap (Treap.take n)+{-# INLINE take #-}++-- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.drop'.+drop :: forall m a . Measured m a => Int -> RTreap m a -> RTreap m a+drop n = overTreap (Treap.drop n)+{-# INLINE drop #-}++-- | \( O(\log \ n) \). Lifted to 'RTreap' version of 'Treap.rotate'.+rotate :: forall m a . Measured m a => Int -> RTreap m a -> RTreap m a+rotate n = overTreap (Treap.rotate n)+{-# INLINE rotate #-}++----------------------------------------------------------------------------+-- Modification functions+----------------------------------------------------------------------------++-- | \( O(\log \ n) \). Insert a value into 'RTreap' by given key.+insert :: forall m a . Measured m a => Int -> a -> RTreap m a -> RTreap m a+insert i a (RTreap gen t) =+    let (priority, newGen) = Random.randomWord64 gen+    in RTreap newGen $ Treap.insert i (Priority priority) a t+{-# INLINE insert #-}++{- | \( O(\log \ n) \). Delete 'RTreap' node that contains given key. If there is no+such key, 'RTreap' remains unchanged.+-}+delete :: forall m a . Measured m a => Int -> RTreap m a -> RTreap m a+delete i (RTreap gen t) = RTreap gen $ Treap.delete i t+{-# INLINE delete #-}++----------------------------------------------------------------------------+-- Generic functions+----------------------------------------------------------------------------++-- | Lift a function that works with 'Treap' to 'RTreap'.+withTreap :: (Treap m a -> r) -> (RTreap m a -> r)+withTreap f = f . rTreapTree+{-# INLINE withTreap #-}++-- | Lift a function that works with 'Treap' to 'RTreap'.+overTreap :: (Treap m a -> Treap m a) -> (RTreap m a -> RTreap m a)+overTreap set t = t { rTreapTree = set $ rTreapTree t }+{-# INLINE overTreap #-}++----------------------------------------------------------------------------+-- Pretty printing functions+----------------------------------------------------------------------------++-- | Pretty prints 'RTreap' without printing random generator.+prettyPrint :: forall m a . (Coercible m a, Show a) => RTreap m a -> IO ()+prettyPrint = withTreap Treap.prettyPrint

+ test/Doctest.hs view

@@ -0,0 +1,23 @@+module Main (main) where++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)+++main :: IO ()+main = do+    sourceFiles <- glob "src/**/*.hs"+    doctest+        $ "-XInstanceSigs"+        : "-XScopedTypeVariables"+        : "-XRecordWildCards"+        : "-XMultiParamTypeClasses"+        : "-XLambdaCase"+        : "-XBangPatterns"+        : "-XGeneralizedNewtypeDeriving"+        : "-XDerivingStrategies"+        : "-XDeriveAnyClass"+        : "-XDeriveGeneric"+        : "-XDeriveFoldable"+        : "-XTypeApplications"+        : sourceFiles

+ test/Spec.hs view

@@ -0,0 +1,17 @@+module Main (main) where++import System.IO (hSetEncoding, stderr, stdout, utf8)+import Test.Hspec (Spec, hspec)++import Test.Rand (randSpec)+++allUnitTests :: Spec+allUnitTests = randSpec++main :: IO ()+main = do+    hSetEncoding stdout utf8+    hSetEncoding stderr utf8++    hspec allUnitTests

+ test/Test/Common.hs view

@@ -0,0 +1,21 @@+module Test.Common+       ( TestTreap+       , smallTreap+       , extractSum+       ) where++import Data.Monoid (Sum (..))+import GHC.Exts (IsList (..))++import Treap (RTreap, measure)+++-- | Specialized version of 'RTreap' for testing.+type TestTreap = RTreap (Sum Int) Int++-- | Small treap of total size 5.+smallTreap :: TestTreap+smallTreap = fromList [1..5]++extractSum :: TestTreap -> Int+extractSum = getSum . measure

+ test/Test/Rand.hs view

@@ -0,0 +1,16 @@+module Test.Rand+       ( randSpec+       ) where++import Test.Hspec (Spec, describe)++import Test.Rand.Cuts (cutsSpec)+import Test.Rand.Query (querySpec)+import Test.Rand.Update (updateSpec)+++randSpec :: Spec+randSpec = describe "RTreap" $ do+    querySpec+    cutsSpec+    updateSpec

+ test/Test/Rand/Cuts.hs view

@@ -0,0 +1,70 @@+module Test.Rand.Cuts+       ( cutsSpec+       ) where++import Data.Bifunctor (bimap)+import GHC.Exts (IsList (..))+import Test.Hspec (Spec, describe, it, shouldBe)++import Test.Common (TestTreap, smallTreap)++import qualified Treap+++cutsSpec :: Spec+cutsSpec = describe "Cuts and joins tests" $ do+    splitAtSpec+    mergeSpec+    takeSpec+    dropSpec+    rotateSpec++splitAtSpec :: Spec+splitAtSpec = describe "splitAt" $ do+    it "splitAt negative returns treap itself" $+        snd (Treap.splitAt (-1) smallTreap) `shouldBe` smallTreap+    it "splitAt 0 returns treap itself" $+        snd (Treap.splitAt 0 smallTreap) `shouldBe` smallTreap+    it "splitAt n returns treap itself" $+        fst (Treap.splitAt 5 smallTreap) `shouldBe` smallTreap+    it "splitAt 2 returns two treaps" $+        bimap toList toList (Treap.splitAt 2 smallTreap) `shouldBe` ([1..2], [3..5])++mergeSpec :: Spec+mergeSpec = describe "merge" $ do+    it "merge with empty should be treap itself" $ do+        Treap.merge Treap.empty smallTreap `shouldBe` smallTreap+        Treap.merge smallTreap Treap.empty `shouldBe` smallTreap+    it "merge two treaps works" $+        toList (Treap.merge (fromList [1..2]) (fromList [3..5]) :: TestTreap) `shouldBe` [1..5]++takeSpec :: Spec+takeSpec = describe "take" $ do+    it "take negative returns empty treap" $+       Treap.take (-1) smallTreap `shouldBe` Treap.empty+    it "take 0 returns empty treap" $+        Treap.take 0 smallTreap `shouldBe` Treap.empty+    it "take size returns treap itself" $+        Treap.take 5 smallTreap `shouldBe` smallTreap+    it "take 2 returns first two elements" $+        Treap.take 2 smallTreap `shouldBe` fromList [1..2]++dropSpec :: Spec+dropSpec = describe "drop" $ do+    it "drop negative returns treap itself" $+       Treap.drop (-1) smallTreap `shouldBe` smallTreap+    it "drop 0 returns treap itself" $+        Treap.drop 0 smallTreap `shouldBe` smallTreap+    it "drop size returns empty treap" $+        Treap.drop 5 smallTreap `shouldBe` Treap.empty+    it "drop 2 returns first two elements" $+        toList (Treap.drop 2 smallTreap) `shouldBe` [3..5]++rotateSpec :: Spec+rotateSpec = describe "rotate" $ do+    it "rotate 0 does nothing" $+        Treap.rotate 0 smallTreap `shouldBe` smallTreap+    it "rotate 1 moves first element to the end" $+        toList (Treap.rotate 1 smallTreap) `shouldBe` [2, 3, 4, 5, 1]+    it "rotate -1 moves last element to the beginning" $+        toList (Treap.rotate (-1) smallTreap) `shouldBe` [5, 1, 2, 3, 4]

+ test/Test/Rand/Query.hs view

@@ -0,0 +1,51 @@+module Test.Rand.Query+       ( querySpec+       ) where++import Data.Monoid (Sum (..))+import GHC.Exts (IsList (..))+import Test.Hspec (Spec, describe, it, shouldBe)++import Test.Common (TestTreap, extractSum, smallTreap)++import qualified Treap+++querySpec :: Spec+querySpec = describe "Query tests" $ do+    basicSpec+    advancedSpec++basicSpec :: Spec+basicSpec = describe "Sanity checks" $ do+    it "size of empty treap is 0" $+        Treap.size Treap.empty `shouldBe` 0+    it "size of singletone treap is 1" $+        Treap.size (Treap.one 1 :: TestTreap) `shouldBe` 1+    it "size of smallTreap is 5" $+        Treap.size smallTreap `shouldBe` 5+    it "measure of empty treap is mempty" $+        extractSum Treap.empty `shouldBe` 0+    it "measure of singleton treap is mempty" $+        extractSum (Treap.one 42) `shouldBe` 42+    it "toList smallTreap is [1..5]" $+        toList smallTreap `shouldBe` [1..5]+    it "total sum of smallTreap is [1..5]" $+        extractSum smallTreap `shouldBe` sum [1..5]++advancedSpec :: Spec+advancedSpec = describe "Different checks on query functions" $ do+    it "elements by indices are correct" $+        map (`Treap.at` smallTreap) [-1..5] `shouldBe`+            [Nothing, Just 1, Just 2, Just 3, Just 4, Just 5, Nothing]+    it "query on empty segment returns 'mempty'" $+        Treap.query 0 (-1) smallTreap `shouldBe` mempty+    it "query on the non-intersected segment returns 'mempty'" $ do+        Treap.query (-2) (-1) smallTreap `shouldBe` mempty+        Treap.query 5 6 smallTreap `shouldBe` mempty+    it "query on subsegments works" $ do+        Treap.query 0 0 smallTreap `shouldBe` 0+        Treap.query 0 1 smallTreap `shouldBe` 1+        Treap.query 0 2 smallTreap `shouldBe` 3+        Treap.query 1 3 smallTreap `shouldBe` 5+        Treap.query (-1) 10 smallTreap `shouldBe` Sum (sum [1..5])

+ test/Test/Rand/Update.hs view

@@ -0,0 +1,38 @@+module Test.Rand.Update+       ( updateSpec+       ) where++import GHC.Exts (IsList (..))+import Test.Hspec (Spec, describe, it, shouldBe)++import Test.Common (smallTreap)++import qualified Treap+++updateSpec :: Spec+updateSpec = describe "Modification operations tests" $ do+    insertSpec+    deleteSpec++insertSpec :: Spec+insertSpec = describe "insert" $ do+    it "insert negative inserts at the beginning" $+        toList (Treap.insert (-1) 42 smallTreap) `shouldBe` 42 : [1..5]+    it "insert 0 inserts at the beginning" $+        toList (Treap.insert 0 42 smallTreap) `shouldBe` 42 : [1..5]+    it "insert size inserts at the end" $+        toList (Treap.insert 5 42 smallTreap) `shouldBe` [1, 2, 3, 4, 5, 42]+    it "insert in the middle works" $+        toList (Treap.insert 2 42 smallTreap) `shouldBe` [1, 2, 42, 3, 4, 5]++deleteSpec :: Spec+deleteSpec = describe "delete" $ do+    it "delete negative does nothing" $+        Treap.delete (-1) smallTreap `shouldBe` smallTreap+    it "delete size does nothing" $+        Treap.delete 5 smallTreap `shouldBe` smallTreap+    it "delete 0 removes first element" $+        toList (Treap.delete 0 smallTreap) `shouldBe` [2..5]+    it "deletes from the middle works" $+        toList (Treap.delete 2 smallTreap) `shouldBe` [1, 2, 4, 5]

+ treap.cabal view

@@ -0,0 +1,98 @@+cabal-version:       2.4+name:                treap+version:             0.0.0.0+synopsis:            Efficient implementation of the implicit treap data structure+description:+    Efficient implementation of the implicit treap data structure.+    Use this data structure if you want dynamic arrays with fast operations on segments.+homepage:            https://github.com/chshersh/treap+bug-reports:         https://github.com/chshersh/treap/issues+license:             MPL-2.0+license-file:        LICENSE+author:              Dmitrii Kovanikov+maintainer:          kovanikov@gmail.com+copyright:           2019 Dmitrii Kovanikov+category:            Data Structure, Tree+build-type:          Simple+extra-doc-files:     README.md+                   , CHANGELOG.md+tested-with:         GHC == 8.4.4+                   , GHC == 8.6.4++source-repository head+  type:                git+  location:            https://github.com/chshersh/treap.git++common common-options+  build-depends:       base >= 4.11 && < 4.13++  ghc-options:         -Wall+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+                       -Wcompat+                       -Widentities+                       -Wredundant-constraints+                       -Wpartial-fields+                       -fhide-source-paths+                       -freverse-errors++  default-language:    Haskell2010+  default-extensions:  BangPatterns+                       ConstraintKinds+                       DataKinds+                       DeriveFunctor+                       DeriveFoldable+                       DeriveTraversable+                       DeriveGeneric+                       DerivingStrategies+                       GeneralizedNewtypeDeriving+                       InstanceSigs+                       KindSignatures+                       LambdaCase+                       MultiParamTypeClasses+                       OverloadedStrings+                       RecordWildCards+                       ScopedTypeVariables+                       TypeApplications+++library+  import:              common-options+  build-depends:       deepseq ^>= 1.4+                     , mersenne-random-pure64 ^>= 0.2.2++  hs-source-dirs:      src+  exposed-modules:     Treap+                         Treap.Measured+                         Treap.Pretty+                         Treap.Pure+                         Treap.Rand+++test-suite treap-test+  import:              common-options+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Test.Common+                       Test.Rand+                         Test.Rand.Cuts+                         Test.Rand.Query+                         Test.Rand.Update++  build-depends:       treap+                     , hspec+                     , hspec-core+++test-suite treap-doctest+  import:              common-options+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Doctest.hs++  build-depends:       doctest+                     , Glob++  ghc-options:         -threaded+  default-language:    Haskell2010