From 11987749fc6e6d3e53ea737d46d5ab13a16faeb8 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Sat, 28 Sep 2019 13:43:29 -0400 Subject: Factor out some new libraries word64-map: Data.Word64Map network-addr: Network.Address tox-crypto: Crypto.Tox lifted-concurrent: Control.Concurrent.Lifted.Instrument Control.Concurrent.Async.Lifted.Instrument psq-wrap: Data.Wrapper.PSQInt Data.Wrapper.PSQ minmax-psq: Data.MinMaxPSQ tasks: Control.Concurrent.Tasks kad: Network.Kademlia Network.Kademlia.Bootstrap Network.Kademlia.Routing Network.Kademlia.CommonAPI Network.Kademlia.Persistence Network.Kademlia.Search --- minmax-psq/CHANGELOG.md | 5 ++ minmax-psq/LICENSE | 30 +++++++++++ minmax-psq/Setup.hs | 2 + minmax-psq/minmax-psq.cabal | 24 +++++++++ minmax-psq/src/Data/MinMaxPSQ.hs | 112 +++++++++++++++++++++++++++++++++++++++ 5 files changed, 173 insertions(+) create mode 100644 minmax-psq/CHANGELOG.md create mode 100644 minmax-psq/LICENSE create mode 100644 minmax-psq/Setup.hs create mode 100644 minmax-psq/minmax-psq.cabal create mode 100644 minmax-psq/src/Data/MinMaxPSQ.hs (limited to 'minmax-psq') diff --git a/minmax-psq/CHANGELOG.md b/minmax-psq/CHANGELOG.md new file mode 100644 index 00000000..ba7d08da --- /dev/null +++ b/minmax-psq/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for minmax-psq + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/minmax-psq/LICENSE b/minmax-psq/LICENSE new file mode 100644 index 00000000..e8eaef49 --- /dev/null +++ b/minmax-psq/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, James Crayne + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of James Crayne nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/minmax-psq/Setup.hs b/minmax-psq/Setup.hs new file mode 100644 index 00000000..9a994af6 --- /dev/null +++ b/minmax-psq/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/minmax-psq/minmax-psq.cabal b/minmax-psq/minmax-psq.cabal new file mode 100644 index 00000000..ba04bd45 --- /dev/null +++ b/minmax-psq/minmax-psq.cabal @@ -0,0 +1,24 @@ +-- Initial minmax-psq.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: minmax-psq +version: 0.1.0.0 +-- synopsis: +-- description: +license: BSD3 +license-file: LICENSE +author: James Crayne +maintainer: jim.crayne@gmail.com +-- copyright: +-- category: +build-type: Simple +extra-source-files: CHANGELOG.md +cabal-version: >=1.10 + +library + exposed-modules: Data.MinMaxPSQ + -- other-modules: + other-extensions: BangPatterns, PatternSynonyms + build-depends: base, psq-wrap + hs-source-dirs: src + default-language: Haskell2010 diff --git a/minmax-psq/src/Data/MinMaxPSQ.hs b/minmax-psq/src/Data/MinMaxPSQ.hs new file mode 100644 index 00000000..e7d7c760 --- /dev/null +++ b/minmax-psq/src/Data/MinMaxPSQ.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE BangPatterns, PatternSynonyms #-} +module Data.MinMaxPSQ + ( module Data.MinMaxPSQ + , Binding' + , pattern Binding + ) where + +import Data.Ord +import qualified Data.Wrapper.PSQ as PSQ + ;import Data.Wrapper.PSQ as PSQ hiding (insert, insert', null, size) +import Prelude hiding (null, take) + +data MinMaxPSQ' k p v = MinMaxPSQ !Int !(PSQ' k p v) !(PSQ' k (Down p) v) +type MinMaxPSQ k p = MinMaxPSQ' k p () + +empty :: MinMaxPSQ' k p v +empty = MinMaxPSQ 0 PSQ.empty PSQ.empty + +singleton' :: (PSQKey k, Ord p) => k -> v -> p -> MinMaxPSQ' k p v +singleton' k v p = MinMaxPSQ 1 (PSQ.singleton' k v p) (PSQ.singleton' k v (Down p)) + +null :: MinMaxPSQ' k p v -> Bool +null (MinMaxPSQ sz _ _) = sz==0 +{-# INLINE null #-} + +size :: MinMaxPSQ' k p v -> Int +size (MinMaxPSQ sz _ _) = sz +{-# INLINE size #-} + +toList :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> [Binding' k p v] +toList (MinMaxPSQ _ nq xq) = PSQ.toList nq + +fromList :: (PSQKey k, Ord p) => [Binding' k p v] -> MinMaxPSQ' k p v +fromList kps = let nq = PSQ.fromList kps + xq = PSQ.fromList $ map (\(Binding k v p) -> Binding k v (Down p)) kps + in MinMaxPSQ (PSQ.size nq) nq xq + +findMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v) +findMin (MinMaxPSQ _ nq xq) = PSQ.findMin nq + +findMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v) +findMax (MinMaxPSQ _ nq xq) = fmap (\(Binding k v (Down p)) -> Binding k v p) $ PSQ.findMin xq + +insert :: (PSQKey k, Ord p) => k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p +insert k p (MinMaxPSQ sz nq xq) = case PSQ.insertView k p () nq of + (Just _ ,nq') -> MinMaxPSQ sz nq' (PSQ.insert k (Down p) xq) + (Nothing,nq') -> MinMaxPSQ (sz+1) nq' (PSQ.insert k (Down p) xq) + +insert' :: (PSQKey k, Ord p) => k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v +insert' k v p (MinMaxPSQ sz nq xq) = case PSQ.insertView k p v nq of + (Just _ ,nq') -> MinMaxPSQ sz nq' (PSQ.insert' k v (Down p) xq) + (Nothing,nq') -> MinMaxPSQ (sz+1) nq' (PSQ.insert' k v (Down p) xq) + +delete :: (PSQKey k, Ord p) => k -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v +delete k q@(MinMaxPSQ sz nq xq) = case PSQ.deleteView k nq of + Just (_,_,nq') -> MinMaxPSQ (sz - 1) nq' (PSQ.delete k xq) + Nothing -> q + +deleteMin :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v +deleteMin q@(MinMaxPSQ sz nq xq) = case PSQ.minView nq of + Just (Binding k _ _, nq') -> MinMaxPSQ (sz - 1) nq' (PSQ.delete k xq) + Nothing -> q + +deleteMax :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> MinMaxPSQ' k p v +deleteMax q@(MinMaxPSQ sz nq xq) = case PSQ.minView xq of + Just (Binding k _ _, xq') -> MinMaxPSQ (sz - 1) (PSQ.delete k nq) xq' + Nothing -> q + +minView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v) +minView (MinMaxPSQ sz nq xq) = fmap (\(Binding k v p, nq') -> (Binding k v p, MinMaxPSQ (sz-1) nq' (PSQ.delete k xq))) + $ PSQ.minView nq + +maxView :: (PSQKey k, Ord p) => MinMaxPSQ' k p v -> Maybe (Binding' k p v, MinMaxPSQ' k p v) +maxView (MinMaxPSQ sz nq xq) = fmap (\(Binding k v (Down p), xq') -> (Binding k v p, MinMaxPSQ (sz-1) (PSQ.delete k nq) xq')) + $ PSQ.minView xq + +-- | Maintains a bounded 'MinMaxPSQ' by deleting the maximum element if the +-- insertion would cause the queue to have too many elements. +insertTake :: (PSQKey k, Ord p) => Int -> k -> p -> MinMaxPSQ k p -> MinMaxPSQ k p +insertTake n k p q + | size q < n = insert k p q + | size q == n = insert k p $ deleteMax q + | otherwise = take n $ insert k p q + +-- | Maintains a bounded 'MinMaxPSQ\'' by deleting the maximum element if the +-- insertion would cause the queue to have too many elements. +insertTake' :: (PSQKey k, Ord p) => Int -> k -> v -> p -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v +insertTake' n k v p q + | size q < n = insert' k v p q + | size q == n = insert' k v p $ deleteMax q + | otherwise = take n $ insert' k v p q + + +-- | Truncate the 'MinMaxPSQ' to the given number of lowest priority elements. +take :: (PSQKey k, Ord p) => Int -> MinMaxPSQ' k p v -> MinMaxPSQ' k p v +take !n !q | (size q <= n) = q + | null q = q + | otherwise = take n $ deleteMax q + +-- | Like 'take', except it provides a list deleted bindings. +takeView :: (PSQKey k, Ord p) => Int -> MinMaxPSQ' k p v -> ( [Binding' k p v], MinMaxPSQ' k p v ) +takeView !n !q | (size q <= n) = ([], q) + | null q = ([], q) + | otherwise = let Just (x,q') = maxView q + (xs,q'') = takeView n q' + ys = x:xs + in (ys, ys `seq` q'') + + + +lookup' :: (PSQKey k, Ord p) => k -> MinMaxPSQ' k p v -> Maybe (p, v) +lookup' k (MinMaxPSQ _ q _) = PSQ.lookup k q -- cgit v1.2.3