Создание многочисленных статистических моделей на основе критериев выбора в отдельном кадре данных - PullRequest
Новая
       6

Создание многочисленных статистических моделей на основе критериев выбора в отдельном кадре данных

0 голосов
/ 06 декабря 2018

Я хочу выполнить определенное количество статистических моделей на основе критериев выбора, указанных в кадре данных.Итак, используя базовый пример, скажем, у меня было 2 переменные ответа и 2 объясняющие переменные: 

#######################Data Input############################
Responses <- as.data.frame(matrix(sample(0:10, 1*100, replace=TRUE), ncol=2))
colnames(Responses) <- c("A","B")

Explanatories <- as.data.frame(matrix(sample(20:30, 1*100, replace=TRUE), ncol=2))
colnames(Explanatories) <- c("x","y")

Затем я определяю, какие статистические модели я хотел бы запустить, которые могут включать в себя различные комбинации отклика / пояснительных переменных иразличные статистические функции: 

###################Model selection#########################
Function <- c("LIN","LOG","EXP") ##Linear, Logarithmic (base 10) and exponential - see the formula for these below
Respo <- c("A","B","B")
Explan <- c("x","x","y")
Model_selection <- data.frame(Function,Respo,Explan)

Как мне затем выполнить список моделей на основе этих критериев выбора?Вот пример моделей, которые я хотел бы создать на основе входных данных из фрейма данных Model_selection.

####################Model creation#########################
Models <- list(
lm(Responses$A ~ Explanatories$x),
lm(Responses$B ~ log10(Explanatories$x)),
lm(Responses$B ~ exp(Explanatories$y))
)

Я бы предположил, что потребуется какая-то функция цикла, и после просмотра, возможно, тоже вставьте?Заранее спасибо за любую помощь с этим

Ответы [ 2 ]

0 голосов
/ 06 декабря 2018

Это идеальный вариант использования для tidyverse

library(tidyverse)

## cbind both data sets into one
my_data <- cbind(Responses, Explanatories)

## use 'mutate' to change function names to the existing function names
## mutate_all to transform implicit factors to characters
## NB this step could be ommitted if Function would already use the proper names
model_params <- Model_selection %>%
   mutate(Function = case_when(Function == "LIN" ~ "identity",
                               Function == "LOG" ~ "log10",
                               Function == "EXP" ~ "exp")) %>%
   mutate_all(as.character)

## create a function which estimates the model given the parameters
## NB: function params must be named exactly like columns 
## in the model_selection df
make_model <- function(Function, Respo, Explan) {
  my_formula <- formula(paste0(Respo, "~", Function, "(", Explan, ")"))
  my_mod <- lm(my_formula, data = my_data)
  ## syntactic sugar: such that we see the value of the formula in the print
  my_mod$call$formula <- my_formula
  my_mod
}

## use purrr::pmap to loop over the model params
## creates a list with all the models
pmap(model_params, make_model)
0 голосов
/ 06 декабря 2018

Это не самое симпатичное решение, но, похоже, оно подойдет для вашего примера: 

Models <- list()
idx <- 1L
for (row in 1:nrow(Model_selection)){

  if (Model_selection$Function[row]=='LOG'){
    expl <- paste0('LOG', Model_selection$Explan[row])
    Explanatories[[expl]] <- log10(Explanatories[[Model_selection$Explan[row]]])
    Models[[idx]] <- lm(Responses[[Model_selection$Respo[row]]] ~ Explanatories[[expl]])
  }
  if (Model_selection$Function[row]=='EXP'){
    expl <- paste0('EXP', Model_selection$Explan[row])
    Explanatories[[expl]] <- exp(Explanatories[[Model_selection$Explan[row]]])
    Models[[idx]] <- lm(Responses[[Model_selection$Respo[row]]] ~ Explanatories[[expl]])
  }
  if (Model_selection$Function[row]=='LIN'){
    expl <- paste0('LIN', Model_selection$Explan[row])
    Explanatories[[expl]] <- Explanatories[[Model_selection$Explan[row]]]
    Models[[idx]] <- lm(Responses[[Model_selection$Respo[row]]] ~ Explanatories[[expl]])
  }
  names(Models)[idx] <- paste(Model_selection$Respo[row], '~', expl)
  idx <- idx+1L
}
Models
...