Carga de datos y librerías Extraer la variable Conclusión

1. CARGA DE LIBRERÍAS Y DATOS

# Carga de Librerías
library(readxl)
library(dplyr)
## 
## Attaching package: '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)

# Cargar base de datos
datos_nuevoartes <- read_excel("datos_nuevoartes_.xlsx")
## New names:
## • `` -> `...34`
## • `` -> `...35`

2. EXTRAER LA VARIABLE

location_accuracy <- datos_nuevoartes$location_accuracy

# Eliminar valores faltantes
location_accuracy <- location_accuracy[!is.na(location_accuracy)]

3. CONTEO

3.1 Regla de Sturges

# Número de observaciones
n_loc <- length(location_accuracy)

# Valores mínimo y máximo
min_loc <- min(location_accuracy)
max_loc <- max(location_accuracy)

# Rango
R_loc <- max_loc - min_loc

# Número de clases según Sturges
k_sturges <- ceiling(1 + 3.322 * log10(n_loc))

# Amplitud real
A_sturges <- R_loc / k_sturges

# Límites inferiores
Li_sturges <- seq(
  from = min_loc,
  by = A_sturges,
  length.out = k_sturges
)

# Límites superiores
Ls_sturges <- c(
  Li_sturges[-1],
  max_loc
)

# Marcas de clase
MC_sturges <- (Li_sturges + Ls_sturges)/2
# Frecuencias absolutas
ni_sturges <- numeric(length(Li_sturges))

for(i in 1:length(Li_sturges)){

  if(i < length(Li_sturges)){

    ni_sturges[i] <- sum(
      location_accuracy >= Li_sturges[i] &
      location_accuracy < Ls_sturges[i]
    )

  }else{

    ni_sturges[i] <- sum(
      location_accuracy >= Li_sturges[i] &
      location_accuracy <= Ls_sturges[i]
    )

  }

}

# Frecuencias relativas
hi_sturges <- round((ni_sturges/n_loc)*100,2)

# Frecuencias acumuladas
Ni_asc_sturges <- cumsum(ni_sturges)

Ni_dsc_sturges <- rev(cumsum(rev(ni_sturges)))

Hi_asc_sturges <- round(cumsum(hi_sturges),2)

Hi_dsc_sturges <- round(rev(cumsum(rev(hi_sturges))),2)

# Intervalos
Intervalo_sturges <- paste0(
  "[",
  round(Li_sturges,2),
  " - ",
  round(Ls_sturges,2),
  ")"
)

Intervalo_sturges[length(Intervalo_sturges)] <- paste0(
  "[",
  round(Li_sturges[length(Li_sturges)],2),
  " - ",
  round(Ls_sturges[length(Ls_sturges)],2),
  "]"
)

# Tabla
TDF_sturges <- data.frame(
  Intervalo = Intervalo_sturges,
  MC = round(MC_sturges,2),
  ni = ni_sturges,
  hi = hi_sturges,
  Ni_asc = Ni_asc_sturges,
  Ni_dsc = Ni_dsc_sturges,
  Hi_asc = Hi_asc_sturges,
  Hi_dsc = Hi_dsc_sturges
)

# Totales
TDF_sturges <- rbind(
  TDF_sturges,
  data.frame(
    Intervalo = "TOTAL",
    MC = "",
    ni = sum(ni_sturges),
    hi = 100,
    Ni_asc = "",
    Ni_dsc = "",
    Hi_asc = "",
    Hi_dsc = ""
  )
)

4. TABLA DE FRECUENCIAS

4.1 Tabla de frecuencias con la regla de Sturges

tabla_sturges <- TDF_sturges %>%
  gt() %>%
  fmt_number(
    columns = MC,
    decimals = 2
  ) %>%
  tab_header(
    title = md("**Tabla N° 1**"),
    subtitle = md(
      paste0(
        "Distribución de frecuencias de la precisión de ubicación mediante la regla de Sturges (",
        k_sturges,
        " clases)"
      )
    )
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo Geología")
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(rows = Intervalo == "TOTAL")
  )

