library(ggplot2)
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(broom)
library(ggpubr)
library(readr)
library(readxl)
library(nortest)

Resumen

En este informe se presenta un análisis estadístico mediante regresión lineal aplicado a una base de datos con variables de propina, precio, total y cantidad. Donde se incluye el estudio de correlación entre variables, evaluación de independencia, análisis de normalidad y la visualización gráfica de los resultados.

Introducción

La regresión lineal es una técnica de modelado estadístico que se emplea para describir una variable de respuesta continua como una función de una o varias variables predictoras. Puede ayudar a comprender y predecir el comportamiento de sistemas complejos o a analizar datos experimentales, financieros y biológicos.

Las técnicas de regresión lineal permiten crear un modelo lineal. Este modelo describe la relación entre una variable dependiente \(y\)(también conocida como la respuesta) como una función de una o varias variables independientes \(X_i\)(denominadas predictores). La ecuación general correspondiente a un modelo de regresión lineal es: \[ Y = \beta_0 + \sum \ \beta_k X_k + \epsilon_i \] donde \(\beta\)representa las estimaciones de parámetros lineales que se deben calcular y \(\epsilon\)representa los términos de error.

La siguiente base de datos hace referencia a la relacion entre el precio unitario, la cantidad vendida y el precio de venta de diferentes productos.

Datos

estadistica_1_ <- read_xlsx("estadistica (1).xlsx")
summary(estadistica_1_)
##      Precio         Cantidad        Propina        Subtotal     Total a Pagar  
##  Min.   : 1500   Min.   :1.000   Min.   : 150   Min.   : 1500   Min.   : 1650  
##  1st Qu.: 5500   1st Qu.:1.000   1st Qu.: 800   1st Qu.: 8000   1st Qu.: 8800  
##  Median : 8000   Median :1.000   Median :1200   Median :12000   Median :13200  
##  Mean   :11077   Mean   :1.577   Mean   :1496   Mean   :14962   Mean   :16458  
##  3rd Qu.: 8750   3rd Qu.:2.000   3rd Qu.:1975   3rd Qu.:19750   3rd Qu.:21725  
##  Max.   :35000   Max.   :4.000   Max.   :3600   Max.   :36000   Max.   :39600

Analisis de Variable y Datos Estadisticos

Dentro de la bases de datos de pedidos, la variable precio, presenta valores que oscilan entre $1,500 hasta $35,000. La media es de $11,077, mientras que la mediana es de $8,000. En cuanto a la cantidad, la mayoría de las compras fueron de una sola unidad. La mediana es 1 y la media es 1.577, por otro lado, La propina varía bastante entre $150 y $3,600. La media es de $1,496 y la mediana de $1,200.

Independencia

El supuesto de independencia establece que los errores en un modelo de regresión deben ser independientes entre sí. Si existe autocorrelación, es decir, si los errores están relacionados entre sí, esto puede alterar la estimación de los coeficientes y afectar la validez de las pruebas estadísticas. Como resultado, podríamos obtener conclusiones incorrectas sobre la relevancia de las variables explicativas.

# Correlación entre variables
cor(estadistica_1_)
##                   Precio   Cantidad   Propina  Subtotal Total a Pagar
## Precio         1.0000000 -0.3306502 0.8049905 0.8049905     0.8049905
## Cantidad      -0.3306502  1.0000000 0.2732668 0.2732668     0.2732668
## Propina        0.8049905  0.2732668 1.0000000 1.0000000     1.0000000
## Subtotal       0.8049905  0.2732668 1.0000000 1.0000000     1.0000000
## Total a Pagar  0.8049905  0.2732668 1.0000000 1.0000000     1.0000000
cor(estadistica_1_$Precio, estadistica_1_$Propina)
## [1] 0.8049905
pairs(estadistica_1_)

El coeficiente de correlación es de 0.80 sugiriendo que a medida que el precio aumenta, la propina también tiende a aumentar.

Lo que se puede concluir que las variables no son independientes. Existe una relación lineal entre ellas.

Normalidad

hist(estadistica_1_$`Total a Pagar`)

