Parcial 1

1. Muestra aleatoria de 200 datos.

A continuación, se ha tomado una muestra aleatoria de 200 datos de la base de datos ‘Olimpicos Atenas 2004.xlsx’. Esta base nos presenta una variedad de información, incluyendo detalles sobre los participantes, sus nacionalidades, altura, peso, género, entre otros.

library(readxl)
#Primero vamos a importar la base de datos de excel y la cargamos

Olimpicos_Atenas_2004 <- read_excel("C:/Users/Acer/Desktop/4TO SEMESTRE/P. y E. Fundamental/Parcial/Olimpicos Atenas 2004.xlsx")
View(Olimpicos_Atenas_2004)

set.seed(2489)

#Le asignamos el Excel a el objeto llamado "Datos.olimpico"

Datos.olimpico <- Olimpicos_Atenas_2004

Datos.olimpico 

Para la primera parte, debemos descartar columnas de variables que no serán tan relevantes en nuestro análisis estadístico de la base de datos.

Las columnas eliminadas serán: ‘ID’, ‘NOC’, ‘GAMES’, ‘YEAR’, ‘SEASON’ y ‘CITY’.

muestra2 <- Datos.olimpico[sample(nrow(Datos.olimpico),size=200),-c(1,8,9,10,11,12)] 

muestra2

2. Dataframe de Paises - Sexo

En esta segunda parte, creamos una tabla seleccionando únicamente los vectores asignados, que son ‘Team’ y ‘Sex’. Con esta tabla, debemos convertirla en un dataframe para así lograr tener una tabla de frecuencias con estos dos vectores relacionados entre sí.

library(readxl)

ubi_archivo <-  muestra2


df_1 <-  table(ubi_archivo$Sex, ubi_archivo$Team)

df_1 <- as.data.frame(df_1)

df_1

3. Frecuencia absoluta de medallería por países.

En la tercera parte, debemos relacionar las variables ‘Países’ y ‘Medallas’ con el fin de determinar cuántas medallas ganó cada país y qué tipo de medallas obtuvo. En esta sección, contamos con tres tipos: Oro, Plata y Bronce.

library(dplyr, warn.conflicts = FALSE)
fabs2 <- table(muestra2$Team,muestra2$Medal)

