fork download
copy 
  1. ; arithmetic progressions
  2.  
  3. (define (arith-progs xs)
  4.   (define (signum x) (if (< x 0) -1 (if (< 0 x) 1 0)))
  5.   (define (x i) (vector-ref xs i))
  6.   (define len (vector-length xs))
  7.   (do ((j 1 (+ j 1))) ((= j (- len 1)))
  8.     (let loop ((i (- j 1)) (k (+ j 1)))
  9.       (when (and (<= 0 i) (< k len))
  10.         (case (signum (+ (x i) (x k) (* (x j) -2)))
  11.         ((-1) (loop i (+ k 1)))
  12.         ((1)  (loop (- i 1) k))
  13.         (else (display (list (x i) (x j) (x k))) (newline)
  14.               (loop (- i 1) (+ k 1))))))))
  15.  
  16. (arith-progs '#(1 2 3 4 6 7 9))
  17. (newline)
  18. (arith-progs '#(1 3 4 6 7 8 9))
  19. (newline)
  20.  
  21. (define (geo-progs xs)
  22.   (define (signum x) (if (< x 0) -1 (if (< 0 x) 1 0)))
  23.   (define (x i) (vector-ref xs i))
  24.   (define len (vector-length xs))
  25.   (do ((j 1 (+ j 1))) ((= j (- len 1)))
  26.     (let loop ((i (- j 1)) (k (+ j 1)))
  27.       (when (and (<= 0 i) (< k len))
  28.         (case (signum (- (/ (x j) (x i)) (/ (x k) (x j))))
  29.         ((-1) (loop (- i 1) k))
  30.         ((1)  (loop i (+ k 1)))
  31.         (else (display (list (x i) (x j) (x k))) (newline)
  32.               (loop (- i 1) (+ k 1))))))))
  33.  
  34. (geo-progs '#(1 2 3 4 6 7 9))
  35. (newline)
  36. (geo-progs '#(1 3 4 6 7 8 9))
Success #stdin #stdout 0.01s 42848KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(1 2 3)
(2 3 4)
(2 4 6)
(1 4 7)
(3 6 9)

(1 4 7)
(4 6 8)
(3 6 9)
(6 7 8)
(7 8 9)

(1 2 4)
(1 3 9)
(4 6 9)

(1 3 9)
(4 6 9)
https://ideone.com/it0Gl6
language:
Scheme (guile 2.2.4)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!