shapiro.test(estadistica_1_$`Total a Pagar`)
## 
##  Shapiro-Wilk normality test
## 
## data:  estadistica_1_$`Total a Pagar`
## W = 0.86613, p-value = 0.002971
qqnorm(estadistica_1_$`Total a Pagar`)
qqline(estadistica_1_$`Total a Pagar`)

Se evaluó la normalidad de la variable Total a Pagar mediante un histograma, la prueba de Shapiro-Wilk y un gráfico Q-Q. Los resultados sugieren que la distribución se aproxima a una distribución normal.

Linealidad

pairs(estadistica_1_)

plot(Propina ~ Precio, data = estadistica_1_)

plot(Propina ~ `Total a Pagar`, data = estadistica_1_)

plot(Propina ~ Cantidad, data = estadistica_1_)

Los gráficos de dispersión entre la propina y las variables Precio, Total a Pagar y Cantidad revelan una relación lineal.

Modelo

estadistica_1.lm<- lm(`Total a Pagar` ~ Propina, data = estadistica_1_)
estadistica_1.lm<-lm(Propina ~ Precio, data = estadistica_1_)

summary(estadistica_1.lm)
## 
## Call:
## lm(formula = Propina ~ Precio, data = estadistica_1_)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -550.45 -440.51  -85.31  242.58 2276.41 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 575.81810  182.87806   3.149  0.00435 ** 
## Precio        0.08309    0.01250   6.647  7.1e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 609.2 on 24 degrees of freedom
## Multiple R-squared:  0.648,  Adjusted R-squared:  0.6333 
## F-statistic: 44.18 on 1 and 24 DF,  p-value: 7.099e-07

Se ajustó un modelo de regresión lineal para evaluar la relación entre la propina recibida y el precio. El modelo resultante es:

\[ Y = 575.82 + 0.083 \times \text{Precio} + e \] El análisis de regresión lineal realizado mostró una relación positiva y significativa entre el precio y la propina. El coeficiente estimado para el precio es 0.083 indica que, en promedio, por cada unidad adicional en el precio, la propina aumenta aproximadamente 0.0831 unidades.

El modelo explica cerca del 65% de la variabilidad en la propina, lo que significa que el precio es un buen predictor para estimar cuánto se dejará de propina.

Homocedasticidad

par(mfrow=c(2,2))
plot(estadistica_1_)

par(mfrow=c(1,1))

La evaluación gráfica de los residuos muestra que la varianza es constante a lo largo de los valores predichos, cumpliendo con el supuesto de homocedasticidad.

Grafico del Modelo

estadistica_1.lm <- lm(`Total a Pagar` ~ Propina, data = estadistica_1_)

# Secuencia de Propina para predicción
plotting.data <- data.frame(
  Propina = seq(min(estadistica_1_$Propina), max(estadistica_1_$Propina), length.out = 30)
)

# Prediccion de Total a Pagar con el modelo
plotting.data$predicted.Total <- predict(estadistica_1.lm, newdata = plotting.data)

ggplot(estadistica_1_, aes(x = Propina, y = `Total a Pagar`)) +
  geom_point() +
  geom_line(data = plotting.data, aes(x = Propina, y = predicted.Total), color = "cadetblue3", size = 1.25) +
  theme_bw() +
  labs(
    title = "Relación entre Propina y Total a Pagar",
    x = "Propina",
    y = "Total a Pagar"
  )
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

El gráfico de dispersión entre la propina y el total a pagar, junto con la línea de tendencia ajustada por el modelo de regresión, evidencia visualmente la relación positiva entre ambas variables

Precio <- c(1500, 3500, 4000, 4000, 5000, 5000, 5000, 7000, 7000, 7000, 7000, 7000, 8000, 8000, 8000, 8000, 8000, 8000, 8000, 9000, 9000, 29000, 29000, 29000, 29000, 35000)
Cantidad <- c(1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 2, 3, 1, 1, 1, 1, 2, 1, 1, 1, 4, 1, 1, 1, 1, 1 )  
Propina <- c(150, 350, 400, 800, 1000, 1000, 1500, 1400, 1400, 1400, 1400, 2100, 800, 800, 800, 800, 1600, 800, 800, 900, 3600, 2900, 2900, 2900, 2900, 3500)

