library(MASS)
library(stats)
library(ggplot2)
library(ggpubr)
library(car)
## Cargando paquete requerido: carData
library(lmtest)
## Cargando paquete requerido: zoo
## 
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

INSTRUCCIONES

Además de lo que se solicita, integrar los siguientes puntos a revisar en el proceso de análisis de regresión lineal simple: 1. Estimación del modelo de regresión 2. Summary e Interpretación del modelo estimado 3. Coeficiente de determinación 4. Predicción (Estimación) de la variable de respuesta para nuevos valores de la variable independiente. 5. Intervalos de confianza para los valores esperados 6. Intervalos de confianza para las predicciones 7. Propiedades de los residuales 8. Verificación de supuestos a. Validación grafica b. Análisis de puntos atípicos c. Validación con pruebas de hipótesis 9. Anova del modelo 10. Prueba de hipótesis para los parámetros

EJERCICIO 1

Las ejercitadoras elípticas se están convirtiendo en una de las máquinas de ejercicio más populares. Su movimiento de bajo impacto es suave y estable, lo que las vuelve la elección preferida por las personas con problemas en rodillas y tobillos. Sin embargo, elegir la ejercitadora adecuada puede resultar un proceso difícil. El precio y la calidad son factores importantes en cualquier decisión de compra. ¿Están asociados los precios altos con las ejercitadoras elípticas de alta calidad? Consumer Reports realizó amplias pruebas para desarrollar una clasificación general basada en facilidad de uso, ergonomía, construcción y rango de ejercicio. A continuación, se muestran los datos de precio (Price) y calificación (Rating) de ocho ejercitadoras elípticas probadas, de las cuales se detallan marca y modelo (Brand and Model) (Consumer Reports,febrero de 2008).

BD1 <- data.frame(
  Brand_Model = c("Precor 5.31",
                  "Keys Fitness CG2",
                  "Octane Fitness Q37e",
                  "LifeFitness X1 Basic",
                  "NordicTrack AudioStrider 990",
                  "Schwinn 430",
                  "Vision Fitness X6100",
                  "ProForm XP 520 Razor"),
  Price = c(3700, 2500, 2800, 1900, 1000, 800, 1700, 600),
  Rating = c(87, 84, 82, 74, 73, 69, 68, 55)
)
BD1

1.Estimación del modelo de regresión

Estimacion por el metodo de minimos cuadrados

xbar<-c(rep(mean(BD1$Price),8))
#head(xbar)
a<-BD1$Price-xbar
acuadrada<-a^2
head(acuadrada)
## [1] 3330625  390625  855625     625  765625 1155625
ybar<-c(rep(mean(BD1$Rating),8))
b<-BD1$Rating-ybar
head(ybar)
## [1] 74 74 74 74 74 74
ab<-a*b
head(ab)
## [1] 23725  6250  7400     0   875  5375
suma_ab<- sum(ab)
suma_ab
## [1] 68900
suma_a_cuadrada<-sum(acuadrada)
suma_a_cuadrada
## [1] 8155000
beta1_gorro<- (suma_ab)/suma_a_cuadrada
beta1_gorro
## [1] 0.008448804

\(\hat{\beta}_1=0.00844884\)

Beta0_g<- mean(BD1$Rating)-beta1_gorro*(mean(BD1$Price))
Beta0_g
## [1] 58.15849

\(\hat{\beta}_0=58.15849\)

modelo1<-lm(Rating~Price,BD1)
modelo1
## 
## Call:
## lm(formula = Rating ~ Price, data = BD1)
## 
## Coefficients:
## (Intercept)        Price  
##   58.158492     0.008449

Ecuacion: \[\hat{y}_{1}=58.158492 +0.008449x_i\] #### 2. Summary e Interpretación del modelo estimado

Cuando el precio es de 0 pesos, el ranting esperado es de 58.15 aunque esto no tiene sentido, por cada 100 pesos de aumento en el precio el rating aumenta 0.8449

