Task

Validate the check digit of an ISBN-13 code:

   Multiply every other digit by  3.
   Add these numbers and the other digits.
   Take the remainder of this number after division by  10.
   If it is  0,   the ISBN-13 check digit is correct.


Use the following codes for testing:

   978-1734314502       (good)
   978-1734314509         (bad)
   978-1788399081       (good)
   978-1788399083         (bad)


Show output here, on this page



See also

   for details:   13-digit ISBN method of validation.       (installs cookies.)


-------------------- ISBN13 CHECK DIGIT --------------------
 
-- isISBN13 :: String -> Bool
on isISBN13(s)
    script digitValue
        on |λ|(c)
            if isDigit(c) then
                {c as integer}
            else
                {}
            end if
        end |λ|
    end script
 
    set digits to concatMap(digitValue, characters of s)
 
    13 = length of digits ¬
        and 0 = sum(zipWith(my mul, digits, cycle({1, 3}))) mod 10
end isISBN13
 
 
--------------------------- TEST ---------------------------
on run
    script test
        on |λ|(s)
            {s, isISBN13(s)}
        end |λ|
    end script
 
    map(test, {"978-1734314502", "978-1734314509", ¬
        "978-1788399081", "978-1788399083"})
end run
 
 
-------------------- GENERIC FUNCTIONS ---------------------
 
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lng to length of xs
    set acc to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set acc to acc & (|λ|(item i of xs, i, xs))
        end repeat
    end tell
    return acc
end concatMap
 
 
-- cycle :: [a] -> Generator [a]
on cycle(xs)
    script
        property lng : 1 + (length of xs)
        property i : missing value
        on |λ|()
            if missing value is i then
                set i to 1
            else
                set nxt to (1 + i) mod lng
                if 0 = ((1 + i) mod lng) then
                    set i to 1
                else
                    set i to nxt
                end if
            end if
            return item i of xs
        end |λ|
    end script
end cycle
 
 
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl
 
 
-- isDigit :: Char -> Bool
on isDigit(c)
    set n to (id of c)
    48 ≤ n and 57 ≥ n
end isDigit
 
 
-- length :: [a] -> Int
on |length|(xs)
    set c to class of xs
    if list is c or string is c then
        length of xs
    else
        (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
    end if
end |length|
 
 
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map
 
 
-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min
 
 
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper. 
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn
 
 
-- mul (*) :: Num a => a -> a -> a
on mul(a, b)
    a * b
end mul
 
 
-- sum :: [Num] -> Num
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script
 
    foldl(add, 0, xs)
end sum
 
 
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to |λ|() of xs
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take
 
 
-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(|length|(xs), |length|(ys))
    if 1 > lng then return {}
    set xs_ to take(lng, xs) -- Allow for non-finite
    set ys_ to take(lng, ys) -- generators like cycle etc
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs_, item i of ys_)
        end repeat
        return lst
    end tell
end zipWith