Scheme (R7RS+SRFI) でマイナンバーのチェックデジットを計算する

流行っているようで Gauche 版も登場していたので、よりポータブルに R7RS で書きました。 SRFI-1 と SRFI-13 もサポートしている処理系でないと動かないので、Gauche と Sagittarius くらいしかなくて結局それほどポータブルというわけでもなかったりするのですが。

mynumber.scm

(import (scheme base)
        (scheme write)
        (scheme char)
        (srfi 1)
        (srfi 13))

(define (mynumber-assert p)
  (unless (string? p)
    (error "string required, but" p))
  (unless (= (string-length p) 12)
    (error "string of length 12 required, but" p))
  (unless (string-every digit-value p)
    (error "every elements of string must be digit, but" p)))  

(define (mynumber-checkdigit p)
  (let ((d (- 11
              (modulo (fold (lambda(pn qn a) (+ a (* pn qn)))
                            0
                            (map digit-value (string->list p))
                            '(6 5 4 3 2 7 6 5 4 3 2))
                      11))))
    (if (< 9 d) 0 d)))

(define (mynumber-validate? p)
  (mynumber-assert p)
  (= (digit-value (string-ref p 11))
     (mynumber-checkdigit p)))

;; test case
(for-each (lambda (x)
            (display x)
            (display " : ")
            (display (mynumber-validate? x))
            (newline))
          '("123456789010"
            "123456789011"
            "123456789012"
            "123456789013"
            "123456789014"
            "123456789015"
            "123456789016"
            "123456789017"
            "123456789018"
            "123456789019"
            "023456789013"))

入力が文字列ではなく数値で与えられる場合も考えてみました。 こちらは R7RS の範囲内だけで書いたのでより多くの処理系でそのまま使えます。 Gauche, Sagittarius, Larceny, Chibi, Foment で動作することを確認できています。

mynumber.scm

(import (scheme base)
        (scheme write))

(define (mynumber-validate? p)
  (unless (integer? p) (error "integer required" p))
  (let ((check-digit (modulo p 10)))
    (do ((r (quotient p 10) (quotient r 10))
         (c 0 (+ c (* (modulo r 10) (vector-ref '#(2 3 4 5 6 7 2 3 4 5 6) i))))
         (i 0 (+ i 1)))
        ((= i 11)
         (unless (= r 0) (error "number is too large" p))
         (let ((d (- 11 (modulo c 11))))
           (= (if (< 9 d) 0 d) check-digit))))))

;; test case
(for-each (lambda (x)
            (display x)
            (display " : ")
            (display (mynumber-validate? x))
            (newline))
          '(123456789010
            123456789011
            123456789012
            123456789013
            123456789014
            123456789015
            123456789016
            123456789017
            123456789018
            123456789019
            23456789013))