fork(4) download
copy 
  1. ; consecutive sums
  2.  
  3. (define (range . args)
  4.   (case (length args)
  5.     ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  6.     ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  7.     ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  8.            (let loop ((x(car args)) (xs '()))
  9.              (if (le? (cadr args) x)
  10.                  (reverse xs)
  11.                  (loop (+ x (caddr args)) (cons x xs))))))
  12.     (else (error 'range "unrecognized arguments"))))
  13.  
  14. (define (consums n)
  15.   (let loop ((i 1) (j 1) (s 0) (zs (list)))
  16.     ;(display i) (display " ") (display j) (display " ")
  17.     ;(display s) (display " ") (display zs) (newline)
  18.     (cond ((< n (+ i i 1)) (reverse zs))
  19.           ((< s n) (loop i (+ j 1) (+ s j) zs))
  20.           ((< n s) (loop (+ i 1) (+ i 1) 0 zs))
  21.           (else (loop (+ i 1) (+ i 1) 0
  22.                       (cons (range i j) zs))))))
  23.  
  24. (display (consums 15)) (newline)
  25.  
  26. (define (consums n)
  27.   (let loop ((len 2) (seqs (list)))
  28.     (let ((sum (/ (* len (+ len 1)) 2)))
  29.       (if (< n sum) seqs
  30.         (if (positive? (modulo (- n sum) len))
  31.             (loop (+ len 1) seqs)
  32.             (let* ((mid (quotient n len))
  33.                    (start (- mid (quotient len 2)
  34.                              (if (even? len) -1 0)))
  35.                    (seq (range start (+ start len))))
  36.               (loop (+ len 1) (cons seq seqs))))))))
  37.  
  38. (display (consums 15)) (newline)
  39.  
  40. (display (map (lambda (n) (length (consums n)))
  41.               '(10 100 1000 10000 100000 1000000)))
Success #stdin #stdout 0.06s 50592KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
((1 2 3 4 5) (4 5 6) (7 8))
((1 2 3 4 5) (4 5 6) (7 8))
(1 2 3 4 5 6)
https://ideone.com/omBXzJ
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!