82 lines
3.7 KiB
Racket
82 lines
3.7 KiB
Racket
|
#lang racket
|
|||
|
|
|
|||
|
|
;; inspired by Kotlin
|
|||
|
|
|
|||
|
|
(define (is-#? c) (char=? c #\#))
|
|||
|
|
|
|||
|
|
(define left-digits
|
|||
|
|
(for/hash ((i (in-naturals))
|
|||
|
|
(c '((#f #f #t #t #f)
|
|||
|
|
(#f #t #t #f #f)
|
|||
|
|
(#f #t #f #f #t)
|
|||
|
|
(#t #t #t #t #f)
|
|||
|
|
(#t #f #f #f #t)
|
|||
|
|
(#t #t #f #f #f)
|
|||
|
|
(#t #f #t #t #t)
|
|||
|
|
(#t #t #t #f #t)
|
|||
|
|
(#t #t #f #t #t)
|
|||
|
|
(#f #f #t #f #t))))
|
|||
|
|
(values `(#f ,@c #t) i)))
|
|||
|
|
|
|||
|
|
(define right-digits (for/hash (([k v] left-digits)) (values (map not k) v)))
|
|||
|
|
|
|||
|
|
(define (lookup-blocks bits hsh fail)
|
|||
|
|
(let recur ((bs bits) (r null))
|
|||
|
|
(if (null? bs)
|
|||
|
|
(reverse r)
|
|||
|
|
(let-values (((bs′ tl) (split-at bs 7)))
|
|||
|
|
(let ((d (hash-ref hsh bs′ (λ () (fail (list 'not-found bs′))))))
|
|||
|
|
(recur tl (cons d r)))))))
|
|||
|
|
|
|||
|
|
(define (extract-blocks b fail)
|
|||
|
|
(let*-values
|
|||
|
|
(((e-l-m-r-e) (map is-#? (string->list (string-trim b))))
|
|||
|
|
((_) (unless (= (length e-l-m-r-e) (+ 3 (* 7 6) 5 (* 7 6) 3))
|
|||
|
|
(fail 'wrong-length)))
|
|||
|
|
((e l-m-r-e) (split-at e-l-m-r-e 3))
|
|||
|
|
((_) (unless (equal? e '(#t #f #t)) (fail 'left-sentinel)))
|
|||
|
|
((l-m-r e) (split-at-right l-m-r-e 3))
|
|||
|
|
((_) (unless (equal? e '(#t #f #t)) (fail 'right-sentinel)))
|
|||
|
|
((l m-r) (split-at l-m-r 42))
|
|||
|
|
((m r) (split-at m-r 5))
|
|||
|
|
((_) (unless (equal? m '(#f #t #f #t #f)) (fail 'mid-sentinel))))
|
|||
|
|
(values l r)))
|
|||
|
|
|
|||
|
|
(define (upc-checksum? ds)
|
|||
|
|
(zero? (modulo (for/sum ((m (in-cycle '(3 1))) (d ds)) (* m d)) 10)))
|
|||
|
|
|
|||
|
|
(define (lookup-digits l r fail (transform values))
|
|||
|
|
(let/ec fail-lookups
|
|||
|
|
(define ds (append (lookup-blocks l left-digits (λ _ (fail-lookups #f)))
|
|||
|
|
(lookup-blocks r right-digits (λ _ (fail-lookups #f)))))
|
|||
|
|
(if (upc-checksum? ds)
|
|||
|
|
(transform ds)
|
|||
|
|
(fail (list 'checksum (transform ds))))))
|
|||
|
|
|
|||
|
|
(define (decode-upc barcode upside-down fail)
|
|||
|
|
(define-values (l r) (extract-blocks barcode fail))
|
|||
|
|
(or (lookup-digits l r fail)
|
|||
|
|
(lookup-digits (reverse r) (reverse l) fail upside-down)))
|
|||
|
|
|
|||
|
|
(define (report-upc barcode)
|
|||
|
|
(displayln (decode-upc barcode
|
|||
|
|
(λ (v) (cons 'upside-down v))
|
|||
|
|
(λ (e) (format "invalid: ~s" e)))))
|
|||
|
|
|
|||
|
|
(define (UPC)
|
|||
|
|
(for-each report-upc
|
|||
|
|
'(" # # # ## # ## # ## ### ## ### ## #### # # # ## ## # # ## ## ### # ## ## ### # # # "
|
|||
|
|
" # # # ## ## # #### # # ## # ## # ## # # # ### # ### ## ## ### # # ### ### # # # "
|
|||
|
|
" # # # # # ### # # # # # # # # # # ## # ## # ## # ## # # #### ### ## # # "
|
|||
|
|
" # # ## ## ## ## # # # # ### # ## ## # # # ## ## # ### ## ## # # #### ## # # # "
|
|||
|
|
" # # ### ## # ## ## ### ## # ## # # ## # # ### # ## ## # # ### # ## ## # # # "
|
|||
|
|
" # # # # ## ## # # # # ## ## # # # # # #### # ## # #### #### # # ## # #### # # "
|
|||
|
|
" # # # ## ## # # ## ## # ### ## ## # # # # # # # # ### # # ### # # # # # "
|
|||
|
|
" # # # # ## ## # # ## ## ### # # # # # ### ## ## ### ## ### ### ## # ## ### ## # # "
|
|||
|
|
" # # ### ## ## # # #### # ## # #### # #### # # # # # ### # # ### # # # ### # # # "
|
|||
|
|
" # # # #### ## # #### # # ## ## ### #### # # # # ### # ### ### # # ### # # # ### # # "
|
|||
|
|
; first element again, with corrupted second digit
|
|||
|
|
" # # # ## # ## # ## ### ## ### ## #### # # # ## ## # # ## ## ### # ## ## ### # # # ")))
|
|||
|
|
|
|||
|
|
(module+ main (UPC))
|