summary(modelo1)
## 
## Call:
## lm(formula = Rating ~ Price, data = BD1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -8.2278 -2.9447 -0.0132  4.2417  6.3927 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 58.158492   4.014418  14.487 6.78e-06 ***
## Price        0.008449   0.001885   4.482  0.00418 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.383 on 6 degrees of freedom
## Multiple R-squared:   0.77,  Adjusted R-squared:  0.7317 
## F-statistic: 20.09 on 1 and 6 DF,  p-value: 0.004184

3. Coeficiente de determinación

El 73.17% de la variabilidad del Rating es explicado por el precio,el 26.83% no se explica poor el precio

a) Trace un diagrama de dispersión con estos datos empleando el precio como variable independiente.

plot(BD1$Price, BD1$Rating, 
     main = "BD1: Precio vs Rating de Equipos de Ejercicio",
     xlab = "Precio ($)", ylab = "Rating",
     pch = 19, col = "blue", cex = 1.5)
grid()

  1. Una tienda de equipo para ejercitarse que vende principalmente equipo caro puso un letrero sobre el área de exhibición que dice: “Calidad: usted obtiene lo que paga.” Con base en su análisis de los datos, ¿considera usted que el letrero refleja de manera justa la relación precio-calidad de las ejercitadoras elípticas? #### 4. Prediccion de nuuevos valores
  2. Utilice la ecuación de regresión estimada para predecir la clasificación de una ejercitadora elíptica con un precio de $1500.
predict(modelo1,data.frame(Price=1500),interval="confidence")
##       fit     lwr      upr
## 1 70.8317 65.8637 75.79969

Para una ejercitadora elíptica con precio de $1500, se predice un rating de 70.83 puntos con un intervalo de confianza del 95% entre 67.12 y 74.54 puntos.

5. Intervalos de confianza para los valores esperados

modelo1$coefficients
##  (Intercept)        Price 
## 58.158491723  0.008448804
confint(modelo1,level=0.95)
##                    2.5 %      97.5 %
## (Intercept) 48.335565079 67.98141837
## Price        0.003836136  0.01306147

Existe un 95% de confianza de que el verdadero valor del rating base (cuando el precio es $0) se encuentra entre 48.34 y 67.98 puntos. Existe un 95% de confianza de que el verdadero incremento en el rating por cada dólar de aumento en el precio se encuentra entre 0.00384 y 0.01306 puntos por PESO.

7. Propiedades de los residuales

Todo modelo de regresión lineal tiene supuestos que son: Independencia, Varianza Constante,Normalidad de los residuales

plot(modelo1)

contraste de hipótesis:

\(H_{0}: los\ datos\ provienen\ de\ una\ distribución\ normal\)

\(H_{1}: los\ datos\ no\ provienen\ de\ una\ distribución\ normal\)

