Data update

This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions

View file

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

View file

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

View file

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

View file

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

View file

@ -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=&nbsp; 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