Introducción

Este conjunto de datos se toma del USGS. El USGS proporciona notificaciones en tiempo real, feeds y servicios web sobre terremotos justo después de que sucedan.

El conjunto de datos contiene detalles de todos los terremotos que han sucedido en los últimos 30 días y se actualiza cada 15 minutos en el sitio web de USGS.

El análisis

Mientras se buscaron los datos, se presentó el hecho de que no todos los terremotos son naturales y pocos son causados por humanos, aunque muy pequeños en números. También se descubrió que en un período de un mes de febrero del 25 de febrero de 2019 más de 8500 terremotos han ocurrido en todo el mundo. Fuera de los cuales solo el 2% son causados debido a la explosión de la cantera, la explosión química, los terremotos de hielo, etc.

Al final del análisis, se trató de predecir terremotos y otros terremotos no naturales (actividades sísmicas relacionadas con explosión, explosión de cantera, etc.).

earthquake <- read.csv("all_month.csv")
glimpse(earthquake)
## Rows: 10,631
## Columns: 22
## $ time            <chr> "2023-02-27T02:06:06.435Z", "2023-02-27T01:51:31.620Z"…
## $ latitude        <dbl> 63.19850, 38.83450, 17.39010, -32.90730, 58.64360, -1.…
## $ longitude       <dbl> -149.37560, -122.81817, 147.53000, -178.86740, -154.31…
## $ depth           <dbl> 73.300, 1.520, 10.000, 45.006, 101.600, 42.456, 3.760,…
## $ mag             <dbl> 1.60, 0.71, 4.90, 5.10, 2.00, 5.50, 0.65, 2.00, 1.30, …
## $ magType         <chr> "ml", "md", "mb", "mb", "ml", "mww", "md", "ml", "ml",…
## $ nst             <int> NA, 14, 48, 45, NA, 132, 8, NA, NA, 11, NA, NA, NA, 46…
## $ gap             <dbl> NA, 61, 149, 153, NA, 57, 133, NA, NA, 224, NA, NA, NA…
## $ dmin            <dbl> NA, 0.0127600, 4.5680000, 3.7240000, NA, 2.5870000, 0.…
## $ rms             <dbl> 0.78, 0.01, 0.66, 0.96, 0.62, 0.87, 0.01, 0.31, 0.67, …
## $ net             <chr> "ak", "nc", "us", "us", "ak", "us", "nc", "ak", "ak", …
## $ id              <chr> "ak0232nyean7", "nc73852211", "us6000jrtu", "us6000jrt…
## $ updated         <chr> "2023-02-27T02:08:44.101Z", "2023-02-27T02:08:14.941Z"…
## $ place           <chr> "30 km SW of Cantwell, Alaska", "8km NW of The Geysers…
## $ type            <chr> "earthquake", "earthquake", "earthquake", "earthquake"…
## $ horizontalError <dbl> NA, 0.26, 13.28, 12.11, NA, 8.71, 0.62, NA, NA, 0.64, …
## $ depthError      <dbl> 0.600, 0.700, 1.911, 6.277, 0.700, 5.046, 1.870, 0.500…
## $ magError        <dbl> NA, 0.1300000, 0.0640000, 0.0990000, NA, 0.0930000, 0.…
## $ magNst          <int> NA, 15, 77, 33, NA, 11, 8, NA, NA, 9, NA, NA, NA, 52, …
## $ status          <chr> "automatic", "automatic", "reviewed", "reviewed", "aut…
## $ locationSource  <chr> "ak", "nc", "us", "us", "ak", "us", "nc", "ak", "ak", …
## $ magSource       <chr> "ak", "nc", "us", "us", "ak", "us", "nc", "ak", "ak", …
head(earthquake)
##                       time latitude longitude   depth  mag magType nst gap
## 1 2023-02-27T02:06:06.435Z  63.1985 -149.3756  73.300 1.60      ml  NA  NA
## 2 2023-02-27T01:51:31.620Z  38.8345 -122.8182   1.520 0.71      md  14  61
## 3 2023-02-27T01:35:49.082Z  17.3901  147.5300  10.000 4.90      mb  48 149
## 4 2023-02-27T01:31:15.500Z -32.9073 -178.8674  45.006 5.10      mb  45 153
## 5 2023-02-27T01:27:10.987Z  58.6436 -154.3143 101.600 2.00      ml  NA  NA
## 6 2023-02-27T01:26:06.458Z  -1.6972  120.2673  42.456 5.50     mww 132  57
##      dmin  rms net           id                  updated
## 1      NA 0.78  ak ak0232nyean7 2023-02-27T02:08:44.101Z
## 2 0.01276 0.01  nc   nc73852211 2023-02-27T02:08:14.941Z
## 3 4.56800 0.66  us   us6000jrtu 2023-02-27T02:18:44.040Z
## 4 3.72400 0.96  us   us6000jrtp 2023-02-27T02:03:50.040Z
## 5      NA 0.62  ak ak0232nxxdfe 2023-02-27T01:29:44.672Z
## 6 2.58700 0.87  us   us6000jrtm 2023-02-27T02:03:23.063Z
##                           place       type horizontalError depthError magError
## 1  30 km SW of Cantwell, Alaska earthquake              NA      0.600       NA
## 2     8km NW of The Geysers, CA earthquake            0.26      0.700    0.130
## 3        Mariana Islands region earthquake           13.28      1.911    0.064
## 4 south of the Kermadec Islands earthquake           12.11      6.277    0.099
## 5 92 km SSE of Kokhanok, Alaska earthquake              NA      0.700       NA
## 6  63 km WSW of Poso, Indonesia earthquake            8.71      5.046    0.093
##   magNst    status locationSource magSource
## 1     NA automatic             ak        ak
## 2     15 automatic             nc        nc
## 3     77  reviewed             us        us
## 4     33  reviewed             us        us
## 5     NA automatic             ak        ak
## 6     11  reviewed             us        us

