5

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.

Will Ness
  • 70,110
  • 9
  • 98
  • 181
aochagavia
  • 5,887
  • 5
  • 34
  • 53

4 Answers4

9

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]]
Community
  • 1
  • 1
pigworker
  • 43,025
  • 18
  • 121
  • 214
5

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]
]
Bartek Banachewicz
  • 38,596
  • 7
  • 91
  • 135
4

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)

josejuan
  • 9,338
  • 24
  • 31
  • 1
    A traversing lens could also be seen as a finger. – Bartek Banachewicz Sep 25 '14 at 09:09
  • 1
    The last `zip` suggestion is essentially the idiom I would have used to write this quickly myself, but I'll just add a note that you don't need the `init $` part - the last pair is automatically filtered away by the `(a, (x:b))` pattern. – Ørjan Johansen Sep 25 '14 at 22:01
  • @ØrjanJohansen I thought `Non-exhaustive patterns` error would be reported. Great example! Thx! – josejuan Sep 26 '14 at 07:05
  • The "desugar do notation" does not work because the usually simple `do p <- e1; e2` -> `e1 >>= \p -> e2` is *not* actually the [precise official desugaring](http://www.haskell.org/onlinereport/haskell2010/haskellch3.html#x8-470003.14) - and this case when `p` is a pattern that can fail is precisely where it breaks. – Ørjan Johansen Sep 26 '14 at 07:41
  • desugared list comprehension is a code using `concatMap`, not `do`... :) – Will Ness Sep 26 '14 at 14:45
4

Looking through all the nice and mostly somewhat fancy solutions posted here (which include @josejuan's last zip-based one, which is essentially the idiom I'd use myself in a hurry), I cannot help feeling the list is missing the really direct, but still idiomatic solution using explicit, lazy recursion - the kind of code you'd probably see in the standard libraries if someFunction had been a standard function. So here's a version of that (including the go worker wrapping you'd also see):

someFunction :: (a -> Bool) -> (a -> a) -> [a] -> [[a]]
someFunction p f xs = go xs where
    go [] = []
    go (x:xs)
      | p x         = (f x : xs) : rest
      | otherwise   = rest
      where
        rest = map (x :) (go xs)
Ørjan Johansen
  • 18,119
  • 3
  • 43
  • 53