Rep-string: Difference between revisions

→‎{{AppleScript}}: Added AppleScript version
(→‎{header|JavaScript}}: Added JavaScript example (solution composed from functional primitives))
(→‎{{AppleScript}}: Added AppleScript version)
Line 159:
)</lang>
{{out}}
<pre>1001110011: longest rep string: "10011"
<pre>
1001110011: longest rep string: "10011"
1110111011: longest rep string: "1110"
0010010010: longest rep string: "001"
Line 170 ⟶ 169:
11: longest rep string: "1"
00: longest rep string: "0"
1: no rep string</pre>
 
</pre>
=={{header|AppleScript}}==
<lang AppleScript>-- repCycles :: String -> [String]
on repCycles(xs)
set n to length of xs
script isCycle
on lambda(cs)
xs = takeCycle(n, cs)
end lambda
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, |last|(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(curry(intercalate)'s lambda(" -> "), ¬
map(cycleReport, samples))))
end run
 
 
-- GENERIC FUNCTIONS ----------------------------------------------------------------------
 
-- concat :: [[a]] -> [a] | [String] -> String
on concat(xs)
script append
on lambda(a, b)
a & b
end lambda
end script
if length of xs > 0 and class of (item 1 of xs) is string then
set unit to ""
else
set unit to {}
end if
foldl(append, unit, xs)
end concat
 
-- cons :: a -> [a] -> [a]
on cons(x, xs)
{x} & xs
end cons
 
-- curry :: (Script|Handler) -> Script
on curry(f)
script
on lambda(a)
script
on lambda(b)
lambda(a, b) of mReturn(f)
end lambda
end script
end lambda
end script
end curry
 
-- 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 lambda(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 lambda(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 lambda(_, i, xs)
items 1 thru i of xs
end lambda
end script
script charInit
on lambda(_, i, xs)
text 1 thru i of xs
end lambda
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, 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
 
-- last :: [a] -> a
on |last|(xs)
if length of xs > 0 then
item -1 of xs
else
missing value
end if
end |last|
 
-- 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 lambda(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 lambda : f
end script
end if
end mReturn
 
-- isNull :: [a] -> Bool
on isNull(xs)
xs = {}
end isNull
 
-- 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)
set blnString to (class of xs is string)
if n > 0 then
if blnString then
text 1 thru n of xs
else
items 2 thru n of xs
end if
else
if blnString then
""
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)
intercalate(linefeed, xs)
end unlines</lang>
{{Out}}
<pre>Longest cycle:
 
1001110011 -> 10011
1110111011 -> 1110
0010010010 -> 001
1010101010 -> 1010
1111111111 -> 11111
0100101101 -> (n/a)
0100100 -> 010
101 -> (n/a)
11 -> 1
00 -> 0
1 -> (n/a)</pre>
 
=={{header|AutoHotkey}}==
{{works with|AutoHotkey 1.1}}
9,659

edits