Generalidades sobre las variables y factores acerca de los terremotos

Análisis exploratorio

Hay alrededor de siete terremotos que tinene una magnitud que es mayor a seis en la escala de richter.

Extracción de características:

A partir de ahora, extraeré dos características de los datos que son,

  1. Ubicación del terremoto (estado/país, etc.)

  2. Hora del día en ‘hora’

Desde la trama de línea a continuación podemos ver que el número máximo de terremotos que han sucedido a una hora particular. La medianoche parece ser la hora más popular del día cuando la mayoría de los terremotos han sucedido. La noche 5 p.m ve el número total más bajo de terremotos en un día. Cuando vemos la magnitud máxima en cada hora, entonces la mañana 8-9 a.m. tiene el terremoto más impactante de alrededor de 7.

#Location
earthquake$location <- sub('.*,\\s*','', earthquake$place)

#Time of the day in 'Hour'
earthquake$hour <- ymd_hms(earthquake$time)
earthquake$hour <- hour(earthquake$hour)

#Visualizing the number of quakes that have happened at a particular time
earthquake %>% 
filter(!is.na(mag))%>%
group_by(hour)%>%
summarise(count = length(id),max_magnitude = max(mag))%>%
ggplot(aes(hour,count, color = max_magnitude))+geom_line()+
scale_color_viridis(direction = -1)+
scale_x_continuous(breaks=seq(0,23,1))+
xlab("Time of the day")+
ylab("Number of earthquakes")+
ggtitle("Number of quakes as per time of the day")+
theme_bw()+
theme(plot.title = element_text(hjust = 0.5))

En el siguiente mapa podemos ver esos lugares donde han sucedido los últimos terremotos. El cinturón del Pacífico que comienza desde países sudamericanos como Chile, Perú, Ecuador que pasa por la costa oeste de Estados Unidos y luego Alaska muestra muchas actividades sísmicas. Sin embargo, la magnitud está más o menos en el rango de 1-5. El próximo cinturón de actividades sísmicas se puede ver en países como Indonesia, Japón, Papua Nueva Guinea y Newzealand.

Los siguientes son los terremotos más prominentes que han sucedido con mayor magnitud de 6 y más. (Entre el 18 de febrero 19 y 18 de marzo de 19) 1. Lugar: 115 km ESE de Palora, ** Ecuador Magnitud: 7.5 ** Hora: 2019-02-22 10:17:22

  1. Lugar: 27 km nne de Azangaro, ** Perú Magnitud: 7 ** Hora: 2019-03-01 08:50:41

  2. Lugar: 116 km SE de L’Sperance Rock, ** Nueva Zelanda Magnitud: 6.4 ** Hora: 2019-03-06 15:46:14

  3. Lugar: 49 km NW de Namatanai, ** Papua Nueva Guinea Magnitud: 6.4 ** Hora: 2019-02-17 14:35:55

  4. Lugar: 28 km s de Cliza, ** Bolivia Magnitud: 6.3 ** Hora: 2019-03-15 05:03:50

  5. Lugar: 260 km SE de Lambasa, ** Fiji Magnitud: 6.2 ** Hora: 2019-03-10 08:12:25

  6. Lugar: 140 km SSW de Kulumadau, ** Papua Nueva Guinea Magnitud: 6.1 ** Hora: 2019-03-10 12:48:00