shapiro.test(modelo1$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo1$residuals
## W = 0.96152, p-value = 0.8245

deacuerdo con el p-valor=0.8245 no se tiene suficiente evidencia para rechazar la hipotesis nula, es decir no se puede rechazar que los resifuos provienen de una distribución normal.

contrasta la hipótesis:

\(H_{0}: los\ datos\ no\ presentan\ autocorrelacion\)

\(H_{1}: los\ datos\ presentan\ autocorrelacion\)

dwtest(modelo1)
## 
##  Durbin-Watson test
## 
## data:  modelo1
## DW = 1.1985, p-value = 0.03471
## alternative hypothesis: true autocorrelation is greater than 0

deacuerdo con el p- valor< 0.05 se puede rechazar la hipótesis nula por lo que los residuos se encuentras autorrelacionados.

contrasta la hipótesis:

\(H_{0}: los\ datos\ presentan\ homoesquedasticidad\)

\(H_{1}: los\ datos\ NO\ presentan\ homoesquedasticidad\)

ncvTest(modelo1)
## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 1.835843, Df = 1, p = 0.17544

con un p-valor > 0.05 no se tiene suficiente evidencia para rechazar la hipotesis nula de que los residuos tienen varianzas constantes

Valorando los puntos influyentes

Contraste de hipotesis:

\(H_{0}: la\ observación\ i\ no\ es\ un\ valor\ atípico\)

\(H_{1}: la\ observación\ i\ es\ un\ valor\ atípico\)

outlierTest(modelo1)
## No Studentized residuals with Bonferroni p < 0.05
## Largest |rstudent|:
##    rstudent unadjusted p-value Bonferroni p
## 8 -2.607448           0.047817      0.38254

con un p-valor mayor a 0.05 no podemos rechazar que la observacionpresentada no sea un valor atipico

influenceIndexPlot(modelo1)

Anova

$H_{0}: _1=0 $

\(H_{1}: \beta_1 \neq 0\)

anova(modelo1)

con un 95% de confianza podemos decir que \(\beta_1\) es diferente de cero ### EJERCICIO 2

Un gerente de ventas obtuvo los siguientes datos sobre ventas anuales (Annual Sales) y años de experiencia (Years of Experience) de 10 vendedores (Salesperson).

BD2 <- data.frame(
  Salesperson = 1:10,
  Years_Experience = c(1, 3, 4, 4, 6, 8, 10, 10, 11, 13),
  Annual_Sales = c(80, 97, 92, 102, 103, 111, 119, 123, 117, 136)
)
BD2

1.Estimación del modelo de regresión

Estimacion por el metodo de minimos cuadrados

xbar<-c(rep(mean(BD2$Years_Experience),10))
#head(xbar)
a<-BD2$Years_Experience-xbar
acuadrada<-a^2
head(acuadrada)
## [1] 36 16  9  9  1  1
ybar<-c(rep(mean(BD2$Annual_Sales),10))
b<-BD2$Annual_Sales-ybar
head(ybar)
## [1] 108 108 108 108 108 108
ab<-a*b
head(ab)
## [1] 168  44  48  18   5   3
suma_ab<- sum(ab)
suma_ab
## [1] 568
suma_a_cuadrada<-sum(acuadrada)
suma_a_cuadrada
## [1] 142
beta1_gorro<- (suma_ab)/suma_a_cuadrada
beta1_gorro
## [1] 4

\(\hat{\beta}_1=4\)

Beta0_g<- mean(BD2$Annual_Sales)-beta1_gorro*(mean(BD2$Years_Experience))
Beta0_g
## [1] 80

\(\hat{\beta}_0=80\)

modelo2<-lm(Annual_Sales~Years_Experience,BD2)
modelo2
## 
## Call:
## lm(formula = Annual_Sales ~ Years_Experience, data = BD2)
## 
## Coefficients:
##      (Intercept)  Years_Experience  
##               80                 4

Ecuacion: \[\hat{y}_{1}=80 +4x_i\] #### 2. Summary e Interpretación del modelo estimado

Un vendedor sin experiencia (0 años) tendría ventas esperadas de 80,000 pesos anuales,por cada año adicional de experiencia, las ventas aumentan 4,000 pesos anuales

summary(modelo2)
## 
## Call:
## lm(formula = Annual_Sales ~ Years_Experience, data = BD2)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##  -7.00  -3.25  -1.00   3.75   6.00 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       80.0000     3.0753   26.01 5.12e-09 ***
## Years_Experience   4.0000     0.3868   10.34 6.61e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.61 on 8 degrees of freedom
## Multiple R-squared:  0.9304, Adjusted R-squared:  0.9217 
## F-statistic: 106.9 on 1 and 8 DF,  p-value: 6.609e-06

3. Coeficiente de determinación

El 92.17% de la variabilidad en las ventas anuales se explica por la experiencia de los vendedores, el 7.83% de la variabilidad no se explica por la experiencia de los vendedores #### a) Trace un diagrama de dispersión con estos datos tomando como variable independiente los años de experiencia.

plot(BD2$Years_Experience, BD2$Annual_Sales,
     main = "BD2: Experiencia vs Ventas Anuales",
     xlab = "Años de Experiencia", ylab = "Ventas Anuales",
     pch = 17, col = "red", cex = 1.5)
grid()

b) Obtenga una ecuación de regresión estimada que pueda utilizarse para predecir las ventas anuales proporcionando los años de experiencia.

