UPC: Difference between revisions
Content added Content deleted
(→{{header|Racket}}: stub) |
|||
Line 2,312: | Line 2,312: | ||
=={{header|Racket}}== |
=={{header|Racket}}== |
||
<lang racket> |
<lang 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))</lang> |
|||
{{out}} |
{{out}} |
||
<pre>(9 2 4 7 7 3 2 7 1 0 1 9) |
|||
<pre></pre> |
|||
(4 0 3 9 4 4 4 4 1 0 5 0) |
|||
(upside-down 8 3 4 9 9 9 6 7 6 7 0 6) |
|||
(upside-down 9 3 9 8 2 5 1 5 8 8 1 1) |
|||
#f |
|||
(upside-down 3 1 6 3 1 3 7 1 8 7 1 7) |
|||
(2 1 4 5 7 5 8 7 5 6 0 8) |
|||
(upside-down 8 1 8 7 7 8 8 4 1 8 1 3) |
|||
(7 0 6 4 6 6 7 4 3 0 3 0) |
|||
(6 5 3 4 8 3 5 4 0 4 3 5) |
|||
invalid: (checksum (9 9 4 7 7 3 2 7 1 0 1 9))</pre> |
|||
=={{header|Raku}}== |
=={{header|Raku}}== |