fork download
  1. ; concatenate n n times
  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 (digits n . args)
  17. (let ((b (if (null? args) 10 (car args))))
  18. (let loop ((n n) (d '()))
  19. (if (zero? n) d
  20. (loop (quotient n b)
  21. (cons (modulo n b) d))))))
  22.  
  23. (define (undigits ds . args)
  24. (let ((b (if (null? args) 10 (car args))))
  25. (let loop ((ds ds) (n 0))
  26. (if (null? ds) n
  27. (loop (cdr ds) (+ (* n b) (car ds)))))))
  28.  
  29. (define (f n)
  30. (undigits (flatten (iterate n append (digits n)))))
  31.  
  32. (display (f 12)) (newline)
  33.  
  34.  
  35. (define (d n) ; number of digits in n
  36. (let loop ((n n) (k 0))
  37. (if (zero? n) k
  38. (loop (quotient n 10) (+ k 1)))))
  39.  
  40. (define (f n) ; concatenate n n times
  41. (quotient
  42. (* n (- (expt 10 (* n (d n))) 1))
  43. (- (expt 10 (d n)) 1)))
  44.  
  45. (display (d 12)) (newline)
  46. (display (f 12)) (newline)
Success #stdin #stdout 0.04s 8792KB
stdin
Standard input is empty
stdout
121212121212121212121212
2
121212121212121212121212