114 lines
3.7 KiB
Racket
114 lines
3.7 KiB
Racket
#lang racket
|
|
(define (img-01string->vector str)
|
|
(define lines (regexp-split "\n" str))
|
|
(define h (length lines))
|
|
(define w (if (zero? h) 0 (string-length (car lines))))
|
|
(define v (for*/vector #:length (* w h)
|
|
((l (in-list lines)) (p (in-string l)))
|
|
(match p (#\0 0) (#\1 1) (#\# 1) (#\. 0))))
|
|
(values v h w))
|
|
|
|
; Task (2) asks for "or an ASCII-art image of space/non-space characters."
|
|
; Spaces don't really impress where the borders are, so we'll use a dot.
|
|
(define cell->display-char (match-lambda (0 ".") (1 "#") (else "?")))
|
|
|
|
(define (display-img v w)
|
|
(for ((p (in-vector v)) (col (in-naturals)))
|
|
(printf "~a" (cell->display-char p))
|
|
(when (= (modulo col w) (sub1 w)) (newline))))
|
|
|
|
; returns vector of ([P1's idx] P1 P2 ... P9)
|
|
(define (Pns v w r c)
|
|
(define i (+ c (* r w)))
|
|
(define-syntax-rule (vi+ x) (vector-ref v (+ i x)))
|
|
(define-syntax-rule (vi- x) (vector-ref v (- i x)))
|
|
(vector i (vi+ 0) (vi- w) (vi+ (- 1 w))
|
|
(vi+ 1) (vi+ (+ w 1)) (vi+ w)
|
|
(vi+ (- w 1)) (vi- 1) (vi- (+ w 1))))
|
|
|
|
; Second argument to in-vector is the start offset;
|
|
; We skip offset 0 (idx) and 1 (P1)
|
|
(define (B Ps) (for/sum ((Pn (in-vector Ps 2))) Pn))
|
|
|
|
(define (A Ps)
|
|
(define P2 (vector-ref Ps 2))
|
|
(define-values (rv _)
|
|
(for/fold ((acc 0) (Pn-1 P2))
|
|
((Pn (in-sequences (in-vector Ps 3) (in-value P2))))
|
|
(values (+ acc (if (and (= 0 Pn-1) (= 1 Pn)) 1 0)) Pn)))
|
|
rv)
|
|
|
|
(define-syntax-rule (not-all-black? Pa Pb Pc) (zero? (* Pa Pb Pc)))
|
|
(define (z-s-thin v h w)
|
|
; return idx when thin necessary, #f otherwise
|
|
(define (thin? Ps n/bour-check-1 n/bour-check-2)
|
|
(match-define (vector idx P1 P2 _ P4 _ P6 _ P8 _) Ps)
|
|
(and (= P1 1) (<= 2 (B Ps) 6) (= (A Ps) 1)
|
|
(n/bour-check-1 P2 P4 P6 P8)
|
|
(n/bour-check-2 P2 P4 P6 P8)
|
|
idx))
|
|
|
|
(define (has-white?-246 P2 P4 P6 P8) (not-all-black? P2 P4 P6))
|
|
(define (has-white?-468 P2 P4 P6 P8) (not-all-black? P4 P6 P8))
|
|
(define (has-white?-248 P2 P4 P6 P8) (not-all-black? P2 P4 P8))
|
|
(define (has-white?-268 P2 P4 P6 P8) (not-all-black? P2 P6 P8))
|
|
(define (step-n even-Pn-check-1 even-Pn-check-2)
|
|
(for*/list ((r (in-range 1 (- h 1)))
|
|
(c (in-range 1 (- w 1)))
|
|
(idx (in-value (thin? (Pns v w r c)
|
|
even-Pn-check-1
|
|
even-Pn-check-2)))
|
|
#:when idx) idx))
|
|
|
|
(define (step-1) (step-n has-white?-246 has-white?-468))
|
|
(define (step-2) (step-n has-white?-248 has-white?-268))
|
|
(define (inner-z-s-thin)
|
|
(define changed-list-1 (step-1))
|
|
(for ((idx (in-list changed-list-1))) (vector-set! v idx 0))
|
|
(define changed-list-2 (step-2))
|
|
(for ((idx (in-list changed-list-2))) (vector-set! v idx 0))
|
|
(unless (and (null? changed-list-1) (null? changed-list-2)) (inner-z-s-thin)))
|
|
(inner-z-s-thin))
|
|
|
|
(define (read-display-thin-display-image img-str)
|
|
(define-values (v h w) (img-01string->vector img-str))
|
|
(printf "Original image:~%") (display-img v w)
|
|
(z-s-thin v h w)
|
|
(printf "Thinned image:~%") (display-img v w))
|
|
|
|
(define e.g.-image #<<EOS
|
|
00000000000000000000000000000000
|
|
01111111110000000111111110000000
|
|
01110001111000001111001111000000
|
|
01110000111000001110000111000000
|
|
01110001111000001110000000000000
|
|
01111111110000001110000000000000
|
|
01110111100000001110000111000000
|
|
01110011110011101111001111011100
|
|
01110001111011100111111110011100
|
|
00000000000000000000000000000000
|
|
EOS
|
|
)
|
|
|
|
(define e.g.-image/2 #<<EOS
|
|
##..###
|
|
##..###
|
|
##..###
|
|
##..###
|
|
##..##.
|
|
##..##.
|
|
##..##.
|
|
##..##.
|
|
##..##.
|
|
##..##.
|
|
##..##.
|
|
##..##.
|
|
######.
|
|
.......
|
|
EOS
|
|
)
|
|
|
|
(module+ main
|
|
; (read-display-thin-display-image e.g.-image/2)
|
|
; (newline)
|
|
(read-display-thin-display-image e.g.-image))
|