74 lines
2.4 KiB
Racket
74 lines
2.4 KiB
Racket
#lang mzscheme
|
|
|
|
#|
|
|
|
|
This script constructs the contents of the problems directory
|
|
from the solutions directory. This process merely consists of
|
|
reading in each file in the solutions directory (based on the
|
|
directory file) and rewriting it into the format described
|
|
in ...
|
|
|
|
|#
|
|
|
|
(require mzlib/match)
|
|
|
|
;; shrink-file : string -> string
|
|
(define (shrink-file filename)
|
|
(printf "shrinking ~a..." filename)
|
|
(flush-output)
|
|
(let ([shrunk (shrink-set (call-with-input-file (build-path 'up "solution-sets" filename) read))])
|
|
(call-with-output-file (build-path 'up "problems" filename)
|
|
(lambda (port)
|
|
(write shrunk port))))
|
|
(printf "done\n"))
|
|
|
|
;; shrink-set sexp[set] -> sexp[set]
|
|
(define (shrink-set set)
|
|
(match set
|
|
[`(unit/sig paint-by-numbers:problem-set^
|
|
(import paint-by-numbers:problem^)
|
|
|
|
(define set-name ,set-name)
|
|
|
|
(define problems (list ,problems ...)))
|
|
`(unit/sig paint-by-numbers:problem-set^
|
|
(import paint-by-numbers:problem^)
|
|
|
|
(define set-name ,set-name)
|
|
|
|
(define problems (list ,@(map shrink-problem problems))))]))
|
|
|
|
;; shrink-problem : sexp[problem] -> sexp[problem]
|
|
(define (shrink-problem problem)
|
|
(match problem
|
|
[`(make-problem ,name ,rows ,cols ',solution)
|
|
`(make-problem ,name ,rows ,cols ',(shrink-solution solution))]))
|
|
|
|
;; shrink-soution : (union #f (vectorof (vectorof (union 'on 'off 'unknown))))
|
|
;; -> (union #f (listof string))
|
|
;; produces the data in a representation that is much smaller when written
|
|
(define (shrink-solution soln)
|
|
(and soln
|
|
(map (lambda (line)
|
|
(apply string (map (lambda (x)
|
|
(case x
|
|
[(on) #\x]
|
|
[(off) #\space]
|
|
[(unknown) #\U]))
|
|
(vector->list line))))
|
|
(vector->list soln))))
|
|
|
|
|
|
;; erase old contents of the solutions directory
|
|
(for-each
|
|
(lambda (file) (when (file-exists? (build-path 'up "problems" file))
|
|
(delete-file (build-path 'up "problems" file))))
|
|
(directory-list (build-path 'up "problems")))
|
|
|
|
(copy-file (build-path 'up "solution-sets" "directory")
|
|
(build-path 'up "problems" "directory"))
|
|
|
|
(provide main)
|
|
(define (main)
|
|
(for-each shrink-file (call-with-input-file (build-path 'up "problems" "directory") read)))
|