How to find all minimum elements in a list of tuples?
Oneliner. The key is sorting.
Prelude Data.List> let a = [(1,'c'),(2,'b'),(1,'w')]
Prelude Data.List> (\xs@((m,_):_) -> takeWhile ((== m) . fst ) xs) . sortOn fst $ a
[(1,'c'),(1,'w')]
Here's a solution that works in one pass (most other answers here do two passes: one to find the minimum value and one to filter on it), and doesn't rely on how the sorting functions are implemented to be efficient.
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Foldable (foldl')
minimumsBy :: forall a. (a -> a -> Ordering) -> [a] -> [a]
minimumsBy _ [] = []
minimumsBy f (x:xs) = postprocess $ foldl' go (x, id) xs
where
go :: (a, [a] -> [a]) -> a -> (a, [a] -> [a])
go acc@(x, xs) y = case f x y of
LT -> acc
EQ -> (x, xs . (y:))
GT -> (y, id)
postprocess :: (a, [a] -> [a]) -> [a]
postprocess (x, xs) = x:xs []
Note that the [a] -> [a]
type I'm using here is called a difference list, aka a Hughes list.
After you obtain the minimum of the first value, we can filter the list on these items. Because you here want to retrieve a list of minimum items, we can cover the empty list as well by returning an empty list:
minimumsFst :: Ord a => [(a, b)] -> [(a, b)]
minimumsFst [] = []
minimumsFst xs = filter ((==) minfst . fst) xs
where minfst = minimum (map fst xs)
For example:
Prelude> minimumsFst [(10,'a'),(5,'b'),(1,'c'),(8,'d'),(1,'e')]
[(1,'c'),(1,'e')]