# 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`
location_accuracy <- datos_nuevoartes$location_accuracy
# Eliminar valores faltantes
location_accuracy <- location_accuracy[!is.na(location_accuracy)]
# 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 = ""
)
)
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 | |||||||
# ======================================================
# 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 | ||||||||
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"
)
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"
)
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 (%)"
)
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 (%)"
)
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"
)
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"
)
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"
)
# 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)
)
)
)
# 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
# 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
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 | |||||||||||
# 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
]
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 | ||||||
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.