0. Librerias 1. Datos 2. Variable 3. Frecuencias 4. Grafica 5. Conjetura 6. Parametros 7. Sobreposicion 8. Bondad 9. Probabilidades 10. Intervalo 11. Conclusion

0. CARGA DE LIBRERIAS

library(readxl)
library(dplyr)
library(gt)

options(scipen=999)

tabla_gt <- function(datos, numero, titulo){
  datos %>%
    gt() %>%
    tab_header(
      title=md(paste0("**Tabla N. ",numero,"**")),
      subtitle=md(titulo)
    ) %>%
    tab_options(table.width=pct(100)) %>%
    tab_source_note(
      source_note=md("Elaborado por: Grupo 1 - Carrera de Geologia")
    )
}

1. CARGA DE DATOS

datos <- read_excel("datos_nuevoartes_.xlsx")

2. PREPARACION DE LA VARIABLE

La variable location_accuracy representa la precisión con la que fueron localizados geográficamente los deslizamientos.

Para el modelo normal se eliminan únicamente los registros vacíos o no numéricos. Los valores atípicos se conservan porque forman parte de la distribución observada.

location_accuracy <- suppressWarnings(
  as.numeric(datos$location_accuracy)
)

location_accuracy <- location_accuracy[
  is.finite(location_accuracy)
]

n <- length(location_accuracy)
xmin <- min(location_accuracy)
xmax <- max(location_accuracy)
rango <- xmax-xmin
resumen_variable <- data.frame(
  Indicador=c(
    "Registros validos",
    "Valor minimo",
    "Valor maximo",
    "Rango observado"
  ),
  Resultado=c(n,xmin,xmax,rango)
)

tabla_gt(
  resumen_variable,
  1,
  "Preparacion de la variable precision de ubicacion"
) %>%
  fmt_number(columns=Resultado,decimals=4)
Tabla N. 1
Preparacion de la variable precision de ubicacion
Indicador Resultado
Registros validos 11,033.0000
Valor minimo 0.0900
Valor maximo 135.0400
Rango observado 134.9500
Elaborado por: Grupo 1 - Carrera de Geologia

3. TABLA DE FRECUENCIAS

Debido a que es una variable cuantitativa continua con numerosos valores diferentes, se utiliza la regla de Sturges:

\[ k=1+3.322\log_{10}(n) \]

k <- ceiling(1+3.322*log10(n))

cortes <- seq(
  xmin,
  xmax,
  length.out=k+1
)

h <- hist(
  location_accuracy,
  breaks=cortes,
  right=FALSE,
  include.lowest=TRUE,
  plot=FALSE
)

Li <- head(cortes,-1)
Ls <- tail(cortes,-1)
MC <- h$mids
ni <- h$counts
hi <- ni/n*100
Ni <- cumsum(ni)
Hi <- cumsum(hi)
amplitud <- cortes[2]-cortes[1]

intervalos <- paste0(
  "[",
  sprintf("%.2f",Li),
  " - ",
  sprintf("%.2f",Ls),
  ifelse(seq_along(Li)==length(Li),"]",")")
)
parametros_sturges <- data.frame(
  Indicador=c(
    "Numero de observaciones",
    "Numero de clases",
    "Amplitud de clase"
  ),
  Resultado=c(n,k,amplitud)
)

tabla_gt(
  parametros_sturges,
  2,
  "Parametros de clasificacion mediante la regla de Sturges"
) %>%
  fmt_number(columns=Resultado,decimals=4)
Tabla N. 2
Parametros de clasificacion mediante la regla de Sturges
Indicador Resultado
Numero de observaciones 11,033.0000
Numero de clases 15.0000
Amplitud de clase 8.9967
Elaborado por: Grupo 1 - Carrera de Geologia 
tabla_frecuencias <- data.frame(
  Intervalo=intervalos,
  Li=Li,
  Ls=Ls,
  MC=MC,
  Cantidad=ni,
  Porcentaje=hi,
  Cantidad_acumulada=Ni,
  Porcentaje_acumulado=Hi
)

