Primero veamos la transformacion de Box-Cox vista en clase

modelo<-lm(Volume~., trees)
summary(modelo)
## 
## Call:
## lm(formula = Volume ~ ., data = trees)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.4065 -2.6493 -0.2876  2.2003  8.4847 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -57.9877     8.6382  -6.713 2.75e-07 ***
## Girth         4.7082     0.2643  17.816  < 2e-16 ***
## Height        0.3393     0.1302   2.607   0.0145 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.882 on 28 degrees of freedom
## Multiple R-squared:  0.948,  Adjusted R-squared:  0.9442 
## F-statistic:   255 on 2 and 28 DF,  p-value: < 2.2e-16
hist(modelo$res)

par(mfrow=c(2,2))
plot(modelo)

Graficamos la log-likelihood en función de lambda

library(MASS)
par(mfrow=c(1,1))
b<-boxcox(modelo)

Como el máximo no se localiza a simple vista, debemos localizarlo

b$x[which(b$y==max(b$y))]
## [1] 0.3030303

Una vez que conocemoes el coeficiente que maximizó la log-lik, aplicamos una transformación al modelo

modelo2<-lm((Volume^(0.3)-1)/0.3~.,trees)
par(mfrow=c(2,2))
plot(modelo2)

bestNormalize

Como se mencionó en clase, tambien es poisble usar el paquete bestNormaliza que contiene un conjunto de funciones para encontrar transformaciones que se usan para ‘normalizar’ los datos. Recuerde que en nuestro caso, queremos que se cumple el supuesto sobre los errores.

Hay varias opciones de transformación a la normalidad, cada una con sus propias ventajas y limitaciones. Además el paquete permite analizar transformaciones individualemte o en grupo. Algunas transformaciones incluidas son:

En el ejemplo anterior, se podría aplicar alguna de las anteriores:

library(bestNormalize)
## 
## Attaching package: 'bestNormalize'
## The following object is masked from 'package:MASS':
## 
##     boxcox
arcsinh_x(modelo$residuals)
## Standardized asinh(x) Transformation with 31 nonmissing obs.:
##  Relevant statistics:
##  - mean (before standardization) = -0.07244041 
##  - sd (before standardization) = 1.767576
orderNorm(modelo$res)
## orderNorm Transformation with 31 nonmissing obs and no ties 
##  - Original quantiles:
##     0%    25%    50%    75%   100% 
## -6.406 -2.649 -0.288  2.200  8.485

o podemos usar la funcion que nos dice cuales son las mejores transformaciones para nuestros datos:

bestNormalize(modelo$residuals)
## Best Normalizing transformation with 31 Observations
##  Estimated Normality Statistics (Pearson P / df, lower => more normal):
##  - arcsinh(x): 1.7133
##  - Center+scale: 1.42
##  - Exp(x): 2.9133
##  - Log_b(x+a): Inf
##  - orderNorm (ORQ): 1.62
##  - sqrt(x + a): Inf
##  - Yeo-Johnson: 1.2867
## Estimation method: Out-of-sample via CV with 10 folds and 5 repeats
##  
## Based off these, bestNormalize chose:
## Standardized Yeo-Johnson Transformation with 31 nonmissing obs.:
##  Estimated statistics:
##  - lambda = 0.896797 
##  - mean (before standardization) = -0.3195476 
##  - sd (before standardization) = 3.724466

por ejemplo, en este caso podemos observar que es la transformación de Yeo-Johnson, muy similar a BoxCox

modelo3<- lm((Volume^(0.89)-1)/0.89 ~., data=trees)
par(mfrow=c(2,2))
plot(modelo2)

Y podemos comparar los errores de modelos a través de graficas o pruebas de hipótesis

par(mfrow=c(1,2))
hist(modelo2$residuals)
hist(modelo3$residuals)

