[ prog / sol / mona ]

prog


LISP Puzzles

123 2020-05-20 19:40

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.

130 2020-05-20 21:25

>>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.

136 2020-05-21 07:05 *

>>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)))))
157


VIP:

do not edit these