Ecuacion: \[\hat{y}_{1}=80 +4x_i\]

4. Prediccion de nuuevos valores

  1. Utilice la ecuación de regresión estimada para predecir las ventas anuales de un vendedor con 9 años de experiencia.
predict(modelo2,data.frame(Years_Experience=9),interval="confidence")
##   fit      lwr      upr
## 1 116 112.1943 119.8057

Se predice que un vendedor con 9 años de experiencia generará 116,000 pesos en ventas anuales, con un Límite inferior 112,194.30 pesos y un Límite superior 119,805.7 superior.

5. Intervalos de confianza para los valores esperados

modelo1$coefficients
##  (Intercept)        Price 
## 58.158491723  0.008448804
confint(modelo2,level=0.95)
##                      2.5 %    97.5 %
## (Intercept)      72.908242 87.091758
## Years_Experience  3.107937  4.892063

Existe un 95% de confianza de que las ventas base SIN EXPERIENCIA se encuentran entre 72,908 pesos y 87,092 pesos.

Existe un 95% de confianza de que el verdadero incremento en ventas por cada año adicional de experiencia se encuentra entre 3,108 pesos anuales y 4,892 pesos anuales.

7. Propiedades de los residuales

Todo modelo de regresión lineal tiene supuestos que son: Independencia, Varianza Constante,Normalidad de los residuales

plot(modelo2)

contraste de hipótesis:

\(H_{0}: los\ datos\ provienen\ de\ una\ distribución\ normal\)

\(H_{1}: los\ datos\ no\ provienen\ de\ una\ distribución\ normal\)

