1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
# # ## ### ##### ######## ############# ######################
## Verhoeff test of numbers
#
# The Verhoeff test is similar to the Luhn test to compute and verify
# check digits of identifier numbers, albeit quite a bit stronger,
# i.e. detecting more possible keying errors.
#
# References
#
# # ## ### ##### ######## ############# ######################
# The code below implements the interface of a snit validation type,
# making it directly usable with snit's -type option in option
# specifications.
# # ## ### ##### ######## ############# ######################
## Requisites
package require Tcl 8.5
package require snit
package require valtype::common
# # ## ### ##### ######## ############# ######################
## Implementation
namespace eval ::valtype::verhoeff {
namespace import ::valtype::common::*
}
snit::type ::valtype::verhoeff {
#-------------------------------------------------------------------
# Type Methods
typemethod validate {value {code VERHOEFF}} {
if {[regexp {[^0-9]} $value]} {
badchar $code "$code number, expected only digits"
}
# Verhoeff test.
set sum [Sum $value 0]
if {$sum != 0} {
badcheck $code "$code number"
}
return $value
}
typemethod checkdigit {value {code VERHOEFF}} {
if {[regexp {[^0-9]} $value]} {
badchar $code "$code number, expected only digits"
}
# Compute the verhoeff checkdigit. First sum the digits as
# usual. Note that we start with position 1, as the check
# digit will go into position 0.
#return [INVERS [Sum $value 1]]
return [lindex $ourinv [Sum $value 1]]
}
proc Sum {value step} {
# 8.5 required for lreverse.
#
# Compute the verhoeff checkdigit. First sum the digits as
# usual. Note that we start with position 1 for checkdigit
# calculation, as the check digit will go into position 0.
set sum 0
foreach ch [lreverse [split $value {}]] {
#set sum [OP $sum [F step $ch]]
# inlined below:
set sum [lindex $ourop $sum [lindex $ourf $step $ch]]
incr step ; if {$step == 8} { set step 0}
}
return $sum
}
#-------------------------------------------------------------------
# Constructor
# None needed; no options
#-------------------------------------------------------------------
# Public Methods
method validate {value} {
$type validate $value
}
#-------------------------------------------------------------------
# Operations in D5, and the helper permutations F^k, k in {0,...,7}.
#proc OP {a b} { return [lindex $ourop $a $b] }
#proc INVERS {a} { return [lindex $ourinv $a] }
#proc F {k x} { return [lindex $ourf $k $x] }
typevariable ourop {
{0 1 2 3 4 5 6 7 8 9}
{1 2 3 4 0 6 7 8 9 5}
{2 3 4 0 1 7 8 9 5 6}
{3 4 0 1 2 8 9 5 6 7}
{4 0 1 2 3 9 5 6 7 8}
{5 9 8 7 6 0 4 3 2 1}
{6 5 9 8 7 1 0 4 3 2}
{7 6 5 9 8 2 1 0 4 3}
{8 7 6 5 9 3 2 1 0 4}
{9 8 7 6 5 4 3 2 1 0}
}
typevariable ourinv {0 4 3 2 1 5 6 7 8 9}
typevariable ourf {
{0 1 2 3 4 5 6 7 8 9}
{1 5 7 6 2 8 3 0 9 4}
{5 8 0 3 7 9 6 1 4 2}
{8 9 1 6 0 4 3 5 2 7}
{9 4 5 3 1 2 6 8 7 0}
{4 2 8 6 5 7 3 9 0 1}
{2 7 9 3 8 0 6 4 1 5}
{7 0 4 6 9 1 3 2 5 8}
}
}
# # ## ### ##### ######## ############# ######################
## Ready
package provide valtype::verhoeff 1
|
