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/USER/Documents/PROYECTO 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" ...
## $ DATE_SUBMITTED : 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" "Exact" "" "" ...
## $ 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]
ANÁLISIS Y DISTRIBUCIÓN DE FRECUENCIAS: CONCENTRACIÓN DE CALCIO (Ca)
# Cargar las librerías necesarias
library(dplyr)
library(gt)
#----------------------- PROCESAMIENTO Ca_pct_AES_ST -----------------------
# 1. Limpieza y preparación de la variable (conversión de coma a punto)
datos$Ca_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ca_pct_AES_ST))))
# Separar registros con concentraciones válidas (>= 0) de los nulos o negativos
ca_numerico <- datos$Ca_pct_AES_ST[datos$Ca_pct_AES_ST >= 0 & !is.na(datos$Ca_pct_AES_ST)]
n_sin_datos_ca <- sum(is.na(datos$Ca_pct_AES_ST) | datos$Ca_pct_AES_ST < 0)
# 2. Tabla de Frecuencias de los valores geoquímicos reales
TDF_VALIDOS_CA <- as.data.frame(table(ca_numerico), stringsAsFactors = FALSE)
colnames(TDF_VALIDOS_CA) <- c("CATEGORIA", "ni")
# Convertir categoría a numérico para ordenar de menor a mayor concentración (%)
TDF_VALIDOS_CA$CATEGORIA <- as.numeric(TDF_VALIDOS_CA$CATEGORIA)
TDF_VALIDOS_CA <- TDF_VALIDOS_CA[order(TDF_VALIDOS_CA$CATEGORIA), ]
# Definición de horizontes cuantitativos para el balance unificado
total_variable_ca <- sum(TDF_VALIDOS_CA$ni) # Total de muestras con lecturas de Ca
total_general_ca <- total_variable_ca + n_sin_datos_ca # Total absoluto de la matriz (1366)
# 3. Agrupación: Top 10 valores de concentración más recurrentes + Otras Concentraciones
if(nrow(TDF_VALIDOS_CA) > 10) {
tabla_top_ca <- head(TDF_VALIDOS_CA, 10)
sum_otros_ca <- sum(TDF_VALIDOS_CA$ni[11:nrow(TDF_VALIDOS_CA)])
fila_otros_ca <- data.frame(CATEGORIA = "Otras Concentraciones", ni = sum_otros_ca)
tabla_final_base_ca <- rbind(tabla_top_ca, fila_otros_ca)
} else {
tabla_final_base_ca <- TDF_VALIDOS_CA
}
# Convertir CATEGORIA a carácter para permitir el ensamblaje de texto
tabla_final_base_ca$CATEGORIA <- as.character(tabla_final_base_ca$CATEGORIA)
# 4. Calcular frecuencias relativas (hi) respecto al total general del proyecto
tabla_final_base_ca$hi <- round((tabla_final_base_ca$ni / total_general_ca) * 100, 4)
# 5. FILA DEL TOTAL EXCLUSIVO DE LA VARIABLE (Muestras con datos de Calcio)
fila_total_var_ca <- data.frame(
CATEGORIA = "TOTAL VARIABLE (Ca)",
ni = total_variable_ca,
hi = round((total_variable_ca / total_general_ca) * 100, 4)
)
# 6. FILA DE CONTRASTE: REGISTROS SIN INFORMACIÓN ANALÍTICA (NAs / Negativos)
fila_sin_datos_ca <- data.frame(
CATEGORIA = "Sin Datos",
ni = n_sin_datos_ca,
hi = round((n_sin_datos_ca / total_general_ca) * 100, 4)
)
# 7. FILA DEL TOTAL GENERAL DEL PROYECTO
fila_total_general_ca <- data.frame(
CATEGORIA = "TOTAL GENERAL",
ni = total_general_ca,
hi = 100 # Cierre perfecto de balance formal
)
# 8. Consolidar la matriz final incluyendo el total de la variable
tabla_final_ca <- rbind(tabla_final_base_ca, fila_total_var_ca, fila_sin_datos_ca, fila_total_general_ca)
colnames(tabla_final_ca) <- c("Valor Ca (%)", "ni", "hi")
#----------------------- GENERAR SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_calcio_completa_gt <- tabla_final_ca %>%
gt() %>%
tab_header(
title = md("**Tabla N° 1**"),
subtitle = md("Distribución de frecuencias para concentraciones de Calcio (Ca)")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
cols_label(
`Valor Ca (%)` = "Valor Ca (%)",
ni = "n (abs)",
hi = "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 = "-"
)
# Renderizar la tabla en el documento
tabla_calcio_completa_gt
| Tabla N° 1 | ||
| Distribución de frecuencias para concentraciones de Calcio (Ca) | ||
| Valor Ca (%) | n (abs) | hi (%) |
|---|---|---|
| 0.01 | 8 | 0.5857 |
| 0.02 | 16 | 1.1713 |
| 0.03 | 33 | 2.4158 |
| 0.04 | 22 | 1.6105 |
| 0.05 | 20 | 1.4641 |
| 0.06 | 19 | 1.3909 |
| 0.07 | 18 | 1.3177 |
| 0.08 | 21 | 1.5373 |
| 0.09 | 10 | 0.7321 |
| 0.1 | 78 | 5.7101 |
| Otras Concentraciones | 912 | 66.7643 |
| TOTAL VARIABLE (Ca) | 1157 | 84.6999 |
| Sin Datos | 209 | 15.3001 |
| TOTAL GENERAL | 1366 | 100.0000 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
||
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE CALCIO
# Cargar las librerías necesarias
library(dplyr)
library(gt)
#------------------------- PREPARACIÓN DE DATOS (Calcio) -------------------------
# Conversión a numérico (reemplazando comas por puntos y manejando advertencias)
datos$Ca_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ca_pct_AES_ST))))
# Creamos la variable de trabajo Ca asegurando que los datos estén limpios desde el inicio
Ca_VAR <- datos$Ca_pct_AES_ST[!is.na(datos$Ca_pct_AES_ST) & datos$Ca_pct_AES_ST >= 0]
Ca_Limpio <- Ca_VAR
#------------------------- ANÁLISIS ESTADÍSTICO BÁSICO -------------------------
cat("\n=======================================================\n")
##
## =======================================================
cat("ANÁLISIS DE CONCENTRACIÓN (Ca_pct_AES_ST):\n")
## ANÁLISIS DE CONCENTRACIÓN (Ca_pct_AES_ST):
cat("La concentración promedio es: ", round(mean(Ca_VAR, na.rm = TRUE), 2), " % \n")
## La concentración promedio es: 3.28 %
cat("La concentración máxima detectada es: ", max(Ca_VAR, na.rm = TRUE), " % \n")
## La concentración máxima detectada es: 35.3 %
cat("Total de muestras analizadas: ", sum(!is.na(Ca_VAR)), " registros \n")
## Total de muestras analizadas: 1157 registros
cat("=======================================================\n\n")
## =======================================================
#------------------------- TABLA DE FRECUENCIAS - STURGES -------------------------
# 1. Parámetros básicos: Rango, Número de clases (Sturges) y Amplitud
R <- max(Ca_Limpio) - min(Ca_Limpio)
k <- floor(1 + 3.322 * log10(length(Ca_Limpio)))
A <- R / k
# 2. Definición de límites y Marcas de Clase (MC)
liminf <- seq(from = min(Ca_Limpio), by = A, length.out = k)
limsup <- liminf + A
MC <- (liminf + limsup) / 2
# 3. Conteo de frecuencias por clase (n)
n <- numeric(k)
for (i in 1:k) {
if (i == k) {
n[i] <- sum(Ca_VAR >= liminf[i] & Ca_VAR <= limsup[i], na.rm = TRUE)
} else {
n[i] <- sum(Ca_VAR >= liminf[i] & Ca_VAR < 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 -------------------------
TablaCa_Sturges <- data.frame(
Clase = as.character(1:k), # Convertido a carácter para permitir la fila "**TOTALES**"
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
fila_totales_Ca <- data.frame(
Clase = "**TOTALES**",
liminf = NA,
limsup = NA,
MC = NA,
n = sum(n),
hi = 100,
Ni_asc = NA,
Hi_asc = 100,
Ni_desc = NA,
Hi_desc = 100
)
# Unión de cuerpo y total
TablaCa_Final <- rbind(TablaCa_Sturges, fila_totales_Ca)
#------------------------- MOSTRAR TABLA FINAL CON 'gt' -------------------------
tabla_sturges_ca_gt <- TablaCa_Final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 2**"),
subtitle = md("Distribución de frecuencias para concentraciones de Calcio (Ca) <br> mediante Regla de Sturges")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
fmt_markdown(columns = Clase) %>% # Asegura que "**TOTALES**" salga en negrita correctamente
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 documento
tabla_sturges_ca_gt
| Tabla N° 2 | |||||||||
| Distribución de frecuencias para concentraciones de Calcio (Ca) mediante Regla de Sturges |
|||||||||
| Clase | Linf (%) | Lsup (%) | MC (%) | n (abs) | hi (%) | Ni (↑) | Hi (↑) | Ni (↓) | Hi (↓) |
|---|---|---|---|---|---|---|---|---|---|
| 1 | 0.010 | 3.218 | 1.614 | 841 | 72.69 | 841 | 72.69 | 1157 | 100.00 |
| 2 | 3.218 | 6.426 | 4.822 | 118 | 10.20 | 959 | 82.89 | 316 | 27.31 |
| 3 | 6.426 | 9.635 | 8.030 | 66 | 5.70 | 1025 | 88.59 | 198 | 17.11 |
| 4 | 9.635 | 12.843 | 11.239 | 42 | 3.63 | 1067 | 92.22 | 132 | 11.41 |
| 5 | 12.843 | 16.051 | 14.447 | 33 | 2.85 | 1100 | 95.07 | 90 | 7.78 |
| 6 | 16.051 | 19.259 | 17.655 | 28 | 2.42 | 1128 | 97.49 | 57 | 4.93 |
| 7 | 19.259 | 22.467 | 20.863 | 11 | 0.95 | 1139 | 98.44 | 29 | 2.51 |
| 8 | 22.467 | 25.675 | 24.071 | 9 | 0.78 | 1148 | 99.22 | 18 | 1.56 |
| 9 | 25.675 | 28.884 | 27.280 | 3 | 0.26 | 1151 | 99.48 | 9 | 0.78 |
| 10 | 28.884 | 32.092 | 30.488 | 2 | 0.17 | 1153 | 99.65 | 6 | 0.52 |
| 11 | 32.092 | 35.300 | 33.696 | 4 | 0.35 | 1157 | 100.00 | 4 | 0.35 |
| TOTALES | NA | NA | NA | 1157 | 100.00 | NA | 100.00 | NA | 100.00 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|||||||||
POLÍGONO DE FRECUENCUAS ABSOLUTAS DEL CALCIO (Ca)
#----------------------- PROCESAMIENTO AUTOMÁTICO Ca_pct_AES_ST -----------------------
# 1. Conversión de la variable a numérico y limpieza de datos (Calcio)
datos$Ca_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ca_pct_AES_ST))))
# Mantenemos el criterio estadístico: valores reales mayores o iguales a cero
Ca_VAR <- datos$Ca_pct_AES_ST[!is.na(datos$Ca_pct_AES_ST) & datos$Ca_pct_AES_ST >= 0]
#----------------------- EXTRACCIÓN METODOLÓGICA DE STURGES -----------------------
# 2. Calculamos los parámetros de Sturges para el Calcio automáticamente
n_total_ca <- length(Ca_VAR)
k_sturges_ca <- floor(1 + 3.322 * log10(n_total_ca))
# 3. Definimos los cortes de intervalos (breaks) usando el rango real del Calcio
rango_ca <- max(Ca_VAR) - min(Ca_VAR)
amplitud_ca <- rango_ca / k_sturges_ca
breaks_sturges_ca <- seq(from = min(Ca_VAR), by = amplitud_ca, length.out = k_sturges_ca + 1)
# 4. CAPTURA DE DATOS OCULTOS: Agrupación y conteo en memoria para Calcio
hist_objeto_ca <- hist(Ca_VAR, breaks = breaks_sturges_ca, plot = FALSE, right = FALSE)
# NUEVO: Cálculo de las Frecuencias Relativas hi (%)
hi_ca_pct <- (hist_objeto_ca$counts / n_total_ca) * 100
#----------------------- ANCLAJE A CERO -----------------------
# 5. Creamos las clases vacías a los extremos para que el polígono cierre en el eje X
mc_inicio_ca <- hist_objeto_ca$mids[1] - amplitud_ca
mc_final_ca <- hist_objeto_ca$mids[length(hist_objeto_ca$mids)] + amplitud_ca
# Unimos los vectores definitivos para el gráfico (Marcas de Clase y Frecuencias hi)
marcas_clase_ca <- c(mc_inicio_ca, hist_objeto_ca$mids, mc_final_ca)
frecuencias_hi <- c(0, hi_ca_pct, 0) # Anclamos el porcentaje a 0 en los extremos
# Detectamos la frecuencia relativa máxima real del calcio para el eje Y
max_y_hi <- max(frecuencias_hi)
#----------------------- GRAFICAR POLÍGONO DE FRECUENCIAS (Calcio) -----------------------
par(mar = c(5, 5, 4, 2))
# 6. Inicializar el lienzo con los límites calculados para el Calcio
plot(marcas_clase_ca, frecuencias_hi,
type = "n",
main = "Gráfica 1: Polígono de Frecuencias Relativas de Calcio (Ca)",
xlab = "Marca de Clase - MC (%)",
ylab = "Frecuencia Relativa - hi (%)",
xlim = c(min(marcas_clase_ca), max(marcas_clase_ca)), # Ajuste para incluir los anclajes
ylim = c(0, max_y_hi * 1.1), # Margen del 10% superior libre
xaxt = "n", yaxt = "n",
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# 7. Dibujar el polígono (Azul cobalto oscuro)
lines(marcas_clase_ca, frecuencias_hi, type = "b", pch = 19, col = "deepskyblue4", lwd = 3)
# 8. Relleno translúcido a juego debajo de la curva
polygon(marcas_clase_ca, frecuencias_hi, col = rgb(0, 0.41, 0.58, 0.12), border = NA)
#----------------------- PERSONALIZACIÓN DE EJES CONTINUOS -----------------------
# Eje X: Imprime las Marcas de Clase (MC) reales de la tabla (3 decimales)
axis(1, at = hist_objeto_ca$mids, labels = round(hist_objeto_ca$mids, 2), cex.axis = 0.75, las = 1)
# Eje Y: Imprime marcas proporcionales y ancla el valor de hi más alto detectado (redondeado a 2 decimales)
marcas_eje_y_hi <- pretty(c(0, max_y_hi))
marcas_eje_y_hi <- marcas_eje_y_hi[marcas_eje_y_hi < (max_y_hi * 0.9)]
axis(2, at = c(marcas_eje_y_hi, max_y_hi), labels = round(c(marcas_eje_y_hi, max_y_hi), 2), las = 1, cex.axis = 0.8)
HISTOGRAMA DISTRIBUCIÓN DE CALCIO
#----------------------- PROCESAMIENTO Ca_pct_AES_ST -----------------------
# 1. Conversión de Ca_pct_AES_ST a numérico (blindado contra comas y textos)
datos$Ca_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ca_pct_AES_ST))))
# Creamos variable de trabajo para las gráficas y FILTRAMOS negativos/NAs
Ca_VAR <- datos$Ca_pct_AES_ST[!is.na(datos$Ca_pct_AES_ST) & datos$Ca_pct_AES_ST >= 0]
#----------------------- HISTOGRAMA DE FRECUENCIAS SIMPLIFICADA -----------------------
# Agrupamos por rangos automáticos (bins) para legibilidad
ca_simplificado <- 5
# Usamos pretty para obtener cortes redondeados y estéticos
breaks_s <- pretty(Ca_VAR, n = ca_simplificado)
# 2. Generación del Histograma
hist(Ca_VAR,
breaks = breaks_s,
main = "Gráfica 2: Distribución de Ca_pct_AES_ST (Simplificada)",
xlab = "Concentración de Ca (%)",
ylab = "Cantidad de muestras",
col = "lightblue", # Color ajustado para diferenciarlo de "gold"
right = FALSE)
#----------------------- PREPARACIÓN DE DATOS (Calcio) -----------------------
datos$Ca_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ca_pct_AES_ST))))
Ca_VAR <- datos$Ca_pct_AES_ST[!is.na(datos$Ca_pct_AES_ST) & datos$Ca_pct_AES_ST >= 0]
#----------------------- 1. CÁLCULO DE INTERVALOS (REGLA DE STURGES) -----------------------
# Calculamos las clases (k) y la amplitud (A) dinámicamente usando Sturges
k <- floor(1 + 3.322 * log10(length(Ca_VAR)))
R_rango <- max(Ca_VAR) - min(Ca_VAR)
A_amplitud <- R_rango / k
# Generamos los cortes matemáticos exactos basados en la amplitud
breaks_ca <- seq(from = min(Ca_VAR), by = A_amplitud, length.out = k + 1)
# Calculamos el histograma de forma invisible para extraer los datos
h_data_ca <- hist(Ca_VAR, breaks = breaks_ca, plot = FALSE)
# Creamos las etiquetas para la leyenda uniendo los límites de cada clase
intervalos_ca <- paste0("[", round(head(breaks_ca, -1), 1), " - ", round(tail(breaks_ca, -1), 1), "]")
#----------------------- ESTÉTICA Y COLORES -----------------------
# Paleta de colores degradada
mis_colores <- colorRampPalette(c("#55FFFF", "#D4FFFF", "#E0FFFF", "#FDE0FF", "#FF88FF"))(length(h_data_ca$counts))
# Ajustamos márgenes (espacio derecho para la leyenda)
par(mar=c(5, 5, 4, 10), xpd = TRUE)
#----------------------- GENERACIÓN DEL GRÁFICO -----------------------
plot(h_data_ca,
col = mis_colores,
border = "white",
main = "Grafica 3: Distribucion de Ca_pct_AES_ST (Sturges)",
xlab = "Contenido de Calcio (%)",
ylab = "Frecuencia (Cantidad)",
ylim = c(0, max(h_data_ca$counts) * 1.15), # Límite Y dinámico + 15% de margen
xaxt = "n",
las = 0.6)
# Eje X dinámico
axis(1, at = breaks_ca, labels = round(breaks_ca, 1), font = 2, cex.axis = 0.7)
# Valores exactos sobre cada barra
text(x = h_data_ca$mids, y = h_data_ca$counts,
labels = h_data_ca$counts,
pos = 3, cex = 1, col = "black")
# Leyenda lateral
legend("topright",
inset = c(-0.35, 0),
title = "Intervalos (%)",
legend = intervalos_ca,
fill = mis_colores,
border = "black",
bty = "n",
cex = 0.75)
OJIVAS ni Y hi
#----------------------- OJIVA INTEGRADA Y PROFESIONAL (Calcio) -----------------------
# 1. Construimos los cortes del eje X l
cortes_eje_x_ca <- c(liminf, limsup[length(limsup)])
# Restauramos los márgenes a la normalidad
par(mar=c(5, 5, 4, 2))
#
plot(MC, Ni_asc,
main = "Gráfica 4: Ojiva Acumulada de Frecuencia del Calcio (ni)",
xlab = "Contenido de Calcio (%)",
ylab = "Frecuencia Acumulada (N muestras)",
type = "b", pch = 19, col = "steelblue", lwd = 3,
xaxt = "n", las = 1,
ylim = c(0, max(Ni_asc) * 1.05),
panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) # Rejilla de fondo
# Línea descendente
lines(MC, Ni_desc, type = "b", pch = 17, col = "darkblue", lwd = 3, lty = 2)
# Eje X
axis(1, at = cortes_eje_x_ca, labels = round(cortes_eje_x_ca, 2), cex.axis = 0.8)
# Leyenda
legend("right",
legend = c("Acumulada Menor que (Ascendente)", "Acumulada Mayor que (Descendente)"),
col = c("steelblue", "darkblue"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n", # Sin caja de borde
cex = 0.85)
#----------------------- OJIVA PROFESIONAL EN PORCENTAJES (Ca) - FRECUENCIAS RELATIVAS ---------
par(mar=c(5, 5, 4, 2))
# Usamos directamente
plot(MC, Hi_asc,
main = "Gráfica 5: Ojiva Acumulada de Frecuencias de Calcio (hi)",
xlab = "Contenido de Calcio (%)",
ylab = "Frecuencia Relativa Acumulada (%)",
type = "b", pch = 19, col = "steelblue", lwd = 3,
xaxt = "n", las = 1,
ylim = c(0, 105), # Escala fija de 0 a 105%
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# Línea descendente (Mayor que)
lines(MC, Hi_desc, type = "b", pch = 17, col = "darkblue", lwd = 3, lty = 2)
# Eje X con los intervalos exactos
axis(1, at = cortes_eje_x_ca, labels = round(cortes_eje_x_ca, 2), cex.axis = 0.8)
# Leyenda adaptada a la escala de porcentajes
legend("right",
legend = c("Acumulada Menor que (Ascendente %)", "Acumulada Mayor que (Descendente %)"),
col = c("steelblue", "darkblue"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n",
cex = 0.85)
BOXPLOTS DE VALORES ATÍPICOS Y DISTRIBUCIÓN LIMPIA
#----------------------- PREPARACIÓN DE DATOS (Calcio) -----------------------
# Filtramos NAs y negativos.
datos$Ca_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ca_pct_AES_ST))))
Ca_VAR <- datos$Ca_pct_AES_ST[!is.na(datos$Ca_pct_AES_ST) & datos$Ca_pct_AES_ST >= 0]
#----------------------- DIAGRAMA DE CAJA (CON ATÍPICOS) -----------------------
par(mar=c(5, 6, 4, 2))
# Cálculos estadísticos
media_ca <- round(mean(Ca_VAR), 2)
mediana_ca <- round(median(Ca_VAR), 2)
outliers_ca <- boxplot.stats(Ca_VAR)$out
n_outliers_ca <- length(outliers_ca)
# Creación del Boxplot
boxplot(Ca_VAR,
horizontal = TRUE,
col = "#E1F5FE", # Fondo azul muy claro para la caja
border = "#0277BD", # Borde azul oscuro
main = "Gráfica 6: Análisis de Valores Atípicos (Calcio)",
xlab = "Concentración (%)",
pch = 21,
bg = "red", # Atípicos en rojo para que resalten
outcol = "darkred") # Borde de los puntos atípicos
# Agregar punto de media
points(media_ca, 1,
col = "darkgreen", # Verde oscuro para contrastar con el fondo celeste
pch = 18,
cex = 2)
# Etiquetas de valores
text(media_ca, 1.25,
labels = paste("Media:", media_ca),
col = "darkgreen",
font = 2,
cex = 0.8)
text(mediana_ca, 0.75,
labels = paste("Mediana:", mediana_ca),
col = "#0277BD", # Mismo color que el borde de la caja
font = 2,
cex = 0.7)
# Leyenda para los valores atípicos
legend("topright",
legend = c(paste("Outliers:", n_outliers_ca)),
pch = 21,
pt.bg = "red",
bty = "n")
#----------------------- PREPARACIÓN DE DATOS (Calcio) -----------------------
# Usamos 'datos' en minúsculas y filtramos NAs y negativos (sin limitar a < 10)
datos$Ca_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ca_pct_AES_ST))))
Ca_VAR <- datos$Ca_pct_AES_ST[!is.na(datos$Ca_pct_AES_ST) & datos$Ca_pct_AES_ST >= 0]
# Cálculos estadísticos necesarios para las etiquetas
media_ca <- round(mean(Ca_VAR), 2)
mediana_ca <- round(median(Ca_VAR), 2)
#----------------------- DIAGRAMA DE CAJA (DISTRIBUCIÓN LIMPIA) -----------------------
# outline = FALSE oculta los puntos atípicos para ver solo la caja principal (cuartiles)
boxplot(Ca_VAR, horizontal = TRUE, outline = FALSE,
col = "#B2EBF2", border = "#0097A7",
main = "Gráfica 7: Distribución del Cuerpo Mineral (Sin Atípicos)",
xlab = "Concentración (%)")
# Agregamos una rejilla para facilitar la lectura del eje X
grid(nx = NULL, ny = NA, col = "gray85", lty = "dotted")
# Agregar punto de media (Usamos rojo oscuro para que contraste bien con el cyan)
points(media_ca, 1, col = "darkred", pch = 18, cex = 2)
# Etiquetas de valores
text(media_ca, 1.25,
labels = paste("Media:", media_ca),
col = "darkred",
font = 2,
cex = 0.8)
text(mediana_ca, 0.75,
labels = paste("Mediana:", mediana_ca),
col = "#0097A7",
font = 2,
cex = 0.8)
HISTOGRAMA CON BOXPLOT FLOTANTE (CALCIO)
#----------------------- PREPARACIÓN DE DATOS -----------------------
# Conversión y limpieza de la variable Ca_pct_AES_ST
datos$Ca_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ca_pct_AES_ST))))
Ca_VAR <- datos$Ca_pct_AES_ST[!is.na(datos$Ca_pct_AES_ST) & datos$Ca_pct_AES_ST >= 0]
#----------------------- METODOLOGÍA DE STURGES EXACTA -----------------------
# Cálculo dinámico de clases y amplitud
k <- floor(1 + 3.322 * log10(length(Ca_VAR)))
R_rango <- max(Ca_VAR) - min(Ca_VAR)
A_amplitud <- R_rango / k
# Generamos los cortes matemáticos exactos
breaks_ca <- seq(from = min(Ca_VAR), by = A_amplitud, length.out = k + 1)
#----------------------- CÁLCULO DEL HISTOGRAMA (INVISIBLE) -----------------------
# Calculamos el histograma internamente para extraer datos
hist_pro_ca <- hist(Ca_VAR, breaks = breaks_ca, plot = FALSE, right = FALSE)
max_y_ca <- max(hist_pro_ca$counts)
#----------------------- CÁLCULO DEL RANGO X TOTAL -----------------------
# Calculamos el rango necesario para abarcar tanto las barras como todos los atípicos
xlim_range <- range(c(Ca_VAR, breaks_ca))
# Aseguramos márgenes normales, con más espacio a la derecha para la leyenda
par(mar = c(5, 5, 4, 12), xpd = TRUE)
#----------------------- GRÁFICA INTEGRADA (HISTOGRAMA) -----------------------
# 1. Dibujamos el histograma base usando tu paleta degradada
mis_colores <- colorRampPalette(c("#55FFFF", "#D4FFFF", "#E0FFFF", "#FDE0FF", "#FF88FF"))(length(hist_pro_ca$counts))
hist(Ca_VAR,
breaks = breaks_ca,
col = mis_colores,
border = "white",
main = "Gráfica 8: Distribución de Calcio con Boxplot Interno",
xlab = "Concentración de Ca (%)",
ylab = "Frecuencia (Cantidad)",
xlim = xlim_range, # Asegura que todo el eje sea visible
ylim = c(0, max_y_ca * 1.15), # Añadimos espacio extra arriba
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 de Sturges)
# Usamos cex.axis = 0.7 para hacer la letra más pequeña y que quepan todos los números
axis(1, at = breaks_ca, labels = round(breaks_ca, 1), font = 2, cex.axis = 0.6)
# 3. Superponemos el Boxplot directamente
boxplot(Ca_VAR,
horizontal = TRUE,
add = TRUE, # Superpone la gráfica
axes = FALSE, # Oculta ejes
at = max_y_ca / 2, # Altura de flotación (mitad del eje Y)
boxwex = max_y_ca / 3, # Grosor de la caja
col = adjustcolor("#E1F5FE", alpha.f = 0.7), # Fondo azul claro con 70% opacidad
border = "#0277BD", # Borde azul 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_ca <- paste0("[", round(hist_pro_ca$breaks[-length(hist_pro_ca$breaks)], 1),
" - ", round(hist_pro_ca$breaks[-1], 1), ")")
legend("topright", inset=c(-0.35, 0),
legend = intervalos_ca,
fill = mis_colores,
title = "Intervalos (%)",
cex = 0.8, bty = "n")
RESUMEN DESCRIPTIVO
# Cargar las librerías necesarias
library(dplyr)
library(gt)
library(e1071) # Necesaria para los cálculos de Asimetría y Curtosis
#----------------------- ANÁLISIS ESTADÍSTICO Ca_pct_AES_ST -----------------------
# 0. Limpieza automática de nombres (elimina espacios invisibles)
colnames(datos) <- trimws(colnames(datos))
# 1. Preparación de la variable y cálculos estadísticos
if("Ca_pct_AES_ST" %in% colnames(datos)) {
# Conversión a numérico (reemplazo de coma por punto)
datos$Ca_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ca_pct_AES_ST))))
# 2. Limpieza de valores nulos o negativos para el análisis real
# Se filtran valores >= 0 (mantenemos datos reales de calcio sin alterar el límite superior)
CA_LIMPIA <- datos$Ca_pct_AES_ST[!is.na(datos$Ca_pct_AES_ST) & datos$Ca_pct_AES_ST >= 0]
# 3. Matriz de parámetros estadísticos descriptivos
resumen_stats_Ca <- 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(CA_LIMPIA),
min(CA_LIMPIA),
max(CA_LIMPIA),
mean(CA_LIMPIA),
median(CA_LIMPIA),
sd(CA_LIMPIA),
(sd(CA_LIMPIA) / mean(CA_LIMPIA)) * 100,
skewness(CA_LIMPIA, type = 2),
kurtosis(CA_LIMPIA)
)
)
# 4. Redondeo técnico uniforme a dos decimales
resumen_stats_Ca$Valor <- round(resumen_stats_Ca$Valor, 2)
} else {
stop("¡ERROR! La columna 'Ca_pct_AES_ST' no existe en el dataset. Verifique el nombre en su archivo de origen.")
}
#----------------------- SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_stats_ca_gt <- resumen_stats_Ca %>%
gt() %>%
tab_header(
title = md("**Tabla N° 3**"),
subtitle = md("Estadística Descriptiva para Concentraciones de Calcio (Ca)")
) %>%
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 final en el reporte
tabla_stats_ca_gt
| Tabla N° 3 | |
| Estadística Descriptiva para Concentraciones de Calcio (Ca) | |
| Parámetro Estadístico | Resultado |
|---|---|
| Tamaño muestral (n) | 1157.00 |
| Mínimo (Min) | 0.01 |
| Máximo (Max) | 35.30 |
| Media (x̅) | 3.28 |
| Mediana (Me) | 0.75 |
| Desviación Estándar (s) | 5.46 |
| Coef. Variación (CV) | 166.78 |
| Asimetría (As) | 2.56 |
| Curtosis (K) | 7.37 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|
CONCLUSIÓN DE LA VARIABLE Ca_pct_AES_ST
El estudio estadístico de 1157.00 muestras de calcio define un rango de leyes entre 0.01% y 35.30%. El depósito presenta una media de 3.28% y una mediana de 0.75%, evidenciando una fuerte dispersión y variabilidad interna respaldada por una desviación estándar de 5.46 y un coeficiente de variación de 166.78%. Finalmente, los parámetros de forma ratifican una distribución marcadamente asimétrica positiva de 2.56 y una curtosis elevada de 7.37. Este comportamiento estadístico corrobora que la mayor parte de las muestras se sitúa en leyes basales bajas (inferiores al 1%), mientras que el promedio se encuentra fuertemente desplazado hacia valores superiores debido a la influencia de anomalías y enriquecimientos locales puntuales de alta ley dentro del yacimiento.