# Superimposed data on top of each other in a Do Loop

If I have 4 different types of data such (that I get from an Excel file) as:

https://pastebin.com/j3Bgfxqm


I am trying to implement a Do loop that extracts the data from the Excel file, superimposes the data in two different regions (as done here: Superimposed curves in two regions), plots the data individually (from the Do loop) and then plots the data all together and superimposed. Here's my approach to everything except superimposing the curves (that's the part I don't know how to implement in the Do loop):

Do[

datTCpc =
Extract[Import["excel file.xlsx"], 1][[3 ;; All, {i, i + 1}]];

store = AppendTo[tts1, datTCpc]; (*Stores the data*)

(*Plotting individually in the do loop*)
Show[
ListLinePlot[datTCpc, PlotStyle -> {Red},
AxesLabel -> {"T (ºC)", "Cp(J/gK)"},
LabelStyle -> {Black, Bold, 14},
PlotLabel -> Style[q2 "K/min", Black, 14]]]

// Print, {i, 1, imax2, 2}]

(*Plots the store data combined - superimposed*)
Show[ListLinePlot[store, PlotStyle -> {Red, Blue, Gray, Black},
LabelStyle -> {Black, Bold, 14}, ImageSize -> Large, Frame -> True,
Axes -> False, GridLines -> Automatic,
GridLinesStyle -> Lighter[Gray, .8], PlotRange -> {{20, 110}, All}]]


How can I superimpose the data using the first region from 29 to 41 (in x-axis data) and the second region from 72 to 85 (in the x-axis data)?

Clarification: By superimposing the curves or the data, I mean simply placing the curves one on top of the other (taking one as the reference and putting the other on top based on two regions).

EDIT

This is how the data will look like superimposed (done manually in Excel), where the two regions are shown in red circles:

It was done by translating or rotating the curves until minimizing the differences.

• Is one curve taken as a reference and the others moved onto it? Are only vertical translations allowed? You say rotations; does that mean that, say, two different vertical translations are allowed for the left and right data? It suggests that I am allowed to add a straight line to each curve to bring them together. – Hugh Jan 12 at 16:41
• Hugh. Yes, you can take any curve as the reference and both vertical and rotation are allowed. Thanks – John Jan 12 at 16:51
• Are all your x values the same? – Hugh Jan 12 at 16:59
• Yes, all the x values the same. Only changing the y values – John Jan 12 at 18:20

I am sure that someone more expert in coding can simplify this but what I am going to do is to add the equation of a straight line to each curve and then choose values for the slope and intercept of the straight lines to minimise the differences between the curves. This will translate and rotate them to bring them together. I will select one curve as the reference curve and bring the others onto it.

One difficulty is that the x-values are all different for the data. I will therefore interpolate the data and then resample to give them all the same x values. This will enable me to do differences between the curves easily.

As Daniel Huber has done I start by getting the data and turning it into numbers.

  dat = Import["https://pastebin.com/j3Bgfxqm", "Data"][[1]];
dat = ToExpression[
StringCases[#,
"{" ~~ NumberString ~~ "," ~~ NumberString ~~ "}"]] & /@ dat;


Next I do the following:
select values for the intervals that are to be used for adjusting the data,
calculate the average increment of the data,
let nn equal the number of curves
interpolate each curve
plot

 {x1, x2, x3, x4} = {20, 50, 73, 98};
dx = Mean[Flatten[Differences[#[[All, 1]]] & /@ dat]];
nn = Length[dat];
ff = Interpolation[#] & /@ dat;
Plot[Evaluate[Table[ff[[n]][x], {n, nn}]], {x, x1, x4}]


Next I do the following:
resample the data adding the equation of a straight line to each curve,
set the reference curve values,
form the mean square error with the reference curve,
define the list of unknowns (uk),
take the derivative of the error with respect to the unknowns and set to zero,
solve for the unknowns,
define a new function for each curve with the correct translation and rotation,
plot

    ClearAll[x, f, m , c, g];
Do[f[n, x] =
Join[Table[ff[[n]][x] + m[n] x + c[n], {x, x1, x2, dx}],
Table[ff[[n]][x] + m[n] x + c[n], {x, x3, x4, dx}]], {n,
Length@ff}];
m[1] = 0; c[1] = 0;  (* Reference function *)
err = Plus @@ Sum[(f[n, x] - f[1, x])^2, {n, 2, Length@ff}];
uk = Flatten[Table[{m[n], c[n]}, {n, 2, Length@ff}]];
eqns = 0 == D[err, #] & /@ uk // Simplify;
sol = First@Solve[eqns];
g = Table[ff[[n]][x] + m[n] x + c[n] /. sol, {n, nn}];
Plot[g, {x, x1, x4}]


Does this solve your problem? Happy for someone to tidy up formulation I feel sure this can be done.

EDIT

I was asked how to end up with data that can be in lists rather than as equations. This can be done by resampling the equations. Here I use the starting and ending points x1 and x4, defined previously, and the mean increment of the original data dx.

    h = Table[{x, #}, {x, x1, x4, dx}] & /@ g;
ListPlot[h]


• Hugh! one question: Do you know how I could transform g (which is a list of interpolating functions) to data?. In other words, you plot g using Plot, so I would like to have the data of g and then being able to plotted with ListPlot. Thanks in advanced! – John Jan 18 at 2:31
• @John Data converted to lists as requested. – Hugh Jan 19 at 16:20

In MMA using Loops is not advised. Instead, use Map and a function. Here is the procedure.

Assume that we want to overlay dataset2, dataset3,.. onto dataset1

We again need data:

dat = Import["https://pastebin.com/j3Bgfxqm", "Data"][[1]];
dat = ToExpression[
StringCases[#,
"{" ~~ NumberString ~~ "," ~~ NumberString ~~ "}"]] & /@ dat;


Then we define the intervals and truncate the first data set:

n1 = 12; n2 = 300; n3 = 450; n4 = 580;
d1 = Join[Take[dat[[1]], {n1, n2}], Take[dat[[1]], {n3, n4}]];


Then we define the affine transformation and error function:

affTrans[t_, r_, d_] := (t + r.#) & /@ d;
err[{tx_, ty_}, phi_, d_] :=
Total[(Norm /@ (affTrans[{tx, ty}, RotationMatrix[phi], d] -
d1))^2];


Using the error function, we define a function that does the actual work. We then map this function onto all the datasets with the exception of data set 1:

results = (d = Join[Take[#, {n1, n2}], Take[#, {n3, n4}]];
sol = {tx, ty} + RotationMatrix[phi].# & /.
FindMinimum[{err[{tx, ty}, phi, d]}, {{tx, 0}, {ty, 0}, {phi,
0}}][[2]];
sol /@ #
) & /@ Rest[dat];


Finally, we prepend dataset 1 to the results and plot them:

PrependTo[results, dat[[1]]];
ListLinePlot[results]


After importing your data, I needed some fixes to convert it to numerical data:

dat = Import["https://pastebin.com/j3Bgfxqm", "Data"][[1]];
dat = ToExpression[ StringCases[#,
"{" ~~ NumberString ~~ "," ~~ NumberString ~~ "}"]] & /@ dat;


Now we have table of numerical data. To pick out the points with prescriped x values:

dat = Flatten[{Take[#, 29 ;; 41], Take[#, 72 ;; 85]} & /@ dat, 1];


Your plot statement has a superfluous Show and the plot range is wrong. With this fixes:

ListLinePlot[dat, PlotStyle -> {Red, Blue, Gray, Black},
LabelStyle -> {Black, Bold, 14}, ImageSize -> Large, Frame -> True,
Axes -> False, GridLines -> Automatic,
GridLinesStyle -> Lighter[Gray, .8]]


• Hi Daniel, thank you from the Figure the curve are not superimposed in those regions. I am putting a Figure of how they will looked like super imposed as an EDIT (doing it in excel Manually) – John Jan 12 at 15:12
• Hi John, did I not already answer how to do this question in: mathematica.stackexchange.com/questions/237742/… – Daniel Huber Jan 12 at 20:06
• Hi Daniel, yes but I wanted to implement your code in a Do Loop. I reference you in the description so that people know also that you developed the code and that my problem is mostly implementation of it in a Do loop – John Jan 12 at 20:46