shapiro.test(modelo2$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo2$residuals
## W = 0.93759, p-value = 0.5265

deacuerdo con el p-valor=0.5265 no se tiene suficiente evidencia para rechazar la hipotesis nula, es decir no se puede rechazar que los resifuos provienen de una distribución normal.

contrasta la hipótesis:

\(H_{0}: los\ datos\ no\ presentan\ autocorrelacion\)

\(H_{1}: los\ datos\ presentan\ autocorrelacion\)

dwtest(modelo2)
## 
##  Durbin-Watson test
## 
## data:  modelo2
## DW = 3.2235, p-value = 0.9708
## alternative hypothesis: true autocorrelation is greater than 0

deacuerdo con el p- valor no menor a 0.05 noo se puede rehcazar la hipotesis nula lo que implica que no podemos rechazar que los residuos no presenas autocorrelacion

contrasta la hipótesis:

\(H_{0}: los\ datos\ presentan\ homoesquedasticidad\)

\(H_{1}: los\ datos\ NO\ presentan\ homoesquedasticidad\)

ncvTest(modelo2)
## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 0.01096545, Df = 1, p = 0.9166

Con un p-valor no menor a 0.05 no se puede rechazar la hipotesis nula de que los residuos presente una varianza constante.

Valorando los puntos influyentes

Con ayuda de la funcion outlierTest() de la libreria car nos ayuda a idendificar valores atípicos de los residuos studentizados del modelo

Contraste de hipotesis:

\(H_{0}: la\ observación\ i\ no\ es\ un\ valor\ atípico\)

\(H_{1}: la\ observación\ i\ es\ un\ valor\ atípico\)

outlierTest(modelo2)
## No Studentized residuals with Bonferroni p < 0.05
## Largest |rstudent|:
##    rstudent unadjusted p-value Bonferroni p
## 9 -2.010637           0.084286      0.84286

con un p-valor mayor a 0.05 no se puede rechar la hipotesis nula de que el punto 9 no es un valor atipico

influenceIndexPlot(modelo2)

Anova

$H_{0}: _1=0 $

\(H_{1}: \beta_1 \neq 0\)

anova(modelo2)

con un 99% de confianza podemos rechazar la hipotesis nula lo que implica que \(\beta_1\) no es igual a cero.

EJERCICIO 3

Con frecuencia, los viajeros de las aerolíneas empacan tanto como pueden en su maleta para evitar las tarifas por sobreequipaje. Encontrar una maleta rodante durable, con gran capacidad y fácil de mover puede ser difícil. La tabla siguiente muestra los resultados de pruebas realizadas por Consumer Reports en 10 maletas rodantes; las puntuaciones (Score) más altas indican mejores resultados en las pruebas en general (sitio web Consumer Reports, octubre de 2008). La tabla incluye marca (Brand) y precio (Price) de las maletas.

BD3 <- data.frame(
  Brand = c("Briggs & Riley",
            "Hartman",
            "Heys",
            "Kenneth Cole Reaction",
            "Liz Claiborne",
            "Samsonite",
            "Titan",
            "TravelPro",
            "Tumi",
            "Victorinox"),
  Price = c(325, 350, 67, 120, 85, 180, 360, 156, 595, 400),
  Score = c(72, 74, 54, 54, 64, 57, 66, 67, 87, 77)
)
BD3

1.Estimación del modelo de regresión

Estimacion por el metodo de minimos cuadrados

xbar<-c(rep(mean(BD3$Price),10))
#head(xbar)
a<-BD3$Price-xbar
acuadrada<-a^2
head(acuadrada)
## [1]  3745.44  7430.44 38730.24 20678.44 31969.44  7022.44
ybar<-c(rep(mean(BD3$Score),10))
b<-BD3$Score-ybar
head(ybar)
## [1] 67.2 67.2 67.2 67.2 67.2 67.2
ab<-a*b
head(ab)
## [1]  293.76  586.16 2597.76 1898.16  572.16  854.76
suma_ab<- sum(ab)
suma_ab
## [1] 14601.4
suma_a_cuadrada<-sum(acuadrada)
suma_a_cuadrada
## [1] 258695.6
beta1_gorro<- (suma_ab)/suma_a_cuadrada
beta1_gorro
## [1] 0.0564424

\(\hat{\beta}_1= 0.0564424\)

Beta0_g<- mean(BD3$Score)-beta1_gorro*(mean(BD3$Price))
Beta0_g
## [1] 52.3105

\(\hat{\beta}_0=52.3105\)

modelo3<-lm(Score~Price,BD3)
modelo3
## 
## Call:
## lm(formula = Score ~ Price, data = BD3)
## 
## Coefficients:
## (Intercept)        Price  
##    52.31050      0.05644

Ecuacion: \[\hat{y}_{1}=52.3105 + 0.0564424x_i\] #### 2. Summary e Interpretación del modelo estimado El score base esperado es de 52.3105 cuando el precio es 0 pesos,por cada 10 pesos de aumento en el precio, el score aumenta aproximadamente 0.564 puntos

summary(modelo3)
## 
## Call:
## lm(formula = Score ~ Price, data = BD3)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -6.630 -4.336  1.226  2.068  6.892 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 52.310495   3.017956  17.333 1.25e-07 ***
## Price        0.056442   0.009768   5.778 0.000415 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.968 on 8 degrees of freedom
## Multiple R-squared:  0.8067, Adjusted R-squared:  0.7826 
## F-statistic: 33.39 on 1 and 8 DF,  p-value: 0.0004153

3. Coeficiente de determinación

El 78.26% de la variabilidad del score se explica por el precio, el 21.74% de la variabilidad noo se explica por el precio

a)Trace un diagrama de dispersión utilizando el precio como la variable independiente.

plot(BD3$Price, BD3$Score,
     main = "BD3: Precio vs Score de Maletas",
     xlab = "Precio ($)", ylab = "Score",
     pch = 15, col = "darkgreen", cex = 1.5)
grid()

b)¿Qué indica el diagrama de dispersión del inciso a) acerca de la relación entre las dos variables?

solo basandoe en el diagrama de dipercion se espsera una endiente positiva, es decir entre más aumente el precio mas aumentara es Score #### c)Proporcione una interpretación para la pendiente de la ecuación de regresión estimada. por cada 10 pesos de aumento en el precio, el score aumenta aproximadamente 0.564 puntos #### 4. Prediccion de nuuevos valores d)La maleta de la marca Eagle Creek Hovercraft tiene un precio de $225. Usando la ecuación de regresión estimada desarrollada en el inciso prediga la puntuación para esta maleta.

predict(modelo3,data.frame(Price=250),interval="confidence")
##        fit      lwr      upr
## 1 66.42109 62.78488 70.05731

Se predice que una maleta con precio de $250 tendrá un score de 66.42 puntos con un limite inferior de al menos 62.78 puntos y un limite superior de 70.06 puntos

5. Intervalos de confianza para los valores esperados

modelo1$coefficients
##  (Intercept)        Price 
## 58.158491723  0.008448804
confint(modelo3,level=0.95)
##                   2.5 %      97.5 %
## (Intercept) 45.35107592 59.26991493
## Price        0.03391753  0.07896727

Existe un 95% de confianza de que el verdadero valor del score base (cuando el precio es 0PESOS ) se encuentra entre 45.35 y 59.27 puntos.

Existe un 95% de confianza de que el verdadero incremento en el score por cada dólar de aumento en el precio se encuentra entre 0.03392 y 0.07897 puntos por peso

7. Propiedades de los residuales

Todo modelo de regresión lineal tiene supuestos que son: Independencia, Varianza Constante,Normalidad de los residuales

plot(modelo3)

contraste de hipótesis:

\(H_{0}: los\ datos\ provienen\ de\ una\ distribución\ normal\)

\(H_{1}: los\ datos\ no\ provienen\ de\ una\ distribución\ normal\)

shapiro.test(modelo3$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo3$residuals
## W = 0.92836, p-value = 0.432

deacuerdo con el p-valor=0.432 no se tiene suficiente evidencia para rechazar la hipotesis nula, es decir no se puede rechazar que los resifuos provienen de una distribución normal.

contrasta la hipótesis:

\(H_{0}: los\ datos\ no\ presentan\ autocorrelacion\)

\(H_{1}: los\ datos\ presentan\ autocorrelacion\)

dwtest(modelo3)
## 
##  Durbin-Watson test
## 
## data:  modelo3
## DW = 2.55, p-value = 0.8244
## alternative hypothesis: true autocorrelation is greater than 0

deacuerdo con el p- valor mayor a 0.05 no puedo rechazar la hipotesis nula de que los residuos no estan relacionados. contrasta la hipótesis:

\(H_{0}: los\ datos\ presentan\ homoesquedasticidad\)

\(H_{1}: los\ datos\ NO\ presentan\ homoesquedasticidad\)

ncvTest(modelo3)
## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 0.9216424, Df = 1, p = 0.33704

Con un p-valor>0.05 no puedo rechazar al hipotesis nula de que los residuos tengan varianza constante

Valorando los puntos influyentes

Contraste de hipotesis:

\(H_{0}: la\ observación\ i\ no\ es\ un\ valor\ atípico\)

\(H_{1}: la\ observación\ i\ es\ un\ valor\ atípico\)

outlierTest(modelo3)
## No Studentized residuals with Bonferroni p < 0.05
## Largest |rstudent|:
##   rstudent unadjusted p-value Bonferroni p
## 5 1.772613            0.11958           NA
influenceIndexPlot(modelo3)

Anova

$H_{0}: _1=0 $

\(H_{1}: \beta_1 \neq 0\)

anova(modelo3)

con un 95% de confianza puedo rechazar al hipotesis nula es decir \(\beta_1\) es diferente de cero

EJERCICIO 4

Para el Internal Revenue Service (Servicio de Administración Tributaria de Estados Unidos), el carácter razonable de las deducciones declaradas por un contribuyente depende de su ingreso bruto ajustado. Deducciones grandes que comprenden donaciones de caridad o por atención médica son más apropiadas para contribuyentes que tengan un ingreso bruto ajustado grande. Si las deducciones de una persona son mayores que las deducciones declaradas promedio correspondientes a un determinado nivel de ingresos, aumentan las posibilidades de que se le realice una auditoría. Los datos (en miles de dólares) sobre ingreso bruto ajustado y el monto promedio o razonable de deducciones declaradas se listan a continuación.

BD4 <- data.frame(
  Ingreso_Bruto_Ajustado = c(22, 27, 32, 48, 65, 85, 120),
  Deducciones_Razonables = c(9.6, 9.6, 10.1, 11.1, 13.5, 17.7, 25.5)
)
BD4

1.Estimación del modelo de regresión

Estimacion por el metodo de minimos cuadrados

xbar<-c(rep(mean(BD4$Ingreso_Bruto_Ajustado),7))
#head(xbar)
a<-BD4$Ingreso_Bruto_Ajustado-xbar
acuadrada<-a^2
head(acuadrada)
## [1] 1225  900  625   81   64  784
ybar<-c(rep(mean(BD4$Deducciones_Razonables),7))
b<-BD4$Deducciones_Razonables-ybar
head(ybar)
## [1] 13.87143 13.87143 13.87143 13.87143 13.87143 13.87143
ab<-a*b
head(ab)
## [1] 149.500000 128.142857  94.285714  24.942857  -2.971429 107.200000
suma_ab<- sum(ab)
suma_ab
## [1] 1233.7
suma_a_cuadrada<-sum(acuadrada)
suma_a_cuadrada
## [1] 7648
beta1_gorro<- (suma_ab)/suma_a_cuadrada
beta1_gorro
## [1] 0.1613101

\(\hat{\beta}_1=0.1613101\)

Beta0_g<- mean(BD4$Deducciones_Razonables)-beta1_gorro*(mean(BD4$Ingreso_Bruto_Ajustado))
Beta0_g
## [1] 4.67675

\(\hat{\beta}_0=4.67675\)

modelo4<-lm(Deducciones_Razonables~Ingreso_Bruto_Ajustado,BD4)
modelo4
## 
## Call:
## lm(formula = Deducciones_Razonables ~ Ingreso_Bruto_Ajustado, 
##     data = BD4)
## 
## Coefficients:
##            (Intercept)  Ingreso_Bruto_Ajustado  
##                 4.6768                  0.1613

Ecuacion: \[\hat{y}_{1}=4.67675 +0.1613101x_i\] #### 2. Summary e Interpretación del modelo estimado

Deducciones mínimas esperadas son 4.67675 incluso con ingreso bruto 0 pesos,Por cada 1,000 pesos de aumento en el ingreso bruto, las deducciones aumentan aproximadamente 161.30 pesos.

summary(modelo4)
## 
## Call:
## lm(formula = Deducciones_Razonables ~ Ingreso_Bruto_Ajustado, 
##     data = BD4)
## 
## Residuals:
##       1       2       3       4       5       6       7 
##  1.3744  0.5679  0.2613 -1.3196 -1.6619 -0.6881  1.4660 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)             4.67675    1.03339   4.526 0.006251 ** 
## Ingreso_Bruto_Ajustado  0.16131    0.01568  10.285 0.000149 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.372 on 5 degrees of freedom
## Multiple R-squared:  0.9549, Adjusted R-squared:  0.9458 
## F-statistic: 105.8 on 1 and 5 DF,  p-value: 0.0001493

3. Coeficiente de determinación

El 94.58% de la variabilidad de las deducciones se explica por los ingresos brutos, el 5.42% de la variabilidad no se explica por los ingresos brutos.

a) Trace un diagrama de dispersión con estos datos empleando como variable independiente el ingreso bruto ajustado.

plot(BD4$Ingreso_Bruto_Ajustado, BD4$Deducciones_Razonables,
     main = "BD4: Ingreso Bruto vs Deducciones Razonables",
     xlab = "Ingreso Bruto Ajustado", ylab = "Deducciones Razonables",
     pch = 18, col = "purple", cex = 1.5)
