ESTADÍSTICA INFERENCIAL
Grupo No. 5
2025-07-18
1 Todas las Variables Discretas
En este proyecto, se aplica la estadística inferencial para analizar variables discretas relevantes que afectan el consumo de combustible en vehículos, como el año de fabricación, el número de cilindros, y las horas de carga bajo corriente alterna (AC) a 240V. Estas variables discretas, que solo pueden tomar valores específicos y contables, permiten modelar y entender mejor la dinámica del consumo energético.
Mediante técnicas inferenciales, se examinan muestras representativas de datos vehiculares para estimar tendencias poblacionales, realizar comparaciones entre diferentes grupos y evaluar la influencia de los tiempos de carga en la eficiencia del combustible. La inferencia estadística con variables discretas posibilita validar hipótesis, ajustar modelos de conteo (como Poisson binomial negativa, entre otros) y predecir comportamientos futuros, facilitando la comprensión de los factores que influyen en el consumo de combustible en la ciudad de Ann Arbor.
Cargamos los datos:
setwd("C:/Users/Usuario/Documents/Trabajo Estadistica/PROYECTO/")
datos <- read.csv("database.csv", header = TRUE, sep = ",", dec = ".")
str(datos)## 'data.frame': 38113 obs. of 81 variables:
## $ Vehicle.ID : int 26587 27705 26561 27681 27550 28426 27549 28425 27593 28455 ...
## $ Year : int 1984 1984 1984 1984 1984 1984 1984 1984 1984 1984 ...
## $ Make : chr "Alfa Romeo" "Alfa Romeo" "Alfa Romeo" "Alfa Romeo" ...
## $ Model : chr "GT V6 2.5" "GT V6 2.5" "Spider Veloce 2000" "Spider Veloce 2000" ...
## $ Class : chr "Minicompact Cars" "Minicompact Cars" "Two Seaters" "Two Seaters" ...
## $ Drive : chr "" "" "" "" ...
## $ Transmission : chr "Manual 5-Speed" "Manual 5-Speed" "Manual 5-Speed" "Manual 5-Speed" ...
## $ Transmission.Descriptor : chr "" "" "" "" ...
## $ Engine.Index : int 9001 9005 9002 9006 1830 1880 1831 1881 1524 1574 ...
## $ Engine.Descriptor : chr "(FFS)" "(FFS) CA model" "(FFS)" "(FFS) CA model" ...
## $ Engine.Cylinders : int 6 6 4 4 4 4 6 6 6 6 ...
## $ Engine.Displacement : num 2.5 2.5 2 2 2.5 2.5 4.2 4.2 4.2 4.2 ...
## $ Turbocharger : logi NA NA NA NA NA NA ...
## $ Supercharger : chr "" "" "" "" ...
## $ Fuel.Type : chr "Regular" "Regular" "Regular" "Regular" ...
## $ Fuel.Type.1 : chr "Regular Gasoline" "Regular Gasoline" "Regular Gasoline" "Regular Gasoline" ...
## $ Fuel.Type.2 : chr "" "" "" "" ...
## $ City.MPG..FT1. : int 17 17 18 18 18 18 13 13 15 15 ...
## $ Unrounded.City.MPG..FT1. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ City.MPG..FT2. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Unrounded.City.MPG..FT2. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ City.Gasoline.Consumption..CD. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ City.Electricity.Consumption : num 0 0 0 0 0 0 0 0 0 0 ...
## $ City.Utility.Factor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Highway.MPG..FT1. : int 24 24 25 25 17 17 13 13 20 19 ...
## $ Unrounded.Highway.MPG..FT1. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Highway.MPG..FT2. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Unrounded.Highway.MPG..FT2. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Highway.Gasoline.Consumption..CD. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Highway.Electricity.Consumption : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Highway.Utility.Factor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Unadjusted.City.MPG..FT1. : num 21 21 23 23 22 22 16 16 19 19 ...
## $ Unadjusted.Highway.MPG..FT1. : num 34 34 35 35 24 24 18 18 27 26 ...
## $ Unadjusted.City.MPG..FT2. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Unadjusted.Highway.MPG..FT2. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Combined.MPG..FT1. : int 20 20 21 21 17 17 13 13 17 17 ...
## $ Unrounded.Combined.MPG..FT1. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Combined.MPG..FT2. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Unrounded.Combined.MPG..FT2. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Combined.Electricity.Consumption : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Combined.Gasoline.Consumption..CD. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Combined.Utility.Factor : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Annual.Fuel.Cost..FT1. : int 1750 1750 1650 1650 2050 2050 2700 2700 2050 2050 ...
## $ Annual.Fuel.Cost..FT2. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Gas.Guzzler.Tax : chr "" "" "" "" ...
## $ Save.or.Spend..5.Year. : int -2000 -2000 -1500 -1500 -3500 -3500 -6750 -6750 -3500 -3500 ...
## $ Annual.Consumption.in.Barrels..FT1.: num 16.5 16.5 15.7 15.7 19.4 ...
## $ Annual.Consumption.in.Barrels..FT2.: num 0 0 0 0 0 0 0 0 0 0 ...
## $ Tailpipe.CO2..FT1. : int -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
## $ Tailpipe.CO2.in.Grams.Mile..FT1. : num 444 444 423 423 523 ...
## $ Tailpipe.CO2..FT2. : int -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
## $ Tailpipe.CO2.in.Grams.Mile..FT2. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Fuel.Economy.Score : int -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
## $ GHG.Score : int -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
## $ GHG.Score..Alt.Fuel. : int -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ...
## $ My.MPG.Data : chr "N" "N" "N" "N" ...
## $ X2D.Passenger.Volume : int 74 74 0 0 0 0 0 0 0 0 ...
## $ X2D.Luggage.Volume : int 7 7 0 0 0 0 0 0 0 0 ...
## $ X4D.Passenger.Volume : int 0 0 0 0 0 0 0 0 0 0 ...
## $ X4D.Luggage.Volume : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Hatchback.Passenger.Volume : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Hatchback.Luggage.Volume : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Start.Stop.Technology : chr "" "" "" "" ...
## $ Alternative.Fuel.Technology : chr "" "" "" "" ...
## $ Electric.Motor : chr "" "" "" "" ...
## $ Manufacturer.Code : chr "" "" "" "" ...
## $ Gasoline.Electricity.Blended..CD. : chr "False" "False" "False" "False" ...
## $ Vehicle.Charger : chr "" "" "" "" ...
## $ Alternate.Charger : chr "" "" "" "" ...
## $ Hours.to.Charge..120V. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Hours.to.Charge..240V. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Hours.to.Charge..AC.240V. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Composite.City.MPG : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Composite.Highway.MPG : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Composite.Combined.MPG : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Range..FT1. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ City.Range..FT1. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Highway.Range..FT1. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Range..FT2. : chr "" "" "" "" ...
## $ City.Range..FT2. : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Highway.Range..FT2. : num 0 0 0 0 0 0 0 0 0 0 ...Empezamos el desarrollo para cada variable discreta:
2 Year
anios <- datos$Year
tabla_anios <- table(anios)
tabla_anios_df <- as.data.frame(tabla_anios)
colnames(tabla_anios_df) <- c("Year", "ni")
hi <- tabla_anios_df$ni / sum(tabla_anios_df$ni)
hi_porc <- round(hi * 100, 2)
Ni_asc <- cumsum(tabla_anios_df$ni)
Ni_dsc <- rev(cumsum(rev(tabla_anios_df$ni)))
Hi_asc <- cumsum(hi_porc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))# Tabla final
TDFanios <- data.frame(
Year = tabla_anios_df$Year,
ni = tabla_anios_df$ni,
`hi(%)` = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
TDFanios## Year ni hi... Niasc Nidsc Hiasc Hidsc
## 1 1984 1964 5.15 1964 38113 5.15 100.00
## 2 1985 1701 4.46 3665 36149 9.61 94.85
## 3 1986 1210 3.17 4875 34448 12.78 90.39
## 4 1987 1247 3.27 6122 33238 16.05 87.22
## 5 1988 1130 2.96 7252 31991 19.01 83.95
## 6 1989 1153 3.03 8405 30861 22.04 80.99
## 7 1990 1078 2.83 9483 29708 24.87 77.96
## 8 1991 1132 2.97 10615 28630 27.84 75.13
## 9 1992 1121 2.94 11736 27498 30.78 72.16
## 10 1993 1093 2.87 12829 26377 33.65 69.22
## 11 1994 982 2.58 13811 25284 36.23 66.35
## 12 1995 967 2.54 14778 24302 38.77 63.77
## 13 1996 773 2.03 15551 23335 40.80 61.23
## 14 1997 762 2.00 16313 22562 42.80 59.20
## 15 1998 812 2.13 17125 21800 44.93 57.20
## 16 1999 852 2.24 17977 20988 47.17 55.07
## 17 2000 840 2.20 18817 20136 49.37 52.83
## 18 2001 911 2.39 19728 19296 51.76 50.63
## 19 2002 975 2.56 20703 18385 54.32 48.24
## 20 2003 1044 2.74 21747 17410 57.06 45.68
## 21 2004 1122 2.94 22869 16366 60.00 42.94
## 22 2005 1166 3.06 24035 15244 63.06 40.00
## 23 2006 1104 2.90 25139 14078 65.96 36.94
## 24 2007 1126 2.95 26265 12974 68.91 34.04
## 25 2008 1187 3.11 27452 11848 72.02 31.09
## 26 2009 1178 3.09 28630 10661 75.11 27.98
## 27 2010 1100 2.89 29730 9483 78.00 24.89
## 28 2011 1121 2.94 30851 8383 80.94 22.00
## 29 2012 1142 3.00 31993 7262 83.94 19.06
## 30 2013 1169 3.07 33162 6120 87.01 16.06
## 31 2014 1203 3.16 34365 4951 90.17 12.99
## 32 2015 1270 3.33 35635 3748 93.50 9.83
## 33 2016 1250 3.28 36885 2478 96.78 6.50
## 34 2017 1228 3.22 38113 1228 100.00 3.22# Gráfico de barras
barplot(TDFanios$ni,
main = "Gráfica No.1: Distribución por Año",
xlab = "Año", ylab = "Frecuencia Absoluta",
col = "yellow", ylim = c(0, max(TDFanios$ni) + 5),
names.arg = TDFanios$Year,
las = 2)
Dividimos los valores para obtener un modelo adecuado para aplicar:
Primero será de 1984 a 1994
Segundo será de 1995 a 2005
Tercero será de 2006 a 2017
2.1 De 1984 a 1994
anios_84_94 <- as.numeric(datos$Year)
anios_84_94 <- anios_84_94[!is.na(anios_84_94) & anios_84_94 >= 1984 & anios_84_94 <= 1994]
tabla_84_94 <- table(anios_84_94)
df_84_94 <- as.data.frame(tabla_84_94)
colnames(df_84_94) <- c("Año", "ni")
hi <- df_84_94$ni / sum(df_84_94$ni)
hi_porc <- round(hi * 100, 2)
Ni_asc <- cumsum(df_84_94$ni)
Ni_dsc <- rev(cumsum(rev(df_84_94$ni)))
Hi_asc <- cumsum(hi_porc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))# Tabla final con ni y todo
tabla_84_94 <- data.frame(
Año = df_84_94$Año,
ni = df_84_94$ni,
`hi(%)` = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
tabla_84_94## Año ni hi... Niasc Nidsc Hiasc Hidsc
## 1 1984 1964 14.22 1964 13811 14.22 100.01
## 2 1985 1701 12.32 3665 11847 26.54 85.79
## 3 1986 1210 8.76 4875 10146 35.30 73.47
## 4 1987 1247 9.03 6122 8936 44.33 64.71
## 5 1988 1130 8.18 7252 7689 52.51 55.68
## 6 1989 1153 8.35 8405 6559 60.86 47.50
## 7 1990 1078 7.81 9483 5406 68.67 39.15
## 8 1991 1132 8.20 10615 4328 76.87 31.34
## 9 1992 1121 8.12 11736 3196 84.99 23.14
## 10 1993 1093 7.91 12829 2075 92.90 15.02
## 11 1994 982 7.11 13811 982 100.01 7.11# Gráfico de barras
barplot(tabla_84_94$ni,
names.arg = tabla_84_94$Año,
main = "Gráfico No.2: Distribución por Años (1984–1994)",
xlab = "Año", ylab = "Frecuencia",
col = "skyblue",
las = 2,
cex.names = 0.8,
ylim = c(0, max(tabla_84_94$ni) + 5))
Modelo Geométrico
# Transformar años en conteo (1984 = 1, ..., 1994 = 11)
conteo_geom <- as.numeric(as.character(tabla_84_94$Año)) - 1983
frecuencia_obs <- tabla_84_94$ni
# Estimar parámetro p
media_x <- mean(rep(conteo_geom, frecuencia_obs))
p_hat <- 1 / media_x
cat("Parámetro estimado p =", round(p_hat, 4), "\n")## Parámetro estimado p = 0.1842# Probabilidades teóricas y frecuencias esperadas
probs_geom <- dgeom(conteo_geom - 1, prob = p_hat)
frecuencia_esp <- round(sum(frecuencia_obs) * probs_geom)
tabla_geom <- data.frame(
Año = tabla_84_94$Año,
X = conteo_geom,
`ni (obs)` = frecuencia_obs,
`ni (esp)` = frecuencia_esp,
`P(x)` = round(probs_geom, 4)
)
tabla_geom## Año X ni..obs. ni..esp. P.x.
## 1 1984 1 1964 2544 0.1842
## 2 1985 2 1701 2075 0.1503
## 3 1986 3 1210 1693 0.1226
## 4 1987 4 1247 1381 0.1000
## 5 1988 5 1130 1127 0.0816
## 6 1989 6 1153 919 0.0666
## 7 1990 7 1078 750 0.0543
## 8 1991 8 1132 612 0.0443
## 9 1992 9 1121 499 0.0361
## 10 1993 10 1093 407 0.0295
## 11 1994 11 982 332 0.0240# Gráfico comparativo observados vs esperados
barplot(rbind(frecuencia_obs, frecuencia_esp),
beside = TRUE,
names.arg = tabla_84_94$Año,
col = c("skyblue", "orange"),
legend.text = c("Real", "Modelo"),
main = "Gráfico No.3: Modelo Geométrico (1984–1994)",
xlab = "Año", ylab = "Frecuencia",
las = 2,
cex.names = 0.8)
Test de Pearson
# Test de bondad de ajuste (Chi-cuadrado)
Fo1 <- frecuencia_obs
Fe1 <- frecuencia_esp
# Verificar que no haya Fe = 0
if (any(Fe1 == 0)) {
cat("Advertencia: Hay frecuencias esperadas iguales a 0. El test de chi-cuadrado puede no ser válido.\n")
}
x2 <- sum((Fo1 - Fe1)^2 / Fe1)
cat("Estadístico Chi-cuadrado (Pearson):", round(x2, 4), "\n")## Estadístico Chi-cuadrado (Pearson): 4199.471correlacion <- cor(Fo1, Fe1)
cat("Correlación entre observadas y esperadas:", round(correlacion, 4), "\n")## Correlación entre observadas y esperadas: 0.9053# Gráfico de correlación
plot(Fo1, Fe1,
main = "Gráfico No.4: Correlación Observadas vs Esperadas",
xlab = "Frecuencias Observadas",
ylab = "Frecuencias Esperadas",
pch = 19, col = "blue")
abline(lm(Fe1 ~ Fo1), col = "red", lwd = 2)
# Valor crítico para contraste
k <- length(Fo1)
vc <- qchisq(0.95, df = k - 1)
cat("Valor crítico Chi-cuadrado (95%):", round(vc, 4), "\n")## Valor crítico Chi-cuadrado (95%): 18.307## ¿x² < valor crítico? FALSEif (x2 < vc) {
cat("No se rechaza la hipótesis nula (buen ajuste del modelo geométrico).\n")
} else {
cat("Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).\n")
}## Se rechaza la hipótesis nula (el modelo no se ajusta bien a los datos).2.2 De 1984 a 1994
anios_95_05 <- as.numeric(datos$Year)
anios_95_05 <- anios_95_05[!is.na(anios_95_05) & anios_95_05 >= 1995 & anios_95_05 <= 2005]
TDF_95_05 <- table(anios_95_05)
Tabla_95_05 <- as.data.frame(TDF_95_05)
hi <- Tabla_95_05$Freq / sum(Tabla_95_05$Freq)
hi_porc <- round(hi * 100, 2)
Ni_asc <- cumsum(Tabla_95_05$Freq)
Ni_dsc <- rev(cumsum(rev(Tabla_95_05$Freq)))
Hi_asc <- cumsum(hi_porc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))# Tabla final con ni y todo
tabla_95_05 <- data.frame(
Año = Tabla_95_05$anios_95_05,
ni = Tabla_95_05$Freq,
`hi(%)` = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
tabla_95_05## Año ni hi... Niasc Nidsc Hiasc Hidsc
## 1 1995 967 9.46 967 10224 9.46 99.99
## 2 1996 773 7.56 1740 9257 17.02 90.53
## 3 1997 762 7.45 2502 8484 24.47 82.97
## 4 1998 812 7.94 3314 7722 32.41 75.52
## 5 1999 852 8.33 4166 6910 40.74 67.58
## 6 2000 840 8.22 5006 6058 48.96 59.25
## 7 2001 911 8.91 5917 5218 57.87 51.03
## 8 2002 975 9.54 6892 4307 67.41 42.12
## 9 2003 1044 10.21 7936 3332 77.62 32.58
## 10 2004 1122 10.97 9058 2288 88.59 22.37
## 11 2005 1166 11.40 10224 1166 99.99 11.40# Gráfico de barras
barplot(tabla_95_05$ni,
names.arg = tabla_95_05$Año,
main = "Gráfico No.5: Distribución por Años (1995–2005)",
xlab = "Año", ylab = "Frecuencia",
col = "lightgreen",
las = 2,
cex.names = 0.8,
ylim = c(0, max(tabla_95_05$ni) + 100))
Modelo Uniform:
# Número de categorías
k <- nrow(tabla_95_05)
Fo <- tabla_95_05$ni # Frecuencias observadas
p_uniforme <- rep(1/k, k) # Probabilidad uniforme
# Frecuencias esperadas bajo uniforme
Fe <- rep(sum(Fo)/k, k)
# Tabla comparativa
tabla_uniforme <- data.frame(
Año = tabla_95_05$Año,
Observado = Fo,
Esperado = Fe
)
tabla_uniforme## Año Observado Esperado
## 1 1995 967 929.4545
## 2 1996 773 929.4545
## 3 1997 762 929.4545
## 4 1998 812 929.4545
## 5 1999 852 929.4545
## 6 2000 840 929.4545
## 7 2001 911 929.4545
## 8 2002 975 929.4545
## 9 2003 1044 929.4545
## 10 2004 1122 929.4545
## 11 2005 1166 929.4545# Gráfico comparativo
barplot(rbind(Fo, Fe),
beside = TRUE,
names.arg = tabla_95_05$Año,
col = c("lightgreen", "orange"),
legend.text = c("Real", "Modelo"),
main = "Gráfico No.6: Modelo Uniforme Discreto (1995–2005)",
xlab = "Año", ylab = "Frecuencia",
las = 2,
cex.names = 0.8)
## Warning in cor(Fo, Fe): La desviación estándar es cero## Correlación observadas vs esperadas: NA# Gráfico correlación
plot(Fo, Fe,
main = "Gráfico No.7: Correlación Observadas vs Esperadas
(Uniforme)",
xlab = "Frecuencias Observadas",
ylab = "Frecuencias Esperadas",
pch = 19, col = "darkgreen")
abline(lm(Fe ~ Fo), col = "red", lwd = 2)
# Test Chi-cuadrado manual con comparación al final
x2_uniforme <- sum((Fo - Fe)^2 / Fe)
cat("Estadístico Chi-cuadrado (Uniforme):", x2_uniforme, "\n")## Estadístico Chi-cuadrado (Uniforme): 204.7316## Valor crítico Chi-cuadrado (95%): 18.30704## ¿x2 < valor crítico? FALSEif (x2_uniforme < vc_uniforme) {
cat("No se rechaza la hipótesis nula (buen ajuste al modelo uniforme)\n")
} else {
cat("Se rechaza la hipótesis nula (mal ajuste al modelo uniforme)\n")
}## Se rechaza la hipótesis nula (mal ajuste al modelo uniforme)2.3 De 1984 a 1994
anios_06_17 <- as.numeric(datos$Year)
anios_06_17 <- anios_06_17[!is.na(anios_06_17) & anios_06_17 >= 2006 & anios_06_17 <= 2017]
TDF_06_17 <- table(anios_06_17)
Tabla_06_17 <- as.data.frame(TDF_06_17)
hi <- Tabla_06_17$Freq / sum(Tabla_06_17$Freq)
hi_porc <- round(hi * 100, 2)
Ni_asc <- cumsum(Tabla_06_17$Freq)
Ni_dsc <- rev(cumsum(rev(Tabla_06_17$Freq)))
Hi_asc <- cumsum(hi_porc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))# Tabla final con ni y todo
tabla_06_17 <- data.frame(
Año = Tabla_06_17$anios_06_17,
ni = Tabla_06_17$Freq,
`hi(%)` = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
tabla_06_17## Año ni hi... Niasc Nidsc Hiasc Hidsc
## 1 2006 1104 7.84 1104 14078 7.84 99.99
## 2 2007 1126 8.00 2230 12974 15.84 92.15
## 3 2008 1187 8.43 3417 11848 24.27 84.15
## 4 2009 1178 8.37 4595 10661 32.64 75.72
## 5 2010 1100 7.81 5695 9483 40.45 67.35
## 6 2011 1121 7.96 6816 8383 48.41 59.54
## 7 2012 1142 8.11 7958 7262 56.52 51.58
## 8 2013 1169 8.30 9127 6120 64.82 43.47
## 9 2014 1203 8.55 10330 4951 73.37 35.17
## 10 2015 1270 9.02 11600 3748 82.39 26.62
## 11 2016 1250 8.88 12850 2478 91.27 17.60
## 12 2017 1228 8.72 14078 1228 99.99 8.72# Gráfico de barras
barplot(tabla_06_17$ni,
names.arg = tabla_06_17$Año,
main = "Gráfico No.8: Distribución por Años (2006–2017)",
xlab = "Año", ylab = "Frecuencia",
col = "salmon",
las = 2,
cex.names = 0.8,
ylim = c(0, max(tabla_06_17$ni) + 100))
Modelo Uniforme:
k <- nrow(tabla_06_17)
Fo <- tabla_06_17$ni
# Probabilidad uniforme
p_uniforme <- rep(1/k, k)
Fe <- rep(sum(Fo)/k, k)
tabla_uniforme <- data.frame(
Año = tabla_06_17$Año,
Observado = Fo,
Esperado = Fe
)
tabla_uniforme## Año Observado Esperado
## 1 2006 1104 1173.167
## 2 2007 1126 1173.167
## 3 2008 1187 1173.167
## 4 2009 1178 1173.167
## 5 2010 1100 1173.167
## 6 2011 1121 1173.167
## 7 2012 1142 1173.167
## 8 2013 1169 1173.167
## 9 2014 1203 1173.167
## 10 2015 1270 1173.167
## 11 2016 1250 1173.167
## 12 2017 1228 1173.167# Gráfico comparativo
barplot(rbind(Fo, Fe),
beside = TRUE,
names.arg = tabla_06_17$Año,
col = c("salmon", "orange"),
legend.text = c("Real", "Modelo"),
main = "Gráfico No.9: Modelo Uniforme (2006–2017)",
xlab = "Año", ylab = "Frecuencia",
las = 2,
cex.names = 0.8)
## Warning in cor(Fo, Fe): La desviación estándar es cero## Correlación observadas vs esperadas: NA# Gráfico correlación
plot(Fo, Fe,
main = "Gráfico No.10: Correlación Observadas vs Esperadas",
xlab = "Frecuencias Observadas",
ylab = "Frecuencias Esperadas",
pch = 19, col = "darkred")
abline(lm(Fe ~ Fo), col = "red", lwd = 2)
# Test Chi-cuadrado manual con comparación
x2_uniforme <- sum((Fo - Fe)^2 / Fe)
cat("Estadístico Chi-cuadrado (Uniforme):", x2_uniforme, "\n")## Estadístico Chi-cuadrado (Uniforme): 30.22901## Valor crítico Chi-cuadrado (95%): 19.67514## ¿x2 < valor crítico? FALSEif (x2_uniforme < vc_uniforme) {
cat("No se rechaza la hipótesis nula (buen ajuste al modelo uniforme)\n")
} else {
cat("Se rechaza la hipótesis nula (mal ajuste al modelo uniforme)\n")
}## Se rechaza la hipótesis nula (mal ajuste al modelo uniforme)3 Engine Cylinders
Cilindros <- datos$Engine.Cylinders
Cilindros <- Cilindros[!is.na(Cilindros) & Cilindros != "" & Cilindros != -1]
Cilindros <- as.numeric(Cilindros)
TDFcilindros <- table(Cilindros)
TablaCilindros <- as.data.frame(TDFcilindros)
# Tabla de frecuencias
hi <- (TablaCilindros$Freq / sum(TablaCilindros$Freq)) * 100
Niasc <- cumsum(TablaCilindros$Freq)
Hiasc <- cumsum(hi)
Nidsc <- rev(cumsum(rev(TablaCilindros$Freq)))
Hidsc <- rev(cumsum(rev(hi)))TablaCilindrosFinal <- data.frame(
Cilindros = TablaCilindros$Cilindros,
`ni(FA)` = TablaCilindros$Freq,
`hi(FR)` = round(hi, 2),
`Ni(FAAa)` = Niasc,
`Hi(FRAa)` = round(Hiasc, 2),
`Ni(FAAd)` = Nidsc,
`Hi(FRAd)` = round(Hidsc, 2)
)
TablaCilindrosFinal## Cilindros ni.FA. hi.FR. Ni.FAAa. Hi.FRAa. Ni.FAAd. Hi.FRAd.
## 1 2 55 0.14 55 0.14 37977 100.00
## 2 3 213 0.56 268 0.71 37922 99.86
## 3 4 14598 38.44 14866 39.14 37709 99.29
## 4 5 766 2.02 15632 41.16 23111 60.86
## 5 6 13268 34.94 28900 76.10 22345 58.84
## 6 8 8342 21.97 37242 98.06 9077 23.90
## 7 10 153 0.40 37395 98.47 735 1.94
## 8 12 574 1.51 37969 99.98 582 1.53
## 9 16 8 0.02 37977 100.00 8 0.02# Gráfico
barplot(
TablaCilindros$Freq,
main = "Gráfica No. 11:
Distribución de Cantidad de Cilindros",
xlab = "Cilindros",
ylab = "Cantidad",
col = "blue",
names.arg = TablaCilindros$Cilindros
)
Aqui agrupamos en dos grupos para poder expresar los modelos correspondientes.
Grupo 1: Vehículos de motor pequeño o estándar (2–5 cilindros)
Grupo 2: Vehículos de motor grande o alto rendimiento (6–16 cilindros)
3.1 Grupo 1
Cilindros_grupo1 <- Cilindros[Cilindros >= 2 & Cilindros <= 5]
# Crear tabla de frecuencia
TablaGrupo1 <- table(Cilindros_grupo1)
TablaGrupo1_df <- as.data.frame(TablaGrupo1)
colnames(TablaGrupo1_df) <- c("Cilindros", "Frecuencia")
hi_grupo1 <- (TablaGrupo1_df$Frecuencia / sum(TablaGrupo1_df$Frecuencia)) * 100
Ni_asc_grupo1 <- cumsum(TablaGrupo1_df$Frecuencia)
Hi_asc_grupo1 <- cumsum(hi_grupo1)
# Tabla de frecuencias completa
TablaFinalGrupo1 <- data.frame(
Cilindros = TablaGrupo1_df$Cilindros,
`ni (FA)` = TablaGrupo1_df$Frecuencia,
`hi (%)` = round(hi_grupo1, 2),
`Ni (Acumulada)` = Ni_asc_grupo1,
`Hi (%) Acumulada` = round(Hi_asc_grupo1, 2)
)
print(TablaFinalGrupo1)## Cilindros ni..FA. hi.... Ni..Acumulada. Hi.....Acumulada
## 1 2 55 0.35 55 0.35
## 2 3 213 1.36 268 1.71
## 3 4 14598 93.39 14866 95.10
## 4 5 766 4.90 15632 100.00# Gráfico de barras del Grupo 1
barplot(
height = TablaGrupo1_df$Frecuencia,
names.arg = TablaGrupo1_df$Cilindros,
col = "steelblue",
main = "Gráfica No.12: Grupo de Distribución de Cilindros (2 a 5)",
xlab = "Número de Cilindros",
ylab = "Frecuencia"
)
Modelo Binomial:
grupo <- Cilindros[Cilindros >= 2 & Cilindros <= 5]
tabla_grupo <- table(grupo)
df_grupo <- as.data.frame(tabla_grupo)
colnames(df_grupo) <- c("X", "ni")
df_grupo$X <- as.numeric(as.character(df_grupo$X))
# Parámetros binomiales
n_bin <- max(df_grupo$X)
p_bin <- mean(grupo) / n_bin
# Frecuencias esperadas (Binomial)
df_grupo$esperados_bin <- dbinom(df_grupo$X, size = n_bin, prob = p_bin) * sum(df_grupo$ni)# Gráfico: Observado vs Esperado (Binomial)
barplot(
rbind(df_grupo$ni, df_grupo$esperados_bin),
beside = TRUE,
col = c("darkblue", "tomato"),
legend = c("Observada", "Esperada"),
names.arg = df_grupo$X,
main = "Gráfica No.13:
Distribución Binomial - Grupo Cilindros (2 a 5)",
xlab = "Número de Cilindros",
ylab = "Frecuencia"
)
# Correlación y gráfico
cor_bin <- cor(df_grupo$ni, df_grupo$esperados_bin)
plot(df_grupo$esperados_bin, df_grupo$ni,
main = "Gráfica No.14:
Correlación Experimental vs Teórica (Binomial)",
xlab = "Teórica (Binomial)", ylab = "Experimental",
pch = 19, col = "blue")
abline(lm(df_grupo$ni ~ df_grupo$esperados_bin), col = "red", lwd = 2)
text(min(df_grupo$esperados_bin), max(df_grupo$ni),
labels = paste("r =", round(cor_bin, 3)), pos = 4, col = "blue")
# Chi-cuadrado
x2_bin <- sum((df_grupo$ni - df_grupo$esperados_bin)^2 / df_grupo$esperados_bin)
gl_bin <- length(df_grupo$X) - 1
vc_bin <- qchisq(0.95, df = gl_bin)
cat("Chi-cuadrado (binomial):", round(x2_bin, 3), "\n")## Chi-cuadrado (binomial): 17702.36## Valor crítico: 7.815if (x2_bin < vc_bin) {
cat("No se rechaza H0: El modelo binomial se ajusta bien.\n")
} else {
cat("Se rechaza H0: El modelo binomial no se ajusta.\n")
}## Se rechaza H0: El modelo binomial no se ajusta.Modelo Poisson:
lambda <- mean(grupo)
# Frecuencias esperadas (Poisson)
df_grupo$esperados_pois <- dpois(df_grupo$X, lambda) * sum(df_grupo$ni)# Gráfico: Observado vs Esperado (Poisson)
barplot(
rbind(df_grupo$ni, df_grupo$esperados_pois),
beside = TRUE,
col = c("darkgreen", "orange"),
legend = c("Observada", "Esperada"),
names.arg = df_grupo$X,
main = "Gráfica No.15: Distribución
Poisson - Grupo Cilindros (2 a 5)",
xlab = "Número de Cilindros",
ylab = "Frecuencia"
)
# Correlación y gráfico
cor_pois <- cor(df_grupo$ni, df_grupo$esperados_pois)
plot(df_grupo$esperados_pois, df_grupo$ni,
main = "Gráfica No.16:
Correlación Experimental vs Teórica (Poisson)",
xlab = "Teórica (Poisson)", ylab = "Experimental",
pch = 19, col = "darkgreen")
abline(lm(df_grupo$ni ~ df_grupo$esperados_pois), col = "red", lwd = 2)
text(min(df_grupo$esperados_pois), max(df_grupo$ni),
labels = paste("r =", round(cor_pois, 3)), pos = 4, col = "darkgreen")
# Chi-cuadrado
x2_pois <- sum((df_grupo$ni - df_grupo$esperados_pois)^2 / df_grupo$esperados_pois)
gl_pois <- length(df_grupo$X) - 1
vc_pois <- qchisq(0.95, df = gl_pois)
cat("Chi-cuadrado (Poisson):", round(x2_pois, 3), "\n")## Chi-cuadrado (Poisson): 49580.47## Valor crítico: 7.815if (x2_pois < vc_pois) {
cat("No se rechaza H0: El modelo Poisson se ajusta bien.\n")
} else {
cat("Se rechaza H0: El modelo Poisson no se ajusta.\n")
}## Se rechaza H0: El modelo Poisson no se ajusta.3.2 Grupo 2
# Filtrar cilindros entre 6 y 16
Cilindros_grupo2 <- Cilindros[Cilindros >= 6 & Cilindros <= 16]
# Crear tabla de frecuencia
TablaGrupo2 <- table(Cilindros_grupo2)
TablaGrupo2_df <- as.data.frame(TablaGrupo2)
colnames(TablaGrupo2_df) <- c("Cilindros", "Frecuencia")
# Calcular frecuencias relativas (%)
hi_grupo2 <- (TablaGrupo2_df$Frecuencia / sum(TablaGrupo2_df$Frecuencia)) * 100
Ni_asc_grupo2 <- cumsum(TablaGrupo2_df$Frecuencia)
Hi_asc_grupo2 <- cumsum(hi_grupo2)
# Tabla de frecuencias completa
TablaFinalGrupo2 <- data.frame(
Cilindros = TablaGrupo2_df$Cilindros,
`ni (FA)` = TablaGrupo2_df$Frecuencia,
`hi (%)` = round(hi_grupo2, 2),
`Ni (Acumulada)` = Ni_asc_grupo2,
`Hi (%) Acumulada` = round(Hi_asc_grupo2, 2)
)
print(TablaFinalGrupo2)## Cilindros ni..FA. hi.... Ni..Acumulada. Hi.....Acumulada
## 1 6 13268 59.38 13268 59.38
## 2 8 8342 37.33 21610 96.71
## 3 10 153 0.68 21763 97.40
## 4 12 574 2.57 22337 99.96
## 5 16 8 0.04 22345 100.00# Gráfico de barras del Grupo 2
barplot(
height = TablaGrupo2_df$Frecuencia,
names.arg = TablaGrupo2_df$Cilindros,
col = "darkorange",
main = "Gráfica No.17: Distribución de Cilindros (6 a 16)",
xlab = "Número de Cilindros",
ylab = "Frecuencia"
)
Modelo Binomial:
grupo2 <- Cilindros[Cilindros >= 6 & Cilindros <= 16]
tabla_grupo2 <- table(grupo2)
df_grupo2 <- as.data.frame(tabla_grupo2)
colnames(df_grupo2) <- c("X", "ni")
df_grupo2$X <- as.numeric(as.character(df_grupo2$X))
# Parámetros binomiales
n_bin2 <- max(df_grupo2$X)
p_bin2 <- mean(grupo2) / n_bin2
# Frecuencias esperadas (Binomial)
df_grupo2$esperados_bin <- dbinom(df_grupo2$X, size = n_bin2, prob = p_bin2) * sum(df_grupo2$ni)# Gráfico Observado vs Esperado
barplot(
rbind(df_grupo2$ni, df_grupo2$esperados_bin),
beside = TRUE,
col = c("blue", "pink"),
legend = c("Observada", "Esperada"),
names.arg = df_grupo2$X,
main = "Gráfica No.18:
Distribución Binomial - Grupo Cilindros (6 a 16)",
xlab = "Número de Cilindros",
ylab = "Frecuencia"
)
# Correlación y gráfico
cor_bin2 <- cor(df_grupo2$ni, df_grupo2$esperados_bin)
plot(df_grupo2$esperados_bin, df_grupo2$ni,
main = "Gráfica No.19:
Correlación Experimental vs Teórica (Binomial)",
xlab = "Teórica (Binomial)", ylab = "Experimental",
pch = 19, col = "blue")
abline(lm(df_grupo2$ni ~ df_grupo2$esperados_bin), col = "red", lwd = 2)
text(min(df_grupo2$esperados_bin), max(df_grupo2$ni),
labels = paste("r =", round(cor_bin2, 3)), pos = 4, col = "blue")
# Chi-cuadrado
x2_bin2 <- sum((df_grupo2$ni - df_grupo2$esperados_bin)^2 / df_grupo2$esperados_bin)
gl_bin2 <- length(df_grupo2$X) - 1
vc_bin2 <- qchisq(0.95, df = gl_bin2)
cat("Chi-cuadrado (binomial):", round(x2_bin2, 3), "\n")## Chi-cuadrado (binomial): 30211.81## Valor crítico: 9.488if (x2_bin2 < vc_bin2) {
cat("No se rechaza H0: El modelo binomial se ajusta bien.\n")
} else {
cat("Se rechaza H0: El modelo binomial no se ajusta.\n")
}## Se rechaza H0: El modelo binomial no se ajusta.Modelo Poisson:
# Parámetro lambda
lambda2 <- mean(grupo2)
df_grupo2$esperados_pois <- dpois(df_grupo2$X, lambda2) * sum(df_grupo2$ni)# Gráfico Observado vs Esperado
barplot(
rbind(df_grupo2$ni, df_grupo2$esperados_pois),
beside = TRUE,
col = c("darkgreen", "orange"),
legend = c("Observada", "Esperada"),
names.arg = df_grupo2$X,
main = "Gráfica No.20:
Distribución Poisson - Grupo Cilindros (6 a 16)",
xlab = "Número de Cilindros",
ylab = "Frecuencia"
)
# Correlación y gráfico
cor_pois2 <- cor(df_grupo2$ni, df_grupo2$esperados_pois)
plot(df_grupo2$esperados_pois, df_grupo2$ni,
main = "Gráfica No.21:
Correlación Experimental vs Teórica (Poisson)",
xlab = "Teórica (Poisson)", ylab = "Experimental",
pch = 19, col = "darkgreen")
abline(lm(df_grupo2$ni ~ df_grupo2$esperados_pois), col = "red", lwd = 2)
text(min(df_grupo2$esperados_pois), max(df_grupo2$ni),
labels = paste("r =", round(cor_pois2, 3)), pos = 4, col = "darkgreen")
# Chi-cuadrado
x2_pois2 <- sum((df_grupo2$ni - df_grupo2$esperados_pois)^2 / df_grupo2$esperados_pois)
gl_pois2 <- length(df_grupo2$X) - 1
vc_pois2 <- qchisq(0.95, df = gl_pois2)
cat("Chi-cuadrado (Poisson):", round(x2_pois2, 3), "\n")## Chi-cuadrado (Poisson): 40795.37## Valor crítico: 9.488if (x2_pois2 < vc_pois2) {
cat("No se rechaza H0: El modelo Poisson se ajusta bien.\n")
} else {
cat("Se rechaza H0: El modelo Poisson no se ajusta.\n")
}## Se rechaza H0: El modelo Poisson no se ajusta.4 Hours to Charge (240V)
horascarga240 <- datos$Hours.to.Charge..240V.
horascarga240 <- as.numeric(horascarga240)
horascarga240 <- horascarga240[!is.na(horascarga240) & horascarga240 > 0 & horascarga240 <= 10]
TDFhorascarga240 <- table(horascarga240)
TablaHoras240 <- as.data.frame(TDFhorascarga240)
colnames(TablaHoras240) <- c("Horas", "ni")
# Cálculo de frecuencia relativa y acumuladas
hi <- TablaHoras240$ni / sum(TablaHoras240$ni)
hi_porc <- round(hi * 100, 2)
Ni_asc <- cumsum(TablaHoras240$ni)
Ni_dsc <- rev(cumsum(rev(TablaHoras240$ni)))
Hi_asc <- cumsum(hi_porc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))
# Tabla final con todas las columnas
TablaFinalHoras240 <- data.frame(
Horas = TablaHoras240$Horas,
ni = TablaHoras240$ni,
hi_porc = hi_porc, # Renombrado de "hi(%)"
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
print(TablaFinalHoras240)## Horas ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 0.67 1 0.72 1 139 0.72 100.02
## 2 1.5 5 3.60 6 138 4.32 99.30
## 3 1.9 3 2.16 9 133 6.48 95.70
## 4 2 8 5.76 17 130 12.24 93.54
## 5 2.5 13 9.35 30 122 21.59 87.78
## 6 2.7 3 2.16 33 109 23.75 78.43
## 7 2.75 2 1.44 35 106 25.19 76.27
## 8 3 14 10.07 49 104 35.26 74.83
## 9 3.5 4 2.88 53 90 38.14 64.76
## 10 3.6 3 2.16 56 86 40.30 61.88
## 11 3.7 1 0.72 57 83 41.02 59.72
## 12 4 27 19.42 84 82 60.44 59.00
## 13 4.5 2 1.44 86 55 61.88 39.58
## 14 5 8 5.76 94 53 67.64 38.14
## 15 5.5 1 0.72 95 45 68.36 32.38
## 16 6 20 14.39 115 44 82.75 31.66
## 17 7 11 7.91 126 24 90.66 17.27
## 18 8 7 5.04 133 13 95.70 9.36
## 19 9.3 1 0.72 134 6 96.42 4.32
## 20 10 5 3.60 139 5 100.02 3.60# Gráfico de barras de frecuencias absolutas
barplot(TablaFinalHoras240$ni,
names.arg = TablaFinalHoras240$Horas,
main = "Gráfica No.22: Distribución
de Horas de Carga (240V)",
xlab = "Horas", ylab = "Frecuencia",
col = "lightblue",
las = 2,
cex.names = 0.6)
En este caso tambien agrupamos para mejor presentación de los modelos
4.1 Agrupado
# Limpieza y filtrado
horascarga240 <- as.numeric(datos$Hours.to.Charge..240V.)
horascarga240 <- horascarga240[!is.na(horascarga240) & horascarga240 > 0]
# Agrupación por rangos definidos manualmente
horas_grupo <- cut(horascarga240,
breaks = c(0.66, 1.9, 2.7, 3.5, 4, 5.5, 8, 10),
labels = c("0.67 - 1.9", "2 - 2.7", "2.75 - 3.5",
"3.6 - 4", "4.5 - 5.5", "6 - 8", "9.3 - 10"),
include.lowest = TRUE,
right = TRUE)
# Eliminar los NA que podrían haber surgido por valores fuera de los rangos
horas_grupo <- horas_grupo[!is.na(horas_grupo)]
# Tabla de frecuencias
tabla_freq <- as.data.frame(table(horas_grupo))
colnames(tabla_freq) <- c("RangoHoras", "ni")
# Cálculo de frecuencias relativas y acumuladas
tabla_freq$hi_porc <- round(tabla_freq$ni / sum(tabla_freq$ni) * 100, 2)
tabla_freq$Niasc <- cumsum(tabla_freq$ni)
tabla_freq$Nidsc <- rev(cumsum(rev(tabla_freq$ni)))
tabla_freq$Hiasc <- cumsum(tabla_freq$hi_porc)
tabla_freq$Hidsc <- rev(cumsum(rev(tabla_freq$hi_porc)))
print(tabla_freq)## RangoHoras ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 0.67 - 1.9 9 6.47 9 139 6.47 100.00
## 2 2 - 2.7 24 17.27 33 130 23.74 93.53
## 3 2.75 - 3.5 20 14.39 53 106 38.13 76.26
## 4 3.6 - 4 31 22.30 84 86 60.43 61.87
## 5 4.5 - 5.5 11 7.91 95 55 68.34 39.57
## 6 6 - 8 38 27.34 133 44 95.68 31.66
## 7 9.3 - 10 6 4.32 139 6 100.00 4.32# Gráfico de barras
barplot(tabla_freq$ni,
names.arg = tabla_freq$RangoHoras,
main = "Gráfica No.23: Distribución
de Horas de Carga (240V) Agrupadas",
xlab = "Rango de Horas", ylab = "Frecuencia",
col = "lightblue",
las = 2,
cex.names = 0.8)
Modelo Poisson:
observados <- tabla_freq$ni
medios <- c(1.285, 2.35, 3.125, 3.8, 5, 7, 9.65) # Aproximaciones de los puntos medios
media <- weighted.mean(medios, observados)
# Generar valores teóricos de Poisson
esperados_pois <- dpois(round(medios), lambda = media) * sum(observados)
esperados_pois <- round(esperados_pois, 2)
tabla_poisson <- data.frame(
Rango = tabla_freq$RangoHoras,
Observado = observados,
Esperado_Poisson = esperados_pois
)
print(tabla_poisson)## Rango Observado Esperado_Poisson
## 1 0.67 - 1.9 9 6.88
## 2 2 - 2.7 24 15.53
## 3 2.75 - 3.5 20 23.36
## 4 3.6 - 4 31 26.35
## 5 4.5 - 5.5 11 23.78
## 6 6 - 8 38 11.52
## 7 9.3 - 10 6 1.47# Gráfico comparativo
barplot(
rbind(observados, esperados_pois),
beside = TRUE,
col = c("lightblue", "tomato"),
names.arg = tabla_freq$RangoHoras,
main = "Gráfica No.24: Comparación Observado vs Esperado (Poisson)",
ylab = "Frecuencia",
legend.text = c("Observado", "Poisson"),
args.legend = list(x = "topright", bty = "n"),
las = 2,
cex.names = 0.75
)
# Correlación
correlacion <- cor(observados, esperados_pois)
cat("Coeficiente de correlación:", round(correlacion, 4), "\n")## Coeficiente de correlación: 0.3903plot(esperados_pois, observados,
main = "Gráfica No.25: Correlación entre
Frecuencias Observadas y Esperadas (Poisson)",
xlab = "Esperadas (Poisson)",
ylab = "Observadas",
pch = 19,
col = "darkgreen")
abline(lm(observados ~ esperados_pois), col = "red", lwd = 2) # Línea de tendencia
Modelo Binomial:
# Parámetros binomiales
n_bin <- nrow(tabla_freq) - 1 # n = número de ensayos
p_bin <- which.max(tabla_freq$ni) / nrow(tabla_freq) # probabilidad estimada
# Frecuencias esperadas
tabla_freq$esperados_bin <- dbinom(0:n_bin, size = n_bin, prob = p_bin) * sum(tabla_freq$ni)# Gráfico Observado vs Esperado
barplot(
rbind(tabla_freq$ni, tabla_freq$esperados_bin),
beside = TRUE,
col = c("blue", "pink"),
legend = c("Observada", "Esperada"),
names.arg = tabla_freq$X,
main = "Gráfica No.26: Distribución
Binomial - Horas de Carga Agrupadas",
xlab = "Rango de Horas", ylab = "Frecuencia"
)
# Correlación y gráfico
cor_bin <- cor(tabla_freq$ni, tabla_freq$esperados_bin)
plot(tabla_freq$esperados_bin, tabla_freq$ni,
main = "Gráfica No.27:
Correlación Experimental vs Teórica (Binomial)",
xlab = "Teórica (Binomial)", ylab = "Experimental",
pch = 19, col = "blue")
abline(lm(tabla_freq$ni ~ tabla_freq$esperados_bin), col = "red", lwd = 2)
text(min(tabla_freq$esperados_bin), max(tabla_freq$ni),
labels = paste("r =", round(cor_bin, 3)), pos = 4, col = "blue")
# Prueba Chi-cuadrado
x2_bin <- sum((tabla_freq$ni - tabla_freq$esperados_bin)^2 / tabla_freq$esperados_bin)
gl_bin <- length(tabla_freq$X) - 1
vc_bin <- qchisq(0.95, df = gl_bin)## Warning in qchisq(0.95, df = gl_bin): Se han producido NaNs## Chi-cuadrado (binomial): 82808.74## Valor crítico: NaN## [1] NA5 Hours to Charge (AC 240V)
horascarga240ac <- datos$Hours.to.Charge..AC.240V.
horascarga240ac <- as.numeric(horascarga240ac)
horascarga240ac <- horascarga240ac[!is.na(horascarga240ac) & horascarga240ac > 0]
# Tabla de frecuencias absolutas
TDFhorascarga240ac <- table(horascarga240ac)
TablaHoras240ac <- as.data.frame(TDFhorascarga240ac)
colnames(TablaHoras240ac) <- c("Horas", "ni")
# Cálculo de frecuencia relativa y acumuladas
hi <- TablaHoras240ac$ni / sum(TablaHoras240ac$ni)
hi_porc <- round(hi * 100, 2)
Ni_asc <- cumsum(TablaHoras240ac$ni)
Ni_dsc <- rev(cumsum(rev(TablaHoras240ac$ni)))
Hi_asc <- cumsum(hi_porc)
Hi_dsc <- rev(cumsum(rev(hi_porc)))
# Tabla final con todas las columnas
TablaFinalHoras240ac <- data.frame(
Horas = TablaHoras240ac$Horas,
ni = TablaHoras240ac$ni,
hi_porc = hi_porc,
Niasc = Ni_asc,
Nidsc = Ni_dsc,
Hiasc = Hi_asc,
Hidsc = Hi_dsc
)
print(TablaFinalHoras240ac)## Horas ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 2.5 1 2.17 1 46 2.17 99.99
## 2 3.75 7 15.22 8 45 17.39 97.82
## 3 4 1 2.17 9 38 19.56 82.60
## 4 4.75 33 71.74 42 37 91.30 80.43
## 5 5 3 6.52 45 4 97.82 8.69
## 6 7 1 2.17 46 1 99.99 2.17# Gráfico de barras de frecuencias absolutas
barplot(TablaFinalHoras240ac$ni,
names.arg = TablaFinalHoras240ac$Horas,
main = "Gráfica No.28:
Distribución de Horas de Carga (AC 240V)",
xlab = "Horas", ylab = "Frecuencia",
col = "lightblue",
las = 2,
cex.names = 0.6)
Asi mismo, se procuro hacer en grupos para poder expresar los modelos detalladamente:
5.1 Grupo 1
grupo1 <- horascarga240ac[horascarga240ac >= 2.5 & horascarga240ac <= 4]
# Tabla de frecuencias absolutas
tabla1 <- as.data.frame(table(grupo1))
colnames(tabla1) <- c("Horas", "ni")
# Frecuencias relativas y acumuladas
tabla1$hi_porc <- round(tabla1$ni / sum(tabla1$ni) * 100, 2)
tabla1$Niasc <- cumsum(tabla1$ni)
tabla1$Nidsc <- rev(cumsum(rev(tabla1$ni)))
tabla1$Hiasc <- cumsum(tabla1$hi_porc)
tabla1$Hidsc <- rev(cumsum(rev(tabla1$hi_porc)))
print(tabla1)## Horas ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 2.5 1 11.11 1 9 11.11 100.00
## 2 3.75 7 77.78 8 8 88.89 88.89
## 3 4 1 11.11 9 1 100.00 11.11# Gráfico grupo 1
barplot(tabla1$ni,
names.arg = tabla1$Horas,
main = "Gráfica No.29: Distribución de Horas de Carga (AC 240V)\nGrupo 1: 2.5 a 4",
xlab = "Horas", ylab = "Frecuencia",
col = "skyblue",
las = 2,
cex.names = 0.8)
Modelo Binomial:
# Redondear las horas para poder aplicar la binomial
grupo1 <- horascarga240ac[horascarga240ac >= 2.5 & horascarga240ac <= 4]
grupo1_red <- round(grupo1)
# Tabla de frecuencias
tabla_bin1 <- as.data.frame(table(grupo1_red))
colnames(tabla_bin1) <- c("X", "ni")
tabla_bin1$X <- as.numeric(as.character(tabla_bin1$X))
# Parámetros binomiales
n_bin1 <- max(tabla_bin1$X)
p_bin1 <- mean(grupo1_red) / n_bin1
# Frecuencias esperadas (binomial)
tabla_bin1$esperados_bin <- dbinom(tabla_bin1$X, size = n_bin1, prob = p_bin1) * sum(tabla_bin1$ni)# Gráfico Observado vs Esperado
barplot(
rbind(tabla_bin1$ni, tabla_bin1$esperados_bin),
beside = TRUE,
col = c("blue", "pink"),
legend = c("Observada", "Esperada"),
names.arg = tabla_bin1$X,
main = "Gráfica No.30: Distribución Binomial - Grupo 1",
xlab = "Horas redondeadas", ylab = "Frecuencia"
)
# Correlación y gráfico
cor_bin1 <- cor(tabla_bin1$ni, tabla_bin1$esperados_bin)
plot(tabla_bin1$esperados_bin, tabla_bin1$ni,
main = "Correlación Experimental vs Teórica (Binomial)",
xlab = "Teórica (Binomial)", ylab = "Experimental",
pch = 19, col = "blue")
abline(lm(tabla_bin1$ni ~ tabla_bin1$esperados_bin), col = "red", lwd = 2)
text(min(tabla_bin1$esperados_bin), max(tabla_bin1$ni),
labels = paste("r =", round(cor_bin1, 3)), pos = 4, col = "blue")
# Prueba Chi-cuadrado
x2_bin1 <- sum((tabla_bin1$ni - tabla_bin1$esperados_bin)^2 / tabla_bin1$esperados_bin)
gl_bin1 <- length(tabla_bin1$X) - 1
vc_bin1 <- qchisq(0.95, df = gl_bin1)
cat("Chi-cuadrado (binomial):", round(x2_bin1, 3), "\n")## Chi-cuadrado (binomial): 4.974## Valor crítico: 3.841if (x2_bin1 < vc_bin1) {
cat("No se rechaza H0: El modelo binomial se ajusta bien.\n")
} else {
cat("Se rechaza H0: El modelo binomial no se ajusta.\n")
}## Se rechaza H0: El modelo binomial no se ajusta.5.2 Grupo 2
grupo2 <- horascarga240ac[horascarga240ac >= 4.75 & horascarga240ac <= 7]
# Tabla de frecuencias absolutas
tabla2 <- as.data.frame(table(grupo2))
colnames(tabla2) <- c("Horas", "ni")
# Frecuencias relativas y acumuladas
tabla2$hi_porc <- round(tabla2$ni / sum(tabla2$ni) * 100, 2)
tabla2$Niasc <- cumsum(tabla2$ni)
tabla2$Nidsc <- rev(cumsum(rev(tabla2$ni)))
tabla2$Hiasc <- cumsum(tabla2$hi_porc)
tabla2$Hidsc <- rev(cumsum(rev(tabla2$hi_porc)))
print(tabla2)## Horas ni hi_porc Niasc Nidsc Hiasc Hidsc
## 1 4.75 33 89.19 33 37 89.19 100.00
## 2 5 3 8.11 36 4 97.30 10.81
## 3 7 1 2.70 37 1 100.00 2.70# Gráfico grupo 2
barplot(tabla2$ni,
names.arg = tabla2$Horas,
main = "Gráfica No.31:
Distribución de Horas de Carga (AC 240V) - Grupo 2",
xlab = "Horas", ylab = "Frecuencia",
col = "lightgreen",
las = 2,
cex.names = 0.8)
Modelo Geométrico:
grupo2 <- horascarga240ac[horascarga240ac >= 4.75 & horascarga240ac <= 7]
grupo2_red <- round(grupo2)
tabla_geom <- as.data.frame(table(grupo2_red))
colnames(tabla_geom) <- c("X", "ni")
tabla_geom$X <- as.numeric(as.character(tabla_geom$X))
# Parámetro de la distribución geométrica
# p = 1 / media
media_geom <- mean(grupo2_red)
p_geom <- 1 / media_geom
# Frecuencias esperadas (geométrica)
tabla_geom$esperados_geom <- dgeom(tabla_geom$X - min(tabla_geom$X), prob = p_geom) * sum(tabla_geom$ni)# Gráfico Observado vs Esperado
barplot(
rbind(tabla_geom$ni, tabla_geom$esperados_geom),
beside = TRUE,
col = c("green", "orange"),
legend = c("Observada", "Esperada"),
names.arg = tabla_geom$X,
main = "Gráfica No.32: Distribución Geométrica - Grupo 2",
xlab = "Horas redondeadas", ylab = "Frecuencia"
)
# Correlación y gráfico
cor_geom <- cor(tabla_geom$ni, tabla_geom$esperados_geom)
plot(tabla_geom$esperados_geom, tabla_geom$ni,
main = "Gráfica No.33: Correlación Experimental vs Teórica (Geométrica)",
xlab = "Teórica (Geométrica)", ylab = "Experimental",
pch = 19, col = "darkgreen")
abline(lm(tabla_geom$ni ~ tabla_geom$esperados_geom), col = "red", lwd = 2)
text(min(tabla_geom$esperados_geom), max(tabla_geom$ni),
labels = paste("r =", round(cor_geom, 3)), pos = 4, col = "darkgreen")
# Prueba Chi-cuadrado
x2_geom <- sum((tabla_geom$ni - tabla_geom$esperados_geom)^2 / tabla_geom$esperados_geom)
gl_geom <- length(tabla_geom$X) - 1
vc_geom <- qchisq(0.95, df = gl_geom)
cat("Chi-cuadrado (geométrica):", round(x2_geom, 3), "\n")## Chi-cuadrado (geométrica): 115.272## Valor crítico: 3.841if (x2_geom < vc_geom) {
cat("No se rechaza H0: El modelo geométrico se ajusta bien.\n")
} else {
cat("Se rechaza H0: El modelo geométrico no se ajusta.\n")
}## Se rechaza H0: El modelo geométrico no se ajusta.