4
$\begingroup$
Tdata={{552.25,0.042,48.7},{552.25,0.046,44.5},{552.25,0.05,43.2},{552.25,0.054,39.2},{552.25,0.058,37.3},{552.25,0.062,35.3},{552.25,0.066,33.7},{552.25,0.07,34.3},{552.25,0.074,30.6},{552.25,0.078,29.7},{552.25,0.082,28.4},{552.25,0.086,27.5},{552.25,0.09,27.},{552.25,0.094,25.2},{552.25,0.098,23.2},{552.25,0.102,22.1},{552.25,0.106,22.4},{552.25,0.11,20.5},{552.25,0.114,21.},{552.25,0.118,20.1},{552.25,0.122,17.5},{552.25,0.126,18.4},{552.25,0.13,17.7},{552.25,0.134,17.1},{552.25,0.138,14.7},{552.25,0.142,14.8},{552.25,0.146,13.6},{552.25,0.15,13.8},{552.25,0.154,12.9},{552.25,0.158,11.9},{552.25,0.162,12.2},{552.25,0.166,12.7},{552.25,0.17,10.9},{552.25,0.174,11.5},{552.25,0.178,9.84},{552.25,0.182,10.6},{552.25,0.186,8.86},{552.25,0.19,8.6},{552.25,0.194,8.57},{552.25,0.198,7.62},{552.25,0.202,8.34},{552.25,0.206,7.88},{552.25,0.21,7.46},{552.25,0.214,7.1},{552.25,0.218,6.54},{552.25,0.222,7.},{552.25,0.226,6.38},{552.25,0.23,5.79},{552.25,0.234,5.49},{552.25,0.238,5.17},{552.25,0.25,4.61},{552.25,0.27,3.9},{552.25,0.29,3.21},{552.25,0.31,2.6},{552.25,0.33,2.16},{552.25,0.35,1.77},{552.25,0.37,1.46},{552.25,0.39,1.21},{552.25,0.41,0.982},{552.25,0.43,0.821},{552.25,0.45,0.656},{552.25,0.47,0.555},{552.25,0.49,0.453},{552.25,0.51,0.377},{552.25,0.53,0.307},{552.25,0.55,0.242},{552.25,0.57,0.2},{552.25,0.59,0.172},{552.25,0.61,0.145},{552.25,0.63,0.123},{552.25,0.65,0.106},{552.25,0.67,0.0843},{552.25,0.69,0.075},{552.25,0.71,0.0602},{552.25,0.73,0.0498},{552.25,0.75,0.0377},{552.25,0.77,0.0328},{552.25,0.79,0.0285},{552.25,0.825,0.018},{552.25,0.875,0.0106},{552.25,0.925,0.00654},{552.25,0.975,0.004},{552.25,1.025,0.00254},{1998.09,0.01026,78.7},{1998.09,0.01082,78.2},{1998.09,0.01138,77.1},{1998.09,0.01196,76.6},{1998.09,0.01256,76.7},{1998.09,0.01317,75.7},{1998.09,0.01379,75.},{1998.09,0.01443,74.2},{1998.09,0.01508,73.3},{1998.09,0.01575,72.6},{1998.09,0.01643,72.3},{1998.09,0.01712,71.8},{1998.09,0.01784,70.8},{1998.09,0.01856,70.3},{1998.09,0.0221,66.2},{1998.09,0.0232,65.1},{1998.09,0.0242,65.6},{1998.09,0.0252,63.7},{1998.09,0.0263,62.8},{1998.09,0.0273,61.5},{1998.09,0.0283,60.9},{1998.09,0.0294,60.3},{1998.09,0.0304,59.8},{1998.09,0.0314,59.8},{1998.09,0.0325,58.1},{1998.09,0.0335,57.2},{1998.09,0.0345,56.3},{1998.09,0.0356,55.7},{1998.09,0.0366,55.1},{1998.09,0.0376,54.9},{1998.09,0.0386,53.4},{1998.09,0.0397,52.6},{1998.09,0.0407,51.9},{1998.09,0.0417,50.4},{1998.09,0.0428,49.5},{1998.09,0.0438,49.5},{1998.09,0.0448,49.6},{1998.09,0.0459,47.9},{1998.09,0.0469,47.3},{1998.09,0.0479,47.1},{1998.09,0.049,46.8},{1998.09,0.05,45.9},{1998.09,0.051,45.7},{1998.09,0.0521,45.3},{1998.09,0.05375,43.},{1998.09,0.05625,41.3},{1998.09,0.05875,40.8},{1998.09,0.06125,38.7},{1998.09,0.06375,38.},{1998.09,0.06625,36.1},{1998.09,0.06875,35.3},{1998.09,0.07125,35.8},{1998.09,0.07375,33.},{1998.09,0.07625,32.6},{1998.09,0.07875,30.2},{1998.09,0.08125,29.5},{1998.09,0.08375,28.6},{1998.09,0.08625,28.3},{1998.09,0.08875,29.1},{1998.09,0.09125,26.3},{1998.09,0.09375,27.3},{1998.09,0.09625,25.7},{1998.09,0.09875,24.5},{1998.09,0.10125,25.3},{1998.09,0.10375,24.6},{1998.09,0.10625,23.5},{1998.09,0.10875,23.6},{1998.09,0.11125,22.},{1998.09,0.11375,22.2},{1998.09,0.11625,21.1},{1998.09,0.11875,20.1},{1998.09,0.12125,19.4},{1998.09,0.12375,18.4},{1998.09,0.12625,18.2},{1998.09,0.12875,16.8},{1998.09,0.13125,17.1},{1998.09,0.13375,17.},{1998.09,0.13625,16.2},{1998.09,0.13875,15.7},{1998.09,0.14125,15.6},{1998.09,0.14375,14.5},{1998.09,0.14625,14.7},{1998.09,0.14875,13.7},{1998.09,0.15125,13.7},{1998.09,0.15375,13.},{1998.09,0.15625,12.},{1998.09,0.15875,12.2},{1998.09,0.16125,12.1},{1998.09,0.16375,12.1},{1998.09,0.16625,12.1},{1998.09,0.16875,11.7},{1998.09,0.17125,11.4},{1998.09,0.17375,10.9},{1998.09,0.17625,10.8},{1998.09,0.17875,10.1},{1998.09,0.18125,10.2},{1998.09,0.18375,9.27},{1998.09,0.18625,9.02},{1998.09,0.18875,8.86},{1998.09,0.19125,8.53},{1998.09,0.19375,8.77},{1998.09,0.19625,8.53},{1998.09,0.19875,8.12},{1998.09,0.20125,8.28},{1998.09,0.20375,7.95},{1998.09,0.20625,7.82},{1998.09,0.20875,7.37},{1998.09,0.21125,7.},{1998.09,0.21375,7.27},{1998.09,0.21625,7.},{1998.09,0.21875,6.67},{1998.09,0.22125,6.33},{1998.09,0.22375,6.42},{1998.09,0.22625,6.11},{1998.09,0.22875,6.29},{1998.09,0.23125,5.52},{1998.09,0.23375,5.82},{1998.09,0.23625,5.27},{1998.09,0.23875,5.35},{1998.09,0.24125,5.16},{1998.09,0.24375,4.84},{1998.09,0.24625,4.78},{1998.09,0.24875,4.68},{1998.09,0.25125,4.35},{1998.09,0.25375,4.71},{1998.09,0.25625,4.29},{1998.09,0.25875,4.27},{1998.09,0.26125,4.18},{1998.09,0.26375,4.13},{1998.09,0.26625,3.73},{1998.09,0.26875,3.71},{1998.09,0.27125,3.77},{1998.09,0.27375,3.72},{1998.09,0.27625,3.7},{1998.09,0.27875,3.53},{1998.09,0.28125,3.15},{1998.09,0.28375,3.13},{1998.09,0.28625,3.12},{1998.09,0.28875,2.83},{1998.09,0.62,0.0779},{1998.09,0.66,0.0521},{1998.09,0.7,0.0361},{1998.09,0.74,0.0217},{1998.09,0.78,0.0146},{1998.09,0.82,0.01},{1998.09,0.86,0.0069},{1998.09,0.9,0.0047},{1998.09,0.94,0.00313},{1998.09,0.98,0.00215},{1998.09,1.02,0.00136},{3906.25,0.01074,83.3},{3906.25,0.01205,81.4},{3906.25,0.01343,80.1},{3906.25,0.0149,78.5},{3906.25,0.01643,77.},{3906.25,0.01804,75.3},{3906.25,0.01973,72.6},{3906.25,0.0215,71.3},{3906.25,0.02334,69.9},{3906.25,0.0215,71.3},{3906.25,0.02525,68.9},{3906.25,0.02724,67.},{3906.25,0.02931,65.},{3906.25,0.03145,62.3},{3906.25,0.03367,60.9},{3906.25,0.03596,59.8},{3906.25,0.037,59.2},{3906.25,0.039,57.3},{3906.25,0.041,56.},{3906.25,0.043,53.7},{3906.25,0.045,53.2},{3906.25,0.047,51.3},{3906.25,0.049,50.1},{3906.25,0.051,48.4},{3906.25,0.053,47.7},{3906.25,0.055,46.7},{3906.25,0.057,45.5},{3906.25,0.059,45.},{3906.25,0.061,43.6},{3906.25,0.063,41.9},{3906.25,0.065,41.3},{3906.25,0.067,40.6},{3906.25,0.069,39.5},{3906.25,0.071,38.5},{3906.25,0.073,37.7},{3906.25,0.075,36.7},{3906.25,0.077,35.1},{3906.25,0.079,34.},{3906.25,0.081,33.2},{3906.25,0.083,32.2},{3906.25,0.085,31.8},{3906.25,0.087,30.5},{3906.25,0.089,30.3},{3906.25,0.091,29.4},{3906.25,0.093,28.6},{3906.25,0.095,28.3},{3906.25,0.097,27.6},{3906.25,0.099,27.},{3906.25,0.27,4.17},{3906.25,0.29,3.05},{3906.25,0.31,2.45},{3906.25,0.33,2.05},{3906.25,0.35,1.73},{3906.25,0.37,1.47},{3906.25,0.39,1.2},{3906.25,0.41,1.01},{3906.25,0.43,0.83},{3906.25,0.45,0.632},{3906.25,0.47,0.533},{3906.25,0.49,0.418},{3906.25,0.525,0.272},{3906.25,0.575,0.163},{3906.25,0.625,0.0861},{3906.25,0.675,0.0504},{3906.25,0.725,0.0232},{3906.25,0.775,0.0149},{3906.25,0.825,0.0102},{3906.25,0.875,0.00567},{3906.25,0.925,0.00305},{3906.25,0.975,0.00154},{3906.25,1.025,0.000717}};

