RosettaCodeData/Task/Rep-string/AppleScript/rep-string.applescript

------------------------REP-CYCLES-------------------------

-- repCycles :: String -> [String]
on repCycles(xs)
    set n to length of xs

    script isCycle
        on |λ|(cs)
            xs = takeCycle(n, cs)
        end |λ|
    end script

    filter(isCycle, tail(inits(take(quot(n, 2), xs))))
end repCycles

-- cycleReport :: String -> [String]
on cycleReport(xs)
    set reps to repCycles(xs)

    if isNull(reps) then
        {xs, "(n/a)"}
    else
        {xs, item -1 of reps}
    end if
end cycleReport


---------------------------TEST----------------------------
on run
    set samples to {"1001110011", "1110111011", "0010010010", ¬
        "1010101010", "1111111111", "0100101101", "0100100", ¬
        "101", "11", "00", "1"}

    unlines(cons("Longest cycle:" & linefeed, ¬
        map(intercalate(" -> "), ¬
            map(cycleReport, samples))))

end run


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

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

-- cons :: a -> [a] -> [a]
on cons(x, xs)
    {x} & xs
end cons

-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
    tell mReturn(f)
        set lst to {}
        set lng to length of xs
        repeat with i from 1 to lng
            set v to item i of xs
            if |λ|(v, i, xs) then set end of lst to v
        end repeat
        return lst
    end tell
end filter

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

-- inits :: [a] -> [[a]]
-- inits :: String -> [String]
on inits(xs)
    script elemInit
        on |λ|(_, i, xs)
            items 1 thru i of xs
        end |λ|
    end script

    script charInit
        on |λ|(_, i, xs)
            text 1 thru i of xs
        end |λ|
    end script

    if class of xs is string then
        {""} & map(charInit, xs)
    else
        {{}} & map(elemInit, xs)
    end if
end inits

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

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

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

-- isNull :: [a] -> Bool
on isNull(xs)
    xs = {}
end isNull

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- quot :: Integral a => a -> a -> a
on quot(n, m)
    n div m
end quot

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

-- tail :: [a] -> [a]
on tail(xs)
    if length of xs > 1 then
        items 2 thru -1 of xs
    else
        {}
    end if
end tail

-- take :: Int -> [a] -> [a]
on take(n, xs)
    if class of xs is string then
        if n > 0 then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else
        if n > 0 then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    end if
end take

-- takeCycle :: Int -> [a] -> [a]
on takeCycle(n, xs)
    set lng to length of xs
    if lng ≥ n then
        set cycle to xs
    else
        set cycle to concat(replicate((n div lng) + 1, xs))
    end if

    if class of xs is string then
        items 1 thru n of cycle as string
    else
        items 1 thru n of cycle
    end if
end takeCycle

-- unlines :: [String] -> String
on unlines(xs)
    |λ|(xs) of intercalate(linefeed)
end unlines