0
$\begingroup$

I have experimental data which looks like this enter image description here

In the high positive and negative x-axis regions, my data is always linear, I want to extract the slope of data in these regions, take average and subtract that linear slope from this experimental data.

BMoment = {-0.0000331, -0.0000354, -0.0000334, -0.0000315, -0.0000291, \
-0.0000269, -0.0000251, -0.0000234, -0.0000211, -0.0000189, \
-0.0000173, -0.0000152, -0.0000131, -0.0000114, -9.51*10^-6, \
-9.51*10^-6, -5.75*10^-6, -3.96*10^-6, -2.5*10^-6, -6.15*10^-7, 
 1.29*10^-6, 3.28*10^-6, 4.95*10^-6, 6.9*10^-6, 
 8.81*10^-6, 0.0000107, 0.000012, 0.0000139, 0.0000156, 0.0000172, \
0.0000186, 0.0000199, 0.0000214, 0.0000229, 0.000024, 0.0000259, \
0.0000271, 0.0000284, 0.0000294, 0.0000302, 0.0000314, 0.0000322, \
0.0000331, 0.0000334, 0.0000332, 0.0000331, 0.0000321, 0.0000303, \
0.0000276, "", 
 7.27*10^-6, -8.61*10^-6, -0.000013, -0.0000166, -0.0000189, \
-0.0000208, -0.0000221, -0.0000229, -0.0000236, -0.0000241, \
-0.0000242, -0.0000242, "", -0.0000238, -0.0000224, -0.0000214, \
-0.0000205, -0.0000192, -0.000018, -0.0000168, -0.0000154, \
-0.0000137, -0.0000125, -0.0000109, -9.51*10^-6, -7.62*10^-6, \
-6.17*10^-6, -4.43*10^-6, -2.91*10^-6, -1.1*10^-6, 4.78*10^-7, 
 2.29*10^-6, 3.93*10^-6, 5.83*10^-6, 7.16*10^-6, 
 9.76*10^-6, 0.0000116, 0.0000132, 0.0000152, "", 0.0000198, \
0.0000236, 0.0000257, 0.0000273, 0.0000287, 0.0000303, 0.0000294, \
0.0000278, 0.0000257, 0.0000239, 0.0000223, 0.00002, 0.0000184, \
0.0000163, 0.0000147, 0.0000129, 0.0000111, 9.1*10^-6, 7.39*10^-6, 
 5.42*10^-6, 3.53*10^-6, 2.1*10^-6, 
 6.21*10^-7, -1.29*10^-6, -2.77*10^-6, -3.92*10^-6, -6.09*10^-6, \
-7.55*10^-6, -7.55*10^-6, -0.0000111, -0.0000127, -0.0000146, \
-0.000016, -0.0000176, -0.0000193, -0.0000208, -0.0000223, \
-0.0000237, -0.0000252, -0.0000262, -0.0000262, -0.0000295, \
-0.0000305, -0.0000314, -0.0000327, -0.0000334, -0.0000344, \
-0.0000347, -0.0000353, -0.0000351, -0.0000349, -0.0000342, \
-0.0000326, "", -0.0000197, 5.36*10^-7, 
 7.15*10^-6, 0.0000117, 0.0000154, 0.0000177, 0.0000192, 0.0000209, \
0.0000214, 0.0000221, 0.0000225, 0.0000225, "", 0.0000229, 0.0000216, \
0.0000202, 0.0000194, 0.0000181, 0.0000171, 0.0000164, 0.000015, \
0.0000133, 0.0000122, 0.0000103, "", 5.69*10^-6, 
 2.4*10^-6, -7.92*10^-7, -2.57*10^-6, -3.8*10^-6, -5.73*10^-6, \
-7.57*10^-6, -9.38*10^-6, -0.0000111, -0.0000132, -0.0000148, \
-0.0000169, -0.0000183, -0.0000202, -0.0000218, -0.0000237, \
-0.0000253, -0.000027, -0.0000284, -0.0000306, -0.0000317};

