Как уменьшить максимальный пик кубического уравнения (подгонка)

Question

Данные об объеме вентиляции были собраны в соответствии с эффективностью.Несколько образцов были взяты и вписаны в кубические уравнения.Он был написан в Excel, и было получено третье уравнение регрессии.

Однако, как видно из рисунка, объем вентиляции при 90-95% выше, чем 100%.Данные никогда не должны превышать 100%, но максимальная вершина авторегрессии является выпуклой, поэтому она превышает 100% в форме кривой.

Есть ли способ уменьшить максимальную вершину и подогнать ее?Это?Используйте измеренные данные как есть, но не превышайте 100%.

Использование R или других статистических программ также приветствуется.Значения R могут быть немного ниже.

Спасибо.

Answer 1

Я извлек данные из диаграммы рассеяния и нашел хорошее совпадение с сигмоидальным уравнением типа Гомперца «a * exp (-1.0 * exp ((x - b) / c)) + Offset», с извлеченными данными, дающими параметрыa = -4,7537951574153149E + 03, b = 5,4531406419707224E + 01, c = 2,1494180901343391E + 01 и смещение = 4,4056239791186508E + 03, получая RMSE = 57,17 и R-квадрат = 0,9988, см. ниже.Если вам кажется, что это может быть полезно для вас, я предлагаю заново подгонять фактические данные, используя эти значения в качестве начальных оценок параметров.

Answer 2

Вот несколько идей в R:

Во-первых, я делаю некоторые примеры данных, которые похожи на ваши, и подгоняю линейную модель с x ^ 3, x ^ 2 и x в качестве предикторов:

#  make example data
xx = rep(c(30, 50, 70, 100), each = 10)
yy = 1/(1+exp(-(xx-50)/15))  * 4798.20 + rnorm(length(xx), sd = 20)
xx = c(0, xx)
yy = c(0, yy)

# fit third-order linear model
m0 = lm(yy ~ I(xx^3) + I(xx^2) + xx)

x_to_predict = data.frame(xx = seq(0, 100, length.out = length(xx)))
lm_preds = predict(m0, newdata = x_to_predict)

Идея 1: Вы можете подобрать модель, которая использует сигмовидную (или другую монотонную) кривую.

# fit quasibinomial model for proportion
# first scale response variable between 0 and 1
m1 = glm(I(yy/max(yy)) ~ xx , family = quasibinomial())

# predict
preds_glm = predict(m1, 
                newdata = x_to_predict, 
                type = "response")

Идея 2: Подберите обобщенную аддитивную модель, которая сделает плавную кривую.

# fit Generalized Additive Model
library(mgcv)
# you have to tune "k" somewhat -- larger means more "wiggliness"
m2 = gam(yy ~ s(xx, k = 4)) 
gam_preds = predict(m2, 
                    newdata = x_to_predict, 
        type = "response")

Вот как выглядят графики для каждой модели:

# plot data and predictions
plot(xx, yy, ylab = "result", xlab = "efficiency")
lines(x_to_predict$xx, 
      preds_glm*max(yy), "l", col = 'red', lwd = 2)
lines(x_to_predict$xx, 
      gam_preds, "l", col = 'blue', lwd = 2)
lines(x_to_predict$xx, lm_preds, 
      "l", col = 'black', lwd = 2, lty = 2)
legend("bottomright", 
       lty = c(0, 1, 1, 2), 
       legend = c("data", "GLM prediction", "GAM prediction", "third-order lm"), 
       pch = c(1, NA_integer_, NA_integer_, NA_integer_), 
       col = c("black", "red", "blue", "black"))