sketch-intervals.hs

sketch-intervals.hs

import System.Random (StdGen, randomR, split)

type Interval = (Double, Double)
type Label = String

data Event = Event Label Interval deriving (Show)

data Relationship = Before | Meets | Overlaps | After 
  deriving (Show, Eq)

type IntervalGraph = [(Event, Event, Relationship)]

determineRelationship :: Interval -> Interval -> Maybe Relationship
determineRelationship (start1, end1) (start2, end2)
  | end1 < start2 = Just Before
  | end1 == start2 = Just Meets
  | start1 < start2 && end1 > end2 = Just Overlaps
  | start2 < start1 = Just After  
  | otherwise = Nothing  
-- SIMPLIFIED


createEventBasedOnRelationship :: Event -> Relationship -> StdGen -> (Event, StdGen)
createEventBasedOnRelationship (Event lbl (start, end)) relationship gen =
  let (gen1, gen2) = split gen
      newLabel = lbl ++ "'"
      (duration, newGen) = randomR (1.0, 5.0) gen1
      newInterval = case relationship of
        Before -> (start - duration - 1.0, start - 1.0)
        Meets -> (end, end + duration)
        Overlaps -> (end - 1.0, end + duration - 1.0)
        After -> (end + 1.0, end + duration + 1.0)
  in (Event newLabel newInterval, newGen)





generateGraph :: [Event] -> IntervalGraph
generateGraph events =
  let findRelations e = [(e, e', rel) | e' <- events, e /= e', Just rel <- [determineRelationship (snd $ eventInterval e) (snd $ eventInterval e')]]
      eventInterval (Event _ interval) = interval
  in concatMap findRelations events