Superimposed data on top of each other in a Do Loop

Question

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.

Answer 1

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]

Answer 2

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]

Answer 3

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