LS0tCnRpdGxlOiAiRWplbXBsb3MgZGUgdHJhbmZvcm1hY2lvbmVzIGEgbGEgbm9ybWFsaWRhZCIKZGF0ZTogIjE4LTA1LTIwMjIiCm91dHB1dDoKICBodG1sX2RvY3VtZW50OgogICAgY29kZV9kb3dubG9hZDogdHJ1ZQotLS0KCiMjIyBQcmltZXJvIHZlYW1vcyBsYSB0cmFuc2Zvcm1hY2lvbiBkZSBCb3gtQ294IHZpc3RhIGVuIGNsYXNlCgpgYGB7cn0KbW9kZWxvPC1sbShWb2x1bWV+LiwgdHJlZXMpCnN1bW1hcnkobW9kZWxvKQpoaXN0KG1vZGVsbyRyZXMpCnBhcihtZnJvdz1jKDIsMikpCnBsb3QobW9kZWxvKQpgYGAKCkdyYWZpY2Ftb3MgbGEgbG9nLWxpa2VsaWhvb2QgZW4gZnVuY2nDs24gZGUgbGFtYmRhCgpgYGB7cn0KbGlicmFyeShNQVNTKQpwYXIobWZyb3c9YygxLDEpKQpiPC1ib3hjb3gobW9kZWxvKQpgYGAKCkNvbW8gZWwgbcOheGltbyBubyBzZSBsb2NhbGl6YSBhIHNpbXBsZSB2aXN0YSwgZGViZW1vcyBsb2NhbGl6YXJsbyAKCmBgYHtyfQpiJHhbd2hpY2goYiR5PT1tYXgoYiR5KSldCmBgYAoKVW5hIHZleiBxdWUgY29ub2NlbW9lcyBlbCBjb2VmaWNpZW50ZSBxdWUgbWF4aW1pesOzIGxhIGxvZy1saWssIGFwbGljYW1vcyB1bmEgdHJhbnNmb3JtYWNpw7NuIGFsIG1vZGVsbwoKYGBge3J9Cm1vZGVsbzI8LWxtKChWb2x1bWVeKDAuMyktMSkvMC4zfi4sdHJlZXMpCnBhcihtZnJvdz1jKDIsMikpCnBsb3QobW9kZWxvMikKYGBgCgojIyMgYmVzdE5vcm1hbGl6ZQoKQ29tbyBzZSBtZW5jaW9uw7MgZW4gY2xhc2UsIHRhbWJpZW4gZXMgcG9pc2JsZSB1c2FyIGVsIHBhcXVldGUgYmVzdE5vcm1hbGl6YSBxdWUgY29udGllbmUgdW4gY29uanVudG8gZGUgZnVuY2lvbmVzIHBhcmEgZW5jb250cmFyIHRyYW5zZm9ybWFjaW9uZXMgcXVlIHNlIHVzYW4gcGFyYSAnbm9ybWFsaXphcicgbG9zIGRhdG9zLiBSZWN1ZXJkZSBxdWUgZW4gbnVlc3RybyBjYXNvLCBxdWVyZW1vcyBxdWUgc2UgY3VtcGxlIGVsIHN1cHVlc3RvIHNvYnJlIGxvcyBlcnJvcmVzLiAKCkhheSB2YXJpYXMgb3BjaW9uZXMgZGUgdHJhbnNmb3JtYWNpw7NuIGEgbGEgbm9ybWFsaWRhZCwgY2FkYSB1bmEgY29uIHN1cyBwcm9waWFzIHZlbnRhamFzIHkgbGltaXRhY2lvbmVzLiBBZGVtw6FzIGVsIHBhcXVldGUgcGVybWl0ZSBhbmFsaXphciB0cmFuc2Zvcm1hY2lvbmVzIGluZGl2aWR1YWxlbXRlIG8gZW4gZ3J1cG8uIEFsZ3VuYXMgdHJhbnNmb3JtYWNpb25lcyBpbmNsdWlkYXMgc29uOgoKLSBCb3gtQ294IChkYXRvcyBwb3NpdGl2b3MpCi0gQXJjU2luaAotIFllby1Kb2huc29uCi0gQ3VhbnRpbGVzIAotbG9nMTAoYSt4KQoKRW4gZWwgZWplbXBsbyBhbnRlcmlvciwgc2UgcG9kcsOtYSBhcGxpY2FyIGFsZ3VuYSBkZSBsYXMgYW50ZXJpb3JlczogCmBgYHtyfQpsaWJyYXJ5KGJlc3ROb3JtYWxpemUpCmFyY3NpbmhfeChtb2RlbG8kcmVzaWR1YWxzKQpvcmRlck5vcm0obW9kZWxvJHJlcykKYGBgCm8gcG9kZW1vcyB1c2FyIGxhIGZ1bmNpb24gcXVlIG5vcyBkaWNlIGN1YWxlcyBzb24gbGFzIG1lam9yZXMgdHJhbnNmb3JtYWNpb25lcyBwYXJhIG51ZXN0cm9zIGRhdG9zOgoKYGBge3J9CmJlc3ROb3JtYWxpemUobW9kZWxvJHJlc2lkdWFscykKYGBgCgpwb3IgZWplbXBsbywgZW4gZXN0ZSBjYXNvIHBvZGVtb3Mgb2JzZXJ2YXIgcXVlIGVzIGxhIHRyYW5zZm9ybWFjacOzbiBkZSBZZW8tSm9obnNvbiwgbXV5IHNpbWlsYXIgYSBCb3hDb3gKCmBgYHtyfQptb2RlbG8zPC0gbG0oKFZvbHVtZV4oMC44OSktMSkvMC44OSB+LiwgZGF0YT10cmVlcykKcGFyKG1mcm93PWMoMiwyKSkKcGxvdChtb2RlbG8yKQpgYGAKCgpZIHBvZGVtb3MgY29tcGFyYXIgbG9zIGVycm9yZXMgZGUgbW9kZWxvcyBhIHRyYXbDqXMgZGUgZ3JhZmljYXMgbyBwcnVlYmFzIGRlIGhpcMOzdGVzaXMKYGBge3J9CnBhcihtZnJvdz1jKDEsMikpCmhpc3QobW9kZWxvMiRyZXNpZHVhbHMpCmhpc3QobW9kZWxvMyRyZXNpZHVhbHMpCmBgYAoKCgoK