commit 7ae8812ef5d92841c4bdb7d4eee59212720aa946 parent 12d44643bf756c24cd03640f9cb365d15bfb36ff Author: Yuval Langer <yuval.langer@gmail.com> Date: Wed, 15 Nov 2023 02:04:40 +0200 Rewrite the "statistics" library. Diffstat:
| M | sicp/statistics.scm | | | 188 | ++++++++++++++++++++++++++++++++++++++++--------------------------------------- |
1 file changed, 95 insertions(+), 93 deletions(-)
diff --git a/sicp/statistics.scm b/sicp/statistics.scm @@ -1,107 +1,109 @@ -(define-module (sicp statistics) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:use-module (ice-9 ftw) - #:use-module (ice-9 match) - #:use-module (ice-9 pretty-print) - #:use-module (ice-9 regex) - #:use-module (ice-9 textual-ports) - ) +(define-library (sicp statistics) + (import (guile) + (srfi srfi-1) + (srfi srfi-26) + (srfi srfi-42) + (srfi srfi-43) + (ice-9 ftw) + (ice-9 match) + (ice-9 pretty-print) + (ice-9 regex) + (ice-9 textual-ports)) -(define (get-chapter-exercise-number-pair s) - (cons (string->number (substring s 0 1)) - (string->number (substring s 2)))) + (begin + (define number-of-exercises '(46 97 82 79 52)) -(define (get-exercise-numbers port) - (define (iter result) - (let ([current-line (get-line port)]) - (if (eof-object? current-line) - result - (iter (cons (get-chapter-exercise-number-pair current-line) - result))))) + (define (make-solution-filename chapter-number exercise-number) + (format #f "./sicp/solutions/chapter-~A/exercise-~A.scm" + chapter-number + exercise-number)) - (iter '())) + (define (make-test-filename chapter-number exercise-number) + (format #f "./sicp/tests/chapter-~A/exercise-~A.scm" + chapter-number + exercise-number)) -(define exercise-numbers - (with-input-from-file "sicp-exercise-number-list.txt" - (lambda () - (get-exercise-numbers (current-input-port))))) + (define (make-test-log-filename chapter-number exercise-number) + (format #f "./chapter-~A-exercise-~A.log" + chapter-number + exercise-number)) -(define (get-chapter-exercise-number-pair s) - (let* ([numbers-match (string-match "[0-9]_[0-9]+" s)]) - (if numbers-match - (let ([substring-location (vector-ref numbers-match 1)]) - (let ([x (substring s - (car substring-location) - (cdr substring-location))]) - (let ([our-pair (map string->number (string-split x #\_))]) - (cons (car our-pair) - (cadr our-pair))))) - #f))) + (define (missing-solution? chapter-number exercise-number) + (let ((solution-filename (make-solution-filename chapter-number exercise-number))) + (not (file-exists? solution-filename)))) -(define get-solution-files-numbers - (match-lambda - ((name stat) (get-chapter-exercise-number-pair name)) - ((name stat children ...) - (map get-solution-files-numbers - children)))) + (define (missing-tests? chapter-number exercise-number) + (let ((test-filename (make-test-filename chapter-number exercise-number))) + (not (file-exists? test-filename)))) -(define solution-files-numbers - (filter identity - (get-solution-files-numbers (file-system-tree "sicp/solutions/")))) + (define (failing-test-log? chapter-number exercise-number) + (let ((test-log-filename (make-test-log-filename chapter-number exercise-number))) + (if (file-exists? test-log-filename) + (let ((retval (system* "grep" "-q" "fail" test-log-filename))) + (zero? retval)) + #f))) -(sort - (lset-difference equal? - exercise-numbers - solution-files-numbers) - (lambda (x y) (or (< (car y) - (car y)) - (< (cdr x) - (cdr x))))) + (define (erroring-test-log? chapter-number exercise-number) + (let ((test-log-filename (make-test-log-filename chapter-number exercise-number))) + (if (file-exists? test-log-filename) + (let ((retval (system* "grep" "-q" "error" test-log-filename))) + (zero? retval)) + #f))) -(define (sort-number-list l) - (sort l - (lambda (x y) (or (< (car x) - (car y)) - (and (= (car x) - (car y)) - (< (cdr x) - (cdr y))))))) + (define (make-range a b) + (cons (min a b) + (max a b))) -(for-each (lambda (x) - (format #t "Unsolved: ~a.~a\n" (car x) (cdr x))) - (sort-number-list - (lset-difference equal? - exercise-numbers - solution-files-numbers))) + (define (range-low range) + (car range)) -(define (split-into-lines s) - (string-split s #\newline)) + (define (range-high range) + (cdr range)) -(define (match-and-filter-XXX-lines lines) - (map (cut vector-ref <> 0) - (filter identity - (map (cut string-match "XXX" <>) - lines)))) + (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))))))) -(define (filename-got-XXX? filename) - (if (file-exists? filename) - (with-input-from-file filename - (lambda () (let ([matches ((compose match-and-filter-XXX-lines - split-into-lines) - (get-string-all (current-input-port)))]) - (if (null? matches) - #f - (list filename matches))))) - #f)) + (define (print-ranges predicate? message) + (for-each (lambda (chapter-ranges) + (format #t message + (car chapter-ranges)) + (for-each (lambda (range) + (if (= (range-low range) + (range-high range)) + (format #t "Exercise ~A~%" (range-low range)) + (format #t "Exercises ~A-~A~%" (range-low range) (range-high range)))) + (cdr chapter-ranges))) + (list-ec (: chapter-number 1 6) + (cons chapter-number + (make-ranges + (list-ec (: exercise-number 1 (1+ (list-ref number-of-exercises + (1- chapter-number)))) + (if (predicate? chapter-number exercise-number)) + exercise-number)))))) -(for-each (lambda (x) (format #t "Solution file has an XXX: ~a\n" x)) - (filter identity - (map filename-got-XXX? - (map (lambda (x) - (string-append "sicp/solutions/" - (number->string (car x)) - "_" - (number->string (cdr x)) - ".scm")) - solution-files-numbers)))) + (print-ranges missing-solution? + "Missing solutions files of chapter ~A:~%") + (print-ranges missing-tests? + "Missing tests files of chapter ~A:~%") + (print-ranges failing-test-log? + "Failing test logs of chapter ~A:~%") + (print-ranges erroring-test-log? + "Errors in test logs of chapter ~A:~%")))