September Morn Update

Task/SEDOLs/Factor/sedols.factor

@@ -0,0 +1,42 @@
+USING: combinators combinators.short-circuit formatting io kernel
+math math.parser regexp sequences unicode ;
+IN: rosetta-code.sedols
+
+<PRIVATE
+
+CONSTANT: input {
+    "710889" "B0YBKJ" "406566" "B0YBLH" "228276" "B0YBKL"
+    "557910" "B0YBKR" "585284" "B0YBKT" "B00030" "AEIOUA"
+    "123"    ""       "B_7K90"
+}
+
+CONSTANT: weights B{ 1 3 1 7 3 9 1 }
+
+: sedol-error ( seq -- err-str )
+    {
+        { [ dup empty? ] [ drop "no data" ] }
+        { [ dup length 6 = not ] [ drop "invalid length" ] }
+        [ drop "invalid char(s)" ]
+    } cond "*error* " prepend ;
+
+: sedol-valid? ( seq -- ? )
+    { [ length 6 = ] [ R/ [0-9BCDFGHJ-NP-TV-Z]+/ matches? ] } 1&& ;
+
+: sedol-value ( m -- n ) dup digit? [ digit> ] [ 55 - ] if ;
+
+: sedol-checksum ( seq -- n )
+    [ sedol-value ] { } map-as weights [ * ] 2map sum ;
+
+: (sedol-check-digit) ( seq -- str )
+    sedol-checksum 10 mod 10 swap - 10 mod number>string ;
+
+PRIVATE>
+
+: sedol-check-digit ( seq -- str )
+    dup sedol-valid? [ (sedol-check-digit) ] [ sedol-error ] if ;
+
+: sedol-demo ( -- )
+    "SEDOL   Check digit\n======  ===========" print
+    input [ dup sedol-check-digit "%-6s  %s\n" printf ] each ;
+
+MAIN: sedol-demo

Task/SEDOLs/Haskell/sedols.hs

@@ -4,7 +4,7 @@ checkSum :: String -> String
 checkSum =
   show .
   (`rem` 10) .
-  (-) 10 . (`rem` 10) . sum . zipWith (*) [1, 3, 1, 7, 3, 9] . (charValue <$>)
+  (-) 10 . (`rem` 10) . sum . zipWith (*) [1, 3, 1, 7, 3, 9] . fmap charValue
 
 charValue :: Char -> Int
 charValue c

Task/SEDOLs/JavaScript/sedols-2.js

