[Haskell-cafe] Create a list without duplicates from a list with duplicates

Dan Weston westondan at imageworks.com
Fri Feb 8 15:36:25 EST 2008


As noted, (Data.Set.toList . Data.Set.fromList) is the best traditional 
solution if you don't care about order (or Data.Set.toAscList for a 
sorted result).

If order is important, the new bijective Data.Bimap class
http://code.haskell.org/~scook0/haddock/bimap/Data-Bimap.html
may be your best bet (I haven't yet tried it myself).

Meanwhile, here is a hand-rolled solution to order-preserving nubbing:

 > import Data.List(groupBy,sortBy,sort)
 > import Data.Maybe(listToMaybe)
 >
 > efficientNub :: (Ord a) => [a] -> [a]
 > efficientNub  = flip zip [0..]        -- carry along index
 >             >>> sort                  -- sort by value, then index
 >             >>> groupBy equalFsts     -- group adjacent equal values
 >             >>> map head              -- keep only primus inter pares
 >             >>> sortBy compareSnds    -- sort by index
 >             >>> map fst               -- discard index
 >
 >   where equalFsts   (x1,y1) (x2,y2) = x1 == x2
 >         compareSnds (x1,y1) (x2,y2) = compare y1 y2
 >         x >>> y = y . x

There is a hidden proof obligation here:

Exercise: Prove that (groupBy equalFsts >>> map head) is a total 
function, using the defintion of groupBy from Data.List:

groupBy           :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy _  []      =  []
groupBy eq (x:xs)  =  (x:ys) : groupBy eq zs
                            where (ys,zs) = span (eq x) xs

Felipe Lessa wrote:
> 2008/2/8 Jed Brown <jed at 59a2.org>:
>> Look at Data.List:
>>
>> nub :: (Eq a) => [a] -> [a]
>> nub = nubBy (==)
>>
>> nubBy :: (a -> a -> Bool) -> [a] -> [a]
>> nubBy eq []     = []
>> nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs)
> 
> And then there's also
> 
> sort :: (Ord a) => [a] -> [a]
> 
> which should have better performance, O(n log n) against O(n²) I
> guess, but of course will change the order of the elements. If you
> really don't mind the order at all, you could also use Data.Set in the
> first place.
> 
> Cheers,
> 
> 
> 
> ------------------------------------------------------------------------
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe




More information about the Haskell-Cafe mailing list