1. CARGA DE DATOS

CARGA DE DATOS

knitr::opts_chunk$set(
  echo = TRUE,
  message = FALSE,
  warning = FALSE,
  fig.align = "center"
)

datos <- read.csv("C:/Users/Martin/Desktop/Estadistica/CMDB_Data.csv", 
                  header = TRUE,
                  sep = ";",
                  dec = ".",
                  fileEncoding = "UTF-8-BOM",
                  check.names = FALSE)

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]
library(dplyr)
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(gt)

2. TABLA DE DISTRIBUCION DE CANTIDAD POR MES

# ==========================================
# LIMPIEZA DE LA VARIABLE DATE_SUBMITTE
# ==========================================

# Nombre de la columna que contiene la fecha completa: dia, mes y anio.
# Si en tu CSV tiene otro nombre, cambia solo esta linea.
variable_fecha <- "Date_submitte"

names(datos) <- trimws(names(datos))
names(datos) <- sub("^\ufeff", "", names(datos))
nombres_normalizados <- tolower(gsub("[^a-z0-9]", "", names(datos)))

pos_fecha_preferida <- which(tolower(names(datos)) == tolower(variable_fecha))

pos_fecha_detectada <- which(nombres_normalizados %in% c(
  "datesubmitte",
  "datesubmitted",
  "datesubmited",
  "datesubmit",
  "detesubmitte",
  "detesubmitted",
  "submitteddate",
  "submissiondate",
  "fechasubmitted",
  "fechadeenvio",
  "fechaenvio"
))

pos_fecha <- unique(c(pos_fecha_preferida, pos_fecha_detectada))

if (length(pos_fecha) == 0) {
  stop(paste0(
    "No se encontro la columna de fecha. ",
    "Revisa el nombre en variable_fecha o la ruta del CSV. ",
    "Columnas disponibles: ",
    paste(names(datos), collapse = ", ")
  ))
}

col_fecha <- names(datos)[pos_fecha[1]]

fecha_completa <- datos[[col_fecha]]

convertir_fecha <- function(x) {
  if (inherits(x, "Date")) {
    return(x)
  }
  
  if (is.numeric(x)) {
    return(as.Date(x, origin = "1899-12-30"))
  }
  
  x <- trimws(as.character(x))
  x <- sub("T.*$", "", x)
  x <- sub(" .*$", "", x)
  
  formatos <- c(
    "%Y-%m-%d",
    "%Y/%m/%d",
    "%d/%m/%Y",
    "%m/%d/%Y",
    "%d-%m-%Y",
    "%m-%d-%Y",
    "%d.%m.%Y",
    "%m.%d.%Y"
  )
  
  fecha <- rep(as.Date(NA), length(x))
  
  for (formato in formatos) {
    faltantes <- is.na(fecha) & !is.na(x) & x != ""
    fecha[faltantes] <- as.Date(x[faltantes], format = formato)
  }
  
  fecha
}

fecha_submitted <- convertir_fecha(fecha_completa)

# Extraer SOLO la parte del mes.
# Ejemplo: 2026-06-18 -> 6
mes_submitted <- as.integer(format(fecha_submitted, "%m"))
mes_submitted <- na.omit(mes_submitted)
mes_submitted <- subset(mes_submitted, mes_submitted >= 1 & mes_submitted <= 12)

if (length(mes_submitted) == 0) {
  stop("La columna de fecha fue encontrada, pero no se pudieron extraer meses validos entre 1 y 12.")
}

cat("Columna analizada:", col_fecha, "\n")
## Columna analizada: DATE_SUBMITTE
cat("Cantidad de fechas validas:", length(mes_submitted), "\n")
## Cantidad de fechas validas: 1366
etiquetas_meses <- c(
  "Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio",
  "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre"
)

tabla_frecuencias <- data.frame(
  mes = factor(mes_submitted, levels = 1:12, labels = etiquetas_meses)
) %>%
  count(mes, name = "Fo", .drop = FALSE) %>%
  mutate(
    Prob_observada = Fo / sum(Fo),
    Porcentaje_observado = round(Prob_observada * 100, 2)
  )

