Counting elements skipped using Reap & Sow

Question

I am using the following code to filter data based on the percentage change between points.

Reap[z = data[[1]]; Sow[z]; 
         Scan[If[Abs[# - z]/z > delta, 
         z = #; Sow[z]] &, data]][[2, 1]]

That is, only considering point that were separated but a certain percentage change.

While it gives me the correct answer, I would like to count the values that are dropped in between each selected point.

How could I do that ?

Answer 1

If you want to count the dropped values, for each application of your distance function you have exactly one outcome. Either the value is fine and included in you list or the value is dropped.

In my opinion a simpler approach is to not use Reap and Sow. Instead, use a simple Map and transform the list afterwards. Furthermore, you have to note that your first element is always dropped because you set z to your first element of the list and get zero in the numerator of your distance function.

Maybe a better approach is here to not include the first element of the list manually but to fix the initial value of z. If your data is always positive, you could do for instance

Block[{z = First[data]/(2 + delta)},
 If[Abs[# - z]/z > delta, z = #; z, Dropped] & /@ data
 ]

Test this in comparison with your function:

data = {7, 1, 8, 9, 6, 3, 1, 2, 4, 3, 7, 9, 2, 7, 3, 9, 7, 1, 10, 3};
delta = .4;

Block[{z = First[data]/(2 + delta)},
 If[Abs[# - z]/z > delta, z = #; z, Dropped] & /@ data
]

(* 
{7, 1, 8, Dropped, Dropped, 3, 1, 2, 4, Dropped, 7, Dropped, 2, 7, 3, 
 9, Dropped, 1, 10, 3}
*)

Now the only thing you have to do is to gather all Dropped symbols, count them and give the other list as your result:

myfilter[data_] := {#1, "Dropped" -> Length[#2]} & @@
  GatherBy[Block[{z = First[data]/(2 + delta)},
    If[Abs[# - z]/z > delta, z = #; z, Dropped] & /@ data
    ], # === Dropped &]

and then

In[68]:= myfilter[data]

Out[68]= {{7, 1, 8, 3, 1, 2, 4, 7, 2, 7, 3, 9, 1, 10, 3}, 
 "Dropped" -> 5}

Update

If you want to build a list where you see where and how many drops happened you could leave out the GatherBy thing and work on the number list with the Dropped inside. Example:

data = {7, 1, 8, 9, 6, 3, 1, 2, 4, 3, 7, 9, 2, 7, 3, 9, 7, 1, 10, 3};
delta = .4;

res = Block[{z = First[data]/(2 + delta)}, 
 If[Abs[# - z]/z > delta, z = #; z, Dropped] & /@ data]

Split[res, #1 === #2 === Dropped &] /. 
   {{i_Integer} :> i, d : {Dropped ..} :> {Length[d]}}

(*
{7, 1, 8, {2}, 3, 1, 2, 4, {1}, 7, {1}, 2, 7, 3, 9, {1}, 1, 10, 3}
*)

I packed the drop-length information inside list braces so one sees what is output and what is drop-information. Note, when I see this right the second argument to Split is not necessary because it cannot happen that there are same numbers next to each other.

Answer 2

Try this:

ignored = 0;
Reap[z = data[[1]]; Sow[z]; 
     Scan[
      If[Abs[# - z]/z > delta, 
         z = #; Sow[z],
         ignored++
      ]&, 
      data
     ]
][[2, 1]]

where I am using the false branch of If to increment the ignored counter.

Answer 3

This is a variation on rcollyer's method - sowing the elements that satisfy the condition as well as lists containing the number of skipped elements and the position of the last skipped element:

    data = RandomInteger[{1, 10}, {100}];
    pos = 0;
    delta = .40;
    skipped = {};
    Reap[z = data[[1]]; Sow[z];
    Scan[(If[Abs[# - z]/z > delta,
      z = #; pos++; 
      If[skipped =!= {}, Sow[{Length@skipped, pos}]]; 
      skipped = {}; Sow[Style[z, Red, Bold, 18]], 
     pos++; skipped = AppendTo[skipped, #]]) &, Rest@data]][[2, 1]]

gives

To verify the results, if you replace Sow[{Length@skipped, pos}] with Sow[#] & /@ skipped you get