tabla_sturges
Tabla N° 1
Distribución de frecuencias de la precisión de ubicación mediante la regla de Sturges (15 clases)
Intervalo MC ni hi Ni_asc Ni_dsc Hi_asc Hi_dsc
[0.09 - 9.09) 4.59 43 0.39 43 11033 0.39 100.02
[9.09 - 18.08) 13.58 145 1.31 188 10990 1.7 99.63
[18.08 - 27.08) 22.58 369 3.34 557 10845 5.04 98.32
[27.08 - 36.08) 31.58 742 6.73 1299 10476 11.77 94.98
[36.08 - 45.07) 40.58 1253 11.36 2552 9734 23.13 88.25
[45.07 - 54.07) 49.57 1701 15.42 4253 8481 38.55 76.89
[54.07 - 63.07) 58.57 1947 17.65 6200 6780 56.2 61.47
[63.07 - 72.06) 67.56 1872 16.97 8072 4833 73.17 43.82
[72.06 - 81.06) 76.56 1371 12.43 9443 2961 85.6 26.85
[81.06 - 90.06) 85.56 867 7.86 10310 1590 93.46 14.42
[90.06 - 99.05) 94.56 458 4.15 10768 723 97.61 6.56
[99.05 - 108.05) 103.55 186 1.69 10954 265 99.3 2.41
[108.05 - 117.05) 112.55 56 0.51 11010 79 99.81 0.72
[117.05 - 126.04) 121.54 19 0.17 11029 23 99.98 0.21
[126.04 - 135.04] 130.54 4 0.04 11033 4 100.02 0.04
TOTAL 11033 100.00
Autor: Grupo Geología

4.2 Tabla de frecuencias reducida

# ======================================================
# REDUCCIÓN DE INTERVALOS
# ======================================================

# Número de clases
k_loc <- 12

# Amplitud real
A_real <- R_loc / k_loc

# Amplitud redondeada
A_loc <- ceiling(A_real)

# Límite inferior
Li0 <- floor(min_loc)

# Límites inferiores
Li_loc <- seq(
  from = Li0,
  by = A_loc,
  length.out = k_loc
)

# Límites superiores
Ls_loc <- Li_loc + A_loc

# Si el máximo queda fuera de los intervalos,
# agregar nuevos intervalos automáticamente

while(max(Ls_loc) < max_loc){

  Li_loc <- c(Li_loc, max(Ls_loc))

  Ls_loc <- c(Ls_loc, max(Ls_loc) + A_loc)

}

# Actualizar número de clases

k_loc <- length(Li_loc)

# Marcas de clase

MC_loc <- round((Li_loc + Ls_loc)/2,2)

# =====================================
# Frecuencias
# =====================================

ni_loc <- numeric(length(Li_loc))

for(i in 1:length(Li_loc)){

  if(i < length(Li_loc)){

    ni_loc[i] <- sum(
      location_accuracy >= Li_loc[i] &
      location_accuracy < Ls_loc[i]
    )

  }else{

    ni_loc[i] <- sum(
      location_accuracy >= Li_loc[i] &
      location_accuracy <= Ls_loc[i]
    )

  }

}

# Frecuencias relativas

hi_loc <- round((ni_loc/n_loc)*100,2)

# Frecuencias acumuladas

Ni_asc_loc <- cumsum(ni_loc)

Ni_dsc_loc <- rev(cumsum(rev(ni_loc)))

Hi_asc_loc <- round(cumsum(hi_loc),2)

Hi_dsc_loc <- round(rev(cumsum(rev(hi_loc))),2)

# Tabla

TDF_location_accuracy <- data.frame(

  Li = Li_loc,

  Ls = Ls_loc,

  MC = MC_loc,

  ni = ni_loc,

  hi = hi_loc,

  Ni_asc = Ni_asc_loc,

  Ni_dsc = Ni_dsc_loc,

  Hi_asc = Hi_asc_loc,

  Hi_dsc = Hi_dsc_loc

)

# Totales

TDF_location_accuracy <- rbind(

  TDF_location_accuracy,

  data.frame(

    Li = "TOTAL",

    Ls = "",

    MC = "",

    ni = sum(ni_loc),

    hi = 100,

    Ni_asc = "",

    Ni_dsc = "",

    Hi_asc = "",

    Hi_dsc = ""

  )

)

tabla_location_accuracy <- TDF_location_accuracy %>%

  gt() %>%

  fmt_number(

    columns = MC,

    decimals = 2

  ) %>%

  tab_header(

    title = md("**Tabla N° 2**"),

    subtitle = md(

      paste0(

        "Distribución de frecuencias de la precisión de ubicación (",

        k_loc,

        " clases)"

      )

    )

  ) %>%

  tab_source_note(

    source_note = md("Autor: Grupo Geología")

  ) %>%

  tab_style(

    style = cell_text(weight = "bold"),

    locations = cells_body(rows = Li == "TOTAL")

  )

