fork download
copy 
  1. ; strangers on a train
  2.  
  3. (define (take n xs)
  4.   (let loop ((n n) (xs xs) (ys '()))
  5.     (if (or (zero? n) (null? xs))
  6.         (reverse ys)
  7.         (loop (- n 1) (cdr xs)
  8.               (cons (car xs) ys)))))
  9.  
  10. (define (range . args)
  11.   (case (length args)
  12.     ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  13.     ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  14.     ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  15.            (let loop ((x(car args)) (xs '()))
  16.              (if (le? (cadr args) x)
  17.                  (reverse xs)
  18.                  (loop (+ x (caddr args)) (cons x xs))))))
  19.     (else (error 'range "unrecognized arguments"))))
  20.  
  21. (define (last xs)
  22.   (if (null? xs) (error 'last "empty list")
  23.     (let loop ((xs xs))
  24.       (if (null? (cdr xs)) (car xs) (loop (cdr xs))))))
  25.  
  26. (define (remove x xs)
  27.   (let loop ((xs xs) (zs '()))
  28.     (cond ((null? xs) (reverse zs))
  29.           ((equal? (car xs) x) (loop (cdr xs) zs))
  30.           (else (loop (cdr xs) (cons (car xs) zs))))))
  31.  
  32. (define (all? pred? xs)
  33.   (cond ((null? xs) #t)
  34.         ((pred? (car xs))
  35.           (all? pred? (cdr xs)))
  36.         (else #f)))
  37.  
  38. (define (prime? n)
  39.   (let loop ((d 2))
  40.     (cond ((< n (* d d)) #t)
  41.           ((zero? (modulo n d)) #f)
  42.           (else (loop (+ d 1))))))
  43.  
  44. (define (next-prime n)
  45.   (let ((n (+ n 1)))
  46.     (if (prime? n) n
  47.       (next-prime n))))
  48.  
  49. (define (coprime? x y)
  50.   (= (gcd x y) 1))
  51.  
  52. (define (strangers n)
  53.   (let loop1 ((k 1) (strange (list 2)) (avail (list 3 4)))
  54.     (if (<= n k) (reverse strange)
  55.       (let loop2 ((cs avail)) ; list of candidates
  56.         (if (null? cs) (error 'strangers "null candidate list")
  57.           (let ((c (car cs)))
  58.             (if (all? (lambda (x) (coprime? x c))
  59.                       (take (quotient (+ k 1) 2) strange))
  60.                 (loop1 (+ k 1) (cons c strange)
  61.                        (append (remove c avail)
  62.                                (range (+ (last cs) 1)
  63.                                       (+ (next-prime (last cs)) 1))))
  64.                 (loop2 (cdr cs)))))))))
  65.  
  66. (display (strangers 61))
Success #stdin #stdout 0.25s 7364KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(2 3 4 5 7 9 8 11 13 17 19 23 15 29 14 31 37 41 43 47 53 59 61 67 71 73 25 27 79 83 16 49 89 97 101 103 107 109 113 121 127 131 137 139 149 151 157 163 167 169 173 179 181 191 85 193 57 197 199 211 223)
https://ideone.com/0miAAH
language:
Scheme (chicken 4.13)
created:
8 years ago
visibility:
secret

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!