packages feed

hgeometry-combinatorial-0.14: src/Data/List/Util.hs

--------------------------------------------------------------------------------
-- |
-- Module      :  Data.List.Util
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.List.Util where

import           Data.Bifunctor
import           Data.Ext
import qualified Data.Foldable as F
import qualified Data.List as List
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.List.Zipper (allNonEmptyNexts, extractNext)
import qualified Data.List.Zipper as Zipper
import           Data.Maybe
import           Data.Ord (comparing)

--------------------------------------------------------------------------------

-- | Given an input list, computes all lists in which just one element is missing.
--
-- >>> mapM_ print $ leaveOutOne [1..5]
-- (1,[2,3,4,5])
-- (2,[1,3,4,5])
-- (3,[1,2,4,5])
-- (4,[1,2,3,5])
-- (5,[1,2,3,4])
-- >>> leaveOutOne []
-- []
-- >>> leaveOutOne [1]
-- [(1,[])]
leaveOutOne    :: [a] -> [(a,[a])]
leaveOutOne xs = second F.toList . fromJust . extractNext
              <$> allNonEmptyNexts (Zipper.fromList xs)


--------------------------------------------------------------------------------
-- * Improved functions for minima and maxima

-- | Safe variant of Prelude.minimum.
--
-- >>> minimum1 [] :: Maybe ()
-- Nothing
-- >>> minimum1 [1,2,3]
-- Just 1
minimum1 :: Ord a => [a] -> Maybe a
minimum1 = minimum1By compare

-- | Safe variant of Prelude.maximum.
--
-- >>> maximum1 [] :: Maybe ()
-- Nothing
-- >>> maximum1 [1,2,3]
-- Just 3
maximum1 :: Ord a => [a] -> Maybe a
maximum1 = minimum1By (flip compare)

-- | Total variant of Data.List.minimumBy.
--
-- >>> minimum1By (comparing abs) [] :: Maybe Int
-- Nothing
-- >>> minimum1By (comparing abs) [1,-2,3]
-- Just 1
minimum1By     :: (a -> a -> Ordering) -> [a] -> Maybe a
minimum1By cmp = \case
  [] -> Nothing
  xs -> Just $ List.minimumBy cmp xs

-- | Computes all minima by comparing some property.
--
-- >>> minimaOn (max 2) [1,2,3,4,5,-1]
-- [-1,2,1]
minimaOn   :: Ord b => (a -> b) -> [a] -> [a]
minimaOn f = minimaBy (comparing f)

-- | Computes all minima.
--
-- >>> minimaBy (comparing abs) [1,2,3,2,1,-1]
-- [-1,1,1]
minimaBy     :: (a -> a -> Ordering) -> [a] -> [a]
minimaBy cmp = \case
  []     -> []
  (x:xs) -> NonEmpty.toList $ List.foldl' (\mins@(m:|_) y -> case m `cmp` y of
                                                               LT -> mins
                                                               EQ -> y NonEmpty.<| mins
                                                               GT -> y:|[]
                                          ) (x:|[]) xs

-- | extracts all minima from the list. The result consists of the
-- list of minima, and all remaining points. Both lists are returned
-- in the order in which they occur in the input.
--
-- >>> extractMinimaBy compare [1,2,3,0,1,2,3,0,1,2,0,2]
-- [0,0,0] :+ [2,3,1,2,3,1,2,1,2]
extractMinimaBy     :: (a -> a -> Ordering) -> [a] -> [a] :+ [a]
extractMinimaBy cmp = \case
  []     -> [] :+ []
  (x:xs) -> first NonEmpty.toList $ foldr (\y (mins@(m:|_) :+ rest) ->
                                             case m `cmp` y of
                                               LT -> mins :+ y:rest
                                               EQ -> (y NonEmpty.<| mins) :+ rest
                                               GT -> (y:|[]) :+ NonEmpty.toList mins <> rest
                                          ) ((x:|[]) :+ []) xs
  -- TODO: This is actually a good scenario for testing how much slower :+ is compared
  -- to doing nothing. i..e compare minimaBy and extractMinimaBy
  -- note that I'm using foldr here, and foldl' before


--------------------------------------------------------------------------------
-- * Partitioning and Grouping

-- | Given a function f, partitions the list into three lists
-- (lts,eqs,gts) such that:
--
-- - f x == LT for all x in lts
-- - f x == EQ for all x in eqs
-- - f x == gt for all x in gts
--
-- >>> partition3 (compare 4) [0,1,2,2,3,4,5,5,6,6,7,7,7,7,7,8]
-- ([5,5,6,6,7,7,7,7,7,8],[4],[0,1,2,2,3])
--
partition3   :: Foldable f => (a -> Ordering) -> f a -> ([a],[a],[a])
partition3 f = foldr g ([],[],[])
  where
    g x (lts,eqs,gts) = case f x of
                          LT -> (x:lts,   eqs,  gts)
                          EQ -> (  lts, x:eqs,  gts)
                          GT -> (  lts,   eqs,x:gts)

-- | A version of groupBy that uses the given Ordering to group
-- consecutive Equal items
--
-- >>> groupBy' compare [0,1,2,2,3,4,5,5,6,6,7,7,7,7,7,8]
-- [0 :| [],1 :| [],2 :| [2],3 :| [],4 :| [],5 :| [5],6 :| [6],7 :| [7,7,7,7],8 :| []]
groupBy'     :: (a -> a -> Ordering) -> [a] -> [NonEmpty a]
groupBy' cmp = go
  where
    go = \case
      []       -> []
      (x:xs)   -> let (pref,rest) = List.span (\y -> x `cmp` y == EQ) xs
                  in (x :| pref) : go rest