1
\$\begingroup\$

Given a list of numeric intervals in the form of (a,b), where a and b are integers, it finds a set of disjoint intervals that cover the same numbers by splitting the original intervals at the points where they intersect.

For example: disjoint [(1,2),(1,3),(1,3),(30,31)] gives [(1,2),(2,3),(30,31)].

Please help me make this code less ugly.

{-# LANGUAGE TupleSections #-}

import Data.List (group, sortBy)

-- [(97, 99), (97, 100), (98, 108)]
-- [97, 97] [98, 99], [100, 100], [101, 108]

disjoint :: (Ord a, Num a) => [(a, a)] -> [(a, a)]
disjoint [] = []
disjoint ts = disjoint' 0 x xs
    where
      disjoint' _ _ []          = []
      disjoint' c (k, p) (x:xs) = let c' = c + k
                                      h  = if c' > 0 then [(p, snd x)] else []
                                  in h ++ (disjoint' c' x xs)
      eitherValue               = either id id
      endpoints                 = foldr (\(a, b) m -> (Left a):(Right b):m) []
      pcompare x y              = compare (eitherValue x) (eitherValue y)
      runs                      = let f xs@(x:_) = either (length xs,) (-length xs,) x
                                  in map f . group
      (x:xs)                    = runs $ (sortBy pcompare) $ endpoints ts
\$\endgroup\$

1 Answer 1

2
\$\begingroup\$

The compactness and efficiency of the code is quite impressive. The downside is that it's rather convoluted and difficult to understand.

Types

Annotations

Haskell types are very helpful, both when writing and reading code. Type declarations should not be limited to top-level functions. They can, and should, be added to local variables as well. Even though it's not very complicated, the purpose of endpoints becomes much clearer when its type is explicitly stated:

endpoints :: [(a, b)] -> [Either a b]
endpoints = foldr (\(a, b) m -> (Left a):(Right b):m) []

It converts tuples into eithers. It's obvious from the type that it works almost like a map, which we can make more explicit by using concatMap:

endpoints = concatMap (\(a,b) -> [Left a, Right b])

Defining types

Another way in which types improve readability is that they hint at the semantics of a value. Either is a very generic type, defining a newtype for interval endpoints might make things easier to understand.

Code organization

Related code should usually be grouped together. The order, in which the local functions are defined, seems rather random. Reorganizing those functions could benefit readability.

Variable naming

The variables (x:xs) a are shadowed in some functions. That's confusing and will cause compiler warnings when compiled with -Wall. I'd suggest renaming the outer (x:xs) to (y:ys).

This is just personal taste, but I'd also rename eitherValue to fromEither (in analogy to fromMaybe and fromJust). This would make even more sense if a custom type was used (e.g. fromBorder).

Opinionated cleanup

Below is what I perceive as a cleaner version of this function. It doesn't have the nice compactness of the original code, but uses the same basic algorithm. The local functions are quite general and can easily be promoted to top level functions. Reusable code is usually to be preferred.

import Data.Function (on)
import Data.List (group, sortBy)
type Border a = Either a a

disjoint' :: (Ord a) => [(a, a)] -> [(a, a)]
disjoint' = concatMap consecutiveBordersToIntervals
            . groupBalancedBorders
            . sortBy (compare `on` fromBorder)
            . intervalBorders
    where
      intervalBorders :: [(a, a)] -> [Border a]
      intervalBorders = concatMap $ \(x, y) -> [Left x, Right y]

      groupBalancedBorders :: [Border a] -> [[Border a]]
      groupBalancedBorders [] = []
      groupBalancedBorders xs = let (ys, zs) = spanBalancedBorders 0 xs
                                in ys : groupBalancedBorders zs

      spanBalancedBorders :: Int -> [Border a] -> ([Border a], [Border a])
      spanBalancedBorders _       []     = ([], [])
      spanBalancedBorders balance (x:xs) =
          let balance' = either (const $ balance + 1) (const $ balance - 1) x
          in case balance' of
               0 -> ([x],xs)
               _ -> let (ys,zs) = spanBalancedBorders balance' xs in (x:ys,zs)

      consecutiveBordersToIntervals :: (Eq a) => [Border a] -> [(a, a)]
      consecutiveBordersToIntervals =
          (\xs -> zip xs (tail xs)) . dedupSortedList . map fromBorder

      dedupSortedList :: (Eq a) => [a] -> [a]
      dedupSortedList = map head . group

      fromBorder :: Border a -> a
      fromBorder = either id id

This is as fast as the original, but arguably easier to read. It also fixes a bug which caused empty intervals to be included.

>>> disjoint [(1,5), (5,10), (1,10)]
[(1,5),(5,5),(5,10)]
>>> disjoint' [(1,5), (5,10), (1,10)]
[(1,5),(5,10)]

As a final note, one should be aware that the algorithm makes some implicit assumptions on the topology of the intervals in a. It would break down when intervals were allowed to have start points which are greater than their endpoint (think modular arithmetic).

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.