Análisis Estadístico por Variables Cuantitativas P_pct_AES_ST
Grupo 1
2026-05-31
CARGA DE DATOS
CARGA DE DATOS
knitr::opts_chunk$set(
echo = TRUE, # Muestra el código R en el reporte final.
message = FALSE,
warning = FALSE, # Message y warning evitan que se impriman alertas o mensajes de carga estorbosos en el HTML.
fig.align = "center" # Centra automáticamente todas las gráficas generadas.
)
datos <- read.csv("C:/Users/Martin/Desktop/Estadistica/CMDB_Data.csv",
header = TRUE, # Indica que la primera fila contienen los nombres de las variables.
sep = ";", # Define que los puntos y comas es el separador de las columnas del archivo.
dec = ".", # Establece el punto como el operador decimal para los números.
fileEncoding = "latin1")
# Verificación inicial del set de datos
str(datos)## 'data.frame': 1366 obs. of 103 variables:
## $ ï..LAB_ID : chr "C355417" "C360759" "C360762" "C360763" ...
## $ PREVIOUS_LAB_ID1 : chr "" "" "" "" ...
## $ PREVIOUS_LAB_ID2 : chr "" "" "" "" ...
## $ PREVIOUS_LAB_ID3 : chr "" "" "" "" ...
## $ FIELD_ID : chr "RM0001" "RM0027" "RM0030" "RM0031" ...
## $ JOB_ID : chr "MRP11968" "MRP12307" "MRP12307" "MRP12307" ...
## $ PREVIOUS_JOB_ID1 : chr "" "" "" "" ...
## $ PREVIOUS_JOB_ID2 : chr "" "" "" "" ...
## $ PREVIOUS_JOB_ID3 : chr "" "" "" "" ...
## $ SUBMITTER : chr "Rare Metals Task" "Rare Metals Task" "Rare Metals Task" "Rare Metals Task" ...
## $ PROJECT_NAME : chr "Critical and Rare Metals" "Critical and Rare Metals" "Critical and Rare Metals" "Critical and Rare Metals" ...
## $ X0 : chr "30/6/2011" "31/8/2011" "31/8/2011" "31/8/2011" ...
## $ COLLECTION : chr "Mackay-Keck Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" ...
## $ COLLECTION_ID : chr "PHNC08_39_1183" "OD21441" "OD22811" "OD25716" ...
## $ CONTINENT : chr "North America" "South America" "South America" "Africa" ...
## $ COUNTRY : chr "United States" "Chile" "Chile" "South Africa" ...
## $ STATE_PROVINCE : chr "Nevada" "Antofagasta" "Tarapacá" "Transvaal" ...
## $ COUNTY : chr "Lyon" "El Loa" "El Tamarugal" "" ...
## $ DISTRICT_NAME : chr "Yerington" "Chuquicamata" "Collahuasi/Quebrada Blanca" "" ...
## $ DEPOSIT_NAME : chr "Pumpkin Hollow" "" "" "" ...
## $ MINE_NAME : chr "Pumpkin Hollow" "Chuquicamata mine" "Collahuasi district" "" ...
## $ DISTRICT_NAME_COLLECT: chr "Yerington" "" "" "" ...
## $ DEPOSIT_NAME_COLLECT : chr "" "" "" "" ...
## $ MINE_NAME_COLLECT : chr "Pumpkin Hollow" "Chuquicamata" "Poduosa mine" "Messina Mines Ltd." ...
## $ LOCATE_DESC : chr "" "" "Level 25" "" ...
## $ LATITUDE : chr "38,94021" "-22,2871" "-21,0309" "-24,7" ...
## $ LONGITUDE : chr "-119,05178" "-68,8991" "-68,74951" "29,3" ...
## $ DATUM : chr "WGS84" "WGS84" "WGS84" "" ...
## $ LATITUDE_COLLECT : chr "38,92492" "22,28944" "" "" ...
## $ LONGITUDE_COLLECT : chr "-119,1071" "-68,90111" "" "" ...
## $ DATUM_COLLECT : chr "" "WGS84" "" "" ...
## $ COORDINATES_QUAL : chr "100 m" "0m" "" "" ...
## $ COORDINATES_SOURCE : chr "1) iTouchMap.com, approx, A. Orkild-Norton; 2) Mineral Resource Deposit Database Deposit ID 10174173, ore body, M. Granitto" "1) Mindat.org, approx, A. Orkild-Norton; 2) Open-File Report 2017-1079 ID 549, mine, M. Granitto" "1) No coordinates; 2) Mineral Resource Deposit Database Deposit ID 10057511, district, M. Granitto" "1) No coordinates; 2) Google Earth Pro, approx ctr of former province of Transvaal, M. Granitto" ...
## $ PRIMARY_CLASS : chr "rock" "rock" "rock" "rock" ...
## $ SYSTEM_TYPE : chr "IOA-IOCG" "Porphyry Cu-Mo-Au" "Porphyry Cu-Mo-Au" "IOA-IOCG" ...
## $ DEPOSIT_TYPE : chr "IOCG" "Supergene Cu" "Porphyry Cu" "IOCG" ...
## $ SAMPLE_DESC : chr "Nearly solid chalcopyrite mixed with small light brown irregular inclusions of unknown mineralogy; clouds of ma"| __truncated__ "Chalcocite-bronchatite-antlerite(?); highly microfractured igneous rock with green copper sulfates coating microfractures" "Bornite-chalcopyrite; mostly massive chalcopyrite with numerous inclusions of micro-chalcopyrite and widely sca"| __truncated__ "Massive chalcopyrite, IOCG in shear zone; mostly massive fine grain cuprite with widely distributed malachite t"| __truncated__ ...
## $ Al_pct_AES_ST : chr "0,33" "6,65" "0,46" "0,7" ...
## $ Ca_pct_AES_ST : chr "1,1" "0,4" "-0,1" "0,3" ...
## $ Fe_pct_AES_ST : chr "42,4" "0,25" "6,98" "27,8" ...
## $ K_pct_AES_ST : chr "-0,1" "6,1" "0,2" "-0,1" ...
## $ Mg_pct_AES_ST : chr "0,57" "0,1" "0,01" "0,33" ...
## $ Mn_pct_AES_ST : chr "0,02" "-0,01" "-0,01" "-0,01" ...
## $ P_pct_AES_ST : chr "-0,01" "0,01" "0,05" "0,01" ...
## $ S_pct_AES_ST : chr "" "" "" "" ...
## $ Si_pct_AES_ST : chr "" "" "" "" ...
## $ Ti_pct_AES_ST : chr "0,01" "0,11" "-0,01" "-0,01" ...
## $ F_pct_ISE_Fuse : chr "" "" "" "" ...
## $ Ag_ppm_MS_ST : chr "58" "6" "468" "16" ...
## $ As_ppm_MS_ST : chr "-30" "-30" "90" "-30" ...
## $ Au_ppm : chr "" "" "" "" ...
## $ Au_AM : chr "" "" "" "" ...
## $ B_ppm_AES_ST : int NA NA NA NA NA NA NA NA NA NA ...
## $ Ba_ppm_AES_ST : chr "-0,5" "924" "121" "174" ...
## $ Be_ppm_AES_ST : int -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 ...
## $ Bi_ppm_MS_ST : chr "1,5" "3,6" "190" "0,4" ...
## $ Cd_ppm_MS_ST : chr "3,6" "-0,2" "0,9" "-0,2" ...
## $ Ce_ppm_MS_ST : chr "0,4" "8,8" "16,3" "3,5" ...
## $ Co_ppm_MS_ST : chr "209" "-0,5" "1,3" "44,8" ...
## $ Cr_ppm_AES_ST : int -10 -10 -10 30 20 20 60 40 20 10 ...
## $ Cs_ppm_MS_ST : chr "0,5" "1,4" "0,2" "-0,1" ...
## $ Cu_ppm_AES_ST : chr "50000,11111" "23300" "50000,11111" "50000,11111" ...
## $ Dy_ppm_MS_ST : chr "-0,05" "0,32" "1,38" "0,37" ...
## $ Er_ppm_MS_ST : chr "-0,05" "0,22" "0,77" "0,23" ...
## $ Eu_ppm_MS_ST : chr "-0,05" "0,14" "0,17" "0,1" ...
## $ Ga_ppm_MS_ST : chr "5" "15" "6" "3" ...
## $ Gd_ppm_MS_ST : chr "-0,05" "0,45" "1,5" "0,39" ...
## $ Ge_ppm_MS_ST : int -1 5 -1 -1 3 8 8 1 2 2 ...
## $ Hf_ppm_MS_ST : int -1 4 -1 -1 5 13 12 2 3 6 ...
## $ Ho_ppm_MS_ST : chr "-0,05" "0,07" "0,25" "0,07" ...
## $ In_ppm_MS_ST : chr "6,4" "-0,2" "3,7" "0,2" ...
## $ La_ppm_MS_ST : chr "0,2" "4,6" "7,2" "1,7" ...
## $ Li_ppm_AES_ST : int -10 -10 -10 -10 30 20 20 20 -10 20 ...
## $ Lu_ppm_MS_ST : chr "-0,05" "-0,05" "0,08" "-0,05" ...
## $ Mo_ppm_MS_ST : chr "-2" "60" "3" "2" ...
## $ Nb_ppm_MS_ST : chr "-1" "4" "-1" "-1" ...
## $ Nd_ppm_MS_ST : chr "0,2" "3,8" "9,1" "1,7" ...
## $ Ni_ppm_AES_ST : chr "144" "6" "-5" "48" ...
## $ Pb_ppm_MS_ST : chr "23" "16" "188" "39" ...
## $ Pd_ppm_FA_MS : chr "" "" "" "" ...
## $ Pr_ppm_MS_ST : chr "-0,05" "1,09" "2,21" "0,46" ...
## $ Pt_ppm_FA_MS : chr "" "" "" "" ...
## $ Rb_ppm_MS_ST : chr "1,2" "148" "7,1" "0,7" ...
## $ Re_ppm_MS_HF : chr "" "" "" "" ...
## $ Sb_ppm_MS_ST : chr "1,2" "2,4" "2,9" "0,3" ...
## $ Sc_ppm_AES_ST : int -5 -5 -5 -5 11 6 15 10 5 6 ...
## $ Se_ppm_MS_ST : int NA NA NA NA NA NA NA NA NA NA ...
## $ Sm_ppm_MS_ST : chr "-0,1" "0,6" "1,6" "0,4" ...
## $ Sn_ppm_MS_ST : chr "2" "3" "106" "-1" ...
## $ Sr_ppm_AES_ST : chr "26,6" "114" "22,5" "38,4" ...
## $ Ta_ppm_MS_ST : chr "-0,5" "-0,5" "-0,5" "-0,5" ...
## $ Tb_ppm_MS_ST : chr "-0,05" "0,07" "0,23" "-0,05" ...
## $ Te_ppm_MS_ST : chr "" "" "" "" ...
## $ Th_ppm_MS_ST : chr "0,2" "9,7" "2,6" "0,2" ...
## $ Tl_ppm_MS_ST : chr "-0,5" "0,5" "-0,5" "-0,5" ...
## $ Tm_ppm_MS_ST : chr "-0,05" "-0,05" "0,08" "-0,05" ...
## $ U_ppm_MS_ST : chr "0,3" "1,75" "0,63" "34,8" ...
## $ V_ppm_AES_ST : int 51 24 -5 493 68 20 40 159 39 61 ...
## $ W_ppm_MS_ST : chr "-1" "28" "22" "11" ...
## [list output truncated]Se cargaron los datos de todas las variables.
ANÁLISIS DE FRECUENCIAS: CONCENTRACIÓN DE FÓSFORO (P)
ANÁLISIS DE FRECUENCIAS: CONCENTRACIÓN DE FÓSFORO (P)
library(dplyr)
library(gt)
#----------------------- PROCESAMIENTO P_pct_AES_ST -----------------------
# 1. Limpieza y preparación de la variable
datos$P_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$P_pct_AES_ST))))
# Separar registros con concentraciones válidas de los nulos/negativos
p_numerico <- datos$P_pct_AES_ST[datos$P_pct_AES_ST >= 0 & !is.na(datos$P_pct_AES_ST)]
n_sin_datos <- sum(is.na(datos$P_pct_AES_ST) | datos$P_pct_AES_ST < 0)
# 2. Tabla de Frecuencias de los valores geoquímicos reales
TDF_VALIDOS <- as.data.frame(table(p_numerico), stringsAsFactors = FALSE)
colnames(TDF_VALIDOS) <- c("CATEGORIA", "ni")
# Convertir categoría a numérico para ordenar de menor a mayor concentración (%)
TDF_VALIDOS$CATEGORIA <- as.numeric(TDF_VALIDOS$CATEGORIA)
TDF_VALIDOS <- TDF_VALIDOS[order(TDF_VALIDOS$CATEGORIA), ]
# Definición de horizontes cuantitativos
total_variable <- sum(TDF_VALIDOS$ni) # Total de muestras con datos de P
total_general <- total_variable + n_sin_datos # Total absoluto de la matriz
# 3. Agrupación: Top 10 valores de concentración más bajos + Otros
if(nrow(TDF_VALIDOS) > 10) {
tabla_top <- head(TDF_VALIDOS, 10)
sum_otros <- sum(TDF_VALIDOS$ni[11:nrow(TDF_VALIDOS)])
fila_otros <- data.frame(CATEGORIA = "Otras Concentraciones", ni = sum_otros)
tabla_final_base <- rbind(tabla_top, fila_otros)
} else {
tabla_final_base <- TDF_VALIDOS
}
# Convertir CATEGORIA a carácter para permitir la unión de las filas de totales
tabla_final_base$CATEGORIA <- as.character(tabla_final_base$CATEGORIA)
# 4. Calcular frecuencias (hi) escaladas a 100 respecto al total general
tabla_final_base$hi <- round((tabla_final_base$ni / total_general) * 100, 4)
# 5. FILA DEL TOTAL EXCLUSIVO DE LA VARIABLE (Muestras con lecturas de P)
fila_total_var <- data.frame(
CATEGORIA = "TOTAL VARIABLE (P)",
ni = total_variable,
hi = round((total_variable / total_general) * 100, 4)
)
# 6. FILA DE CONTRASTE: REGISTROS SIN INFORMACIÓN ANALÍTICA
fila_sin_datos <- data.frame(
CATEGORIA = "Sin Datos",
ni = n_sin_datos,
hi = round((n_sin_datos / total_general) * 100, 4)
)
# 7. FILA DEL TOTAL GENERAL DEL PROYECTO
fila_total_general <- data.frame(
CATEGORIA = "TOTAL GENERAL",
ni = total_general,
hi = 100 # Forzado para cierre perfecto de balance estadístico
)
# Consolidar toda la matriz de datos en orden lógico estructurado
tabla_final <- rbind(tabla_final_base, fila_total_var, fila_sin_datos, fila_total_general)
colnames(tabla_final) <- c("Valor P (%)", "ni", "hi")
#----------------------- GENERAR SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_p_completa_gt <- tabla_final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 1**"),
subtitle = md("Distribución de frecuencias para concentraciones de Fósforo (P)")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
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
)
# Renderizar la tabla en el documento
tabla_p_completa_gt| Tabla N° 1 | ||
| Distribución de frecuencias para concentraciones de Fósforo (P) | ||
| Valor P (%) | ni | hi |
|---|---|---|
| 0.01 | 111 | 8.1259 |
| 0.02 | 188 | 13.7628 |
| 0.03 | 126 | 9.2240 |
| 0.04 | 92 | 6.7350 |
| 0.05 | 69 | 5.0512 |
| 0.06 | 78 | 5.7101 |
| 0.07 | 41 | 3.0015 |
| 0.08 | 33 | 2.4158 |
| 0.09 | 39 | 2.8551 |
| 0.1 | 26 | 1.9034 |
| Otras Concentraciones | 235 | 17.2035 |
| TOTAL VARIABLE (P) | 1038 | 75.9883 |
| Sin Datos | 328 | 24.0117 |
| TOTAL GENERAL | 1366 | 100.0000 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
||
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DEL FÓSFORO
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DEL FÓSFORO
# Cargar las librerías al inicio
library(dplyr)
library(gt)
#------------------------- PREPARACIÓN DE DATOS -------------------------
datos$P_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$P_pct_AES_ST))))
# Creamos la variable de trabajo P asegurando que los datos estén limpios y sin negativos
P <- datos$P_pct_AES_ST[!is.na(datos$P_pct_AES_ST) & datos$P_pct_AES_ST >= 0]
#------------------------- ANÁLISIS DE CONCENTRACIÓN (ESTADÍSTICOS) -------------------------
cat("\n=======================================================\n")##
## =======================================================cat("ANÁLISIS DE CONCENTRACIÓN (P_pct_AES_ST):\n")## ANÁLISIS DE CONCENTRACIÓN (P_pct_AES_ST):cat("La concentración promedio es: ", round(mean(P, na.rm = TRUE), 3), " % \n")## La concentración promedio es: 0.164 %cat("La concentración máxima detectada es: ", max(P, na.rm = TRUE), " % \n")## La concentración máxima detectada es: 17.2 %cat("Total de muestras analizadas: ", sum(!is.na(P)), " registros \n")## Total de muestras analizadas: 1038 registroscat("=======================================================\n")## =======================================================#------------------------- TABLA DE FRECUENCIAS - STURGES -------------------------
# 1. Parámetros básicos: Rango, Número de clases (Sturges) y Amplitud
R <- max(P, na.rm = TRUE) - min(P, na.rm = TRUE)
k <- floor(1 + 3.322 * log10(length(P)))
A <- R / k
# 2. Definición de límites y Marcas de Clase (MC)
liminf <- seq(from = min(P, na.rm = TRUE), by = A, length.out = k)
limsup <- liminf + A
MC <- (liminf + limsup) / 2
# 3. Conteo de frecuencias absolutas por clase (n)
n <- numeric(k)
for (i in 1:k) {
if (i == k) {
n[i] <- sum(P >= liminf[i] & P <= limsup[i], na.rm = TRUE)
} else {
n[i] <- sum(P >= liminf[i] & P < limsup[i], na.rm = TRUE)
}
}
# 4. Cálculos de frecuencias relativas y acumuladas
hi <- (n / sum(n)) * 100
Ni_asc <- cumsum(n) # Frecuencia absoluta acumulada (ascendente)
Hi_asc <- cumsum(hi) # Frecuencia relativa acumulada (ascendente)
Ni_desc <- rev(cumsum(rev(n))) # Frecuencia absoluta acumulada (descendente)
Hi_desc <- rev(cumsum(rev(hi))) # Frecuencia relativa acumulada (descendente)
#------------------------- CONSTRUCCIÓN DE LA TABLA -------------------------
TablaP_Sturges <- data.frame(
Clase = as.character(1:k),
liminf = round(liminf, 3),
limsup = round(limsup, 3),
MC = round(MC, 3),
n = n,
hi = round(hi, 2),
Ni_asc = Ni_asc,
Hi_asc = round(Hi_asc, 2),
Ni_desc = Ni_desc,
Hi_desc = round(Hi_desc, 2)
)
# Fila de TOTALES para cierre de tabla respetando NA en columnas sin totales
fila_totales_P <- data.frame(
Clase = "**TOTALES**",
liminf = NA,
limsup = NA,
MC = NA,
n = sum(n),
hi = 100,
Ni_asc = NA,
Hi_asc = NA,
Ni_desc = NA,
Hi_desc = NA
)
# Unión de cuerpo y totales
TablaP_Final <- rbind(TablaP_Sturges, fila_totales_P)
#------------------------- MOSTRAR TABLA FINAL CON 'gt' -------------------------
tabla_sturges_p_gt <- TablaP_Final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 2**"),
subtitle = md("Distribución de frecuencias para concentraciones de Fósforo (P_pct_AES_ST) <br> mediante Regla de Sturges")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
fmt_markdown(columns = Clase) %>%
cols_label(
Clase = "Clase",
liminf = "Linf (%)",
limsup = "Lsup (%)",
MC = "MC (%)",
n = "n (abs)",
hi = "hi (%)",
Ni_asc = "Ni (↑)",
Hi_asc = "Hi (↑)",
Ni_desc = "Ni (↓)",
Hi_desc = "Hi (↓)"
) %>%
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
) %>%
sub_missing(
columns = everything(),
missing_text = "NA"
)
# Renderizar la tabla en el reporte
tabla_sturges_p_gt| Tabla N° 2 | |||||||||
| Distribución de frecuencias para concentraciones de Fósforo (P_pct_AES_ST) mediante Regla de Sturges |
|||||||||
| Clase | Linf (%) | Lsup (%) | MC (%) | n (abs) | hi (%) | Ni (↑) | Hi (↑) | Ni (↓) | Hi (↓) |
|---|---|---|---|---|---|---|---|---|---|
| 1 | 0.010 | 1.573 | 0.791 | 1023 | 98.65 | 1023 | 98.65 | 1037 | 100.00 |
| 2 | 1.573 | 3.135 | 2.354 | 6 | 0.58 | 1029 | 99.23 | 14 | 1.35 |
| 3 | 3.135 | 4.698 | 3.917 | 3 | 0.29 | 1032 | 99.52 | 8 | 0.77 |
| 4 | 4.698 | 6.261 | 5.480 | 0 | 0.00 | 1032 | 99.52 | 5 | 0.48 |
| 5 | 6.261 | 7.824 | 7.042 | 3 | 0.29 | 1035 | 99.81 | 5 | 0.48 |
| 6 | 7.824 | 9.386 | 8.605 | 2 | 0.19 | 1037 | 100.00 | 2 | 0.19 |
| 7 | 9.386 | 10.949 | 10.168 | 0 | 0.00 | 1037 | 100.00 | 0 | 0.00 |
| 8 | 10.949 | 12.512 | 11.730 | 0 | 0.00 | 1037 | 100.00 | 0 | 0.00 |
| 9 | 12.512 | 14.075 | 13.293 | 0 | 0.00 | 1037 | 100.00 | 0 | 0.00 |
| 10 | 14.075 | 15.637 | 14.856 | 0 | 0.00 | 1037 | 100.00 | 0 | 0.00 |
| 11 | 15.637 | 17.200 | 16.419 | 0 | 0.00 | 1037 | 100.00 | 0 | 0.00 |
| TOTALES | NA | NA | NA | 1037 | 100.00 | NA | NA | NA | NA |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|||||||||
POLÍGONO DE FRECUENCIA
POLÍGONO DE FRECUENCIAS RELATIVAS DEL FÓSFORO (P)
#----------------------- PROCESAMIENTO AUTOMÁTICO P_PCT_AES_ST -----------------------
# 1. Conversión de la variable a numérico y limpieza de datos
datos$P_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$P_pct_AES_ST))))
P_VAR <- datos$P_pct_AES_ST[!is.na(datos$P_pct_AES_ST) & datos$P_pct_AES_ST >= 0]
#----------------------- EXTRACCIÓN METODOLÓGICA DE STURGES -----------------------
# 2. Parámetros base desde la tabla
n_total <- length(P_VAR)
k_sturges <- floor(1 + 3.322 * log10(n_total))
rango_p <- max(P_VAR) - min(P_VAR)
amplitud_p <- rango_p / k_sturges
breaks_sturges <- seq(from = min(P_VAR), by = amplitud_p, length.out = k_sturges + 1)
# 3. Captura de datos en memoria (plot = FALSE)
hist_objeto <- hist(P_VAR, breaks = breaks_sturges, plot = FALSE, right = FALSE)
# Extraemos las Marcas de Clase (MC) reales del gráfico
mc_reales <- hist_objeto$mids
# Convertimos los conteos absolutos a frecuencias relativas porcentuales (hi %)
hi_porcentaje <- (hist_objeto$counts / n_total) * 100
#----------------------- ANCLAJE A CERO CON MARCAS DE CLASE -----------------------
# 4. Creamos los extremos ficticios para que el polígono toque el eje X en cero
mc_inicio <- mc_reales[1] - amplitud_p
mc_final <- mc_reales[length(mc_reales)] + amplitud_p
# Unimos los puntos: Marcas de Clase (X) y Frecuencias Relativas hi (Y)
marcas_clase_p <- c(mc_inicio, mc_reales, mc_final)
frecuencias_hi_p <- c(0, hi_porcentaje, 0)
# Detectamos el porcentaje máximo real para calibrar el eje Y
max_y_hi <- max(frecuencias_hi_p)
#----------------------- GRAFICAR POLÍGONO DE FRECUENCIAS (hi) -----------------------
par(mar = c(6, 5, 4, 2)) # Margen inferior ligeramente amplio para las MC verticales
# 5. Inicializar el lienzo ajustado a las Marcas de Clase y porcentajes
plot(marcas_clase_p, frecuencias_hi_p,
type = "n",
main = "Gráfica 1: Polígono de Frecuencias Relativas de Fósforo (P)",
xlab = "Concentración de P (%)",
ylab = "Frecuencia Relativa - hi (%)",
xlim = c(mc_inicio, mc_final),
ylim = c(0, max_y_hi * 1.1), # Un 10% de espacio arriba del pico más alto
xaxt = "n", yaxt = "n",
panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) # Rejilla de fondo
# 6. DIBUJAR EL POLÍGONO
lines(marcas_clase_p, frecuencias_hi_p, type = "l", col = "darkblue", lwd = 3)
# Luego dibujamos los puntos (pch=19) ÚNICAMENTE en las marcas de clase reales de tu tabla
points(mc_reales, hi_porcentaje, pch = 19, col = "darkblue", cex = 1.2)
# 7. Relleno translúcido bajo la curva
polygon(marcas_clase_p, frecuencias_hi_p, col = rgb(0, 0, 0.5, 0.12), border = NA)
#----------------------- PERSONALIZACIÓN DE EJES CONTINUOS -----------------------
# Eje X: Imprime las Marcas de Clase
axis(1, at = mc_reales, labels = round(mc_reales, 3), cex.axis = 0.75, las = 1)
# Eje Y: Valores horizontales dinámicos calculados a partir de los datos
marcas_eje_y <- pretty(c(0, max_y_hi))
axis(2, at = marcas_eje_y,
labels = paste0(marcas_eje_y, "%"),
las = 1, cex.axis = 0.8)
ANÁLISIS GRÁFICO: HISTOGRAMA DISTRIBUCIÓN DE FÓSFORO
HISTOGRAMA DISTRIBUCIÓN DE FÓSFORO
#----------------------- PROCESAMIENTO P_pct_AES_ST -----------------------
# 1. Conversión de P_pct_AES_ST a numérico
datos$P_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$P_pct_AES_ST))))
# Creamos variable de trabajo para las gráficas y FILTRAMOS los negativos
P_VAR <- datos$P_pct_AES_ST
P_VAR <- P_VAR[P_VAR >= 0 & !is.na(P_VAR)]
#----------------------- TABLA DE FRECUENCIAS SIMPLIFICADA -----------------------
# Al ser continua, agrupamos por rangos automáticos (bins) para que la tabla sea legible
k_simplificado <- 5
breaks_p <- pretty(P_VAR, n = k_simplificado)
HistogramaP <- hist(P_VAR, breaks = breaks_p, plot = FALSE)
# 2. Generación del Histograma Simplificado
hist(P_VAR,
breaks = breaks_p,
main = "Grafica 2: Distribucion de P_pct_AES_ST (Simplificada)",
xlab = "Concentracion de P (%)",
ylab = "Cantidad de muestras",
col = "lightgreen",
right = FALSE)
# ==============================================================================
# 1. PREPARACIÓN DE DATOS (MÉTODO STURGES)
# ==============================================================================
datos$P_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$P_pct_AES_ST))))
P_VAR <- datos$P_pct_AES_ST[!is.na(datos$P_pct_AES_ST) & datos$P_pct_AES_ST >= 0]
# ==============================================================================
# 2. CONFIGURACIÓN METODOLÓGICA (STURGES)
# ==============================================================================
k_sturges <- floor(1 + 3.322 * log10(length(P_VAR)))
rango_p <- max(P_VAR) - min(P_VAR)
amplitud_p <- rango_p / k_sturges
breaks_sturges <- seq(from = min(P_VAR), by = amplitud_p, length.out = k_sturges + 1)
# CREACIÓN CRÍTICA DEL OBJETO
hist_pro <- hist(P_VAR, breaks = breaks_sturges, plot = FALSE, right = FALSE)
# ==============================================================================
# 3. TEXTOS Y COLORES
# ==============================================================================
colores_degrade <- colorRampPalette(c("cyan", "blue", "purple"))(k_sturges)
etiquetas_intervalos <- paste0("[", round(breaks_sturges[1:k_sturges], 3), " - ",
round(breaks_sturges[2:(k_sturges+1)], 3), "]")
# ==============================================================================
# 4. CONSTRUCCIÓN DE LA GRÁFICA
# ==============================================================================
par(mar = c(6, 5, 4, 11))
# Guardamos el barplot en un objeto 'bp' para obtener las coordenadas exactas de las barras
bp <- barplot(hist_pro$counts,
names.arg = rep("", k_sturges),
col = colores_degrade,
border = "white",
main = "Grafica 3: Distribucion de P_pct_AES_ST (Regla de Sturges)",
ylab = "Frecuencia (Cantidad)",
xlab = "Contenido de Fósforo (%)",
ylim = c(0, max(hist_pro$counts) * 1.1),
yaxt = "n")
# Añadir frecuencias arriba de cada barra
text(x = bp,
y = hist_pro$counts,
labels = hist_pro$counts,
pos = 3, cex = 0.85, font = 2)
# ==============================================================================
# 5. PERSONALIZACIÓN DE EJES Y LEYENDA
# ==============================================================================
# Eje Y
marcas_y <- pretty(c(0, max(hist_pro$counts)))
axis(2, at = marcas_y, labels = marcas_y, las = 1, cex.axis = 0.85)
# 6. EJE X
# Calculamos los puntos de quiebre de las barras
ancho_barra <- bp[2] - bp[1]
posiciones_bordes_x <- c(bp - (ancho_barra / 2), max(bp) + (ancho_barra / 2))
# Dibujamos el eje X usando todos los breaks de Sturges
axis(1, at = posiciones_bordes_x,
labels = round(breaks_sturges, 2), cex.axis = 0.7)
# 7. Leyenda a la derecha
legend(x = max(bp) + (ancho_barra * 1.5), y = max(hist_pro$counts),
legend = etiquetas_intervalos,
fill = colores_degrade,
title = "Intervalos (%)",
xpd = TRUE, bty = "n", cex = 0.8)
ANÁLISIS VISUAL ACUMULADO: OJIVA ASCENDENTE Y DESCENDENTE
OJIVAS ni Y hi
#----------------------- PREPARACIÓN DE CORTES ENTEROS -----------------------
# Como el fósforo puede tener valores muy bajos, usamos un paso adecuado
paso_p <- if (ceiling(max(P_VAR)) > 10) 1 else 0.5
breaks_entero <- seq(0, ceiling(max(P_VAR)) + paso_p, by = paso_p)
#----------------------- OJIVA INTEGRADA Y PROFESIONAL -----------------------
par(mar=c(5, 5, 4, 2))
plot(MC, Ni_asc,
main = "Gráfica 4: Ojiva Combinada de Frecuencias del Fósforo (ni)",
xlab = "Contenido de Fósforo (%)",
ylab = "Frecuencia Acumulada (N muestras)",
type = "b", pch = 19, col = "blue", lwd = 3,
xaxt = "n", las = 1,
ylim = c(0, max(Ni_asc) * 1.05),
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# Segunda línea (Descendente)
lines(MC, Ni_desc, type = "b", pch = 17, col = "red", lwd = 3, lty = 2)
# Eje X con los intervalos exactos
axis(1, at = breaks_entero, labels = breaks_entero)
# Leyenda reubicada en el espacio vacío del lado derecho
legend("right",
legend = c("Acumulada Menor que (Ascendente)", "Acumulada Mayor que (Descendente)"),
col = c("blue", "red"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n",
cex = 0.85) 
#----------------------- OJIVA PROFESIONAL FÓSFORO - EN PORCENTAJES (Hi) -----------------------
MC_graficar <- MC[!is.na(MC)]
Hi_asc_graficar <- Hi_asc[1:length(MC_graficar)]
Hi_desc_graficar <- Hi_desc[1:length(MC_graficar)]
# Definir los cortes del eje X
breaks_p <- c(liminf[!is.na(liminf)], limsup[length(limsup) - 1])
# 2. Configurar los márgenes para la leyenda
par(mar=c(5, 5, 4, 2))
# 3. Graficar la curva ascendente
plot(MC_graficar, Hi_asc_graficar,
main = "Gráfica 5 : Ojiva Acumulada de Frecuencias de Fósforo (hi)",
xlab = "Concentración de Fósforo - P (%)",
ylab = "Frecuencia Relativa Acumulada (%)",
type = "b", pch = 19, col = "blue", lwd = 3,
xaxt = "n", las = 1,
ylim = c(0, 105),
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# 4. Línea descendente perfectamente emparejada
lines(MC_graficar, Hi_desc_graficar, type = "b", pch = 17, col = "red", lwd = 3, lty = 2)
# 5. Dibujar el Eje X con los intervalos exactos
axis(1, at = breaks_p, labels = round(breaks_p, 3), cex.axis = 0.8)
# 6. Leyenda técnica reubicada
legend("right",
legend = c("Acumulada Menor que (Ascendente %)", "Acumulada Mayor que (Descendente %)"),
col = c("blue", "red"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n",
cex = 0.85)
BOXPLOT
BOXPLOTS DE VALORES ATÍPICOS Y DISTRIBUCIÓN LIMPIA
#----------------------- PREPARACIÓN DE DATOS (Fósforo) -----------------------
# Conversión a numérico y limpieza de valores nulos o en cero
datos$P_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$P_pct_AES_ST))))
P_VAR <- datos$P_pct_AES_ST[!is.na(datos$P_pct_AES_ST) & datos$P_pct_AES_ST > 0]
#----------------------- BOXPLOT: ANÁLISIS DE VALORES ATÍPICOS -----------------------
par(mar=c(5, 6, 5, 2), xpd = FALSE)
# Cálculos estadísticos previos
stats_p <- boxplot.stats(P_VAR)
media_p <- round(mean(P_VAR), 3)
mediana_p <- round(median(P_VAR), 3)
n_outliers <- length(stats_p$out)
# Generación del Boxplot
boxplot(P_VAR, horizontal = TRUE, col = "#E0E0E0", border = "#424242",
main = " Gráfica 6: Análisis de Valores Atípicos (Fósforo)",
xlab = "Concentración de P (%)",
pch = 21,
bg = "red",
col.outline = "darkred",
frame = FALSE)
# Punto de Media y etiquetas de texto mejor ubicadas
points(media_p, 1,
col = "blue",
pch = 18,
cex = 2)
text(media_p, 1.25,
labels = paste("Media:", media_p),
col = "blue",
font = 2,
cex = 0.9)
text(mediana_p, 0.75,
labels = paste("Mediana:", mediana_p),
col = "#424242",
font = 2,
cex = 0.9)
# Leyenda
legend("topright",
legend = paste("Atípicos detectados:", n_outliers),
pch = 21,
pt.bg = "red",
bty = "n",
text.col = "darkred",
cex = 0.9)
#-----------------------BOXPLOT: DISTRIBUCIÓN LIMPIA (FÓSFORO) -----------------------
par(mar=c(5, 6, 5, 2))
# Generación del Boxplot sin valores atípicos (outline = FALSE)
boxplot(P_VAR,
horizontal = TRUE,
outline = FALSE,
col = "#E0E0E0",
border = "#424242",
main = "Gráfica 7: Distribución del Cuerpo Mineral (Sin Atípicos) - Fósforo",
xlab = "Concentración de P (%)",
frame = FALSE)
# Agregar cuadrícula de fondo
grid(nx = NULL,
ny = NA,
col = "gray85",
lty = "dashed")
# Valores sobre la vista limpia
points(media_p, 1,
col = "#E65100",
pch = 18,
cex = 2)
text(media_p, 1.25,
labels = paste("Media:", media_p),
col = "#BF360C",
font = 2,
cex = 0.9)
text(mediana_p, 0.75,
labels = paste("Mediana:", mediana_p),
col = "#424242",
font = 2,
cex = 0.9)
HISTOGRAMA CON BOXPLOT SUPERPUESTO (FÓSFORO)
HISTOGRAMA CON BOXPLOT FLOTANTE (FÓSFORO)
#----------------------- PREPARACIÓN DE DATOS -----------------------
datos$P_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$P_pct_AES_ST))))
P_VAR <- datos$P_pct_AES_ST[!is.na(datos$P_pct_AES_ST) & datos$P_pct_AES_ST >= 0]
# Metodología de Sturges
k_sturges <- floor(1 + 3.322 * log10(length(P_VAR)))
rango_p <- max(P_VAR) - min(P_VAR)
amplitud_p <- rango_p / k_sturges
breaks_sturges <- seq(from = min(P_VAR), by = amplitud_p, length.out = k_sturges + 1)
#----------------------- CÁLCULO DEL HISTOGRAMA (INVISIBLE) -----------------------
# Calculamos el histograma internamente para extraer datos
hist_pro <- hist(P_VAR, breaks = breaks_sturges, plot = FALSE, right = FALSE)
max_y <- max(hist_pro$counts)
#----------------------- CÁLCULO DEL RANGO X TOTAL -----------------------
# Calculamos el rango necesario para abarcar tanto las barras como los atípicos
xlim_range <- range(c(P_VAR, breaks_sturges))
# Aseguramos márgenes, con espacio ampliado a la derecha para la leyenda lateral
par(mar = c(5, 5, 4, 12), xpd = TRUE)
#----------------------- GRÁFICA INTEGRADA (HISTOGRAMA) -----------------------
# 1. Dibujamos el histograma base usando paleta degradada
colores_degrade <- colorRampPalette(c("cyan", "blue", "purple"))(length(hist_pro$counts))
hist(P_VAR,
breaks = breaks_sturges,
col = colores_degrade,
border = "white",
main = "Gráfica 8: Distribución de Fósforo con Boxplot Interno",
xlab = "Concentración de Fósforo (%)",
ylab = "Frecuencia (Cantidad)",
xlim = xlim_range, # Asegura que todo el eje X sea visible
ylim = c(0, max_y * 1.15), # Añadimos espacio extra en la parte superior
las = 1,
labels = TRUE, # Muestra los números encima de las barras
right = FALSE,
xaxt = "n") # Suprime el eje X por defecto
# 2. Personalización del eje X dinámico (breaks exactos)
axis(1, at = breaks_sturges, labels = round(breaks_sturges, 3), font = 2, cex.axis = 0.5)
# 3. Superponemos el Boxplot directamente
boxplot(P_VAR,
horizontal = TRUE,
add = TRUE, # Superpone la gráfica
axes = FALSE, # Oculta ejes
at = max_y / 2, # Altura de flotación (mitad del eje Y)
boxwex = max_y / 3, # Grosor de la caja
col = rgb(0.53, 0.81, 0.98, alpha = 0.7), # Color 'skyblue' con 70% opacidad
border = "#1C1C1C", # Borde oscuro
lwd = 1.5,
pch = 21, bg = "red", # Estilo de atípicos en rojo
outcol = "darkred") # Borde de los puntos atípicos
# 4. Añadimos la leyenda lateral
intervalos_p <- paste0("[", round(hist_pro$breaks[-length(hist_pro$breaks)], 3),
" - ", round(hist_pro$breaks[-1], 3), ")")
legend("topright", inset=c(-0.35, 0),
legend = intervalos_p,
fill = colores_degrade,
title = "Intervalos (%)",
cex = 0.8, bty = "n")
RESUMEN DESCRIPTIVO
RESUMEN DESCRIPTIVO
# Cargar las librerías al inicio
library(dplyr)
library(gt)
library(e1071) # Necesaria para el cálculo de Asimetría y Curtosis
#----------------------- ANÁLISIS ESTADÍSTICO P_pct_AES_ST -----------------------
# 1. Preparación de la variable continua
datos$P_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$P_pct_AES_ST))))
# 2. Limpieza de valores nulos o negativos
P_LIMPIA <- datos$P_pct_AES_ST[!is.na(datos$P_pct_AES_ST) & datos$P_pct_AES_ST > 0]
# 3. Cálculos estadísticos descriptivos consolidados aplicando simbología
resumen_stats_P <- data.frame(
Estadistico = c("Tamaño muestral (n)",
"Mínimo (Min)",
"Máximo (Max)",
"Media (x̄)",
"Mediana (Me)",
"Desviación Estándar (s)",
"Coef. Variación (CV)",
"Asimetría (As)",
"Curtosis (K)"),
Valor = c(
length(P_LIMPIA),
min(P_LIMPIA),
max(P_LIMPIA),
mean(P_LIMPIA),
median(P_LIMPIA),
sd(P_LIMPIA),
(sd(P_LIMPIA) / mean(P_LIMPIA)) * 100,
skewness(P_LIMPIA, type = 2),
kurtosis(P_LIMPIA)
)
)
# 4. Redondeo técnico para presentación en el reporte (2 decimales)
resumen_stats_P$Valor <- round(resumen_stats_P$Valor, 2)
#----------------------- SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_stats_p_gt <- resumen_stats_P %>%
gt() %>%
tab_header(
title = md("**Tabla N° 3**"),
subtitle = md("Estadística Descriptiva para Concentraciones de Fósforo (P)")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
cols_label(
Estadistico = "Parámetro Estadístico",
Valor = "Resultado"
) %>%
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
)
# Renderizar la tabla en el documento de RMarkdown
tabla_stats_p_gt| Tabla N° 3 | |
| Estadística Descriptiva para Concentraciones de Fósforo (P) | |
| Parámetro Estadístico | Resultado |
|---|---|
| Tamaño muestral (n) | 1038.00 |
| Mínimo (Min) | 0.01 |
| Máximo (Max) | 17.20 |
| Media (x̄) | 0.16 |
| Mediana (Me) | 0.05 |
| Desviación Estándar (s) | 0.81 |
| Coef. Variación (CV) | 490.28 |
| Asimetría (As) | 13.81 |
| Curtosis (K) | 234.07 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|
CONCLUSION
El análisis descriptivo del fósforo (P) sobre 1038 muestras válidas reporta un rango de 0.01% a 17.20%, con una media de 0.16% y una mediana de 0.05%. Su coeficiente de variación (490.28%) y desviación estándar (0.81) reflejan una dispersión extremadamente alta, lo que indica un conjunto geoquímico masivamente heterogéneo en el yacimiento. Finalmente, los índices de forma muestran una asimetría fuertemente positiva de 13.81 y una curtosis extrema de 235.67, confirmando una distribución con acumulación marcada en las leyes geoquímicas mínimas y la presencia de numerosos valores atípicos que dominan la variabilidad del depósito.