Intersection of sets of ranges in Scheme

Question

I am trying to write a Scheme function that will find the intersection of sets that contain pairs representing ranges.

for example, lets say set1 = ((1 3) (5 13) (25 110) (199 300))

and set2 = ((2 4) (17 26) (97 100) (110 200) (288 500))

so a Scheme function (intersect set1 set2) should give the result

((2 3) (25 26) (97 100) (110 110) (199 200) (288 300))

Note that I am not trying to find the intersection of the set elements but rather the overlapping points of the pairs in the sets.

This is what I have tried so far

(define (intersect a b)
  (cond
    ((or(null? a)(null? b))(quote ()))
    ((and(>=(cadr(car a))(car(car b)))(>=(cadr(car a))(cadr(car b))))
       (cons(cons (car(car b))(cdr(car b)))
         (intersect (cdr a)(cdr b))))
    ((>=(cadr(car a))(car(car b)))
       (cons(cons (car(car b))(cdr(car a)))
         (intersect (cdr a)(cdr b))))
    ((>=(cadr(car a))(car(car(cdr b))))
       (cons(cons (car(car(cdr b)))(cdr(car a)))
         (intersect (cdr a)(cdr b))))
    ((>=(cadr(car b))(car(car(cdr a))))
       (cons(cons (car(car(cdr a)))(cdr(car b)))
         (intersect (cdr a)(cdr b))))
    (else(intersect (cdr a) (cdr b)))))

but I got the output as ((2 3) (25 26) (97 100) (110 200)) which is not correct as I should be getting ((2 3) (25 26) (97 100) (110 110) (199 200) (288 300)).

Anybody has any suggestions on how to solve this or what is wrong in my code.

Answer 1

;; Function to compute the intersection of two intervals.
;; If the intersection is empty, the function returns #f as the lower limit
;; of the intersection.
(define (intersect-interval a b)

  ;; Assume that (car a) <= (cadr a) and (car b) <= (cadr b)

  ;; Get the lower limit of the intersection.
  ;; If there isn't one, return #f
  (define (lower-limit)
    (if (< (cadr a) (car b))
      #f
      (car b)))

  ;; Get the upper limit of the intersection.
  (define (upper-limit)
    (min (cadr a) (cadr b)))

  ;; Let's make our life simpler.
  ;; Make sure that (car a) is less than (car b)
  ;; for the core computation.

  (if (> (car a) (car b))
    (intersect-interval b a)
    (list
      (lower-limit)
      (upper-limit)))
  )

;; Function that computes the valid intersections of two sets of intervals.
(define (intersect-interval-sets seta setb)

  ;; Helper function that takes one item from the first set and iterates over the
  ;; items of the second set. It computes the intersection of the item from the first set
  ;; and each item of the second set. If there is a valid intesection, it adds it to the output.
  (define (make-intersections-2 item lst2 out)
    (if (null? lst2)
      out
      (begin
        (let ((ints (intersect-interval item (car lst2))))
          (if (eq? #f (car ints))
            (make-intersections-2 item (cdr lst2) out)
            (make-intersections-2 item (cdr lst2) (append out (list ints))))))))

  ;; Helper function that iterates over the items of the first list and calls the previous
  ;; function using each item of the first list and the second list.
  (define (make-intersections-1 lst1 lst2 out)
    (if (null? lst1)
      out
      (make-intersections-1 (cdr lst1) lst2 (make-intersections-2 (car lst1) lst2 out))))

  ;; Start the recursion and return the result.
  (make-intersections-1 seta setb '())
  )

Testing at repl.it

   (define seta '((2 3) (100 200)))
   (define setb '((5 10) (90 120) (110 300)))
   (intersect-interval-sets seta setb)
=> ((100 120) (110 200))

Answer 2

This will be easier to handle if we create a special auxiliary function to find an intersection of two given regions, producing an intersection region and the left-over region as the result:

(define (intersect xs ys)
  (define (intersect-regions x y)   ; x=(a b) y=(c d), a <= c is assumed NB!
    (let ((b (cadr x)) (c (car y)) (d (cadr y)))  
      (cond
        ( (< b c)            ; 1st region ends before 2nd begins
            (list '()        ; no intersection
                   y))       ; the left-over region
        ( (< b d)            ; thus b >= c, and so, if b < d,
            (list (list c b)      ; b already included: this will
                  (list b d)))    ;  only work for sorted range-lists
        (else                     ; b >= d
            (list y               ; includes d -- will only work for
                  (list d b))))))     ; sorted, 
  (define (loop a b acc)              ;   non-overlapping range-lists
    (if (or (null? a) (null? b))   
      (reverse acc)
      (let ((r (if (<= (caar a) (caar b))
                 (intersect-regions (car a) (car b))
                 (intersect-regions (car b) (car a)))))
          (if (not (null? (car r))) 
             (set! acc (cons (car r) acc)))
          (if (or (null? (cdr a)) (< (cadadr r) (caadr a)))
             (loop (cons (cadr r) (cdr a))  (cdr b)  acc)
             (loop (cdr a)  (cons (cadr r) (cdr b))  acc)))))
  (loop xs ys '()))

The function loop is tail recursive, building up its result in an accumulator argument. We assume each range-list contains non-overlapping ranges in ascending order. Testing:

(intersect '((1 3) (5 13) (25 110) (199 300)) 
           '((2 4) (17 26) (97 100) (110 200) (288 500)))
;Value 18: ((2 3) (25 26) (97 100) (110 110) (199 200) (288 300))