Damm algorithm

From Rosetta Code
Damm algorithm is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

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[edit]

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
Output:
check digit of 5724 is valid
check digit of 5727 is invalid
check digit of 112946 is valid

C[edit]

#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;
}
 
int main() {
unsigned char input[4] = {5, 7, 2, 4};
puts(damm(input, 4) ? "Checksum correct" : "Checksum incorrect");
return 0;
}

Clojure[edit]

(def 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]])
 
(defn damm? [digits]
(= 0 (reduce #(nth (nth tbl %1) %2) 0
(map #(Character/getNumericValue %) (seq digits)))))
Output:
=> (damm? "5724")
true
=> (damm? "5727")
false
=> (damm? "112946")
true

Fortran[edit]

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. The continuation column has the (apparent) row count, but row zero can't have the digit zero in the continuation column as this is taken to be equivalent to a space (meaning "no continuation") just in case it is used for the first line of a statement to be continued. However, the letter o will do instead. A capital O looks too much like a 0...

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.
      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 digit should 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

Output:

 T 5724
 F 5727
 T 112946

J[edit]

Solution:

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

Example Usage:

   checkDamm&> 5724 5727 112946
1 0 1

Kotlin[edit]

// version 1.1.2
 
val table = arrayOf(
intArrayOf(0, 3, 1, 7, 5, 9, 8, 6, 4, 2),
intArrayOf(7, 0, 9, 2, 1, 5, 4, 8, 6, 3),
intArrayOf(4, 2, 0, 6, 8, 7, 1, 3, 5, 9),
intArrayOf(1, 7, 5, 0, 9, 8, 3, 4, 2, 6),
intArrayOf(6, 1, 2, 3, 0, 4, 5, 9, 7, 8),
intArrayOf(3, 6, 7, 4, 2, 0, 9, 5, 8, 1),
intArrayOf(5, 8, 6, 9, 7, 2, 0, 1, 3, 4),
intArrayOf(8, 9, 4, 5, 3, 6, 2, 0, 1, 7),
intArrayOf(9, 4, 3, 8, 6, 1, 7, 2, 0, 5),
intArrayOf(2, 5, 8, 1, 4, 3, 6, 7, 9, 0)
)
 
fun damm(s: String): Boolean {
var interim = 0
for (c in s) interim = table[interim][c - '0']
return interim == 0
}
 
fun main(args: Array<String>) {
val numbers = intArrayOf(5724, 5727, 112946, 112949)
for (number in numbers) {
val isValid = damm(number.toString())
println("${"%6d".format(number)} is ${if (isValid) "valid" else "invalid"}")
}
}
Output:
  5724 is valid
  5727 is invalid
112946 is valid
112949 is invalid

Lua[edit]

 
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
 
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[edit]

Works with: Rakudo version 2017.05
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."
}
Output:
5724:	Checksum digit correct.
5727:	Checksum digit incorrect.
112946:	Checksum digit correct.

Python[edit]

 
#!/usr/bin/env python2
matrix = (
(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)
)
input = raw_input()
def checkdigit(input):
row = 0
for eachdigit in input:
row = matrix[row][int(eachdigit)]
return row
output = checkdigit(input)
print str(input)+str(output)
 

Racket[edit]

#lang racket/base
(require racket/match)
 
(define operation-table
#(#(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)))
 
(define (integer->digit-list n)
(let loop ((n n) (a null))
(if (zero? n) a (let-values (([q r] (quotient/remainder n 10))) (loop q (cons r a))))))
 
(define/match (check-digit n)
[((list ds ...))
(foldl
(λ (d interim)
(vector-ref (vector-ref operation-table interim) d))
0 ds)]
[((? integer? i))
(check-digit (integer->digit-list i))])
 
(define/match (valid-number? n)
[((? integer? i))
(valid-number? (integer->digit-list i))]
[((list ds ...))
(zero? (check-digit ds))])
 
(module+ test
(require rackunit)
(check-equal? (integer->digit-list 572) '(5 7 2))
(check-equal? (check-digit 572) 4)
(check-equal? (check-digit '(5 7 2)) 4)
(check-true (valid-number? 5724))
(check-false (valid-number? 5274))
(check-true (valid-number? 112946)))

No output from checks means that all tests passed.

REXX[edit]

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
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)

Ruby[edit]

 
def dammCheck( nbr )
idx = 0
for i in 0 .. nbr.length - 1
a = nbr[i].to_i
if a == nil then return false end
idx = @table[idx][a]
end
print( "this number is " )
if idx == 0; print( "valid!" )
else print( "invalid!" )
end
puts
end
 
@table = Array.new(
[
[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]
]
)
 
while true
print( "Number to check: " )
dammCheck( gets.chomp )
end
 
Output:

Number to check: 5724 this number is valid! Number to check: 5727 this number is invalid! Number to check: 112940 this number is invalid! Number to check: 112946 this number is valid! Number to check: 1321 this number is valid!

Sidef[edit]

func damm(digits) {
static 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],
]
 
 !digits.reduce({|row,col| tbl[row][col] }, 0)
}
 
for n in [5724, 5727, 112946] {
say "#{n}:\tChecksum digit #{ damm(n.digits) ? '' : 'in'}correct."
}
Output:
5724:	Checksum digit correct.
5727:	Checksum digit incorrect.
112946:	Checksum digit correct.

zkl[edit]

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)
}
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
Output:
True
False
True