@@ -0,0 +1,164 @@
+(() => {
+    'use strict';
+
+    const main = () => {
+
+        // checkSumLR :: String -> Either String String
+        const checkSumLR = s => {
+            const
+                tpl = partitionEithers(map(charValueLR, s));
+            return 0 < tpl[0].length ? (
+                Left(s + ' -> ' + unwords(tpl[0]))
+            ) : Right(rem(10 - rem(
+                sum(zipWith(
+                    (a, b) => a * b,
+                    [1, 3, 1, 7, 3, 9],
+                    tpl[1]
+                )), 10
+            ), 10).toString());
+        };
+
+        // charValue :: Char -> Either String Int
+        const charValueLR = c =>
+            isAlpha(c) ? (
+                isUpper(c) ? (
+                    elem(c, 'AEIOU') ? Left(
+                        'Unexpected vowel: ' + c
+                    ) : Right(ord(c) - ord('A') + 10)
+                ) : Left('Unexpected lower case character: ' + c)
+            ) : isDigit(c) ? Right(
+                parseInt(c, 10)
+            ) : Left('Unexpected character: ' + c);
+
+        // TESTS ------------------------------------------
+        const [problems, checks] = Array.from(
+            partitionEithers(map(s => bindLR(
+                    checkSumLR(s),
+                    c => Right(s + c)
+                ),
+                [
+                    "710889", "B0YBKJ", "406566",
+                    "B0YBLH", "228276", "B0YBKL",
+                    "557910", "B0YBKR", "585284",
+                    "B0YBKT", "B00030"
+                ]
+            ))
+        );
+        return unlines(
+            0 < problems.length ? (
+                problems
+            ) : checks
+        );
+    };
+
+    // GENERIC FUNCTIONS ----------------------------
+
+    // Left :: a -> Either a b
+    const Left = x => ({
+        type: 'Either',
+        Left: x
+    });
+
+    // Right :: b -> Either a b
+    const Right = x => ({
+        type: 'Either',
+        Right: x
+    });
+
+    // Tuple (,) :: a -> b -> (a, b)
+    const Tuple = (a, b) => ({
+        type: 'Tuple',
+        '0': a,
+        '1': b,
+        length: 2
+    });
+
+    // bindLR (>>=) :: Either a -> (a -> Either b) -> Either b
+    const bindLR = (m, mf) =>
+        undefined !== m.Left ? (
+            m
+        ) : mf(m.Right);
+
+    // elem :: Eq a => a -> [a] -> Bool
+    const elem = (x, xs) => xs.includes(x);
+
+    // isAlpha :: Char -> Bool
+    const isAlpha = c =>
+        /[A-Za-z\u00C0-\u00FF]/.test(c);
+
+    // isDigit :: Char -> Bool
+    const isDigit = c => {
+        const n = ord(c);
+        return 48 <= n && 57 >= n;
+    };
+
+    // isUpper :: Char -> Bool
+    const isUpper = c =>
+        /[A-Z]/.test(c);
+
+    // Returns Infinity over objects without finite length.
+    // This enables zip and zipWith to choose the shorter
+    // argument when one is non-finite, like cycle, repeat etc
+
+    // length :: [a] -> Int
+    const length = xs =>
+        (Array.isArray(xs) || 'string' === typeof xs) ? (
+            xs.length
+        ) : Infinity;
+
+    // map :: (a -> b) -> [a] -> [b]
+    const map = (f, xs) =>
+        (Array.isArray(xs) ? (
+            xs
+        ) : xs.split('')).map(f);
+
+    // ord :: Char -> Int
+    const ord = c => c.codePointAt(0);
+
+    // partitionEithers :: [Either a b] -> ([a],[b])
+    const partitionEithers = xs =>
+        xs.reduce(
+            (a, x) => undefined !== x.Left ? (
+                Tuple(a[0].concat(x.Left), a[1])
+            ) : Tuple(a[0], a[1].concat(x.Right)),
+            Tuple([], [])
+        );
+
+    // rem :: Int -> Int -> Int
+    const rem = (n, m) => n % m;
+
+    // sum :: [Num] -> Num
+    const sum = xs => xs.reduce((a, x) => a + x, 0);
+
+    // take :: Int -> [a] -> [a]
+    // take :: Int -> String -> String
+    const take = (n, xs) =>
+        'GeneratorFunction' !== xs.constructor.constructor.name ? (
+            xs.slice(0, n)
+        ) : [].concat.apply([], Array.from({
+            length: n
+        }, () => {
+            const x = xs.next();
+            return x.done ? [] : [x.value];
+        }));
+
+    // unlines :: [String] -> String
+    const unlines = xs => xs.join('\n');
+
+    // unwords :: [String] -> String
+    const unwords = xs => xs.join(' ');
+
+    // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
+    const zipWith = (f, xs, ys) => {
+        const
+            lng = Math.min(length(xs), length(ys)),
+            as = take(lng, xs),
+            bs = take(lng, ys);
+        return Array.from({
+            length: lng
+        }, (_, i) => f(as[i], bs[i], i));
+    };
+
+    // MAIN ---
+    return main();
+})();

Task/SEDOLs/OCaml/sedols.ocaml

@@ -1,20 +1,19 @@
 let char2value c =
   assert (not (String.contains "AEIOU" c));
   match c with
-     '0'..'9' -> int_of_char c - int_of_char '0'
-   | 'A'..'Z' -> int_of_char c - int_of_char 'A' + 10
+  | '0'..'9' -> int_of_char c - int_of_char '0'
+  | 'A'..'Z' -> int_of_char c - int_of_char 'A' + 10
+  | _ -> assert false
 
 let sedolweight = [1;3;1;7;3;9]
 
 let explode s =
-  let result = ref [] in
-  String.iter (fun c -> result := c :: !result) s;
-  List.rev !result
+  s |> String.to_seq |> List.of_seq
 
 let checksum sedol =
   let tmp = List.fold_left2 (fun sum ch weight -> sum + char2value ch * weight)
               0 (explode sedol) sedolweight in
