high pass filter without losing detail

Question

I have troubles doing a simple high pass filtering...

Downloading the test data, you can see that overimposed on the signal there are some low frequencies and an almost constant slope, that I'd like to get rid of:

 ListPlot[Import["https://pastebin.com/raw/74J8t2YV", "Table"], Joined -> True]

The problem is that using the following code, to have the signal oscillate around a more-or-less constant line I need to use $h_f > 2 \pi / f_\text{samp}$ (Nyquist), but at frequencies so high the important details of the signal are lost.

Module[{dat, a, times, lf, hf = 1, fl, filt, avgy, fsamp},
 dat = Import[NotebookDirectory[] <> "test.dat"];
 times = dat\[Transpose][[1]];
 a = dat\[Transpose][[2]];
 avgy = Mean[a];
 a = a /. y_ -> y - avgy;  (* not interested in signal offset *)
 
 fsamp = 1/Mean[Differences[times]]; (* sampling slightly irregular *)

  hf = 2 \[Pi] 0.9/fsamp;
 filt = HighpassFilter[a, hf];
 ListPlot[{{times, a}\[Transpose], {times, filt}\[Transpose]}, 
  Joined -> True]]

I'm not an expert at all in frequency analysis, but I did these kind of stuff blindly using Microcal Origin - and there the highpass filtering does not suffer of this drawback... what can be done?

Here is the results in Origin (the signal is the same, I just forgot to subtract the average)

unfortunately the help page doesnt enter into details about the algorithm, where you only choose the cutoff frequency

Answer 1

The default kernel length of HighpassFilter seems to be too small, after modifying it to Round[Length@a/10], the result is almost the same as that of Origin:

times = dat\[Transpose][[1]];
a = dat\[Transpose][[2]];
avgy = Mean[a];
a = a - avgy;
(* Alternative method for obtaining a: *)
(*
   a = Standardize[dat\[Transpose][[2]], Mean, 1 &];
 *)

fsamp = 1/Mean@Differences@times;(*sampling slightly irregular*)
hf = 0.3;(*Found by trial and error *)

filt = HighpassFilter[#, hf, Round[Length@#/10], SampleRate -> Round@fsamp] &@a;

ListLinePlot[{{times, a}\[Transpose], {times, filt}\[Transpose]}, PlotRange -> All]

Answer 2

Here is my take on how to do filtering for a time series. The HighpassFilter you used is I think for image processing.

Import the data and find the sample rate

data = ToExpression[Partition[StringSplit[Import["74J8t2YV.txt"]], 2]];
ListLinePlot[data]
sr = 1/(data[[2, 1]] - data[[1, 1]])

The sample rate is 16.9492 and from the data it looks like you have a main frequency at about 0.2 Hz. The data starts at about 3400 units. I am assuming you wish to get rid of the rising drift. Now check the frequency content by doing a Fourier transform.

ft = Fourier[data[[All, 2]], FourierParameters -> {-1, -1}];
ff = Table[(n - 1) sr/Length[ft], {n, Length[ft]}];
ListLogPlot[Transpose[{ff, Abs@ft}][[1 ;; 500]], PlotRange -> All, 
 Joined -> True]

Looking at the first peak this confirms that there is a frequency of about 0.2 Hz.

Now I build a high pass filter. I start with an analogue Butterworth filter of 4th order and with cut off frequency fp which I set to 0.1Hz. You may wish to play with this value to see what frequency is best for you.

fp = 0.1; (* filter cut off frequency *)
filter = ToDiscreteTimeModel[ 
  ButterworthFilterModel[{"Highpass", 4, fp 2 π}], 1/sr];

Now apply the filter and plot the results.

fd = RecurrenceFilter[filter, data[[All, 2]] - data[[1, 2]]];
ListLinePlot[Transpose[{data[[All, 1]], fd}], PlotRange -> All]

I have taken away the first point of the data so that the filter is not hit by a big step. This value could be adjusted a little and may take out the low frequency initial oscillation.

Hope that helps.

Edit

Following a comment from xzczd I have changed the code for generating the filter by removing division by the sample rate. This is correct there is no need to divide by the sample rate here. Unfortunately the original data has gone so I can't retest the code.

Answer 3

How about LowpassFiltering the signal and subtracting the result from the original?

ListLinePlot[
 Transpose[{
   dat[[All, 1]],
   # - LowpassFilter[#, 0.005] &@dat[[All, 2]]
  }]
 , AspectRatio -> 1/5
 , ImageSize -> 1000
 ]