BField = {"10000.39258", 9926.71, 9753.31, 9553.6, 9353.67, 9153.66, \
8953.65, 8753.5, 8553.29, 8353.13, 8153.14, 7953.13, 7752.97, \
7552.86, 7353.25, 7153.36, 6953.29, 6753.62, 6553.47, 6353.31, \
6153.6, 5953.9, 5753.44, 5552.94, 5353.2, 5153.07, 4953.16, 4753.47, \
4553.01, 4353.3, 4153.54, 3953.03, 3752.89, 3552.98, 3353.06, \
3152.92, 2952.87, 2752.98, 2553.19, 2353.5, 2153.44, 1952.88, \
1752.74, 1552.62, 1352.12, 1152.4, 952.428, 752.302, 552.574, 352.34, \
-151.947, -556.781, -652.343, -847.615, -1047.75, -1247.28, -1447.3, \
-1647.63, -1847.38, -2047.14, -2247.47, -2447.92, -2647.83, -3154.02, \
-3559.45, -3653.04, -3846.57, -4047.03, -4247.54, -4446.88, -4646.19, \
-4846.62, -5047.05, -5247.21, -5447.34, -5647.21, -5847.3, -6047.42, \
-6247.12, -6446.82, -6646.87, -6846.88, -7046.54, -7246.27, -7446.34, \
-7646.43, -7846.78, -8046.89, -8246.18, -8446.21, -8951.32, -9356.78, \
-9451.92, -9647.21, -9846.9, -9973.31, -9926.79, -9753.78, -9554.16, \
-9354.13, -9154.55, -8954.45, -8753.93, -8554.08, -8354.06, -8153.96, \
-7954.24, -7754.61, -7554.58, -7354.49, -7154.46, -6954.43, -6754.8, \
-6555.13, -6354.76, -6154.64, -5955.32, -5755.24, -5554.82, -5354.72, \
-5154.56, -4954.41, -4754.38, -4554.55, -4354.45, -4154.76, -3954.64, \
-3754.54, -3555.01, -3355.44, -3155.4, -2954.92, -2755.14, -2555.44, \
-2355.56, -2155.53, -1955.45, -1755.26, -1555.16, -1355.13, -1155.11, \
-954.979, -755.29, -555.501, -51.2047, 353.059, 449.119, 645.156, \
844.884, 1044.6, 1245.1, 1445.18, 1644.92, 1845.08, 2045.35, 2245.77, \
2443.42, 2949.21, 3354.2, 3449.83, 3645.43, 3845.47, 4045.53, 4245.5, \
4445.27, 4644.96, 4845.01, 5045.58, 5245.87, 5750.52, 6154.81, \
6350.27, 6645.9, 6846.01, 7045.71, 7245.51, 7445.61, 7645.62, \
7845.34, 8045.41, 8245.76, 8445.88, 8645.97, 8845.68, 9045.82, \
9246.4, 9446.06, 9645.72, 9845.93, 9973.12};

