Análisis Inferencial de Tipo de Depósito (DEPOSIT_TYPE) - Modelo Binomial
Grupo 1
2026-06-18
CARGA DE DATOS
CARGA DE DATOS
library(dplyr)
library(gt)
datos <- read.csv(
"C:/Users/Martin/Desktop/Estadistica/CMDB_Data.csv",
header = TRUE,
sep = ";",
dec = ".",
fileEncoding = "latin1"
)
if (!"DEPOSIT_TYPE" %in% names(datos)) {
stop("La variable DEPOSIT_TYPE no existe en el archivo de datos.")
}
# 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" ...
## $ 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 correctamente los datos para el análisis inferencial de
la variable DEPOSIT_TYPE mediante el modelo probabilístico
binomial.
LIMPIEZA DE LA VARIABLE DEPOSIT_TYPE
# Convertir la variable a texto para facilitar la limpieza
deposit_type <- as.character(datos$DEPOSIT_TYPE)
deposit_type <- trimws(deposit_type)
# Estandarizar valores vacios, nulos o desconocidos
deposit_type[
is.na(deposit_type) |
deposit_type == "" |
tolower(deposit_type) %in% c("unknown", "desconocido", "na", "n/a")
] <- "Desconocido"
# Para el modelo se usan solo registros validos
deposit_type_valido <- deposit_type[deposit_type != "Desconocido"]
deposit_type_valido <- factor(deposit_type_valido)
if (length(deposit_type_valido) == 0) {
stop("No existen datos validos para DEPOSIT_TYPE despues de la limpieza.")
}
cat("Cantidad total de registros:", length(deposit_type), "\n")## Cantidad total de registros: 1366cat("Cantidad de registros validos:", length(deposit_type_valido), "\n")## Cantidad de registros validos: 1363cat("Cantidad de registros desconocidos:", sum(deposit_type == "Desconocido"), "\n")## Cantidad de registros desconocidos: 3TABLA DE DISTRIBUCIÓN DE CANTIDAD
# Tabla de frecuencias por tipo de deposito
TDFDEPOSIT <- table(deposit_type_valido)
TDFDEPOSIT_ORD <- sort(TDFDEPOSIT, decreasing = TRUE)
tabla_frecuencias <- as.data.frame(TDFDEPOSIT_ORD)
colnames(tabla_frecuencias) <- c("Tipo_de_deposito", "ni")
total_muestras <- sum(tabla_frecuencias$ni)
tabla_frecuencias$hi <- tabla_frecuencias$ni / total_muestras
tabla_frecuencias$hi_porc <- round(tabla_frecuencias$hi * 100, 2)
Fila_Total <- data.frame(
Tipo_de_deposito = "TOTAL",
ni = sum(tabla_frecuencias$ni),
hi = round(sum(tabla_frecuencias$hi), 4),
hi_porc = round(sum(tabla_frecuencias$hi_porc), 2)
)
tabla_frecuencias_total <- rbind(tabla_frecuencias, Fila_Total)
tabla_deposit_gt <- tabla_frecuencias_total %>%
gt() %>%
fmt_number(
columns = hi,
decimals = 4
) %>%
fmt_number(
columns = hi_porc,
decimals = 2
) %>%
cols_label(
Tipo_de_deposito = "Tipo de deposito",
ni = "Frecuencia absoluta (ni)",
hi = "Frecuencia relativa (hi)",
hi_porc = "Porcentaje (%)"
) %>%
tab_header(
title = md("**Tabla N. 1**"),
subtitle = md("Distribucion de frecuencias de la variable DEPOSIT_TYPE")
) %>%
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
)
tabla_deposit_gt| Tabla N. 1 | |||
| Distribucion de frecuencias de la variable DEPOSIT_TYPE | |||
| Tipo de deposito | Frecuencia absoluta (ni) | Frecuencia relativa (hi) | Porcentaje (%) |
|---|---|---|---|
| Porphyry Cu-Mo | 154 | 0.1130 | 11.30 |
| IOCG | 139 | 0.1020 | 10.20 |
| Polymetallic vein | 116 | 0.0851 | 8.51 |
| Porphyry Cu | 94 | 0.0690 | 6.90 |
| Polymetallic replacement | 82 | 0.0602 | 6.02 |
| IOA | 58 | 0.0426 | 4.26 |
| Low sulfidation epithermal Au-Ag-Te | 37 | 0.0271 | 2.71 |
| MVT | 32 | 0.0235 | 2.35 |
| Porphyry Cu, skarn-related | 31 | 0.0227 | 2.27 |
| Hot-spring Au-Ag | 29 | 0.0213 | 2.13 |
| Sediment-hosted Au | 28 | 0.0205 | 2.05 |
| High sulfidation epithermal Au-Ag | 26 | 0.0191 | 1.91 |
| Polymetallic skarn | 24 | 0.0176 | 1.76 |
| Sediment-hosted Cu | 24 | 0.0176 | 1.76 |
| Epithermal vein, Comstock | 23 | 0.0169 | 1.69 |
| Polymetallic massive sulfide, Kuroko-type | 23 | 0.0169 | 1.69 |
| Skarn Cu | 21 | 0.0154 | 1.54 |
| Polymetallic massive sulfide | 20 | 0.0147 | 1.47 |
| Low sulfidation epithermal, Comstock | 19 | 0.0139 | 1.39 |
| Homestake stratiform Au | 18 | 0.0132 | 1.32 |
| Distal disseminated Ag-Au | 15 | 0.0110 | 1.10 |
| Sedimentary exhalative Zn-Pb | 15 | 0.0110 | 1.10 |
| Cu-Zn massive sulfide, Besshi-type | 12 | 0.0088 | 0.88 |
| Cu-Zn massive sulfide, Kuroko-type | 11 | 0.0081 | 0.81 |
| Low-sulfide Au-quartz vein | 11 | 0.0081 | 0.81 |
| Supergene Cu | 11 | 0.0081 | 0.81 |
| Polymetallic skarn and replacement | 10 | 0.0073 | 0.73 |
| Banded iron formation, Algoma-type | 9 | 0.0066 | 0.66 |
| Cu-Zn sulfide (metamorphosed?) | 9 | 0.0066 | 0.66 |
| Cu massive sulfide, Besshi-type | 9 | 0.0066 | 0.66 |
| Intermediate sulfidation epithermal | 9 | 0.0066 | 0.66 |
| Kennecott-type Cu | 9 | 0.0066 | 0.66 |
| Oxide Zn, metamorphosed | 9 | 0.0066 | 0.66 |
| Porphyry Cu-Au | 9 | 0.0066 | 0.66 |
| High sulfidation epithermal Au-Ag, Lithocap alunite | 8 | 0.0059 | 0.59 |
| Low sulfidation epithermal | 8 | 0.0059 | 0.59 |
| Cu sulfide | 7 | 0.0051 | 0.51 |
| Impact-related Cu-Ni-PGE | 7 | 0.0051 | 0.51 |
| Intermediate sulfidation epithermal, Creede | 7 | 0.0051 | 0.51 |
| Detachment fault-related polymetallic | 6 | 0.0044 | 0.44 |
| Magmatic sulfide | 6 | 0.0044 | 0.44 |
| Orogenic Au | 6 | 0.0044 | 0.44 |
| Polymetallic sulfide vein, intermediate sulfidation epithermal | 6 | 0.0044 | 0.44 |
| Carbonatite, REE | 5 | 0.0037 | 0.37 |
| Cu-Au vein | 5 | 0.0037 | 0.37 |
| Cu-Co-Zn-Ni sulfide | 5 | 0.0037 | 0.37 |
| Massive sulfide | 5 | 0.0037 | 0.37 |
| Sediment-hosted Cu, reduced facies | 5 | 0.0037 | 0.37 |
| Cu-Zn massive sulfide | 4 | 0.0029 | 0.29 |
| Polymetallic | 4 | 0.0029 | 0.29 |
| Polymetallic sulfide | 4 | 0.0029 | 0.29 |
| Polymetallic sulfide vein, intermediate sulfidation epithermal, W vein | 4 | 0.0029 | 0.29 |
| Porphyry Au-Cu | 4 | 0.0029 | 0.29 |
| Porphyry Sn-W | 4 | 0.0029 | 0.29 |
| Sedimentary exhalative Zn-Pb with sedimentary Cu overprint(?) | 4 | 0.0029 | 0.29 |
| Stratabound Pb-Zn-Ag-Cu | 4 | 0.0029 | 0.29 |
| Cu massive sulfide, Cyprus-type | 3 | 0.0022 | 0.22 |
| Cu vein | 3 | 0.0022 | 0.22 |
| Epithermal vein, lithocap alunite | 3 | 0.0022 | 0.22 |
| Hydrothermal fault/shear zone-hosted Au | 3 | 0.0022 | 0.22 |
| Intermediate sulfidation epithermal, Comstock | 3 | 0.0022 | 0.22 |
| Porphyry Au | 3 | 0.0022 | 0.22 |
| Skarn Cu-Zn | 3 | 0.0022 | 0.22 |
| Skarn Fe | 3 | 0.0022 | 0.22 |
| Zn-Cu massive sulfide | 3 | 0.0022 | 0.22 |
| Au-quartz vein | 2 | 0.0015 | 0.15 |
| Cu sulfide, supergene | 2 | 0.0015 | 0.15 |
| Komatiitic Ni-Cu | 2 | 0.0015 | 0.15 |
| Low sulfidation epithermal, metamorphosed | 2 | 0.0015 | 0.15 |
| Ni-Cu-Co sulfide | 2 | 0.0015 | 0.15 |
| Podiform chromite (minor) | 2 | 0.0015 | 0.15 |
| Polymetallic vein, low sulfidation epithermal | 2 | 0.0015 | 0.15 |
| Sedimentary exhalative Zn-Pb-Cu | 2 | 0.0015 | 0.15 |
| Sedimentary exhalative, metamorphosed | 2 | 0.0015 | 0.15 |
| Skarn Cu-Zn and vein | 2 | 0.0015 | 0.15 |
| Skarn Fe-Cu | 2 | 0.0015 | 0.15 |
| Sulfide | 2 | 0.0015 | 0.15 |
| W (Cu, Ag, Au) vein | 2 | 0.0015 | 0.15 |
| Ag-Au veins and stockworks | 1 | 0.0007 | 0.07 |
| Alkaline Au-Te | 1 | 0.0007 | 0.07 |
| Asbestos(?) | 1 | 0.0007 | 0.07 |
| Au-Cr-Ni-Co paleoplacer | 1 | 0.0007 | 0.07 |
| Banded iron formation, metamorphosed | 1 | 0.0007 | 0.07 |
| Black shale | 1 | 0.0007 | 0.07 |
| Chromite layer | 1 | 0.0007 | 0.07 |
| Cu-Au vein, supergene | 1 | 0.0007 | 0.07 |
| Cu-Ni sulfide | 1 | 0.0007 | 0.07 |
| Cu massive sulfide | 1 | 0.0007 | 0.07 |
| Cu replacement | 1 | 0.0007 | 0.07 |
| Cu sulfide-PGE-Au | 1 | 0.0007 | 0.07 |
| Cu sulfide, barite | 1 | 0.0007 | 0.07 |
| Epizonal Au-Hg-Sb vein | 1 | 0.0007 | 0.07 |
| Hg vein | 1 | 0.0007 | 0.07 |
| High Sulfidation Epithermal Au-Ag | 1 | 0.0007 | 0.07 |
| High sulfidation epithermal vein(?) | 1 | 0.0007 | 0.07 |
| IOCG(?) | 1 | 0.0007 | 0.07 |
| IOCG(?), Ni-Co vein | 1 | 0.0007 | 0.07 |
| IOCG(?), sulfide | 1 | 0.0007 | 0.07 |
| IOCG, Blackbird-type | 1 | 0.0007 | 0.07 |
| IOCG, supergene | 1 | 0.0007 | 0.07 |
| Low sulfidation Au-Ag-Te | 1 | 0.0007 | 0.07 |
| Massive sulfide, Kuroko-type | 1 | 0.0007 | 0.07 |
| Massive sulfide, Kuroko-type(?), supergene | 1 | 0.0007 | 0.07 |
| Ni-Cu-sulfide and PGE | 1 | 0.0007 | 0.07 |
| Ni-Cu sulfide | 1 | 0.0007 | 0.07 |
| Ni sulfide, metamorphosed | 1 | 0.0007 | 0.07 |
| Orogenic Au, barren quartz vein | 1 | 0.0007 | 0.07 |
| Orogenic Au, sulfidized Fe-BIF | 1 | 0.0007 | 0.07 |
| Polymetallic Pb-Ag vein | 1 | 0.0007 | 0.07 |
| Polymetallic replacement, MVT(?) | 1 | 0.0007 | 0.07 |
| Polymetallic Skarn | 1 | 0.0007 | 0.07 |
| Polymetallic vein (low sulfide Au-quartz?) | 1 | 0.0007 | 0.07 |
| Polymetallic vein, Au-Ag-Sb-W | 1 | 0.0007 | 0.07 |
| Polymetallic vein, Cu-Zn | 1 | 0.0007 | 0.07 |
| Polymetallic vein, epithermal vein | 1 | 0.0007 | 0.07 |
| Polymetallic vein, supergene | 1 | 0.0007 | 0.07 |
| Porphyry Mo | 1 | 0.0007 | 0.07 |
| Porphyry Mo, low-F | 1 | 0.0007 | 0.07 |
| Skarn Fe-Cu and replacement | 1 | 0.0007 | 0.07 |
| Skarn Zn-Pb | 1 | 0.0007 | 0.07 |
| Skarn, polymetallic | 1 | 0.0007 | 0.07 |
| Sulfide, supergene | 1 | 0.0007 | 0.07 |
| Supergene | 1 | 0.0007 | 0.07 |
| Synorogenic-synvolcanic Ni-Cu | 1 | 0.0007 | 0.07 |
| TOTAL | 1363 | 1.0000 | 99.88 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|||
DEFINICIÓN DEL MODELO BINOMIAL: ÉXITO Y FRACASO
# En el modelo binomial se necesita una variable con dos resultados:
# exito o fracaso. En este informe, el exito sera pertenecer al tipo de
# deposito mas frecuente observado en DEPOSIT_TYPE.
deposito_interes <- names(TDFDEPOSIT_ORD)[1]
exitos <- sum(deposit_type_valido == deposito_interes)
fracasos <- total_muestras - exitos
p_exito <- exitos / total_muestras
q_fracaso <- 1 - p_exito
# Variable binaria para el modelo:
# 1 = exito, 0 = fracaso
resultado_binomial <- ifelse(
deposit_type_valido == deposito_interes,
1,
0
)
tabla_binomial <- data.frame(
Resultado = c("Exito", "Fracaso", "Total"),
Descripcion = c(
paste("La muestra pertenece a:", deposito_interes),
paste("La muestra no pertenece a:", deposito_interes),
"Total de muestras validas"
),
Frecuencia = c(exitos, fracasos, total_muestras),
Probabilidad = c(p_exito, q_fracaso, 1),
Porcentaje = c(p_exito, q_fracaso, 1) * 100
)
tabla_binomial_gt <- tabla_binomial %>%
gt() %>%
fmt_number(
columns = c(Probabilidad, Porcentaje),
decimals = 4
) %>%
cols_label(
Resultado = "Resultado binomial",
Descripcion = "Descripcion",
Frecuencia = "Frecuencia",
Probabilidad = "Probabilidad",
Porcentaje = "Porcentaje (%)"
) %>%
tab_header(
title = md("**Tabla N. 2**"),
subtitle = md("Definicion de exito y fracaso para el modelo binomial")
) %>%
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
)
tabla_binomial_gt| Tabla N. 2 | ||||
| Definicion de exito y fracaso para el modelo binomial | ||||
| Resultado binomial | Descripcion | Frecuencia | Probabilidad | Porcentaje (%) |
|---|---|---|---|---|
| Exito | La muestra pertenece a: Porphyry Cu-Mo | 154 | 0.1130 | 11.2986 |
| Fracaso | La muestra no pertenece a: Porphyry Cu-Mo | 1209 | 0.8870 | 88.7014 |
| Total | Total de muestras validas | 1363 | 1.0000 | 100.0000 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
||||
El modelo probabilístico utilizado es:
\[X \sim Binomial(n, p)\]
Donde n representa el número de muestras analizadas y
p representa la probabilidad de que una muestra pertenezca
al tipo de depósito de interés.
GRÁFICA DE DISTRIBUCIÓN DE CANTIDAD
par(mar = c(10, 5, 4, 2) + 0.1)
bar_centers <- barplot(
TDFDEPOSIT_ORD,
main = "Grafica 1. Distribucion de muestras por tipo de deposito",
xlab = "Tipo de deposito",
ylab = "Cantidad de muestras",
col = "lightblue",
las = 2,
cex.names = 0.75,
ylim = c(0, max(TDFDEPOSIT_ORD) * 1.20)
)
text(
x = bar_centers,
y = TDFDEPOSIT_ORD,
labels = TDFDEPOSIT_ORD,
pos = 3,
cex = 0.8,
col = "black"
)
CONJETURA DEL MODELO
# Numero de ensayos para el modelo binomial
n_ensayos <- 20
# Para comparar la realidad con el modelo binomial, se agrupan los datos
# reales en bloques de 20 muestras y se cuenta cuantos exitos hay en cada bloque.
numero_grupos <- floor(length(resultado_binomial) / n_ensayos)
if (numero_grupos < 1) {
stop("No hay suficientes datos validos para formar grupos de 20 muestras.")
}
resultado_agrupado <- resultado_binomial[1:(numero_grupos * n_ensayos)]
matriz_grupos <- matrix(
resultado_agrupado,
ncol = n_ensayos,
byrow = TRUE
)
exitos_por_grupo <- rowSums(matriz_grupos)
# Histograma de la realidad observada
histograma_binomial <- hist(
exitos_por_grupo,
breaks = seq(-0.5, n_ensayos + 0.5, by = 1),
freq = FALSE,
main = paste(
"Gráfica 2. Comparación de la realidad con el modelo binomial\n",
"Tipo de depósito de interés:",
deposito_interes
),
xlab = "Cantidad de éxitos en 20 muestras",
ylab = "Densidad de probabilidad",
col = "lightblue",
border = "black",
ylim = c(
0,
max(
c(
hist(
exitos_por_grupo,
breaks = seq(-0.5, n_ensayos + 0.5, by = 1),
plot = FALSE
)$density,
dbinom(0:n_ensayos, size = n_ensayos, prob = p_exito)
)
) * 1.25
)
)
# Curva del modelo binomial teorico
x_modelo <- 0:n_ensayos
y_modelo <- dbinom(
x = x_modelo,
size = n_ensayos,
prob = p_exito
)
curva_binomial <- spline(
x_modelo,
y_modelo,
n = 200
)
curva_binomial$y <- pmax(curva_binomial$y, 0)
lines(
curva_binomial$x,
curva_binomial$y,
col = "black",
lwd = 3
)
points(
x = x_modelo,
y = y_modelo,
pch = 19,
col = "black"
)
legend(
"topright",
legend = c("Realidad observada", "Modelo binomial"),
fill = c("lightblue", NA),
border = c("black", NA),
lty = c(NA, 1),
pch = c(NA, 19),
col = c("black", "black"),
bty = "o",
cex = 0.8
)
# Valores posibles de X: cantidad de exitos en n ensayos
x_binom <- 0:n_ensayos
# Probabilidad binomial para cada valor de X
prob_binom <- dbinom(
x = x_binom,
size = n_ensayos,
prob = p_exito
)
tabla_modelo_binomial <- data.frame(
X_exitos = x_binom,
Probabilidad = prob_binom,
Porcentaje = prob_binom * 100
)
tabla_modelo_binomial_gt <- tabla_modelo_binomial %>%
gt() %>%
fmt_number(
columns = c(Probabilidad, Porcentaje),
decimals = 4
) %>%
cols_label(
X_exitos = "X exitos",
Probabilidad = "P(X = x)",
Porcentaje = "Porcentaje (%)"
) %>%
tab_header(
title = md("**Tabla N. 3**"),
subtitle = md("Distribucion teorica binomial para 20 muestras")
) %>%
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
)
tabla_modelo_binomial_gt| Tabla N. 3 | ||
| Distribucion teorica binomial para 20 muestras | ||
| X exitos | P(X = x) | Porcentaje (%) |
|---|---|---|
| 0 | 0.0909 | 9.0909 |
| 1 | 0.2316 | 23.1597 |
| 2 | 0.2803 | 28.0254 |
| 3 | 0.2142 | 21.4189 |
| 4 | 0.1160 | 11.5953 |
| 5 | 0.0473 | 4.7263 |
| 6 | 0.0151 | 1.5051 |
| 7 | 0.0038 | 0.3834 |
| 8 | 0.0008 | 0.0794 |
| 9 | 0.0001 | 0.0135 |
| 10 | 0.0000 | 0.0019 |
| 11 | 0.0000 | 0.0002 |
| 12 | 0.0000 | 0.0000 |
| 13 | 0.0000 | 0.0000 |
| 14 | 0.0000 | 0.0000 |
| 15 | 0.0000 | 0.0000 |
| 16 | 0.0000 | 0.0000 |
| 17 | 0.0000 | 0.0000 |
| 18 | 0.0000 | 0.0000 |
| 19 | 0.0000 | 0.0000 |
| 20 | 0.0000 | 0.0000 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
||
barplot(
prob_binom,
names.arg = x_binom,
main = paste(
"Grafica 3. Modelo binomial para el tipo de deposito:",
deposito_interes
),
xlab = "Cantidad de exitos en 20 muestras",
ylab = "Probabilidad",
col = "lightgreen",
ylim = c(0, max(prob_binom) * 1.20)
)
TEST DE APROBACIÓN
# Prueba binomial exacta.
# Se usa p_referencia = 0.50 como proporcion teorica de comparacion.
# Si el docente establece otra proporcion teorica, reemplazar este valor.
p_referencia <- 0.50
prueba_binomial <- binom.test(
x = exitos,
n = total_muestras,
p = p_referencia,
alternative = "two.sided"
)
decision <- ifelse(
prueba_binomial$p.value < 0.05,
"Se rechaza H0",
"No se rechaza H0"
)
tabla_test <- data.frame(
Variable = "DEPOSIT_TYPE",
Deposito_de_interes = deposito_interes,
Exitos_observados = exitos,
Total_muestras = total_muestras,
p_observada = p_exito,
p_referencia = p_referencia,
p_value = prueba_binomial$p.value,
Decision = decision
)
tabla_test_gt <- tabla_test %>%
gt() %>%
fmt_number(
columns = c(p_observada, p_referencia, p_value),
decimals = 4
) %>%
cols_label(
Variable = "Variable",
Deposito_de_interes = "Deposito de interes",
Exitos_observados = "Exitos observados",
Total_muestras = "Total de muestras",
p_observada = "p observada",
p_referencia = "p de referencia",
p_value = "Valor p",
Decision = "Decision"
) %>%
tab_header(
title = md("**Tabla N. 4**"),
subtitle = md("Prueba binomial exacta para la proporcion de DEPOSIT_TYPE")
) %>%
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
)
tabla_test_gt| Tabla N. 4 | |||||||
| Prueba binomial exacta para la proporcion de DEPOSIT_TYPE | |||||||
| Variable | Deposito de interes | Exitos observados | Total de muestras | p observada | p de referencia | Valor p | Decision |
|---|---|---|---|---|---|---|---|
| DEPOSIT_TYPE | Porphyry Cu-Mo | 154 | 1363 | 0.1130 | 0.5000 | 0.0000 | Se rechaza H0 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|||||||
CÁLCULO DE PROBABILIDADES
Cual es la probabilidad de que, al seleccionar 20 muestras aleatorias, como maximo 5 pertenezcan al tipo de deposito de interes?
n_pregunta <- 20
k_pregunta <- 5
probabilidad_maximo_5 <- pbinom(
q = k_pregunta,
size = n_pregunta,
prob = p_exito
)
cat(
"Deposito de interes:",
deposito_interes,
"\n"
)## Deposito de interes: Porphyry Cu-Mocat(
"Probabilidad de que como maximo 5 de 20 muestras pertenezcan al deposito de interes:",
round(probabilidad_maximo_5 * 100, 2),
"%\n"
)## Probabilidad de que como maximo 5 de 20 muestras pertenezcan al deposito de interes: 98.02 %x_prob <- 0:n_pregunta
y_prob <- dbinom(
x = x_prob,
size = n_pregunta,
prob = p_exito
)
colores_prob <- ifelse(x_prob <= k_pregunta, "tomato", "lightgray")
barplot(
y_prob,
names.arg = x_prob,
col = colores_prob,
main = "Grafica 4. Probabilidad acumulada binomial P(X <= 5)",
xlab = "Cantidad de exitos",
ylab = "Probabilidad",
ylim = c(0, max(y_prob) * 1.20)
)
legend(
"topright",
legend = c("Area de probabilidad", "Resto de la distribucion"),
fill = c("tomato", "lightgray"),
bty = "o",
cex = 0.8
)
Si se analizan 50 nuevas muestras, cuantas se esperaria que pertenezcan al tipo de deposito de interes?
n_nuevas_muestras <- 50
muestras_esperadas <- n_nuevas_muestras * p_exito
varianza_binomial <- n_nuevas_muestras * p_exito * q_fracaso
desviacion_binomial <- sqrt(varianza_binomial)
cat(
"Cantidad esperada de muestras del deposito de interes:",
round(muestras_esperadas, 2),
"\n"
)## Cantidad esperada de muestras del deposito de interes: 5.65cat(
"Desviacion estandar binomial:",
round(desviacion_binomial, 2),
"\n"
)## Desviacion estandar binomial: 2.24INTERVALOS DE CONFIANZA
# Intervalo de confianza exacto para la proporcion de exito
ic_binomial <- binom.test(
x = exitos,
n = total_muestras
)$conf.int
tabla_ic <- data.frame(
Deposito_de_interes = deposito_interes,
Proporcion_observada = p_exito,
Limite_inferior = ic_binomial[1],
Limite_superior = ic_binomial[2],
Nivel_confianza = attr(ic_binomial, "conf.level")
)
tabla_ic_gt <- tabla_ic %>%
gt() %>%
fmt_number(
columns = c(
Proporcion_observada,
Limite_inferior,
Limite_superior,
Nivel_confianza
),
decimals = 4
) %>%
cols_label(
Deposito_de_interes = "Deposito de interes",
Proporcion_observada = "Proporcion observada",
Limite_inferior = "Limite inferior",
Limite_superior = "Limite superior",
Nivel_confianza = "Nivel de confianza"
) %>%
tab_header(
title = md("**Tabla N. 5**"),
subtitle = md("Intervalo de confianza para la proporcion binomial")
) %>%
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
)
tabla_ic_gt| Tabla N. 5 | ||||
| Intervalo de confianza para la proporcion binomial | ||||
| Deposito de interes | Proporcion observada | Limite inferior | Limite superior | Nivel de confianza |
|---|---|---|---|---|
| Porphyry Cu-Mo | 0.1130 | 0.0967 | 0.1310 | 0.9500 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
||||
CONCLUSIÓN
El analisis inferencial de la variable DEPOSIT_TYPE se
realizo mediante el modelo probabilistico binomial, transformando la
variable original en dos resultados posibles: exito y fracaso. En este
caso, el exito corresponde a que una muestra pertenezca al tipo de
deposito de interes, definido como el tipo de deposito con mayor
frecuencia dentro de los registros validos.
La proporcion observada de exito permite estimar la probabilidad
p del modelo binomial. Con este parametro se calcularon
probabilidades asociadas a nuevas muestras, como la probabilidad de
obtener como maximo 5 exitos en 20 muestras y la cantidad esperada de
exitos en 50 nuevas muestras.
El intervalo de confianza permite estimar el rango probable de la proporcion poblacional del tipo de deposito de interes. Finalmente, la prueba binomial exacta permite comparar la proporcion observada con una proporcion teorica de referencia y decidir si existe evidencia estadistica suficiente para rechazar dicha referencia.