7
$\begingroup$

You can get data by this code:

data = Normal[Databin["fHVr7FSi"]]

Visualize it like following

Mathematica graphics

We can find some non derivable points.So when I show its derivative graphic,it will be:

Plot[Evaluate[D[Interpolation[data, x], x]], {x, 
  Sequence @@ MinMax[First /@ data]}]

Mathematica graphics

But I want get this style graphic:

Mathematica graphics

So I smooth the primitive data by MeanFilter

f = Interpolation[
   Transpose[{First /@ data, MeanFilter[Last /@ data, 200]}], x];
Plot[f, {x, Sequence @@ MinMax[First /@ data]}]

Mathematica graphics

But the derivative graphic is ugly still

Plot[Evaluate[D[f, x]], {x, Sequence @@ MinMax[First /@ data]}]

Mathematica graphics

$\endgroup$
  • 1
    $\begingroup$ Probably the derivative based on data is actually that noisy and you have to use some judgment about how to smooth the data. The approach here approximates the curve with (Chebyshev series) polynomial of an appropriately chosen degree. $\endgroup$ – Michael E2 Sep 14 '16 at 3:44
  • $\begingroup$ Does the solution in this post help? BTW, does the URL "http://goo.gl/NaH6rM" still work? $\endgroup$ – xzczd Sep 14 '16 at 6:45
  • $\begingroup$ I think there are some difference with your link?And that link work fine still.Or you can get it by this code data = Normal[Databin["fHVr7FSi"]]? $\endgroup$ – yode Sep 14 '16 at 7:29
  • $\begingroup$ @MichaelE2 I'm sorry for fail to understand that post. $\endgroup$ – yode Sep 14 '16 at 7:33
  • $\begingroup$ since i have some idea what that data represents, I'd suggest your measurement error is likely primarily in the x- data. Try applying MedianFilter to the x instead of y. $\endgroup$ – george2079 Sep 14 '16 at 12:39
10
$\begingroup$

I think one issue is that your initial data is not evenly sampled and thus filtering it directly is not going to do much good in regards to differentiating it.

I propose resampling of the data, filtering, differentiating and possibly filtering the resulting derivative again. For convenience I will use a custom function applyFilter that is again reproduced at the end of this answer.

To resample the data I use Interpolation and Table

interpolation = Interpolation[data];
(resampledData = Table[{x, interpolation@x}, {x, 0, 0.2, 0.0001}] // 
applyFilter[MedianFilter[#, 30] &, MeanFilter[#, 10] &]) // ListPlot

together with applyFilter to apply first a MedianFilter to remove outliers and MeanFilter to smooth the result. (You have to play around with the radius parameters for those filters depending on how fine you want to resample)

For differentiating the data Interpolation is used again

interpolationDiff = Interpolation[resampledData]'; (* note the ' *)

which can be sampled

diffdata = Table[{x, interpolationDiff@x}, {x, 0, 0.2, 0.0001}]

and filtered again via

diffdata //applyFilter[MedianFilter[#, 10] &, MeanFilter[#, 10] &] 

result

Instead of my chosen combination of MedianFilter and MeanFilter you can of course use any other linear/nonlinear filters, which might yield better results.


Definition for applyFilter

Clear@applyFilter;
applyFilter[filter_] := Function[data, 
Module[{freq, value},
{freq, value} = Transpose@data;
Transpose[{freq, filter@value}]
]
];

applyFilter[filters__] := RightComposition @@ (applyFilter /@ {filters})

applyFilter[{filter_, n_}] := Nest[applyFilter[filter], # , n] &
$\endgroup$
  • $\begingroup$ I benefit a lot from your answer.Thanks. :) $\endgroup$ – yode Sep 15 '16 at 2:44
  • $\begingroup$ @yode you are welcome:) $\endgroup$ – Sascha Sep 15 '16 at 6:35
6
$\begingroup$

I see you're smoothing the data, but why not smooth the derivative instead?

(*Take a list of forward differences between points*)
ddata = Differences[Last /@ data];

(*Divide the differences by the difference in `x' value*)
ddata = ddata/Differences[First /@ data];

(*Apply a MeanFilter to the list of forward differences. 
This will be plotted alongside ddata.*)
ddataFiltered = MeanFilter[ddata, 100];

(*Add back in the `x' values so that the data lists are of the form \
{{x1,y1},{x2,y2},...} *)
{ddata, ddataFiltered} = 
  Transpose[{Most[First /@ data], #}] & /@ {ddata, ddataFiltered};

(*Plot it!*)
ListLinePlot[{ddata, ddataFiltered}, PlotStyle -> {Thin,Thick},
 PlotLegends -> {"Unfiltered",
   "Filtered Derivative Data"}, PlotLabel -> "Derivative"]

enter image description here

Applying a MeanFilter to the forward difference may be a bit crude, but the principle is there.

$\endgroup$
  • $\begingroup$ Could you add a comparison of filtered and unfiltered data as well? $\endgroup$ – Sascha Sep 14 '16 at 16:09
  • $\begingroup$ @Sascha - Do you mean a MeanFilter on data with no filter on ddata? $\endgroup$ – Myridium Sep 14 '16 at 16:12
  • $\begingroup$ Just the unfiltered version of ddata for comparison before and after smoothing $\endgroup$ – Sascha Sep 14 '16 at 16:29
  • $\begingroup$ @Sascha - Okay, I've done that. I appreciate the suggestion. $\endgroup$ – Myridium Sep 14 '16 at 16:30

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.