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

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

  1. include <stddef.h>
  2. 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;

}</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 ) )
   if a == nil then return false end
   idx = tab[1][a + 1]
   for i = 2, #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

Works with: Rakudo version 2017.05

<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

}

  1. 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
Retrieved from "https://rosettacode.org/wiki/Damm_algorithm?oldid=276074"