-------------------- 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-0596528126", "978-0596528120", ¬ "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