Damm algorithm
The Damm algorithm is a checksum algorithm which detects all single digit errors and adjacent transposition errors. The task is to verify the checksum, stored as last digit of an input.
ALGOL 68
<lang algol68>BEGIN
# returns TRUE if the check digit of s is correct according to the Damm algorithm, #
# FALSE otherwise #
PROC has valid damm check digit = ( STRING s )BOOL:
BEGIN
# operation table - as per wikipedia example #
[,]INT operation table =
( [,]INT( ( 0, 3, 1, 7, 5, 9, 8, 6, 4, 2 )
, ( 7, 0, 9, 2, 1, 5, 4, 8, 6, 3 )
, ( 4, 2, 0, 6, 8, 7, 1, 3, 5, 9 )
, ( 1, 7, 5, 0, 9, 8, 3, 4, 2, 6 )
, ( 6, 1, 2, 3, 0, 4, 5, 9, 7, 8 )
, ( 3, 6, 7, 4, 2, 0, 9, 5, 8, 1 )
, ( 5, 8, 6, 9, 7, 2, 0, 1, 3, 4 )
, ( 8, 9, 4, 5, 3, 6, 2, 0, 1, 7 )
, ( 9, 4, 3, 8, 6, 1, 7, 2, 0, 5 )
, ( 2, 5, 8, 1, 4, 3, 6, 7, 9, 0 )
)
) [ AT 0, AT 0 ]
;
INT interim digit := 0;
FOR s pos FROM LWB s TO UPB s DO
INT next digit = ABS s[ s pos ] - ABS "0";
IF next digit < 0 OR next digit > 9 THEN
# invalid digit #
print( ( "Invalid damm digit: ", s[ s pos ], newline ) );
stop
ELSE
# have a valid digit #
interim digit := operation table[ interim digit, next digit ]
FI
OD;
interim digit = 0
END # has valid damm check digit # ;
# test the damm algorithm #
PROC test damm algorithm = ( STRING s, BOOL expected )VOID:
BEGIN
BOOL valid = has valid damm check digit( s );
print( ( "check digit of ", s, " is "
, IF valid THEN "valid" ELSE "invalid" FI
, IF valid = expected THEN "" ELSE " *** NOT AS EXPECTED" FI
, newline
)
)
END # test damm algorithm # ;
# test cases - as per other language samples #
test damm algorithm( "5724", TRUE );
test damm algorithm( "5727", FALSE );
test damm algorithm( "112946", TRUE )
END</lang>
- Output:
check digit of 5724 is valid check digit of 5727 is invalid check digit of 112946 is valid
C
<lang c>#include <stdbool.h>
- include <stddef.h>
- include <stdio.h>
bool damm(unsigned char *input, size_t length) {
static const unsigned char table[10][10] = {
{0, 3, 1, 7, 5, 9, 8, 6, 4, 2},
{7, 0, 9, 2, 1, 5, 4, 8, 6, 3},
{4, 2, 0, 6, 8, 7, 1, 3, 5, 9},
{1, 7, 5, 0, 9, 8, 3, 4, 2, 6},
{6, 1, 2, 3, 0, 4, 5, 9, 7, 8},
{3, 6, 7, 4, 2, 0, 9, 5, 8, 1},
{5, 8, 6, 9, 7, 2, 0, 1, 3, 4},
{8, 9, 4, 5, 3, 6, 2, 0, 1, 7},
{9, 4, 3, 8, 6, 1, 7, 2, 0, 5},
{2, 5, 8, 1, 4, 3, 6, 7, 9, 0},
};
unsigned char interim = 0;
for (size_t i = 0; i < length; i++) {
interim = table[interim][input[i]];
}
return interim == 0;
}
Fortran
Thanks to the ability standardised in F90 to define an array with a lower bound other than one, this can be achieved without the need for annoying offsets, as in A(I + 1) instead of just A(I). However, right from the start, Fortran has stored arrays in column-major order, so statements that initialise two-dimensional arrays via a list of consecutive values can look odd when they are nicely laid out, because they will have to be be in transposed order. Alternatively, if the layout is the same as the expected (row,column) usage, the actual usage of the array will have to be (column,row). Rather than transpose a ten by ten matrix, this is the approach here.
Possibly a more useful function would be one that returned the check digit that must be appended to a sequence to provide the full sequence, as when preparing a checksummed sequence for output. For checking input, such a function would be applied to all but the last digit of the suspect sequence, and its result compared to the supplied last digit. But for simplicity here, all that is reported is "good" or "bad", without hints as to what would have been good. <lang> Fortran> LOGICAL FUNCTION DAMM(DIGIT) !Check that a sequence of digits checks out.. Calculates according to the method of H. Michael Damm, described in 2004.
CHARACTER*(*) DIGIT !A sequence of digits only.
INTEGER*1 OPTABLE(0:9,0:9) !The special "Operation table" of the method.
PARAMETER (OPTABLE = (/ !A set of constants...
o 0, 3, 1, 7, 5, 9, 8, 6, 4, 2, ! CAREFUL!
1 7, 0, 9, 2, 1, 5, 4, 8, 6, 3, !Fortran stores arrays in column-major order.
2 4, 2, 0, 6, 8, 7, 1, 3, 5, 9, !Despite the manifest row and column layout apparent here
3 1, 7, 5, 0, 9, 8, 3, 4, 2, 6, !This sequence of consecutive items will go into storage order.
4 6, 1, 2, 3, 0, 4, 5, 9, 7, 8, !The table resulting from this sequence of constants
5 3, 6, 7, 4, 2, 0, 9, 5, 8, 1, !Will appear to be transposed if referenced as (row,column)
6 5, 8, 6, 9, 7, 2, 0, 1, 3, 4, !What appears to be row=6 column=1 (counting from zero)
7 8, 9, 4, 5, 3, 6, 2, 0, 1, 7, !is to be accessed as OPTABLE(1,6) = 8, not OPTABLE(6,1)
8 9, 4, 3, 8, 6, 1, 7, 2, 0, 5, !Storage order is (0,0), (1,0), (2,0), ... (9,0)
9 2, 5, 8, 1, 4, 3, 6, 7, 9, 0/)) !Followed by (0,1), (1,1), (2,1), ... (9,1)
INTEGER I,D,ID !Assistants.
ID = 0 !Here we go.
DO I = 1,LEN(DIGIT) !Step through the text.
D = ICHAR(DIGIT(I:I)) - ICHAR("0") !Convert to an integer. (ASCII or EBCDIC)
IF (D.LT.0 .OR. D.GT.9) STOP "DAMM! Not a digit!" !This shouldn't happen!
ID = OPTABLE(D,ID) !Transposed: D is the column index and ID the row.
END DO !On to the next.
DAMM = ID .EQ. 0 !Somewhere, a check digits shoulkd ensure this.
END FUNCTION DAMM !Simple, fast, and alas, rarely used.
LOGICAL DAMM !Not a default type.
WRITE (6,*) DAMM("5724"),"5724"
WRITE (6,*) DAMM("5727"),"5727"
WRITE (6,*) DAMM("112946"),"112946"
END </lang>
Output:
T 5724 F 5727 T 112946
int main() {
unsigned char input[4] = {5, 7, 2, 4};
puts(damm(input, 4) ? "Checksum correct" : "Checksum incorrect");
return 0;
}</lang>
J
Solution: <lang j>OpTbl=: _99 ". ];._2 noun define 0 3 1 7 5 9 8 6 4 2 7 0 9 2 1 5 4 8 6 3 4 2 0 6 8 7 1 3 5 9 1 7 5 0 9 8 3 4 2 6 6 1 2 3 0 4 5 9 7 8 3 6 7 4 2 0 9 5 8 1 5 8 6 9 7 2 0 1 3 4 8 9 4 5 3 6 2 0 1 7 9 4 3 8 6 1 7 2 0 5 2 5 8 1 4 3 6 7 9 0 )
getdigits=: 10&#.inv
getDamm=: verb define
row=. 0
for_digit. getdigits y do.
row=. OpTbl {~ <row,digit
end.
)
checkDamm=: 0 = getDamm</lang> Example Usage: <lang j> checkDamm&> 5724 5727 112946 1 0 1</lang>
Lua
<lang lua> local tab = {
{0,3,1,7,5,9,8,6,4,2}, {7,0,9,2,1,5,4,8,6,3},
{4,2,0,6,8,7,1,3,5,9}, {1,7,5,0,9,8,3,4,2,6},
{6,1,2,3,0,4,5,9,7,8}, {3,6,7,4,2,0,9,5,8,1},
{5,8,6,9,7,2,0,1,3,4}, {8,9,4,5,3,6,2,0,1,7},
{9,4,3,8,6,1,7,2,0,5}, {2,5,8,1,4,3,6,7,9,0}
} function check( n )
local idx, a = 0, tonumber( n:sub( 1, 1 ) )
for i = 1, #n do
a = tonumber( n:sub( i, i ) )
if a == nil then return false end
idx = tab[idx + 1][a + 1]
end
return idx == 0
end local n, r while( true ) do
io.write( "Enter the number to check: " ) n = io.read(); if n == "0" then break end r = check( n ); io.write( n, " is " ) if not r then io.write( "in" ) end io.write( "valid!\n" )
end </lang>
- Output:
Enter the number to check: 5724 5724 is valid! Enter the number to check: 5727 5727 is invalid! Enter the number to check: 112946 112946 is valid! Enter the number to check: 0
Perl 6
<lang perl6>sub damm ( *@digits ) {
my @tbl = [0, 3, 1, 7, 5, 9, 8, 6, 4, 2],
[7, 0, 9, 2, 1, 5, 4, 8, 6, 3],
[4, 2, 0, 6, 8, 7, 1, 3, 5, 9],
[1, 7, 5, 0, 9, 8, 3, 4, 2, 6],
[6, 1, 2, 3, 0, 4, 5, 9, 7, 8],
[3, 6, 7, 4, 2, 0, 9, 5, 8, 1],
[5, 8, 6, 9, 7, 2, 0, 1, 3, 4],
[8, 9, 4, 5, 3, 6, 2, 0, 1, 7],
[9, 4, 3, 8, 6, 1, 7, 2, 0, 5],
[2, 5, 8, 1, 4, 3, 6, 7, 9, 0];
my $row = 0;
for @digits -> $col { $row = @tbl[$row][$col] }
not $row
}
- Testing
for 5724, 5727, 112946 {
say "$_:\tChecksum digit { damm( $_.comb ) ?? !! 'in' }correct."
}</lang>
- Output:
5724: Checksum digit correct. 5727: Checksum digit incorrect. 112946: Checksum digit correct.
REXX
<lang rexx>Call init Call test 5724 Call test 5727 Call test 112946 Call test 112940 Exit
test: Parse Arg number int_digit=0 Do p=1 To length(number)
d=substr(number,p,1) int_digit=grid.int_digit.d If p<length(number) Then cd=int_digit End
If int_digit=0 Then
Say number 'is ok'
Else
Say number 'is not ok, check-digit should be' cd '(instead of' d')'
Return
init: i=-2 Call setup '* 0 1 2 3 4 5 6 7 8 9' Call setup '0 0 3 1 7 5 9 8 6 4 2' Call setup '1 7 0 9 2 1 5 4 8 6 3' Call setup '2 4 2 0 6 8 7 1 3 5 9' Call setup '3 1 7 5 0 9 8 3 4 2 6' Call setup '4 6 1 2 3 0 4 5 9 7 8' Call setup '5 3 6 7 4 2 0 9 5 8 1' Call setup '6 5 8 6 9 7 2 0 1 3 4' Call setup '7 8 9 4 5 3 6 2 0 1 7' Call setup '8 9 4 3 8 6 1 7 2 0 5' Call setup '9 2 5 8 1 4 3 6 7 9 0' Return setup:
Parse Arg list i=i+1 Do col=-1 To 9 grid.i.col=word(list,col+2) End Return</lang>
- Output:
5724 is ok 5727 is not ok, check-digit should be 4 (instead of 7) 112946 is ok 112940 is not ok, check-digit should be 6 (instead of 0)
zkl
<lang zkl>fcn damm(digits){ // digits is something that supports an iterator of integers
var [const] tbl=Data(0,Int, // 10x10 byte bucket
0, 3, 1, 7, 5, 9, 8, 6, 4, 2,
7, 0, 9, 2, 1, 5, 4, 8, 6, 3,
4, 2, 0, 6, 8, 7, 1, 3, 5, 9,
1, 7, 5, 0, 9, 8, 3, 4, 2, 6,
6, 1, 2, 3, 0, 4, 5, 9, 7, 8,
3, 6, 7, 4, 2, 0, 9, 5, 8, 1,
5, 8, 6, 9, 7, 2, 0, 1, 3, 4,
8, 9, 4, 5, 3, 6, 2, 0, 1, 7,
9, 4, 3, 8, 6, 1, 7, 2, 0, 5,
2, 5, 8, 1, 4, 3, 6, 7, 9, 0);
0 == digits.reduce(fcn(interim,digit){ tbl[interim*10 + digit] },0)
}</lang> <lang zkl>damm(List(5,7,2,4)).println(); // True damm(Data(0,Int,5,7,2,7).howza(0)).println(); // stream bytes, False damm((112946).split()).println(); // True</lang>
- Output:
True False True