linetree.rkt

#lang racket

;; Generate n random lines offset m from origin
(define (random-lines n m)
  (map (lambda (_)
         (define i (random m))
         (list i (+ i (random 999))))
       (range n)))

;; Count lines in a conventional way (n log n because of sort)
(define (line-coverage0 lines)
  (define sorted-lines (sort lines <= #:key first))
  (define (add-to-coverage lines total skip-to)
    (if (null? lines)
        total
        (match (first lines)
          [`(,start ,end)
           (if (>= skip-to end)
               (add-to-coverage (cdr lines) total skip-to)
               (add-to-coverage (cdr lines) (+ total (- end (max start skip-to))) end))])))
  (add-to-coverage sorted-lines 0 0))

(define (linetree? lt)
  (match lt
    ['empty #t]
    ['covered #t]
    [`(linetree ,(? number?) ,(? linetree?) ,(? linetree?)) #t]))

;; add to a line tree
(define (linetree-add lt line)
    (match line
      [`(,start ,end) #:when (> end start)
       (match lt
         ['empty
          `(linetree ,start empty (linetree ,end covered empty))]
         ['covered 'covered]
         [`(linetree ,px ,left ,right)
          `(linetree ,px
                     ,(linetree-add left `(,(min px start) ,(min px end)))
                     ,(linetree-add right `(,(max px start) ,(max px end))))])]
      [_ lt]))

;; sum a line tree
(define (linetree-sum lt [wstart -inf.0] [wend +inf.0])
    (match lt
      ['empty 0]
      ['covered (- wend wstart)]
      [`(linetree ,px ,left ,right)
       (+ (linetree-sum left (min wstart px) (min wend px))
          (linetree-sum right (max wstart px) (max wend px)))]))

(define (line-coverage1 lines)
  (linetree-sum
   (foldl (lambda (line lt) (linetree-add lt line)) 'empty lines)))