Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to write this function idiomatically?

I am looking for a function which tests a predicate on the elements of a list, creates a new list for each element which satisfies the predicate and applies a function only to that element.

Example:

someFunction :: (a -> Bool) -> (a -> a) -> [a] -> [[a]]
someFunction = ...

let ys = someFunction isOdd (* 2) [1..10]
    {- ys == [[2, 2, 3, 4, 5,  ...],
              [1, 2, 6, 4, 5,  ...],
              [1, 2, 3, 4, 10, ...],
              ...] -}

In ys, the first list is equal to the original one, except the first element, which satisfies the predicate and is multiplied by 2. The second list is also equal to the original one, except the third element, and so on.

I have been able to write such a function by taking the indices of the values which satisfy the predicate and then mapping through the indices. However, this doesn't seem very functional and I would like to see a more idiomatic approach.

like image 721
aochagavia Avatar asked Sep 25 '14 08:09

aochagavia


3 Answers

You can assemble this function from pieces which either are standard or should be. The accepted answer has the right clue about zippers. My answer about differentiation and comonads gives a general treatment of the relevant operations, but let me be specific here.

I define the type of "lists with one element hole" as follows:

data Bwd x = B0 | Bwd x :< x deriving Show
type HoleyList x = (Bwd x, [x])

Strictly speaking, I don't need to introduce backward lists to do that, but I get so easily confused if I have to reverse things in my head. (It so happens that HoleyList is the formal derivative of [].)

I can now define what it is to be a list element in its context.

type InContext x = (HoleyList x, x)

The idea is that the second component of the pair belongs in between the backward list and the forward list. I can define the function which plugs the list back together (Called upF in the generic treatment.)

plug :: InContext x -> [x]
plug ((B0, xs), y)      = y : xs
plug ((xz :< x, xs), y) = plug ((xz, y : xs), x)

I can also define the function that gives all the ways to take a list apart (downF, generically).

selections :: [x] -> [InContext x]
selections = go B0 where
  go xz [] = []
  go xz (x : xs) = ((xz, xs), x) : go (xz :< x) xs

Note that

map snd  (selections xs) = xs 
map plug (selections xs) = map (const xs) xs

And now we're good to follow Bartek's recipe.

selectModify :: (a -> Bool) -> (a -> a) -> [a] -> [[a]]
selectModify p f = map (plug . (id *** f)) . filter (p . snd) . selections

That is: filter the selections by the test, apply the function to the element in focus, then plug back together. If you have the zipper equipment lying about, it's a one-liner, and it should work for any differentiable functor, not just lists! Job done!

> selectModify ((1 ==) . (`mod` 2)) (2*) [1..10]
[[2,2,3,4,5,6,7,8,9,10]
,[1,2,6,4,5,6,7,8,9,10]
,[1,2,3,4,10,6,7,8,9,10]
,[1,2,3,4,5,6,14,8,9,10]
,[1,2,3,4,5,6,7,8,18,10]]
like image 192
pigworker Avatar answered Nov 16 '22 08:11

pigworker


How about that:

Start with a list:

[1,2,3,4]

Copy the list n times, n being its size (:: [[]]):

[
 [1,2,3,4],
 [1,2,3,4],
 [1,2,3,4],
 [1,2,3,4]
]

Split the lists on every element (more or less "diagonally") (:: [([], [])]):

[
 ([],[1,2,3,4]),
 ([1],[2,3,4]),
 ([1,2],[3,4]),
 ([1,2,3],[4])
]

Filter out the lines on which head . snd doesn't satisfy your predicate

[
 ([],    [1,2,3,4]),
 ([1,2], [3,4])
]

Apply your function on the remaining heads

[
 ([],    [2,2,3,4])
 ([1,2], [6,4]),
]

Concatenate the pairs back

[
 [2,2,3,4],
 [1,2,6,4]
]
like image 5
Bartek Banachewicz Avatar answered Nov 16 '22 08:11

Bartek Banachewicz


You can use a finger (like a zipper :D you move your finger over each item :D as when you read)

someFunction :: (a -> Bool) -> (a -> a) -> [a] -> [[a]]
someFunction check f xs = r [] xs
  where r _  []     = []
        r ps (y:ys) = let rs = r (ps ++ [y]) ys
                      in  if check y then [ps ++ [f y] ++ ys] ++ rs
                                     else rs

r function take ps "processed elements" and (y:ys) "pending elements".

If you need linear cost (ps ++ [y] operation do it cuadratic) use efficient tail insertion struct.

Using splitAt you can write

someFunction check f xs = map (\(a,(x:b)) -> a ++ [f x] ++ b) $
                          filter (check.head.snd)
                          [splitAt n xs | n <- [0..length xs - 1]]

Or using list comprehension

someFunction check f xs =
    [ a ++ [f x] ++ b | n <- [0..length xs - 1]
                      , let (a, (x:b)) = splitAt n xs
                      , check x]

Using zip suggested by @chi the solution take linear cost (generating lists, finally is O(n^2))

someFunction check f xs = 
    [ a ++ [f x] ++ b | (a, (x:b)) <- init $ zip (inits xs) (tails xs)
                      , check x]

Finally (?) @ØrjanJohansen note to remove init $ (I leave both versions, I think is a great example)

Avoiding init $

someFunction check f xs = 
    [ a ++ [f x] ++ b | (a, (x:b)) <- zip (inits xs) (tails xs)
                      , check x]

last (xs, []) "zipped" element is avoided by the list comprehension, @ØrjanJohansen has pointed here how it is translated

[e | p <- l, Q] = let ok p = [e | Q]
                      ok _ = []
                  in concatMap ok l

(thx @WillNess)

like image 4
josejuan Avatar answered Nov 16 '22 10:11

josejuan