fork(3) download
copy 
  1. ; leonardo numbers
  2.  
  3. (define (make-matrix rows columns . value)
  4.   (do ((m (make-vector rows)) (i 0 (+ i 1)))
  5.       ((= i rows) m)
  6.     (if (null? value)
  7.         (vector-set! m i (make-vector columns))
  8.         (vector-set! m i (make-vector columns (car value))))))
  9.  
  10. (define (matrix-rows x) (vector-length x))
  11.  
  12. (define (matrix-cols x) (vector-length (vector-ref x 0)))
  13.  
  14. (define (matrix-ref m i j) (vector-ref (vector-ref m i) j))
  15.  
  16. (define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))
  17.  
  18. (define-syntax for
  19.   (syntax-rules ()
  20.     ((for (var first past step) body ...)
  21.       (let ((ge? (if (< first past) >= <=)))
  22.         (do ((var first (+ var step)))
  23.             ((ge? var past))
  24.           body ...)))
  25.     ((for (var first past) body ...)
  26.       (let* ((f first) (p past) (s (if (< first past) 1 -1)))
  27.         (for (var f p s) body ...)))
  28.     ((for (var past) body ...)
  29.       (let* ((p past)) (for (var 0 p) body ...)))))
  30.  
  31. (define (matrix-multiply a b)
  32.   (let ((ar (matrix-rows a)) (ac (matrix-cols a))
  33.         (br (matrix-rows b)) (bc (matrix-cols b)))
  34.     (if (not (= ac br))
  35.         (error 'matrix-multiply "incompatible matrices")
  36.         (let ((c (make-matrix ar bc 0)))
  37.           (for (i ar)
  38.             (for (j bc)
  39.               (for (k ac)
  40.                 (matrix-set! c i j
  41.                   (+ (matrix-ref c i j)
  42.                      (* (matrix-ref a i k)
  43.                         (matrix-ref b k j)))))))
  44.           c))))
  45.  
  46. (define (matrix-power m n)
  47.   (cond ((= n 1) m)
  48.         ((even? n)
  49.           (matrix-power
  50.             (matrix-multiply m m)
  51.             (/ n 2)))
  52.         (else (matrix-multiply m
  53.                 (matrix-power
  54.                   (matrix-multiply m m)
  55.                   (/ (- n 1) 2))))))
  56.  
  57. (define (leo1 n)
  58.   (if (< n 2) 1
  59.     (+ (leo1 (- n 2)) (leo1 (- n 1)) 1)))
  60.  
  61. (display (leo1 30)) (newline)
  62.  
  63. (define (leo2 n)
  64.   (if (< n 2) 1
  65.     (let loop ((L-2 1) (L-1 1) (L 3) (k 2))
  66.       (if (= n k) L
  67.         (loop L-1 L (+ L-1 L 1) (+ k 1))))))
  68.  
  69. (display (leo2 30)) (newline)
  70.  
  71. (define (fib n)
  72.   (if (zero? n) 0
  73.     (matrix-ref (matrix-power #(#(1 1) #(1 0)) n) 1 0)))
  74.  
  75. (define (leo3 n) (- (* (fib (+ n 1)) 2) 1))
  76.  
  77. (display (leo3 30)) (newline)
Success #stdin #stdout 1.5s 7372KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
2692537
2692537
2692537
https://ideone.com/XQTUwK
language:
()
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!