r - shiny using html

usando predicción con una lista de objetos lm()

Question

Tengo datos con los que regularmente ejecuto regresiones. Cada "fragmento" de datos se ajusta a una regresión diferente. Cada estado, por ejemplo, puede tener una función diferente que explica el valor dependiente. Esto parece un problema típico de tipo "dividir-aplicar-combinar", entonces estoy usando el paquete plyr. Puedo crear fácilmente una lista de objetos lm() que funciona bien. Sin embargo, no puedo comprender cómo uso esos objetos más adelante para predecir valores en un cuadro de datos separado.

Aquí hay un ejemplo totalmente artificial que ilustra lo que estoy tratando de hacer:

# setting up some fake data
set.seed(1)
funct <- function(myState, myYear){
   rnorm(1, 100, 500) +  myState + (100 * myYear) 
}
state <- 50:60
year <- 10:40
myData <- expand.grid( year, state)
names(myData) <- c("year","state")
myData$value <- apply(myData, 1, function(x) funct(x[2], x[1]))
## ok, done with the fake data generation. 

require(plyr)

modelList <- dlply(myData, "state", function(x) lm(value ~ year, data=x))
## if you want to see the summaries of the lm() do this:  
    # lapply(modelList, summary)

state <- 50:60
year <- 50:60
newData <- expand.grid( year, state)
names(newData) <- c("year","state") 
## now how do I predict the values for newData$value 
   # using the regressions in modelList? 

Entonces, ¿cómo uso los objetos lm() contenidos en modelList para predecir valores usando el año y los valores independientes del estado de newData ?

Answer 1

Aquí está mi intento:

predNaughty <- ddply(newData, "state", transform,
  value=predict(modelList[[paste(piece$state[1])]], newdata=piece))
head(predNaughty)
#   year state    value
# 1   50    50 5176.326
# 2   51    50 5274.907
# 3   52    50 5373.487
# 4   53    50 5472.068
# 5   54    50 5570.649
# 6   55    50 5669.229
predDiggsApproved <- ddply(newData, "state", function(x)
  transform(x, value=predict(modelList[[paste(x$state[1])]], newdata=x)))
head(predDiggsApproved)
#   year state    value
# 1   50    50 5176.326
# 2   51    50 5274.907
# 3   52    50 5373.487
# 4   53    50 5472.068
# 5   54    50 5570.649
# 6   55    50 5669.229

Edición larga de JD

Me inspiré lo suficiente como para elaborar una opción adply() :

pred3 <- adply(newData, 1,  function(x)
    predict(modelList[[paste(x$state)]], newdata=x))
head(pred3)
#   year state        1
# 1   50    50 5176.326
# 2   51    50 5274.907
# 3   52    50 5373.487
# 4   53    50 5472.068
# 5   54    50 5570.649
# 6   55    50 5669.229

Answer 2

Lo que está mal con

lapply(modelList, predict, newData)

?

EDITAR:

Gracias por explicar lo que está mal con eso. Qué tal si:

newData <- data.frame(year)
ldply(modelList, function(model) {
  data.frame(newData, predict=predict(model, newData))
})

Iterar sobre los modelos y aplicar los nuevos datos (que es el mismo para cada estado, ya que acaba de hacer un expand.grid para crearlo).

EDIT 2:

Si newData no tiene los mismos valores por year para cada state que en el ejemplo, se puede usar un enfoque más general. Tenga en cuenta que esto utiliza la definición original de newData , no la de la primera edición.

ldply(state, function(s) {
  nd <- newData[newData$state==s,]
  data.frame(nd, predict=predict(modelList[[as.character(s)]], nd))
})

Primeras 15 líneas de esta salida:

   year state  predict
1    50    50 5176.326
2    51    50 5274.907
3    52    50 5373.487
4    53    50 5472.068
5    54    50 5570.649
6    55    50 5669.229
7    56    50 5767.810
8    57    50 5866.390
9    58    50 5964.971
10   59    50 6063.551
11   60    50 6162.132
12   50    51 5514.825
13   51    51 5626.160
14   52    51 5737.496
15   53    51 5848.832

Answer 3

Supongo que la parte difícil es hacer coincidir cada estado en newData con el modelo correspondiente.

¿Algo así tal vez?

predList <- dlply(newData, "state", function(x) {
  predict(modelList[[as.character(min(x$state))]], x) 
})

Aquí utilicé una forma "pirata" de extraer el modelo de estado correspondiente: as.character(min(x$state))

... probablemente hay una mejor manera?

Salida:

> predList[1:2]
$`50`
       1        2        3        4        5        6        7        8        9       10       11 
5176.326 5274.907 5373.487 5472.068 5570.649 5669.229 5767.810 5866.390 5964.971 6063.551 6162.132 

$`51`
      12       13       14       15       16       17       18       19       20       21       22 
5514.825 5626.160 5737.496 5848.832 5960.167 6071.503 6182.838 6294.174 6405.510 6516.845 6628.181

O, si quieres un data.frame como salida:

predData <- ddply(newData, "state", function(x) {
  y <-predict(modelList[[as.character(min(x$state))]], x)
  data.frame(id=names(y), value=c(y))
})

Salida:

head(predData)
  state id    value
1    50  1 5176.326
2    50  2 5274.907
3    50  3 5373.487
4    50  4 5472.068
5    50  5 5570.649
6    50  6 5669.229

Answer 4

Tal vez me esté perdiendo algo, pero creo que lmList es la herramienta ideal aquí,

library(nlme)
ll = lmList(value ~ year | state, data=myData)
predict(ll, newData)


## Or, to show that it produces the same results as the other proposed methods...
newData[["value"]] <- predict(ll, newData)
head(newData)
#   year state    value
# 1   50    50 5176.326
# 2   51    50 5274.907
# 3   52    50 5373.487
# 4   53    50 5472.068
# 5   54    50 5570.649
# 6   55    50 5669.229

Answer 5

Una solución con solo la base R. El formato de la salida es diferente, pero todos los valores están ahí.

models <- lapply(split(myData, myData$state), ''lm'', formula = value ~ year)
pred4  <- mapply(''predict'', models, split(newData, newData$state))

Answer 6

mdply usar mdply para suministrar tanto el modelo como los datos a cada llamada de función:

dataList <- dlply(newData, "state")

preds <- mdply(cbind(mod = modelList, df = dataList), function(mod, df) {
  mutate(df, pred = predict(mod, newdata = df))
})