 |
| Penerapan Natural Language Processing pada Tweet Gempa BMKG |
Dalam blog ini, telah banyak kita bahas mengenai teori sekaligus pemanfaatan Natural Language Processing (NLP) baik menggunakan Python maupun R. Namun kali ini, kita akan mencoba mengimplementasikan lebih dalam mengenai pemanfaatan NLP untuk data tidak terstruktur, seperti teks berita atau info gempa bumi di Indonesia yang secara resmi tertera di akun BMKG.
Gempa bumi seringkali terjadi di Indonesia, sebab selain banyaknya gurunu berapi yang aktif, Indonesia juga merupakan tempat pertemuan beberapa lempeng bumi yang juga aktif. Mengingat seringnya kejadian gempa bumi, informasi teraktual mengenai gempa bumi sangat diperlukan oleh seluruh lapisan masyarakat. Informasi gempa bumi yang cepat dan akurat dibutuhkan agar mitigasi risiko bencana gempa bumi dapat dilakukan secara cepat sehingga tidak sampai menimbulkan korban nyawa.
Informasi yang terkandung dalam setiap tweet BMKG terkait gempa bumi cukup lengkap. Mulai dari kekuatan gempa dalam skala Richter (SR), posisi latitude dan longitude, kedalaman, hingga di wilayah mana kejadian gempa bumi. Namun demikian, kita hanya mampu menangkap informasi pada satu waktu saja, sementara histori setiap waktunya sulit untuk diamati. Untuk tujuan inilah, pada kesempatan ini, kita akan mencoba menerapkan NLP pada data teks tweet BMKG 10 hari terakhir yang terjadi di seluruh wilayah Indonesia.
Data tweet yang kita gunakan kali ini berasal dari hasil scraping Twitter dengan menggunakan package rtweet. Kemudian pada proses pembersihan teks kita awali dengan memfilter beberapa tweet yang tidak diperlukan lalu kita ekstrak beberapa variabel yang diperlukan. Pada akhirnya kita akan menampilkan sebuah visualisasi animasi yang memperlihatkan situasi dan kondisi kejadian gempa bumi di Indonesia dalam 10 hari terakhir. Sebagai informasi bahwa penerapan NLP untuk data tidak terstruktur ini telah saya publish dalam jurnal ilmiah yang dapat dibaca pada tautan [berikut]. Berikut beberapa langkahnya menggunakan code R:
#Aktiavsi package yang diperlukan
library(rtweet)
#Membuat Kredensial Akses Twitter dengan API
create_token(app = "xxxxxxxxxxxxxxxxxxxx", consumer_key = "z3AdaqAKnB0aM5MzRfiMA1Say",
consumer_secret = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
access_token = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx",
access_secret = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
## Saving auth to 'C:\Users\Joko Ade\AppData\Roaming/R/config/R/rtweet/create_token.rds'
#Crawling data yang dibutuhkan
gempa <- search_tweets(q = "#Gempa #BMKG", n = 5000, lang = "id", retryonratelimit = F, include_rts = F)
## Downloading multiple pages ==>---------------------------------------------------------------------
## Downloading multiple pages ===>--------------------------------------------------------------------
## Downloading multiple pages =====>------------------------------------------------------------------
## Downloading multiple pages ======>-----------------------------------------------------------------
## Downloading multiple pages ========>---------------------------------------------------------------
## Downloading multiple pages =========>--------------------------------------------------------------
## Downloading multiple pages ===========>------------------------------------------------------------
#Mengambil data yang tidak terduplikat
coba <- gempa[!duplicated(gempa$full_text),]
#Aktivasi package untuk Natural Language Processing
library(stringr)
library(dplyr)
library(tidyr)
#Filter text yang tidak mengandung kata UPDATE, infosonora, Peringatan Dini, dan tweet bukan resmi BMKG
coba %>%
filter(!str_detect(full_text, c("(UPDATE)"))) -> coba
coba %>%
filter(str_detect(full_text, c("#Gempa Mag:|#Gempa Magnitudo:"))) -> coba
coba %>%
filter(!str_detect(full_text, c("#InfoSonora"))) -> coba
coba %>%
filter(!str_detect(full_text, c("Peringatan Dini"))) -> coba
coba %>%
filter(!str_detect(full_text, c("@infoBMKG Ada gempa|@infoBMKG Lariii|#LalinSonora"))) -> coba
#Penyeragaman format teks
coba$text %>%
str_replace_all(" Kedalaman", " Kedlmn") -> coba$text
coba$text %>%
str_replace_all("Magnitudo: ", "Mag:") -> coba$text
coba$text %>%
str_replace_all("Koordinat", "Lok") -> coba$text
coba$text %>%
str_replace_all(" WIB", "WIB") -> coba$text
coba$text %>%
str_replace_all(" Dirasakan", "") -> coba$text
#Seragamkan format tanggal
coba$text %>%
str_replace_all("15 Apr 2023", "15-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("16 Apr 2023", "16-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("17 Apr 2023", "17-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("18 Apr 2023", "18-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("19 Apr 2023", "19-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("20 Apr 2023", "20-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("21 Apr 2023", "21-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("22 Apr 2023", "22-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("23 Apr 2023", "23-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("24 Apr 2023", "24-Apr-2023") -> coba$text
coba$text %>%
str_replace_all("25 Apr 2023", "25-Apr-2023") -> coba$text
#Penyeragaman format lokasi
coba$text %>%
str_replace_all("LU-| LU-| LU,", "LU, ") -> coba$text
coba$text %>%
str_replace_all("LS-| LS-| LS,", "LS, ") -> coba$text
coba$text %>%
str_replace_all(" BB", "BB") -> coba$text
coba$text %>%
str_replace_all(" BT", "BT") -> coba$text
#Ekstrak Lat dan Lon
coba %>%
mutate(latlon = str_extract_all(text, "\\d+\\.\\d{2}LU|\\d+\\.\\d{2}LS|
\\d+\\.\\d{2}BB|\\d+\\.\\d{2}BT")) %>%
mutate(lat = case_when(str_detect(latlon,"LS") ~ paste0("-", str_extract(latlon, "\\d+\\.\\d{2}LS")),
str_detect(latlon,"LU") ~ paste0(str_extract(latlon, "\\d+\\.\\d{2}LU")),
TRUE ~ str_extract(latlon, "\\d+\\.\\d{2}LS"),
TRUE ~ str_extract(latlon, "\\d+\\.\\d{2}LU"))) %>%
mutate(lon = case_when(str_detect(latlon,"BB") ~ paste0("-", str_extract(latlon, "\\d+\\.\\d{2}BB")),
str_detect(latlon,"BT") ~ paste0(str_extract(latlon, "\\d+\\.\\d{2}BT")),
TRUE ~ str_extract(latlon, "\\d+\\.\\d{2}BB"),
TRUE ~ str_extract(latlon, "\\d+\\.\\d{2}BT"))) -> bersih
## Warning in stri_detect_regex(string, pattern, negate = negate, opts_regex = opts(pattern)): argument
## is not an atomic vector; coercing
## Warning in stri_extract_first_regex(string, pattern, opts_regex = opts(pattern)): argument is not an
## atomic vector; coercing
## Warning in stri_detect_regex(string, pattern, negate = negate, opts_regex = opts(pattern)): argument
## is not an atomic vector; coercing
## Warning in stri_extract_first_regex(string, pattern, opts_regex = opts(pattern)): argument is not an
## atomic vector; coercing
## Warning in stri_extract_first_regex(string, pattern, opts_regex = opts(pattern)): argument is not an
## atomic vector; coercing
## Warning in stri_extract_first_regex(string, pattern, opts_regex = opts(pattern)): argument is not an
## atomic vector; coercing
## Warning in stri_detect_regex(string, pattern, negate = negate, opts_regex = opts(pattern)): argument
## is not an atomic vector; coercing
## Warning in stri_extract_first_regex(string, pattern, opts_regex = opts(pattern)): argument is not an
## atomic vector; coercing
## Warning in stri_detect_regex(string, pattern, negate = negate, opts_regex = opts(pattern)): argument
## is not an atomic vector; coercing
## Warning in stri_extract_first_regex(string, pattern, opts_regex = opts(pattern)): argument is not an
## atomic vector; coercing
## Warning in stri_extract_first_regex(string, pattern, opts_regex = opts(pattern)): argument is not an
## atomic vector; coercing
## Warning in stri_extract_first_regex(string, pattern, opts_regex = opts(pattern)): argument is not an
## atomic vector; coercing
bersih$lat <- as.numeric(unlist(lapply(bersih$lat, function(x) gsub("LU|LS", "", x))))
bersih$lon <- as.numeric(unlist(lapply(bersih$lon, function(x) gsub("BB|BT", "", x))))
#Ekstrak Time
bersih %>%
mutate(time = str_extract_all(text, "(?: \\d(.+)\\dWIB)|(?: \\d(.+)\\d\\ \\WIB)|
(?:, d(.+)\\d\\ \\WIB)")) -> bersih
bersih$time <- lapply(bersih$time, function(x) gsub("WIB", "", x))
bersih$time <- lapply(bersih$time, function(x) gsub("\\d+\\ km, ", "", x))
bersih$time <- unlist(bersih$time)
bersih$time %>%
str_replace_all("-23", "-2023") -> bersih$time
#Ekstrak Magnitudo
bersih %>%
mutate(mag = str_extract_all(text, ".*.*Mag:\\d{1}\\.\\d{1}|.*.*Mag: \\d{1}\\.\\d{1}")) -> bersih
bersih$mag <- lapply(bersih$mag, function(x) gsub("#Gempa Mag:", "", x))
bersih$mag <- unlist(bersih$mag)
#Ekstrak Kedalaman Episentrum
bersih %>%
mutate(epidlm = str_extract_all(text, "\\d{1,3} Km|: \\d{1,3} km")) -> bersih
bersih$epidlm <- lapply(bersih$epidlm, function(x) gsub(": ", "", x))
bersih$epidlm <- lapply(bersih$epidlm, function(x) gsub(" Km", "", x))
bersih$epidlm <- lapply(bersih$epidlm, function(x) gsub(" km", "", x))
bersih$epidlm <- as.numeric(unlist(bersih$epidlm))
#Mengubah tipe karakter time menjadi timestamps dengan anytime
library(anytime)
bersih$time <- anytime(bersih$time)
#Aktivasi package visualisasi peta
library(maps)
library(ggplot2)
library(gifski)
library(gganimate)
#Visualisasi peta dasar
county_info <- map_data("world", region = "Indonesia")
base_map <- ggplot(data = county_info, mapping = aes(x = long, y = lat, group = group)) +
geom_polygon(color = "black", fill = "white") +
coord_quickmap() +
theme_void()
base_map
#Menggabungkan peta dan data dan warna dot merah
bersih2 <- bersih
base_map +
geom_point(data = bersih2, aes(x = lon, y = lat, group = time, size = epidlm, colour = "red"))
#Visualisasi animasi
viz <- base_map +
geom_point(data = bersih2, aes(x = lon, y = lat, group = time, color = "red")) +
transition_time(time = time) +
ggtitle('Sebaran 636 Gempa Bumi di Indonesia periode {frame_time}',
subtitle = 'sumber: Twitter @infoBMKG diolah dengan Natural Language Processing') +
theme(legend.position = "none",
plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5)) +
shadow_mark()
#Dengan Shadow mark
gganimate::animate(viz, height = 7,
width = 7, units = "in", res = 130)
##
Rendering [=================================================================] at 5.3 fps ~ eta: 0s
Demikian sedikit sharing kita kali ini. Semoga sedikit ini dapat bermanfaat dan nantikan terus unggahan artikel terbaru, unik, dan menarik dalam blog ini. Selamat memahami dan mempraktikkan!