##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(stringr)
library(gt)
datos <- read.csv("D:/sampling_methods_2500.csv")
# Extraer variable
df_muestreo <- data.frame(
muestreo = toupper(trimws(datos$SAMPLING_METHOD))
)
# Reemplazar categorías
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 ~ "Sin registro"
)
# Orden de categorías
orden_muestreo <- c(
"Diamond Core Drilling",
"Reverse Circulation (RC)",
"Channel Sampling",
"Chip Sampling",
"Composite Sampling",
"Systematic Sampling",
"Random Sampling",
"Stratified Sampling",
"Sin registro"
)
# Convertir en factor ordenado
df_muestreo$muestreo <- factor(
df_muestreo$muestreo,
levels = orden_muestreo
)
# Frecuencias y probabilidad
ni <- table(df_muestreo$muestreo)
hi <- round(prop.table(ni), 4)
P <- round(hi * 100, 2)
# Crear tabla base
tabla_finalsampling <- data.frame(
Sampling_Method = names(ni),
ni = as.numeric(ni),
hi = as.numeric(hi),
P = as.numeric(P)
)
# Fila TOTAL
fila_total <- data.frame(
Sampling_Method = "TOTAL",
ni = sum(tabla_finalsampling$ni),
hi = round(sum(tabla_finalsampling$hi), 4),
P = round(sum(tabla_finalsampling$P), 2)
)
# Mostrar
tabla_finalsampling <- rbind(tabla_finalsampling, fila_total)
tabla_finalsampling
## Sampling_Method ni hi P
## 1 Diamond Core Drilling 878 0.3512 35.12
## 2 Reverse Circulation (RC) 608 0.2432 24.32
## 3 Channel Sampling 276 0.1104 11.04
## 4 Chip Sampling 184 0.0736 7.36
## 5 Composite Sampling 169 0.0676 6.76
## 6 Systematic Sampling 205 0.0820 8.20
## 7 Random Sampling 71 0.0284 2.84
## 8 Stratified Sampling 109 0.0436 4.36
## 9 Sin registro 0 0.0000 0.00
## 10 TOTAL 2500 1.0000 100.00
tabla_sampling_gt <- tabla_finalsampling %>%
gt() %>%
tab_header(
title = md("**Tabla N° 1**"),
subtitle = md("Distribución de probabilidad de los métodos de obtención de muestras en el análisis geoquímico y geológico de depósitos minerales en Estados Unidos")
) %>%
tab_source_note(
source_note = md("Autor: Grupo 2")
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
table_body.hlines.color = "gray",
table_body.border.bottom.color = "black",
row.striping.include_table_body = TRUE
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(rows = Sampling_Method == "TOTAL")
)
tabla_sampling_gt
| Tabla N° 1 |
| Distribución de probabilidad de los métodos de obtención de muestras en el análisis geoquímico y geológico de depósitos minerales en Estados Unidos |
| Sampling_Method |
ni |
hi |
P |
| Diamond Core Drilling |
878 |
0.3512 |
35.12 |
| Reverse Circulation (RC) |
608 |
0.2432 |
24.32 |
| Channel Sampling |
276 |
0.1104 |
11.04 |
| Chip Sampling |
184 |
0.0736 |
7.36 |
| Composite Sampling |
169 |
0.0676 |
6.76 |
| Systematic Sampling |
205 |
0.0820 |
8.20 |
| Random Sampling |
71 |
0.0284 |
2.84 |
| Stratified Sampling |
109 |
0.0436 |
4.36 |
| Sin registro |
0 |
0.0000 |
0.00 |
| TOTAL |
2500 |
1.0000 |
100.00 |
| Autor: Grupo 2 |
# Extraer probabilidad (%) sin la fila TOTAL
P_global <- as.numeric(tabla_finalsampling$P[1:(nrow(tabla_finalsampling)-1)])
barplot(
P_global,
main = "Gráfica Nº1: Distribución de probabilidad de los métodos de\nobtención de muestras en depósitos minerales de Estados Unidos",
cex.main = 0.7,
xlab = "Métodos de muestreo",
ylab = "Probabilidad (%)",
col = "blue",
names.arg = tabla_finalsampling$Sampling_Method[1:(nrow(tabla_finalsampling)-1)],
cex.names = 0.8,
ylim = c(0, 100),
las = 2
)
# Eliminar fila TOTAL
tabla_sin_total <- tabla_finalsampling[
tabla_finalsampling$Sampling_Method != "TOTAL",
]
# Extraer probabilidad de la categoría "Diamond Core Drilling"
prob_diamond <- tabla_sin_total$P[
tabla_sin_total$Sampling_Method == "Diamond Core Drilling"
]
# Gráfico de texto explicativo
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(
x = 1, y = 1,
labels = paste(
"Cálculo de probabilidad\n(Estimación general)\n\n",
"¿Qué probabilidad existe de que una muestra\n",
"geoquímica o geológica en depósitos minerales\n",
"de Estados Unidos sea obtenida mediante el método\n",
"Diamond Core Drilling?\n\n",
"Probabilidad = ", prob_diamond, " (%)",
sep = ""
),
cex = 1.4,
col = "black",
font = 2
)
