Shrinking or extending element regions in a list?

Question

Consider a list containing zeros and ones:

list = {0,0,0,1,1,1,0,0,0,0,0,0,1,1,1,1,0,0,0,0,1,0,0,0,1,1,1,1};

I would like to have a function that takes the above list as input and returns another list, which has the regions containing 1's either shrunk by one to the left and right, or extended by one to left and right. I.e.:

extend[list]

{0,0,1,1,1,1,1,0,0,0,0,1,1,1,1,1,1,0,0,1,1,1,0,1,1,1,1,1}

shrink[list]

{0,0,0,0,1,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,1,1,0}

I know how to implement this in terms of a trivial Do loop, but I suspect that there might be a different quick and elegant solution. Is there a neat way to do this?

Update

Here is my ugly Frankenstein (p=1 to extend p=0 to shrink):

extendORshrink[x_,p_] := Block[{inp, tmp},
  inp = x; tmp = {};
  Do[If[x[[i]] =!= x[[i + 1]], AppendTo[tmp, {i, i + 1}]];, {i, 1, Length[x] - 1}];
  Do[inp[[tmp[[i, 1]]]] = p; inp[[tmp[[i, 2]]]] = p;, {i, 1, Length[tmp]}];
  inp
  ]

Answer 1

extendF = Join @@ (Split[#, UnsameQ] /.
   {{1, 0} | {0, 1} -> {1, 1}, {0, 1, 0} -> {1, 1, 1}}) &;
extendF@list

{0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1}

shrinkF = Join @@ (Split[#] /.  
  a : {1 ..} :> If[Length[a] == 1, {0}, {0, ## & @@ Most[Rest@a], 0}]) &;
shrinkF@list

{0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0}

Answer 2

It looks like what you wish is called Dilation and Erosion :)

Dilation[list, {1, 1, 1}]
Erosion[list, {1, 1, 1}, Padding -> 0]

{0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1}

{0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0}

Answer 3

Never forget ListCorrelate and Unit*** operations when trying to deal with near range interactions in lists. This type of array style operations is extremely speedy, effective in these cases!

I suppose this is more close to what's in your mind, right? :)

corr[list_] := ListCorrelate[{1, 1, 1}, list, {2, 2}, 0]
extend = Sign@*corr;
shrink = UnitStep[corr[#] - 3] &;

---

A brief explanation in Q&A style:

Q: What do you mean by "extend"?

A: Obviously I mean I would like some place to become 1 when its neighbour or itself is 1!

Q: Then how can you deternmin whether there's a 1 in a number's neighbourhood?

A: Hummm, probably for each position, add the left, the right and itself, and check if it's zero? Well, I got it, ListCorrelate handles the summation well, and an extra Sign can do the checking!

Q: Well, almost there, but how you deal with boundary? Boundary only has one neighbour!

A: probably imaging some value outside the boundary to zero will be a good choice, so that where encountering 0,0,0}, we make up a 0 outside the } so it becomes 0,0,0},0 and we can deal with it in our normal way! the boundary value will keep 0 in this case, perfect! Also I remember the third argument and the fourth is just designed for this!

Q: Great, then similarly, how to handle shrink?

A: Let me think, well, what I need is probably check whether a value itself and its neighbours are all one and left only this type 1! So a UnitStep[sum-3] operation will be perfect!

Q: Well, it seems that there's a lot of similarities in this two cases~

A: Ah, I know, let's write the stuffs together, let's call it corr which do all the summation work and the rest do the result processing!

Q: Great!

Hope this helps~