Terror={1.27,1.2,1.17,1.14,1.12,1.06,1.04,1.06,1.01,0.98,0.966,0.962,0.945,0.907,0.882,0.84,0.851,0.82,0.819,0.804,0.752,0.773,0.761,0.752,0.691,0.696,0.666,0.676,0.645,0.619,0.634,0.648,0.599,0.609,0.561,0.594,0.54,0.533,0.531,0.503,0.525,0.504,0.492,0.483,0.458,0.476,0.459,0.434,0.423,0.414,0.143,0.112,0.0918,0.0816,0.0612,0.051,0.0408,0.0357,0.0296,0.0245,0.0194,0.0163,0.0133,0.0112,0.00918,0.00714,0.00612,0.0052,0.00439,0.00367,0.00337,0.00306,0.00286,0.00255,0.00235,0.00204,0.00194,0.00173,0.00108,0.000638,0.000392,0.00024,0.000153,0.394,0.391,0.386,0.46,0.46,0.454,0.45,0.371,0.367,0.436,0.434,0.431,0.496,0.773,0.463,0.521,0.525,0.51,0.502,0.492,0.426,0.422,0.419,0.419,0.407,0.4,0.394,0.39,0.386,0.384,0.374,0.421,0.415,0.403,0.396,0.396,0.397,0.383,0.378,0.377,0.374,0.413,0.411,0.408,0.602,0.578,0.571,0.581,0.57,0.541,0.53,0.537,0.528,0.522,0.483,0.502,0.486,0.481,0.495,0.473,0.464,0.463,0.441,0.455,0.443,0.446,0.448,0.418,0.422,0.422,0.402,0.407,0.386,0.382,0.37,0.376,0.374,0.373,0.361,0.359,0.348,0.353,0.329,0.329,0.325,0.312,0.317,0.315,0.315,0.315,0.304,0.308,0.294,0.302,0.293,0.286,0.278,0.271,0.266,0.264,0.272,0.264,0.26,0.257,0.254,0.25,0.243,0.238,0.247,0.238,0.233,0.228,0.231,0.226,0.226,0.21,0.215,0.211,0.209,0.206,0.198,0.196,0.197,0.187,0.198,0.189,0.188,0.184,0.182,0.175,0.174,0.177,0.175,0.174,0.169,0.161,0.16,0.159,0.153,0.00273,0.00208,0.00143,0.00065,0.000455,0.000299,0.000208,0.000143,0.0000936,0.000065,0.0000416,0.333,0.326,0.32,0.314,0.308,0.678,1.52,1.5,1.47,1.5,0.758,0.737,0.715,0.685,0.67,0.718,0.414,0.401,0.392,0.269,0.319,0.308,0.301,0.29,0.286,0.28,0.273,0.315,0.305,0.293,0.289,0.284,0.276,0.308,0.302,0.294,0.281,0.306,0.299,0.29,0.286,0.305,0.303,0.294,0.286,0.283,0.304,0.297,0.66,0.47,0.37,0.3,0.25,0.21,0.17,0.14,0.12,0.087,0.073,0.056,0.036,0.022,0.012,0.0072,0.0035,0.0025,0.00163,0.00085,0.000518,0.000262,0.000108};

