Split a character string based on change of character: Difference between revisions

Content added Content deleted
(→‎JS ES6: updated groupBy primitive ( redrafted as a fold, rather than an explicit recursion with 'span' ))
(→‎{{header|AppleScript}}: ( updated groupBy primitive – using a fold, rather than explicit recursion with span))
Line 52: Line 52:
-- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
-- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
on groupBy(f, xs)
on groupBy(f, xs)
set lng to length of xs
set mf to mReturn(f)
if lng > 0 then
script enGroup
set x to item 1 of xs
set mf to mReturn(f)
on lambda(a, x)
set h to cond(length of (active of a) > 0, item 1 of active of a, missing value)
script matchPrevious
on lambda(y)
if h is not missing value and mf's lambda(h, x) then
mf's lambda(x, y)
{active:(active of a) & x, sofar:sofar of a}
end lambda
else
{active:{x}, sofar:(sofar of a) & {active of a}}
end script
end if
end lambda
set {ys, zs} to span(matchPrevious, tail(xs))
end script
set lstGroup to {{x} & ys}
if zs ≠ {} then
if length of xs > 0 then
lstGroup & groupBy(mf, zs)
set dct to foldl(enGroup, {active:{item 1 of xs}, sofar:{}}, tail(xs))
sofar of dct & cond(length of (active of dct) > 0, {active of dct}, {})
else
lstGroup
end if
else
else
{}
{}
Line 76: Line 74:
end groupBy
end groupBy


-- foldl :: (a -> b -> a) -> a -> [b] -> a
-- Span of unbroken predicate matches at left, returned with remainder
on foldl(f, startValue, xs)
-- span :: (a -> Bool) -> [a] -> ([a],[a])
on span(f, xs)
set lng to length of xs
set i to 0
tell mReturn(f)
tell mReturn(f)
set v to startValue
repeat while i < lng and lambda(item (i + 1) of xs)
set i to i + 1
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
end repeat
return v
end tell
end tell
end foldl

if i > 0 then
if i < lng then
-- cond :: Bool -> a -> a -> a
on cond(bool, f, g)
{items 1 thru i of xs, (items (i + 1) thru -1 of xs)}
else
if bool then
{xs, {}}
f
end if
else
else
{{}, xs}
g
end if
end if
end span
end cond


-- intercalate :: Text -> [Text] -> Text
-- intercalate :: Text -> [Text] -> Text