tabla_frecuencias <- rbind(
  tabla_frecuencias,
  data.frame(
    Intervalo="TOTAL",
    Li=NA,
    Ls=NA,
    MC=NA,
    Cantidad=sum(ni),
    Porcentaje=100,
    Cantidad_acumulada=NA,
    Porcentaje_acumulado=NA
  )
)
tabla_gt(
  tabla_frecuencias,
  3,
  "Distribucion de la precision de ubicacion"
) %>%
  cols_label(
    Intervalo="Intervalo",
    Li="Li",
    Ls="Ls",
    MC="MC",
    Cantidad="Cantidad",
    Porcentaje="Porcentaje (%)",
    Cantidad_acumulada="Cantidad acumulada",
    Porcentaje_acumulado="Porcentaje acumulado (%)"
  ) %>%
  fmt_number(
    columns=c(Li,Ls,MC,Porcentaje,Porcentaje_acumulado),
    decimals=2
  ) %>%
  sub_missing(columns=everything(),missing_text="") %>%
  tab_style(
    style=cell_text(weight="bold"),
    locations=cells_body(rows=Intervalo=="TOTAL")
  )
Tabla N. 3
Distribucion de la precision de ubicacion
Intervalo Li Ls MC Cantidad Porcentaje (%) Cantidad acumulada Porcentaje acumulado (%)
[0.09 - 9.09) 0.09 9.09 4.59 43 0.39 43 0.39
[9.09 - 18.08) 9.09 18.08 13.58 145 1.31 188 1.70
[18.08 - 27.08) 18.08 27.08 22.58 369 3.34 557 5.05
[27.08 - 36.08) 27.08 36.08 31.58 742 6.73 1299 11.77
[36.08 - 45.07) 36.08 45.07 40.58 1253 11.36 2552 23.13
[45.07 - 54.07) 45.07 54.07 49.57 1701 15.42 4253 38.55
[54.07 - 63.07) 54.07 63.07 58.57 1947 17.65 6200 56.20
[63.07 - 72.06) 63.07 72.06 67.56 1872 16.97 8072 73.16
[72.06 - 81.06) 72.06 81.06 76.56 1371 12.43 9443 85.59
[81.06 - 90.06) 81.06 90.06 85.56 867 7.86 10310 93.45
[90.06 - 99.05) 90.06 99.05 94.56 458 4.15 10768 97.60
[99.05 - 108.05) 99.05 108.05 103.55 186 1.69 10954 99.28
[108.05 - 117.05) 108.05 117.05 112.55 56 0.51 11010 99.79
[117.05 - 126.04) 117.05 126.04 121.54 19 0.17 11029 99.96
[126.04 - 135.04] 126.04 135.04 130.54 4 0.04 11033 100.00
TOTAL


11033 100.00

Elaborado por: Grupo 1 - Carrera de Geologia

4. GRAFICA DE FRECUENCIAS

par(mar=c(5,5,4,2))

plot(
  h,
  freq=TRUE,
  col="#D8C3CA",
  border="#6D213C",
  ylim=c(0,max(ni)*1.15),
  main="Distribucion de la precision de ubicacion\nde los deslizamientos a nivel mundial",
  xlab="Precision de ubicacion",
  ylab="Cantidad absoluta"
)

text(
  MC,
  ni,
  labels=ni,
  pos=3,
  cex=.75,
  font=2
)

5. CONJETURA DEL MODELO

La distribución normal es una distribución continua, simétrica y con forma de campana. Está determinada por la media poblacional \(\mu\) y la desviación estándar poblacional \(\sigma\).

Su función de densidad es:

\[ f(x)= \frac{1}{\sigma\sqrt{2\pi}} e^{-\frac{1}{2}\left(\frac{x-\mu}{\sigma}\right)^2} \]

Por tanto:

\[ X\sim N(\mu,\sigma^2) \]

Las hipótesis son:

\[ H_0: \text{La precision de ubicacion sigue una distribucion normal} \]

\[ H_1: \text{La precision de ubicacion no sigue una distribucion normal} \]

El ajuste se evaluará mediante la sobreposición gráfica, el coeficiente de Pearson, el gráfico Q-Q y el contraste chi-cuadrado.

