UIC vehicle number validator

Richard Suchenwirth 1999-11-11 - Member railroads of the UIC (Union internationale des chemins de fer), mostly in Europe, identify goods and passenger cars by 12-digit numbers which indicate category, exchange status, owner, type etc. Some railroads also use 7- or 8-digit numbers for locomotives. In both types, the final digit (separated by a dash) is a check digit (see Check digits) that allows plausibility tests:

The cross-sum of the 12 or 7 digits multiplied alternating by 1 or 2 (starting with 1 at the rightmost digit) must be a multiple of 10, e.g. for validating the number 21 80 155 9 084-5:

        2   1   8   0   1   5   5   9   0   8   4   5
 *      2   1   2   1   2   1   2   1   2   1   2   1
 ----------------------------------------------------
        4   1  16   0   2   5  10   9   0   8   8   5
        4  +1+1+6  +0  +2  +5+1+0  +9  +0  +8  +8  +5 = 50, o.k.

The Tcl code for this validation removes all non-digits, so can be called with the complete car inscriptions like

   21 RIV
   80 DB
   155 9 084-5

 proc uic:valid {s} {
        regsub -all {[^0-9]} $s "" no
        set length [string length $no]
        if {$length!=12 && $length!=7 && $length!=8} {
                error "bad number of UIC digits, must be 7, 8, or 12"
        }
        regexp {([0-9]+)([0-9]$)} $no -> stem check
        expr [uic:checkdigit $stem] == $check
 }

The calculation of the check digit is factored out:

 proc uic:checkdigit {no} {
        set pos [string length $no]
        set t ""
        foreach i [split $no ""] {
                incr pos -1
                append t [expr $i*(2-$pos%2)]
        }
        expr (10-[cross_sum $t] % 10) % 10
 }

Notice the shimmering, but beautiful way to compute the cross sum ;-)

 proc cross_sum {s} {expr [join [split $s ""] +]}

Without much ado, the argument goes from string to list to string to int. This is another reason why I love Tcl - and don't care much for Python or Perl.