set.seed(78)
datos <- data.frame(
  Cantidad = factor(rep(1:4, each=6)),
  Precio = c(1500,457,450,731,499,632,595,580,508,583,633,517,639,615,511,573,648,677,417,449,517,438,415,555)
)

length(datos$Precio)
## [1] 24
table(datos$Cantidad)
## 
## 1 2 3 4 
## 6 6 6 6
aggregate(Precio ~ Cantidad, data = datos, FUN = mean)
##   Cantidad   Precio
## 1        1 711.5000
## 2        2 569.3333
## 3        3 610.5000
## 4        4 465.1667
aggregate(Precio ~ Cantidad, data = datos, FUN = sd)
##   Cantidad    Precio
## 1        1 401.68184
## 2        2  47.98611
## 3        3  59.94581
## 4        4  57.60700
ggplot(datos, aes(x = Cantidad, y = Precio, color = Cantidad)) +
  geom_boxplot() +
  theme_bw()

# Normalidad para ANOVA (QQ plots por grupo)
par(mfrow = c(1,1))
for(i in levels(datos$Cantidad)){
  qqnorm(datos[datos$Cantidad == i, "Precio"], main = paste("Cantidad =", i))
  qqline(datos[datos$Cantidad == i, "Precio"])
}

by(datos, datos$Cantidad, function(x) lillie.test(x$Precio))
## datos$Cantidad: 1
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  x$Precio
## D = 0.31397, p-value = 0.06543
## 
## ------------------------------------------------------------ 
## datos$Cantidad: 2
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  x$Precio
## D = 0.25462, p-value = 0.2576
## 
## ------------------------------------------------------------ 
## datos$Cantidad: 3
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  x$Precio
## D = 0.19659, p-value = 0.6621
## 
## ------------------------------------------------------------ 
## datos$Cantidad: 4
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  x$Precio
## D = 0.27717, p-value = 0.1578
# Prueba de homocedasticidad ANOVA
bartlett.test(Precio ~ Cantidad, datos)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  Precio by Cantidad
## Bartlett's K-squared = 30.531, df = 3, p-value = 1.067e-06
fligner.test(Precio ~ Cantidad, datos)
## 
##  Fligner-Killeen test of homogeneity of variances
## 
## data:  Precio by Cantidad
## Fligner-Killeen:med chi-squared = 9.3149, df = 3, p-value = 0.02538
# ANOVA
anova_result <- aov(Precio ~ Cantidad, data = datos)
summary(anova_result)
##             Df Sum Sq Mean Sq F value Pr(>F)
## Cantidad     3 187139   62380   1.463  0.255
## Residuals   20 852815   42641
# Gráficos de diagnóstico ANOVA
plot(anova_result)

# Comparaciones múltiples (Tukey)
TukeyHSD(anova_result)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = Precio ~ Cantidad, data = datos)
## 
## $Cantidad
##           diff       lwr       upr     p adj
## 2-1 -142.16667 -475.8579 191.52459 0.6384361
## 3-1 -101.00000 -434.6913 232.69125 0.8313643
## 4-1 -246.33333 -580.0246  87.35792 0.1981760
## 3-2   41.16667 -292.5246 374.85792 0.9854286
## 4-2 -104.16667 -437.8579 229.52459 0.8182679
## 4-3 -145.33333 -479.0246 188.35792 0.6224126
plot(TukeyHSD(anova_result))

Se aplicó ANOVA para evaluar si el precio varía según la cantidad. El resultado no fue significativo p = 0.255, lo que indica que no hay diferencias significativas en el precio entre las cantidades. Aunque los datos presentan normalidad, las pruebas de Bartlett p < 0.001 y Fligner p = 0.025 indican diferencias en la varianza, lo que puede afectar la validez del ANOVA. Las pruebas post-hoc también confirmaron que no hay diferencias significativas entre pares de grupos.