# How can I find an intermediate function between a set of functions?

I have 5 nonlinear functions, which are very complex and long. For this reason I will not include them here. But the plots of four of them are given here:

I am looking for some functionality which may find an intermediate function among these four, which has the closest distance at each point on the x-axis to each of the four plots. I found two interesting functionalities, https://reference.wolfram.com/language/NonlinearRegression/tutorial/NonlinearRegression.html and https://reference.wolfram.com/applications/eda/FittingDataToNonlinearModels.html

However, these need points to regress. Are there any functionalities in Mathematica that can do nonlinear regression on functions?

Thanks

• Are you trying to find an explicit formula for the resulting "intermediate" function, namely $f(x) = \cdots$, or are you satisfied with a sampled, numeric result? Dec 28, 2022 at 15:26
• Both would be great, but if the numerical result can be used as a form of dataset or interpolation later, it will be OK too! Dec 28, 2022 at 15:27
• I offer the following: (1) If there are only 5 curves, just plot them all on a single graph, (2) You probably want the "average" on the logs of the values, (3) along with the average you should have some measure of variability, (4) ask this question on CrossValidated StackExchange (stats.stackexchange.com) and mention "functional data analysis": en.wikipedia.org/wiki/Functional_data_analysis, and (5) stating the purpose for wanting to combine dissimilar curves into a single "average" is critical.
– JimB
Dec 28, 2022 at 17:17
• Given the figures presented, I disagree (although maybe this is just a semantics issue). The figures are the curves in the original units plotted on a log scale as opposed to plotting the log of the functions on a linear scale. So, yes, you don't want to take the log of the logs. It is the geometric mean in the original units that's needed and then that average is plotted on the same log scale as in the figures in your question.
– JimB
Dec 29, 2022 at 17:28
• @Domen 's solution ends up being the arithmetic average. If one didn't want to assume that the value that minimizes the sum of squares is the arithmetic average, then that would be the way to go.
– JimB
Dec 29, 2022 at 18:39

You simply need to take the pointwise arithmetic average to minimize the mean square error on the original scale or the geometric average to minimize the mean square error on the log scale (as mentioned by @JohnMadden at https://stats.stackexchange.com/questions/600285/how-to-combine-dissimilar-curves-into-a-single-average?noredirect=1#comment1112129_600285.

Arithmetic or geometric mean? Given that you are showing the plots on a log scale, I'd vote for the geometric mean. But there might be some subject-matter reason for the arithmetic mean. (In other words, it's not just about the numbers. The decision requires subject-matter knowledge.)

I've digitized the first two curves and linearly interpolated those points to allow for obtaining intermediate points. Here are the averages for both the arithmetic and geometric means on both a linear and log scale.