Sdata={{11.7149,0,41.171},{12.2675,0,41.6},{12.2787,0,40.878},{12.8307,0,40.848},{12.8422,0,41.6},{13.0921,0,38.3},{13.1566,0,40.6},{15.0141,0,40.6},{16.4106,0,41.6},{16.5682,0,40.075},{16.5967,0,40.},{16.8757,0,40.},{17.0627,0,40.1},{20.4223,0,39.4},{20.6089,0,39.9},{20.6089,0,40.2},{20.6089,0,39.6},{20.627,0,41.1},{20.8137,0,40.},{24.3483,0,39.6},{24.3483,0,39.4},{25.0961,0,39.},{28.0911,0,39.1},{29.9636,0,39.29},{31.462,0,38.7},{31.8367,0,38.7},{35.0215,0,39.7},{35.5848,0,38.7},{38.0775,0,38.9},{38.2085,0,39.7},{38.9576,0,38.6},{39.333,0,38.4},{39.333,0,38.85},{39.333,0,39.06},{41.9567,0,39.4},{43.0822,0,38.3},{44.957,0,39.39},{45.8939,0,39.7},{46.8321,0,38.9},{47.2065,0,38.7},{47.7702,0,39.3},{48.7078,0,38.8},{51.3702,0,38.8},{55.0831,0,39.9},{58.0842,0,38.55},{58.0842,0,38.59},{62.0235,0,38.4},{67.4632,0,38.46},{67.4632,0,38.49},{76.8428,0,38.85},{76.8428,0,38.5},{81.5337,0,38.42},{86.2242,0,38.45},{95.6034,0,38.2},{95.6034,0,38.14},{95.6034,0,38.42},{95.6034,0,37.74},{95.6034,0,38.46},{99.7322,0,37.87},{104.981,0,38.43},{114.362,0,38.44},{123.743,0,38.65},{131.263,0,36.68},{133.125,0,38.28},{138.745,0,37.6},{185.668,0,37.6},{189.42,0,38.7},{189.42,0,38.46},{189.42,0,38.39},{193.182,0,38.9},{226.954,0,38.58},{230.706,0,37.},{277.622,0,37.6},{277.622,0,38.47},{283.249,0,38.69},{283.249,0,38.62},{320.768,0,38.83},{324.54,0,37.4},{330.149,0,39.6},{369.562,0,38.5},{377.059,0,38.98},{377.059,0,38.9},{386.437,0,39.},{452.115,0,39.24},{527.208,0,39.42},{552.25,0,39.65},{552.25,0,39.4},{552.25,0,39.13},{552.25,0,38.8},{552.25,0,38.9},{556.96,0,38.7},{564.728,0,39.21},{564.728,0,40.68},{570.35,0,39.},{583.512,0,39.59},{639.786,0,39.69},{696.063,0,39.77},{761.76,0,40.6},{936.36,0,40.22},{936.36,0,40.11},{936.36,0,39.91},{936.36,0,40.07},{936.36,0,40.2},{936.36,0,40.1},{942.49,0,40.1},{948.64,0,40.},{1239.04,0,40.42},{1998.,0,41.7},{1998.09,0,41.9},{2016.01,0,41.89},{2043.04,0,42.5},{2787.84,0,43.01},{2787.84,0,42.38},{2787.84,0,42.1},{2787.84,0,42.85},{2787.84,0,42.71},{2798.41,0,42.4},{2830.24,0,42.9},{3881.29,0,43.55},{3893.88,0,43.1},{3906.25,0,44.},{3931.29,0,43.82},{3931.29,0,42.96},{3943.84,0,44.1},{3969.,0,42.2}};

Serror={0.12759,1.4,0.12931,0.12922,0.6,4.2,0.72446,0.3,1.1,0.13099,0.6,0.72111,0.2,1.5,0.72056,0.3,0.3,1.7,0.3,0.1,0.7178,1.5,0.71616,0.19774,1.5,0.71398,1.5,0.71398,0.3,1.5,0.6,0.71236,0.18996,0.197,1.5,0.71182,0.44858,1.5,0.1,1.5,0.8,0.19618,0.3,1.5,0.18941,0.19552,0.6,0.16176,0.1952,0.18996,0.19523,0.09,0.19508,0.16077,0.20314,0.18917,1.18,0.19511,0.12,0.19501,0.19504,0.21411,0.53,0.15826,1.1159,1.1159,1.743,0.15896,0.20111,0.8,0.15942,1.1154,1.1159,0.58,0.15985,0.20221,0.16039,1.1158,1.6191,1.2153,0.16097,0.20354,1.,0.16198,0.16267,0.23386,0.3,0.39689,0.25,0.7,0.7,0.92,0.55,1.,0.16935,0.17351,0.17002,1.2,0.21327,0.18798,0.40773,0.24,0.8,0.4,0.2,0.6,0.6199,0.4,0.24,0.40691,0.8,0.26381,0.17229,0.2,0.41833,0.35,0.4,0.7,0.322,0.4,0.44643,0.31766,0.38,0.9,3.5};