tabla_location_accuracy
Tabla N° 2
Distribución de frecuencias de la precisión de ubicación (12 clases)
Li Ls MC ni hi Ni_asc Ni_dsc Hi_asc Hi_dsc
0 12 6 74 0.67 74 11033 0.67 99.99
12 24 18 316 2.86 390 10959 3.53 99.32
24 36 30 904 8.19 1294 10643 11.72 96.46
36 48 42 1779 16.12 3073 9739 27.84 88.27
48 60 54 2484 22.51 5557 7960 50.35 72.15
60 72 66 2509 22.74 8066 5476 73.09 49.64
72 84 78 1705 15.45 9771 2967 88.54 26.9
84 96 90 878 7.96 10649 1262 96.5 11.45
96 108 102 304 2.76 10953 384 99.26 3.49
108 120 114 65 0.59 11018 80 99.85 0.73
120 132 126 13 0.12 11031 15 99.97 0.14
132 144 138 2 0.02 11033 2 99.99 0.02
TOTAL 11033 100.00
Autor: Grupo Geología

5. GRÁFICAS

5.1 Histogramas

5.1.1 Distribución local de la precisión de ubicación de deslizamientos a nivel mundial

hist(

  location_accuracy,

  breaks = c(Li_loc, max(Ls_loc)),

  right = FALSE,

  freq = TRUE,

  col = "grey",

  border = "black",

  main = "Distribución local de la precisión de ubicación\n de deslizamientos a nivel mundial",

  xlab = "Precisión de ubicación",

  ylab = "Cantidad"

)

5.1.2 Distribución global de la precisión de ubicación de deslizamientos a nivel mundial

hist(

  location_accuracy,

  breaks = c(Li_loc, max(Ls_loc)),

  right = FALSE,

  freq = TRUE,

  col = "grey",

  border = "black",

  ylim = c(0,sum(ni_loc)),

  main = "Distribución global de la precisión de ubicación\n de deslizamientos a nivel mundial",

  xlab = "Precisión de ubicación",

  ylab = "Cantidad"

)

5.1.3 Distribución local de la precisión de ubicación de deslizamientos a nivel mundial

hist(

  location_accuracy,

  breaks = c(Li_loc,max(Ls_loc)),

  right = FALSE,

  freq = FALSE,

  col = "grey",

  border = "black",

  main = "Distribución local de la precisión de ubicación\n de deslizamientos a nivel mundial",

  xlab = "Precisión de ubicación",

  ylab = "Porcentaje (%)"

)

5.1.4 Distribución global de la precisión de ubicación de deslizamientos a nivel mundial

hist(

  location_accuracy,

  breaks = c(Li_loc,max(Ls_loc)),

  probability = TRUE,

  right = FALSE,

  col = "grey",

  border = "black",

  main = "Distribución global de la precisión de ubicación\n de deslizamientos a nivel mundial",

  xlab = "Precisión de ubicación",

  ylab = "Porcentaje (%)"

)

5.2 Ojivas

plot(
  Ls_loc,
  Ni_asc_loc,
  type = "o",
  pch = 19,
  col = "blue",
  ylim = c(0, max(Ni_asc_loc)),
  main = "Ojiva ascendente y descendente de la precisión\n de ubicación a nivel mundial",
  xlab = "Precisión de ubicación",
  ylab = "Cantidad"
)

lines(
  Li_loc,
  Ni_dsc_loc,
  type = "o",
  pch = 17,
  col = "red"
)

legend(
  "right",
  legend = c("Ojiva ascendente (Ni ≤)", "Ojiva descendente (Ni ≥)"),
  col = c("blue", "red"),
  pch = c(19,17),
  lty = 1,
  cex = 0.8,
  bty = "n"
)

5.3 Diagrama de caja (Boxplot)

boxplot(
  location_accuracy,
  horizontal = TRUE,
  col = "grey",
  border = "black",
  main = "Diagrama de caja de la precisión de ubicación\n a nivel mundial",
  xlab = "Precisión de ubicación",
  outline = TRUE,
  pch = 19,
  outcol = "red"
)

5.4 Histograma y Boxplot

h <- hist(
  location_accuracy,
  breaks = c(Li_loc, max(Ls_loc)),
  right = FALSE,
  plot = FALSE
)

plot(
  h,
  freq = TRUE,
  col = "grey",
  border = "black",
  main = "Distribución y boxplot de la longitud de\n deslizamientos a nivel mundial",
  xlab = "Precisión de ubicación",
  ylab = "Cantidad"
)
boxplot(
  location_accuracy,
  horizontal = TRUE,
  add = TRUE,
  axes = FALSE,
  at = max(h$counts) * 0.45,     # posición vertical
  boxwex = max(h$counts) * 0.50, # altura de la caja
  col = rgb(0.45, 0.80, 1.00, 0.70),
  border = "black",
  outline = TRUE,
  pch = 19,
  outcol = "red"
)

