Plantilla para los trabajos

Utiliza este documento para presentar las prácticas de una manera sencilla y bonita.


                                          VIDEOS

VIDEOS TRABAJO 1 LINK VIDEO DRIVE LINK VIDEO YOUTUBE

[VIDEOS TRABAJO 2] LINK VIDEO DRIVE LINK VIDEO YOUTUBE

[VIDEOS TRABAJO 3] LINK VIDEO DRIVE LINK VIDEO YOUTUBE

[VIDEOS BANCO DE DATOS] LINK VIDEO DRIVE LINK VIDEO YOUTUBE

VIDEOS TRABAJO 1 LINK VIDEO DRIVE LINK VIDEO YOUTUBE

Probabilidad

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\)


Variable aleatoria

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

***

Estadística descriptiva

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

Tema 2

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\)



Contraste de hipotesis

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.


Contraste de hipotesis

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

Contraste de hipótesis, paramétrico y no paramétrico

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.

Anova

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        |
  1. A la vista de estos resultados, ¿puede inferirse que existen diferencias significativas entre las tres marcas a nivel de significación alpha=0.05?

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)

Regresión lineal

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

[VIDEOS BANCO DE DATOS] LINK VIDEO DRIVE LINK VIDEO YOUTUBE

Banco de datos

Para la elaboracion de este trabjo nos hemos descargado un archivo .csv que contiene una serie de datos sobre el vino

Lo primero es almacenar estos datos en datos_vino

datos_vinos<-read.csv(file.choose()) #cuando se abra el menú elegimos el archivo necesario

También en un primer momento podemos hacer un summary para ver un pequño resumen de los datos con los que estamos trabajando

summary(datos_vinos)
##        X            country          description        designation       
##  Min.   :     0   Length:150930      Length:150930      Length:150930     
##  1st Qu.: 37732   Class :character   Class :character   Class :character  
##  Median : 75465   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 75465                                                           
##  3rd Qu.:113197                                                           
##  Max.   :150929                                                           
##                                                                           
##      points           price           province           region_1        
##  Min.   : 80.00   Min.   :   4.00   Length:150930      Length:150930     
##  1st Qu.: 86.00   1st Qu.:  16.00   Class :character   Class :character  
##  Median : 88.00   Median :  24.00   Mode  :character   Mode  :character  
##  Mean   : 87.89   Mean   :  33.13                                        
##  3rd Qu.: 90.00   3rd Qu.:  40.00                                        
##  Max.   :100.00   Max.   :2300.00                                        
##                   NA's   :13695                                          
##    region_2           variety             winery         
##  Length:150930      Length:150930      Length:150930     
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
## 

Vamos a obtener los paises con más vino presentado al concurso

contarPais <- table(datos_vinos$country)

contarPais <- data.frame(country = names(contarPais), cuenta = as.integer(contarPais))
contarPais <- contarPais[order(-contarPais$cuenta),]

top10_paises <- head(contarPais, 10)

pie(top10_paises$cuenta, main = "Top 10 países con más vino", labels = top10_paises$country)

print(top10_paises)
##        country cuenta
## 48          US  62397
## 24       Italy  23478
## 17      France  21098
## 42       Spain   8268
## 10       Chile   5816
## 3    Argentina   5631
## 35    Portugal   5322
## 4    Australia   4957
## 34 New Zealand   3320
## 5      Austria   3057

Provincias españolas que han pesentado vino candidato al concurso y observamos si existe relacion entre la provincia y el precio de los vinos

library(ggplot2)
datos_espana <- datos_vinos[datos_vinos$country == "Spain", ]

ggplot2::ggplot(datos_espana, aes(x = province, y = price)) +
  geom_point(alpha = 0.5) +
  labs(title = "Precio del vino por provincia en España",
       x = "Provincia",
       y = "Precio del vino") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
## Warning: Removed 108 rows containing missing values or values outside the scale range
## (`geom_point()`).

Vamos a trabajar es ver si hay relacion entre los puntos conseguido en el concurso y el precio de la botella

Hipótesis nula (H0): No hay relación entre los puntos obtenidos por un vino en el concurso y su precio.

Hipótesis alternativa (H1): Los vinos con más puntos tienden a tener un precio más alto que los vinos con menos puntos

cor.test(datos_vinos$points,datos_vinos$price)
## 
##  Pearson's product-moment correlation
## 
## data:  datos_vinos$points and datos_vinos$price
## t = 191.84, df = 137233, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.4556814 0.4640252
## sample estimates:
##       cor 
## 0.4598634
plot(datos_vinos$points~datos_vinos$price)
abline(lm(datos_vinos$points~datos_vinos$price))

Conclusion El resultado de la prueba de correlación muestra un valor p extremadamente pequeño, prácticamente cero (p < 2.2e-16), lo que indica que hay una correlación significativa entre los puntos obtenidos por un vino en el concurso y su precio. Además, el coeficiente de correlación de Pearson es de aproximadamente 0.46, lo que sugiere una correlación positiva moderadamente fuerte entre estas dos variables.

Por lo tanto, con base en estos resultados, rechazaríamos la hipótesis nula que afirmaba que no hay relación entre los puntos y el precio de los vinos. En su lugar, aceptaríamos la hipótesis alternativa, que sugiere que los vinos con más puntos tienden a tener un precio más alto que los vinos con menos puntos.

Ahora vamos a realizar un modelo de regresión lineal que prediga el precio del vino en funcion de las características.

modelo_regresion <- lm(price ~ points + variety + province, data = datos_vinos)
nuevos_datos <- data.frame(points = c(90, 85, 95), variety = c("Chardonnay", "Merlot", "Cabernet Sauvignon"), province = c("California", "Bordeaux", "Tuscany"))
predict(modelo_regresion, nuevos_datos)
##        1        2        3 
## 40.24103 17.95002 81.79203

Conclusion Para el vino con 90 puntos, variedad Chardonnay y provincia California, la predicción del precio es de aproximadamente 40.24 unidades monetarias.

Para el vino con 85 puntos, variedad Merlot y provincia Bordeaux, la predicción del precio es de aproximadamente 17.95 unidades monetarias.

Para el vino con 95 puntos, variedad Cabernet Sauvignon y provincia Tuscany, la predicción del precio es de aproximadamente 81.79 unidades monetarias.