Rdata={{7.65906,0,-0.426},{9.83638,0,-0.39},{11.0277,0,-0.38},{11.3071,0,-0.389},{14.7809,0,-0.3},{15.0141,0,-0.339},{16.5218,0,-0.331},{16.5967,0,-0.29},{18.5339,0,-0.33},{19.5435,0,-0.351},{20.3473,0,-0.343},{20.3473,0,-0.345},{20.6089,0,-0.33},{20.6089,0,-0.31},{20.8137,0,-0.43},{22.2869,0,-0.26},{24.2359,0,-0.29},{28.1473,0,-0.272},{37.8889,0,-0.245},{38.0775,0,-0.33},{39.782,0,-0.205},{46.8321,0,-0.19},{47.0569,0,-0.157},{50.807,0,-0.154},{51.3702,0,-0.32},{53.3952,0,-0.23},{58.0842,0,-0.183},{75.7544,0,-0.176},{81.5337,0,-0.194},{95.6034,0,-0.068},{98.0001,0,-0.157},{99.3411,0,-0.153},{99.7322,0,-0.176},{105.699,0,-0.154},{113.231,0,-0.122},{132.826,0,-0.106},{133.125,0,-0.104},{133.125,0,-0.115},{151.881,0,-0.096},{159.391,0,-0.1216},{159.391,0,-0.1194},{178.009,0,-0.098},{189.42,0,-0.092},{189.42,0,-0.074},{193.182,0,-0.1029},{195.049,0,-0.0987},{195.049,0,-0.1024},{236.329,0,-0.024},{273.01,0,-0.064},{283.249,0,-0.04},{283.249,0,0.008},{307.652,0,-0.048},{328.987,0,-0.039},{330.149,0,-0.011},{349.017,0,-0.038},{375.197,0,-0.034},{377.059,0,0.019},{393.943,0,-0.0247},{405.016,0,-0.02},{433.389,0,-0.0176},{458.988,0,-0.013},{470.89,0,-0.041},{491.553,0,-0.009},{505.98,0,0.022},{529.092,0,0.0118},{538.472,0,0.0099},{552.25,0,0.02},{552.25,0,0.022},{564.728,0,-0.028},{570.35,0,-0.011},{590.49,0,0.009},{655.975,0,0.025},{739.024,0,0.039},{748.624,0,0.012},{936.36,0,0.03},{936.36,0,0.034},{936.36,0,0.042},{1998.09,0,0.062},{2787.84,0,0.077},{2798.41,0,0.078},{3893.76,0,0.095}};

Rerror={0.047432,0.031667,0.1,0.031544,0.07,0.037348,0.024299,0.024947,0.08,0.05561,0.021835,0.026915,0.035,0.041212,0.042459,0.05,0.023862,0.023961,0.038863,0.032561,0.023929,0.09,0.027213,0.032028,0.031575,0.13,0.051,0.035735,0.021984,0.04,0.019266,0.015016,0.018653,0.036019,0.034458,0.034052,0.065,0.015291,0.01347,0.028411,0.028712,0.018976,0.014,0.017476,0.02787,0.028686,0.027689,0.013943,0.017795,0.014,0.011662,0.028612,0.019069,0.0184,0.020387,0.012615,0.016606,0.028244,0.019209,0.028228,0.017986,0.014,0.012728,0.021185,0.02817,0.028187,0.05,0.014142,0.016,0.012057,0.011677,0.021213,0.019069,0.012728,0.06,0.0080605,0.018698,0.018504,0.00922,0.017878,0.018763};

Tdatag1={{0.042,48.7},{0.046,44.5},{0.05,43.2},{0.054,39.2},{0.058,37.3},{0.062,35.3},{0.066,33.7},{0.07,34.3},{0.074,30.6},{0.078,29.7},{0.082,28.4},{0.086,27.5},{0.09,27.},{0.094,25.2},{0.098,23.2},{0.102,22.1},{0.106,22.4},{0.11,20.5},{0.114,21.},{0.118,20.1},{0.122,17.5},{0.126,18.4},{0.13,17.7},{0.134,17.1},{0.138,14.7},{0.142,14.8},{0.146,13.6},{0.15,13.8},{0.154,12.9},{0.158,11.9},{0.162,12.2},{0.166,12.7},{0.17,10.9},{0.174,11.5},{0.178,9.84},{0.182,10.6},{0.186,8.86},{0.19,8.6},{0.194,8.57},{0.198,7.62},{0.202,8.34},{0.206,7.88},{0.21,7.46},{0.214,7.1},{0.218,6.54},{0.222,7.},{0.226,6.38},{0.23,5.79},{0.234,5.49},{0.238,5.17},{0.25,4.61},{0.27,3.9},{0.29,3.21},{0.31,2.6},{0.33,2.16},{0.35,1.77},{0.37,1.46},{0.39,1.21},{0.41,0.982},{0.43,0.821},{0.45,0.656},{0.47,0.555},{0.49,0.453},{0.51,0.377},{0.53,0.307},{0.55,0.242},{0.57,0.2},{0.59,0.172},{0.61,0.145},{0.63,0.123},{0.65,0.106},{0.67,0.0843},{0.69,0.075},{0.71,0.0602},{0.73,0.0498},{0.75,0.0377},{0.77,0.0328},{0.79,0.0285},{0.825,0.018},{0.875,0.0106},{0.925,0.00654},{0.975,0.004},{1.025,0.00254}};

Tdatag2={{0.01026,78.7},{0.01082,78.2},{0.01138,77.1},{0.01196,76.6},{0.01256,76.7},{0.01317,75.7},{0.01379,75.},{0.01443,74.2},{0.01508,73.3},{0.01575,72.6},{0.01643,72.3},{0.01712,71.8},{0.01784,70.8},{0.01856,70.3},{0.0221,66.2},{0.0232,65.1},{0.0242,65.6},{0.0252,63.7},{0.0263,62.8},{0.0273,61.5},{0.0283,60.9},{0.0294,60.3},{0.0304,59.8},{0.0314,59.8},{0.0325,58.1},{0.0335,57.2},{0.0345,56.3},{0.0356,55.7},{0.0366,55.1},{0.0376,54.9},{0.0386,53.4},{0.0397,52.6},{0.0407,51.9},{0.0417,50.4},{0.0428,49.5},{0.0438,49.5},{0.0448,49.6},{0.0459,47.9},{0.0469,47.3},{0.0479,47.1},{0.049,46.8},{0.05,45.9},{0.051,45.7},{0.0521,45.3},{0.05375,43.},{0.05625,41.3},{0.05875,40.8},{0.06125,38.7},{0.06375,38.},{0.06625,36.1},{0.06875,35.3},{0.07125,35.8},{0.07375,33.},{0.07625,32.6},{0.07875,30.2},{0.08125,29.5},{0.08375,28.6},{0.08625,28.3},{0.08875,29.1},{0.09125,26.3},{0.09375,27.3},{0.09625,25.7},{0.09875,24.5},{0.10125,25.3},{0.10375,24.6},{0.10625,23.5},{0.10875,23.6},{0.11125,22.},{0.11375,22.2},{0.11625,21.1},{0.11875,20.1},{0.12125,19.4},{0.12375,18.4},{0.12625,18.2},{0.12875,16.8},{0.13125,17.1},{0.13375,17.},{0.13625,16.2},{0.13875,15.7},{0.14125,15.6},{0.14375,14.5},{0.14625,14.7},{0.14875,13.7},{0.15125,13.7},{0.15375,13.},{0.15625,12.},{0.15875,12.2},{0.16125,12.1},{0.16375,12.1},{0.16625,12.1},{0.16875,11.7},{0.17125,11.4},{0.17375,10.9},{0.17625,10.8},{0.17875,10.1},{0.18125,10.2},{0.18375,9.27},{0.18625,9.02},{0.18875,8.86},{0.19125,8.53},{0.19375,8.77},{0.19625,8.53},{0.19875,8.12},{0.20125,8.28},{0.20375,7.95},{0.20625,7.82},{0.20875,7.37},{0.21125,7.},{0.21375,7.27},{0.21625,7.},{0.21875,6.67},{0.22125,6.33},{0.22375,6.42},{0.22625,6.11},{0.22875,6.29},{0.23125,5.52},{0.23375,5.82},{0.23625,5.27},{0.23875,5.35},{0.24125,5.16},{0.24375,4.84},{0.24625,4.78},{0.24875,4.68},{0.25125,4.35},{0.25375,4.71},{0.25625,4.29},{0.25875,4.27},{0.26125,4.18},{0.26375,4.13},{0.26625,3.73},{0.26875,3.71},{0.27125,3.77},{0.27375,3.72},{0.27625,3.7},{0.27875,3.53},{0.28125,3.15},{0.28375,3.13},{0.28625,3.12},{0.28875,2.83},{0.62,0.0779},{0.66,0.0521},{0.7,0.0361},{0.74,0.0217},{0.78,0.0146},{0.82,0.01},{0.86,0.0069},{0.9,0.0047},{0.94,0.00313},{0.98,0.00215},{1.02,0.00136}};

