fork download
copy 
  1. ; a triangular sequence
  2.  
  3. (define (iterate n f . bs)
  4.   (let loop ((n n) (b (car bs)) (bs (cdr bs)) (xs '()))
  5.     (if (zero? n) (reverse xs)
  6.       (let ((new-bs (append bs (list (apply f b bs)))))
  7.         (loop (- n 1) (car new-bs) (cdr new-bs) (cons b xs))))))
  8.  
  9. (define (flatten xs)
  10.   (cond ((null? xs) xs)
  11.         ((pair? xs)
  12.           (append (flatten (car xs))
  13.                   (flatten (cdr xs))))
  14.         (else (list xs))))
  15.  
  16. (define (range . args)
  17.   (case (length args)
  18.     ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  19.     ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  20.     ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  21.            (let loop ((x(car args)) (xs '()))
  22.              (if (le? (cadr args) x)
  23.                  (reverse xs)
  24.                  (loop (+ x (caddr args)) (cons x xs))))))
  25.     (else (error 'range "unrecognized arguments"))))
  26.  
  27. (define (seq nrows)
  28.   (flatten (iterate nrows (lambda (xs) (map add1 (cons 0 xs))) '(1))))
  29.  
  30. (display (seq 5)) (newline)
  31.  
  32. (define (nth n)
  33.   (let ((m (inexact->exact (floor (/ (- (sqrt (+ (* 8 n) 1)) 1) 2)))))
  34.     (inexact->exact (- n (* m (+ m 1) 1/2) -1))))
  35.  
  36. (display (map nth (range 15))) (newline)
Success #stdin #stdout 0s 7948KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(1 1 2 1 2 3 1 2 3 4 1 2 3 4 5)
(1 1 2 1 2 3 1 2 3 4 1 2 3 4 5)
https://ideone.com/hzS2mp
language:
Scheme (chicken 4.13)
created:
4 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!