-    string_of_int ((10 - (tmp mod 10)) mod 10)
+  string_of_int ((10 - (tmp mod 10)) mod 10) ;;
 
 List.iter (fun sedol -> print_endline (sedol ^ checksum sedol))
   [ "710889";

Task/SEDOLs/Python/sedols-2.py

@@ -0,0 +1,125 @@
+'''SEDOL checksum digits'''
+
+from functools import reduce
+
+
+# sedolCheckSumDigitLR :: String -> Either String Char
+def sedolCheckSumDigitLR(s):
+    '''Either an explanatory message, or a
+       checksum digit character to append
+       to a given six-character SEDOL string.
+    '''
+    def goLR(lr, cn):
+        c, n = cn
+        return bindLR(lr)(
+            lambda a: bindLR(sedolValLR(c))(
+                lambda x: Right(a + x * n)
+            )
+        )
+    return bindLR(
+        reduce(
+            goLR,
+            zip(s, [1, 3, 1, 7, 3, 9]),
+            Right(0)
+        )
+    )(lambda d: Right(str((10 - (d % 10)) % 10)))
+
+
+# sedolValLR :: Char -> Either String Char
+def sedolValLR(c):
+    '''Either an explanatory message, or the
+       SEDOL value of a given character.
+    '''
+    return Right(int(c, 36)) if (
+        c not in 'AEIOU'
+    ) else Left('Unexpected vowel in SEDOL string: ' + c)
+
+
+# TEST -------------------------------------------------
+def main():
+    '''Append checksums where valid.'''
+
+    print(
+        fTable(__doc__ + ':\n')(str)(
+            either(str)(str)
+        )(sedolCheckSumDigitLR)(
+            '''710889
+               B0YBKJ
+               406566
+               B0YBLH
+               228276
+               B0YBKL
+               BOYBKL
+               557910
+               B0YBKR
+               585284
+               B0YBKT
+               B00030
+            '''.split()
+        )
+    )
+
+
+# GENERIC -------------------------------------------------
+
+
+# Left :: a -> Either a b
+def Left(x):
+    '''Constructor for an empty Either (option type) value
+       with an associated string.'''
+    return {'type': 'Either', 'Right': None, 'Left': x}
+
+
+# Right :: b -> Either a b
+def Right(x):
+    '''Constructor for a populated Either (option type) value'''
+    return {'type': 'Either', 'Left': None, 'Right': x}
+
+
+# bindLR (>>=) :: Either a -> (a -> Either b) -> Either b
+def bindLR(m):
+    '''Either monad injection operator.
+       Two computations sequentially composed,
+       with any value produced by the first
+       passed as an argument to the second.'''
+    return lambda mf: (
+        mf(m.get('Right')) if None is m.get('Left') else m
+    )
+
+
+# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
+def compose(g):
+    '''Right to left function composition.'''
+    return lambda f: lambda x: g(f(x))
+
+
+# either :: (a -> c) -> (b -> c) -> Either a b -> c
+def either(fl):
+    '''The application of fl to e if e is a Left value,
+       or the application of fr to e if e is a Right value.'''
+    return lambda fr: lambda e: fl(e['Left']) if (
+        None is e['Right']
+    ) else fr(e['Right'])
+
+
+# fTable :: String -> (a -> String) ->
+#                     (b -> String) ->
+#        (a -> b) -> [a] -> String
+def fTable(s):
+    '''Heading -> x display function -> fx display function ->
+          f -> value list -> tabular string.'''
+    def go(xShow, fxShow, f, xs):
+        w = max(map(compose(len)(xShow), xs))
+        return s + '\n' + '\n'.join([
+            xShow(x).rjust(w, ' ') + ' -> ' + fxShow(f(x)) for x in xs
+        ])
+    return lambda xShow: lambda fxShow: (
+        lambda f: lambda xs: go(
+            xShow, fxShow, f, xs
+        )
+    )
+
+
+# MAIN ---
+if __name__ == '__main__':
+    main()

Task/SEDOLs/Q/sedols.q

@@ -0,0 +1,8 @@
+scd:{
+    v:{("i"$x) - ?[("0"<=x) & x<="9"; "i"$"0"; -10+"i"$"A"]} each x; / Turn characters of SEDOL into their values
+    w:sum v*1 3 1 7 3 9;        / Weighted sum of values
+    d:(10 - w mod 10) mod 10;   / Check digit value
+    x,"c"$(("i"$"0")+d)         / Append to SEDOL
+}
+
+scd each ("710889";"B0YBKJ";"406566";"B0YBLH";"228276";"B0YBKL";"557910";"B0YBKR";"585284";"B0YBKT";"B00030")

Task/SEDOLs/Ruby/sedols.rb

@@ -1,21 +1,18 @@
 Sedol_char = "0123456789BCDFGHJKLMNPQRSTVWXYZ"
+Sedolweight = [1,3,1,7,3,9]
 
 def char2value(c)
-  raise ArgumentError, "No vowels" unless Sedol_char.include?(c)
+  raise ArgumentError, "Invalid char #{c}" unless Sedol_char.include?(c)
   c.to_i(36)
 end
 
-Sedolweight = [1,3,1,7,3,9]
-
 def checksum(sedol)
   raise ArgumentError, "Invalid length" unless sedol.size == Sedolweight.size
-  sum = sedol.split('').zip(Sedolweight).map { |ch, weight|
-            char2value(ch) * weight }.inject(:+)
+  sum = sedol.chars.zip(Sedolweight).sum{|ch, weight| char2value(ch) * weight }
   ((10 - (sum % 10)) % 10).to_s
 end
 
-data = %w{
-          710889
+data = %w(710889
           B0YBKJ
           406566
           B0YBLH
@@ -28,10 +25,9 @@ data = %w{
           B00030
           C0000
           1234567
-          00000A
-         }
+          00000A)
 
-for sedol in data
+data.each do |sedol|
   print "%-8s " % sedol
   begin
     puts sedol + checksum(sedol)