mod10 Algorithm

Charlie Bursell

unread,

May 30, 2012, 3:27:18 PM5/30/12

to

Has anyone implemented the mod10 check digit algorithm in Tcl? If so would you be kind enough to post a copy

Thks

Andreas Leitgeb

unread,

May 30, 2012, 4:35:21 PM5/30/12

to

Charlie Bursell <cbur...@geusnet.com> wrote:
> Has anyone implemented the mod10 check digit algorithm in Tcl?
> If so would you be kind enough to post a copy

Not sure, I understand what you mean. What's wrong with

set x 42
set lastDigit [expr {$x % 10}] ;# -> 2

?

Aric Bills

unread,

May 30, 2012, 5:40:57 PM5/30/12

to

On Wednesday, May 30, 2012 1:27:18 PM UTC-6, Charlie Bursell wrote:
> Has anyone implemented the mod10 check digit algorithm in Tcl? If so would you be kind enough to post a copy
>
> Thks

Google turned up the following:

http://rosettacode.org/wiki/Luhn_test_of_credit_card_numbers#Tcl
https://devcentral.f5.com/weblogs/joe/archive/2005/07/18/1388.aspx

Andreas Kupries

unread,

May 31, 2012, 12:06:48 AM5/31/12

to

Tcllib has a few checkdigit validation algorithms. Maybe what you are
looking for is present also. And if not, consider contributing your
code, once you have some.

http://docs.activestate.com/activetcl/8.5/tcllib/toc.html
Look for 'valtype'.

valtype::common Validation, common code
valtype::creditcard::amex Validation for AMEX creditcard number
valtype::creditcard::discover Validation for Discover creditcard number
valtype::creditcard::mastercard Validation for Mastercard creditcard number
valtype::creditcard::visa Validation for VISA creditcard number
valtype::gs1::ean13 Validation for EAN13
valtype::iban Validation for IBAN
valtype::imei Validation for IMEI
valtype::isbn Validation for ISBN
valtype::luhn Validation for plain number with a LUHN checkdigit
valtype::luhn5 Validation for plain number with a LUHN5 checkdigit
valtype::usnpi Validation for USNPI
valtype::verhoeff Validation for plain number with a VERHOEFF checkdigit

--
So long,
Andreas Kupries <akup...@shaw.ca>
<http://www.purl.org/NET/akupries/>
Developer @ <http://www.activestate.com/>

http://www.eurotcl.tcl3d.org/ - EuroTcl 2012, July 7-8, Munich, Germany.
http://www.tcl.tk/community/tcl2012/ - Tcl'2012, Nov 12-16, Chicago, IL, USA.
-------------------------------------------------------------------------------

Charlie Bursell

unread,

May 31, 2012, 9:08:39 AM5/31/12

to

On Wednesday, May 30, 2012 2:27:18 PM UTC-5, Charlie Bursell wrote:
> Has anyone implemented the mod10 check digit algorithm in Tcl? If so would you be kind enough to post a copy
>
> Thks

Thanks for the replies. I finally remember that I wrote one of these back in 1999. Here is what I came up with: (How do I add an attachment?)

###########################################################################
# compute_ mod10.tcl
#
# Calulates the Mod 10 check digit of a number IAW with HL7 standard 2.2
# Page 2-11
#
#
# Algorithm - Assume you have an identifier = 12345. Take the odd digit
# position starting from the right, i.e., 531, multiply this number by 2
# to get 1062. Take the even digit positions, starting from the right
# (i.e., 42), prepend these to the 1062 to get 421062. Add all of these
# six digit together to get 15. Subtract this number from the next higher
# multiple of 10, i.e., 20 - 15 to get 5. The Mod10 check digit is 5.
#
###########################################################################

proc compute_mod10 {num} {

#
# Remove leading zeros. They do not affect calculation and will cut
# down on times through loop. Then make a list of number and reverse
# the order.
#
set num [string trimleft $num 0] ;# Input number w/o leading zeros
set numlist [split $num ""] ;# Numbers in a list
set revnum "" ;# Holds reversed numbers
#
# Reverse the numbers since we must accumulate from right
#
while {$numlist ne ""} {lvarpush revnum [lvarpop numlist]}
#
# Set Odd/even flag. If the length is even, we start with even
# else we start with odd
#
set ODDFLAG 1

set odd "" ;# Stores Odd numbers
set even "" ;# Stores even numbers
#
# Loop through reversed numbers and get odd and even positions
#
foreach digit $revnum {
if {$ODDFLAG} {
append odd $digit
} else {
append even $digit
}
set ODDFLAG [expr $ODDFLAG ^ 1] ;# Flip flag
}
if {$odd eq ""} {set odd 0} ;# Just in case
if {$even eq ""} {set even 0} ;# Just in case
#
# Muliply odd by 2 and prepend to even
#
append even [expr {[string trimleft $odd 0] * 2}]
set newnum [split $even ""] ;# Numbers to list
set total 0 ;# Accumulator
#
# Add all digits together
#
foreach digit $newnum { incr total $digit }
#
# Subtract from next highest multiple of 10
# Return that value
#
set diff [expr {$total % 10}]
if {$diff} {set diff [expr {10 - $diff}]}
set next10 [expr {$total + $diff}]

# Return mod10 value
return [expr {$next10 - $total}]
}

Harald Oehlmann

unread,

Jun 1, 2012, 3:05:47 AM6/1/12

to

Here is my version of the 1-3-1 weighted mod 10 used in EAN/UCC/GS-1
Bar Codes:

proc parse::parseCheckEAN In {
set Sum 0
set Pos [string length $In]
set fWeight 0
while { $Pos > 0 } {
incr Pos -1
set Num [string index $In $Pos]
incr Sum $Num
if {$fWeight} {
set fWeight 0
} else {
incr Sum $Num
incr Sum $Num
set fWeight 1
}
}
return [expr { ( 10 - ( $Sum % 10 ) ) % 10 } ]
}
---
Remember that "mod 10" is not sufficient as specification.
You should say:
- how the numbers are weighted: 1-3-1-3
- If the modulo itself or the remainder to the modulo is searched.
Here, it is the remainder.

-Harald

Andreas Kupries

unread,

Jun 5, 2012, 12:36:41 AM6/5/12

to

Harald Oehlmann <wort...@yahoo.de> writes:

> Here is my version of the 1-3-1 weighted mod 10 used in EAN/UCC/GS-1
> Bar Codes:
>
> proc parse::parseCheckEAN In {

See also the implementation of
http://docs.activestate.com/activetcl/8.5/tcllib/valtype/ean13.html