6. INDICADORES ESTADÍSTICOS

6.1 Indicadores de posición

# Límite inferior teórico
ri <- min(location_accuracy)

# Límite superior teórico
rs <- max(location_accuracy)

# Media
media_loc <- mean(location_accuracy)

# Mediana
mediana_loc <- median(location_accuracy)

# Moda
moda_loc <- as.numeric(
  names(
    which.max(
      table(location_accuracy)
    )
  )
)

6.2 Indicadores de dispersión

# Rango
rango_loc <- max(location_accuracy)-min(location_accuracy)

# Varianza
var_loc <- var(location_accuracy)

# Desviación estándar
sd_loc <- sd(location_accuracy)

# Coeficiente de variación
CV_loc <- (sd_loc/media_loc)*100

6.3 Indicadores de forma

# Asimetría
As_loc <- mean(
  (location_accuracy-media_loc)^3
)/sd_loc^3

# Curtosis
K_loc <- mean(
  (location_accuracy-media_loc)^4
)/sd_loc^4 -3

6.4 Tabla resumen

TablaIndicadores_location_accuracy <- data.frame(

Variable="Precisión de ubicación",

ri=round(ri,2),

rs=round(rs,2),

Media=round(media_loc,2),

Mediana=round(mediana_loc,2),

Moda=round(moda_loc,2),

Rango=round(rango_loc,2),

Varianza=round(var_loc,2),

Desv_Estandar=round(sd_loc,2),

CV=round(CV_loc,2),

Asimetria=round(As_loc,2),

Curtosis=round(K_loc,2)

)

tabla_indicadores <- TablaIndicadores_location_accuracy %>%

gt() %>%

tab_header(

title=md("**Tabla N° 3**"),

subtitle=md("Indicadores estadísticos de la precisión de ubicación")

) %>%

tab_source_note(

source_note=md("Autor: Grupo Geología")

)

tabla_indicadores
Tabla N° 3
Indicadores estadísticos de la precisión de ubicación
Variable ri rs Media Mediana Moda Rango Varianza Desv_Estandar CV Asimetria Curtosis
Precisión de ubicación 0.09 135.04 59.88 59.82 63.76 134.95 394.45 19.86 33.17 0.04 -0.11
Autor: Grupo Geología

6.5 Valores atípicos (Outliers)

# Primer cuartil
Q1 <- quantile(location_accuracy,0.25)

# Tercer cuartil
Q3 <- quantile(location_accuracy,0.75)

# Rango intercuartílico
IQR_loc <- IQR(location_accuracy)

# Límite inferior
LI <- Q1 - 1.5*IQR_loc

# Límite superior
LS <- Q3 + 1.5*IQR_loc

# Valores atípicos
Outliers_loc <- location_accuracy[
  location_accuracy < LI |
  location_accuracy > LS
]

6.6 Tabla de valores atípicos

TablaOutliers_location_accuracy <- data.frame(

Variable = "Precisión de ubicación",

Q1 = round(Q1,2),

Q3 = round(Q3,2),

IQR = round(IQR_loc,2),

Limite_Inferior = round(LI,2),

Limite_Superior = round(LS,2),

Numero_Outliers = length(Outliers_loc)

)

tabla_outliers <- TablaOutliers_location_accuracy %>%

gt() %>%

tab_header(

title = md("**Tabla N° 4**"),

subtitle = md("Detección de valores atípicos de la precisión de ubicación")

) %>%

tab_source_note(

source_note = md("Autor: Grupo Geología")

)

tabla_outliers
Tabla N° 4
Detección de valores atípicos de la precisión de ubicación
Variable Q1 Q3 IQR Limite_Inferior Limite_Superior Numero_Outliers
Precisión de ubicación 46.21 73.28 27.07 5.6 113.89 58
Autor: Grupo Geología

7. CONCLUSIÓN

La variable Precisión de ubicación fluctúa entre 0.09 y 135.04, y sus valores giran en torno a 59.88, con una desviación estándar de 19.86, siendo un conjunto de datos heterogéneo. El conjunto de valores se concentra principalmente en la parte media de la variable y presenta una asimetría positiva, con mayor extensión hacia las precisiones de ubicación mayores. Además, se identificaron 58 valores atípicos, que van desde 113.89 hasta 135.04. Por lo tanto, esto se considera medianamente perjudicial a nivel mundial, debido a que la precisión de ubicación de los registros presenta una variabilidad moderada.