逆向工程功能

Question

我有一组数据，这些数据是各种功能的输出。我想对用于生成数据的功能进行反向工程。

数据不是模型，而是黑匣子的输出。一进一出功能。

数据中使用了各种不同的函数类型，因此我不能只寻找线性，多项式...，而是数据全部直接位于函数上，因为它是使用功能而不是模型。

这是数据的一个示例：

这是该图所使用的数据

structure(list(X = c(0.06050204, 0.167133799, 0.186391417, 0.190329366, 
0.196672471, 0.207911445, 0.214449273, 0.229251478, 0.234028819, 
0.242093899, 0.24349257, 0.244729436, 0.39800469, 0.436150397, 
0.450365566, 0.464060275, 0.466786445, 0.472667963, 0.477521528, 
0.482221782, 0.484183864, 0.49209699, 0.495429393, 0.508960782, 
0.68546826, 0.690209329, 0.723914626, 0.727942039, 0.741838149, 
0.747554145, 0.747708705, 0.75478701, 0.771729659, 0.775956414, 
0.778249962, 0.815312457, 0.828622825, 0.833439055, 0.839409187, 
0.840709342, 0.856131883, 0.872452239, 0.879358066, 0.895114147, 
1.247642798, 1.257366179, 1.266937575, 1.275446662, 1.27711604, 
1.287079698, 1.308993481, 1.318231746, 1.325242549, 1.335554042, 
1.338906966, 1.339160629, 1.340198035, 1.344638831, 1.352201623, 
1.359421854, 1.373292948, 1.399119753, 1.40965068, 1.410935624, 
1.415266773, 1.415425865, 1.438464079, 1.455720506, 1.460821629, 
1.466482054, 1.475282781, 1.483172643, 1.533184336, 1.546887373, 
1.998753453, 2.034199716, 2.066407989, 2.077510951, 2.20463565, 
2.223005095, 2.224830847, 2.267643369, 2.271226393, 2.295315266, 
2.344610251, 2.456412384, 2.562203204, 2.574557256, 2.600166132, 
2.619093601, 2.678881245, 2.683071018, 2.7087061, 2.711178093, 
2.722539394, 2.778354991, 2.798338885, 2.863908595, 3.02353335, 
3.261082156, 3.36021103, 3.392025038, 3.399868316, 3.492393297, 
3.560011162, 4.380118698, 4.468136425, 4.641043792, 5.273975349, 
5.325685858, 5.457207603, 5.805004184, 5.825779251, 5.834008996, 
6.012624786, 6.114247141, 6.180720738, 6.199476141, 6.291656452, 
6.412672968, 6.562967698, 6.723490329, 6.936856458, 6.947786566, 
7.820687305, 7.884015044, 7.934720069, 8.63725803, 8.676115972, 
8.824504671, 8.932868273, 9.00285955, 9.249167438, 9.470252998, 
9.601551702, 9.793235809, 10.00221276, 10.12583372, 10.25784496, 
10.43641476, 10.79602111, 10.80425459, 10.87037185, 10.88317157, 
11.02378492, 11.04006438, 11.10743316, 11.1317165, 11.190111, 
11.30456784, 11.32412056, 11.35565196, 11.7091522, 11.81045332, 
11.89758106, 11.98603597, 12.04573057, 12.04779309, 12.06195301, 
12.36455732, 12.41850727, 12.56517528, 12.5676588, 12.64066841, 
12.7827266, 12.86021779, 12.86393058, 12.88128857, 12.97103373, 
13.16279522, 13.17127567, 13.39998536, 16.20091983, 16.21963353, 
16.23242411, 16.2355031, 16.26389359, 16.35162378, 16.5230312, 
16.66152255, 16.72462785, 16.80908297, 16.8722608, 16.88049767, 
16.95431704, 17.2891657, 17.47689749, 27.85453484, 28.83527417, 
28.97085533, 30.27507516, 30.38642694), Y = c(3.21e-08, 4.73e-06, 
8.03e-06, 8.88e-06, 1.04e-05, 1.36e-05, 1.58e-05, 2.18e-05, 2.41e-05, 
2.83e-05, 2.91e-05, 2.98e-05, 0.000299, 0.000458, 0.00053152, 
0.00061047, 0.000627205, 0.0006645, 0.000696535, 0.00072867, 
0.000742415, 0.00079987, 0.000825055, 0.000933595, 0.0035789, 
0.00369004, 0.004555995, 0.00466874, 0.00507371, 0.005247635, 
0.005252395, 0.005473995, 0.006032475, 0.00617812, 0.00625823, 
0.007661875, 0.00821832, 0.00842678, 0.008690535, 0.00874877, 
0.009461505, 0.010260995, 0.010613695, 0.01145137, 0.045278785, 
0.046703545, 0.04813586, 0.049434285, 0.04969181, 0.051247985, 
0.05478723, 0.05632796, 0.057516695, 0.0592959, 0.059882385, 
0.059926915, 0.06010926, 0.060894075, 0.062246555, 0.063556605, 
0.06612541, 0.0710929, 0.073188245, 0.07344671, 0.074322405, 
0.074354705, 0.079131475, 0.082840305, 0.08395835, 0.085210635, 
0.087182125, 0.088975, 0.100906405, 0.104348895, 0.2627031, 0.278956975, 
0.294217255, 0.299586115, 0.364993055, 0.375038595, 0.376045155, 
0.40006762, 0.40211442, 0.41602006, 0.445256795, 0.515376245, 
0.58642996, 0.595015575, 0.613000035, 0.626452975, 0.669826935, 
0.672915725, 0.69195226, 0.69380039, 0.702322315, 0.7448435, 
0.760326675, 0.812055245, 0.94353242, 1.15173308, 1.24225578, 
1.27168728, 1.278969415, 1.36559796, 1.42966192, 2.225004175, 
2.309189795, 2.472209385, 3.030986595, 3.07341868, 3.178876745, 
3.43997735, 3.454735245, 3.460554895, 3.583149025, 3.649723495, 
3.692027405, 3.70378585, 3.76044543, 3.83199226, 3.916421805, 
4.001286245, 4.10584859, 4.11095823, 4.4481549, 4.467659255, 
4.482843405, 4.6574696, 4.665378215, 4.69409518, 4.71364424, 
4.725663775, 4.76441431, 4.79487557, 4.81121241, 4.832921495, 
4.85394571, 4.86519894, 4.876322005, 4.890010025, 4.913383635, 
4.913859645, 4.9175939, 4.91829898, 4.92567956, 4.926492205, 
4.92976681, 4.930912995, 4.93359729, 4.93857504, 4.939389235, 
4.940680735, 4.953482355, 4.956636135, 4.959184725, 4.96162567, 
4.963193545, 4.96324661, 4.96360894, 4.97058347, 4.971684245, 
4.974480855, 4.97452585, 4.975815045, 4.978146255, 4.979325265, 
4.97938019, 4.97963512, 4.98090556, 4.98336949, 4.983471055, 
4.985995335, 4.99828436, 4.99830891, 4.99832549, 4.998329455, 
4.99836561, 4.998472565, 4.998662135, 4.9987983, 4.99885575, 
4.998928445, 4.99897985, 4.99898637, 4.99904302, 4.999263355, 
4.999364235, 4.999999885, 4.99999995, 4.999999955, 4.999999985, 
4.999999985)), .Names = c("X", "Y"), class = c("tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -192L), spec = structure(list(
    cols = structure(list(X = structure(list(), class = c("collector_double", 
    "collector")), Y = structure(list(), class = c("collector_double", 
    "collector"))), .Names = c("X", "Y")), default = structure(list(), class = c("collector_guess", 
    "collector"))), .Names = c("cols", "default"), class = "col_spec"))

