Reputation: 4938
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
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
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
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
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