Related
For example, I need a function:
gather :: Int -> [a] -> [[a]]
gather n list = ???
where gather 3 "Hello!" == ["Hel","ell","llo","ol!"].
I have a working implementation:
gather :: Int-> [a] -> [[a]]
gather n list =
unfoldr
(\x ->
if fst x + n > length (snd x) then
Nothing
else
Just
(take
n
(drop
(fst x)
(snd x)),
(fst x + 1, snd x)))
(0, list)
but I am wondering if there is something already built into the language for this? I scanned Data.List but didn't see anything.
You could use tails:
gather n l = filter ((== n) . length) $ map (take n) $ tails l
or using takeWhile instead of filter:
gather n l = takeWhile ((== n) . length) $ map (take n) $ tails l
EDIT: You can remove the filter step by dropping the last n elements of the list returned from tails as suggested in the comments:
gather n = map (take n) . dropLast n . tails
where dropLast n xs = zipWith const xs (drop n xs)
The dropping of tails can be arranged for automagically, thanks to the properties of zipping,
import Data.List (tails)
g :: Int -> [a] -> [[a]]
g n = foldr (zipWith (:)) (repeat []) . take n . tails
or else a simple transpose . take n . tails would suffice. Testing:
Prelude Data.List> g 3 [1..10]
[[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7],[6,7,8],[7,8,9],[8,9,10]]
Prelude Data.List> transpose . take 3 . tails $ [1..10]
[[1,2,3],[2,3,4],[3,4,5],[4,5,6],[5,6,7],[6,7,8],[7,8,9],[8,9,10],[9,10],[10]]
(edit 2018-09-16:) The use of zipping can be expressed on a higher level, with traverse ZipList:
g :: Int -> [a] -> [[a]]
g n = getZipList . traverse ZipList . take n . tails
Function, which finds in the list of integers one of the longest ordered increments of subscripts (not necessarily consecutive) numbers. Example:
• Sequence [21,27,15,14,18,16,14,17,22,13] = [14,16,17,22]
I have a problem with the function which takes the initial number from the array, and looks for a sequence:
fstLen:: Int -> [Int] -> [Int]
fstLen a [] = a: []
fstLen x (l:ls) = if x < l then x:(fstLen l ls) else fstLen x ls
I have problems in place, 14,18,16,14,17,22,13
14 < 18 but then 18 > 16 and my algorithm takes the number 16 as the basis and is looking for a new sequence and I need to go back to 14
How can I do it?
(sorry for my english)
You could always just use subsequences from Data.List to get all the possible subsequences in a list. When you get these subsequences, just take the sorted ones with this function and filter:
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted(x:y:xs) = x <= y && isSorted (y:xs)
Then get the maximum length subsequence with maximumBy(or another method), with the ordering being comparinglength.
Here is what the code could look like:
import Data.Ord (comparing)
import Data.List (subsequences, maximumBy, nub)
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted(x:y:xs) = x <= y && isSorted (y:xs)
max_sequence :: (Ord a) => [a] -> [a]
max_sequence xs = maximumBy (comparing length) $ map nub $ filter isSorted (subsequences xs)
Which seems to work correctly:
*Main> max_sequence [21,27,15,14,18,16,14,17,22,13]
[14,16,17,22]
Note: used map nub to remove duplicate elements from the sub sequences. If this is not used, then this will return [14,14,17,22] as the maximum sub sequence, which may be fine if you allow this.
A more efficient n log n solution can be done by maintaining a map where
keys are the first element of an increasing sequence.
values are a tuple: (length of the sequence, the actual sequence)
and the map maintains the invariance that for each possible size of an increasing sequence, only the lexicographically largest one is retained.
Extra traceShow bellow to demonstrate how the map changes while folding from the end of the list:
import Debug.Trace (traceShow)
import Data.Map (empty, elems, insert, delete, lookupGT, lookupLT)
-- longest (strictly) increasing sequence
lis :: (Ord k, Show k, Foldable t) => t k -> [k]
lis = snd . maximum . elems . foldr go empty
where
go x m = traceShow m $ case x `lookupLT` m of
Nothing -> m'
Just (k, v) -> if fst a < fst v then m' else k `delete` m'
where
a = case x `lookupGT` m of
Nothing -> (1, [x])
Just (_, (i, r)) -> (i + 1, x:r)
m' = insert x a m
then:
\> lis [21,27,15,14,18,16,14,17,22,13]
fromList []
fromList [(13,(1,[13]))]
fromList [(22,(1,[22]))]
fromList [(17,(2,[17,22])),(22,(1,[22]))]
fromList [(14,(3,[14,17,22])),(17,(2,[17,22])),(22,(1,[22]))]
fromList [(16,(3,[16,17,22])),(17,(2,[17,22])),(22,(1,[22]))]
fromList [(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(14,(4,[14,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(15,(4,[15,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(15,(4,[15,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(27,(1,[27]))]
[15,16,17,22]
It is not necessary to retain the lists within the map. One can reconstruct the longest increasing sequence only using the keys and the length of the sequences (i.e. only the first element of the tuples).
Excellent question! Looking forward to a variety of answers.
Still improving my answer. The answer below folds to build increasing subsequences from the right. It also uses the the list monad to prepend new elements to subsequences if the new element is smaller than the head of the subsequence. (This is my first real application of the list monad.) For example,
λ> [[3], [1]] >>= (prepIfSmaller 2)
[[2,3],[3],[1]]
This solution is about as short as I can make it.
import Data.List (maximumBy)
maxSubsequence :: Ord a => [a] -> [a]
maxSubsequence [] = []
maxSubsequence xs = takeLongest $ go [] xs
where
takeLongest :: Ord a => [[a]] -> [a]
takeLongest = maximumBy (\ x y -> compare (length x) (length y))
go :: Ord a => [[a]] -> [a] -> [[a]]
go = foldr (\x subs -> [x] : (subs >>= (prepIfSmaller x)))
where prepIfSmaller x s#(h:_) = (if x < h then [x:s] else []) ++ [s]
Quick test.
λ> maxSubsequence [21,27,15,14,18,16,14,17,22,13]
[15,16,17,22]
For instance, I want to extract from a list the numbers that end in 67: 1637767, 9967, 523467...
Compare them modulo 100:
let result = filter ((== 67) . (`mod` 100)) numbers
The other answers will work if all you want is to match a 2-digit number. Here is a more generalized solution:
import Data.List (isSuffixOf)
extractSuff :: Int -> [Int] -> [Int]
extractSuff n xs = filter (\x -> isSuffixOf (show n) (show x)) xs
EDIT:
Upon Guvante's suggestion, I'm adding another solution which doesn't stringify numbers.
extractSuff' :: Int -> [Int] -> [Int]
extractSuff' n xs = filter (\x -> n == (x `mod` (10 ^ (numDigits n)))) xs
where numDigits n
| abs n < 10 = 1
| otherwise = 1 + numDigits (n `div` 10)
I was given an assignment in my functional programming course that asks me to rewrite several functions, like map and filter to be tail recursive.
I'm not 100% sure how to go about this yet but I know that you can define functions by calling foldr and foldl. I know foldl is tail recursive, so if I can define say, filter with foldl, would it become tail recursive, too?
There are two ways to make a recursive function tail recursive:
Convert the function to accumulator passing style. This only works in some cases.
Convert the function to continuation passing style. This works in all cases.
Consider the definition of the map function:
map :: (a -> b) -> [a] -> [b]
map _ [] = []
map f (x:xs) = f x : map f xs
In accumulator passing style, we have an additional argument which accumulates the result:
mapA :: (a -> b) -> [a] -> [b] -> [b]
mapA _ [] = id
mapA f (x:xs) = mapA f xs . (f x :)
The original map function can be recovered as follows:
map :: (a -> b) -> [a] -> [b]
map f xs = reverse $ mapA f xs []
Note that we need to reverse the result. This is because mapA accumulates the result in reverse:
> mapA (+1) [1,2,3,4,5] []
> mapA (+1) [2,3,4,5] [2]
> mapA (+1) [3,4,5] [3,2]
> mapA (+1) [3,5] [4,3,2]
> mapA (+1) [5] [5,4,3,2]
> mapA (+1) [] [6,5,4,3,2]
> [6,5,4,3,2]
Now, consider continuation passing style:
mapK :: (a -> b) -> [a] -> ([b] -> r) -> r
mapK _ [] k = k []
mapK f (x:xs) k = mapK f xs (k . (f x :))
The original map function can be recovered as follows:
map :: (a -> b) -> [a] -> [b]
map f xs = mapK f xs id
Note that we do not need to reverse the result. This is because although mapK accumulates the continuations in reverse, yet when finally applied to the base case the continuations are unfolded to produce the result in the correct order:
> mapK (+1) [1,2,3,4,5] id
> mapK (+1) [2,3,4,5] (id . (2:))
> mapK (+1) [3,4,5] (id . (2:) . (3:))
> mapK (+1) [4,5] (id . (2:) . (3:) . (4:))
> mapK (+1) [5] (id . (2:) . (3:) . (4:) . (5:))
> mapK (+1) [] (id . (2:) . (3:) . (4:) . (5:) . (6:))
> (id . (2:) . (3:) . (4:) . (5:) . (6:)) []
> (id . (2:) . (3:) . (4:) . (5:)) [6]
> (id . (2:) . (3:) . (4:)) [5,6]
> (id . (2:) . (3:)) [4,5,6]
> (id . (2:)) [3,4,5,6]
> id [2,3,4,5,6]
> [2,3,4,5,6]
Note, that in both cases we're doing twice the required amount of work:
First, we accumulate an intermediate result in reverse order.
Next, we produce the final result in the correct order.
Some functions can be written efficiently in the accumulator passing style (e.g. the sum function):
sumA :: Num a => [a] -> a -> a
sumA [] = id
sumA (x:xs) = sumA xs . (+ x)
The original sum function can be recovered as follows:
sum :: Num a => [a] -> a
sum xs = sumA xs 0
Note that we don't need to do any post processing on the result.
However, list functions written in tail recursive style always need to be reversed. Hence, we do not write list functions in tail recursive style. Instead, we depend upon laziness to process only as much of the list as required.
It should be noted that continuation passing style is just a special case of accumulator passing style. Since foldl is both tail recursive and uses an accumulator, you can write mapA and mapK using foldl as follows:
mapA :: (a -> b) -> [a] -> [b] -> [b]
mapA f xs acc = foldl (\xs x -> f x : xs) acc xs
mapK :: ([b] -> r) -> (a -> b) -> [a] -> r
mapK k f xs = foldl (\k x xs -> k (f x : xs)) k xs []
For, mapK if you take the k to be id then you get map:
map :: (a -> b) -> [a] -> [b]
map f xs = foldl (\k x xs -> k (f x : xs)) id xs []
Similarly, for filter:
filter :: (a -> Bool) -> [a] -> [a]
filter p xs = foldl (\k x xs -> k (if p x then x : xs else xs)) id xs []
There you have it, tail recursive map and filter functions. However, don't forget that they are actually doing twice the work. In addition, they won't work for infinite lists because the result will not be generated until the end of the list is reached (which will never happen for infinite lists).
I'm suspecting the professor/lecturer is expecting solutions where tail recursion is used "directly", i.e. lexically, within the source code of the function, not indirectly, or "dynamically", where tail recursion only happens at runtime within the scope of some subroutine call.
Otherwise, you might as well supply e.g. Prelude.foldl as the implementation for a custom foldl of yours, since it, possibly, uses tail recursion under the hood, and thus does yours:
import Prelude as P
foldl = P.foldl
but obviously something like that wouldn't be accepted.
How can you remove every nth element of a string?
I'm guessing you would use the drop function in some kind of way.
Like this drops the first n, how can you change this so only drops the nth, and then the nth after that, and so on, rather than all?
dropthem n xs = drop n xs
Simple. Take (n-1) elements, then skip 1, rinse and repeat.
dropEvery _ [] = []
dropEvery n xs = take (n-1) xs ++ dropEvery n (drop n xs)
Or in showS style for efficiency's sake
dropEvery n xs = dropEvery' n xs $ []
where dropEvery' n [] = id
dropEvery' n xs = (take (n-1) xs ++) . dropEvery n (drop n xs)
-- groups is a pretty useful function on its own!
groups :: Int -> [a] -> [[a]]
groups n = map (take n) . takeWhile (not . null) . iterate (drop n)
removeEveryNth :: Int -> [a] -> [a]
removeEveryNth n = concatMap (take (n-1)) . groups n
remove_every_nth :: Int -> [a] -> [a]
remove_every_nth n = foldr step [] . zip [1..]
where step (i,x) acc = if (i `mod` n) == 0 then acc else x:acc
Here's what the function does:
zip [1..] is used to index all items in the list, so e.g. zip [1..] "foo" becomes [(1,'f'), (2,'o'), (3,'o')].
The indexed list is then processed with a right fold which accumulates every element whose index is not divisible by n.
Here's a slightly longer version that does essentially the same thing, but avoids the extra memory allocations from zip [1..] and doesn't need to calculate modulus.
remove_every_nth :: Int -> [a] -> [a]
remove_every_nth = recur 1
where recur _ _ [] = []
recur i n (x:xs) = if i == n
then recur 1 n xs
else x:recur (i+1) n xs
Try to combine take and drop to achieve this.
take 3 "hello world" = "hel"
drop 4 "hello world" = "o world"
I like the following solution:
del_every_nth :: Int -> [a] -> [a]
del_every_nth n = concat . map init . group n
You just have to define a function group which groups a list in portions of length n. But that's quite easy:
group :: Int -> [a] -> [[a]]
group n [] = []
group n xs = take n xs : group n (drop n xs)