I removed some silly mistakes and changed the sum to be calculated during sequence
. According to my amateurish measurements it reduced the runtime to around 80% of the previous version.
(use-modules (ice-9 q))
(define (sequence n)
(let* ((rs (make-q)) ; Queue of R values.
(ss (make-q)) ; Queue of S values.
(r 7) ; Current R value.
(s 5) ; Current S value.
(len 1) ; Length of queues.
(negsum -7) ; Negative sum of R queue.
(pos 3) ; Smallest n in the queues.
(n (- n 1))) ; Off by one.
(enq! rs r)
(enq! ss s)
(let loop ((i 4))
(when (<= (+ s r) (+ i n))
(set! r (+ r s))
(set! s (+ s 1))
(set! negsum (- negsum r))
(when (= s (q-front rs))
(set! negsum (+ negsum s))
(set! s (+ s 1))
(set! len (- len 1))
(set! pos (+ pos 1))
(deq! ss)
(deq! rs))
(enq! rs r)
(enq! ss s)
(loop (+ i 1))))
(list pos len negsum (cadr rs) (cadr ss))))
(define (sum m n)
(* (/ (- m n -1) 2) (+ m n)))
(define (jump n)
(cond
((= n 1) 1)
((= n 2) 3)
((= n 3) 7)
((= n 4) 12)
(else
(let* ((seq (sequence n))
(m (list-ref seq 0))
(l (list-ref seq 1))
(ns (list-ref seq 2))
(r' (list-ref seq 3))
(s' (list-ref seq 4))
(n' (+ m l -1))
(s (+ s' (- n n') l)))
(+ r' (sum (- s 1) s') ns)))))
I have Guile 3.0.0 and statprof
does not crash for me, it just complains that it has a hard time making sense of the stack. It still produces some output but I am not sure if it can be trusted.
>>129
Here, this version should work with Guile, Chez Scheme and Chicken.
(define (sequence n)
(let* ((rs 7) ; Smallest R value unused.
(ss (let ((n (list 5))) ; Queue of S values.
(cons n n)))
(r 7) ; Current R value.
(s 5) ; Current S value.
(negsum -7) ; Negative sum of unused R values.
(pos 3) ; Smallest n in the queues.
(n (- n 1))) ; Off by one.
(let loop ((i 4))
(when (<= (+ s r) (+ i n))
(set! r (+ r s))
(set! s (+ s 1))
(set! negsum (- negsum r))
(when (= s rs)
(set! rs (+ rs (caar ss)))
(set! negsum (+ negsum s))
(set! s (+ s 1))
(set! pos (+ pos 1))
(set-car! ss (cdar ss)))
(let ((n (list s)))
(set-cdr! (cdr ss) n)
(set-cdr! ss n))
(loop (+ i 1))))
(list pos negsum r (cadr ss))))
(define (sum m n)
(* (/ (- m n -1) 2) (+ m n)))
(define (jump n)
(cond
((= n 1) 1)
((= n 2) 3)
((= n 3) 7)
((= n 4) 12)
(else
(let* ((seq (sequence n))
(m (list-ref seq 0))
(ns (list-ref seq 1))
(rx (list-ref seq 2))
(sx (list-ref seq 3))
(nx (+ m -1))
(s (+ sx (- n nx))))
(+ rx (sum (- s 1) sx) ns)))))
Both perform better on R(10^13) but slow down soon after.
>>126
You might want to run a benchmark that actually stresses bigints. At least for my case, R(10^13) spends at least 80% of its time in GC. If I turn off the GC (GC_DONT_GC=0 guile hofstadter.scm
) it is much faster, but at R(10^15), memory consumption blows up.
>>130
I "compressed" the unused S values. Not much improvement in terms of order of growth though.
(define (sequence n)
(let* ((rs 7) ; Smallest R value unused.
(ss (let ((n (list 7))) ; S skip queue.
(cons n n)))
(sl 5) ; Smalles S value unused.
(r 7) ; Current R value.
(s 5) ; Current S value.
(negsum -7) ; Negative sum of unused R values.
(pos 3) ; Smallest n in the queues.
(n (- n 1))) ; Off by one.
(let loop ((i 4))
(when (<= (+ s r) (+ i n))
(set! r (+ r s))
(set! s (+ s 1))
(set! negsum (- negsum r))
(when (= s rs)
(set! rs (+ rs sl))
(set! sl (+ sl 1))
(when (= sl (caar ss))
(set! sl (+ sl 1))
(set-car! ss (cdar ss)))
(set! negsum (+ negsum s))
(set! s (+ s 1))
(set! pos (+ pos 1))
(let ((n (list rs)))
(set-cdr! (cdr ss) n)
(set-cdr! ss n)))
(loop (+ i 1))))
(list pos negsum r s)))
(define (sum m n)
(* (/ (- m n -1) 2) (+ m n)))
(define (jump n)
(cond
((= n 1) 1)
((= n 2) 3)
((= n 3) 7)
((= n 4) 12)
(else
(let* ((seq (sequence n))
(m (list-ref seq 0))
(ns (list-ref seq 1))
(rx (list-ref seq 2))
(sx (list-ref seq 3))
(nx (+ m -1))
(s (+ sx (- n nx))))
(+ rx (sum (- s 1) sx) ns)))))