bins=seq(1, 8.0, by=1.0)
palette = colorBin( palette="YlOrBr", domain=earthquake$mag, na.color="transparent", bins=bins)

d=leaflet(earthquake) %>% 
  addTiles()  %>% 
  setView( lng = 166.45, lat = 21, zoom = 1.25) %>%
  addProviderTiles(providers$Esri.WorldImagery) %>%
  addCircleMarkers(~longitude, ~latitude, 
    fillColor = ~palette(mag), fillOpacity = 0.7, color="white", radius=3, stroke=FALSE,
     popup = paste("Place:", earthquake$place, "<br>",
            "Magnitude:", earthquake$mag, "<br>",
            "Time:", earthquake$time, "<br>")) %>%
  addLegend( pal=palette, values=~mag, opacity=0.9, title = "Magnitude", position = "bottomright" )

htmlwidgets::saveWidget(d, "d.html")
display_html('<iframe src="d.html" width=100% height=450></iframe>')

Las 30 ubicaciones principales donde han tenido lugar la mayoría de las actividades sísmicas, algunas son países y algunos son estados de EE. UU. Aunque alrededor del 35% de los terremotos han sucedido en California y el 27% en Alaska, la magnitud promedio no es de 0.9 y 1.7 respectivamente. En comparación con estos lugares, países como Newzealand, Indonesia, Papua Nueva Guinea, Chile, Japón y Filiipines han recibido mucho menos porcentaje de terremotos, sin embargo, las magnitudes promedio de estos Earthqaukes están por encima de 4.4

earthquake %>% 
group_by(location) %>% 
filter(!(is.na(mag)))%>%
summarise(Number_of_quakes = length(location), 
          Average_Magnitude = mean(mag))%>%
mutate(Percent = round(prop.table(Number_of_quakes)*100,2))%>%
arrange(desc(Number_of_quakes))%>% top_n(25, Number_of_quakes)
## # A tibble: 25 × 4
##    location         Number_of_quakes Average_Magnitude Percent
##    <chr>                       <int>             <dbl>   <dbl>
##  1 Alaska                       4244             1.25    39.9 
##  2 CA                           2867             1.04    27.0 
##  3 Hawaii                        428             2.09     4.03
##  4 Turkey                        263             4.52     2.47
##  5 Nevada                        248             0.808    2.33
##  6 Alaska Peninsula              219             0.158    2.06
##  7 Washington                    192             0.859    1.81
##  8 Texas                         179             2.18     1.68
##  9 Puerto Rico                   154             2.59     1.45
## 10 Utah                           99             1.14     0.93
## # … with 15 more rows

Se sabe que la profundidad es la distancia donde el terremoto comienza a romperse. Es interesante plantearse si una profundidad mayor conduce a un terremoto de mayor magnitud. Trazé el trazado de magnitud de dispersión a continuación frente a la profundidad y descubrí que un número considerable de terremotos que son de magnitud entre 4-5 solo tienen profundidades más grandes. Incluso las profundidades de los terremotos que tienen más de 6 en magnitud están dispersas. Los terremotos de menor magnitud generalmente ocurren dentro de 200 km de profundidad.

ggplot(earthquake, aes(mag,depth,color = hour))+
geom_jitter(alpha = 0.5)+
gghighlight(max(depth>200)| max(mag>4))+
scale_x_continuous(breaks=seq(0,9,1))+
scale_color_viridis(direction = -1)+
theme_bw()+
xlab('Magnitude')+
ylab('Depth')+
ggtitle('Magnitude Vs. Depth in Km')+
theme(plot.title = element_text(hjust = 0.5))

Las actividades sísmicas se producen debido a otras actividades humanas, como la explosión, la cantera, etc. Sin embargo, el 98% de las actividades sísmicas ocurren debido al terremoto.

earthquake %>%
group_by(type)%>%
summarise(count = length(type))%>%
mutate(Percent = prop.table(count*100))%>%
ggplot(aes(type,Percent, fill = type))+
geom_col()+theme_bw()+
xlab('Type of Seismic Activity')+
ylab('Percent')+
ggtitle('Percent of Seismic Activity')+
theme(plot.title = element_text(hjust = 0.5))

Cuando visualizamos estas actividades sesísmicas de acuerdo con su tipo, encontramos que la mayoría de las actividades sísmicas además de un terremoto tienen lugar en EE. UU. (Principalmente Ca y Alaska, Nevada, Washington), Canadá. Sin embargo, Alaska experimenta muchos terrenos de hielo. Haga clic en el mapa para saber más.

pal <- colorFactor(palette = "Accent",domain = earthquake$type)

e=leaflet(earthquake) %>% 
  addTiles()  %>% 
  setView( lng = -119.417931, lat = 50.778259, zoom = 3) %>%
  addProviderTiles(providers$CartoDB.Positron) %>%
  addCircleMarkers(~longitude, ~latitude, 
    fillColor = ~pal(type), fillOpacity = 0.5, color="white", radius=3, stroke=FALSE,
     popup = paste("Place:", earthquake$place, "<br>",
            "Magnitude:", earthquake$mag, "<br>",
            "Time:", earthquake$time, "<br>",
            "Type:", earthquake$type, "<br>")) %>%
  addLegend( pal=pal, values=~type, opacity=0.9, title = "Type", position = "bottomright" )


htmlwidgets::saveWidget(e, "e.html")
display_html('<iframe src="e.html" width=100% height=450></iframe>')

¿Cómo notar la diferencia entre terremotos y otros terremotos?

Profundidad:

Sabemos que la ‘profundidad’ es donde el terremoto comienza a romperse. Podemos ver en el diagrama de caja a continuación que la mayoría de las actividades sísmicas no relacionadas con la naturaleza ocurren principalmente en la superficie de la tierra. Por otro lado, los terremotos se producen principalmente 10-20 km debajo de la superficie y pueden ocurrir hasta varios kilómetros debajo de la superficie de la tierra. Pero este generalmente no es el caso con otro tipo de actividades sísmicas.

ggplot(earthquake, aes('',depth, color = type))+geom_boxplot()+
scale_y_continuous(limits = c(0, 100))+theme_bw()+
xlab('Type of Seismic Activity')+
ggtitle('Depth of Seismic Activity')

Magnitud

El siguiente parámetro importante aquí es la magnitud. Mientras que un terremoto natural puede tener una magnitud que varía de 0-7 en una escala. La magnitud de los terremotos hechos por humanos es mucho menor y mayormente flota alrededor de 0-2.2 en una escala de Richter.

ggplot(earthquake, aes('',mag, color = type))+geom_boxplot()+
scale_y_continuous(limits = c(0, 8))+theme_bw()+
xlab('Type of Seismic Activity')+
ggtitle('Magnitude of Seismic Activity')

# Momento del día

Bueno, si experimenta sacudidas después de la medianoche hasta las 5 de la mañana, considere revisar las noticias para una explosión química en su área. Si su mesa está temblando, entonces puede ser su explosión de cantera.

ggplot(earthquake, aes('',hour, color = type))+geom_boxplot()+
scale_y_continuous(limits = c(0, 24))+theme_bw()+
xlab('Type of Seismic Activity')+
ggtitle('Time of Seismic Activity')

Predicción

En la siguiente sección se está tratando de predecir el tipo de actividad sísmica utilizando pocas características, como profundidad, magnitud, latitud y longitud. Hay muchas más características presentes en el conjunto de datos, pero a partir de ahora usemos estos parámetros para hacer una predicción básica.

En primer lugar, se plantea preparar el conjunto de datos para la predicción. Clasificaré todas las actividades sísmicas que no son terremotos naturales en una categoría, ya que se vio que la mayoría de los otros terremotos tienen más o menos el mismo rango de profundidad, magnitud y ubicación.

#Choosing the relevant columns
quake <- earthquake[,c(2,3,4,5,24,15)]

#Categorising the type
quake$type <- ifelse(quake$type == 'earthquake', 'Earthquake', 'Otherquake')

#quake[,c(1:5)] <- scale(quake[,c(1:5)])

#Converting our target column 'type' into a factor
quake$type <- factor(quake$type)

#Checking and removing any row having NA
colSums(is.na(quake))
##  latitude longitude     depth       mag      hour      type 
##         0         0         0         0         0         0
quake <- quake[!is.na(quake$mag),]
#Now look at the data
head(quake)
##   latitude longitude   depth  mag hour       type
## 1  63.1985 -149.3756  73.300 1.60    2 Earthquake
## 2  38.8345 -122.8182   1.520 0.71    1 Earthquake
## 3  17.3901  147.5300  10.000 4.90    1 Earthquake
## 4 -32.9073 -178.8674  45.006 5.10    1 Earthquake
## 5  58.6436 -154.3143 101.600 2.00    1 Earthquake
## 6  -1.6972  120.2673  42.456 5.50    1 Earthquake

