; fibonacho numbers (define (range . args) (case (length args) ((1) (range 0 (car args) (if (negative? (car args)) -1 1))) ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1))) ((3) (let ((le? (if (negative? (caddr args)) >= <=))) (let loop ((x(car args)) (xs '())) (if (le? (cadr args) x) (reverse xs) (loop (+ x (caddr args)) (cons x xs)))))) (else (error 'range "unrecognized arguments")))) (define (iterate n f . bs) (let loop ((n n) (b (car bs)) (bs (cdr bs)) (xs '())) (if (zero? n) (reverse xs) (let ((new-bs (append bs (list (apply f b bs))))) (loop (- n 1) (car new-bs) (cdr new-bs) (cons b xs)))))) (define fibs (iterate 20 + 1 1)) (define (scan-left op base xs) (define (scan base xs) (if (null? xs) (list) (scan-left op (op base (car xs)) (cdr xs)))) (cons base (scan base xs))) (define sums (cdr (scan-left + 0 fibs))) (define (restarts n) (define (max-less-or-equal n xs) (let loop ((prev 0) (xs xs)) (if (< n (car xs)) prev (loop (car xs) (cdr xs))))) (let loop ((n n) (r 0)) (if (zero? n) r (loop (- n (max-less-or-equal n sums)) (+ r 1))))) ; https://p...content-available-to-author-only...s.com/2016/12/20/highly-abundant-numbers (define (records lt? xs) ; index and value at each new maximum (if (null? xs) (error 'records "no data") (let loop ((xs (cdr xs)) (k 1) (recs (list (cons 0 (car xs))))) (if (null? xs) (reverse recs) (if (lt? (cdar recs) (car xs)) (loop (cdr xs) (+ k 1) (cons (cons k (car xs)) recs)) (loop (cdr xs) (+ k 1) recs)))))) (define (fib n) (define (square x) (* x x)) (cond ((zero? n) 0) ((or (= n 1) (= n 2)) 1) ((even? n) (let* ((n2 (quotient n 2)) (n2-1 (- n2 1))) (* (fib n2) (+ (* 2 (fib n2-1)) (fib n2))))) (else (let* ((n2-1 (quotient n 2)) (n2 (+ n2-1 1))) (+ (square (fib n2-1)) (square (fib n2))))))) (define (fibonacho n) (- (fib (+ n n 1)) n)) (display fibs) (newline) (display sums) (newline) (display (restarts 227)) (newline) (for-each (lambda (idx/val) (display (cdr idx/val)) (display " ") (display (+ (car idx/val) 1)) (newline)) (records < (map restarts (range 1 1000)))) (display (map fibonacho (range 1 50))) (newline)