; 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))