fork(1) download
copy 
  1. ; almost-primes
  2.  
  3. (define (factors n)
  4.   (let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6)))
  5.     (let loop ((n n) (f 2) (w 0) (fs (list)))
  6.       (if (< n (* f f)) (reverse (cons n fs))
  7.         (if (zero? (modulo n f))
  8.             (loop (/ n f) f w (cons f fs))
  9.             (loop n (+ f (vector-ref wheel w))
  10.                   (if (= w 10) 3 (+ w 1)) fs))))))
  11.  
  12. (define (kap? k n) (= (length (factors n)) k))
  13.  
  14. (define (distinct? xs)
  15.   (if (or (null? xs) (null? (cdr xs))) #t
  16.     (if (= (car xs) (cadr xs)) #f
  17.       (distinct? (cdr xs)))))
  18.  
  19. (define (sfkap? k n)
  20.   (let ((fs (factors n)))
  21.     (and (= (length fs) k) (distinct? fs))))
  22.  
  23. (define (seq test? k len)
  24.   (let loop ((k k) (m len) (n 2) (ks (list)) (kss (list)))
  25.     (if (zero? k) kss
  26.       (if (zero? m)
  27.           (loop (- k 1) len 2 (list) (cons (reverse ks) kss))
  28.           (if (test? k n)
  29.               (loop k (- m 1) (+ n 1) (cons n ks) kss)
  30.               (loop k m (+ n 1) ks kss))))))
  31.  
  32. (for-each (lambda (ks) (display ks) (newline)) (seq kap? 5 10))
  33. (newline)
  34. (for-each (lambda (ks) (display ks) (newline)) (seq sfkap? 5 10))
Success #stdin #stdout 1.21s 52960KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(2 3 5 7 11 13 17 19 23 29)
(4 6 9 10 14 15 21 22 25 26)
(8 12 18 20 27 28 30 42 44 45)
(16 24 36 40 54 56 60 81 84 88)
(32 48 72 80 108 112 120 162 168 176)

(2 3 5 7 11 13 17 19 23 29)
(6 10 14 15 21 22 26 33 34 35)
(30 42 66 70 78 102 105 110 114 130)
(210 330 390 462 510 546 570 690 714 770)
(2310 2730 3570 3990 4290 4830 5610 6006 6090 6270)
https://ideone.com/lNRjAI
language:
Scheme (guile 2.2.4)
created:
5 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!