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)
library(knitr)
Ejercicio sacado de: (https://www.superprof.es/apuntes/escolar/matematicas/estadistica/disbidimension/ejercicios-de-regresion-y-correlacion.html)
niños <- c(1:5)
edad <- c(2,3,5,7,8)
peso <- c(14,20,32,42,44)
datos <- data.frame(niños,edad,peso)
kable(datos, caption = "Tabla sobre el peso de algunos niños de ciertas edades")
niños | edad | peso |
---|---|---|
1 | 2 | 14 |
2 | 3 | 20 |
3 | 5 | 32 |
4 | 7 | 42 |
5 | 8 | 44 |
r <- cor(datos$edad, datos$peso)
r
## [1] 0.9938422
ggplot(data = datos, aes(x = edad, y = peso)) +
geom_point(colour = 'black')
modelo <- lm(data = datos, formula = peso~edad)
modelo
##
## Call:
## lm(formula = peso ~ edad, data = datos)
##
## Coefficients:
## (Intercept) edad
## 4.631 5.154
summary(modelo)
##
## Call:
## lm(formula = peso ~ edad, data = datos)
##
## Residuals:
## 1 2 3 4 5
## -0.93846 -0.09231 1.60000 1.29231 -1.86154
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.6308 1.8231 2.54 0.08468 .
## edad 5.1538 0.3318 15.54 0.00058 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.692 on 3 degrees of freedom
## Multiple R-squared: 0.9877, Adjusted R-squared: 0.9836
## F-statistic: 241.3 on 1 and 3 DF, p-value: 0.0005795
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.987722232001408"
a <- modelo$coefficients[1]
b <- modelo$coefficients[2]
a ; b
## (Intercept)
## 4.630769
## edad
## 5.153846
ggplot() +
geom_point(data = datos, aes(x = edad, y = peso), colour='black') +
geom_line(aes( x = datos$edad, y = predict(modelo, datos)), color = "deepskyblue2") +
xlab("Edad") +
ylab("Peso") +
ggtitle("Linea de tendencia sobre Conjunto de Datos de la edad y peso de los niños")
x <- c(2,3,4,6,8)
prediccion <- predict(object = modelo, newdata = data.frame(edad = x))
prediccion
## 1 2 3 4 5
## 14.93846 20.09231 25.24615 35.55385 45.86154
y = a + b * x
y
## [1] 14.93846 20.09231 25.24615 35.55385 45.86154
Ejercicio sacado de: (https://www.superprof.es/apuntes/escolar/matematicas/estadistica/disbidimension/ejercicios-de-regresion-y-correlacion.html)
La tabla siguiente nos da las notas del test de aptitud {(x)} dadas a seis dependientes a prueba y ventas del primer mes de prueba {(y)} en cientos de euros.
Cargar o generar los datos
personas <- c(1:6)
aptitud <- c(25,42,33,54,29,36)
prueba <- c(42,72,50,90,45,48)
datos1 <- data.frame(personas,aptitud,prueba)
kable(datos, caption = "Tabla con el test de aptitud")
niños | edad | peso |
---|---|---|
1 | 2 | 14 |
2 | 3 | 20 |
3 | 5 | 32 |
4 | 7 | 42 |
5 | 8 | 44 |
r <- cor(datos1$aptitud, datos1$prueba)
r
## [1] 0.9649844
ggplot(data = datos1, aes(x = aptitud, y = prueba)) +
geom_point(colour = "blue4")
modelo1 <- lm(data = datos1, formula = prueba~aptitud)
modelo1
##
## Call:
## lm(formula = prueba ~ aptitud, data = datos1)
##
## Coefficients:
## (Intercept) aptitud
## -6.78 1.77
summary(modelo1)
##
## Call:
## lm(formula = prueba ~ aptitud, data = datos1)
##
## Residuals:
## 1 2 3 4 5 6
## 4.5243 4.4304 -1.6375 1.1876 0.4434 -8.9482
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6.7802 9.0722 -0.747 0.49639
## aptitud 1.7702 0.2406 7.358 0.00182 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.578 on 4 degrees of freedom
## Multiple R-squared: 0.9312, Adjusted R-squared: 0.914
## F-statistic: 54.14 on 1 and 4 DF, p-value: 0.001818
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.93119484699333"
a1 <- modelo1$coefficients[1]
b1 <- modelo1$coefficients[2]
a1 ; b1
## (Intercept)
## -6.780155
## aptitud
## 1.770233
ggplot() +
geom_point(data = datos1, aes(x = aptitud, y = prueba), colour='black') +
geom_line(aes( x = datos1$aptitud, y = predict(modelo1, datos1)), color = "forestgreen") +
xlab("Aptitud") +
ylab("Pruebas") +
ggtitle("Linea de tendencia sobre Conjunto de Datos de las aptitudes y personas")
x1 <- c(20,30,35,40,45,50)
prediccion <- predict(object = modelo1, newdata = data.frame(aptitud = x1))
prediccion
## 1 2 3 4 5 6
## 28.62450 46.32682 55.17798 64.02915 72.88031 81.73147
y1 = a1 + b1 * x1
y1
## [1] 28.62450 46.32682 55.17798 64.02915 72.88031 81.73147
A continuacion se explicaran los ejercicios hechos en este caso:
En ejercicio 2.1, se desea saber la ecuacion sobre la edad sobre el peso de algunos niños, las variables son los datos de la tabla sobre el peso y edad de algunos niños, el valor de correlacion entre las variables tienen el valor de 0.9938, el cual es la relacion que tienen las variables de edad y peso, la representacion de los coeficientes a y b en la ecuación de mínimos cuadrados es de 0.9877, lo que quiere decir es que el 98.77% de los niños tienen el peso ideal segun su edad, y su valor en la prediccion es que encontrar a un niño de 2 años y que este tenga un peso de 14kg, es del 14.93%.
En el ejercicio 2.2, se desea saber las notas de un test de aptitud, para las variables se usaron las de aptitud y personas, para poder sacar el valor de correlacion entre las variables, su valor es de 0.9649, lo que representa la relacion que tienen las variables de aptitud y personas, la representacion de los coeficientes a1 y b1 en la ecuación de mínimos cuadrados es de 0.9311, lo que significa que que es el 93.11% de las personas las cuales tienen aptitudes para una empresa o trabajo, y el valor en la prediccion, es que para encontrar una persona que tenga las buenas aptitudes es del 28.62%.