Plantilla para los trabajos
Utiliza este documento para presentar las prácticas de una manera sencilla y bonita.
VIDEOS TRABAJO 1 LINK VIDEO DRIVE LINK VIDEO YOUTUBE
Supongamos que en una universidad hay dos facultades, Ciencias (C) y Humanidades (H), en las cuales estudian respectivamente el 60 % y el 40 % de los estudiantes. El porcentaje de estudiantes que practican deportes (D) en un momento determinado en dichas facultades es del 25 % y el 15 % respectivamente. Escogemos un estudiante al azar, calcula las siguientes probabilidades.
1. Que no pertenezca a la facultad de Ciencias.
La probabilidad de que pertenzca a la facultad de Ciencias es \(P(C)\), que como nos dice el enunciado es \(P(C)=0.6\), pues para que no pertenezca a la facultad de ciencias es \(P((C)')=1-P(C)=1-0.6=0.4\)
2. Que pertenezca a la facultad de Humanidades y practique deportes.
Como nos dice en el enunciado la probabilidad que pertenezca a la facultad de humanidades de \(P(H)=0.4\) y la probabilidad de que practique deporte siendo de la facultad de Humanidades es de \(P(D)=0.15\), por lo tanto \(P(H \cap D)=0.4 * 0.15 = 0.06\)
3. Que pertenezca a la facultad de Ciencias y practique deportes o a la facultad de Humanidades y no practique deportes.
Lo que nos pide en este apartado es calcular la probabilidad de que sea de la facultad de Ciencias y practique deportes, la probabilidad de que sea de la facultad de Ciencias es de \(P(C)=0.6\) y la probabilidad de que practique deporte siendo de la facultad de ciencias es de \(P(D)=0.25\).
Y tambien nos piden la probabilidad de que sea de la facultad de Humanidades y no practique deporte, la probabilidad de que sea de la facultad de Humanidades es de \(P(H)=0.4\) y la probabilidad de que no practique deporte siendo de la facultad de Humanidades es de \(P((D)')=1-0.15=0.85\).
Por lo que:
\(P(C \cap D) + P(H \cap (D)') =0.6 * 0.25 + 0.4 * 0.85 = 0.49\)
4. Que practique deportes.
Para calcular la probabilidad de que practique deporte lo que hay que hacer es calcular la probabilidad de que sea de la facultad de Ciencias y practique deporte y sumarselo a la probabilidad de que sea de la facultad de Humanidades y practique deporte. Por lo tanto:
\(P(D)=P(C \cap D) + P(H \cap D) =0.6 * 0.25 + 0.4 * 0.15 = 0.21\)
La media y los que de los pesos de 500 estudiantes de un colegio es 70 kg y la desviación típica 3 kg. Suponiendo que los pesos se distribuyen normalmente, hallar cuántos estudiantes pesan:
1. Entre 60 kg y 75 kg.
Como sabemos la distribucion normal esta formada por una media y una desviacion tipica, y se representa X~N(media,desviacion tipica), en este ejercicio lo que tenemos es X~N(70,3). Lo que nos esta pidiendo el apartado es \(P(60 \leq X \leq 75)\), hay 2 formas de plantear el apartado, tificando o haciendolo con comandos de r:
Con comandos de r \(P(60 \leq X \leq
75)=P(X\leq 75)-P(X \leq
60)\)=pnorm(75,70,3)-pnorm(60,70,3)= 0.9517806 todo
eso va a ser igual a 0.9517806, pero falta multiplicarlo por 500 que son
el numero de estudiantes a los que se le toma el peso, por lo que
0.9517806*500=475.8903.
Tipificando: Al tipificar lo que queremos conseguir es transformar N(media,desviacion tipica)–>N(0,1).
Para poder tipificar hay que hacer hacer lo siguiente: \((Z=\frac{x-media}{desviacion tipica})\)
Por lo tanto:
\(P(60 \leq X \leq 75)=P(\frac{60-70}{3} \leq Z \leq \frac{75-70}{3})\) = \(P(-3.33 \leq Z \leq 1.67)=P(Z \leq 1.67) - [1 - P(Z\leq 3.33)] = 0.9521061*500=476.053\)
Hacemos el \(1 - P(Z\leq 3.33)\)
para quitar el numero negativo y ponerlo positivo y se consigue \(P(Z \leq 1.67)\) y \(P(Z\leq 3.33)\) mediante
pnorm(1.67,0,1)= 0.9525403 y pnorm(3.33,0,1)=
0.9995658.
2. Más de 90 kg.
Este lo vamos a resolver con comandos de r:
\(P(X>90) = 1 -
P(X<90)\)=1-pnorm(90,70,3) Como pnorm(90,70,3) =
1, al hacer 1-pnorm(90,70,3)= 1-1=0 Por lo que al
multiplicarlo por los 500 estudiantes: 0*500=0
3. 64 kg exactamente.
Este lo vamos a resolver tipificando:
\(P(X=64)=P(Z=\frac{64-70}{3})=P(Z=-2)\)=dnorm(-2,0,1)=
0.053991 Al tipificar lo que queremos conseguir, como hemos visto en el
apartado 1 es media=0 y desviacion tipica = 1,
dnorm(-2,0,1)= 0.05399097, por lo que al multiplicarlo por
los 500 estudiantes quedaria: 0.05399097*500= 26.99548
4. Calcula la mediana y el cuartil del 10%.
La mediana ya nos la dan ya que en las distribuciones normales, la mediana es la media que nos dan por lo que la mediana = 70
Y para calcular el cuatil del 10% podemos hacer
qnorm(0.1,70,3)= 66.1553453
***
La base de datos HealthStatsEU recopila
información sobre diversos indicadores de salud para los países de la
Unión Europea. Estos indicadores incluyen la esperanza de vida al nacer
experanza_vida, el índice de obesidad
indice_obesidad, y el gasto per cápita en atención médica
gasto_medico. El objetivo es realizar un análisis
descriptivo de estos indicadores para comprender mejor la situación de
la salud en la región.
Lo primero es generar la base de datos
HealthStatsEU.
set.seed(123)
paises_ue <- c("España", "Francia", "Alemania", "Italia", "Portugal", "Suecia", "Finlandia", "Países Bajos", "Bélgica", "Dinamarca", "Austria", "Grecia", "Irlanda", "Polonia", "Hungría", "Eslovaquia", "República Checa", "Eslovenia", "Estonia", "Letonia", "Lituania", "Croacia", "Rumania", "Bulgaria", "Chipre")
HealthStatsEu<-data.frame(
pais = sample(paises_ue, 100, replace = TRUE),
esperanza_vida = rnorm(100, mean = 78, sd = 3),
indice_obesidad = rnorm(100, mean = 25, sd = 5),
gasto_medico = rnorm(100, mean = 3000, sd = 500)
)
1.- Calcula la media, mediana y rango de la esperanza de vida al nacer para los países de la Unión Europea.
media_esperanza_vida<- mean(HealthStatsEu$esperanza_vida)
mediana_esperanza_vida<- median(HealthStatsEu$esperanza_vida)
rango_esperanza_vida<- max(HealthStatsEu$esperanza_vida)
cat("Media de la esperanza de vida al nacer:", media_esperanza_vida, "\n")
## Media de la esperanza de vida al nacer: 77.94568
cat("Mediana de la esperanza de vida al nacer:", mediana_esperanza_vida,"\n")
## Mediana de la esperanza de vida al nacer: 77.96172
cat("Rango de la esperanza de vida al nacer:", rango_esperanza_vida, "\n\n")
## Rango de la esperanza de vida al nacer: 83.61425
2.- Construye un histograma y un diagrama de cajas para visualizar la distribución del índice de obesidad en la población de los países de la Unión Europea.
hist(HealthStatsEu$indice_obesidad, main = "Distribución del índice de obesidad en la UE", xlab = "Índice de obesidad", ylab = "Frecuencia")
boxplot(HealthStatsEu$indice_obesidad)
3.- Calcula la desviación estándar, el coeficiente y muestra los cuantiles de variación del gasto per cápita en atención médica para los países de la Unión Europea.
desviacion_gastos<-sd(HealthStatsEu$gasto_medico)
coeficiente_variacion_gasto<-desviacion_gastos/mean(HealthStatsEu$gasto_medico)
cuantiles<- quantile(HealthStatsEu$gasto_medico,probs = c(0, 0.25, 0.50, 0.75, 1))
cat("Desviación estándar del gasto per cápita en atención médica:", desviacion_gastos, "\n")
## Desviación estándar del gasto per cápita en atención médica: 492.602
cat("Coeficiente de variación del gasto per cápita en atención médica:", coeficiente_variacion_gasto, "\n\n")
## Coeficiente de variación del gasto per cápita en atención médica: 0.1647429
cat("Los cuantiles son:\n")
## Los cuantiles son:
print(cuantiles)
## 0% 25% 50% 75% 100%
## 1660.142 2676.084 3050.555 3357.599 4229.784
4.- Presenta una tabla de frecuencias absolutas y relativas para mostrar la cantidad de países que tienen diferentes rangos de esperanza de vida al nacer (por ejemplo, de 70 a 75 años, de 75 a 80 años, etc.) en la Unión Europea.
rangos_esperanza_vida <- cut(HealthStatsEu$esperanza_vida, breaks = seq(70,90, by = 5))
tabla_frecuencia <- table(rangos_esperanza_vida)
tabla_frecuencia_absoluta <- as.data.frame(table(rango_esperanza_vida))
tabla_frecuencia_relativa <- prop.table(table(rangos_esperanza_vida))
cat("Tabla de frecuencias absolutas de la esperanza de vida al nacer:\n")
## Tabla de frecuencias absolutas de la esperanza de vida al nacer:
print(tabla_frecuencia_absoluta)
## rango_esperanza_vida Freq
## 1 83.6142540156332 1
cat("\nTabla de frecuencias relativas de la esperanza de vida al nacer:\n")
##
## Tabla de frecuencias relativas de la esperanza de vida al nacer:
print(tabla_frecuencia_relativa)
## rangos_esperanza_vida
## (70,75] (75,80] (80,85] (85,90]
## 0.11 0.68 0.21 0.00
[VIDEOS TRABAJO 2] LINK VIDEO DRIVE LINK VIDEO YOUTUBE
Supongamos que en una granja solar (denominada Y), la producción diaria de energía (en megavatios hora, MWh) sigue una distribución normal con una media de 1200 MWh y una desviación estándar de 150 MWh.
1. Calcular la probabilidad de que la producción diaria de energía en Y sea mayor de 1300 MWh, dado que es mayor de 1100 MWh.
El el ejercicio seguimos una distribucion normal con una media=1200 y una desviacion tipica=150 -> N(1200,150)
Lo que nos pide en este apartado es calcular la probabilidad de que la granja produzca mas de 1300Mwh sabiendo que produce 1100 Mwh, de ahi sacamos la siguiente interseccion \(P(Y>1300) \cap P(Y>1100)\) y se lo devidimos a la probabilidad de que sea mayor de 1100. Como no se pueden calcular valores mayores, hacemos \(1-pnorm(1300,1200,150)\) y \(1-pnorm(1100,1200,150)\) y sale la siguiente operacion:
\(P(Y>1300 / Y>1100) = \frac{P(Y>1300) \cap P(Y>1100)}{P(Y>1100)}\)\(=\frac{P(1100>Y>1300)}{P(Y>1100)}\)\(=\frac{1-pnorm(1300,1200,150)}{1-pnorm(1100,1200,150)}=\)\(0.2524925/0.7475075=0.3377793\)
2. Calcular la probabilidad de que la producción diaria de energía en Y sea menor de 1000 MWh.
Para calcular la probabilidad de que Y produzca menos de 1000 Mwh se hace con la siguiente expresion:
\(P(Y<1000)=pnorm(1000,1200,150)=0.09121122\)
La probabilidad de que produzca menos de 1000 Mwh es de 0.09121122
3. Calcular la probabilidad de que la producción diaria de energía en Y se encuentre entre 1000 MWh y 1400 MWh.
Para saber si la granja puede producir diariamente entre 1000 MWh y 1400 MWh se hace con la siguiente expresion:
\(P(1000<Y<1400)=P(Y<1400)-P(Y<1000)=pnorm(1400,1200,150)-pnorm(1000,1200,150)=0.9087888-0.09121122=0.8175776\)
La probabilidad de que produzca diariamente entre 1000 MWh y 1400 MWh es de 0.8175776
4. Si se toma una muestra aleatoria de 50 días de producción, calcular la probabilidad de que la media de esta muestra sea mayor de 1220 MWh.
Como se toma una muestra aleatoria con n=50 la desviacion tipica cambia quedandose la siguiente distribucion normal \(N(1200,150/sqrt(50))\)
Nor pide calcular la probabilidad de que en esos 50 dias, la produccion sea mayor de 1220 Mwh y se hace con la siguiente expresion:
\(P(Y>1220)=1-pnorm(1220,1200,150/sqrt(50))=1-0.8271107=0.1728893\)
Un grupo de estudiantes de una universidad está interesado en determinar cuál método de estudio es más efectivo para mejorar el rendimiento académico en un examen de estadística. Se seleccionaron dos grupos de estudiantes y cada grupo utilizó un método de estudio diferente. Los puntajes obtenidos en el examen de estadística por cada grupo de estudiantes fueron los siguientes:
Grupo 1(Método A): 7.5, 8.1, 7.2, 8.0, 7.5, 7.0, 7.9, 8.5
Grupo 2(Método B): 7.9, 7.5, 7.7, 8.4, 8.3, 7.1, 7.3, 8.1
Parte 1: Prueba de Wilcoxon-Mann-Whitney
-Utiliza un test de Wilcoxon-Mann-Whitney para contrastar si hay una diferencia en el rendimiento académico entre los dos métodos de estudio, con un nivel de significancia α = 0.05.
-Determina el valor p asociado.
-Toma una decisión sobre si rechazar o no la hipótesis nula.
Parte 2: Comparación con un test t
-Considera qué conclusión se obtendría si se pudiera utilizar un test t para comparar los dos métodos de estudio en lugar del test de Wilcoxon-Mann-Whitney.
-¿Cuál sería la hipótesis nula y la hipótesis alternativa en este caso?
-¿Cuál sería la decisión basada en un test t con un nivel de significancia α = 0.05?
1º Paso:
Almacenos los datos dentro de cada una de las variables:
grupoA <- c(7.5, 8.1, 7.2, 8.0, 7.5, 7.0, 7.9, 8.5)
grupoB <- c(7.9, 7.5, 7.7, 8.4, 8.3, 7.1, 7.3, 8.1)
2º Paso:
Parte 1:Realizamos las prueba de Wilcoxon-Mann-Whitney
resultadoWicoxon <- wilcox.test(grupoA, grupoB, alternative = "two.sided")
## Warning in wilcox.test.default(grupoA, grupoB, alternative = "two.sided"):
## cannot compute exact p-value with ties
print(resultadoWicoxon);
##
## Wilcoxon rank sum test with continuity correction
##
## data: grupoA and grupoB
## W = 29, p-value = 0.792
## alternative hypothesis: true location shift is not equal to 0
Con el resultado obtenido podemos verificar lo siguiente:
1º Debido al que el p-value es mayor que α las diferencias son debidas al azar
2º El valor de p-value es igual a 0.792
3º No podemos rechazar la hipótesis nula. No hay suficiente evidencia para concluir que hay una diferencia significativa en el rendimiento académico entre los dos métodos de estudio.
resultadoT <- t.test(grupoA, grupoB,alternative = "two.sided")
print(resultadoT)
##
## Welch Two Sample t-test
##
## data: grupoA and grupoB
## t = -0.30907, df = 13.949, p-value = 0.7618
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.5956338 0.4456338
## sample estimates:
## mean of x mean of y
## 7.7125 7.7875
Con el resultado obtenido odemos verificar lo siguiente:
1º Si se utilizara un test t para comparar los dos métodos de estudio en lugar del test de Wilcoxon-Mann-Whitney, se asumiría que los datos siguen una distribución normal.Sin embargo, como en muchos casos la distribución de los puntajes puede no ser normal, el test de Wilcoxon-Mann-Whitney es preferible ya que es no paramétrico y no hace suposiciones sobre la distribución de los datos.
2º La hipotesis nula seria que no hay diferencia significativa entre los dos métodos de estudio y la hipotesis Alternativa seria que hay una diferencia significativa entre los dos métodos de estudio
3º Con el p-value obtenido con el t test nos indica que no tendríamos suficiente evidencia para rechazar la hipótesis nula y no podríamos concluir que hay una diferencia significativa entre los dos métodos de estudio.
Supongamos que queremos determinar si hay una diferencia en el promedio de puntos anotados por un equipo de la NFL en la primera mitad de la temporada en comparación con la segunda mitad de la temporada. La hipótesis nula (H0) sería que no hay diferencia en los promedios de puntos (μ1 = μ2), mientras que la hipótesis alternativa (H1) sería que hay una diferencia en los promedios de puntos (μ1 ≠ μ2).Teniendo en cuenta un α = 0.05
1º Paso:
Generamos los datos ficticios para puntos anotados por el equipo en la temporada completa
set.seed(123) # Para reproducibilidad
puntos_temporada <- c(rnorm(16, mean = 25, sd = 5), rnorm(16, mean = 30, sd = 5)) # Simulación de puntos anotados en la temporada
2º Paso:
Dividimos los datos en la primera y segunda mitad de la temporada
puntos_primera_mitad <- puntos_temporada[1:16]
puntos_segunda_mitad <- puntos_temporada[17:32]
3º Paso:
Realizamos la pruba t test de dos muestras
resultado <- t.test(puntos_primera_mitad, puntos_segunda_mitad, alternative = "two.sided", var.equal = TRUE)
4º Paso:
Imprimimos el resultado
print(resultado)
##
## Two Sample t-test
##
## data: puntos_primera_mitad and puntos_segunda_mitad
## t = -1.2624, df = 30, p-value = 0.2165
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -5.377127 1.269050
## sample estimates:
## mean of x mean of y
## 26.27271 28.32675
Conclusión:
Como el p-value = 0.2165 > 0.05 podemos decir que no tenemos evidencia suficiente para rechazar la hipótesis nula. Por lo tanto, no podemos concluir que haya una diferencia significativa en el promedio de puntos anotados por el equipo de la NFL entre la primera mitad y la segunda mitad de la temporada.
[VIDEOS TRABAJO 3] LINK VIDEO DRIVE LINK VIDEO YOUTUBE
En un entorno de investigación científica, la velocidad de respuesta cognitiva es un factor crítico en diversas áreas, desde la psicología hasta la neurociencia. Estamos interesados en investigar la eficacia de dos métodos de entrenamiento cognitivo: el Método Tradicional y el Método de Estimulación Cerebral No Invasiva (ECNI), para mejorar la velocidad de respuesta cognitiva en una población de adultos jóvenes.
Hipótesis Nula (H0): No hay diferencia significativa en la velocidad de respuesta cognitiva entre los participantes entrenados con el Método Tradicional y los entrenados con el Método de ECNI.
Hipótesis Alternativa (H1): Existe una diferencia significativa en la velocidad de respuesta cognitiva entre los participantes entrenados con el Método Tradicional y los entrenados con el Método de ECNI.
Observa las diferencias entre paramétrica y no paramétrica
1º Paso:
Generamos los datos ficticios para puntos anotados por el equipo en la temporada completa
set.seed(123)
velocidad_tradicional <- rnorm(50, mean = 250, sd = 50)
velocidad_ECNI <- rnorm(50, mean = 275, sd = 45)
2º Paso:
Realizamos la pruba t test de dos muestras, en este caso sería la prueba paramétrica
t_test_result <- t.test(velocidad_tradicional, velocidad_ECNI)
print("Prueba t de Student:")
## [1] "Prueba t de Student:"
print(t_test_result)
##
## Welch Two Sample t-test
##
## data: velocidad_tradicional and velocidad_ECNI
## t = -3.4247, df = 96.445, p-value = 0.0009055
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -47.17927 -12.55712
## sample estimates:
## mean of x mean of y
## 251.7202 281.5884
3º Paso:
Realizamos la pruba Wilcoxon-Mann-Whitney de dos muestras, en este caso sería la prueba no paramétrica
wilcox_test_result <- wilcox.test(velocidad_tradicional, velocidad_ECNI)
print("Prueba de Wilcoxon-Mann-Whitney:")
## [1] "Prueba de Wilcoxon-Mann-Whitney:"
print(wilcox_test_result)
##
## Wilcoxon rank sum test with continuity correction
##
## data: velocidad_tradicional and velocidad_ECNI
## W = 770, p-value = 0.0009478
## alternative hypothesis: true location shift is not equal to 0
Conclusión: Al usar la prueba t de Student, asumimos que los datos siguen una distribución normal y que las varianzas de ambos son iguales. La prueba de Wilcoxon-Mann-Whitney, por otro lado, no asume una distribución particular de los datos, lo que la hace más robusta frente a violaciones de la normalidad. Sin embargo, requiere que las muestras sean independientes y que los datos sean al menos de escala ordinal. Ambas pruebas arrojan valores de p significativamente bajos (menores que 0.05), lo que indica que hay evidencia suficiente para rechazar la hipótesis nula en ambos casos.
En el crash test, prueba que comprueba el rendimiento de los sistemas de seguridad del vehículo, se han puesto a prueba 3 marcas de coche diferentes, Audi, Seat y BMW, para comprobar su seguridad. Se han realizado varias veces los test opteniendo varias puntuaciones cada marca, opteniendo las siguientes puntuaciones sobre 100 en la siguiente tabla
| Marca | Puntuaciones |
|-------------------|---------------------------|
| Audi | 75 79 90 85 63 |
| Seat | 71 59 90 79 94 |
| BMW | 57 89 87 74 79 |
Para contestar a la pregunta haremos un analisis de la varianza, ya que se cumplen las condiciones para ello. El contraste que planteamos es el de igualdad de medias para los 3 grupos:
H0 : µAudi = µSeat = µBMW
H1 : No todas las medias son iguales
En este caso, tenemos 3 grupos (b=numero de grupos) y 15 observaciones (n=numero de observaciones) Ponemos en la variable datos todos los datos juntos.
datos=c(75,79,90,85,63,71,59,90,79,94,57,89,87,74,79)
Y en la variable marca creamos un factor que va a crear 3 niveles (Audi, Seat y BMW) y lo va a repetir el numero de veces que aparezcan esos datos, en este caso 5 cada uno.
marca=factor(c(rep("Audi",5),rep("Seat",5),rep("BMW",5)))
Hacemos el siguiente comando para obtener los de la fila ‘Entre Grupos’ y ‘Dentro Grupos’ de la tabla de anova. El de la fila total el la suma de las otras 2 filas.
summary(aov(datos~marca))
summary(aov(datos~marca))
## Df Sum Sq Mean Sq F value Pr(>F)
## marca 2 5.7 2.87 0.018 0.982
## Residuals 12 1893.2 157.77
Con este comendo obtenemos lo que vale solo el estadistico test de la tabla de anova. summary(aov(datos~marca))[[1]]$‘F value’
summary(aov(datos~marca))[[1]]$'F value'
## [1] 0.01817029 NA
summary(aov(datos~marca))[[1]]$‘Pr(>F)’
summary(aov(datos~marca))[[1]]$'Pr(>F)'
## [1] 0.9820208 NA
| Variacion |Grado de |Suma de |Cuadrados |Fs |P-Valor |
| |Libertad |Cuadrados |Medios | | |
|-------------------|--------------|---------------------|--------------------|---------------|----------|
| Entre Grupos | b-1=3-1=2 | 5.7 | 5.7/2=2.87 | 0.018 | 0.982 |
|-------------------|--------------|---------------------|--------------------|---------------|----------|
| Dentro Grupos | n-b=15-3=12 | 1893.2 | 1893.2/12=157.77 | | |
|-------------------|--------------|---------------------|--------------------|---------------|----------|
| Total | n-1=15-1=14 | 2032.4 | | | |
Al comparar los resultados obtenidos y sacar el estadistico test F0.05,2,12(qf(1-0.05,2,12)), Vemos que como α = 0.05 se cumple que F0.05,2,12 ≈ 3.885294 y Fs ≈ 0.01817029, Entonces Fs=0.01817029 ≤ F0.05,2,12=3.885294 aceptamos la hipótesis nula y concluimos que no hay diferencia significativa entre las tres marcas.
Otra manera de comprobarlo es comprobar el P-valor. El P-Valor=0.9820208 y como es mayor que α = 0.05 aceptamos la hipótesis nula y concluimos que no hay diferencia significativa entre las tres marcas.
Con esto podemos obtener el diagrama de cajas de los datos y las marcas y compararlos
boxplot(datos~marca)
En un estudio sobre los factores que afectan al consumo de helado, se recopilaron datos sobre la temperatura ambiental y las ventas diarias de helado en una heladería durante un período de varios meses. El objetivo es investigar la relación entre la temperatura y el consumo de helado y predecir las ventas futuras en función de la temperatura.
1º Paso:
Generamos todos los datos
set.seed(123)
temperatura <- rnorm(100, mean = 25, sd = 5)
ventas_helado <- 50 + 2 * temperatura + rnorm(100, mean = 0, sd = 10)
summary(temperatura)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 13.45 22.53 25.31 25.45 28.46 35.94
summary(ventas_helado)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 70.67 90.15 100.52 99.83 109.69 128.80
2º Paso:
Visualizamos los datos con un diagrama de dispersión de temperatura vs venta de helado
plot(temperatura, ventas_helado, main = "Relación entre Temperatura y Ventas de Helado", xlab = "Temperatura (°C)", ylab = "Ventas de Helado")
3º Paso:
Ajustamos un modelo de regresión lineal
modelo <- lm(ventas_helado ~ temperatura)
summary(modelo)
##
## Call:
## lm(formula = ventas_helado ~ temperatura)
##
## Residuals:
## Min 1Q Median 3Q Max
## -19.073 -6.835 -0.875 5.806 32.904
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 51.5956 5.5265 9.336 3.34e-15 ***
## temperatura 1.8951 0.2138 8.865 3.50e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.707 on 98 degrees of freedom
## Multiple R-squared: 0.4451, Adjusted R-squared: 0.4394
## F-statistic: 78.6 on 1 and 98 DF, p-value: 3.497e-14
4º Paso:
Predición de las ventas futuras
temperatura_futura <- rnorm(30, mean = 25, sd = 5)
predicciones<-predict(modelo, newdata = data.frame(temperatura = temperatura_futura))
data.frame(temperatura = temperatura_futura, ventas_predichas = predicciones)
## temperatura ventas_predichas
## 1 35.99405 119.80632
## 2 31.56206 111.40745
## 3 23.67427 96.45964
## 4 27.71597 104.11889
## 5 22.92830 95.04598
## 6 22.61877 94.45939
## 7 21.05699 91.49973
## 8 22.02691 93.33780
## 9 33.25454 114.61479
## 10 24.72986 98.46004
## 11 25.59623 100.10185
## 12 26.21844 101.28098
## 13 31.16238 110.65003
## 14 22.41968 94.08212
## 15 20.03746 89.56768
## 16 33.37848 114.84967
## 17 22.79418 94.79182
## 18 21.38467 92.12071
## 19 18.81863 87.25793
## 20 18.57642 86.79892
## 21 22.13013 93.53341
## 22 28.08993 104.82756
## 23 30.54924 109.48810
## 24 28.53794 105.67657
## 25 23.18171 95.52621
## 26 25.29875 99.53812
## 27 21.47702 92.29572
## 28 21.41391 92.17612
## 29 29.42325 107.35428
## 30 19.92204 89.34894