high pass filter without losing detail

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]])

Mathematica graphics

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]

Mathematica graphics

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]

Mathematica graphics

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.


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
 ]

enter image description here


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]

Mathematica graphics