regresión "ponderada" en I

Question

He creado un script como el siguiente para hacer algo que se llama como la regresión "ponderada":

library(plyr) 

set.seed(100) 

temp.df <- data.frame(uid=1:200, 
         bp=sample(x=c(100:200),size=200,replace=TRUE), 
         age=sample(x=c(30:65),size=200,replace=TRUE), 
         weight=sample(c(1:10),size=200,replace=TRUE), 
         stringsAsFactors=FALSE) 

temp.df.expand <- ddply(temp.df, 
         c("uid"), 
         function(df) { 
          data.frame(bp=rep(df[,"bp"],df[,"weight"]), 
            age=rep(df[,"age"],df[,"weight"]), 
            stringsAsFactors=FALSE)}) 

temp.df.lm <- lm(bp~age,data=temp.df,weights=weight) 
temp.df.expand.lm <- lm(bp~age,data=temp.df.expand) 

Se puede ver que en temp.df, cada fila tiene su peso, lo Quiero decir es que hay un total de 1178 muestras, pero para las filas con el mismo bp y age, se fusionan en 1 fila y se representan en la columna weight.

I utiliza los parámetros weight en la función lm, entonces cruzo comprobar el resultado con otra trama de datos que el temp.df trama de datos se "expande". Pero encontré las salidas lm diferentes para el cuadro de datos 2.

¿He interpretan mal los parámetros weight en lm función, y puede alguien que me haga saber cómo corro de regresión correctamente (es decir, sin la ampliación de la trama de datos de forma manual) para un conjunto de datos presentados como temp.df? Gracias.

Answer 1

El problema aquí es que los grados de libertad no se suman correctamente para obtener las estadísticas correctas de Df y de suma media. Esto soluciona el problema:

temp.df.lm.aov <- anova(temp.df.lm) 
temp.df.lm.aov$Df[length(temp.df.lm.aov$Df)] <- 
     sum(temp.df.lm$weights)- 
     sum(temp.df.lm.aov$Df[-length(temp.df.lm.aov$Df)] ) -1 
temp.df.lm.aov$`Mean Sq` <- temp.df.lm.aov$`Sum Sq`/temp.df.lm.aov$Df 
temp.df.lm.aov$`F value`[1] <- temp.df.lm.aov$`Mean Sq`[1]/ 
             temp.df.lm.aov$`Mean Sq`[2] 
temp.df.lm.aov$`Pr(>F)`[1] <- pf(temp.df.lm.aov$`F value`[1], 1, 
             temp.df.lm.aov$Df, lower.tail=FALSE)[2] 
temp.df.lm.aov 
Analysis of Variance Table 

Response: bp 
      Df Sum Sq Mean Sq F value Pr(>F) 
age   1 8741 8740.5 10.628 0.001146 ** 
Residuals 1176 967146 822.4   

Comparar con:

> anova(temp.df.expand.lm) 
Analysis of Variance Table 

Response: bp 
      Df Sum Sq Mean Sq F value Pr(>F) 
age   1 8741 8740.5 10.628 0.001146 ** 
Residuals 1176 967146 822.4      
--- 
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

Estoy un poco sorprendido de que esto no ha llegado con más frecuencia en I-ayuda. O eso o mis poderes de desarrollo de la estrategia de búsqueda se están debilitando con la vejez.