Data commit

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

@@ -0,0 +1,222 @@
+------------------------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