Pertama, kita memuat library yang diperlukan dan memeriksa struktur dataset AssociatedPress dari package topicmodels.
library(tm)
## Warning: package 'tm' was built under R version 4.5.3
## Loading required package: NLP
## Warning: package 'NLP' was built under R version 4.5.2
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(tidytext)
## Warning: package 'tidytext' was built under R version 4.5.3
library(ggplot2)
##
## Attaching package: 'ggplot2'
## The following object is masked from 'package:NLP':
##
## annotate
# Memuat dataset AssociatedPress
data("AssociatedPress", package = "topicmodels")
AssociatedPress
## <<DocumentTermMatrix (documents: 2246, terms: 10473)>>
## Non-/sparse entries: 302031/23220327
## Sparsity : 99%
## Maximal term length: 18
## Weighting : term frequency (tf)
# Melihat beberapa term teratas
terms <- Terms(AssociatedPress)
head(terms)
## [1] "aaron" "abandon" "abandoned" "abandoning" "abbott"
## [6] "abboud"
Selanjutnya, kita mengubah objek DocumentTermMatrix tersebut menjadi bentuk tidy data frame menggunakan fungsi tidy(). Setelah itu, kita bisa menggabungkannya dengan kamus sentimen bing untuk melakukan analisis sentimen.
# Mengubah DTM menjadi tidy format
ap_td <- tidy(AssociatedPress)
ap_td
## # A tibble: 302,031 × 3
## document term count
## <int> <chr> <dbl>
## 1 1 adding 1
## 2 1 adult 2
## 3 1 ago 1
## 4 1 alcohol 1
## 5 1 allegedly 1
## 6 1 allen 1
## 7 1 apparently 2
## 8 1 appeared 1
## 9 1 arrested 1
## 10 1 assault 1
## # ℹ 302,021 more rows
# Menggabungkan dengan get_sentiments
ap_sentiments <- ap_td %>%
inner_join(get_sentiments("bing"), by = c(term = "word"))
ap_sentiments
## # A tibble: 30,094 × 4
## document term count sentiment
## <int> <chr> <dbl> <chr>
## 1 1 assault 1 negative
## 2 1 complex 1 negative
## 3 1 death 1 negative
## 4 1 died 1 negative
## 5 1 good 2 positive
## 6 1 illness 1 negative
## 7 1 killed 2 negative
## 8 1 like 2 positive
## 9 1 liked 1 positive
## 10 1 miracle 1 positive
## # ℹ 30,084 more rows
Berikut adalah visualisasi kata-kata yang memberikan kontribusi terbesar terhadap sentimen positif maupun negatif (dengan kemunculan minimal 200 kali).
ap_sentiments %>%
count(sentiment, term, wt = count) %>%
filter(n >= 200) %>%
mutate(n = ifelse(sentiment == "negative", -n, n)) %>%
mutate(term = reorder(term, n)) %>%
ggplot(aes(n, term, fill = sentiment)) +
geom_col() +
labs(x = "Contribution to sentiment", y = NULL)
Selain objek dari package tm, tidytext juga mendukung konversi objek Document-Feature Matrix (dfm) dari package quanteda.
library(tidyr)
# Membuat objek dfm menggunakan quanteda
data("data_corpus_inaugural", package = "quanteda")
inaug_dfm <- data_corpus_inaugural %>%
quanteda::tokens() %>%
quanteda::dfm(verbose = FALSE)
inaug_dfm
## Document-feature matrix of: 60 documents, 9,591 features (91.94% sparse) and 4 docvars.
## features
## docs fellow-citizens of the senate and house representatives :
## 1789-Washington 1 71 116 1 48 2 2 1
## 1793-Washington 0 11 13 0 2 0 0 1
## 1797-Adams 3 140 163 1 130 0 2 0
## 1801-Jefferson 2 104 130 0 81 0 0 1
## 1805-Jefferson 0 101 143 0 93 0 0 0
## 1809-Madison 1 69 104 0 43 0 0 0
## features
## docs among vicissitudes
## 1789-Washington 1 1
## 1793-Washington 0 0
## 1797-Adams 4 0
## 1801-Jefferson 1 0
## 1805-Jefferson 7 0
## 1809-Madison 0 0
## [ reached max_ndoc ... 54 more documents, reached max_nfeat ... 9,581 more features ]
# Mengubah dfm menjadi tidy format
inaug_td <- tidy(inaug_dfm)
inaug_td
## # A tibble: 46,402 × 3
## document term count
## <chr> <chr> <dbl>
## 1 1789-Washington fellow-citizens 1
## 2 1797-Adams fellow-citizens 3
## 3 1801-Jefferson fellow-citizens 2
## 4 1809-Madison fellow-citizens 1
## 5 1813-Madison fellow-citizens 1
## 6 1817-Monroe fellow-citizens 5
## 7 1821-Monroe fellow-citizens 1
## 8 1841-Harrison fellow-citizens 11
## 9 1845-Polk fellow-citizens 1
## 10 1849-Taylor fellow-citizens 1
## # ℹ 46,392 more rows
Kita bisa menghitung nilai TF-IDF untuk melihat kata-kata unik yang paling penting di setiap dokumen pidato kenegaraan.
inaug_tf_idf <- inaug_td %>%
bind_tf_idf(term, document, count) %>%
arrange(desc(tf_idf))
inaug_tf_idf
## # A tibble: 46,402 × 6
## document term count tf idf tf_idf
## <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 1793-Washington arrive 1 0.00680 4.09 0.0279
## 2 1793-Washington upbraidings 1 0.00680 4.09 0.0279
## 3 1793-Washington willingly 1 0.00680 3.40 0.0231
## 4 1793-Washington incurring 1 0.00680 3.40 0.0231
## 5 2025-Trump — 22 0.00657 3.40 0.0224
## 6 1793-Washington previous 1 0.00680 3.00 0.0204
## 7 1793-Washington violated 1 0.00680 3.00 0.0204
## 8 1793-Washington knowingly 1 0.00680 3.00 0.0204
## 9 1793-Washington injunctions 1 0.00680 3.00 0.0204
## 10 1793-Washington witnesses 1 0.00680 3.00 0.0204
## # ℹ 46,392 more rows
Berikut adalah proses untuk mengekstrak tahun dari nama dokumen, kemudian menghitung proporsi frekuensi kata spesifik seiring berjalannya tahun.
# Mengekstrak tahun dan menghitung total kata per tahun
year_term_counts <- inaug_td %>%
extract(document, "year", "(\\d+)", convert = TRUE) %>%
complete(year, term, fill = list(count = 0)) %>%
group_by(year) %>%
mutate(year_total = sum(count))
# Visualisasi tren beberapa kata spesifik
year_term_counts %>%
filter(term %in% c("god", "america", "foreign", "union", "constitution", "freedom")) %>%
ggplot(aes(year, count / year_total)) +
geom_point() +
geom_smooth(method = "loess", se = FALSE) +
facet_wrap(~ term, scales = "free_y") +
scale_y_continuous(labels = scales::percent_format()) +
labs(y = "% frequency of word in inaugural address")
## `geom_smooth()` using formula = 'y ~ x'
Sebaliknya, jika kita sudah memiliki data dalam bentuk tidy namun package analisis lanjutan (seperti pemodelan topik) membutuhkan format matriks, kita bisa menggunakan fungsi cast_ untuk mengubahnya kembali.
library(Matrix)
##
## Attaching package: 'Matrix'
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
library(janeaustenr)
## Warning: package 'janeaustenr' was built under R version 4.5.3
# Mengubah kembali ke DocumentTermMatrix
ap_td %>%
cast_dtm(document, term, count)
## <<DocumentTermMatrix (documents: 2246, terms: 10473)>>
## Non-/sparse entries: 302031/23220327
## Sparsity : 99%
## Maximal term length: 18
## Weighting : term frequency (tf)
# Mengubah kembali ke dfm milik quanteda
ap_td %>%
cast_dfm(document, term, count)
## Document-feature matrix of: 2,246 documents, 10,473 features (98.72% sparse) and 0 docvars.
## features
## docs adding adult ago alcohol allegedly allen apparently appeared arrested
## 1 1 2 1 1 1 1 2 1 1
## 2 0 0 0 0 0 0 0 1 0
## 3 0 0 1 0 0 0 0 1 0
## 4 0 0 3 0 0 0 0 0 0
## 5 0 0 0 0 0 0 0 0 0
## 6 0 0 2 0 0 0 0 0 0
## features
## docs assault
## 1 1
## 2 0
## 3 0
## 4 0
## 5 0
## 6 0
## [ reached max_ndoc ... 2,240 more documents, reached max_nfeat ... 10,463 more features ]
# Mengubah menjadi sparse Matrix objek
m <- ap_td %>%
cast_sparse(document, term, count)
class(m)
## [1] "dgCMatrix"
## attr(,"package")
## [1] "Matrix"
dim(m)
## [1] 2246 10473
Contoh melakukan tokenisasi dari buku Jane Austen, menghitung kemunculannya, lalu menyimpannya langsung ke dalam bentuk DocumentTermMatrix.
austen_dtm <- austen_books() %>%
unnest_tokens(word, text) %>%
count(book, word) %>%
cast_dtm(book, word, n)
austen_dtm
## <<DocumentTermMatrix (documents: 6, terms: 14520)>>
## Non-/sparse entries: 40379/46741
## Sparsity : 54%
## Maximal term length: 19
## Weighting : term frequency (tf)
Beberapa objek Corpus memiliki metadata pelengkap untuk setiap dokumen di dalamnya. Fungsi tidy() akan mempertahankan metadata tersebut ke dalam kolom data frame yang rapi.
data("acq", package = "tm")
acq
## <<VCorpus>>
## Metadata: corpus specific: 0, document level (indexed): 0
## Content: documents: 50
# Memeriksa isi dokumen pertama
acq[[1]]
## <<PlainTextDocument>>
## Metadata: 15
## Content: chars: 1287
# Mengubah objek Corpus ber-metadata menjadi tidy
acq_td <- tidy(acq)
acq_td
## # A tibble: 50 × 16
## author datetimestamp description heading id language origin topics
## <chr> <dttm> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 <NA> 1987-02-26 15:18:06 "" COMPUT… 10 en Reute… YES
## 2 <NA> 1987-02-26 15:19:15 "" OHIO M… 12 en Reute… YES
## 3 <NA> 1987-02-26 15:49:56 "" MCLEAN… 44 en Reute… YES
## 4 By Cal … 1987-02-26 15:51:17 "" CHEMLA… 45 en Reute… YES
## 5 <NA> 1987-02-26 16:08:33 "" <COFAB… 68 en Reute… YES
## 6 <NA> 1987-02-26 16:32:37 "" INVEST… 96 en Reute… YES
## 7 By Patt… 1987-02-26 16:43:13 "" AMERIC… 110 en Reute… YES
## 8 <NA> 1987-02-26 16:59:25 "" HONG K… 125 en Reute… YES
## 9 <NA> 1987-02-26 17:01:28 "" LIEBER… 128 en Reute… YES
## 10 <NA> 1987-02-26 17:08:27 "" GULF A… 134 en Reute… YES
## # ℹ 40 more rows
## # ℹ 8 more variables: lewissplit <chr>, cgisplit <chr>, oldid <chr>,
## # places <named list>, people <lgl>, orgs <lgl>, exchanges <lgl>, text <chr>
Kita bisa membersihkan teks ini dari stop words untuk melihat kata yang paling sering muncul serta nilai TF-IDF-nya.
acq_tokens <- acq_td %>%
select(-places) %>%
unnest_tokens(word, text) %>%
anti_join(stop_words, by = "word")
# Kata yang paling sering muncul
acq_tokens %>%
count(word, sort = TRUE)
## # A tibble: 1,566 × 2
## word n
## <chr> <int>
## 1 dlrs 100
## 2 pct 70
## 3 mln 65
## 4 company 63
## 5 shares 52
## 6 reuter 50
## 7 stock 46
## 8 offer 34
## 9 share 34
## 10 american 28
## # ℹ 1,556 more rows
# Menghitung TF-IDF berdasarkan ID dokumen
acq_tokens %>%
count(id, word) %>%
bind_tf_idf(word, id, n) %>%
arrange(desc(tf_idf))
## # A tibble: 2,853 × 6
## id word n tf idf tf_idf
## <chr> <chr> <int> <dbl> <dbl> <dbl>
## 1 186 groupe 2 0.133 3.91 0.522
## 2 128 liebert 3 0.130 3.91 0.510
## 3 474 esselte 5 0.109 3.91 0.425
## 4 371 burdett 6 0.103 3.91 0.405
## 5 442 hazleton 4 0.103 3.91 0.401
## 6 199 circuit 5 0.102 3.91 0.399
## 7 162 suffield 2 0.1 3.91 0.391
## 8 498 west 3 0.1 3.91 0.391
## 9 441 rmj 8 0.121 3.22 0.390
## 10 467 nursery 3 0.0968 3.91 0.379
## # ℹ 2,843 more rows
Sebagai alternatif modern dari fungsi GoogleFinanceSource yang sudah usang, bagian ini menggunakan package rvest untuk melakukan web scraping berita keuangan terkini langsung dari RSS Feed Yahoo Finance.
library(rvest)
## Warning: package 'rvest' was built under R version 4.5.2
library(purrr)
## Warning: package 'purrr' was built under R version 4.5.3
library(stringr)
## Warning: package 'stringr' was built under R version 4.5.3
# Menentukan daftar perusahaan dan ticker simbol sahamnya
company <- c("Microsoft", "Apple", "Google", "Amazon", "Meta",
"Twitter", "IBM", "Yahoo", "Netflix")
symbol <- c("MSFT", "AAPL", "GOOG", "AMZN", "META",
"TWTR", "IBM", "YHOO", "NFLX")
# Membuat fungsi custom scraper
download_articles <- function(symbol) {
Sys.sleep(2)
url <- paste0("https://feeds.finance.yahoo.com/rss/2.0/headline?s=", symbol)
hasil <- tryCatch({
halaman <- read_html(url)
judul_berita <- halaman %>%
html_nodes("item title") %>%
html_text()
paste(judul_berita, collapse = " . ")
}, error = function(e) {
return(NA)
})
return(hasil)
}
# Mengeksekusi scraping teks berita keuangan
stock_articles <- tibble(company = company, symbol = symbol) %>%
mutate(corpus = map_chr(symbol, download_articles))
head(stock_articles)
## # A tibble: 6 × 3
## company symbol corpus
## <chr> <chr> <chr>
## 1 Microsoft MSFT "Here’s How Nancy Pelosi Beat the Stock Market and Warren Bu…
## 2 Apple AAPL "Here’s How Nancy Pelosi Beat the Stock Market and Warren Bu…
## 3 Google GOOG "Google's $920 Million‑a‑Month Deal Could Supercharge the Sp…
## 4 Amazon AMZN "Prediction: Quantum Computing Will Produce the Nasdaq's Bes…
## 5 Meta META "SpaceX’s IPO Is Ready for Liftoff. Its Returns Might Not Be…
## 6 Twitter TWTR ""
Proses tokenisasi memecah paragraf berita menjadi kata per kata agar siap dianalisis secara tidy.
stock_tokens <- stock_articles %>%
unnest_tokens(word, corpus) %>%
select(company, symbol, word)
head(stock_tokens)
## # A tibble: 6 × 3
## company symbol word
## <chr> <chr> <chr>
## 1 Microsoft MSFT here’s
## 2 Microsoft MSFT how
## 3 Microsoft MSFT nancy
## 4 Microsoft MSFT pelosi
## 5 Microsoft MSFT beat
## 6 Microsoft MSFT the
Menghitung nilai TF-IDF dari berita masing-masing emiten saham setelah menyaring komponen angka.
stock_tf_idf <- stock_tokens %>%
count(company, word) %>%
filter(!str_detect(word, "\\d+")) %>%
bind_tf_idf(word, company, n) %>%
arrange(-tf_idf)
stock_tf_idf
## # A tibble: 1,111 × 6
## company word n tf idf tf_idf
## <chr> <chr> <int> <dbl> <dbl> <dbl>
## 1 Netflix netflix 9 0.0431 1.95 0.0838
## 2 IBM ibm 9 0.0375 1.95 0.0730
## 3 Amazon amazon 6 0.0252 1.95 0.0491
## 4 Microsoft microsoft 6 0.0252 1.95 0.0491
## 5 Netflix nflx 5 0.0239 1.95 0.0466
## 6 Amazon fiber 4 0.0168 1.95 0.0327
## 7 Amazon corning 6 0.0252 1.25 0.0316
## 8 Netflix hastings 3 0.0144 1.95 0.0279
## 9 Netflix hoag 3 0.0144 1.95 0.0279
## 10 Netflix jay 3 0.0144 1.95 0.0279
## # ℹ 1,101 more rows
Analisis Sentimen 1: Kontribusi Kata Menggunakan Kamus AFINN
stock_tokens %>%
anti_join(stop_words, by = "word") %>%
count(company, word, sort = TRUE) %>%
inner_join(get_sentiments("afinn"), by = "word") %>%
group_by(word) %>%
summarize(contribution = sum(n * value)) %>%
slice_max(abs(contribution), n = 12) %>%
mutate(word = reorder(word, contribution)) %>%
ggplot(aes(contribution, word)) +
geom_col() +
labs(x = "Frequency of word * AFINN value", y = NULL)
Analisis Sentimen 2: Kamus Loughran (Spesialisasi Konteks Finansial) Melihat 5 kata teratas untuk setiap kategori emosi/sentimen yang ada di dalam kamus Loughran.
stock_tokens %>%
count(word) %>%
inner_join(get_sentiments("loughran"), by = "word") %>%
group_by(sentiment) %>%
slice_max(n, n = 5, with_ties = FALSE) %>%
ungroup() %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(n, word)) +
geom_col() +
facet_wrap(~ sentiment, scales = "free") +
labs(x = "Frequency of this word in the recent financial articles", y = NULL)
Menghitung Positivity Score untuk membandingkan sentimen keseluruhan antar perusahaan.
# Mengubah bentuk matriks sentimen menjadi melebar (wide)
stock_sentiment_count <- stock_tokens %>%
inner_join(get_sentiments("loughran"), by = "word") %>%
count(sentiment, company) %>%
pivot_wider(names_from = sentiment, values_from = n, values_fill = 0)
stock_sentiment_count
## # A tibble: 7 × 5
## company litigious negative positive uncertainty
## <chr> <int> <int> <int> <int>
## 1 Meta 2 8 1 4
## 2 Amazon 0 6 2 3
## 3 Apple 0 4 4 2
## 4 Google 0 1 4 5
## 5 IBM 0 2 4 0
## 6 Microsoft 0 4 3 4
## 7 Netflix 0 5 6 0
# Visualisasi perbandingan skor positif vs negatif
stock_sentiment_count %>%
mutate(score = (positive - negative) / (positive + negative)) %>%
mutate(company = reorder(company, score)) %>%
ggplot(aes(score, company, fill = score > 0)) +
geom_col(show.legend = FALSE) +
labs(x = "Positivity score among recent news articles", y = NULL)
Analisis teks membutuhkan fleksibilitas kerja antar berbagai jenis tools dan package, di mana input serta outputnya tidak selalu berformat tidy. Bab ini telah mendemonstrasikan bagaimana melakukan konversi bolak-balik antara tidy text data frame dengan struktur sparse document-term matrices, serta bagaimana melakukan proses tidy pada objek Corpus yang menyimpan metadata dokumen. Kemampuan konversi ini merupakan pondasi penting sebelum melangkah ke pemodelan tingkat lanjut seperti Topic Modeling.