Skip to main content
much faster
Source Link
Pillsy
  • 18.6k
  • 2
  • 48
  • 94

We almost want SequenceReplace, but it doesn't quite work because of the way it handles overlapping patters. However, at the potential cost of some inefficiency, we can combine it with FixedPoint to get the result we want.

First, a utility function to do the interpolation:

lerp[x_, y_, n_] :=
 Interpolation[{{0, x}, {n + 1, y}}, InterpolationOrder -> 1][
  Range[1, n]]

With that, it gives the result you want:

FixedPoint[
 SequenceReplace[{x_Real, xs : "xx" .., y_Real} :>
   With[{n = Length@{xs}}, 
    Sequence @@ Flatten[{x, lerp[x, y, n], y}]]],
 testy]
(* {1.1, 2.4, 3.5, 2.5, 3., 3.5, 4., 4.5, 8.5, 7.5, 6.5, 5.5, 4.5, 6.5, \
8.5} *) 

EDIT

Unfortunately, with large data sets this is slow as all get-out. If you want speed, just use Interpolation directly, as suggested by Jean-Pierre and klgr. However, you can speed this up even more by using the third argument of Pick, instead of Cases.

With[{n = 1000},
  SeedRandom[1];
  testx = 
   MapAt["xx" &, RandomReal[100, n], 
    List /@ RandomSample[Range[2, n - 1], n/2]]];

Interpolation[Transpose[{Flatten@Position[#, _Real], Cases[_Real]@#}],
       InterpolationOrder -> 1] /@ Range[Length@#] &[
   testx]; // RepeatedTiming
(* {0.00331371, Null} *)

Interpolation[
   Pick[
    Transpose@{Range@Length@testz, testx},
    testz,
    _Real],
   InterpolationOrder -> 1]; // RepeatedTiming
(* {0.000958979, Null} *)

Given the size of the data set in question, a factor of 3 speed up is nothing to sneeze at.

We almost want SequenceReplace, but it doesn't quite work because of the way it handles overlapping patters. However, at the potential cost of some inefficiency, we can combine it with FixedPoint to get the result we want.

First, a utility function to do the interpolation:

lerp[x_, y_, n_] :=
 Interpolation[{{0, x}, {n + 1, y}}, InterpolationOrder -> 1][
  Range[1, n]]

With that, it gives the result you want:

FixedPoint[
 SequenceReplace[{x_Real, xs : "xx" .., y_Real} :>
   With[{n = Length@{xs}}, 
    Sequence @@ Flatten[{x, lerp[x, y, n], y}]]],
 testy]
(* {1.1, 2.4, 3.5, 2.5, 3., 3.5, 4., 4.5, 8.5, 7.5, 6.5, 5.5, 4.5, 6.5, \
8.5} *) 

We almost want SequenceReplace, but it doesn't quite work because of the way it handles overlapping patters. However, at the potential cost of some inefficiency, we can combine it with FixedPoint to get the result we want.

First, a utility function to do the interpolation:

lerp[x_, y_, n_] :=
 Interpolation[{{0, x}, {n + 1, y}}, InterpolationOrder -> 1][
  Range[1, n]]

With that, it gives the result you want:

FixedPoint[
 SequenceReplace[{x_Real, xs : "xx" .., y_Real} :>
   With[{n = Length@{xs}}, 
    Sequence @@ Flatten[{x, lerp[x, y, n], y}]]],
 testy]
(* {1.1, 2.4, 3.5, 2.5, 3., 3.5, 4., 4.5, 8.5, 7.5, 6.5, 5.5, 4.5, 6.5, \
8.5} *) 

EDIT

Unfortunately, with large data sets this is slow as all get-out. If you want speed, just use Interpolation directly, as suggested by Jean-Pierre and klgr. However, you can speed this up even more by using the third argument of Pick, instead of Cases.

With[{n = 1000},
  SeedRandom[1];
  testx = 
   MapAt["xx" &, RandomReal[100, n], 
    List /@ RandomSample[Range[2, n - 1], n/2]]];

Interpolation[Transpose[{Flatten@Position[#, _Real], Cases[_Real]@#}],
       InterpolationOrder -> 1] /@ Range[Length@#] &[
   testx]; // RepeatedTiming
(* {0.00331371, Null} *)

Interpolation[
   Pick[
    Transpose@{Range@Length@testz, testx},
    testz,
    _Real],
   InterpolationOrder -> 1]; // RepeatedTiming
(* {0.000958979, Null} *)

Given the size of the data set in question, a factor of 3 speed up is nothing to sneeze at.

Source Link
Pillsy
  • 18.6k
  • 2
  • 48
  • 94

We almost want SequenceReplace, but it doesn't quite work because of the way it handles overlapping patters. However, at the potential cost of some inefficiency, we can combine it with FixedPoint to get the result we want.

First, a utility function to do the interpolation:

lerp[x_, y_, n_] :=
 Interpolation[{{0, x}, {n + 1, y}}, InterpolationOrder -> 1][
  Range[1, n]]

With that, it gives the result you want:

FixedPoint[
 SequenceReplace[{x_Real, xs : "xx" .., y_Real} :>
   With[{n = Length@{xs}}, 
    Sequence @@ Flatten[{x, lerp[x, y, n], y}]]],
 testy]
(* {1.1, 2.4, 3.5, 2.5, 3., 3.5, 4., 4.5, 8.5, 7.5, 6.5, 5.5, 4.5, 6.5, \
8.5} *)