UPC: Difference between revisions

4,161 bytes added ,  2 years ago
Line 2,312:
=={{header|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}}
 
<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}}==
569

edits