# How to make a ReplaceAll Rule for adjacent items in a list?

I would like to make only one pass of a list of 2D items and replace adjacent items that have matching $x$ or $y$ coordinates with a series of linearly interpolated points between the two points. My attempt to construct this rule for matching $x$ coordinates is being met by a syntax error.

Minimal example:

{{4, 5}, {1, 2}, {1, 5}, {3, 5}} /. ({x_, j_}, {x_, k_}) ->
Table[{x, j + n (k - j)/3}, {n, 0, 3}]
Syntax::sntxf: "(" cannot be followed by "{x_,j_},{x_,k_})".


I am expecting

{{4, 5}, {1, 2}, {1, 3}, {1, 4}, {1, 5}, {3, 5}}

• Will there ever be lists where there are three adjacent pairs with the same first element? Oct 1, 2015 at 20:40
• And will the second elements of the list always be in order from largest to smallest? Oct 1, 2015 at 20:46
• @march Yes, there is no limit to how many adjacent elements there are. I thought the rule would pick these up due to the way rules work. Largest to smallest does not matter as the formula will still work. It will subtract instead of add in this case. Oct 1, 2015 at 20:55
• In that case, I think it will be very difficult to do this in precisely "one pass". I think I have a solution in "three" passes, but I'm still working on it. Oh and one more question: You always want to fill in exactly two more points between the adjacent ones, or does it depend on the difference between the second elements of the adjacent pairs? Oct 1, 2015 at 20:59
• @march The number of interpolated points will be variable. I just picked 2 and integers for the example to keep it simple. Oct 1, 2015 at 22:11

You might find useful this other approach which is not using ReplaceAll:

foo[___, {x_, j_}, {x_, k_}] :=
Sequence @@ Rest@Table[{x, j + n (k - j)/3}, {n, 0, 3}]

foo[__, s_] := s


then for any number of adjacent items with matching x, for example

testlist = {{4, 5}, {1, 2}, {1, 5}, {1, 7}, {3, 7}}


just run

FoldList[foo,testlist]
(* FoldList[foo, First@testlist, Rest@testlist] for versions < 10 *)

{{4, 5}, {1, 2}, {1, 3}, {1, 4}, {1, 5}, {1, 17/3}, {1, 19/3}, {1, 7}, {3, 7}}


If you need also, as I understand, the same interpolation when adjacent y are the same, just add the definition:

foo[___, {j_, y_}, {k_, y_}] :=
Sequence @@ Rest@Table[{j + n (k - j)/3, y}, {n, 0, 3}]


then with the same FoldList command than above you get now

{{4, 5}, {1, 2}, {1, 3}, {1, 4}, {1, 5}, {1, 17/3}, {1, 19/3}, {1, 7}, {5/3, 7},


{7/3, 7}, {3, 7}}

• The FoldList two arguments syntax has been introduced silently with version 10. I added the traditional 3 arguments syntax for older versions. Oct 2, 2015 at 11:27
• I was not originally looking for FoldList but this answer will be the easiest to follow when I (or more importantly, someone else) comes across it again so I have selected it. Oct 19, 2015 at 19:18
{{4, 5}, {1, 2}, {1, 5}, {3, 5}} /.
{a : ___,  b : PatternSequence[{x_, j_}, {x_, k_}], c : ___} :>
{a, Sequence @@ Table[{x, j + n (k - j)/3}, {n, 0, 3}], c}

(* {{4, 5}, {1, 2}, {1, 3}, {1, 4}, {1, 5}, {3, 5}} *)


Edit

For supporting multiple adjacent values you may do the much more convoluted:

g[x_] := Module[{s = 3 Length@x - 2},
{x[[1, 1]], Interpolation[x[[All, 2]], InterpolationOrder -> 1][#]} & /@
Rescale[Range@s, {1, s}, {1, Length@x}]]
g[x : {{__}}] := x
f[l_] := Flatten[g /@ SplitBy[l, First], 1]

l = {{4, 5}, {1, 2}, {1, 5}, {1, 8}, {3, 5}, {3, 7}};
f@l

(*
{{4, 5},
{1, 2}, {1, 3}, {1, 4}, {1, 5}, {1, 6}, {1, 7}, {1, 8},
{3, 5}, {3, 17/3}, {3, 19/3}, {3, 7}}
*)

• There is a problem! See @Edmund's comment on his question! Oct 1, 2015 at 20:59
• @march I try to disregard "and this case too" question-upgrading comments. Oct 1, 2015 at 21:03
• Yeah, that seems like a reasonable practice, actually. I mean, I've just made more work for myself. Oct 1, 2015 at 21:06
• @march The full solution to a problem always include corner cases the OP should try to work out on his own.[{3,4},{1,2},{1,2},{8,7}} ..... Oct 1, 2015 at 21:41
• Very nice. Sorry to make you work harder :) Oct 1, 2015 at 22:45

Here is my extension of the belisarius' first solution for the case of arbitrary number of elements in the sequence with matching $x$ coordinate (the sequence is still allowed to be only one):

{{4, 5}, {1, 2}, {1, 8}, {1, 7}, {3, 5}} /.
{a : ___, b : Longest@Repeated[{x_, _}, {2, Infinity}], c : ___} :>
{a,
Sequence @@
Flatten[MovingMap[Most[Subdivide[#[[1]], #[[2]], 3]] &, {b}[[;; , 2]], 1]],
{b}[[-1, 2]]]}, {2, Automatic}, x]],
c}

{{4, 5}, {1, 2}, {1, 4}, {1, 6}, {1, 8}, {1, 23/3}, {1, 22/3}, {1, 7}, {3, 5}}


If the number of sequences with matching $x$ coordinate is arbitrary, there probably is no way to avoid Split:

l = {{4, 5}, {1, 2}, {1, 8}, {1, 7}, {3, 5}, {3, 7}, {3, 4}};

subd[s : {{_, _}}] := s;
subd[s : {{x_, _} ..}] :=

{{4, 5}, {1, 2}, {1, 4}, {1, 6}, {1, 8}, {1, 23/3}, {1, 22/3}, {1, 7}, {3, 5},

• Many thanks for assisting with this but the FoldList (although I did ask for ReplaceAll answer seems like it will be easier to follow so easier to support. Oct 19, 2015 at 19:16