learning-sicp

commit 77d3ca3eae65eea2e77be66e6cbf41aadeddd165
parent 7ae8812ef5d92841c4bdb7d4eee59212720aa946
Author: Yuval Langer <yuval.langer@gmail.com>
Date:   Thu, 16 Nov 2023 16:27:07 +0200

Mark statistics Makefile target as a PHONY target and change make-ranges implementation.

Diffstat:
M
Makefile
 | 
1
+
M
sicp/statistics.scm
 | 
52
+++++++++++++++++++++++++++++++++-------------------

2 files changed, 34 insertions(+), 19 deletions(-)
diff --git a/Makefile b/Makefile
@@ -12,5 +12,6 @@ print_variables:
 $(tests_results): $(tests)
 	guile -L . `printf $@ | sed -E 's#(chapter-[0-9]*)-(exercise-[0-9]+).log#sicp/tests/\1/\2.scm#g'`
 
+.PHONY: statistics
 statistics:
 	guile -L . sicp/statistics.scm
diff --git a/sicp/statistics.scm b/sicp/statistics.scm
@@ -51,35 +51,49 @@
             #f)))
 
     (define (make-range a b)
-      (cons (min a b)
+      (list (min a b)
             (max a b)))
 
     (define (range-low range)
       (car range))
 
     (define (range-high range)
-      (cdr range))
+      (cadr range))
+
+    (define (pair-consecutives lst)
+      (reverse
+       (fold (lambda (val acc)
+               (match acc
+                 (()
+                  `((,val)))
+                 (`((,x) . ,rest)
+                  `((,x ,val) . ,rest))
+                 (`((,x ,y) . ,rest)
+                  `((,val) ,(make-range x y) . ,rest))))
+             '()
+             lst)))
 
     (define (make-ranges ordered-integers)
       (if (null? ordered-integers)
           '()
-          (let loop ((ordered-integers (cdr ordered-integers))
-                     (ranges (list (make-range (car ordered-integers)
-                                               (car ordered-integers)))))
-            (cond
-             ((null? ordered-integers)
-              (reverse ranges))
-             ((= (car ordered-integers)
-                 (1+ (range-high (car ranges))))
-              (loop (cdr ordered-integers)
-                    (cons (make-range (range-low (car ranges))
-                                      (1+ (range-high (car ranges))))
-                          (cdr ranges))))
-             (else
-              (loop (cdr ordered-integers)
-                    (cons (make-range (car ordered-integers)
-                                      (car ordered-integers))
-                          ranges)))))))
+          (let* ((consecutive-pairs-of-integers
+                  (zip (cdr ordered-integers)
+                       ordered-integers))
+                 (consecutive-differences
+                  (map (lambda (pair-of-integers)
+                         (- (car pair-of-integers)
+                            (cadr pair-of-integers)))
+                       consecutive-pairs-of-integers))
+                 (bigger-than-1-jumps
+                  (filter (lambda (x) (> (cadr x) 1))
+                          (zip consecutive-pairs-of-integers
+                               consecutive-differences)))
+                 (only-the-integers
+                  (map car
+                       bigger-than-1-jumps)))
+            (pair-consecutives (append (list (car ordered-integers))
+                                       (apply append only-the-integers)
+                                       (list (last ordered-integers)))))))
 
     (define (print-ranges predicate? message)
       (for-each (lambda (chapter-ranges)