Давайте смоделируем некоторые данные, чтобы показать, как это можно сделать.
Представьте, что мы тестируем новый электрический продукт, и мы тестируем его при различных температурах, чтобы увидеть, влияет ли температура на частоту отказов.
set.seed(69)
df <- data.frame(temperature = seq(0, 100, length.out = 1000),
failed = rbinom(1000, 1, seq(0.1, 0.9, length.out = 1000)))
Итак, у нас есть два столбца: температура и дихотомический столбец, состоящий из 1 (не удалось) и 0 (прошел).
Мы можем получить приблизительную оценку взаимосвязи между температурой и частоту отказов, просто разрезав наш фрейм данных на ячейки по 5 градусов:
df$temp_range <- cut(df$temperature, seq(0, 100, 5), include.lowest = TRUE)
Теперь мы можем построить долю устройств, которые вышли из строя в каждом температурном диапазоне 5 градусов: 1014 *
Мы видим, что вероятность отказа go возрастает линейно с температурой.
Теперь, если мы получим пропорции отказов в каждой ячейке, мы примем их за оценка вероятности отказа. Это позволяет нам рассчитать логарифмические шансы отказа в каждой ячейке:
counts <- table(df$temp_range, df$failed)
probs <- counts[,2]/rowSums(counts)
logodds <- log(probs/(1 - probs))
temp_range <- seq(2.5, 97.5, 5)
logit_df <- data.frame(temp_range, probs, logodds)
Итак, теперь мы можем построить логарифмические шансы. Здесь мы сделаем нашу ось x непрерывной, взяв среднюю точку каждого бина в качестве координаты x. Затем мы можем провести линейную регрессию по нашим точкам:
p <- ggplot(logit_df, aes(temp_range, logodds)) +
geom_point() +
geom_smooth(method = "lm", colour = "black", linetype = 2, se = FALSE)
p
#> `geom_smooth()` using formula 'y ~ x'
и фактически провести линейную регрессию:
summary(lm(logodds ~ temp_range))
#>
#> Call:
#> lm(formula = logodds ~ temp_range)
#>
#> Residuals:
#> Min 1Q Median 3Q Max
#> -0.70596 -0.20764 -0.06761 0.18100 1.31147
#>
#> Coefficients:
#> Estimate Std. Error t value Pr(>|t|)
#> (Intercept) -2.160639 0.207276 -10.42 4.70e-09 ***
#> temp_range 0.046025 0.003591 12.82 1.74e-10 ***
#> ---
#> Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
#>
#> Residual standard error: 0.463 on 18 degrees of freedom
#> Multiple R-squared: 0.9012, Adjusted R-squared: 0.8957
#> F-statistic: 164.2 on 1 and 18 DF, p-value: 1.738e-10
Мы можем видеть что линейное предположение здесь разумно.
То, что мы только что сделали, похоже на грубую форму логистической c регрессии. Давайте теперь сделаем это правильно:
model <- glm(failed ~ temperature, data = df, family = binomial())
summary(model)
#>
#> Call:
#> glm(formula = failed ~ temperature, family = binomial(), data = df)
#>
#> Deviance Residuals:
#> Min 1Q Median 3Q Max
#> -2.1854 -0.8514 0.4672 0.8518 2.0430
#>
#> Coefficients:
#> Estimate Std. Error z value Pr(>|z|)
#> (Intercept) -2.006197 0.159997 -12.54 <2e-16 ***
#> temperature 0.043064 0.002938 14.66 <2e-16 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> (Dispersion parameter for binomial family taken to be 1)
#>
#> Null deviance: 1383.4 on 999 degrees of freedom
#> Residual deviance: 1096.0 on 998 degrees of freedom
#> AIC: 1100
#>
#> Number of Fisher Scoring iterations: 3
Обратите внимание, насколько близки коэффициенты к нашей модели, созданной вручную.
Теперь, когда у нас есть эта модель, мы можем построить ее прогнозы по нашей грубой линейной оценка:
mod_df <- data.frame(temp_range = 1:100,
logodds = predict(model, newdata = list(temperature = 1:100)))
p + geom_line(data = mod_df, colour = "red", linetype = 3, size = 2)
#> `geom_smooth()` using formula 'y ~ x'
Достаточно близко.
Создано 19.06.2020 пакетом REPEX ( v0.3.0)