General FizzBuzz: Difference between revisions

Content added Content deleted
(→‎{{header|AppleScript}}: Tidied and partially restructured.)
Line 203: Line 203:
=={{header|AppleScript}}==
=={{header|AppleScript}}==


<lang AppleScript>--------------------- GENERAL FIZZBUZZ -------------------
{{Trans|JavaScript}}
<lang AppleScript>-- GENERAL FIZZBUZZ ----------------------------------------------------------


-- fizz :: [[Int, String]] -> Int -> String
-- fizzEtc :: [(Int, String)] -> [Symbol]
on fizzEtc(rules)
on fizz(lstRules, intMax)
-- A non-finite sequence of fizzEtc symbols,
-- fizzLine :: String -> Int -> String
-- as defined by the given list of rules.
script fizzline
script go
on |λ|(strSeries, n)
on |λ|(n)
script ruleMatch
-- Multiple rule matches -> single or concatenated words
on |λ|(a, mk)
-- wordIfRuleMatch :: String -> (Int, String) -> String
set {m, k} to mk
script wordIfRuleMatch
on |λ|(str, rulePair)
set {factor, noiseWord} to rulePair
cond(n mod factor > 0, str, str & noiseWord)
if 0 = (n mod m) then
if integer is class of a then
k
else
a & k
end if
else
a
end if
end |λ|
end |λ|
end script
end script
set strPhrase to foldl(wordIfRuleMatch, "", lstRules)
foldl(ruleMatch, n, rules)
strSeries & cond(strPhrase ≠ "", strPhrase, n as string) & linefeed
end |λ|
end |λ|
end script
end script
foldl(fizzline, "", enumFromTo(1, intMax))
fmapGen(go, enumFrom(1))
end fizz
end fizzEtc



-- TEST ----------------------------------------------------------------------
--------------------------- TEST -------------------------
on run
on run
unlines(take(20, ¬
fizz([[3, "Fizz"], [5, "Buzz"], [7, "Baxx"]], 20)
fizzEtc({{3, "Fizz"}, {5, "Buzz"}, {7, "Baxx"}})))
end run
end run


-- GENERIC FUNCTIONS ---------------------------------------------------------


------------------------- GENERIC ------------------------
-- cond :: Bool -> a -> a -> a

on cond(bool, x, y)
-- enumFrom :: Enum a => a -> [a]
if bool then
on enumFrom(x)
x
else
script
y
property v : missing value
end if
on |λ|()
if missing value is not v then
end cond
set v to 1 + v
else
set v to x
end if
return v
end |λ|
end script
end enumFrom


-- fmapGen <$> :: (a -> b) -> Gen [a] -> Gen [b]
on fmapGen(f, gen)
script
property g : mReturn(f)
on |λ|()
set v to gen's |λ|()
if v is missing value then
v
else
g's |λ|(v)
end if
end |λ|
end script
end fmapGen


-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if m > n then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo


-- foldl :: (a -> b -> a) -> a -> [b] -> a
-- foldl :: (a -> b -> a) -> a -> [b] -> a
Line 276: Line 290:
end foldl
end foldl



-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
on mReturn(f)
if class of f is script then
-- 2nd class handler function lifted into 1st class script wrapper.
if script is class of f then
f
f
else
else
Line 286: Line 301:
end script
end script
end if
end if
end mReturn</lang>
end mReturn


-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
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
end take


-- unlines :: [String] -> String
on unlines(xs)
-- A single string formed by the intercalation
-- of a list of strings with the newline character.
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set s to xs as text
set my text item delimiters to dlm
s
end unlines</lang>
{{Out}}
{{Out}}
<pre>1
<pre>1
Retrieved from "https://rosettacode.org/wiki/General_FizzBuzz"