Se usarán máquinas de vectores de soporte para hacer una predicción y anticipo un problema de desequilibrio de clase aquí porque en nuestro conjunto de datos el 98% de las observaciones son terremotos naturales y solo el 2% de las observaciones pertenecen a otros terremotos.

Primero se hallará el modelo sin manejar el desequilibrio de la clase y luego se pasará a usar la biblioteca de Rose para tratar el problema del desequilibrio de la clase.

table(quake$type)
## 
## Earthquake Otherquake 
##      10446        185
# splitting the data between train and test
set.seed(1234)

indices = sample.split(quake$type, SplitRatio = 0.7)

train = quake[indices,]

test = quake[!(indices),]

head(train)
##    latitude longitude  depth  mag hour       type
## 1  63.19850 -149.3756 73.300 1.60    2 Earthquake
## 2  38.83450 -122.8182  1.520 0.71    1 Earthquake
## 3  17.39010  147.5300 10.000 4.90    1 Earthquake
## 4 -32.90730 -178.8674 45.006 5.10    1 Earthquake
## 6  -1.69720  120.2673 42.456 5.50    1 Earthquake
## 7  38.79883 -122.7945  3.760 0.65    1 Earthquake
table(train$type)
## 
## Earthquake Otherquake 
##       7312        130
table(test$type)
## 
## Earthquake Otherquake 
##       3134         55
set.seed(1234)
#Using RBF Kernel
Model_RBF <- ksvm(type~ ., data = train, scale = FALSE, kernel = "rbfdot")
Eval_RBF <- predict(Model_RBF, test[,-6])

  #confusion matrix - RBF Kernel
  confusionMatrix(Eval_RBF,test$type)
## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   Earthquake Otherquake
##   Earthquake       3134         55
##   Otherquake          0          0
##                                             
##                Accuracy : 0.9828            
##                  95% CI : (0.9776, 0.987)   
##     No Information Rate : 0.9828            
##     P-Value [Acc > NIR] : 0.5358            
##                                             
##                   Kappa : 0                 
##                                             
##  Mcnemar's Test P-Value : 0.0000000000003305
##                                             
##             Sensitivity : 1.0000            
##             Specificity : 0.0000            
##          Pos Pred Value : 0.9828            
##          Neg Pred Value :    NaN            
##              Prevalence : 0.9828            
##          Detection Rate : 0.9828            
##    Detection Prevalence : 1.0000            
##       Balanced Accuracy : 0.5000            
##                                             
##        'Positive' Class : Earthquake        
## 

En la predicción anterior se puede ver claramente el defecto. Todos los terremotos se predicen correctamente, lo que hace que la sensibilidad (verdaderos positivos) sea realmente alta. Sin embargo, ninguno de los ‘otros terremotos’ se predice correctamente que conduce a una especificidad 0 (verdadero negativo).

Tratando el desequilibrio de la clase:

Ahora se utiliza el paquete Rose (al azar sobre ejemplos de muestreo) para tratar el problema de desequilibrio de clases utilizando el muestreo, bajo muestreo y ambos. Comencemos primero con exceso de muestreo.

set.seed(1234)
over <- ovun.sample(type~., data = train, method="over", N= 11640)$data
set.seed(1234)
#Using RBF Kernel
Model_RBF <- ksvm(type~ ., data = over, scale = FALSE, kernel = "rbfdot")
Eval_RBF <- predict(Model_RBF, test[,-6])

  #confusion matrix - RBF Kernel
  confusionMatrix(Eval_RBF,test$type)
## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   Earthquake Otherquake
##   Earthquake       3020          1
##   Otherquake        114         54
##                                              
##                Accuracy : 0.9639             
##                  95% CI : (0.9569, 0.9701)   
##     No Information Rate : 0.9828             
##     P-Value [Acc > NIR] : 1                  
##                                              
##                   Kappa : 0.4705             
##                                              
##  Mcnemar's Test P-Value : <0.0000000000000002
##                                              
##             Sensitivity : 0.9636             
##             Specificity : 0.9818             
##          Pos Pred Value : 0.9997             
##          Neg Pred Value : 0.3214             
##              Prevalence : 0.9828             
##          Detection Rate : 0.9470             
##    Detection Prevalence : 0.9473             
##       Balanced Accuracy : 0.9727             
##                                              
##        'Positive' Class : Earthquake         
## 

Podemos ver claramente un aumento significativo en la especificidad. 47 de los 55 otros terremotos en nuestros datos de prueba se predicen correctamente, aunque 150 terremotos se predicen incorrectamente. La introducción sobre el muestreo realmente ha ayudado a tratar el desequilibrio de la clase y ha aumentado significativamente nuestra especificidad al 85%.