Determinar predicciones de datos bajo el modelo de regresión lineal simple
De un conjunto de datos con dos variables (bivariable) en donde una de ellas es \(X\) variable independiente y otra de ellas \(Y\) variable dependiente, predecir el valor de Y conforme la historia de X.
library(dplyr)
library(mosaic)
library(readr)
library(ggplot2) # Para gráficos
library(knitr) # Para formateo de datos
semanas <- c(1:12)
comerciales <- c(2,5,1,3,4,1,5,3,4,2,3,2)
ventas <- c(50,57,41,54,54,38,63,48,59,46, 45, 48 )
datos <- data.frame(semanas,comerciales,ventas)
kable(datos, caption = "Ventas en función de inversión en comerciales")
| semanas | comerciales | ventas |
|---|---|---|
| 1 | 2 | 50 |
| 2 | 5 | 57 |
| 3 | 1 | 41 |
| 4 | 3 | 54 |
| 5 | 4 | 54 |
| 6 | 1 | 38 |
| 7 | 5 | 63 |
| 8 | 3 | 48 |
| 9 | 4 | 59 |
| 10 | 2 | 46 |
| 11 | 3 | 45 |
| 12 | 2 | 48 |
r <- cor(datos$comerciales, datos$ventas)
r
## [1] 0.9006177
ggplot(data = datos, aes(x = comerciales, y = ventas)) +
geom_point(colour = 'Red')
modelo <- lm(data = datos, formula = ventas~comerciales)
modelo
##
## Call:
## lm(formula = ventas ~ comerciales, data = datos)
##
## Coefficients:
## (Intercept) comerciales
## 36.131 4.841
summary(modelo)
##
## Call:
## lm(formula = ventas ~ comerciales, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.6534 -2.7331 0.1076 2.8357 4.1873
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 36.1315 2.3650 15.278 2.93e-08 ***
## comerciales 4.8406 0.7387 6.553 6.45e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.378 on 10 degrees of freedom
## Multiple R-squared: 0.8111, Adjusted R-squared: 0.7922
## F-statistic: 42.94 on 1 and 10 DF, p-value: 6.449e-05
paste("El coeficiente de determinación o Multiple R-squared: es igual al cuadrado del coeficiente de correlación: ", r^2)
## [1] "El coeficiente de determinación o Multiple R-squared: es igual al cuadrado del coeficiente de correlación: 0.811112191696598"
valor de solido representa el 81.11 % del oxígeno.
a <- modelo$coefficients[1]
b <- modelo$coefficients[2]
a ; b
## (Intercept)
## 36.13147
## comerciales
## 4.840637
ggplot() +
geom_point(data = datos, aes(x = comerciales, y = ventas), colour='blue') +
geom_line(aes( x = datos$comerciales, y = predict(modelo, datos)), color = "red") +
xlab("Comerciales") +
ylab("Ventas") +
ggtitle("Linea de tendencia sobre Conjunto de Datos")
x <- c(4,3.5,2,0,1)
prediccion <- predict(object = modelo, newdata = data.frame(comerciales = x))
prediccion
## 1 2 3 4 5
## 55.49402 53.07371 45.81275 36.13147 40.97211
Uno de los problemas más desafiantes que se enfrentan en el área del control de la contaminación del agua lo representa la industria de la peletería (dedicada a la elaboración de indumentaria, cuero y piel animal).
Los desechos de ésta tienen una complejidad química. Se caracterizan por valores elevados de demanda de oxígeno bioquímico, sólidos volátiles y otras medidas de la contaminación. (Walpole et al., 2007)
seq <- c(1:33)
solido <- c(3,7,11,15,18,27,29,30,30,31,31,32,33,33,34,36,36,36,37,38,39,39,39,40,41,42,42,43,44,45,46,47,50)
oxigeno <- c(5,11,21,16,16,28,27,25,35,30,40,32,34,32,34,37,38,34,36,38,37,36,45,39,41,40,44,37,44,46,46,49,51 )
datos <- data.frame(seq,solido,oxigeno)
kable(datos, caption = "Contaminante oxígeno en función de reducción de sólidos")
| seq | solido | oxigeno |
|---|---|---|
| 1 | 3 | 5 |
| 2 | 7 | 11 |
| 3 | 11 | 21 |
| 4 | 15 | 16 |
| 5 | 18 | 16 |
| 6 | 27 | 28 |
| 7 | 29 | 27 |
| 8 | 30 | 25 |
| 9 | 30 | 35 |
| 10 | 31 | 30 |
| 11 | 31 | 40 |
| 12 | 32 | 32 |
| 13 | 33 | 34 |
| 14 | 33 | 32 |
| 15 | 34 | 34 |
| 16 | 36 | 37 |
| 17 | 36 | 38 |
| 18 | 36 | 34 |
| 19 | 37 | 36 |
| 20 | 38 | 38 |
| 21 | 39 | 37 |
| 22 | 39 | 36 |
| 23 | 39 | 45 |
| 24 | 40 | 39 |
| 25 | 41 | 41 |
| 26 | 42 | 40 |
| 27 | 42 | 44 |
| 28 | 43 | 37 |
| 29 | 44 | 44 |
| 30 | 45 | 46 |
| 31 | 46 | 46 |
| 32 | 47 | 49 |
| 33 | 50 | 51 |
r <- cor(datos$solido, datos$oxigeno)
r
## [1] 0.9554794
ggplot(data = datos, aes(x = solido, y = oxigeno)) +
geom_point(colour = 'blue')
modelo <- lm(data = datos, formula = oxigeno~solido)
modelo
##
## Call:
## lm(formula = oxigeno ~ solido, data = datos)
##
## Coefficients:
## (Intercept) solido
## 3.8296 0.9036
summary(modelo)
##
## Call:
## lm(formula = oxigeno ~ solido, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.939 -1.783 -0.228 1.506 8.157
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.82963 1.76845 2.166 0.0382 *
## solido 0.90364 0.05012 18.030 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.23 on 31 degrees of freedom
## Multiple R-squared: 0.9129, Adjusted R-squared: 0.9101
## F-statistic: 325.1 on 1 and 31 DF, p-value: < 2.2e-16
paste("El coeficiente de determinación o Multiple R-squared: es igual al cuadrado del coeficiente de correlación :", r^2)
## [1] "El coeficiente de determinación o Multiple R-squared: es igual al cuadrado del coeficiente de correlación : 0.912940801014387"
a <- modelo$coefficients[1]
b <- modelo$coefficients[2]
a ; b
## (Intercept)
## 3.829633
## solido
## 0.9036432
ggplot() +
geom_point(data = datos, aes(x = solido, y = oxigeno), colour='blue') +
geom_line(aes( x = datos$solido, y = predict(modelo, datos)), color = "red") +
xlab("Reducción de sólido") +
ylab("% Oxígeno") +
ggtitle("Linea de tendencia sobre Conjunto de Datos")
x <- c(15,20,35,40,50)
prediccion <- predict(object = modelo, newdata = data.frame(solido = x))
prediccion
## 1 2 3 4 5
## 17.38428 21.90250 35.45715 39.97536 49.01179
datos <- read.table("https://raw.githubusercontent.com/rpizarrog/probabilidad-y-estad-stica/master/datos/body.dat.txt", quote="\"", comment.char="")
datos <- as.data.frame(datos)
colnames(datos)[23:25] <- c("peso", "estatura", "genero")
# Solo nos interesan las tres últimas columnas
datos <- select(datos, estatura, peso, genero)
kable(head(datos, 10), caption = "Datos de pesos y etaturas de personas")
| estatura | peso | genero |
|---|---|---|
| 174.0 | 65.6 | 1 |
| 175.3 | 71.8 | 1 |
| 193.5 | 80.7 | 1 |
| 186.5 | 72.6 | 1 |
| 187.2 | 78.8 | 1 |
| 181.5 | 74.8 | 1 |
| 184.0 | 86.4 | 1 |
| 184.5 | 78.4 | 1 |
| 175.0 | 62.0 | 1 |
| 184.0 | 81.6 | 1 |
r <- cor(datos$estatura, datos$peso)
r
## [1] 0.7173011
ggplot(data = datos, aes(x = estatura, y = peso)) +
geom_point(colour = 'blue')
modelo <- lm(data = datos, formula = peso~estatura)
modelo
##
## Call:
## lm(formula = peso ~ estatura, data = datos)
##
## Coefficients:
## (Intercept) estatura
## -105.011 1.018
summary(modelo)
##
## Call:
## lm(formula = peso ~ estatura, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -18.743 -6.402 -1.231 5.059 41.103
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -105.01125 7.53941 -13.93 <2e-16 ***
## estatura 1.01762 0.04399 23.14 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.308 on 505 degrees of freedom
## Multiple R-squared: 0.5145, Adjusted R-squared: 0.5136
## F-statistic: 535.2 on 1 and 505 DF, p-value: < 2.2e-16
paste("El coeficiente de determinación o Multiple R-squared: es igual al cuadrado del coeficiente de correlación :", r^2)
## [1] "El coeficiente de determinación o Multiple R-squared: es igual al cuadrado del coeficiente de correlación : 0.514520837538849"
a <- modelo$coefficients[1]
b <- modelo$coefficients[2]
a ; b
## (Intercept)
## -105.0113
## estatura
## 1.017617
ggplot() +
geom_point(data = datos, aes(x = estatura, y = peso), colour='blue') +
geom_line(aes( x = datos$estatura, y = predict(modelo, datos)), color = "red") +
xlab("Estarura") +
ylab("Peso") +
ggtitle("Linea de tendencia sobre Conjunto de Datos")
x <- c(150, 160, 170, 175, 185, 190)
prediccion <- predict(object = modelo, newdata = data.frame(estatura = x))
prediccion
## 1 2 3 4 5 6
## 47.63126 57.80743 67.98360 73.07168 83.24785 88.33593