6. ESTIMACION DE PARAMETROS

Los parámetros del modelo normal se estiman mediante:

\[ \hat{\mu}=\bar{x} \]

\[ \hat{\sigma}=s \]

media <- mean(location_accuracy)
mediana <- median(location_accuracy)
varianza <- var(location_accuracy)
desviacion <- sd(location_accuracy)
CV <- desviacion/media*100

m2 <- mean((location_accuracy-media)^2)
asimetria <- mean((location_accuracy-media)^3)/m2^(3/2)
curtosis <- mean((location_accuracy-media)^4)/m2^2-3

parametros <- data.frame(
  Parametro=c(
    "Numero de observaciones",
    "Media estimada",
    "Mediana",
    "Varianza estimada",
    "Desviacion estandar",
    "Coeficiente de variacion (%)",
    "Asimetria",
    "Curtosis"
  ),
  Resultado=c(
    n,
    media,
    mediana,
    varianza,
    desviacion,
    CV,
    asimetria,
    curtosis
  )
)
tabla_gt(
  parametros,
  4,
  "Parametros estimados del modelo normal"
) %>%
  fmt_number(columns=Resultado,decimals=4)
Tabla N. 4
Parametros estimados del modelo normal
Parametro Resultado
Numero de observaciones 11,033.0000
Media estimada 59.8772
Mediana 59.8200
Varianza estimada 394.4542
Desviacion estandar 19.8609
Coeficiente de variacion (%) 33.1694
Asimetria 0.0370
Curtosis −0.1068
Elaborado por: Grupo 1 - Carrera de Geologia

7. SOBREPOSICION CON EL MODELO NORMAL

Las cantidades esperadas se calculan mediante las probabilidades de la distribución normal. La primera y la última clase incluyen las colas teóricas del modelo.

P_normal <- pnorm(
  Ls,
  mean=media,
  sd=desviacion
)-
pnorm(
  Li,
  mean=media,
  sd=desviacion
)

P_normal[1] <- pnorm(
  Ls[1],
  mean=media,
  sd=desviacion
)

P_normal[length(P_normal)] <- 1-pnorm(
  Li[length(Li)],
  mean=media,
  sd=desviacion
)

Fe <- n*P_normal

tabla_ajuste <- data.frame(
  Intervalo=intervalos,
  Cantidad_observada=ni,
  Cantidad_esperada=Fe,
  Porcentaje_observado=hi,
  Porcentaje_normal=P_normal*100
)
tabla_gt(
  tabla_ajuste,
  5,
  "Comparacion entre la realidad y el modelo normal"
) %>%
  fmt_number(
    columns=c(
      Cantidad_esperada,
      Porcentaje_observado,
      Porcentaje_normal
    ),
    decimals=4
  )
Tabla N. 5
Comparacion entre la realidad y el modelo normal
Intervalo Cantidad_observada Cantidad_esperada Porcentaje_observado Porcentaje_normal
[0.09 - 9.09) 43 58.1902 0.3897 0.5274
[9.09 - 18.08) 145 136.8164 1.3142 1.2401
[18.08 - 27.08) 369 349.2960 3.3445 3.1659
[27.08 - 36.08) 742 728.7766 6.7253 6.6054
[36.08 - 45.07) 1253 1,242.6893 11.3568 11.2634
[45.07 - 54.07) 1701 1,731.8657 15.4174 15.6971
[54.07 - 63.07) 1947 1,972.6934 17.6471 17.8799
[63.07 - 72.06) 1872 1,836.5501 16.9673 16.6460
[72.06 - 81.06) 1371 1,397.4670 12.4264 12.6662
[81.06 - 90.06) 867 869.0954 7.8582 7.8772
[90.06 - 99.05) 458 441.7392 4.1512 4.0038
[99.05 - 108.05) 186 183.4918 1.6859 1.6631
[108.05 - 117.05) 56 62.2865 0.5076 0.5645
[117.05 - 126.04) 19 17.2770 0.1722 0.1566
[126.04 - 135.04] 4 4.7654 0.0363 0.0432
Elaborado por: Grupo 1 - Carrera de Geologia 
comparacion <- rbind(
  Realidad=hi,
  Modelo_normal=P_normal*100
)