Tdatag3={{0.01074,83.3},{0.01205,81.4},{0.01343,80.1},{0.0149,78.5},{0.01643,77.},{0.01804,75.3},{0.01973,72.6},{0.0215,71.3},{0.02334,69.9},{0.0215,71.3},{0.02525,68.9},{0.02724,67.},{0.02931,65.},{0.03145,62.3},{0.03367,60.9},{0.03596,59.8},{0.037,59.2},{0.039,57.3},{0.041,56.},{0.043,53.7},{0.045,53.2},{0.047,51.3},{0.049,50.1},{0.051,48.4},{0.053,47.7},{0.055,46.7},{0.057,45.5},{0.059,45.},{0.061,43.6},{0.063,41.9},{0.065,41.3},{0.067,40.6},{0.069,39.5},{0.071,38.5},{0.073,37.7},{0.075,36.7},{0.077,35.1},{0.079,34.},{0.081,33.2},{0.083,32.2},{0.085,31.8},{0.087,30.5},{0.089,30.3},{0.091,29.4},{0.093,28.6},{0.095,28.3},{0.097,27.6},{0.099,27.},{0.27,4.17},{0.29,3.05},{0.31,2.45},{0.33,2.05},{0.35,1.73},{0.37,1.47},{0.39,1.2},{0.41,1.01},{0.43,0.83},{0.45,0.632},{0.47,0.533},{0.49,0.418},{0.525,0.272},{0.575,0.163},{0.625,0.0861},{0.675,0.0504},{0.725,0.0232},{0.775,0.0149},{0.825,0.0102},{0.875,0.00567},{0.925,0.00305},{0.975,0.00154},{1.025,0.000717}};

Sdatag={{11.7149,41.171},{12.2675,41.6},{12.2787,40.878},{12.8307,40.848},{12.8422,41.6},{13.0921,38.3},{13.1566,40.6},{15.0141,40.6},{16.4106,41.6},{16.5682,40.075},{16.5967,40.},{16.8757,40.},{17.0627,40.1},{20.4223,39.4},{20.6089,39.9},{20.6089,40.2},{20.6089,39.6},{20.627,41.1},{20.8137,40.},{24.3483,39.6},{24.3483,39.4},{25.0961,39.},{28.0911,39.1},{29.9636,39.29},{31.462,38.7},{31.8367,38.7},{35.0215,39.7},{35.5848,38.7},{38.0775,38.9},{38.2085,39.7},{38.9576,38.6},{39.333,38.4},{39.333,38.85},{39.333,39.06},{41.9567,39.4},{43.0822,38.3},{44.957,39.39},{45.8939,39.7},{46.8321,38.9},{47.2065,38.7},{47.7702,39.3},{48.7078,38.8},{51.3702,38.8},{55.0831,39.9},{58.0842,38.55},{58.0842,38.59},{62.0235,38.4},{67.4632,38.46},{67.4632,38.49},{76.8428,38.85},{76.8428,38.5},{81.5337,38.42},{86.2242,38.45},{95.6034,38.2},{95.6034,38.14},{95.6034,38.42},{95.6034,37.74},{95.6034,38.46},{99.7322,37.87},{104.981,38.43},{114.362,38.44},{123.743,38.65},{131.263,36.68},{133.125,38.28},{138.745,37.6},{185.668,37.6},{189.42,38.7},{189.42,38.46},{189.42,38.39},{193.182,38.9},{226.954,38.58},{230.706,37.},{277.622,37.6},{277.622,38.47},{283.249,38.69},{283.249,38.62},{320.768,38.83},{324.54,37.4},{330.149,39.6},{369.562,38.5},{377.059,38.98},{377.059,38.9},{386.437,39.},{452.115,39.24},{527.208,39.42},{552.25,39.65},{552.25,39.4},{552.25,39.13},{552.25,38.8},{552.25,38.9},{556.96,38.7},{564.728,39.21},{564.728,40.68},{570.35,39.},{583.512,39.59},{639.786,39.69},{696.063,39.77},{761.76,40.6},{936.36,40.22},{936.36,40.11},{936.36,39.91},{936.36,40.07},{936.36,40.2},{936.36,40.1},{942.49,40.1},{948.64,40.},{1239.04,40.42},{1998.,41.7},{1998.09,41.9},{2016.01,41.89},{2043.04,42.5},{2787.84,43.01},{2787.84,42.38},{2787.84,42.1},{2787.84,42.85},{2787.84,42.71},{2798.41,42.4},{2830.24,42.9},{3881.29,43.55},{3893.88,43.1},{3906.25,44.},{3931.29,43.82},{3931.29,42.96},{3943.84,44.1},{3969.,42.2}};

