Skip to content

Commit

Permalink
Fix broken Haddock links (#136)
Browse files Browse the repository at this point in the history
  • Loading branch information
pgujjula authored May 19, 2024
1 parent bc185ff commit 110d979
Show file tree
Hide file tree
Showing 8 changed files with 30 additions and 29 deletions.
10 changes: 5 additions & 5 deletions src/BinomialQueue/Max.hs
Original file line number Diff line number Diff line change
Expand Up @@ -132,7 +132,7 @@ maxView (MaxQueue q) = case MinQ.minView q of
Just (Down a, q') -> Just (a, MaxQueue q')
Nothing -> Nothing

-- | \(O(k \log n)\)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th largest
-- | \(O(k \log n)\). Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th largest
-- element in the queue. Equivalent to @toDescList queue !! k@.
(!!) :: Ord a => MaxQueue a -> Int -> a
q !! n | n >= size q
Expand Down Expand Up @@ -164,17 +164,17 @@ break :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a)
break p = span (not . p)

{-# INLINE take #-}
-- | \(O(k \log n)\)/. 'take' @k@, applied to a queue @queue@, returns a list of the greatest @k@ elements of @queue@,
-- | \(O(k \log n)\). 'take' @k@, applied to a queue @queue@, returns a list of the greatest @k@ elements of @queue@,
-- or all elements of @queue@ itself if @k >= 'size' queue@.
take :: Ord a => Int -> MaxQueue a -> [a]
take n = List.take n . toDescList

-- | \(O(k \log n)\)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the greatest @k@ elements deleted,
-- or an empty queue if @k >= size 'queue'@.
-- | \(O(k \log n)\). 'drop' @k@, applied to a queue @queue@, returns @queue@ with the greatest @k@ elements deleted,
-- or an empty queue if @k >= 'size' queue@.
drop :: Ord a => Int -> MaxQueue a -> MaxQueue a
drop n (MaxQueue queue) = MaxQueue (MinQ.drop n queue)

-- | \(O(k \log n)\)/. Equivalent to @('take' k queue, 'drop' k queue)@.
-- | \(O(k \log n)\). Equivalent to @('take' k queue, 'drop' k queue)@.
splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a)
splitAt n (MaxQueue queue)
| (l, r) <- MinQ.splitAt n queue
Expand Down
10 changes: 5 additions & 5 deletions src/BinomialQueue/Min.hs
Original file line number Diff line number Diff line change
Expand Up @@ -120,7 +120,7 @@ deleteMin q = case minView q of
deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a)
deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView

-- | \(O(k \log n)\)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest
-- | \(O(k \log n)\). Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest
-- element in the queue. Equivalent to @toAscList queue !! k@.
(!!) :: Ord a => MinQueue a -> Int -> a
q !! n | n >= size q
Expand Down Expand Up @@ -156,20 +156,20 @@ break :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
break p = span (not . p)

