Data update
This commit is contained in:
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -4,20 +4,17 @@ BEGIN
|
|||
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 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 )
|
||||
);
|
||||
INT interim digit := 0;
|
||||
FOR s pos FROM LWB s TO UPB s DO
|
||||
INT next digit = ABS s[ s pos ] - ABS "0";
|
||||
|
|
@ -27,7 +24,7 @@ BEGIN
|
|||
stop
|
||||
ELSE
|
||||
# have a valid digit #
|
||||
interim digit := operation table[ interim digit, next digit ]
|
||||
interim digit := operation table[ interim digit + 1, next digit + 1 ]
|
||||
FI
|
||||
OD;
|
||||
interim digit = 0
|
||||
|
|
@ -44,7 +41,7 @@ BEGIN
|
|||
)
|
||||
)
|
||||
END # test damm algorithm # ;
|
||||
# test cases - as per other language samples #
|
||||
# test cases #
|
||||
test damm algorithm( "5724", TRUE );
|
||||
test damm algorithm( "5727", FALSE );
|
||||
test damm algorithm( "112946", TRUE )
|
||||
|
|
|
|||
|
|
@ -1,39 +0,0 @@
|
|||
with Ada.Text_IO;
|
||||
|
||||
procedure Damm_Algorithm is
|
||||
|
||||
function Damm (Input : in String) return Boolean
|
||||
is
|
||||
subtype Digit is Character range '0' .. '9';
|
||||
|
||||
Table : constant array (Digit, Digit) of Digit :=
|
||||
(('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'));
|
||||
Intern : Digit := '0';
|
||||
begin
|
||||
for D of Input loop
|
||||
Intern := Table (Intern, D);
|
||||
end loop;
|
||||
return Intern = '0';
|
||||
end Damm;
|
||||
|
||||
procedure Put_Damm (Input : in String) is
|
||||
use Ada.Text_IO;
|
||||
begin
|
||||
Put_Line ("Damm of " & Input & " validates as " & Damm (Input)'Image);
|
||||
end Put_Damm;
|
||||
|
||||
begin
|
||||
Put_Damm ("5724");
|
||||
Put_Damm ("5727");
|
||||
Put_Damm ("112946");
|
||||
Put_Damm ("112949");
|
||||
end Damm_Algorithm;
|
||||
|
|
@ -1,32 +1,73 @@
|
|||
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.
|
||||
module damm_algorithm
|
||||
implicit none
|
||||
private
|
||||
public :: damm_check ! Expose only the damm_check function to external code
|
||||
|
||||
LOGICAL DAMM !Not a default type.
|
||||
contains
|
||||
|
||||
WRITE (6,*) DAMM("5724"),"5724"
|
||||
WRITE (6,*) DAMM("5727"),"5727"
|
||||
WRITE (6,*) DAMM("112946"),"112946"
|
||||
!---------------------------------------------------------------------
|
||||
! Function: damm_check
|
||||
! Purpose : Validates a digit string using the Damm algorithm
|
||||
! Input : digit - a character string of numeric digits ('0' to '9')
|
||||
! Output : is_valid - .TRUE. if the check digit validates, .FALSE. otherwise
|
||||
!---------------------------------------------------------------------
|
||||
function damm_check(digit) result(is_valid)
|
||||
use iso_fortran_env, only: int8 ! Use portable 8-bit integer type
|
||||
character(len=*), intent(in) :: digit
|
||||
logical :: is_valid
|
||||
integer(kind=int8) :: i, d, id
|
||||
|
||||
!------------------------------------------------------------------
|
||||
! Damm operation table: a 10x10 quasigroup matrix used for validation
|
||||
! Note: Fortran stores arrays in column-major order, meaning that
|
||||
! array constructors fill columns first, not rows.
|
||||
! To preserve the intended row-wise layout of the table,
|
||||
! we use TRANSPOSE(RESHAPE(...)) to correct the orientation.
|
||||
!------------------------------------------------------------------
|
||||
integer(kind=int8), parameter :: optable(0:9, 0:9) = transpose(reshape( &
|
||||
[integer(kind=int8) :: &
|
||||
0, 3, 1, 7, 5, 9, 8, 6, 4, 2, & ! Row 0
|
||||
7, 0, 9, 2, 1, 5, 4, 8, 6, 3, & ! Row 1
|
||||
4, 2, 0, 6, 8, 7, 1, 3, 5, 9, & ! Row 2
|
||||
1, 7, 5, 0, 9, 8, 3, 4, 2, 6, & ! Row 3
|
||||
6, 1, 2, 3, 0, 4, 5, 9, 7, 8, & ! Row 4
|
||||
3, 6, 7, 4, 2, 0, 9, 5, 8, 1, & ! Row 5
|
||||
5, 8, 6, 9, 7, 2, 0, 1, 3, 4, & ! Row 6
|
||||
8, 9, 4, 5, 3, 6, 2, 0, 1, 7, & ! Row 7
|
||||
9, 4, 3, 8, 6, 1, 7, 2, 0, 5, & ! Row 8
|
||||
2, 5, 8, 1, 4, 3, 6, 7, 9, 0 ], & ! Row 9
|
||||
shape=[10, 10])) ! Reshape into 10x10, then transpose to fix layout
|
||||
|
||||
! Initialize the interim digit to zero
|
||||
id = 0
|
||||
|
||||
! Loop over each character in the input string
|
||||
do i = 1, len(digit)
|
||||
! Convert character to integer digit (ASCII math)
|
||||
d = iachar(digit(i:i)) - iachar('0')
|
||||
|
||||
! Validate that the character is a digit
|
||||
if (d < 0 .or. d > 9) then
|
||||
error stop 'Invalid input: Not a digit in string'
|
||||
end if
|
||||
|
||||
! Apply Damm algorithm step: lookup in the operation table
|
||||
id = optable(id, d)
|
||||
end do
|
||||
|
||||
! Final check: if result is zero, the input is valid
|
||||
is_valid = (id == 0)
|
||||
end function damm_check
|
||||
|
||||
end module damm_algorithm
|
||||
|
||||
program test_damm
|
||||
use damm_algorithm
|
||||
implicit none
|
||||
|
||||
write(*, '(A,L1,A)') 'Damm check for "5724": ', damm_check('5724'), ' (should be .TRUE.)'
|
||||
write(*, '(A,L1,A)') 'Damm check for "5727": ', damm_check('5727'), ' (should be .FALSE.)'
|
||||
write(*, '(A,L1,A)') 'Damm check for "112946": ', damm_check('112946'), ' (should be .TRUE.)'
|
||||
write(*, '(A,L1,A)') 'Damm check for "112949": ', damm_check('112949'), ' (should be .FALSE.)'
|
||||
end program test_damm
|
||||
END
|
||||
|
|
|
|||
|
|
@ -1,25 +0,0 @@
|
|||
$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)
|
||||
)
|
||||
|
||||
function Test-Damm([string]$s) {
|
||||
$interim = 0
|
||||
foreach ($c in $s.ToCharArray()) {
|
||||
$interim = $table[$interim][[int]$c - [int][char]'0']
|
||||
}
|
||||
return $interim -eq 0
|
||||
}
|
||||
|
||||
foreach ($number in 5724, 5727, 112946, 112949) {
|
||||
$validity = if (Test-Damm $number) {'valid'} else {'invalid'}
|
||||
'{0,6} is {1}' -f $number, $validity
|
||||
}
|
||||
|
|
@ -15,11 +15,4 @@ Damm:
|
|||
If z=d Then Say ' valid checksum digit ' z " for " x
|
||||
Else Say ' invalid checksum digit ' z " for " x ' (should be' d")"
|
||||
End /*j*/
|
||||
Return /syntaxhighlight>
|
||||
{{out|output|text= when using the (internal) default inputs:}}
|
||||
<pre>
|
||||
valid checksum digit 4 for 5724
|
||||
invalid checksum digit 7 for 5727 (should be 4)
|
||||
valid checksum digit 6 for 112946
|
||||
invalid checksum digit 0 for 112940 (should be 6)
|
||||
</pre>
|
||||
Return
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue