Metodo de Muestreo Nominal

ANÁLISIS ESTADÍSTICO

CARGA DE DATOS Y LIBRERÍAS

CARGA DE DATOS

library(dplyr)
library(stringr)
library(gt)

datos <- read.csv("D:/sampling_methods_2500.csv")

ASIGNACION DE VARIABLES

ASIGNACION DE VARIABLES

df_muestreo <- data.frame(muestreo = toupper(trimws(datos$SAMPLING_METHOD)))

df_muestreo$muestreo <- case_when(
  toupper(df_muestreo$muestreo) == "DIAMOND CORE DRILLING" ~ "Diamond Core Drilling",
  toupper(df_muestreo$muestreo) == "REVERSE CIRCULATION (RC)" ~ "Reverse Circulation (RC)",
  toupper(df_muestreo$muestreo) == "CHANNEL SAMPLING" ~ "Channel Sampling",
  toupper(df_muestreo$muestreo) == "CHIP SAMPLING" ~ "Chip Sampling",
  toupper(df_muestreo$muestreo) == "COMPOSITE SAMPLING" ~ "Composite Sampling",
  toupper(df_muestreo$muestreo) == "SYSTEMATIC SAMPLING" ~ "Systematic Sampling",
  toupper(df_muestreo$muestreo) == "RANDOM SAMPLING" ~ "Random Sampling",
  toupper(df_muestreo$muestreo) == "STRATIFIED SAMPLING" ~ "Stratified Sampling",
  TRUE ~ NA_character_
)

orden_muestreo <- c(
  "Diamond Core Drilling",
  "Reverse Circulation (RC)",
  "Channel Sampling",
  "Chip Sampling",
  "Composite Sampling",
  "Systematic Sampling",
  "Random Sampling",
  "Stratified Sampling"
)

TABLA DE DISTRIBUCIÓN DE CANTIDAD

TABLA DE DISTRIBUCION DE CANTIDAD

df_muestreo$muestreo <- factor(
  df_muestreo$muestreo,
  levels = orden_muestreo,
  ordered = TRUE
)


TDF_muestreo <- df_muestreo %>%
  count(muestreo, name = "ni") %>%
  arrange(muestreo)

# Calculamos los porcentajes redondeados
TDF_muestreo <- TDF_muestreo %>%
  mutate(hi = round(ni / sum(ni) * 100, 0))

# Ajuste por redondeo: la diferencia se le asigna a la categoría con mayor frecuencia
diferencia <- 100 - sum(TDF_muestreo$hi)
if (diferencia != 0) {
  pos_max <- choosing_row <- which.max(TDF_muestreo$ni)
  TDF_muestreo$hi[pos_max] <- TDF_muestreo$hi[pos_max] + diferencia
}

# Tabla 
tabla_muestreo <- TDF_muestreo %>%
  gt() %>%
  tab_header(
    title = "Tabla N° 1",
    subtitle = "Distribución del Método de Muestreo"
  ) %>%
  grand_summary_rows(
    columns = c(ni, hi),
    fns = list(Total = ~sum(., na.rm = TRUE)),
    fmt = list(~fmt_number(., decimals = 0))
  )

tabla_muestreo

Tabla N° 1
Distribución del Método de Muestreo
	muestreo	ni	hi
	Diamond Core Drilling	878	36
	Reverse Circulation (RC)	608	24
	Channel Sampling	276	11
	Chip Sampling	184	7
	Composite Sampling	169	7
	Systematic Sampling	205	8
	Random Sampling	71	3
	Stratified Sampling	109	4
Total	—	2,500	100

# Agregamos fila TOTAL
tabla_final_muestreo <- TDF_muestreo %>%
  mutate(
    muestreo = as.character(muestreo)
  )

tabla_final_muestreo <- bind_rows(
  tabla_final_muestreo,
  data.frame(
    muestreo = "TOTAL",
    ni = sum(tabla_final_muestreo$ni),
    hi = sum(tabla_final_muestreo$hi)
  )
)

