Task

For each number list of 6-digit SEDOLs, calculate and append the checksum digit.



That is, given this input:

710889
B0YBKJ
406566
B0YBLH
228276
B0YBKL
557910
B0YBKR
585284
B0YBKT
B00030

Produce this output:

7108899
B0YBKJ7
4065663
B0YBLH2
2282765
B0YBKL9
5579107
B0YBKR5
5852842
B0YBKT7
B000300

Extra credit

Check each input is correctly formed, especially with respect to valid characters allowed in a SEDOL string.



Related tasks

   Luhn test
   ISIN


[]INT sedol weights = (1, 3, 1, 7, 3, 9);
STRING reject = "AEIOUaeiou";
 
PROC strcspn = (STRING s,reject)INT: (
  INT out:=0;
  FOR i TO UPB s DO
    IF char in string(s[i], LOC INT, reject) THEN
      return out
    FI;
    out:=i
  OD;
  return out: out
);
 
PROC sedol checksum = (REF STRING sedol6)INT:
(
  INT out;
 
  INT len := UPB sedol6;
  INT sum := 0;
 
  IF sedol6[len-1] = REPR 10 THEN len-:=1; sedol6[len]:=null char FI;
  IF len = 7 THEN
    putf(stand error, ($"SEDOL code already checksummed? ("g")"l$, sedol6)); 
    out := ABS ( BIN ABS sedol6[6] AND 16r7f); return out
  FI;
  IF len > 7 OR len < 6 OR strcspn(sedol6, reject) /= 6 THEN
    putf(stand error, ($"not a SEDOL code? ("g")"l$, sedol6));
    out := -1; return out
  FI;
  FOR i TO UPB sedol6 DO
    sum+:=sedol weights[i]*
      IF is digit(sedol6[i]) THEN
        ABS sedol6[i]- ABS "0"
      ELIF is alpha(sedol6[i]) THEN
        (ABS to upper(sedol6[i])-ABS "A") + 10
      ELSE
        putf(stand error, $"SEDOL with not alphanumeric digit"l$);
        out:=-1; return out
      FI
  OD;
  out := (10 - (sum MOD 10)) MOD 10 + ABS "0";
  return out: out
);
 
main:
(
  STRING line;
 
  on logical file end(stand in, (REF FILE f)BOOL: done);
  DO getf(stand in, ($gl$,line));
    INT sr := sedol checksum(line);
    IF sr > 0 THEN
      printf(($ggl$, line, REPR sedol checksum(line)))
    FI
  OD;
  done: SKIP
)