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

Line 25:
 
=={{header|Haskell}}==
{{Trans|JavaScript}}
<lang AppleScript>on run
intercalate(", ", ¬
map(curry(intercalate)'s lambda(""), ¬
group("gHHH5YY++///\\")))
--> "g, HHH, 5, YY, ++, ///, \\"
end run
 
<lang Haskell>import Data.List (group, intercalate)
 
-- GENERIC FUNCTIONS
main :: IO ()
 
main = putStrLn $ intercalate ", " (group "gHHH5YY++///\\")</lang>
-- group :: Eq a => [a] -> [[a]]
on group(xs)
script eq
on lambda(a, b)
a = b
end lambda
end script
groupBy(eq, xs)
end group
 
-- groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
on groupBy(f, xs)
set lng to length of xs
if lng > 0 then
set x to item 1 of xs
set mf to mReturn(f)
script furtherMatch
on lambda(y)
mf's lambda(x, y)
end lambda
end script
set {ys, zs} to span(furtherMatch, tail(xs))
set lstGroup to {{x} & ys}
if zs ≠ {} then
lstGroup & groupBy(mf, zs)
else
lstGroup
end if
else
{}
end if
end groupBy
 
-- Span of unbroken predicate matches at left, returned with remainder
-- span :: (a -> Bool) -> [a] -> ([a],[a])
on span(f, xs)
set lng to length of xs
set i to 0
tell mReturn(f)
repeat while i < lng and lambda(item (i + 1) of xs)
set i to i + 1
end repeat
end tell
if i > 0 then
if i < lng then
{items 1 thru i of xs, (items (i + 1) thru -1 of xs)}
else
{xs, {}}
end if
else
{{}, xs}
end if
end span
 
-- 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
 
-- 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
 
-- 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
 
-- 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
 
-- tail :: [a] -> [a]
on tail(xs)
if length of xs > 1 then
items 2 thru -1 of xs
else
{}
end if
end tail</lang>
 
{{Out}}
9,659

edits