; arithmetic progressions

(define (arith-progs xs)
  (define (signum x) (if (< x 0) -1 (if (< 0 x) 1 0)))
  (define (x i) (vector-ref xs i))
  (define len (vector-length xs))
  (do ((j 1 (+ j 1))) ((= j (- len 1)))
    (let loop ((i (- j 1)) (k (+ j 1)))
      (when (and (<= 0 i) (< k len))
        (case (signum (+ (x i) (x k) (* (x j) -2)))
        ((-1) (loop i (+ k 1)))
        ((1)  (loop (- i 1) k))
        (else (display (list (x i) (x j) (x k))) (newline)
              (loop (- i 1) (+ k 1))))))))

(arith-progs '#(1 2 3 4 6 7 9))
(newline)
(arith-progs '#(1 3 4 6 7 8 9))
(newline)

(define (geo-progs xs)
  (define (signum x) (if (< x 0) -1 (if (< 0 x) 1 0)))
  (define (x i) (vector-ref xs i))
  (define len (vector-length xs))
  (do ((j 1 (+ j 1))) ((= j (- len 1)))
    (let loop ((i (- j 1)) (k (+ j 1)))
      (when (and (<= 0 i) (< k len))
        (case (signum (- (/ (x j) (x i)) (/ (x k) (x j))))
        ((-1) (loop (- i 1) k))
        ((1)  (loop i (+ k 1)))
        (else (display (list (x i) (x j) (x k))) (newline)
              (loop (- i 1) (+ k 1))))))))

(geo-progs '#(1 2 3 4 6 7 9))
(newline)
(geo-progs '#(1 3 4 6 7 8 9))