grid()

4. Prediccion de nuuevos valores

b) Calcule el monto razonable de deducciones declaradas de un contribuyente cuyo ingreso bruto ajustado es de $52 500. Si éste tiene deducciones declaradas por $20 400, ¿estará justificada una auditoria? Explique.

predict(modelo4,data.frame(Ingreso_Bruto_Ajustado=52500),interval="confidence")
##        fit      lwr      upr
## 1 8473.459 6359.184 10587.74

Para el contribuyente cuyo ingreso ajustado es de 52500 esos se espera en prommedio que la deduccion razonable es 8473.46 pesos en promedio con un minimo de 6359.184 pesos como minimo y un maximo de 10587.74

5. Intervalos de confianza para los valores esperados

modelo1$coefficients
##  (Intercept)        Price 
## 58.158491723  0.008448804
confint(modelo4,level=0.95)
##                            2.5 %    97.5 %
## (Intercept)            2.0203257 7.3331748
## Ingreso_Bruto_Ajustado 0.1209945 0.2016258

Existe un 95% de confianza de que las deducciones base (con ingreso bruto 0 PESOS) se encuentran entre 2,020 PESOS y 7,333 PESOS Existe un 95% de confianza de que el verdadero incremento en deducciones por cada 1000 PESOS de aumento en el ingreso bruto se encuentra entre 121 PESOS y 202 PESOS.

7. Propiedades de los residuales

Todo modelo de regresión lineal tiene supuestos que son: Independencia, Varianza Constante,Normalidad de los residuales

plot(modelo4)

contraste de hipótesis:

\(H_{0}: los\ datos\ provienen\ de\ una\ distribución\ normal\)

\(H_{1}: los\ datos\ no\ provienen\ de\ una\ distribución\ normal\)

shapiro.test(modelo4$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo4$residuals
## W = 0.92061, p-value = 0.4741

deacuerdo con el p-valor=0.4741 no se tiene suficiente evidencia para rechazar la hipotesis nula, es decir no se puede rechazar que los resifuos provienen de una distribución normal.

contrasta la hipótesis:

\(H_{0}: los\ datos\ no\ presentan\ autocorrelacion\)

\(H_{1}: los\ datos\ presentan\ autocorrelacion\)

dwtest(modelo4)
## 
##  Durbin-Watson test
## 
## data:  modelo4
## DW = 0.95149, p-value = 0.00691
## alternative hypothesis: true autocorrelation is greater than 0

deacuerdo con el p-valor menor a 0.05 se puede rechazar la hipotesis nula por lo que si se presenta autocorrelacion entre los residuos. contrasta la hipótesis:

\(H_{0}: los\ datos\ presentan\ homoesquedasticidad\)

\(H_{1}: los\ datos\ NO\ presentan\ homoesquedasticidad\)

ncvTest(modelo4)
## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 0.2179547, Df = 1, p = 0.6406

con un p-valor mator a 0.05 no se puede rechazar la hipotesis nula que nos dice que los residuos presentan varianza constante

Valorando los puntos influyentes

Contraste de hipotesis:

\(H_{0}: la\ observación\ i\ no\ es\ un\ valor\ atípico\)

\(H_{1}: la\ observación\ i\ es\ un\ valor\ atípico\)

outlierTest(modelo4)
## No Studentized residuals with Bonferroni p < 0.05
## Largest |rstudent|:
##   rstudent unadjusted p-value Bonferroni p
## 7 2.886681           0.044712      0.31298

con un p-valor mayor a 0.05 no se puede rechazar que el punto 7 no es un punto atipico

influenceIndexPlot(modelo4)

Anova

$H_{0}: _1=0 $

\(H_{1}: \beta_1 \neq 0\)

anova(modelo4)

Con un p valor mayor a 0.05 no se puede rechazar el echo de que \(\beta_1=0\)