fabs2
##                                 
##                                  Bronze Gold NA Silver
##   Algeria                             0    0  2      0
##   Antigua and Barbuda                 0    0  1      0
##   Australia                           0    3  5      1
##   Azerbaijan                          0    0  1      0
##   Bahamas                             0    0  1      0
##   Bangladesh                          0    0  1      0
##   Belarus                             0    0  5      0
##   Belgium                             0    0  1      0
##   Bermuda                             0    0  1      0
##   Brazil                              0    0  3      0
##   Bulgaria                            0    0  2      0
##   Canada                              0    0  3      0
##   Chile                               0    0  1      0
##   China                               0    1  7      0
##   China-2                             0    0  2      0
##   Chinese Taipei                      0    0  4      0
##   Cook Islands                        0    0  1      0
##   Cote d'Ivoire                       0    0  1      0
##   Croatia                             0    0  1      0
##   Cyprus                              0    0  1      0
##   Czech Republic                      0    0  3      0
##   Czech Republic-1                    1    0  0      0
##   Denmark                             0    0  1      0
##   Denmark-2                           0    0  1      0
##   Dominican Republic                  0    0  1      0
##   Egypt                               0    0  1      0
##   El Salvador                         0    0  1      0
##   Estonia                             0    0  2      0
##   Federated States of Micronesia      0    0  1      0
##   Fiji                                0    0  1      0
##   France                              0    0  4      0
##   Germany                             1    0  9      0
##   Germany-1                           0    0  0      1
##   Great Britain                       0    0  2      0
##   Greece                              1    0  6      0
##   Hong Kong                           0    0  2      0
##   Hungary                             0    1  3      1
##   Ireland                             0    0  1      0
##   Italy                               0    0  7      1
##   Japan                               0    0  3      0
##   Kyrgyzstan                          0    0  1      0
##   Latvia                              0    0  1      0
##   Lithuania                           0    0  1      0
##   Macedonia                           0    0  1      0
##   Malaysia                            0    0  1      0
##   Maldives                            0    0  1      0
##   Mauritius                           0    0  1      0
##   Mexico                              0    0  4      0
##   Moldova                             0    0  1      0
##   Netherlands                         0    0  0      1
##   New Zealand                         0    0  3      0
##   Nigeria-2                           0    0  1      0
##   North Korea                         0    0  2      0
##   Philippines                         0    0  3      0
##   Poland                              0    1  2      0
##   Portugal                            0    0  2      0
##   Romania                             0    0  3      0
##   Russia                              1    0  7      1
##   Singapore                           0    0  2      0
##   Slovenia                            0    0  3      0
##   South Africa                        0    2  2      0
##   South Korea                         0    1  5      1
##   South Korea-1                       0    0  0      1
##   Spain                               0    0  7      0
##   Sweden                              0    0  3      0
##   Switzerland                         0    0  5      0
##   Tajikistan                          0    0  1      0
##   Thailand                            0    0  1      0
##   Tunisia                             0    0  1      0
##   Turkey                              0    0  3      0
##   Ukraine                             0    1  3      0
##   United States                       0    1  6      1
##   Uruguay                             0    0  2      0
##   Uzbekistan                          0    0  3      0
##   Venezuela                           0    0  1      0
frecuencia_absoluta_con_suma <- addmargins(fabs2, FUN = list(Total = sum))
## Margins computed over dimensions
## in the following order:
## 1: 
## 2:
frecuencia_absoluta_con_suma
##                                 
##                                  Bronze Gold  NA Silver Total
##   Algeria                             0    0   2      0     2
##   Antigua and Barbuda                 0    0   1      0     1
##   Australia                           0    3   5      1     9
##   Azerbaijan                          0    0   1      0     1
##   Bahamas                             0    0   1      0     1
##   Bangladesh                          0    0   1      0     1
##   Belarus                             0    0   5      0     5
##   Belgium                             0    0   1      0     1
##   Bermuda                             0    0   1      0     1
##   Brazil                              0    0   3      0     3
##   Bulgaria                            0    0   2      0     2
##   Canada                              0    0   3      0     3
##   Chile                               0    0   1      0     1
##   China                               0    1   7      0     8
##   China-2                             0    0   2      0     2
##   Chinese Taipei                      0    0   4      0     4
##   Cook Islands                        0    0   1      0     1
##   Cote d'Ivoire                       0    0   1      0     1
##   Croatia                             0    0   1      0     1
##   Cyprus                              0    0   1      0     1
##   Czech Republic                      0    0   3      0     3
##   Czech Republic-1                    1    0   0      0     1
##   Denmark                             0    0   1      0     1
##   Denmark-2                           0    0   1      0     1
##   Dominican Republic                  0    0   1      0     1
##   Egypt                               0    0   1      0     1
##   El Salvador                         0    0   1      0     1
##   Estonia                             0    0   2      0     2
##   Federated States of Micronesia      0    0   1      0     1
##   Fiji                                0    0   1      0     1
##   France                              0    0   4      0     4
##   Germany                             1    0   9      0    10
##   Germany-1                           0    0   0      1     1
##   Great Britain                       0    0   2      0     2
##   Greece                              1    0   6      0     7
##   Hong Kong                           0    0   2      0     2
##   Hungary                             0    1   3      1     5
##   Ireland                             0    0   1      0     1
##   Italy                               0    0   7      1     8
##   Japan                               0    0   3      0     3
##   Kyrgyzstan                          0    0   1      0     1
##   Latvia                              0    0   1      0     1
##   Lithuania                           0    0   1      0     1
##   Macedonia                           0    0   1      0     1
##   Malaysia                            0    0   1      0     1
##   Maldives                            0    0   1      0     1
##   Mauritius                           0    0   1      0     1
##   Mexico                              0    0   4      0     4
##   Moldova                             0    0   1      0     1
##   Netherlands                         0    0   0      1     1
##   New Zealand                         0    0   3      0     3
##   Nigeria-2                           0    0   1      0     1
##   North Korea                         0    0   2      0     2
##   Philippines                         0    0   3      0     3
##   Poland                              0    1   2      0     3
##   Portugal                            0    0   2      0     2
##   Romania                             0    0   3      0     3
##   Russia                              1    0   7      1     9
##   Singapore                           0    0   2      0     2
##   Slovenia                            0    0   3      0     3
##   South Africa                        0    2   2      0     4
##   South Korea                         0    1   5      1     7
##   South Korea-1                       0    0   0      1     1
##   Spain                               0    0   7      0     7
##   Sweden                              0    0   3      0     3
##   Switzerland                         0    0   5      0     5
##   Tajikistan                          0    0   1      0     1
##   Thailand                            0    0   1      0     1
##   Tunisia                             0    0   1      0     1
##   Turkey                              0    0   3      0     3
##   Ukraine                             0    1   3      0     4
##   United States                       0    1   6      1     8
##   Uruguay                             0    0   2      0     2
##   Uzbekistan                          0    0   3      0     3
##   Venezuela                           0    0   1      0     1
##   Total                               4   11 176      9   200
library(dplyr, warn.conflicts = FALSE)