{-# INLINE take #-}
-- | \(O(k \log n)\)/. 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@,
-- | \(O(k \log n)\). 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@,
-- or all elements of @queue@ itself if @k >= 'size' queue@.
take :: Ord a => Int -> MinQueue a -> [a]
take n = List.take n . toAscList

-- | \(O(k \log n)\)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,
-- or an empty queue if @k >= size 'queue'@.
-- | \(O(k \log n)\). 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,
-- or an empty queue if @k >= 'size' queue@.
drop :: Ord a => Int -> MinQueue a -> MinQueue a
drop n queue = n `seq` case minView queue of
Just (_, queue')
| n > 0 -> drop (n - 1) queue'
_ -> queue

-- | \(O(k \log n)\)/. Equivalent to @('take' k queue, 'drop' k queue)@.
-- | \(O(k \log n)\). Equivalent to @('take' k queue, 'drop' k queue)@.
splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a)
splitAt n queue = n `seq` case minView queue of
Just (x, queue')
Expand Down
2 changes: 1 addition & 1 deletion src/Data/PQueue/Internals.hs
Original file line number Diff line number Diff line change
Expand Up @@ -282,7 +282,7 @@ insertMinQ' x (MinQueue n x' f) = MinQueue (n + 1) x (BQ.insertMinQ' x' f)

-- | @insertMaxQ' x h@ assumes that @x@ compares as greater
-- than or equal to every element of @h@. It also assumes,
-- and preserves, an extra invariant. See 'insertMax'' for details.
-- and preserves, an extra invariant. See 'BQ.insertMax'' for details.
-- tldr: this function can be used safely to build a queue from an
-- ascending list/array/whatever, but that's about it.
insertMaxQ' :: a -> MinQueue a -> MinQueue a
Expand Down
8 changes: 4 additions & 4 deletions src/Data/PQueue/Max.hs
Original file line number Diff line number Diff line change
Expand Up @@ -210,21 +210,21 @@ MaxQ q1 `union` MaxQ q2 = MaxQ (q1 `Min.union` q2)
unions :: Ord a => [MaxQueue a] -> MaxQueue a
unions qs = MaxQ (Min.unions [q | MaxQ q <- qs])

-- | \(O(k \log n)\)/. Returns the @(k+1)@th largest element of the queue.
-- | \(O(k \log n)\). Returns the @(k+1)@th largest element of the queue.
(!!) :: Ord a => MaxQueue a -> Int -> a
MaxQ q !! n = unDown ((Min.!!) q n)

{-# INLINE take #-}
-- | \(O(k \log n)\)/. Returns the list of the @k@ largest elements of the queue, in descending order, or
-- | \(O(k \log n)\). Returns the list of the @k@ largest elements of the queue, in descending order, or
-- all elements of the queue, if @k >= n@.
take :: Ord a => Int -> MaxQueue a -> [a]
take k (MaxQ q) = [a | Down a <- Min.take k q]

-- | \(O(k \log n)\)/. Returns the queue with the @k@ largest elements deleted, or the empty queue if @k >= n@.
-- | \(O(k \log n)\). Returns the queue with the @k@ largest elements deleted, or the empty queue if @k >= n@.
drop :: Ord a => Int -> MaxQueue a -> MaxQueue a
drop k (MaxQ q) = MaxQ (Min.drop k q)

-- | \(O(k \log n)\)/. Equivalent to @(take k queue, drop k queue)@.
-- | \(O(k \log n)\). Equivalent to @(take k queue, drop k queue)@.
splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a)
splitAt k (MaxQ q) = (coerce xs, MaxQ q') where
(xs, q') = Min.splitAt k q
Expand Down
10 changes: 5 additions & 5 deletions src/Data/PQueue/Min.hs
Original file line number Diff line number Diff line change
Expand Up @@ -163,7 +163,7 @@ deleteMin q = case minView q of
deleteFindMin :: Ord a => MinQueue a -> (a, MinQueue a)
deleteFindMin = fromMaybe (error "Error: deleteFindMin called on empty queue") . minView

-- | \(O(k \log n)\)/. Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest
-- | \(O(k \log n)\). Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest
-- element in the queue. Equivalent to @toAscList queue !! k@.
(!!) :: Ord a => MinQueue a -> Int -> a
q !! n | n >= size q
Expand Down Expand Up @@ -199,20 +199,20 @@ break :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a)
break p = span (not . p)

{-# INLINE take #-}
-- | \(O(k \log n)\)/. 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@,
-- | \(O(k \log n)\). 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@,
-- or all elements of @queue@ itself if @k >= 'size' queue@.
take :: Ord a => Int -> MinQueue a -> [a]
take n = List.take n . toAscList

-- | \(O(k \log n)\)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,
-- or an empty queue if @k >= size 'queue'@.
-- | \(O(k \log n)\). 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted,
-- or an empty queue if @k >= 'size' queue@.
drop :: Ord a => Int -> MinQueue a -> MinQueue a
drop n queue = n `seq` case minView queue of
Just (_, queue')
| n > 0 -> drop (n - 1) queue'
_ -> queue

-- | \(O(k \log n)\)/. Equivalent to @('take' k queue, 'drop' k queue)@.
-- | \(O(k \log n)\). Equivalent to @('take' k queue, 'drop' k queue)@.
splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a)
splitAt n queue = n `seq` case minView queue of
Just (x, queue')
Expand Down
7 changes: 4 additions & 3 deletions src/Data/PQueue/Prio/Internals.hs
Original file line number Diff line number Diff line change
Expand Up @@ -312,9 +312,10 @@ minViewWithKey (MinPQ n k a ts) = Just ((k, a), extractHeap n ts)
mapWithKey :: (k -> a -> b) -> MinPQueue k a -> MinPQueue k b
mapWithKey f = runIdentity . traverseWithKeyU (coerce f)

-- | \(O(n)\). @'mapKeysMonotonic' f q == 'mapKeys' f q@, but only works when
-- @f@ is (weakly) monotonic (meaning that @x <= y@ implies @f x <= f y@).
-- /The precondition is not checked./ This function has better performance than 'mapKeys'.
-- | \(O(n)\). @'mapKeysMonotonic' f q == 'Data.PQueue.Prio.Min.mapKeys' f q@,
-- but only works when @f@ is (weakly) monotonic (meaning that @x <= y@ implies
-- @f x <= f y@). /The precondition is not checked./ This function has better
-- performance than 'Data.PQueue.Prio.Min.mapKeys'.
--
-- Note: if the given function returns bottom for any of the keys in the queue, then the
-- portion of the queue which is bottom is /unspecified/.
Expand Down
6 changes: 3 additions & 3 deletions src/Data/PQueue/Prio/Max/Internals.hs
Original file line number Diff line number Diff line change
Expand Up @@ -388,16 +388,16 @@ mapMWithKey f = go empty
insertMin' :: k -> a -> MaxPQueue k a -> MaxPQueue k a
insertMin' k a (MaxPQ q) = MaxPQ (PrioInternals.insertMax' (Down k) a q)

-- | \(O(k \log n)\)/. Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@.
-- | \(O(k \log n)\). Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@.
-- (@'take' k q == 'List.take' k ('toDescList' q)@)
take :: Ord k => Int -> MaxPQueue k a -> [(k, a)]
take k (MaxPQ q) = fmap (first' unDown) (Q.take k q)

-- | \(O(k \log n)\)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@.
-- | \(O(k \log n)\). Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@.
drop :: Ord k => Int -> MaxPQueue k a -> MaxPQueue k a
drop k (MaxPQ q) = MaxPQ (Q.drop k q)

-- | \(O(k \log n)\)/. Equivalent to @('take' k q, 'drop' k q)@.
-- | \(O(k \log n)\). Equivalent to @('take' k q, 'drop' k q)@.
splitAt :: Ord k => Int -> MaxPQueue k a -> ([(k, a)], MaxPQueue k a)
splitAt k (MaxPQ q) = case Q.splitAt k q of
(xs, q') -> (fmap (first' unDown) xs, MaxPQ q')
Expand Down
6 changes: 3 additions & 3 deletions src/Data/PQueue/Prio/Min.hs
Original file line number Diff line number Diff line change
Expand Up @@ -275,12 +275,12 @@ partitionWithKey :: Ord k => (k -> a -> Bool) -> MinPQueue k a -> (MinPQueue k a
partitionWithKey p = mapEitherWithKey (\k a -> if p k a then Left a else Right a)

{-# INLINE take #-}
-- | \(O(k \log n)\)/. Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@.
-- | \(O(k \log n)\). Takes the first @k@ (key, value) pairs in the queue, or the first @n@ if @k >= n@.
-- (@'take' k q == 'List.take' k ('toAscList' q)@)
take :: Ord k => Int -> MinPQueue k a -> [(k, a)]
take n = List.take n . toAscList

-- | \(O(k \log n)\)/. Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@.
-- | \(O(k \log n)\). Deletes the first @k@ (key, value) pairs in the queue, or returns an empty queue if @k >= n@.
drop :: Ord k => Int -> MinPQueue k a -> MinPQueue k a
drop n0 q0
| n0 <= 0 = q0
Expand All @@ -291,7 +291,7 @@ drop n0 q0
| n == 0 = q
| otherwise = drop' (n - 1) (deleteMin q)

-- | \(O(k \log n)\)/. Equivalent to @('take' k q, 'drop' k q)@.
-- | \(O(k \log n)\). Equivalent to @('take' k q, 'drop' k q)@.
splitAt :: Ord k => Int -> MinPQueue k a -> ([(k, a)], MinPQueue k a)
splitAt n q
| n <= 0 = ([], q)
Expand Down

0 comments on commit 110d979

Please sign in to comment.