Ejercicios Guía para solucionar el Taller 2
Realizado por: Rodolfo Garcia (@rodolfgc)
2022-10-22
Advertencia: Para poder reproducir el presente libro debe tener previamente instaladas las librerías readr y readxl, en caso de no tenerlas instaladas, ejecute los siguientes comandos:
install.packages("readr")
install.packages("readxl")Tamaño de una muestra de Naranjos
Cierto grupo de investigación del Departamento de Biología tiene como hipótesis que los naranjos tienden a crecer de manera proporcional respecto al tiempo. Para poder medir el crecimiento de dichos árboles se toma como medida de referencia la circunferencia de sus troncos (en cm). A continuación se tienen las medidas de una muestra de 35 árboles con su respectiva edad en días y el tamaño de su circunferencia.
library(readxl)
Tree <- read_excel("Tree.xlsx", col_types = c("numeric","numeric", "numeric"))
knitr::kable(x = Tree, digits = 3, align = "c")| Arbol | Edad | Circun |
|---|---|---|
| 1 | 118 | 30 |
| 2 | 484 | 58 |
| 3 | 664 | 87 |
| 4 | 1004 | 115 |
| 5 | 1231 | 120 |
| 6 | 1372 | 142 |
| 7 | 1582 | 145 |
| 8 | 118 | 33 |
| 9 | 484 | 69 |
| 10 | 664 | 111 |
| 11 | 1004 | 156 |
| 12 | 1231 | 172 |
| 13 | 1372 | 203 |
| 14 | 1582 | 203 |
| 15 | 118 | 30 |
| 16 | 484 | 51 |
| 17 | 664 | 75 |
| 18 | 1004 | 108 |
| 19 | 1231 | 115 |
| 20 | 1372 | 139 |
| 21 | 1582 | 140 |
| 22 | 118 | 32 |
| 23 | 484 | 62 |
| 24 | 664 | 112 |
| 25 | 1004 | 167 |
| 26 | 1231 | 179 |
| 27 | 1372 | 209 |
| 28 | 1582 | 214 |
| 29 | 118 | 30 |
| 30 | 484 | 49 |
| 31 | 664 | 81 |
| 32 | 1004 | 125 |
| 33 | 1231 | 142 |
| 34 | 1372 | 174 |
| 35 | 1582 | 177 |
- Verificar siempre si hay datos atípicos y/o extremos. Aquí nos daremos cuenta si es necesario o no usar medidas resistentes.
boxplot(Tree$Circun, main= "Boxplot circunferencia de naranjos", horizontal=T)
- Construya un diagrama de dispersión de los datos. ¿Qué evidencia en el diagrama obtenido?
plot(Tree$Edad, Tree$Circun, xlab="Edad en días", ylab="Circunferencia en cms")
title("Diagrama de Dispersión")
Para verificar si hay indicio de correlación lineal, mi recomendación es usar el coeficiente de correlación lineal de Pearson, aquí se calcula así:
cor(Tree$Edad,Tree$Circun)## [1] 0.9135189- Ajuste un modelo de regresión lineal simple que relacione la circunferencia (como variable respuesta) con la edad en días (como variable explicativa), utilizando el Método de Mínimos Cuadrados Ordinarios (MCO), proporcione las estimaciones de los coeficientes de regresión: \(\beta_0\) y \(\beta_1\) y establezca la ecuación de regresión ajustada.
fit1<-lm(Circun~Edad, data=Tree)
coef(fit1)## (Intercept) Edad
## 17.3996502 0.1067703\[\hat{Y_i}=17.39+0.1067x_i\]
Tenga en cuenta, que en este caso, la estimación de \(\beta_0\) es análoga entre las medidas que dividen por \(n\) que por \(n-1\)
Veamos:
\[\hat{\beta_1}=\frac{Cov_p(X,Y)}{Var_p(X)}=\frac{\frac{1}{n}\sum_{i=1}^{n}(x_i-\bar{x})(y_i-\bar{y})}{\frac{1}{n}\sum_{i=1}^n(x_i-\bar{x})^2}=\frac{\sum_{i=1}^{n}(x_i-\bar{x})(y_i-\bar{y})}{\sum_{i=1}^n(x_i-\bar{x})^2}=\frac{\frac{1}{n-1}\sum_{i=1}^{n}(x_i-\bar{x})(y_i-\bar{y})}{\frac{1}{n-1}\sum_{i=1}^n(x_i-\bar{x})^2}=\frac{Cov_s(X,Y)}{Var_s(X)}\]
Dejamos aquí plasmado el cálculo manual de los coeficientes mediante el método de mínimos cuadrados ordinarios.
beta_1<-(cov(Tree$Edad, Tree$Circun)/var(Tree$Edad))
beta_0<-mean(Tree$Circun)-beta_1*mean(Tree$Edad)
beta_0## [1] 17.39965beta_1## [1] 0.1067703- En el contexto del problema. ¿Qué interpretación tienen los coeficientes \(\hat{\beta_0}\) y \(\hat{\beta_1}\) obtenidos en el ajuste?
- Encuentre el valor ajustado de la circunferencia de un árbol cuya edad es de 664 días de vida, calcule el residuo correspondiente.
pred<-beta_0+beta_1*664
print(pred)## [1] 88.29515- Halle e interprete el coeficiente de determinación \(R^2\) y el coeficiente de determinación corregido \(R^2_c\) del modelo de regresión ajustado.
### DIRECTO DEL AJUSTE
summary(fit1)##
## Call:
## lm(formula = Circun ~ Edad, data = Tree)
##
## Residuals:
## Min 1Q Median 3Q Max
## -46.310 -14.946 -0.076 19.697 45.111
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 17.399650 8.622660 2.018 0.0518 .
## Edad 0.106770 0.008277 12.900 1.93e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 23.74 on 33 degrees of freedom
## Multiple R-squared: 0.8345, Adjusted R-squared: 0.8295
## F-statistic: 166.4 on 1 and 33 DF, p-value: 1.931e-14#### MANUALMENTE
R2<-1-sum(residuals(fit1)^2)/sum((Tree$Circun-mean(Tree$Circun))^2)
R2Adjus<-1-(1-R2)*((dim(Tree)[1]-1)/(dim(Tree)[1]-1-1))
R2## [1] 0.8345167R2Adjus## [1] 0.829502- Ajuste una recta resistente que explique la relación la circunferencia con la edad de los naranjos.
Definimos el conjunto de datos y lo separamos en los tres conjuntos para el cálculo de la línea resistente
Tree_orden <- Tree[order(Tree$Edad), ]
Tree_inf<-Tree_orden[1:12,]
Tree_med<-Tree_orden[13:23,]
Tree_sup<-Tree_orden[24:35,]Calculamos las medidas para cada una:
Xinf<-mean(Tree_inf$Edad)
Xmed<-mean(Tree_med$Edad)
Xsup<-mean(Tree_sup$Edad)
Yinf<-mean(Tree_inf$Circun)
Ymed<-mean(Tree_med$Circun)
Ysup<-mean(Tree_sup$Circun)
####
b<- (Ysup-Yinf)/(Xsup-Xinf)
###
ainf<-Yinf-b*Xinf
amed<-Ymed-b*Xmed
asup<-Ysup-b*Xsup
###
a<-(1/3)*(ainf+amed+asup)
###
a## [1] 13.96918b## [1] 0.1105165puntos2<-as.vector(a+b*Tree$Edad)
plot(Tree$Edad,Tree$Circun, xlab = "Edades (en días)", ylab = "Circunferencia (cm)", main="Número de días vs. Circunferencia de los naranjos")
abline(fit1, col= "green")
lines(Tree$Edad,puntos2, type="l", col="blue")
legend("topleft", legend = c("MCO", "LResis"), lty = 1, col = c("green","blue"))
- Encuentre el valor ajustado de la circunferencia de un árbol cuya edad es de 664 días de vida, calcule el residuo correspondiente.
a+b*664## [1] 87.35214Gastos estudiantes universitarios
Los datos corresponden a una muestra de 131 estudiantes universitarios, se filtró la información para solo contar con los gastos trimestrales en dólares de cada uno de los estudiantes que hizo parte del estudio, donde obtuvimos la siguiente información, se presenta en una tabla los primeros diez registros del conjunto:
library(readr)
Gastos<- read_csv("Gastos universitarios.csv")## Rows: 131 Columns: 1
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (1): GASTOS
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.knitr::kable(x = head(Gastos,10), align = "c")| GASTOS |
|---|
| 100 |
| 150 |
| 150 |
| 200 |
| 300 |
| 120 |
| 150 |
| 120 |
| 300 |
| 300 |
Gastos<-as.integer(Gastos$GASTOS)
hist(Gastos, main="Histograma de frecuencias gastos de universitarios")
- Calcule y compare la media aritmética, la mediana, el promedio de
los cuartiles, la trimedia y la media intercuartílica de los gastos.
Se calcula la media aritmética y la mediana
summary(Gastos)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 100.0 130.0 170.0 188.7 200.0 500.0Calculamos el promedio de los cuartiles
barQ<-mean(quantile(Gastos,probs=c(0.25,0.75)))
barQ## [1] 165Calculamos la trimedia
Tri<-(median(Gastos)+barQ)/2
Tri## [1] 167.5Media Intercuartílica Las posiciones 33 corresponden arriba del cuartil
mean(sort(Gastos)[33:98])## [1] 168.0303- Calcule y compare la desviación estándar, el rango intercuartílico y la mediana de las desviaciones absolutas de los gastos.
Desviación Estándar
sd<-sqrt(((length(Gastos)-1)/length(Gastos))*var(Gastos))
sd## [1] 78.86625Rango Intercuartílico
quantile(Gastos, 0.75)-quantile(Gastos, 0.25)## 75%
## 70Mediana de las desviaciones absolutas
median(abs(Gastos-median(Gastos)))## [1] 40- Calcule y compare el coeficiente de variación y el coeficiente de variación cuartílico de los gastos.
Coeficiente de variación
sqrt(((length(Gastos)-1)/length(Gastos))*var(Gastos))/mean(Gastos)## [1] 0.4180077Coeficiente de Variación cuartílico
(quantile(Gastos,0.75)-quantile(Gastos,0.25))/(quantile(Gastos,0.75)+quantile(Gastos,0.25))## 75%
## 0.2121212- Calcule y compare el coeficiente de asimetría, el ındice de simetría de Yule y el índice de simetría de Kelly de los gastos.
Coeficiente de asimetría
sum((Gastos-mean(Gastos))^3)/(length(Gastos)*(sd^3))## [1] 1.372239Índice de simetría de Yule
(quantile(Gastos,0.25)+quantile(Gastos,0.75)-2*median(Gastos))/(2*median(Gastos))## 25%
## -0.02941176Índice de simetría de Kelly
h2<-median(Gastos)-(quantile(Gastos,0.10)+quantile(Gastos,0.90))/(2)
-h2/median(Gastos)## 10%
## 0.2352941- Calcule y compare el coeficiente de apuntamiento y el coeficiente de curtosis basado en los cuartiles de los gastos.
SIEMPRE REVISAR SI TIENE SENTIDO O NO CALCULARLOS
Coeficiente de apuntamiento
sum((Gastos-mean(Gastos))^4)/(length(Gastos)*(sd^4))-3## [1] 1.856833Coeficiente de curtosis basado en cuartiles
(quantile(Gastos, 0.90)-quantile(Gastos, 0.10))/(1.9*(quantile(Gastos,0.75)-quantile(Gastos,0.25)))## 90%
## 1.353383