on run

    -- TRADITIONAL STRINGS ---------------------------------------------------

    -- ts :: Array Int (String, String)            -- 天干 tiangan – 10 heavenly stems
    set ts to zip(chars("甲乙丙丁戊己庚辛壬癸"), ¬
        |words|("jiă yĭ bĭng dīng wù jĭ gēng xīn rén gŭi"))

    -- ds :: Array Int (String, String)            -- 地支 dizhi – 12 terrestrial branches
    set ds to zip(chars("子丑寅卯辰巳午未申酉戌亥"), ¬
        |words|("zĭ chŏu yín măo chén sì wŭ wèi shēn yŏu xū hài"))

    -- ws :: Array Int (String, String, String)    -- 五行 wuxing – 5 elements
    set ws to zip3(chars("木火土金水"), ¬
        |words|("mù huǒ tǔ jīn shuǐ"), ¬
        |words|("wood fire earth metal water"))

    -- xs :: Array Int (String, String, String)    -- 十二生肖 shengxiao – 12 symbolic animals
    set xs to zip3(chars("鼠牛虎兔龍蛇馬羊猴鸡狗豬"), ¬
        |words|("shǔ niú hǔ tù lóng shé mǎ yáng hóu jī gǒu zhū"), ¬
        |words|("rat ox tiger rabbit dragon snake horse goat monkey rooster dog pig"))

    -- ys :: Array Int (String, String)            -- 阴阳 yinyang
    set ys to zip(chars("阳阴"), |words|("yáng yīn"))


    -- TRADITIONAL CYCLES ----------------------------------------------------

    script cycles
        on |λ|(y)
            set iYear to y - 4
            set iStem to iYear mod 10
            set iBranch to iYear mod 12
            set {hStem, pStem} to item (iStem + 1) of ts
            set {hBranch, pBranch} to item (iBranch + 1) of ds
            set {hElem, pElem, eElem} to item ((iStem div 2) + 1) of ws
            set {hAnimal, pAnimal, eAnimal} to item (iBranch + 1) of xs
            set {hYinyang, pYinyang} to item ((iYear mod 2) + 1) of ys

            {{show(y), hStem & hBranch, hElem, hAnimal, hYinyang}, ¬
                {"", pStem & pBranch, pElem, pAnimal, pYinyang}, ¬
                {"", show((iYear mod 60) + 1) & "/60", eElem, eAnimal, ""}}
        end |λ|
    end script

    -- FORMATTING ------------------------------------------------------------

    -- fieldWidths :: [[Int]]
    set fieldWidths to {{6, 10, 7, 8, 3}, {6, 11, 8, 8, 4}, {6, 11, 8, 8, 4}}

    script showYear
        script widthStringPairs
            on |λ|(nscs)
                set {ns, cs} to nscs
                zip(ns, cs)
            end |λ|
        end script

        script justifiedRow
            on |λ|(row)
                script
                    on |λ|(ns)
                        set {n, s} to ns
                        justifyLeft(n, space, s)
                    end |λ|
                end script

                concat(map(result, row))
            end |λ|
        end script

        on |λ|(y)
            unlines(map(justifiedRow, ¬
                map(widthStringPairs, ¬
                    zip(fieldWidths, |λ|(y) of cycles))))
        end |λ|
    end script

    -- TEST OUTPUT -----------------------------------------------------------
    intercalate("\n\n", map(showYear, {1935, 1938, 1968, 1972, 1976, 1984, 2017}))
end run


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

-- chars :: String -> [String]
on chars(s)
    characters of s
end chars

-- concat :: [[a]] -> [a] | [String] -> String
on concat(xs)
    if length of xs > 0 and class of (item 1 of xs) is string then
        set acc to ""
    else
        set acc to {}
    end if
    repeat with i from 1 to length of xs
        set acc to acc & item i of xs
    end repeat
    acc
end concat

-- 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

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
    set {dlm, my text item delimiters} to {my text item delimiters, strText}
    set strJoined to lstText as text
    set my text item delimiters to dlm
    return strJoined
end intercalate

-- justifyLeft :: Int -> Char -> Text -> Text
on justifyLeft(n, cFiller, strText)
    if n > length of strText then
        text 1 thru n of (strText & replicate(n, cFiller))
    else
        strText
    end if
end justifyLeft

-- map :: (a -> b) -> [a] -> [b]
on map(f, 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

-- minimum :: [a] -> a
on minimum(xs)
    script min
        on |λ|(a, x)
            if x < a or a is missing value then
                x
            else
                a
            end if
        end |λ|
    end script

    foldl(min, missing value, xs)
end minimum

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length

-- replicate :: Int -> a -> [a]
on replicate(n, a)
    set out to {}
    if n < 1 then return out
    set dbl to {a}

    repeat while (n > 1)
        if (n mod 2) > 0 then set out to out & dbl
        set n to (n div 2)
        set dbl to (dbl & dbl)
    end repeat
    return out & dbl
end replicate

-- show :: a -> String
on show(e)
    set c to class of e
    if c = list then
        script serialized
            on |λ|(v)
                show(v)
            end |λ|
        end script

        "[" & intercalate(", ", map(serialized, e)) & "]"
    else if c = record then
        script showField
            on |λ|(kv)
                set {k, ev} to kv
                "\"" & k & "\":" & show(ev)
            end |λ|
        end script

        "{" & intercalate(", ", ¬
            map(showField, zip(allKeys(e), allValues(e)))) & "}"
    else if c = date then
        "\"" & iso8601Z(e) & "\""
    else if c = text then
        "\"" & e & "\""
    else if (c = integer or c = real) then
        e as text
    else if c = class then
        "null"
    else
        try
            e as text
        on error
            ("«" & c as text) & "»"
        end try
    end if
end show

-- unlines :: [String] -> String
on unlines(xs)
    intercalate(linefeed, xs)
end unlines

-- words :: String -> [String]
on |words|(s)
    words of s
end |words|

-- zip :: [a] -> [b] -> [(a, b)]
on zip(xs, ys)
    set lng to min(length of xs, length of ys)
    set lst to {}
    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 zip

-- zip3 :: [a] -> [b] -> [c] -> [(a, b, c)]
on zip3(xs, ys, zs)
    script
        on |λ|(x, i)
            [x, item i of ys, item i of zs]
        end |λ|
    end script

    map(result, items 1 thru ¬
        minimum({length of xs, length of ys, length of zs}) of xs)
end zip3