statistics.scm (5136B)
1 (define-library (sicp statistics) 2 (import (guile) 3 (srfi srfi-1) 4 (srfi srfi-26) 5 (srfi srfi-42) 6 (srfi srfi-43) 7 (ice-9 ftw) 8 (ice-9 match) 9 (ice-9 pretty-print) 10 (ice-9 regex) 11 (ice-9 textual-ports)) 12 (export 13 make-ranges 14 main) 15 16 17 (begin 18 (define number-of-exercises '(46 97 82 79 52)) 19 20 (define (make-solution-filename chapter-number exercise-number) 21 (format #f "./sicp/solutions/chapter-~A/exercise-~A.scm" 22 chapter-number 23 exercise-number)) 24 25 (define (make-test-filename chapter-number exercise-number) 26 (format #f "./sicp/tests/chapter-~A/exercise-~A.scm" 27 chapter-number 28 exercise-number)) 29 30 (define (make-test-log-filename chapter-number exercise-number) 31 (format #f "./chapter-~A-exercise-~A.log" 32 chapter-number 33 exercise-number)) 34 35 (define (missing-solution? chapter-number exercise-number) 36 (let ((solution-filename (make-solution-filename chapter-number exercise-number))) 37 (not (file-exists? solution-filename)))) 38 39 (define (missing-tests? chapter-number exercise-number) 40 (let ((test-filename (make-test-filename chapter-number exercise-number))) 41 (not (file-exists? test-filename)))) 42 43 (define (grep-q filename term) 44 (if (file-exists? filename) 45 (let ((retval (system* "grep" "-q" "XXX" filename))) 46 (zero? retval)) 47 #f)) 48 49 (define (failing-test-log? chapter-number exercise-number) 50 (grep-q (make-test-log-filename chapter-number exercise-number) 51 "fail")) 52 53 (define (XXX? chapter-number exercise-number) 54 (grep-q (make-solution-filename chapter-number exercise-number) 55 "XXX")) 56 57 (define (TODO? chapter-number exercise-number) 58 (grep-q (make-test-log-filename chapter-number exercise-number) 59 "TODO")) 60 61 (define (erroring-test-log? chapter-number exercise-number) 62 (grep-q (make-test-log-filename chapter-number exercise-number) 63 "error")) 64 65 (define (make-range a b) 66 (list (min a b) 67 (max a b))) 68 69 (define (range-low range) 70 (car range)) 71 72 (define (range-high range) 73 (cadr range)) 74 75 (define (pair-consecutives lst) 76 (reverse 77 (fold (lambda (val acc) 78 (match acc 79 (() 80 `((,val))) 81 (`((,x) . ,rest) 82 `((,x ,val) . ,rest)) 83 (`((,x ,y) . ,rest) 84 `((,val) ,(make-range x y) . ,rest)))) 85 '() 86 lst))) 87 88 (define (make-ranges ordered-integers) 89 (if (null? ordered-integers) 90 '() 91 (let* ((consecutive-pairs-of-integers 92 (zip (cdr ordered-integers) 93 ordered-integers)) 94 (consecutive-differences 95 (map (lambda (pair-of-integers) 96 (- (car pair-of-integers) 97 (cadr pair-of-integers))) 98 consecutive-pairs-of-integers)) 99 (bigger-than-1-jumps 100 (filter (lambda (x) (> (cadr x) 1)) 101 (zip consecutive-pairs-of-integers 102 consecutive-differences))) 103 (only-the-integers 104 (map car 105 bigger-than-1-jumps))) 106 (pair-consecutives (append (list (car ordered-integers)) 107 (apply append only-the-integers) 108 (list (last ordered-integers))))))) 109 110 (define (print-ranges predicate? message) 111 (for-each (lambda (chapter-ranges) 112 (format #t message 113 (car chapter-ranges)) 114 (for-each (lambda (range) 115 (if (= (range-low range) 116 (range-high range)) 117 (format #t "Exercise ~A~%" (range-low range)) 118 (format #t "Exercises ~A-~A~%" (range-low range) (range-high range)))) 119 (cdr chapter-ranges))) 120 (list-ec (: chapter-number 1 6) 121 (cons chapter-number 122 (make-ranges 123 (list-ec (: exercise-number 1 (1+ (list-ref number-of-exercises 124 (1- chapter-number)))) 125 (if (predicate? chapter-number exercise-number)) 126 exercise-number)))))) 127 128 (define (main args) 129 (print-ranges missing-solution? 130 "Missing solutions files of chapter ~A:~%") 131 (print-ranges missing-tests? 132 "Missing tests files of chapter ~A:~%") 133 (print-ranges failing-test-log? 134 "Failing test logs of chapter ~A:~%") 135 (print-ranges erroring-test-log? 136 "Errors in test logs of chapter ~A:~%"))))