par(mar=c(9,5,4,2))

barplot(
  comparacion,
  beside=TRUE,
  names.arg=intervalos,
  col=c("#D8C3CA","#6D213C"),
  border="#4A1026",
  las=2,
  ylim=c(0,max(comparacion)*1.20),
  main="Distribucion observada y modelo normal",
  xlab="",
  ylab="Porcentaje relativo"
)

legend(
  "topright",
  legend=c("Realidad","Modelo normal"),
  fill=c("#D8C3CA","#6D213C"),
  bty="n"
)

mtext(
  "Intervalos de la precision de ubicacion",
  side=1,
  line=7
)

par(mar=c(5,5,4,2))

hist(
  location_accuracy,
  breaks=cortes,
  right=FALSE,
  probability=TRUE,
  col="#D8C3CA",
  border="#6D213C",
  main="Histograma y curva del modelo normal",
  xlab="Precision de ubicacion",
  ylab="Densidad"
)

curve(
  dnorm(x,mean=media,sd=desviacion),
  from=xmin,
  to=xmax,
  add=TRUE,
  col="#6D213C",
  lwd=3
)

8. TEST DE BONDAD DE AJUSTE

8.1 Coeficiente de Pearson

El coeficiente de Pearson compara las cantidades observadas y esperadas.

pearson <- if(
  sd(ni)>0 && sd(Fe)>0
){
  cor(ni,Fe)*100
}else{
  NA_real_
}

pearson
## [1] 99.96802
plot(
  Fe,
  ni,
  pch=19,
  col="#6D213C",
  main="Cantidades observadas y esperadas",
  xlab="Cantidad esperada",
  ylab="Cantidad observada"
)

abline(
  lm(ni~Fe),
  col="#4A1026",
  lwd=2
)

grid()

8.2 Grafico Q-Q normal

Cuando los puntos se mantienen próximos a la línea recta, existe semejanza con una distribución normal.

qqnorm(
  location_accuracy,
  pch=19,
  cex=.45,
  col="#6D213C",
  main="Grafico Q-Q normal de la precision de ubicacion",
  xlab="Cuantiles teoricos",
  ylab="Cuantiles observados"
)

qqline(
  location_accuracy,
  col="#4A1026",
  lwd=2
)

grid()

8.3 Contraste chi-cuadrado

Para garantizar cantidades esperadas suficientes, se utilizan diez clases equiprobables según el modelo normal.

Como se estimaron dos parámetros, los grados de libertad son:

\[ gl=k-1-2 \]

limites_chi <- qnorm(
  seq(0,1,length.out=11),
  mean=media,
  sd=desviacion
)

grupos_chi <- cut(
  location_accuracy,
  breaks=limites_chi,
  include.lowest=TRUE
)

Fo_chi <- as.numeric(table(grupos_chi))
P_chi <- diff(
  pnorm(
    limites_chi,
    mean=media,
    sd=desviacion
  )
)

Fe_chi <- n*P_chi

chi_calculado <- sum(
  (Fo_chi-Fe_chi)^2/Fe_chi
)

gl <- length(Fo_chi)-1-2

chi_critico <- qchisq(.95,gl)

p_chi <- pchisq(
  chi_calculado,
  gl,
  lower.tail=FALSE
)

decision_chi <- ifelse(
  p_chi>=.05,
  "No se rechaza H0: el modelo normal es adecuado",
  "Se rechaza H0: el modelo normal no es adecuado"
)
tabla_chi <- data.frame(
  Intervalo=levels(grupos_chi),
  Cantidad_observada=Fo_chi,
  Cantidad_esperada=Fe_chi
)

tabla_gt(
  tabla_chi,
  6,
  "Cantidades utilizadas en el contraste chi-cuadrado"
) %>%
  fmt_number(
    columns=Cantidad_esperada,
    decimals=4
  )