Rdatag={{7.65906,-0.426},{9.83638,-0.39},{11.0277,-0.38},{11.3071,-0.389},{14.7809,-0.3},{15.0141,-0.339},{16.5218,-0.331},{16.5967,-0.29},{18.5339,-0.33},{19.5435,-0.351},{20.3473,-0.343},{20.3473,-0.345},{20.6089,-0.33},{20.6089,-0.31},{20.8137,-0.43},{22.2869,-0.26},{24.2359,-0.29},{28.1473,-0.272},{37.8889,-0.245},{38.0775,-0.33},{39.782,-0.205},{46.8321,-0.19},{47.0569,-0.157},{50.807,-0.154},{51.3702,-0.32},{53.3952,-0.23},{58.0842,-0.183},{75.7544,-0.176},{81.5337,-0.194},{95.6034,-0.068},{98.0001,-0.157},{99.3411,-0.153},{99.7322,-0.176},{105.699,-0.154},{113.231,-0.122},{132.826,-0.106},{133.125,-0.104},{133.125,-0.115},{151.881,-0.096},{159.391,-0.1216},{159.391,-0.1194},{178.009,-0.098},{189.42,-0.092},{189.42,-0.074},{193.182,-0.1029},{195.049,-0.0987},{195.049,-0.1024},{236.329,-0.024},{273.01,-0.064},{283.249,-0.04},{283.249,0.008},{307.652,-0.048},{328.987,-0.039},{330.149,-0.011},{349.017,-0.038},{375.197,-0.034},{377.059,0.019},{393.943,-0.0247},{405.016,-0.02},{433.389,-0.0176},{458.988,-0.013},{470.89,-0.041},{491.553,-0.009},{505.98,0.022},{529.092,0.0118},{538.472,0.0099},{552.25,0.02},{552.25,0.022},{564.728,-0.028},{570.35,-0.011},{590.49,0.009},{655.975,0.025},{739.024,0.039},{748.624,0.012},{936.36,0.03},{936.36,0.034},{936.36,0.042},{1998.09,0.062},{2787.84,0.077},{2798.41,0.078},{3893.76,0.095}};

Tmodel=1/x^2 1.22208 ((a3 E^(b3 y) x^(0.435-0.93 y) Sin[1/2 \[Pi] (0.435-0.93 y)]-a2 E^(b2 y) x^(0.703-0.84 y) Sin[1/2 \[Pi] (0.703-0.84 y)]+(a1 E^((\[Alpha]-y \[Beta]) (b1+Log[x])) x (Cos[1/2 \[Pi] (\[Alpha]-y \[Beta])] (b1+Log[x])-1/2 \[Pi] Sin[1/2 \[Pi] (\[Alpha]-y \[Beta])]))/b1)^2+(-a3 E^(b3 y) x^(0.435-0.93 y) Cos[1/2 \[Pi] (0.435-0.93 y)]+a2 E^(b2 y) x^(0.703-0.84 y) Cos[1/2 \[Pi] (0.703-0.84 y)]+(a1 E^((\[Alpha]-y \[Beta]) (b1+Log[x])) x (1/2 \[Pi] Cos[1/2 \[Pi] (\[Alpha]-y \[Beta])]+(b1+Log[x]) Sin[1/2 \[Pi] (\[Alpha]-y \[Beta])]))/b1)^2);
Smodel=(4.88832 (0.631353 a3 x^0.435-0.893136 a2 x^0.703+(a1 E^(\[Alpha] (b1+Log[x])) x (Cos[(\[Pi] \[Alpha])/2] (b1+Log[x])-1/2 \[Pi] Sin[(\[Pi] \[Alpha])/2]))/b1))/x;
Rmodel=(-0.775496 a3 x^0.435+0.449787 a2 x^0.703+(a1 E^(\[Alpha] (b1+Log[x])) x (1/2 \[Pi] Cos[(\[Pi] \[Alpha])/2]+(b1+Log[x]) Sin[(\[Pi] \[Alpha])/2]))/b1)/(0.631353 a3 x^0.435-0.893136 a2 x^0.703+(a1 E^(\[Alpha] (b1+Log[x])) x (Cos[(\[Pi] \[Alpha])/2] (b1+Log[x])-1/2 \[Pi] Sin[(\[Pi] \[Alpha])/2]))/b1);

Tfit=NonlinearModelFit[Tdata,Tmodel,{{a1,2},{b1,4},{\[Alpha],0.01},{\[Beta]},{a2},b2,{a3},b3},{x,y},Weights->1/Terror^2,VarianceEstimatorFunction->(1&)];
Sfit=NonlinearModelFit[Sdata,Smodel,{{a1,2},{b1,4},{\[Alpha],0.01},{\[Beta]},{a2},b2,{a3},b3},{x,y},Weights->1/Serror^2,VarianceEstimatorFunction->(1&)];
Rfit=NonlinearModelFit[Rdata,Rmodel,{{a1,2},{b1,4},{\[Alpha],0.01},{\[Beta]},{a2},b2,{a3},b3},{x,y},Weights->1/Rerror^2,VarianceEstimatorFunction->(1&)];

T1=Tfit["BestFit"]/.x->552.25;
T2=Tfit["BestFit"]/.x->1998.09;
T3=Tfit["BestFit"]/.x->3906.25;
S=Sfit["BestFit"];
R=Rfit["BestFit"];
Tfit["ParameterTable"]
Sfit["ParameterTable"]
Rfit["ParameterTable"]

Show[LogPlot[1000000*T1,{y,0.01,1.1},ImageSize->Large,PlotRange->{{0,1.2},{10^9,10^-2}},PlotStyle->{Red,Thick}],LogPlot[10000*T2,{y,0.01,1.1},PlotRange->{{0,1.2},{10^9,10^-6}},PlotRange->{{0,1.2},{10^9,10^-3}},PlotStyle->{Red,Thick}],LogPlot[100*T3,{y,0.01,1.1},PlotRange->{{0,1.2},{10^9,10^-6}},PlotRange->{{0,1.2},{10^9,10^-3}},PlotStyle->{Red,Thick}],Epilog->{{Point[Tdatag1/.{t_,y_}->{t,Log[1000000*y]}],Point[Tdatag2/.{t_,y_}->{t,Log[10000*y]}],Point[Tdatag3/.{t_,y_}->{t,Log[100*y]}]}},Axes->False,Frame->True,LabelStyle->{FontFamily->"Arial",FontSize->20,FontColor->Black,FontWeight->Plain},FrameLabel->{"y","T"}]

Show[LogLinearPlot[S,{x,2.5,5000},ImageSize->Large,PlotRange->{{5,5000},{30,50}},PlotStyle->{Red,Thick}],ListLogLinearPlot[Sdatag,ImageSize->Large,PlotRange->{{5,5000},{30,50}},PlotStyle->Black],Axes->False,Frame->True,LabelStyle->{FontFamily->"Arial",FontSize->20,FontColor->Black,FontWeight->Plain},FrameLabel->{"x","S"}]

Show[LogLinearPlot[R,{x,1.5,5000},ImageSize->Large,PlotRange->{{1.1,5000},{-0.5,0.5}},PlotStyle->{Blue,Thick}],ListLogLinearPlot[Rdatag,ImageSize->Large,PlotRange->{{1.1,100},{-0.5,0.5}},PlotStyle->Black],Axes->False,Frame->True,LabelStyle->{FontFamily->"Arial",FontSize->20,FontColor->Black,FontWeight->Plain},FrameLabel->{"x","R"}]

I have three data set (Tdata, Sdata, Rdata) and their measurement errors (Terror, Serror, Rerror). I also have three models (Tmodel, Smodel, Rmodel). These models contain the same parameters. My task is to obtain a simultaneous fit to the three data set using also the measurement errors. Until now I was able to fit the data separately:

Fit of T data

Obtained parameters for T data

Fit of S data

Obtained parameters for S data

Fit of R data

Obtained parameters for R data

I have no idea how can I solve the simultaneous fit for the three data set and get same parameter values in each model using also the measurement errors. The solution would be proper even if the the results of the simultaneous fit not as good as those of the separate fits.

$\endgroup$
  • 1
    $\begingroup$ Link to related MathGroup threads. $\endgroup$ – Daniel Lichtblau Aug 16 '17 at 18:55
4
$\begingroup$

Following @JackLaVigne 's suggestion about setting up another column that identifies the model...

The created index is 1, 2, and 3 for R, S, and T:

dataR = ArrayFlatten[{{Transpose[{ConstantArray[1, Length[Rdata]]}], Rdata}}];
dataS = ArrayFlatten[{{Transpose[{ConstantArray[2, Length[Sdata]]}], Sdata}}];
dataT = ArrayFlatten[{{Transpose[{ConstantArray[3, Length[Tdata]]}], Tdata}}];
data = Join[dataR, dataS, dataT];
error = Join[Rerror, Serror, Terror];

Now run NonlinearModelFit

fit = NonlinearModelFit[data, 
   Boole[d == 1] Rmodel + Boole[d == 2] Smodel + Boole[d == 3] Tmodel,
   {{a1, 0.9}, {b1, 5}, {α, -0.08}, {β, 0.2}, {a2, 0.0016}, {b2, 12},
    {a3, 2}, {b3, 7.4}}, {d, x, y}, Weights -> 1/error^2, 
   VarianceEstimatorFunction -> (1 &), MaxIterations -> 5000];


fit["BestFitParameters"]
  (* {a1 -> 4.86173, b1 -> 7.08801, α -> -0.0136636, β -> 0.395975, 
      a2 -> -0.369444, b2 -> 4.9503, a3 -> 17.4843, b3 -> -37.717} *)

But the fit is poor in several aspects. Here is a plot of the residuals vs. the predicted values (a standard display for examining the fit):

nR = Length[Rdata];
nS = Length[Sdata];
nT = Length[Tdata];
ListPlot[{Transpose[{fit["PredictedResponse"][[Range[1, nR]]], 
    fit["FitResiduals"][[Range[1, nR]]]}],
  Transpose[{fit["PredictedResponse"][[Range[nR + 1, nR + nS]]], 
    fit["FitResiduals"][[Range[nR + 1, nR + nS]]]}],
  Transpose[{fit["PredictedResponse"][[Range[nR + nS + 1, nR + nS + nT]]], 
    fit["FitResiduals"][[Range[nR + nS + 1, nR + nS + nT]]]}]},
 PlotStyle -> {Red, Green, Black}, PlotLegends -> {"R", "S", "T"}, Frame -> True]

Predicted vs. residuals

We see several things: (1) The variability of the residuals differs by data source (although there might be some confounding due to the varying weights), (2) Both the R and T models tend to over-estimate, and (3) for T there is a definite remaining pattern (middle values over-estimated, low and high values being under-estimated) suggesting the inadequacy of the T model.

Again, as @JackLaVigne has pointed out only the T data offers any information related to β, b2, and b3 so to call those "common parameters" is a bit of a stretch.

In summary I'd recommend reconsidering the formulation of the T model and because the variances differ among the dataset, use a maximizing function to maximize the sum of 3 customized LogLikelihood functions.

$\endgroup$
6
$\begingroup$

For sake of brevity I will not recopy the data.

The strategy will be to build an objective function that is based upon the measured and reconstructed data and weights for the three data sets.

Here is a simple pseudo-code of the idea.

Say that we have two data sets with three points and associated errors.

We will use the model to compute reconstructed data (here trec represents the reconstructed data for model T using the fitting parameters).

tdata = {t1, t2, t3};
trec = {tr1, tr2, tr3};
terror = {te1, te2, te3};

(tdata - trec)^2/terror^2
(* {(t1 - tr1)^2/te1^2, (t2 - tr2)^2/te2^2, (t3 - tr3)^2/te3^2} *)

We do the same thing for the second data set.

sdata = {s1, s2, s3};
srec = {sr1, sr2, sr3};
serror = {se1, se2, se3};

(sdata - srec)^2/serror^2
(* {(s1 - sr1)^2/se1^2, (s2 - sr2)^2/se2^2, (s3 - sr3)^2/se3^2} *)

Then an objective function is formed that is the sum of these. The objective function will be a function of the parameters we are attempting to find.

objectiveFun[a1_, b1_, α_, β_, a2_, b2_, a3_, b3_] :=
      (tdata - trec)^2/terror^2 + (sdata - srec)^2/serror^2

Define reconstructed functions

The first step is to define the functions that will create the reconstructed measurements. There are three. We will set the attributes of the function to be listable so we can feed in an entire data set in one fell swoop.

Tfun[x_, y_, a1_, b1_, α_, β_, a2_, b2_, a3_, b3_] := 
 1/x^2 1.22208 ((a3 E^(b3 y) x^(0.435 - 0.93 y) Sin[
         1/2 π (0.435 - 0.93 y)] - 
       a2 E^(b2 y) x^(0.703 - 0.84 y) Sin[
         1/2 π (0.703 - 
            0.84 y)] + (a1 E^((α - y β) (b1 + 
               Log[x])) x (Cos[
              1/2 π (α - y β)] (b1 + Log[x]) - 
            1/2 π Sin[1/2 π (α - y β)]))/
        b1)^2 + (-a3 E^(b3 y) x^(0.435 - 0.93 y) Cos[
         1/2 π (0.435 - 0.93 y)] + 
       a2 E^(b2 y) x^(0.703 - 0.84 y) Cos[
         1/2 π (0.703 - 
            0.84 y)] + (a1 E^((α - y β) (b1 + 
               Log[x])) x (1/2 π Cos[
              1/2 π (α - y β)] + (b1 + Log[x]) Sin[
              1/2 π (α - y β)]))/b1)^2)

SetAttributes[Tfun, Listable]

Sfun[x_, y_, a1_, b1_, α_, β_, a2_, b2_, a3_, b3_] := 
   (4.88832 (0.631353 a3 x^0.435 - 
      0.893136 a2 x^0.703 + (a1 E^(α (b1 + 
              Log[x])) x (Cos[(π α)/2] (b1 + Log[x]) - 
           1/2 π Sin[(π α)/2]))/b1))/x

SetAttributes[Sfun, Listable]