tabla_date_submitted_gt <- tabla_frecuencias %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 1**"),
    subtitle = md("**Distribucion observada de Date_submitte agrupada por mes**")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 1")
  ) %>%
  cols_label(
    mes = "Mes",
    Fo = "Frecuencia observada (Fo)",
    Prob_observada = "Prob. observada",
    Porcentaje_observado = "Porcentaje observado (%)"
  ) %>%
  fmt_number(columns = c(Prob_observada, Porcentaje_observado), decimals = 2) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black",
    row.striping.include_table_body = TRUE
  )

tabla_date_submitted_gt
Tabla N° 1
Distribucion observada de Date_submitte agrupada por mes
Mes Frecuencia observada (Fo) Prob. observada Porcentaje observado (%)
Enero 0 0.00 0.00
Febrero 0 0.00 0.00
Marzo 0 0.00 0.00
Abril 114 0.08 8.35
Mayo 0 0.00 0.00
Junio 21 0.02 1.54
Julio 136 0.10 9.96
Agosto 1047 0.77 76.65
Septiembre 48 0.04 3.51
Octubre 0 0.00 0.00
Noviembre 0 0.00 0.00
Diciembre 0 0.00 0.00
Autor: Grupo 1

3. GRAFICA DE DISTRIBUCION DE CANTIDAD

barplot(
  height = tabla_frecuencias$Fo,
  names.arg = 1:12,
  main = "Grafica 1. Distribucion de Date_submitte por mes",
  xlab = "Mes",
  ylab = "Frecuencia observada",
  col = "lightblue",
  border = "black"
)

legend(
  "topright",
  legend = paste0(1:12, ". ", etiquetas_meses),
  fill = "lightblue",
  border = NA,
  bty = "n",
  cex = 0.7
)

4. CONJETURA DEL MODELO

# ==========================================
# CONJETURA DEL MODELO POISSON DESPLAZADA
# ==========================================

# Como los meses empiezan en 1, se plantea:
# Mes = Y + 1, donde Y sigue una distribucion Poisson(lambda).
y_poisson <- mes_submitted - 1
lambda <- mean(y_poisson)
n <- length(mes_submitted)

cat("Lambda:", round(lambda, 4), "\n")
## Lambda: 6.571
cat("Tamanio muestral:", n, "\n\n")
## Tamanio muestral: 1366
# Probabilidades esperadas bajo Poisson desplazada:
# P(Mes = m) = P(Y = m - 1)
meses <- 1:12
P_esperada <- dpois(meses - 1, lambda)

# Renormalizacion dentro del rango observable 1 a 12.
# Esto evita perder probabilidad de la cola Poisson fuera de diciembre.
P_esperada <- P_esperada / sum(P_esperada)

Fo <- tabla_frecuencias$Fo
Fe <- P_esperada * n

tabla_ajuste <- tabla_frecuencias %>%
  mutate(
    Prob_esperada = P_esperada,
    Fe = Fe,
    Fe = round(Fe, 2),
    Prob_esperada = round(Prob_esperada, 4),
    Cumple_Fe_mayor_igual_5 = Fe >= 5
  )

cat("Frecuencias observadas (Fo):\n")
## Frecuencias observadas (Fo):
print(Fo)
##  [1]    0    0    0  114    0   21  136 1047   48    0    0    0
cat("\nFrecuencias esperadas (Fe):\n")
## 
## Frecuencias esperadas (Fe):
print(round(Fe, 2))
##  [1]   1.98  13.04  42.85  93.86 154.19 202.64 221.92 208.32 171.11 124.93
## [11]  82.09  49.04
cat("\nTodas las frecuencias esperadas son mayores o iguales a 5:\n")
## 
## Todas las frecuencias esperadas son mayores o iguales a 5:
print(all(Fe >= 5))
## [1] FALSE
tabla_ajuste_gt <- tabla_ajuste %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 2**"),
    subtitle = md("**Frecuencias observadas y esperadas con modelo Poisson desplazada**")
  ) %>%
  cols_label(
    mes = "Mes",
    Fo = "Fo",
    Prob_observada = "Prob. observada",
    Porcentaje_observado = "Porcentaje observado (%)",
    Prob_esperada = "Prob. esperada",
    Fe = "Fe",
    Cumple_Fe_mayor_igual_5 = "Fe >= 5"
  ) %>%
  fmt_number(columns = c(Prob_observada, Prob_esperada), decimals = 4) %>%
  fmt_number(columns = c(Porcentaje_observado, Fe), decimals = 2)

tabla_ajuste_gt
Tabla N° 2
Frecuencias observadas y esperadas con modelo Poisson desplazada
Mes Fo Prob. observada Porcentaje observado (%) Prob. esperada Fe Fe >= 5
Enero 0 0.0000 0.00 0.0015 1.98 FALSE
Febrero 0 0.0000 0.00 0.0095 13.04 TRUE
Marzo 0 0.0000 0.00 0.0314 42.85 TRUE
Abril 114 0.0835 8.35 0.0687 93.86 TRUE
Mayo 0 0.0000 0.00 0.1129 154.19 TRUE
Junio 21 0.0154 1.54 0.1483 202.64 TRUE
Julio 136 0.0996 9.96 0.1625 221.92 TRUE
Agosto 1047 0.7665 76.65 0.1525 208.32 TRUE
Septiembre 48 0.0351 3.51 0.1253 171.11 TRUE
Octubre 0 0.0000 0.00 0.0915 124.93 TRUE
Noviembre 0 0.0000 0.00 0.0601 82.09 TRUE
Diciembre 0 0.0000 0.00 0.0359 49.04 TRUE
 
barplot(
  rbind(Fo, Fe),
  beside = TRUE,
  names.arg = 1:12,
  main = "Grafica 2. Comparacion entre realidad y modelo Poisson desplazada",
  xlab = "Mes",
  ylab = "Frecuencia",
  col = c("lightblue", "gray40"),
  border = "black"
)

legend(
  "topright",
  legend = c("Frecuencia observada", "Frecuencia esperada"),
  fill = c("lightblue", "gray40"),
  bty = "n",
  cex = 0.8
)

5. TEST DE APROBACION

# =========================
# TEST DE PEARSON
# =========================

Fo_pct <- (Fo / n) * 100
Fe_pct <- (Fe / n) * 100

plot(
  Fo_pct,
  Fe_pct,
  main = "Grafica 3. Correlacion de frecuencias en el modelo Poisson desplazada",
  xlab = "Frecuencia observada (%)",
  ylab = "Frecuencia esperada (%)",
  pch = 19,
  col = "forestgreen"
)

abline(a = 0, b = 1, col = "red", lwd = 2)

Correlacion <- cor(Fo_pct, Fe_pct) * 100

# =========================
# TEST DE CHI-CUADRADO
# =========================

# Grados de libertad: numero de grupos - 1 - parametro estimado.
gl <- length(Fo) - 1 - 1

x2 <- sum((Fo - Fe)^2 / Fe)
p_valor <- pchisq(x2, df = gl, lower.tail = FALSE)
umbral <- qchisq(0.97, gl)

decision <- ifelse(
  p_valor < 0.05,
  "Se rechaza el modelo Poisson desplazada",
  "No se rechaza el modelo Poisson desplazada"
)

tabla_resumen <- data.frame(
  Variable = "Date_submitte por mes",
  Lambda = round(lambda, 4),
  "Test Pearson (%)" = round(Correlacion, 2),
  "Chi Cuadrado" = round(x2, 2),
  "Valor p" = ifelse(p_valor < 0.0001, "< 0.0001", round(p_valor, 4)),
  "Umbral de aceptacion" = round(umbral, 2),
  "Decision" = decision
)

tabla_resumen_gt <- tabla_resumen %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 3**"), 
    subtitle = md("**Resultados de las pruebas de bondad de ajuste para Date_submitte por mes**")
  ) %>%
  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 N° 3
Resultados de las pruebas de bondad de ajuste para Date_submitte por mes
Variable Lambda Test.Pearson.... Chi.Cuadrado Valor.p Umbral.de.aceptacion Decision
Date_submitte por mes 6.571 45.43 4133.47 < 0.0001 19.92 Se rechaza el modelo Poisson desplazada
Autor: Grupo 1

6. ESTIMACION DE PROBABILIDADES

¿Cual es la probabilidad de que un registro haya sido enviado durante el primer trimestre del anio?

# P(Mes <= 3) = P(Y <= 2), porque Mes = Y + 1.
# Se usa la distribucion renormalizada dentro de los meses 1 a 12.
probabilidad_primer_trimestre <- sum(P_esperada[1:3])

cat("Probabilidad:", round(probabilidad_primer_trimestre * 100, 2), "%\n")
## Probabilidad: 4.24 %
plot(
  meses,
  P_esperada,
  type = "h",
  lwd = 4,
  col = "black",
  main = "Grafica 4. Probabilidad de envio durante el primer trimestre",
  xlab = "Mes",
  ylab = "Probabilidad"
)

points(meses, P_esperada, pch = 19, col = "black")

meses_area <- 1:3
segments(
  x0 = meses_area,
  y0 = 0,
  x1 = meses_area,
  y1 = P_esperada[meses_area],
  col = "red",
  lwd = 5
)

texto_prob <- paste0("Probabilidad = ", round(probabilidad_primer_trimestre * 100, 2), " %")

text(
  x = 7,
  y = max(P_esperada) * 0.8,
  labels = texto_prob,
  col = "black",
  cex = 1,
  font = 2
)

Si se analizan 50 nuevos registros, ¿cuantos se esperaria que tengan Date_submitte entre junio y agosto?

probabilidad_junio_agosto <- sum(P_esperada[6:8])

registros_esperados <- probabilidad_junio_agosto * 50

cat("Probabilidad (junio a agosto):", round(probabilidad_junio_agosto * 100, 2), "%\n")
## Probabilidad (junio a agosto): 46.33 %
cat("Cantidad de registros esperados:", round(registros_esperados), "\n")
## Cantidad de registros esperados: 23

7. INTERVALOS DE CONFIANZA

# ==========================================
# INTERVALO DE CONFIANZA PARA LA MEDIA DEL MES DE ENVIO
# ==========================================

x_media <- mean(mes_submitted)
sigma <- sd(mes_submitted)
n <- length(mes_submitted)

e <- sigma / sqrt(n)

li <- x_media - 2 * e
ls <- x_media + 2 * e

cat("Media del mes de envio:", round(x_media, 2), "\n")
## Media del mes de envio: 7.57
cat("Desviacion estandar de la muestra:", round(sigma, 2), "\n")
## Desviacion estandar de la muestra: 1.16
cat("Tamanio muestral:", n, "\n")
## Tamanio muestral: 1366
cat("Error estandar de la media:", round(e, 4), "\n")
## Error estandar de la media: 0.0314
cat("Limite inferior:", round(li, 2), "\n")
## Limite inferior: 7.51
cat("Limite superior:", round(ls, 2), "\n")
## Limite superior: 7.63
tabla_media_mes <- data.frame(
  "Limite inferior" = round(li, 2),
  "Media poblacional" = round(x_media, 2),
  "Limite superior" = round(ls, 2),
  "Error estandar" = round(e, 4)
)

tabla_media_mes_gt <- tabla_media_mes %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 4**"),
    subtitle = md("**Intervalo de confianza del mes de envio en Date_submitte**")
  ) %>%
  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_media_mes_gt
Tabla N° 4
Intervalo de confianza del mes de envio en Date_submitte
Limite.inferior Media.poblacional Limite.superior Error.estandar
7.51 7.57 7.63 0.0314
Autor: Grupo 1

8. CONCLUSION

La variable Date_submitte fue analizada tomando unicamente el mes como unidad de estudio. Para ello, primero se llamo a la fecha completa, que contiene dia, mes y anio, y luego se extrajo solo el mes mediante format(fecha_submitted, "%m").

El modelo planteado corresponde a una distribucion de Poisson desplazada, ya que el mes observado inicia en 1. Por esta razon se define Mes = Y + 1, donde Y sigue una distribucion Poisson con parametro lambda.

Con base en el ajuste mensual, se obtiene lambda = 6.571, Chi-cuadrado = 4133.47 y valor p = < 0.0001. Por lo tanto, la decision estadistica es: Se rechaza el modelo Poisson desplazada.