# TABLA ESQUELETO
tabla_muestreo_gt <- tabla_final_muestreo %>%

  gt() %>%

  tab_header(
    title = md("**Tabla Nº2**"),
    subtitle = md("Distribución ordinal del método de muestreo")
  ) %>%

  cols_label(
    muestreo = "Método de Muestreo",
    ni = "Frecuencia",
    hi = "Porcentaje (%)"
  ) %>%

  cols_align(
    align = "center",
    columns = everything()
  ) %>%

  fmt_number(
    columns = c(ni, hi),
    decimals = 0
  ) %>%

  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(
      rows = muestreo == "TOTAL"
    )
  ) %>%

  tab_source_note(
    source_note = md("Autor: Grupo 2")
  )

tabla_muestreo_gt

Tabla Nº2
Distribución ordinal del método de muestreo
Método de Muestreo	Frecuencia	Porcentaje (%)
Diamond Core Drilling	878	36
Reverse Circulation (RC)	608	24
Channel Sampling	276	11
Chip Sampling	184	7
Composite Sampling	169	7
Systematic Sampling	205	8
Random Sampling	71	3
Stratified Sampling	109	4
TOTAL	2,500	100
Autor: Grupo 2

GRÁFICAS DE DISTRIBUCIÓN DE CANTIDAD

# Gráfica Nº1: Frecuencia absoluta
barplot(TDF_muestreo$ni,
        main = "Gráfica Nº1: Frecuencia del Método de Muestreo",
        xlab = "Método de Muestreo",
        ylab = "Cantidad (ni)",
        col = "steelblue",
        names.arg = TDF_muestreo$muestreo,
        cex.names = 0.6,
        las = 2) # las = 2 para rotar nombres si son largos

# Gráfica Nº2: Frecuencia absoluta ajustada
barplot(TDF_muestreo$ni,
        main = "Gráfica Nº2: Frecuencia del Método de Muestreo (Escala Ajustada)",
        xlab = "Método de Muestreo",
        ylab = "Cantidad (ni)",
        col = "steelblue",
        names.arg = TDF_muestreo$muestreo,
        cex.names = 0.6,
        las = 2,
        ylim = c(0, max(TDF_muestreo$ni) * 1.2))

# Gráfica Nº3: Frecuencia relativa
barplot(TDF_muestreo$hi,
        main = "Gráfica Nº3: Porcentaje del Método de Muestreo",
        xlab = "Método de Muestreo",
        ylab = "Porcentaje (%)",
        col = "steelblue",
        names.arg = TDF_muestreo$muestreo,
        cex.names = 0.6,
        las = 2)

# Gráfica Nº4: Frecuencia relativa escala completa
barplot(TDF_muestreo$hi,
        main = "Gráfica Nº4: Porcentaje del Método de Muestreo (Escala Completa)",
        xlab = "Método de Muestreo",
        ylab = "Porcentaje (%)",
        col = "steelblue",
        names.arg = TDF_muestreo$muestreo,
        cex.names = 0.6,
        las = 2,
        ylim = c(0, 100))

# Gráfico circular
par(mar = c(4, 4, 4, 10)) # Margen derecho más amplio para leyenda larga

colores <- rainbow(length(TDF_muestreo$hi))

pie(TDF_muestreo$hi,
    col = colores,
    main = "Distribución del Método de Muestreo",
    labels = NA)

legend("right",
       legend = paste(TDF_muestreo$muestreo, TDF_muestreo$hi, "%"),
       fill = colores,
       title = "MÉTODOS",
       bty = "o",
       xpd = TRUE,
       inset = c(-0.46, 0))

INDICADORES ESTADISTICOS

# Moda
moda_muestreo <- TDF_muestreo[TDF_muestreo$ni == max(TDF_muestreo$ni), ]
moda_muestreo

##                muestreo  ni hi
## 1 Diamond Core Drilling 878 36

# Mediana
TDF_muestreo <- TDF_muestreo %>%
  mutate(Ni = cumsum(ni))

N <- sum(TDF_muestreo$ni)

mediana_muestreo <- TDF_muestreo %>%
  filter(Ni >= N/2) %>%
  slice(1)

mediana_muestreo

##                   muestreo  ni hi   Ni
## 1 Reverse Circulation (RC) 608 24 1486