frecuencia_medallas <- muestra2 %>%
  
  filter(!is.na(Medal) & Medal %in% c("Gold", "Silver", "Bronze")) %>%
  group_by(Team, Medal) %>%
  summarise(Frequency = n())
## `summarise()` has grouped output by 'Team'. You can override using the
## `.groups` argument.
frecuencia_medallas

4. Diagrama de barras para los deportes.

En la cuarta parte, utilizaremos el paquete ggplot2 para la creación de gráficas. Este paquete facilita la generación de diagramas de barras y diagramas de torta, donde representaremos los deportes de competición y su frecuencia asociada. Para esto, seleccionaremos la variable ‘Sport’ de nuestro conjunto de datos en el eje x y luego lo personalizaremos según nuestras preferencias.

library(ggplot2, warn.conflicts = FALSE)

ggplot(muestra2, aes(x = Sport, fill = Sport)) +
  geom_bar() +
  geom_text(stat = 'count', aes(label=after_stat(count)), vjust=-2.6, position=position_stack(0.5)) +
  labs(title = "Diagrama de Barras para los deportes en competición",
       x = "Deporte",
       y = "Frecuencia") +
  scale_fill_manual(values = c("#CAFF70", "#A2CD5A", "#9AFF9A", "#7CCD7C", "#00BFFF", "#009ACD", "#1C86EE", "#00E5EE", "#00868B", "#458B74")) +
  theme_minimal() +
  theme(
    panel.background = element_rect(fill = "#F0FFFF"),
    plot.background = element_rect(fill = "#F0FFFF"),
  )

library(ggplot2, warn.conflicts = FALSE)

datos <- data.frame(
  Categoria = c("Archery", "Badminton", "Canoeing", "Cycling", "Diving", "Gymnastics", "swimming", "Table.tennis", "Triathlon", "Weightlifting"),
  Valor = c(4.5, 7.5, 10.5, 15, 3.5, 7.5, 36.5, 5.5, 2.5, 7)
)

# Definir colores para cada valor
colores <- c("#CAFF70", "#A2CD5A", "#9AFF9A", "#7CCD7C", "#00BFFF", "#009ACD", "#1C86EE", "#00E5EE", "#00868B", "#458B74")

# Crear un gráfico de torta
ggplot(datos, aes(x = "deportes", y = Valor, fill = Categoria)) +
  geom_bar(stat = "identity", width = 1) +
  geom_text(aes(label = paste0(Valor, "%")), position = position_stack(vjust = 0.5)) +
  coord_polar("y", start = 0) +
  theme_void() +
  scale_fill_manual(values = colores) +  # Asignar colores
  theme(legend.position = "right") +
  labs(title = "Diagrama de Torta",
       fill = "Deporte",
       y = "Valor")

5. Diagrama de caja y bigotes para Sexo - Pesos.

library(ggplot2)

ggplot(muestra2, aes(x = Sex, y = Weight, fill = Sex)) +
  geom_boxplot(color = "#00868B", fill = "#9AFF9A", alpha = 1.4, width = 1.4) +
  labs(x = "Sexo", y = "Peso", title = "Distribución de Peso por Sexo") +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 0, hjust = 1.0, vjust = 1.0),
    plot.title = element_text(hjust = 0.5),
    legend.position = "none",
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.background = element_rect(fill = "#F0FFFF", color = "black", linewidth = 1),
    panel.border = element_rect(color = "black", fill = NA, linewidth = 1)
  )

6. Variabilidad en Variables Cuantitativas

# Separo los datos de "muestra2" por género

datos_mujeres_alturas <- muestra2$Height[muestra2$Sex == "F"]

datos_mujeres_peso <- muestra2$Weight[muestra2$Sex == "F"]

datos_mujeres_edad <- muestra2$Age[muestra2$Sex == "F"]

datos_hombres_alturas <- muestra2$Height[muestra2$Sex == "M"]


# Imprimie un resumen de los datos dados

