commit 88d130a96008956c4f49c513eccb86b9788a4d1a parent 7c75afe0425d350ac1db2cd09c499145a851ccfc Author: Yuval Langer <yuval.langer@gmail.com> Date: Tue, 11 Apr 2023 20:52:25 +0300 Add "statistics". Diffstat:
M | Makefile | | | 3 | +++ |
A | sicp/statistics.scm | | | 98 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 101 insertions(+), 0 deletions(-)
diff --git a/Makefile b/Makefile @@ -1,6 +1,9 @@ poop: echo poop +statistics: + guile -L . sicp/statistics.scm + 3.6: guile -L . sicp/tests/3_6.scm diff --git a/sicp/statistics.scm b/sicp/statistics.scm @@ -0,0 +1,98 @@ +(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 (get-chapter-exercise-number-pair s) + (cons (string->number (substring s 0 1)) + (string->number (substring s 2)))) + +(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))))) + + (iter '())) + +(define exercise-numbers + (with-input-from-file "sicp-exercise-number-list.txt" + (lambda () + (get-exercise-numbers (current-input-port))))) + +(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 get-solution-files-numbers + (match-lambda + ((name stat) (get-chapter-exercise-number-pair name)) + ((name stat children ...) + (map get-solution-files-numbers + children)))) + +(define solution-files-numbers + (filter identity + (get-solution-files-numbers (file-system-tree "sicp/solutions/")))) + +'(display solution-files-numbers) + +(sort + (lset-difference equal? + exercise-numbers + solution-files-numbers) + (lambda (x y) (or (< (car y) + (car y)) + (< (cdr x) + (cdr x))))) + +(define (sort-number-list l) + (sort l + (lambda (x y) (or (< (car x) + (car y)) + (and (= (car x) + (car y)) + (< (cdr x) + (cdr y))))))) + +(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 (filename-got-XXX? filename) + (if (file-exists? filename) + (with-input-from-file filename + (lambda () (if (string-match "XXX" + (get-string-all (current-input-port))) + filename + #f))) + #f)) + +(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))))