phynfo
phynfo

Reputation: 4938

Determine time gaps from list of time-spans (not covered by the spans in the list)

I have a list of time-spans (given as Integer-Tuples), e.g.:

timespans = [ (1200, 1210)
        , (1202, 1209)
        , (1505, 1900)
        , (1300, 1500)
        , (1400, 1430)
        ]   

I want to find an elegant Haskell solution to determine time gaps which are not covered by the timespans in the list.

Upvotes: 4

Views: 308

Answers (4)

ony
ony

Reputation: 13243

Elegant - you mean something like?

import Data.List
timespans = [ (1200, 1210)
        , (1202, 1209)
        , (1505, 1900)
        , (1300, 1500)
        , (1400, 1430)
        ]   

gaps xs0 = filter g $ zipWith f xs (tail xs) where
  xs = merge $ sort xs0
  f (_, t0) (t1, _) = (t0, t1)
  g (t0, t1) = t0 < t1
  merge [] = []
  merge ((t0, t1):(t2, t3):ys) | t2 < t1 = merge ((t0, max t1 t3) : ys)
  merge (y:ys) = y : merge ys

main = print (gaps timespans)

Upvotes: 3

sepp2k
sepp2k

Reputation: 370397

First I would sort the spans by their starting time. Then you can merge overlapping spans pretty easily. Once you have that you can find the gaps by just iterating over the merged spans in pairs (by zipping it with its tail). The gap will be the span from the end time of the first item of the pair to the starting time of the second item.

In code this would look like this:

mergeSortedSpans [] = []
mergeSortedSpans ((from1, to1):(from2, to2):spans) | to1 >= from2 =
   mergeSortedSpans $ (from1, max to1 to2):spans
mergeSortedSpans (span:spans) = span : mergeSortedSpans spans

inPairs _ [] = []
inPairs f (x:xs) = zipWith f (x:xs) xs

gap (_, to1) (from2, _) = (to1, from2)

gaps = inPairs gap . mergeSortedSpans . sort

Usage:

gaps timespans
-- [(100,500),(1210,1300),(1500,1505)]

Upvotes: 4

phynfo
phynfo

Reputation: 4938

Thanks sepp2k -- your right; its much easier the way you suggest! In working Haskell-Code:

flattentime :: [(Integer,Integer)] -> [(Integer,Integer)]
flattentime [] = []
flattentime [x] = [x]
flattentime ((x1,x2):(y1,y2):ts) | y2<x2 = (x1,x2):(flattentime ts)
                                 | y1<x2 = (x1,y2):(flattentime ts)
                                 | otherwise = (x1,x2) : (flattentime ((y1,y2):ts))

Then i have to call just:

> (flattentime.sort) timespans

Upvotes: 2

phynfo
phynfo

Reputation: 4938

My solution works with divide-and-conquer to melt all overlapping timespans in order to get a sorted list of non-overlapping timespans:

module Test
where

type Time  = Int 
type Start = Time
type Stop  = Time
type Span  = (Start, Stop)

timespans :: [Span]
timespans = [ (1200, 1210)
            , (1202, 1209)
            , (1505, 1900)
            , (1300, 1500)
            , (1400, 1430)
            , (500,1200)
            , (20,100)
            ]   


flattentime :: [Span] -> [Span]
flattentime [] = []
flattentime [x] = [x]
flattentime (s:ss) = combine (flattentime [ times | times <- ss, (fst times) < (fst s) ]) s
                             (flattentime [ times | times <- ss, (fst times) >= (fst s) ])

combine [] s [] = [s]
combine [] s ss2 = melt s (head ss2) ++ tail ss2
combine ss1 s [] = firsts ss1 ++ melt (last ss1) s 
combine ss1 s ss2 =  (firsts ss1) ++ melt3 (last ss1) s (head ss2) ++ (tail ss2)
melt (x1,x2) (x3,x4) | x2 < x3 = [(x1,x2), (x3,x4)]
                     | x4 < x2 = [(x1,x2)]
                     | otherwise = [(x1,x4)]

melt3 (x1,x2) (x3,x4) (x5,x6)  = if (length ss >1) then (head ss):(melt y (x5,x6)) else melt y (x5,x6)
                       where ss = melt (x1,x2) (x3,x4)
                             y = last ss

firsts [x] = []
firsts [] = []
firsts (x:xs) = x:(firsts xs)

Its not that clean and elegant I wished it would be ... anyone has a shorter solution to that?

Upvotes: 3

Related Questions