print_resumen <- function(nombre_grupo, alturas) {
  cat("Resumen para", nombre_grupo, ":\n")
  cat("Media:", mean(alturas), "\n")
  cat("Mediana:", median(alturas), "\n")
  cat("Desviación Estándar:", sd(alturas), "\n")
  cat("Minimo y Maximo", range(alturas), "\n")
  cat("Rango:", diff(range(alturas)), "\n")
  cat("Cuartiles (Q1, Q3):", quantile(alturas, c(0.25, 0.75)), "\n")
  cat("Percentil 90:", quantile(alturas, 0.9), "\n\n")
}
# Imprimir resumen para mujeres y hombres
print_resumen("Variabilidad de la Altura de Mujeres", datos_mujeres_alturas)
## Resumen para Variabilidad de la Altura de Mujeres :
## Media: 167.1078 
## Mediana: 168 
## Desviación Estándar: 8.858522 
## Minimo y Maximo 143 187 
## Rango: 44 
## Cuartiles (Q1, Q3): 163.25 173 
## Percentil 90: 176
print_resumen("Variabilidad de la Altura de Hombres", datos_hombres_alturas)
## Resumen para Variabilidad de la Altura de Hombres :
## Media: 179.1735 
## Mediana: 180 
## Desviación Estándar: 9.314688 
## Minimo y Maximo 155 196 
## Rango: 41 
## Cuartiles (Q1, Q3): 174 186 
## Percentil 90: 190
# Visualización: Comparación por diagrama de Cajas y Bigotes de los Géneros


#ALTURAS ENTRE MJERES Y HOMBRES
boxplot(datos_mujeres_alturas,datos_hombres_alturas, horizontal = TRUE, 
        main = "Variabilidad de Alturas entre Mujeres y Hombre",
        names = c("Mujeres", "Hombres"), 
        col = c("#00868B", "#00BFFF"), border = "black",
        xlab = "Alturas en Cm")

print_resumen("Variabilidad del Peso de Mujeres", datos_mujeres_peso)
## Resumen para Variabilidad del Peso de Mujeres :
## Media: 59.73529 
## Mediana: 60 
## Desviación Estándar: 10.97786 
## Minimo y Maximo 31 118 
## Rango: 87 
## Cuartiles (Q1, Q3): 54 64 
## Percentil 90: 69.9
#PESO MUJERES
boxplot(datos_mujeres_peso, horizontal = TRUE, 
        main = "Variabilidad en el Peso de Mujeres",
        names = c("Mujeres"), 
        col = c("#009ACD"), border = "black",
        xlab = "Peso")

print_resumen("Variabilidad de la Edad de Mujeres", datos_mujeres_edad)
## Resumen para Variabilidad de la Edad de Mujeres :
## Media: 22.97059 
## Mediana: 22 
## Desviación Estándar: 4.879652 
## Minimo y Maximo 15 39 
## Rango: 24 
## Cuartiles (Q1, Q3): 19.25 25.75 
## Percentil 90: 29
#EDAD MUJERES
boxplot(datos_mujeres_edad, horizontal = TRUE, 
        main = "Variabilidad en la Edad de Mujeres",
        names = c("Mujeres"), 
        col = c("#00E5EE"), border = "black",
        xlab = "Edad")

7. Tabla de Frecuencias e Histograma

frecuencia_absoluta <-  table(subset(muestra2,Sex=="F")[c("Height")]);frecuencia_absoluta #frecuencia absoluta por altura
## Height
## 143 145 148 152 153 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 
##   2   1   2   3   2   1   2   2   1   1   3   2   1   3   4   7   3   7  10   4 
## 170 171 172 173 174 175 176 177 178 180 182 184 186 187 
##   8   3   2   5   4   5   4   1   3   1   1   2   1   1
fr <- data.frame("Sex","Height")
Re <- length(subset(fr$Height,fr$Sex == "F"))

frecuencia_relativa  <-  round(frecuencia_absoluta/length(Re),5)

frecuencia_relativa 
## Height
## 143 145 148 152 153 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 
##   2   1   2   3   2   1   2   2   1   1   3   2   1   3   4   7   3   7  10   4 
## 170 171 172 173 174 175 176 177 178 180 182 184 186 187 
##   8   3   2   5   4   5   4   1   3   1   1   2   1   1
fabsacum <-  cumsum(frecuencia_absoluta) 

fabsacum
## 143 145 148 152 153 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 
##   2   3   5   8  10  11  13  15  16  17  20  22  23  26  30  37  40  47  57  61 
## 170 171 172 173 174 175 176 177 178 180 182 184 186 187 
##  69  72  74  79  83  88  92  93  96  97  98 100 101 102
?cbind
## starting httpd help server ... done
tabla_de_frecuencias <-  cbind(frecuencia_absoluta,fabsacum, frecuencia_relativa)

