Objetivo Determinar predicciones de datos bajo el modelo de regresión lineal simple

Descripción 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.

#Librerias

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(mosaic)
## Warning: package 'mosaic' was built under R version 4.0.3
## Registered S3 method overwritten by 'mosaic':
##   method                           from   
##   fortify.SpatialPolygonsDataFrame ggplot2
## 
## The 'mosaic' package masks several functions from core packages in order to add 
## additional features.  The original behavior of these functions should not be affected by this.
## 
## Attaching package: 'mosaic'
## The following object is masked from 'package:Matrix':
## 
##     mean
## The following object is masked from 'package:ggplot2':
## 
##     stat
## The following objects are masked from 'package:dplyr':
## 
##     count, do, tally
## The following objects are masked from 'package:stats':
## 
##     binom.test, cor, cor.test, cov, fivenum, IQR, median, prop.test,
##     quantile, sd, t.test, var
## The following objects are masked from 'package:base':
## 
##     max, mean, min, prod, range, sample, sum
library(readr)
library(ggplot2)  # Para gráficos
library(knitr)    # Para formateo de datos

#Ejercicios Ventas en Función de Comerciales

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")
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 = 'blue')

ggplot(data = datos, aes(x = comerciales, y = ventas)) +
  geom_point(colour = 'blue')

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"
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
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
# Comprobar
y = a + b * x
y
## [1] 55.49402 53.07371 45.81275 36.13147 40.97211

Medidas de los Solidos y la Demanda de Oxigeno Quimico

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")
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
# Comprobar
y = a + b * x
y
## [1] 17.38428 21.90250 35.45715 39.97536 49.01179

Caso de Mediciones del Cuerpo Humano (Peso y Estatura)

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")
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
# Comprobar
y = a + b * x
y
## [1] 47.63126 57.80743 67.98360 73.07168 83.24785 88.33593

INTERPRETACIÓN DEL CASO

De acuerdo con los ejercicios realizdos en este caso donde determinamos predicciones de datos bajo el modelo de regresión lineal simple, podemos darnos cuenta que es posible encontrar una cantidad variada de información simplemente a partir de datos y fórmulas.

Los datos que podemos encontrar, entre otras cosas, son la línea de tendencia sobre un conjunto de datos (es decir, hacia dónde se inclinan los datos)