Longest common prefix: Difference between revisions

Content added Content deleted
m (→‎{{header|AppleScript}}: Restored missing comment indicator, inserted separator, added index subheadings.)
Line 272: Line 272:
----
----
===Functional===
===Functional===
and for more productivity, and higher re-use of existing library functions, we can write a functional definition (rather than a procedure).
and for a functional definition (rather than a procedure) we can compose reusable generics, applying a ''takeWhile'' function (with a suitable predicate) to a transposed matrix of the characters in the given words.


<lang applescript>-- longestCommonPrefix :: [String] -> String
<lang applescript>------------------- LONGEST COMMON PREFIX ------------------


-- longestCommonPrefix :: [String] -> String
on longestCommonPrefix(xs)
on longestCommonPrefix(xs)
if {} ≠ xs then
if 1 < length of xs then
map(my fst, ¬
map(my fst, ¬
takeWhile(my identical, my transpose(map(my chars, xs)))) as text
takeWhile(my allSame, my transpose(xs))) as text
else
else
""
xs as text
end if
end if
end longestCommonPrefix
end longestCommonPrefix




---------------------------TEST----------------------------
---------------------------- TESTS --------------------------
on run
on run
script test
script test
Line 306: Line 309:




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


-- all :: (a -> Bool) -> [a] -> Bool
-- all :: (a -> Bool) -> [a] -> Bool
Line 319: Line 322:
end tell
end tell
end all
end all


⚫
-- allSame :: [a] -> Bool
⚫
on allSame(xs)
⚫
if 2 > length of xs then
⚫
true
⚫
else
script p
⚫
property h : item 1 of xs
on |λ|(x)
h = x
end |λ|
⚫
end script
⚫
all(p, rest of xs)
end if
end allSame



-- chars :: String -> [Char]
-- chars :: String -> [Char]
Line 324: Line 344:
characters of s
characters of s
end chars
end chars



-- comparing :: (a -> b) -> (a -> a -> Ordering)
-- comparing :: (a -> b) -> (a -> a -> Ordering)
Line 343: Line 364:
end script
end script
end comparing
end comparing



-- concatMap :: (a -> [b]) -> [a] -> [b]
-- concatMap :: (a -> [b]) -> [a] -> [b]
Line 355: Line 377:
return acc
return acc
end concatMap
end concatMap



-- eq (==) :: Eq a => a -> a -> Bool
-- eq (==) :: Eq a => a -> a -> Bool
Line 364: Line 387:
end script
end script
end eq
end eq



-- foldl :: (a -> b -> a) -> a -> [b] -> a
-- foldl :: (a -> b -> a) -> a -> [b] -> a
Line 376: Line 400:
end tell
end tell
end foldl
end foldl



-- fst :: (a, b) -> a
-- fst :: (a, b) -> a
Line 386: Line 411:
end fst
end fst


⚫
-- identical :: [a] -> Bool
⚫
on identical(xs)
-- True if the list is empty, or
-- if all its items are identical.
⚫
if 0 < length of xs then
⚫
set h to item 1 of xs
⚫
all(eq(h), rest of xs)
⚫
else
⚫
true
⚫
end if
end identical


-- intercalate :: String -> [String] -> String
-- intercalate :: String -> [String] -> String
Line 406: Line 420:
str
str
end intercalate
end intercalate



-- justifyLeft :: Int -> Char -> String -> String
-- justifyLeft :: Int -> Char -> String -> String
Line 419: Line 434:
end script
end script
end justifyLeft
end justifyLeft



-- length :: [a] -> Int
-- length :: [a] -> Int
Line 429: Line 445:
end if
end if
end |length|
end |length|



-- map :: (a -> b) -> [a] -> [b]
-- map :: (a -> b) -> [a] -> [b]
Line 443: Line 460:
end tell
end tell
end map
end map



-- maximumBy :: (a -> a -> Ordering) -> [a] -> a
-- maximumBy :: (a -> a -> Ordering) -> [a] -> a
Line 459: Line 477:
foldl(max, missing value, xs)
foldl(max, missing value, xs)
end maximumBy
end maximumBy



-- min :: Ord a => a -> a -> a
-- min :: Ord a => a -> a -> a
Line 468: Line 487:
end if
end if
end min
end min



-- mReturn :: First-class m => (a -> b) -> m (a -> b)
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
Line 480: Line 500:
end if
end if
end mReturn
end mReturn



-- Egyptian multiplication - progressively doubling a list, appending
-- Egyptian multiplication - progressively doubling a list, appending
Line 497: Line 518:
return out & dbl
return out & dbl
end replicate
end replicate



-- showList :: [a] -> String
-- showList :: [a] -> String
Line 515: Line 537:
end if
end if
end showList
end showList



-- take :: Int -> [a] -> [a]
-- take :: Int -> [a] -> [a]
Line 547: Line 570:
end if
end if
end take
end take



-- takeWhile :: (a -> Bool) -> [a] -> [a]
-- takeWhile :: (a -> Bool) -> [a] -> [a]
Line 563: Line 587:
end if
end if
end takeWhile
end takeWhile



-- transpose :: [[a]] -> [[a]]
-- transpose :: [[a]] -> [[a]]
Line 582: Line 607:
map(cols, item 1 of rows)
map(cols, item 1 of rows)
end transpose
end transpose



-- unlines :: [String] -> String
-- unlines :: [String] -> String
Retrieved from "https://rosettacode.org/wiki/Longest_common_prefix"