Rfun[x_, y_, a1_, b1_, α_, β_, a2_, b2_, a3_, b3_] :=
   (-0.775496 a3 x^0.435 + 
    0.449787 a2 x^0.703 + (a1 E^(α (b1 + Log[x])) x (1/
           2 π Cos[(π α)/2] + (b1 + 
            Log[x]) Sin[(π α)/2]))/
     b1)/(0.631353 a3 x^0.435 - 
    0.893136 a2 x^0.703 + (a1 E^(α (b1 + 
            Log[x])) x (Cos[(π α)/2] (b1 + Log[x]) - 
         1/2 π Sin[(π α)/2]))/b1)

SetAttributes[Rfun, Listable]

The right hand side is identical to Tmodel, Smodel and Rmodel. The left hand side uses a uniform set of inputs although several are not needed for Sfun and Rfun as they are not influenced by y, β, b2 nor b3.

One could tidy this up by removing the arguments but for sake of speed (cut and paste) I left them as arguments, even though not required.

The objective function

The function that we wish to minimize is the difference between the measured and reconstructed logs squared divided by the weights squared.

objectiveFun[a1_, b1_, α_, β_, a2_, b2_, a3_, b3_] := 
 Module[
  {
   trec,
   srec,
   rrec
   },

  trec = Tfun[Tdata[[All,1]], Tdata[[All,2]], a1, b1, α, β, a2, b2, a3, b3];
  srec = Sfun[Sdata[[All,1]], Sdata[[All,2]], a1, b1, α, β, a2, b2, a3, b3];
  rrec = Rfun[Rdata[[All,1]], Rdata[[All,2]], a1, b1, α, β, a2, b2, a3, b3];

  ((Tdata[[All, 3]] - trec)/Terror).((Tdata[[All, 3]] - trec)/Terror) +
  ((Sdata[[All, 3]] - srec)/Serror).((Sdata[[All, 3]] - srec)/Serror) +
  ((Rdata[[All, 3]] - rrec)/Rerror).((Rdata[[All, 3]] - rrec)/Rerror)
  ]

FindMinimum

Next step is to run FindMinimum.

solutionTSR = FindMinimum[
  objectiveFun[a1, b1, α, β, a2, b2, a3, b3],
  {{a1, 1.049}, {b1, 3.3}, {α, 0.06}, {β, 
    0.48}, {a2, -12.7}, {b2, -2}, {a3, 102}, {b3, -18.5}}
  ]

(* {2931.75, {a1 -> 2.2674, 
  b1 -> 4.50914, α -> 0.0176986, β -> 0.447624, 
  a2 -> -10.8981, b2 -> -13.3481, a3 -> -0.427242, b3 -> -2595.21}} *)

Plot the results

The code for the plotting the results is more or less identical to that supplied in the question but the reconstructed functions are used.

Show[
 LogPlot[
  1000000*
   Evaluate[
    Tfun[x, y, a1, b1, α, β, a2, b2, a3, b3] /. 
      x -> 552.5 /. solutionTSR[[2]]],
  {y, 0.01, 1.1},
  ImageSize -> Large,
  PlotRange -> {{0, 1.2}, {10^9, 10^-2}},
  PlotStyle -> {Red, Thick}
  ],
 LogPlot[10000*
   Evaluate[
    Tfun[x, y, a1, b1, α, β, a2, b2, a3, b3] /. 
      x -> 1998.09 /. solutionTSR[[2]]],
  {y, 0.01, 1.1},
  PlotRange -> {{0, 1.2}, {10^9, 10^-6}},
  PlotStyle -> {Red, Thick}
  ],
 LogPlot[100*
   Evaluate[
    Tfun[x, y, a1, b1, α, β, a2, b2, a3, b3] /. 
      x -> 3906.25 /. solutionTSR[[2]]],
  {y, 0.01, 1.1},
  PlotStyle -> {Red, Thick}
  ],
 Epilog -> {
   {Point[Tdatag1 /. {t_, y_} -> {t, Log[1000000*y]}], 
    Point[Tdatag2 /. {t_, y_} -> {t, Log[10000*y]}], 
    Point[Tdatag3 /. {t_, y_} -> {t, Log[100*y]}]
    }
   },
 Axes -> False,
 Frame -> True,
 LabelStyle -> {
   FontFamily -> "Arial",
   FontSize -> 20,
   FontColor -> Black,
   FontWeight -> Plain
   },
 FrameLabel -> {"y", "T"}
 ]

Mathematica graphics

Show[
 LogLinearPlot[
  Evaluate[Sfun[x, y, a1, b1, α, β, a2, b2, a3, b3] /. 
     y -> 0 /. solutionTSR[[2]]],
  {x, 2.5, 5000},
  ImageSize -> Large,
  PlotRange -> {{5, 5000}, {30, 50}},
  PlotStyle -> {Red, Thick}
  ],
 ListLogLinearPlot[Sdatag, PlotStyle -> Black],
 Axes -> False,
 Frame -> True,
 LabelStyle -> {
   FontFamily -> "Arial",
   FontSize -> 20,
   FontColor -> Black,
   FontWeight -> Plain
   },
 FrameLabel -> {"x", "S"}
 ]

Mathematica graphics

The fit for the R data does not look good. Note that this is entirely due to the selected weights and number of points. One might want to modify the weights but that is beyond the scope of this answer.

Show[
 LogLinearPlot[
  Rfun[x, y, a1, b1, α, β, a2, b2, a3, b3] /. y -> 0 /. 
   solutionTSR[[2]],
  {x, 1.5, 5000},
  ImageSize -> Large,
  PlotRange -> {{1.1, 5000}, {-0.5, 0.5}},
  PlotStyle -> {Blue, Thick}
  ],
 ListLogLinearPlot[Rdatag, PlotStyle -> Black],
 Axes -> False,
 Frame -> True,
 LabelStyle -> {
   FontFamily -> "Arial",
   FontSize -> 20,
   FontColor -> Black,
   FontWeight -> Plain
   },
 FrameLabel -> {"x", "R"}
 ]

Mathematica graphics

NonlinearModelFit

With some work one could make a single function whose output was either the reconstructed T, S or R models by setting up another column in the data to identify the appropriate model.

Then one could combine all of the data and all of the weights and use NonlinearModelFit rather than FindMinimum.

The advantage of this approach is that all of the fitting statistics are available as an output of NonlinearModelFit.

I leave it to you to create the function but assuming that we have a fourth column that is either "T", "S" or "R" the function would look something like:

TRSFun[id_, x_, y_, a1_, b1_, α_, β_, a2_, b2_, a3_, b3_] :=
 Switch[id,
   "T",
  Tfun[x, y, a1, b1, α, β, a2, b2, a3, b3],
  "S",
  Sfun[x, y, a1, b1, α, β, a2, b2, a3, b3],
  "R",
  Rfun[x, y, a1, b1, α, β, a2, b2, a3, b3]

]

$\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.