d1 = {{0.15576323987538943, 27888682.018000126}, {0.35825545171339535, 28158754.38588849}, {0.6230529595015573, 28845432.997554258}, {0.8722741433021806, 29406813.062473945}, {1.090342679127726, 29835006.339824874}, {1.339563862928349, 30710188.47782043}, {1.6199376947040498, 31307859.783459507}, {1.8380062305295948, 31917162.765987914}, {2.1183800623052953, 32695493.82126514}, {2.3676012461059184, 33012115.0739256}, {2.6635514018691584, 33654585.69674162}, {2.9127725856697815, 34144630.88853987}, {3.2242990654205608, 34977280.92032298}, {3.53582554517134, 35486585.90751357}, {3.8473520249221185, 35146231.8509037}, {4.080996884735202, 34309559.86561202}, {4.283489096573209, 33171573.6543362}, {4.548286604361371, 30710188.47782043}, {4.735202492211838, 29265452.00694473}, {4.906542056074766, 27621199.93102035}, {5.077881619937695, 26448924.71172429}, {5.3115264797507775, 25695180.5107205}, {5.498442367601245, 26069328.621623732}, {5.716510903426791, 27356283.28140367}, {5.8566978193146415, 29265452.00694473}, {6.012461059190031, 31459086.291230522}, {6.105919003115265, 33012115.0739256}, {6.277258566978192, 35146231.8509037}, {6.401869158878504, 36351960.81756076}, {6.5420560747663545, 38330793.67201461}, {6.713395638629283, 39837273.596115045}, {6.90031152647975, 40223055.42701603}, {7.149532710280373, 39455191.822792314}, {7.3676012461059175, 37599053.60231369}, {7.554517133956385, 34977280.92032298}, {7.694704049844236, 32695493.82126514}, {7.834890965732087, 30269434.549277384}, {7.975077881619936, 28023392.854738533}, {8.130841121495326, 25695180.5107205}, {8.271028037383175, 22888971.76667416}, {8.473520249221181, 20389233.238389708}, {8.598130841121494, 18695274.738905102}, {8.707165109034266, 17142052.05642869}, {8.909657320872272, 15946741.018279528}, {9.11214953271028, 15123488.170492101}, {9.361370716510903, 15269943.14668281}, {9.532710280373829, 15946741.018279528}, {9.657320872274141, 16896028.59771182}, {9.813084112149532, 17815770.359834112}, {9.999999999999998, 18876318.68762239}};
d2 = {{0.0619195046439629, 65244252.714321114}, {0.2786377708978327, 65046887.41912322}, {0.5108359133126934, 63895404.83743486}, {0.6811145510835912, 62209571.71559735}, {0.851393188854489, 60748090.107776485}, {0.9597523219814244, 59322032.119475015}, {1.1145510835913315, 57586113.22047326}, {1.2693498452012386, 55735471.84467494}, {1.4086687306501549, 54104753.50258524}, {1.5170278637770893, 52211658.28900773}, {1.6873065015479873, 50683575.00120118}, {1.8111455108359131, 48765140.464943126}, {2.0123839009287927, 47337492.13372791}, {2.2445820433436534, 46499507.4150806}, {2.492260061919504, 46911568.15660117}, {2.662538699690402, 48464548.47111898}, {2.8328173374613, 50366764.655987754}, {2.9411764705882346, 52189613.5018157}, {3.06501547987616, 55048958.105777785}, {3.219814241486068, 58064426.319180384}, {3.3436532507739933, 61064292.65827257}, {3.4674922600619187, 64409859.79302654}, {3.591331269349845, 68342842.87079988}, {3.761609907120742, 72730333.30803478}, {3.8854489164086683, 76261428.73121768}, {3.9783281733746128, 79491852.95206213}, {4.102167182662538, 82613017.385934}, {4.287925696594426, 85855154.6530389}, {4.458204334365324, 89755675.9601989}, {4.659442724458204, 92177832.45641635}, {4.845201238390092, 94106016.72419916}, {5.046439628482972, 95223206.59635475}, {5.294117647058823, 96352332.43907347}, {5.557275541795666, 96917902.25030807}, {5.789473684210526, 96624279.93399164}, {5.975232198142415, 96047636.94839196}, {6.160990712074303, 94909882.31255996}, {6.377708978328173, 93507052.27940893}, {6.594427244582042, 91580209.9077934}, {6.76470588235294, 88636695.46818762}, {6.981424148606811, 85026832.83740048}, {7.151702786377708, 81565110.50776042}, {7.306501547987615, 78710108.76580703}, {7.4458204334365305, 74837527.5384325}, {7.569659442724458, 71791634.00887407}, {7.708978328173373, 68259445.59616923}, {7.8328173374613, 64709171.1214184}, {7.9566563467492255, 61161916.4776066}, {8.06501547987616, 57981061.114540316}, {8.204334365325076, 54640112.18417334}, {8.28173374613003, 51645538.66405376}, {8.374613003095973, 48814859.884844035}, {8.467492260061917, 45866501.91267188}, {8.622291021671826, 42335454.5056284}, {8.761609907120741, 39777896.92930071}, {8.885448916408668, 37044002.75952661}, {9.024767801857585, 35117128.322678134}, {9.133126934984519, 33588264.42992504}, {9.287925696594426, 32508840.44349814}, {9.473684210526315, 31839243.046130344}, {9.659442724458202, 31368926.229139872}, {9.984520123839008, 31088108.082565922}};
f1 = Interpolation[d1];
f2 = Interpolation[d2];


Figures on a log scale:

LogPlot[{f1[x], f2[x], (f1[x] + f2[x])/2, Exp[(Log[f1[x]] + Log[f2[x]])/2]}, {x, 0.2, 9.9},
PlotLegends -> {"f1", "f2", "Arithmetic mean", "Geometric mean"}]


Figures on a linear scale:

• Thanks Jim, I will look at this closer tomorrow! Dec 29, 2022 at 19:50

Point-wise calculation of the intermediate function

interF[funs_, x_?NumericQ] := ArgMin[Total[(f |-> (f[x] - t)^2) /@ funs], t]

f1 = x |-> Cos[x];
f2 = x |-> Cos[2 x];
f3 = x |-> Cos[3 x];

Plot[Evaluate@{f1[x], f2[x], f3[x], interF[{f1, f2, f3}, x]}, {x, 0,2 Pi},
PlotStyle -> {Gray, Gray, Gray, Red}]


• Thanks, does this mean that interF[funs_, x_?NumericQ] is an analytic function? Dec 28, 2022 at 15:49