Вопрос или проблема
Хорошо, этот вопрос может быть немного сложным, поэтому позвольте мне объяснить свою ситуацию как можно лучше.
У меня есть датафрейм, аналогичный приведенному ниже примеру, в котором есть предсказательная колонка (xpred
) и три ответные колонки (y1:y3
). У всех есть соответствующая колонка с логарифмическим преобразованием, так как я хочу запустить линейную модель с помощью lm()
, используя логарифмически преобразованные данные.
suppressWarnings(library(tidyverse))
# Создание примерных данных.
set.seed(10)
df <- data.frame(
subject = rep(paste("Subject", LETTERS[1:5]), each = 10),
xpred = rep(1:10, 5),
y1 = sort(runif(10, min = 130, max = 220), decreasing = TRUE),
y2 = sort(runif(10, min = 10, max = 90), decreasing = TRUE),
y3 = sort(runif(10, min = 2, max = 5), decreasing = TRUE)
)
# Логарифмическое преобразование колонок pred_x:y3.
df <- df %>%
group_by(subject) %>%
mutate(across(.cols = xpred:y3, .fns = ~log(.x), .names = "{col}_log")) %>%
ungroup()
head(df)
#> # A tibble: 6 × 9
#> subject xpred y1 y2 y3 xpred_log y1_log y2_log y3_log
#> <chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 Subject A 1 192. 76.9 4.59 0 5.26 4.34 1.52
#> 2 Subject A 2 185. 62.1 4.51 0.693 5.22 4.13 1.51
#> 3 Subject A 3 176. 57.7 4.33 1.10 5.17 4.05 1.46
#> 4 Subject A 4 169. 55.4 4.31 1.39 5.13 4.01 1.46
#> 5 Subject A 5 168. 44.3 4.12 1.61 5.13 3.79 1.42
#> 6 Subject A 6 158. 41.9 3.85 1.79 5.06 3.74 1.35
Создано 2024-10-25 с помощью reprex v2.1.1
Сейчас я комфортно запускаю модель (пример ниже) в изоляции, но это становится немного повторяющимся, когда я хочу запустить модель на следующих комбинациях колонок для каждого уникального субъекта в колонке subject
: y1_log ~ xpred_log
, y2_log ~ xpred_log
и y3_log ~ xpred_log
.
Если бы я делал это в изоляции, вот как бы выглядел мой код для одного субъекта.
# Подмножество данных для одного субъекта.
df_subset <- df %>% filter(subject == "Subject A")
# Запуск модели.
model <- lm(df_subset$y1_log ~ df_subset$xpred_log)
# Извлечение коэффициентов для расчетов предсказания.
c <- unname(exp(model$coefficients["(Intercept)"]))
n <- unname(model$coefficients["df_subset$xpred_log"])
Как вы заметите в моих данных, xpred
варьируется от 1 до 10, так как y1:y3
были ранее рассчитаны для этих значений. Что я хотел бы сделать в этом проекте, так это расширить xpred
, чтобы он варьировался от 1 до 30, и предсказать y1:y3
для значений от 11 до 30 на основе формулы c*x^n
, где x
это xpred
. Например, если я хотел бы предсказать y1
для значения 11, это было бы c*11^n
.
Надеюсь, вы все еще со мной!
Таким образом, в сущности, я хотел бы получить чистый/эффективный способ:
-
Выполнить
lm()
по вышеупомянутым комбинациям логарифмически преобразованных колонок в моем датафрейме для каждого субъекта. Я предполагаю, что это будет зависеть от какой-то формы вызоваgroup_by()
вdplyr
. -
Использовать коэффициенты (сохраненные как переменные
c
иn
) для предсказанияy1:y3
на основе значенийxpred
от 11 до 30 (уже известны 1 до 10).
Надеюсь, есть решение, в котором окончательный вывод, содержащий значения xpred
от 1 до 30 для каждого субъекта, сохранен в аккуратном датафрейме для дальнейшего анализа.
Благодарю за любую помощь в этом, и пожалуйста, дайте мне знать, если что-то нужно уточнить, так как это мой первый пост.
Ответ или решение
Чтобы вычислить множественные линейные модели на основе комбинаций столбцов в DataFrame в R, вы можете использовать пакет dplyr
в сочетании с purrr
для выполнения модели для каждой группы. В этой детали мы пройдем через процесс выполнения вашей задачи.
Шаг 1: Создание DataFrame и логарифмическое преобразование
Начнем с создания DataFrame, как вы и описали, и проведем логарифмическое преобразование соответствующих столбцов.
library(tidyverse)
# Создание примера данных
set.seed(10)
df <- data.frame(
subject = rep(paste("Subject", LETTERS[1:5]), each = 10),
xpred = rep(1:10, 5),
y1 = sort(runif(10, min = 130, max = 220), decreasing = TRUE),
y2 = sort(runif(10, min = 10, max = 90), decreasing = TRUE),
y3 = sort(runif(10, min = 2, max = 5), decreasing = TRUE)
)
# Логарифмическое преобразование
df <- df %>%
group_by(subject) %>%
mutate(across(.cols = xpred:y3, .fns = ~log(.x), .names = "{col}_log")) %>%
ungroup()
Шаг 2: Построение линейных моделей для каждой группы
Теперь мы построим линейные модели для каждой уникальной группы subject
по комбинациям логарифмических ответов. Используя dplyr
и purrr
, мы можем упростить процесс создания моделей и последующего извлечения коэффициентов.
# Функция для построения линейной модели и извлечения коэффициентов
run_models <- function(data) {
models <- list()
response_vars <- c("y1_log", "y2_log", "y3_log")
for (response in response_vars) {
formula <- as.formula(paste(response, "~ xpred_log"))
model <- lm(formula, data = data)
# Сохраняем коэффициенты
c <- exp(coef(model)["(Intercept)"])
n <- coef(model)["xpred_log"]
models[[response]] <- list(c = c, n = n)
}
return(models)
}
# Применение функции для каждой группы subject
model_results <- df %>%
group_by(subject) %>%
do(models = run_models(.)) %>%
ungroup()
Шаг 3: Прогнозирование для новых значений xpred
Теперь, когда у нас есть коэффициенты для каждой модели, мы можем использовать их для прогнозирования значений y1
, y2
, y3
для новых значений xpred
от 11 до 30.
# Создание нового DataFrame для прогнозов
new_xpred <- data.frame(xpred = 11:30)
predictions <- model_results %>%
rowwise() %>%
do({
subj <- .$subject
model_data <- .$models
preds <- new_xpred %>%
mutate(
y1_pred = model_data$y1_log$c * (xpred^model_data$y1_log$n),
y2_pred = model_data$y2_log$c * (xpred^model_data$y2_log$n),
y3_pred = model_data$y3_log$c * (xpred^model_data$y3_log$n)
)
preds <- cbind(subject = subj, preds)
})
# Объединяем все результаты прогнозирования
final_predictions <- bind_rows(predictions)
print(final_predictions)
Заключение
В результате выполнения этих шагов вы получите итоговый DataFrame, содержащий прогнозные значения для y1
, y2
и y3
в диапазоне значений xpred
от 11 до 30 для каждого уникального субъекта. Таким образом, вы сможете эффективно управлять множественными линейными моделями, избегая повторений кода и сохраняя результаты в удобном для анализа формате.
Если у вас есть дополнительные вопросы или пожелания по доработке данного решения, пожалуйста, дайте знать!