tabla_de_frecuencias
##     frecuencia_absoluta fabsacum frecuencia_relativa
## 143                   2        2                   2
## 145                   1        3                   1
## 148                   2        5                   2
## 152                   3        8                   3
## 153                   2       10                   2
## 155                   1       11                   1
## 156                   2       13                   2
## 157                   2       15                   2
## 158                   1       16                   1
## 159                   1       17                   1
## 160                   3       20                   3
## 161                   2       22                   2
## 162                   1       23                   1
## 163                   3       26                   3
## 164                   4       30                   4
## 165                   7       37                   7
## 166                   3       40                   3
## 167                   7       47                   7
## 168                  10       57                  10
## 169                   4       61                   4
## 170                   8       69                   8
## 171                   3       72                   3
## 172                   2       74                   2
## 173                   5       79                   5
## 174                   4       83                   4
## 175                   5       88                   5
## 176                   4       92                   4
## 177                   1       93                   1
## 178                   3       96                   3
## 180                   1       97                   1
## 182                   1       98                   1
## 184                   2      100                   2
## 186                   1      101                   1
## 187                   1      102                   1
?cbind
datos_mujeres_alturas <- subset(muestra2, Sex == "F")
# Crear el histograma de alturas de mujeres
ggplot(datos_mujeres_alturas, aes(x = Height)) +
  geom_histogram(binwidth = 1, fill = "#458B74", color = "#1C86EE", aes(y = after_stat(density)), alpha = 0.7) +
  labs(title = "Histograma de Altura de Mujeres",
       x = "Altura",
       y = "Frecuencia") +
  theme_minimal() +
  theme(plot.title = element_text(size = 20, hjust = 0.5, face = "bold"),
        axis.title = element_text(size = 15, face = "bold"),
        axis.text = element_text(size = 12),
        panel.background = element_rect(fill = "lightgray", color = "#CAFF70"),
        panel.grid.major = element_line(color = "white"),
        panel.grid.minor = element_blank(),
        plot.background = element_rect(fill = "lightgray"))

8. Conclusiones

Observaremos que la tabla de frecuencias nos mostrará el número de participantes por género (hombre, mujer), y esto en relación con cada país participante en los Juegos Olímpicos. La información que nos brinda revela diferencias significativas entre los países. Por ejemplo, Australia cuenta con un total de 9 participantes (6 mujeres, 3 hombres), mientras que Italia tiene 8 participantes en total (5 mujeres y 3 hombres). En contraste, algunos países tienen una baja participación, como Venezuela, con tan solo dos participantes (1 hombre, 1 mujer), o Corea del Sur, con solo una participante mujer. Finalmente, el país que aportó más participantes fue Alemania, con 10 en total (7 hombres, 3 mujeres).

Al observar los diagramas de cajas para cada género, notamos que en la categoría de hombres, los datos de peso están menos dispersos y muestran un sesgo menor. Además, solo observamos un dato atípico por debajo del límite inferior, que corresponde a una persona que pesa 52 kilos. En el caso de las mujeres, encontramos una mayor dispersión de los datos con respecto a su mediana. Encontramos 5 datos atípicos fuera de los límites inferior y superior. Dentro de estos datos atípicos, se destaca una mujer que pesa 118 kilos por encima del límite superior y otra que pesa 31 kilos por debajo del límite inferior.

Con respecto a las variables cuantitativas para las mujeres, encontramos datos interesantes sobre las características de las participantes. La mujer más joven que participa en los Juegos Olímpicos tiene solo 15 años, y la media de edad de las mujeres que participan es de 22 años, lo que indica una población bastante joven. También observamos una gran diferencia en los pesos, donde la mujer más delgada pesa 31 kilos, mientras que la mujer más pesada pesa 118 kilos, ambos considerados datos atípicos. La media del peso de las mujeres es de 60 kilos. En cuanto a la altura de los hombres, la media es de 1,80 cm, y el hombre más pequeño mide 1,55 cm.

Se ha llevado a cabo un análisis de la frecuencia de práctica deportiva, representado de manera visual a través de diagramas de barras y torta. Los resultados revelan una clara tendencia hacia la natación, con un total impresionante de 73 personas que prefieren este deporte como su actividad física principal. Por otro lado, llama la atención el escaso interés por el triatlón, ya que solo 5 personas lo han elegido como su deporte preferido.