Tabla N. 6
Cantidades utilizadas en el contraste chi-cuadrado
Intervalo Cantidad_observada Cantidad_esperada
[-Inf,34.4] 1149 1,103.3000
(34.4,43.2] 1072 1,103.3000
(43.2,49.5] 1119 1,103.3000
(49.5,54.8] 1077 1,103.3000
(54.8,59.9] 1118 1,103.3000
(59.9,64.9] 1068 1,103.3000
(64.9,70.3] 1126 1,103.3000
(70.3,76.6] 1078 1,103.3000
(76.6,85.3] 1098 1,103.3000
(85.3, Inf] 1128 1,103.3000
Elaborado por: Grupo 1 - Carrera de Geologia 
bondad <- data.frame(
  Indicador=c(
    "Correlacion de Pearson (%)",
    "Chi-cuadrado calculado",
    "Grados de libertad",
    "Chi-cuadrado critico",
    "Valor p",
    "Decision"
  ),
  Resultado=c(
    ifelse(is.na(pearson),"No calculable",round(pearson,2)),
    round(chi_calculado,4),
    gl,
    round(chi_critico,4),
    round(p_chi,6),
    decision_chi
  )
)

tabla_gt(
  bondad,
  7,
  "Resultados de la bondad de ajuste del modelo normal"
)
Tabla N. 7
Resultados de la bondad de ajuste del modelo normal
Indicador Resultado
Correlacion de Pearson (%) 99.97
Chi-cuadrado calculado 6.5822
Grados de libertad 7
Chi-cuadrado critico 14.0671
Valor p 0.47364
Decision No se rechaza H0: el modelo normal es adecuado
Elaborado por: Grupo 1 - Carrera de Geologia

9. CALCULO DE PROBABILIDADES

Se calcula la probabilidad de que la precisión de ubicación se encuentre dentro de una desviación estándar respecto de la media:

\[ P(\mu-\sigma\leq X\leq\mu+\sigma) \]

Li_prob <- media-desviacion
Ls_prob <- media+desviacion

p_inferior <- pnorm(
  Li_prob,
  mean=media,
  sd=desviacion
)

p_central <- pnorm(
  Ls_prob,
  mean=media,
  sd=desviacion
)-
p_inferior

p_superior <- 1-pnorm(
  Ls_prob,
  mean=media,
  sd=desviacion
)

probabilidades <- data.frame(
  Evento=c(
    paste0("X menor que ",round(Li_prob,2)),
    paste0(
      round(Li_prob,2),
      " <= X <= ",
      round(Ls_prob,2)
    ),
    paste0("X mayor que ",round(Ls_prob,2))
  ),
  Probabilidad=c(
    p_inferior,
    p_central,
    p_superior
  )
)

probabilidades$Porcentaje <- 
  probabilidades$Probabilidad*100
tabla_gt(
  probabilidades,
  8,
  "Probabilidades calculadas mediante el modelo normal"
) %>%
  fmt_number(columns=Probabilidad,decimals=6) %>%
  fmt_number(columns=Porcentaje,decimals=2)
Tabla N. 8
Probabilidades calculadas mediante el modelo normal
Evento Probabilidad Porcentaje
X menor que 40.02 0.158655 15.87
40.02 <= X <= 79.74 0.682689 68.27
X mayor que 79.74 0.158655 15.87
Elaborado por: Grupo 1 - Carrera de Geologia 
x_grafica <- seq(
  media-4*desviacion,
  media+4*desviacion,
  length.out=1000
)

y_grafica <- dnorm(
  x_grafica,
  mean=media,
  sd=desviacion
)

zona <- x_grafica>=Li_prob & x_grafica<=Ls_prob

plot(
  x_grafica,
  y_grafica,
  type="l",
  lwd=3,
  col="#6D213C",
  main="Probabilidad dentro de una desviacion estandar",
  xlab="Precision de ubicacion",
  ylab="Densidad de probabilidad"
)

polygon(
  c(Li_prob,x_grafica[zona],Ls_prob),
  c(0,y_grafica[zona],0),
  col="#D8C3CA",
  border="#6D213C"
)

lines(
  x_grafica,
  y_grafica,
  lwd=3,
  col="#6D213C"
)