datalist300K = Transpose@{BField, BMoment};
p1 = ListLinePlot[datalist300K, PlotStyle -> {Blue}];
BMomentDia = (-7.61*10^-9)*BField; (* I found the slope in excel and put it here but I want to automatically find the slope*)
data2 = Transpose@{BField, BMomentDia};
p2 = ListLinePlot[data2, PlotStyle -> {Dashed, Black}];
BMomentProcessed = BMoment - BMomentDia;
data3 = Transpose@{BField, BMomentProcessed};
p3 = ListLinePlot[data3,  PlotStyle -> Red, Frame -> True, 
  FrameTicks -> True, Joined -> True, 
  FrameLabel -> {"Magnetic Field(Oe)", "Magnetization(emu)"}, 
  PlotRange -> {{-10000, 10000}, Automatic}, PlotStyle -> Thick, 
  BaseStyle -> {FontSize -> 15}, AspectRatio -> 3/5, Mesh -> {{0}}, 
  MeshFunctions -> {#2 &}, 
  MeshStyle -> Directive[Black, PointSize[.02]]]

enter image description here

Finally the plotted curve should look something like the one in red, but I also want to extrapolate the missing points in between, how do I go about?

$\endgroup$
0
$\begingroup$

The BMoment has some missing data and the first element of BField is garbled. I manually adjusted BField. With Positionand Extract, you delete the missing data from BMoment and then create an Interpolation to fill in the missing data with a linear interpolation as shown with the code below.

BMoment = {-0.0000331, -0.0000354, -0.0000334, -0.0000315, \
-0.0000291, -0.0000269, -0.0000251, -0.0000234, -0.0000211, \
-0.0000189, -0.0000173, -0.0000152, -0.0000131, -0.0000114, \
-9.51*10^-6, -9.51*10^-6, -5.75*10^-6, -3.96*10^-6, -2.5*10^-6, \
-6.15*10^-7, 1.29*10^-6, 3.28*10^-6, 4.95*10^-6, 6.9*10^-6, 
   8.81*10^-6, 0.0000107, 0.000012, 0.0000139, 0.0000156, 0.0000172, 
   0.0000186, 0.0000199, 0.0000214, 0.0000229, 0.000024, 0.0000259, 
   0.0000271, 0.0000284, 0.0000294, 0.0000302, 0.0000314, 0.0000322, 
   0.0000331, 0.0000334, 0.0000332, 0.0000331, 0.0000321, 0.0000303, 
   0.0000276, "", 
   7.27*10^-6, -8.61*10^-6, -0.000013, -0.0000166, -0.0000189, \
-0.0000208, -0.0000221, -0.0000229, -0.0000236, -0.0000241, \
-0.0000242, -0.0000242, 
   "", -0.0000238, -0.0000224, -0.0000214, -0.0000205, -0.0000192, \
-0.000018, -0.0000168, -0.0000154, -0.0000137, -0.0000125, \
-0.0000109, -9.51*10^-6, -7.62*10^-6, -6.17*10^-6, -4.43*10^-6, \
-2.91*10^-6, -1.1*10^-6, 4.78*10^-7, 2.29*10^-6, 3.93*10^-6, 
   5.83*10^-6, 7.16*10^-6, 9.76*10^-6, 0.0000116, 0.0000132, 
   0.0000152, "", 0.0000198, 0.0000236, 0.0000257, 0.0000273, 
   0.0000287, 0.0000303, 0.0000294, 0.0000278, 0.0000257, 0.0000239, 
   0.0000223, 0.00002, 0.0000184, 0.0000163, 0.0000147, 0.0000129, 
   0.0000111, 9.1*10^-6, 7.39*10^-6, 5.42*10^-6, 3.53*10^-6, 
   2.1*10^-6, 
   6.21*10^-7, -1.29*10^-6, -2.77*10^-6, -3.92*10^-6, -6.09*10^-6, \
-7.55*10^-6, -7.55*10^-6, -0.0000111, -0.0000127, -0.0000146, \
-0.000016, -0.0000176, -0.0000193, -0.0000208, -0.0000223, \
-0.0000237, -0.0000252, -0.0000262, -0.0000262, -0.0000295, \
-0.0000305, -0.0000314, -0.0000327, -0.0000334, -0.0000344, \
-0.0000347, -0.0000353, -0.0000351, -0.0000349, -0.0000342, \
-0.0000326, "", -0.0000197, 5.36*10^-7, 7.15*10^-6, 0.0000117, 
   0.0000154, 0.0000177, 0.0000192, 0.0000209, 0.0000214, 0.0000221, 
   0.0000225, 0.0000225, "", 0.0000229, 0.0000216, 0.0000202, 
   0.0000194, 0.0000181, 0.0000171, 0.0000164, 0.000015, 0.0000133, 
   0.0000122, 0.0000103, "", 5.69*10^-6, 
   2.4*10^-6, -7.92*10^-7, -2.57*10^-6, -3.8*10^-6, -5.73*10^-6, \
-7.57*10^-6, -9.38*10^-6, -0.0000111, -0.0000132, -0.0000148, \
-0.0000169, -0.0000183, -0.0000202, -0.0000218, -0.0000237, \
-0.0000253, -0.000027, -0.0000284, -0.0000306, -0.0000317};

BField = {10000.39258, 9926.71, 9753.31, 9553.6, 9353.67, 9153.66, 
   8953.65, 8753.5, 8553.29, 8353.13, 8153.14, 7953.13, 7752.97, 
   7552.86, 7353.25, 7153.36, 6953.29, 6753.62, 6553.47, 6353.31, 
   6153.6, 5953.9, 5753.44, 5552.94, 5353.2, 5153.07, 4953.16, 
   4753.47, 4553.01, 4353.3, 4153.54, 3953.03, 3752.89, 3552.98, 
   3353.06, 3152.92, 2952.87, 2752.98, 2553.19, 2353.5, 2153.44, 
   1952.88, 1752.74, 1552.62, 1352.12, 1152.4, 952.428, 752.302, 
   552.574, 
   352.34, -151.947, -556.781, -652.343, -847.615, -1047.75, \
-1247.28, -1447.3, -1647.63, -1847.38, -2047.14, -2247.47, -2447.92, \
-2647.83, -3154.02, -3559.45, -3653.04, -3846.57, -4047.03, -4247.54, \
-4446.88, -4646.19, -4846.62, -5047.05, -5247.21, -5447.34, -5647.21, \
-5847.3, -6047.42, -6247.12, -6446.82, -6646.87, -6846.88, -7046.54, \
-7246.27, -7446.34, -7646.43, -7846.78, -8046.89, -8246.18, -8446.21, \
-8951.32, -9356.78, -9451.92, -9647.21, -9846.9, -9973.31, -9926.79, \
-9753.78, -9554.16, -9354.13, -9154.55, -8954.45, -8753.93, -8554.08, \
-8354.06, -8153.96, -7954.24, -7754.61, -7554.58, -7354.49, -7154.46, \
-6954.43, -6754.8, -6555.13, -6354.76, -6154.64, -5955.32, -5755.24, \
-5554.82, -5354.72, -5154.56, -4954.41, -4754.38, -4554.55, -4354.45, \
-4154.76, -3954.64, -3754.54, -3555.01, -3355.44, -3155.4, -2954.92, \
-2755.14, -2555.44, -2355.56, -2155.53, -1955.45, -1755.26, -1555.16, \
-1355.13, -1155.11, -954.979, -755.29, -555.501, -51.2047, 353.059, 
   449.119, 645.156, 844.884, 1044.6, 1245.1, 1445.18, 1644.92, 
   1845.08, 2045.35, 2245.77, 2443.42, 2949.21, 3354.2, 3449.83, 
   3645.43, 3845.47, 4045.53, 4245.5, 4445.27, 4644.96, 4845.01, 
   5045.58, 5245.87, 5750.52, 6154.81, 6350.27, 6645.9, 6846.01, 
   7045.71, 7245.51, 7445.61, 7645.62, 7845.34, 8045.41, 8245.76, 
   8445.88, 8645.97, 8845.68, 9045.82, 9246.4, 9446.06, 9645.72, 
   9845.93, 9973.12};
(* Make an index for parametric function *)
ts = First@Range[0, Dimensions@BMoment - 1];
(* Find positions of missing data in BMomnent *)
pos = Position[BMoment, _?NumericQ];
(* Create Linear Interpolation Functions *)
BMfn = Interpolation[
   Transpose[{Extract[ts, pos], Extract[BMoment, pos]}], 
   InterpolationOrder -> 1];
BFfn = Interpolation[Transpose[{ts, BField}], InterpolationOrder -> 1];
ParametricPlot[{BFfn[u], BMfn[u]}, {u, 0, 
  First@(Dimensions@BMoment - 1)}, AspectRatio -> 1/GoldenRatio, 
 PlotStyle -> Thick, 
 ColorFunction -> Function[{x, y, u}, ColorData["DarkRainbow"][u]]]

Interpolated Data

$\endgroup$
  • $\begingroup$ Thanks, this looks good, how do I extract the slope at high y-axis in both directions (positive and negative), take average and subtract from this raw data? $\endgroup$ – Indeterminate Jun 17 at 13:25
  • $\begingroup$ You can use Last@FindMaximum[{BMfn[u], 50 <= u <= 150}, {u, 100}] to show that the maximum occurs at u->95.5. Then you can differentiate the Interpolating functions on either side of 95.5 to get the slope. For example, (D[BMfn[u], u]/D[BFfn[u], u]) /. u -> 95 and (D[BMfn[u], u]/D[BFfn[u], u]) /. u -> 96. You may want more samples because differentiating experimental data blows up the noise. $\endgroup$ – Tim Laska Jun 17 at 14:34
0
$\begingroup$

Using the fixed value supplied by Tim Laska, you could also do this:

originalData = Transpose[{BField, BMoment}];
originalGoodData = Sort@DeleteCases[originalData, {first_, second_} /; ! NumberQ[second]];
firstRangeEquation = Fit[Select[originalGoodData, -10000 <= #[[1]] <= -6000 &], {1, x}, x];
secondRangeEquation = Fit[Select[originalGoodData, 4000 <= #[[1]] <= 10000 &], {1, x}, x];
Show[{ListLinePlot[originalData], Plot[firstRangeEquation, {x, -10000, -2000}, PlotStyle -> Orange], Plot[secondRangeEquation, {x, 4000, 10000}, PlotStyle -> Purple]}]

The variables firstRangeEquation and secondRangeEquation provide the equations you want.

$\endgroup$

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.