我希望能够生成用于创建此公式的公式。

Answer 1

splinefun能够完成我需要做的事情。

> x <- as.matrix(data[1])
> y <- as.matrix(data[2])
> splinefun(x, y)
> s0 = splinefun(x, y)
> print(s0)
function (x, deriv = 0L) 
{
    deriv <- as.integer(deriv)
    if (deriv < 0L || deriv > 3L) 
        stop("'deriv' must be between 0 and 3")
    if (deriv > 0L) {
        z0 <- double(z$n)
        z[c("y", "b", "c")] <- switch(deriv, list(y = z$b, b = 2 * 
            z$c, c = 3 * z$d), list(y = 2 * z$c, b = 6 * z$d, 
            c = z0), list(y = 6 * z$d, b = z0, c = z0))
        z[["d"]] <- z0
    }
    res <- .splinefun(x, z)
    if (deriv > 0 && z$method == 2 && any(ind <- x <= z$x[1L])) 
        res[ind] <- ifelse(deriv == 1, z$y[1L], 0)
    res
}
<bytecode: 0x10b1ba040>
<environment: 0x1085bbd50>
> s0(5)
[1] 2.797464
> s0(24)
[1] 5.000285

这是用原始数据绘制的函数。

> plot(data)
> curve(s0(x), add=TRUE, col=2, n=1001)

Answer 2

至少您可以使用非线性回归来估算此曲线。形状对我来说是S型：

library(nlme)
fit <- nls(Y ~ SSlogis(X, Asym, xmid, scal), data = x)
new_dat <- data.frame(X = seq(0, 30, length.out = 1000))
plot(x$X, x$Y)
lines(new_dat$X, predict(fit, new_dat), col = 2)