Analisis Inferencial de Minerales Criticos Modelo Multinomial de Coordenadas
Grupo 1
2026-06-18
1. CARGA DE DATOS
CARGA DE DATOS
knitr::opts_chunk$set(
echo = TRUE, # Muestra el codigo 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 automaticamente todas las graficas 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 numeros.
fileEncoding = "latin1")
# Verificacion 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_SUBMITTE : 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]2. TABLA DE DISTRIBUICION DE CANTIDAD
# ============================================================
# TRANSFORMACION ORDINAL DE COORDINATES_QUAL
# ============================================================
# 1. Crear una copia de la variable original
coord <- trimws(datos$COORDINATES_QUAL)
# 2. Eliminar espacios duplicados
coord <- gsub("\\s+", " ", coord)
# 3. Unificar las diferentes formas de escribir cero metros
coord[coord == "0m"] <- "0 m"
# 4. Convertir "Exact" en cero metros
coord[coord == "Exact"] <- "0 m"
# 5. Extraer solamente el valor numerico
coord_metros <- suppressWarnings(
as.numeric(gsub("[^0-9.]", "", coord))
)
# 6. Conservar los valores vacios como NA
coord_metros[is.na(coord) | coord == ""] <- NA
# 7. Crear la variable ordinal agrupada
datos$COORD_ORDINAL <- cut(
coord_metros,
breaks = c(-Inf, 10, 500, Inf),
labels = c(
"Alta precision",
"Media precision",
"Baja precision"
),
ordered_result = TRUE,
right = TRUE
)
# 8. Comprobar que sea una variable ordinal
print(is.ordered(datos$COORD_ORDINAL))## [1] TRUEprint(levels(datos$COORD_ORDINAL))## [1] "Alta precision" "Media precision" "Baja precision"# 9. Tabla de frecuencias
frecuencia_con_na <- table(
datos$COORD_ORDINAL,
useNA = "ifany"
)
print(frecuencia_con_na)##
## Alta precision Media precision Baja precision <NA>
## 330 335 174 527# 10. Porcentajes utilizando solamente datos validos
frecuencia <- table(datos$COORD_ORDINAL)
porcentaje <- prop.table(frecuencia) * 100
print(round(porcentaje, 2))##
## Alta precision Media precision Baja precision
## 39.33 39.93 20.74# 11. Tabla de resultados
tabla_resultados <- data.frame(
Nivel = names(frecuencia),
Frecuencia = as.vector(frecuencia),
Porcentaje = round(as.vector(porcentaje), 2)
)
print(tabla_resultados)## Nivel Frecuencia Porcentaje
## 1 Alta precision 330 39.33
## 2 Media precision 335 39.93
## 3 Baja precision 174 20.74# RESUMEN
coord_validos <- datos$COORD_ORDINAL[!is.na(datos$COORD_ORDINAL)]
coord_vacios <- sum(is.na(datos$COORD_ORDINAL))
cat("Cantidad total:", length(datos$COORD_ORDINAL), "\n")## Cantidad total: 1366cat("Cantidad de valores vacios NA:", coord_vacios, "\n")## Cantidad de valores vacios NA: 527cat("Cantidad valida:", length(coord_validos), "\n")## Cantidad valida: 839# FRECUENCIA ABSOLUTA
Fo <- as.numeric(frecuencia)
names(Fo) <- names(frecuencia)
# FRECUENCIA RELATIVA
hi <- Fo / sum(Fo) * 100
# TABLA
tabla_frecuencias <- data.frame(
Nivel = c(names(frecuencia), "Valores vacios (NA)", "Total valido"),
ni = c(as.numeric(Fo), coord_vacios, sum(Fo)),
hi = c(round(as.numeric(hi), 2), NA, 100)
)
print(tabla_frecuencias)## Nivel ni hi
## 1 Alta precision 330 39.33
## 2 Media precision 335 39.93
## 3 Baja precision 174 20.74
## 4 Valores vacios (NA) 527 NA
## 5 Total valido 839 100.00# TABLA CON GT
library(gt)
library(dplyr)
tabla_coord_gt <- tabla_frecuencias %>%
gt() %>%
tab_header(
title = md("**Tabla Nro 1**"),
subtitle = md("**Distribucion de frecuencias de minas archivadas segun calidad ordinal de coordenadas**")
) %>%
tab_source_note(
source_note = md("Autor: Grupo 1")
) %>%
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
)
tabla_coord_gt| Tabla Nro 1 | ||
| Distribucion de frecuencias de minas archivadas segun calidad ordinal de coordenadas | ||
| Nivel | ni | hi |
|---|---|---|
| Alta precision | 330 | 39.33 |
| Media precision | 335 | 39.93 |
| Baja precision | 174 | 20.74 |
| Valores vacios (NA) | 527 | NA |
| Total valido | 839 | 100.00 |
| Autor: Grupo 1 | ||
3. GRAFICA DE DISTRIBUCION DE CANTIDAD
barplot(Fo,
main = "Grafica 1. Distribucion de cantidad de calidad ordinal\nde coordenadas en minas archivadas",
xlab = "COORD_ORDINAL",
ylab = "Densidad",
col = "lightblue",
names.arg = names(Fo))
4. CONJETURA DEL MODELO
# ==========================================
# CONJETURA DEL MODELO (COORD_ORDINAL)
# ==========================================
# PARAMETROS
n <- sum(Fo)
p <- Fo / n
k <- length(Fo)
# Diagrama de barras con densidad/probabilidad observada
prob_observada <- Fo / n
posiciones <- barplot(prob_observada,
main = "Grafica 2. Comparacion de la realidad con el modelo multinomial de\nCOORD_ORDINAL en minas archivadas",
xlab = "COORD_ORDINAL",
ylab = "Densidad",
col = "lightblue",
border = "black",
names.arg = names(Fo),
ylim = c(0, max(prob_observada) * 1.25))
# MOSTRAR VALORES
cat("Total valido:", n, "\n")## Total valido: 839cat("Probabilidades del modelo multinomial:\n")## Probabilidades del modelo multinomial:print(round(p, 4))## Alta precision Media precision Baja precision
## 0.3933 0.3993 0.2074# CURVA MULTINOMIAL
lines(posiciones, p, col = "black", lwd = 3, type = "b", pch = 19)
legend("topright",
legend = c("Realidad", "Modelo multinomial"),
col = c("lightblue", "black"),
fill = c("lightblue", NA),
border = c("black", NA),
lwd = c(NA, 3),
pch = c(NA, 19),
cex = 0.8)
# ==========================================
# CALCULO DE FRECUENCIAS (Fo y Fe)
# ==========================================
# FRECUENCIAS OBSERVADAS (Realidad)
Fo <- as.numeric(frecuencia)
names(Fo) <- names(frecuencia)
# FRECUENCIAS ESPERADAS (Modelo Teorico)
P <- p
Fe <- P * n
# MOSTRAR RESULTADOS EN CONSOLA
cat("Frecuencias observadas (Fo):\n")## Frecuencias observadas (Fo):print(Fo)## Alta precision Media precision Baja precision
## 330 335 174cat("\nFrecuencias esperadas (Fe):\n")##
## Frecuencias esperadas (Fe):print(round(Fe, 2))## Alta precision Media precision Baja precision
## 330 335 174cat("\nModelo:\n")##
## Modelo:cat("(X1, X2, X3) ~ Multinomial(", n, "; ",
paste(round(P, 4), collapse = ", "), ")\n", sep = "")## (X1, X2, X3) ~ Multinomial(839; 0.3933, 0.3993, 0.2074)5. TEST DE APROBACION
# =========================
# TEST DE APROBACION
# =========================
n <- sum(Fo)
# Convertir a porcentajes
Fo_porcentaje <- (Fo / n) * 100
Fe_porcentaje <- (Fe / n) * 100
plot(Fo_porcentaje, Fe_porcentaje,
main = "Grafica 3: Correlacion de frecuencias en el modelo multinomial (COORD_ORDINAL)",
xlab = "Frecuencia Observada (%)",
ylab = "Frecuencia Esperada (%)",
pch = 19,
col = "forestgreen")
abline(a = 0, b = 1, col = "red", lwd = 2)
# =========================
# TEST DE PEARSON
# =========================
Correlacion <- cor(Fo_porcentaje, Fe_porcentaje) * 100
# =========================
# TEST DE CHI-CUADRADO
# =========================
# GRADOS DE LIBERTAD
gl <- length(Fo) - 1
# ESTADISTICO
x2 <- sum((Fe - Fo)^2 / Fe)
# UMBRAL (Asumiendo 97% de confianza)
umbral <- qchisq(0.97, gl)
# =========================
# TABLA RESUMEN
# =========================
Variable <- c("COORD_ORDINAL")
tabla_resumen <- data.frame(
Variable,
round(Correlacion, 2),
round(x2, 2),
round(umbral, 2)
)
colnames(tabla_resumen) <- c(
"Variable",
"Test Pearson (%)",
"Chi Cuadrado",
"Umbral de aceptacion"
)
library(gt)
library(dplyr)
tabla_resumen_gt <- tabla_resumen %>%
gt() %>%
tab_header(
title = md("**Tabla Nro 2**"),
subtitle = md("**Resultados de las pruebas de bondad de ajuste para COORD_ORDINAL**")
) %>%
tab_source_note(
source_note = md("Autor: Grupo 1")
) %>%
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.border.bottom.color = "black"
)
tabla_resumen_gt| Tabla Nro 2 | |||
| Resultados de las pruebas de bondad de ajuste para COORD_ORDINAL | |||
| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de aceptacion |
|---|---|---|---|
| COORD_ORDINAL | 100 | 0 | 7.01 |
| Autor: Grupo 1 | |||
6. ESTIMACION DE PROBABILIDADES
Cual es la probabilidad de que una mina archivada presente una calidad de coordenadas de Alta precision?
# ==========================================
# CALCULO DE PROBABILIDADES (ALTA PRECISION)
# ==========================================
probabilidad_coord <- P["Alta precision"]
# En porcentaje
cat("Probabilidad:", probabilidad_coord * 100, "%\n")## Probabilidad: 39.33254 %# =========================
# GRAFICA DE PROBABILIDAD
# =========================
x <- seq_along(P)
plot(x, P,
col = "black",
lwd = 2,
type = "n",
main = "Grafica 4. Calculo de probabilidades de COORD_ORDINAL\nen minas archivadas (Alta precision)",
ylab = "Densidad de probabilidad",
xlab = "COORD_ORDINAL",
xlim = c(0.5, length(P) + 0.5),
ylim = c(0, max(P) * 1.25),
xaxt = "n")
axis(1, at = x, labels = names(P))
# Area de probabilidad para Alta precision
rect(1 - 0.15, 0,
1 + 0.15, probabilidad_coord,
col = rgb(1, 0, 0, 0.5),
border = NA)
# Curva multinomial
lines(x, P, col = "black", lwd = 2, type = "b", pch = 19)
legend("topright",
legend = c("Modelo multinomial", "Area de Probabilidad"),
col = c("black", rgb(1, 0, 0, 0.5)),
lwd = c(2, 8),
cex = 0.8)
# Texto de la probabilidad dentro del grafico
texto_prob <- paste0("Probabilidad = ", round(probabilidad_coord * 100, 2), " %")
text(x = 2,
y = max(P) * 0.55,
labels = texto_prob,
col = "black",
cex = 1,
font = 2)
Si se analizan los registros de 50 nuevas minas archivadas, cuantas se esperaria que presenten una calidad de coordenadas de Media precision?
# ==========================================
# PROBABILIDAD DE MEDIA PRECISION
# ==========================================
probabilidad_coord <- P["Media precision"]
# Cantidad esperada en 50 nuevas minas archivadas
minas_esperadas <- probabilidad_coord * 50
# Mostrar resultados
cat("Probabilidad de Media precision:", round(probabilidad_coord * 100, 2), "%\n")## Probabilidad de Media precision: 39.93 %cat("Cantidad de minas esperadas:", round(minas_esperadas), "\n")## Cantidad de minas esperadas: 207. INTERVALOS DE CONFIANZA
# ==========================================
# INTERVALOS DE CONFIANZA (COORD_ORDINAL)
# ==========================================
# CALCULOS
n <- sum(Fo)
x <- P
# Error estandar de cada proporcion
e <- sqrt((x * (1 - x)) / n)
# Calculo de los limites (usando Z=2)
li <- x - 2 * e
ls <- x + 2 * e
# MOSTRAR VALORES EN CONSOLA
cat("Tamano muestral valido:", n, "\n")## Tamano muestral valido: 839cat("Valores vacios NA reportados por separado:", coord_vacios, "\n")## Valores vacios NA reportados por separado: 527cat("Proporciones:\n")## Proporciones:print(round(x, 4))## Alta precision Media precision Baja precision
## 0.3933 0.3993 0.2074cat("Error estandar:\n")## Error estandar:print(round(e, 4))## Alta precision Media precision Baja precision
## 0.0169 0.0169 0.0140cat("Limite inferior:\n")## Limite inferior:print(round(li, 4))## Alta precision Media precision Baja precision
## 0.3596 0.3655 0.1794cat("Limite superior:\n")## Limite superior:print(round(ls, 4))## Alta precision Media precision Baja precision
## 0.4271 0.4331 0.2354# =========================
# TABLA PROFESIONAL
# =========================
library(gt)
library(dplyr)
# Crear el dataframe base
tabla_intervalos_coord <- data.frame(
Nivel = names(P),
"Limite_inferior" = round(li * 100, 2),
"Proporcion_poblacional" = round(x * 100, 2),
"Limite_superior" = round(ls * 100, 2),
"Error_estandar" = round(e * 100, 2)
)
# Ajustar los nombres de las columnas para que se vean bien al imprimir
colnames(tabla_intervalos_coord) <- c("Nivel", "Limite inferior (%)", "Proporcion poblacional (%)", "Limite superior (%)", "Error estandar (%)")
# Crear la tabla con gt
tabla_intervalos_coord_gt <- tabla_intervalos_coord %>%
gt() %>%
tab_header(
title = md("**Tabla Nro 3**"),
subtitle = md("**Intervalo de confianza de las proporciones de COORD_ORDINAL en minas archivadas**")
) %>%
tab_source_note(
source_note = md("Autor: Grupo 1")
) %>%
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
)
tabla_intervalos_coord_gt| Tabla Nro 3 | ||||
| Intervalo de confianza de las proporciones de COORD_ORDINAL en minas archivadas | ||||
| Nivel | Limite inferior (%) | Proporcion poblacional (%) | Limite superior (%) | Error estandar (%) |
|---|---|---|---|---|
| Alta precision | 35.96 | 39.33 | 42.71 | 1.69 |
| Media precision | 36.55 | 39.93 | 43.31 | 1.69 |
| Baja precision | 17.94 | 20.74 | 23.54 | 1.40 |
| Autor: Grupo 1 | ||||
8. CONCLUSION
La variable COORDINATES_QUAL fue transformada en la variable ordinal COORD_ORDINAL, con los niveles Alta precision, Media precision y Baja precision.
La variable COORD_ORDINAL se explica descriptivamente mediante un modelo multinomial, conservando los valores vacios como NA y reportandolos por separado, porque no informado no significa necesariamente baja precision.
Por tanto:
\[ (X_1, X_2, X_3) \sim Multinomial(n; p_1, p_2, p_3) \]
Si se desea explicar COORD_ORDINAL mediante otras variables, lo mas correcto es utilizar una regresion logistica ordinal, porque la regresion multinomial comun ignora el orden de las categorias.