DATA608_Final_Project.utf8

Earthquake Analysis

To Study the behavior of earthquake around the world (year 2000 - 2020) and perform statistical and exploratory analysis based on data from http://earthquake.usgs.gov

Different factors will be analyzed

      1. What geographical regions have the most magnitude of earthquakes?
      2. Earthquake timeline analysis?
      3. Trend Analysis of earthquake bases on month/zone
      4. Countries most affected by earthquake
      5. Other Events causing quakes
      6. Exploring the earthquake using shiny app

Data Sources

Earthquake data obtained from United States Geological Survey using API services

API - The primary data will be obtained from http://earthquake.usgs.gov using webservice API (https://earthquake.usgs.gov/fdsnws/event/1/query?)

CSV - Some of the supporting data files are fetched from github

Approach and libraries

This project follows the data science workflow, the data is first fetched from API and from github location and then it got transformed in order to present in the form the dataframe or graphs

The following libraries are used

      ggmap - map the world
      RColorBrewer - color coding of graphs
      tidyverse - data cleansing and transformation
      knitr - table visvulizations
      ggplot2 - plot graphs
      GGally - Advanced graphs
      sqldf - SQL operations
      shiny - to build the shiny app
      leaflet - generating maps
      treemap - generating treemaps
      lubridate - date manipulation
      plotly - generating graphs

# Load libraries
library(tidyverse)
library(ggmap)
library(RColorBrewer)
library(knitr)
library(kableExtra)
library(ggplot2)
library(GGally)
library(sqldf)
library(shiny)
library(leaflet)
library(RCurl)
library(treemap)
library(lubridate)
library(plotly)

Analysis

Earthquake data from the year 2000 to 2020 has been used for this analysis

Data from API

USGS has web serive to pull the data using API (example : https://earthquake.usgs.gov/fdsnws/event/1/query?format=csv&starttime=2018-01-01&endtime=2018-02-20")

There is an limiatation to fetch 20000 records on each request, Written a code to loop through from year 2000 to 2020 and saved in a single csv file format for faster performance

#Getting data from API
#quake_part1 <- read.csv("https://raw.githubusercontent.com/mohamedthasleem/DATA608/master/Final_Project/final_data_cleaned_part1.csv", sep = ",", stringsAsFactors = F)
#quake_part2 <- read.csv("https://raw.githubusercontent.com/mohamedthasleem/DATA608/master/Final_Project/final_data_cleaned_part2.csv", sep = ",", stringsAsFactors = F)

#quake <- data.frame(rbind(as.matrix(quake_part1), as.matrix(quake_part2)))
quake <- read.csv("C:/data/final_data_cleaned.csv", sep = ",", stringsAsFactors = F)
quake$date <- as.Date(quake$date)
#summary(quake)

#Preview data
kable(data.frame(head(quake, n=20))) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
  row_spec(0, bold = T, color = "white", background = "#ea7872") %>%
    scroll_box(width = "100%", height = "300px")

seq	date	latitude	longitude	type	locationSource	depth	mag	nst	rms
1	2000-01-30	36.81467	-121.4258	earthquake	nc	5.047	1.13	8	0.090
2	2000-01-30	13.21400	-87.5460	earthquake	us	186.400	4.30	0	1.020
3	2000-01-30	34.68200	-116.2910	earthquake	ci	0.269	1.70	0	0.212
4	2000-01-30	34.85000	-116.4110	earthquake	ci	2.628	1.30	0	0.111
5	2000-01-30	6.31700	-73.1560	earthquake	us	210.800	0.00	0	0.630
6	2000-01-30	35.31100	-119.3680	earthquake	ci	5.040	2.31	0	0.266
7	2000-01-30	44.76083	-111.0898	earthquake	uu	7.300	0.67	10	0.090
8	2000-01-30	19.38200	-155.2620	otherevent	hv	30.267	0.00	8	0.080
9	2000-01-30	34.88033	-116.4118	earthquake	ci	3.856	1.30	4	0.110
10	2000-01-30	39.79000	20.7500	earthquake	ath	7.000	3.10	0	0.000
11	2000-01-30	33.63500	-116.6850	earthquake	ci	4.916	1.20	0	0.095
12	2000-01-30	32.45400	-115.8290	earthquake	ci	-0.364	0.00	0	0.142
13	2000-01-30	12.68600	142.9670	earthquake	us	142.700	4.90	0	0.960
14	2000-01-30	36.83933	-121.4300	earthquake	nc	4.912	0.88	7	0.540
15	2000-01-30	39.29150	-111.2077	earthquake	uu	5.950	1.58	8	0.060
16	2000-01-30	34.79500	-116.3700	earthquake	ci	1.126	1.60	0	0.108
17	2000-01-30	10.37600	125.9250	earthquake	us	33.000	4.70	0	1.000
18	2000-01-30	19.40083	-155.4877	earthquake	hv	7.861	1.40	23	0.110
19	2000-01-30	41.11100	-8.8790	earthquake	mdd	0.000	2.80	0	0.000
20	2000-01-30	33.96900	-117.2280	earthquake	ci	12.556	1.53	0	0.120

Geographical Impact

Magnitude is a number that characterizes the relative size of an earthquake, which is based on measurement of the maximum motion recorded by a seismograph

A Magnitude of 4.5 or higher is considered as dangerous may cause more damage

All Region

# all
quake0 <- subset(quake, quake$mag > 0)

quake0.sorted <- arrange(quake0, desc(mag))
quake0.mod <- select(quake0.sorted, latitude, longitude, mag)
inside <- filter(quake0.mod, between(longitude, -90, 90), between(latitude, -180, 180))
quake0.mod <- setdiff(quake0.mod, inside)

wmap <- borders("world", colour = "gray50", fill = "gray50")


# mag > 0 (All recorded seismic events)
options(repr.plot.width = 20, repr.plot.height = 18)
quake0_map <- ggplot() + wmap
quake0_map <- quake0_map + geom_point(data = quake0.mod, aes(x = as.numeric(longitude), y = as.numeric(latitude),
    colour = mag)) + ggtitle("quakes with Mag > 0 Seismic Events") +
    xlab("Longitude") + ylab("Latitude")+
  theme(plot.title = element_text(hjust = 0.5))
myPalette <- colorRampPalette(rev(brewer.pal(11, "Spectral")))
sc2 <- scale_colour_gradientn(colours = myPalette(100), limits = c(0, 8))
quake0_map + sc2

Risk Region

# 4.5
quake45 <- subset(quake, quake$mag >= 4.5)
quake45.sorted <- arrange(quake45, desc(mag))
quake45.mod <- select(quake45.sorted, latitude, longitude, mag)
inside <- filter(quake45.mod, between(longitude, -90, 90), between(latitude, -180, 180))
quake45.mod <- setdiff(quake45.mod, inside)

wmap <- borders("world", colour = "gray50", fill = "gray50")

# mag >= 4.5$ 
quake45_map <- ggplot() + wmap
quake45_map <- quake45_map + geom_point(data = quake45.mod, aes(x = as.numeric(longitude),
    y = as.numeric(latitude), colour = mag)) + ggtitle("quakes with Mag > 4.5 - Risk") +
    xlab("Longitude") + ylab("Latitude") +
  theme(plot.title = element_text(hjust = 0.5))
myPalette <- colorRampPalette(rev(brewer.pal(11, "Spectral")))
sc1 <- scale_colour_gradientn(colours = myPalette(100), limits = c(4.5, 8))
quake45_map + sc1

Timeline Analysis

ds <- sqldf("select date,avg(depth) as depth,avg(mag) as magnitude from quake where type = 'earthquake' group by date order by date")
fig <- plot_ly(ds, x = ~date)
fig <- fig %>% add_lines(y = ~depth, name = "Depth")
fig <- fig %>% add_lines(y = ~magnitude, name = "Magnitude")
fig <- fig %>% layout(autosize = F, width = 800, height = 500, margin = ds)
fig <- fig %>% layout(legend = list(x = 0, y = 1.0))
fig <- fig %>% layout(
    title = "Trend Analysis",
    xaxis = list(
      rangeselector = list(
        buttons = list(
          list(
            count = 3,
            label = "3 mo",
            step = "month",
            stepmode = "backward"),
          list(
            count = 6,
            label = "6 mo",
            step = "month",
            stepmode = "backward"),
          list(
            count = 1,
            label = "1 yr",
            step = "year",
            stepmode = "backward"),
          list(
            count = 1,
            label = "YTD",
            step = "year",
            stepmode = "todate"),
          list(step = "all"))),

      rangeslider = list(type = "date")),

    yaxis = list(title = "Depth & Magnitude"))

fig

Trend Analysis

Monthly Trend

quake$tes <- paste0('2020',substr(as.character(quake$date),5,10))
#head(quake)
quq1 <- sqldf("select tes as date1,latitude from quake")
quq1$date1 <- as.Date(quq1$date1)
#head(quq1)
quq1 %>%
  group_by(date1) %>%
  summarise(count = n())  %>%
  ggplot() +
  geom_point(mapping = aes(x = date1, y = count, colour = "red")) +
  scale_x_date(name = 'Month', date_breaks = '1 month', date_labels = '%b') + labs(title = "Earthquake - Monthly Trend (2000 - 2020)", y= "Number of Earthquake", x = "Month")+ theme(legend.position = "none") +
  theme(plot.title = element_text(hjust = 0.5))

Zone Level Trend

geo_zone <- function(lat) {
  
  levels <- c("tropics", "subtropics", "temperate", "frigid")
  regions <- factor(x = levels, levels = levels, ordered =T)
  
  if (abs(lat) < 23.5) {    result <- regions[1]  }
  else if (abs(lat) < 35) {    result <- regions[2]  }
  else if (abs(lat) < 66.5) {    result <- regions[3]  }
  else {    result <- regions[4]  }
  return(result)
}

quq1$zone <-unlist(lapply(quq1$latitude, geo_zone))

zone1 <- quq1 %>% group_by(date1, zone = quq1$zone) %>% summarise(count = n())

ggplot(zone1, aes(x = date1, y = count, color = zone1$zone)) +
  geom_point() +
  scale_x_date(name = 'Month', date_breaks = '1 month', date_labels = '%b') + 
  scale_color_brewer(palette="Set1") + labs(title = "Earthquake - Zone Level Impact (2000 - 2020)", y= "Number of Earthquake", x = "Month",  fill = "zone") +
  theme(plot.title = element_text(hjust = 0.5)) + theme(legend.title = element_blank()) + theme(legend.position = c(0.9, 0.9))

Region Exposure

Treemap showing how different places are impacted by earthquake magnitude

#Getting data from github
station_mapping <- read.csv("https://raw.githubusercontent.com/mohamedthasleem/DATA608/master/Final_Project/stations.csv", sep = ",", stringsAsFactors = F)

#Transformating data
quakes1 <- left_join(quake, station_mapping, by = c('locationSource')) %>% rename(lat = latitude) %>% rename(long = longitude) %>% mutate(mag = replace_na(mag, 0)) %>% mutate(stations = replace_na(stations, 0)) 

quakes2 <- subset(quakes1, date > '2019-01-01')
places <-  sqldf("select place,printf(\"%.2f\",avg(mag)) as avg_mag from quakes2 group by place order by avg(mag)")
places$avg_mag <- as.numeric(places$avg_mag) 

treemap(dtf = places,
        index=c("place"),
        vSize="avg_mag",
        vColor="avg_mag",
        palette="Spectral",
        type="value",
        border.col=c("grey70", "grey90"),
        fontsize.title = 18,
        algorithm="pivotSize",
        title ="Earthquakes by Places - Magnitude (2019-2020)",
        title.legend="Magnitude")

Other Analysis

Interesting finds apart from earthquake as part of this analysis

quake_all <- quake %>% mutate(type = replace(type, type == 'sonicboom', 'sonic boom')) %>% mutate(type = replace(type, type == 'quarry', 'quarry blast')) %>% mutate(type = replace(type, type == 'Rock Slide', 'rockslide'))

other <- sqldf("select type,printf(\"%.2f\",avg(mag)) as avg_mag,count(type) as count from quake_all where type <> \"earthquake\" and type <> \"other event\" and type <> \"not reported\" and type <> \"buildingcollapse\" group by type order by avg(mag),count(type)");
other$avg_mag <- as.numeric(other$avg_mag)  

ggplot(data=other, aes(x= reorder(type,avg_mag), y=avg_mag, fill=count)) +  geom_bar(stat="identity", fill = "#63b7af") + coord_flip() + geom_text(aes(label=avg_mag), vjust=0.40, colour = "#9a1f40") + ggtitle("Other Events") + theme(plot.title = element_text(hjust = 0.15)) + theme(legend.position = "none") + xlab("Event") + ylab("Magnitude")

Earthquake Explorer

Shiny link:

https://mohamedthasleem.shinyapps.io/DATA608_Final_Project

Tectonics Plate

Tectonic earthquakes occur at plate tectonic boundaries. Tectonic plates are constantly moving slowly, but sometimes friction between them causes them lock together and become unable to move. The rest of the plates carry on moving, which leads to increased pressure on the locked section. Eventually, the locked section succumbs to the pressure, and the plates move past each other rapidly. This movement causes a tectonic earthquake. The waves of released energy move through the Earth’s crust and cause the shaking we feel at an earthquake site
Some study says that mountains are the results of tectonic earthquakes

Challenges

The data was taken from API, it has limitation of getting 20000 records at a time, so i have split the records by doing multiple API calls to bind the together
Initially the shiny app was designed to fetch data directly from API, but due to limitation (20000 records), and interactive parameter changes in the shiny app will drastically slowdown the performance, then I have redesigned the shiny app to pull data from R dataframe instead of directly from API

Conclusion

Earthquakes are mostly occurring on temperate regions and high on summer season on tropical regions
Asia is most targeted on earthquake
Climate Change and Tectonics plate movement may change the earthquake behavior

References

1.https://earthquake.usgs.gov/fdsnws/event/1/
2.https://earthquake.usgs.gov/
3.http://www.lat34north.com/cities/CitiesLatitude.cfm
4.https://www.ncbi.nlm.nih.gov/pmc/articles/PMC6033417/
5.https://earthquake.usgs.gov/fdsnws/event/1/#parameters
6.https://earthquake.usgs.gov/earthquakes/feed/v1.0/csv.php

DATA608 Final Project
Knowledge and Visual Analytics

Mohamed Thasleem Kalikul Zaman

May 13, 2020

Earthquake Analysis

Data Sources

Approach and libraries

Analysis

Data from API

Geographical Impact

All Region

Risk Region

Timeline Analysis

Trend Analysis

Monthly Trend

Zone Level Trend

Region Exposure

Other Analysis

Earthquake Explorer

Tectonics Plate

Challenges

Conclusion

References

DATA608 Final Project Knowledge and Visual Analytics

Mohamed Thasleem Kalikul Zaman

May 13, 2020

Earthquake Analysis

Data Sources

Approach and libraries

Analysis

Data from API

Geographical Impact

All Region

Risk Region

Timeline Analysis

Trend Analysis

Monthly Trend

Zone Level Trend

Region Exposure

Other Analysis

Earthquake Explorer

Tectonics Plate

Challenges

Conclusion

References

DATA608 Final Project
Knowledge and Visual Analytics