abline(
  v=media,
  col="#4A1026",
  lty=2,
  lwd=2
)

grid()

10. INTERVALO DE CONFIANZA

Como la desviación estándar poblacional es desconocida, se utiliza la distribución \(t\) de Student:

\[ IC_{95\%} = \bar{x} \pm t_{\alpha/2,n-1} \left( \frac{s}{\sqrt{n}} \right) \]

error_estandar <- desviacion/sqrt(n)

t_critico <- qt(
  .975,
  df=n-1
)

margen_error <- t_critico*error_estandar

ic_inferior <- media-margen_error
ic_superior <- media+margen_error

tabla_ic <- data.frame(
  Indicador=c(
    "Media muestral",
    "Desviacion estandar",
    "Numero de observaciones",
    "Error estandar",
    "Valor t critico",
    "Margen de error",
    "Limite inferior del 95 %",
    "Limite superior del 95 %"
  ),
  Resultado=c(
    media,
    desviacion,
    n,
    error_estandar,
    t_critico,
    margen_error,
    ic_inferior,
    ic_superior
  )
)
tabla_gt(
  tabla_ic,
  9,
  "Intervalo de confianza para la media"
) %>%
  fmt_number(columns=Resultado,decimals=6)
Tabla N. 9
Intervalo de confianza para la media
Indicador Resultado
Media muestral 59.877153
Desviacion estandar 19.860870
Numero de observaciones 11,033.000000
Error estandar 0.189083
Valor t critico 1.960179
Margen de error 0.370636
Limite inferior del 95 % 59.506517
Limite superior del 95 % 60.247789
Elaborado por: Grupo 1 - Carrera de Geologia

11. CONCLUSION

forma <- ifelse(
  abs(asimetria)<.5,
  "aproximadamente simetrica",
  ifelse(
    asimetria>0,
    "asimetrica hacia la derecha",
    "asimetrica hacia la izquierda"
  )
)

tipo_curtosis <- ifelse(
  abs(curtosis)<.5,
  "con curtosis cercana a la normal",
  ifelse(
    curtosis>0,
    "mas apuntada que la normal",
    "mas aplanada que la normal"
  )
)

texto_pearson <- ifelse(
  is.na(pearson),
  "no calculable",
  paste0(round(pearson,2)," %")
)

cat(
  paste0(
    "Se analizaron **",n,
    " registros validos** de la precision de ubicacion. ",
    "La media fue de **",round(media,2),
    "** y la mediana de **",round(mediana,2),
    "**.\n\n",

    "La desviacion estandar fue de **",
    round(desviacion,2),
    "** y el coeficiente de variacion de **",
    round(CV,2),
    " %**. La distribucion es ",
    forma," y ",tipo_curtosis,".\n\n",

    "El coeficiente de Pearson entre las cantidades observadas y esperadas fue de **",
    texto_pearson,
    "**. El valor p del contraste chi-cuadrado fue de **",
    round(p_chi,6),
    "**. Por lo tanto, ",
    tolower(decision_chi),
    ".\n\n",

    "La probabilidad de que la precision de ubicacion se encuentre entre **",
    round(Li_prob,2)," y ",round(Ls_prob,2),
    "** es de **",round(p_central*100,2),
    " %**.\n\n",

    "Con un nivel de confianza del 95 %, la media poblacional se encuentra entre **",
    round(ic_inferior,2)," y ",round(ic_superior,2),
    "**."
  )
)

Se analizaron 11033 registros validos de la precision de ubicacion. La media fue de 59.88 y la mediana de 59.82.

La desviacion estandar fue de 19.86 y el coeficiente de variacion de 33.17 %. La distribucion es aproximadamente simetrica y con curtosis cercana a la normal.

El coeficiente de Pearson entre las cantidades observadas y esperadas fue de 99.97 %. El valor p del contraste chi-cuadrado fue de 0.47364. Por lo tanto, no se rechaza h0: el modelo normal es adecuado.

La probabilidad de que la precision de ubicacion se encuentre entre 40.02 y 79.74 es de 68.27 %.

Con un nivel de confianza del 95 %, la media poblacional se encuentra entre 59.51 y 60.25.