Obrada podataka

Analiza teksta

Analiza teksta dobiva na popularnosti zbog sve veće dostupnosti podataka i razvoja user friendly podrške za provedbu takve analize. Konceptualni pregled analize teksta ya sociologe je dostupan i u nedavno objavljenoj knjizi, koja se preporuča tek nakon savladavanja osnovnih tehničkih vještina i alata za obradu teksta. Provedba analize tekstualnih podataka je moguća na mnogo načina, a najšire korišten pristup je bag-of-words u kojem je frekvencija riječi polazište za analizu dok se (npr.) pozicija riječi u rečenici ili paragrafu zanemaruje. Bag of words pristup je ujedno i najjednostavniji (konceptualno i računarski) pa će biti korišten u ovom predavanju.

Postupak analize teksta započinje pripremom teksta (podataka), koja je često dosta zahtjevna i uključuje: uvoz teksta, operacije sa riječima, uređivanje i tokenizaciju, izradu matrice pojmova, filtiranje i ponderiranje podataka. Pri tome valja imati na umu da vrsta analize i korištena metoda određuju način na koji je potrebno pripremiti podatke za daljnu analizu te da svaka metoda ima svoje specifičnosti. Nakon pripreme podataka se vrši analiza teksta (podataka) metodama nadziranog strojnog učenja, ne-nadziranog strojnog učenja, statistike na tekstualnim podatcima, analize riječnika, analize sentimenta. Napredne metode analize podataka uključuju NLP, analizu pozicije riječi i sintakse…Sažeti prikaz workflow-a za analizu teksta izgleda ovako:

Procedura za analizu teksta.

Software i korisni resursi

U ovom predavanju ćemo koristiti tidytext pristup (i istoimeni paket) za analizu tekstualnih podatka, detaljno opisan u knjizi Text Mining with R. Ovaj paket služi kako bismo tekstualne podatke “uveli” u tidyverse ovir pomoću kojeg je moguće nestrukturirani tekst analizirati sa otprije poznatim alatima iz dplyr i ggplot paketa. Učitajmo potrebne pakete:

library(tidyverse)
library(tidytext)
library(data.table)
library(lubridate)
library(grid)
library(wordcloud)
library(reshape2)
library(igraph)
library(ggraph)
library(widyr)
library(topicmodels)
library(ggthemes)
library(DT)
library(kableExtra)
library(ggplot2)
library(ggthemes)
library(scales)
library(tidyverse)
library(httr)
library(lubridate)
library(dplyr)
library(data.table)
library(tidytext)
library(plotly)
library(readxl)

Prije opisa podataka koje ćemo koristiti valja naglasiti da tidytext pristup nije jedini način za rad s podatcima u R. Ovdje ga koristimo jer je kompatibilan sa pristupima koje smo do sada koristili u okviru ovog kolegija. Drugi paketi (pristupi) za rad sa tekstom u R su:

quanteda je sveobuhvatan i funkcijama bogat paket, neophodan u za složeniju analizu teksta. Izvrstan tutorial je dostupan na linku.
text2vec je izrazito koristan paket za ML algoritme sa tekstualnim podatcima. Posebno je pogodan za izradu dtm i tcm matrica. Paket je motiviran python-ovom Gensim knjižnicom, a tutorial je dostupan na linku.
stringr paket je neophodan za manipulaciju string podataka u R i kao dio tidyverse svijeta će biti izrazito koristan u čišćenju i pripremi podataka. Vrlo je praktičan za rad sa regex-om i ima nekoliko izvrsnih funkcija za pattern matching. Službeni R Tutorial je dostupan na linku.
spacyr je wrapper paket za spaCy knjižnicu iz python-a i omogućava provedbu naprednijih NLP modela (deep learning, speech tagging, tkoenization, parsing) u R. Također je kompatibilan sa quanteda i tidytext paketima. Tutorial je dostupan na linku.
za one koji žele znati više mogu biti korisni i sljedeći resursi: vodič za tekstualnu analizu u R i kolegij za obradu prirodnog teksta u najstajnju koji sadrži i mnoštvo referenci.

Podatci

Svaka analiza (teksta) počinje od podataka. Pribava tekstualnih podataka o specifičnim temama najčešće nije jednostavna. Najčešći je način preuzimanja podataka neki od dostupnih API servisa za novinske članke ili tekstualnih repozitorija ili servisi poput Twitter-a. No to često nije dovoljno ukolilko želimo analizirati specifičnu temu ili temu na specifičnom jeziku (npr. hrvatskom). Ovdje još valja napomeniti da je preuzimanje kvalitetnih tekstualnih podataka često moguće isključivo uz nadoplatu kao što je to slučaj člancima na hrvatskom jeziku kroz webhose.io servis, presscliping, presscut i mediatoolkit

U ovom ćemo predavanju analizirati tržište aparata za kavu u Hrvatskoj na osnovi osnovi svih tekstova objavljenih u svim domaćim medijima u perodu od 2021-01-09 do 2022-11-01. Članci su preuzeti strojno sa mediatoolkit servisa i identificirani na način da sadrže riječ: LatteGo, De`Longhi, Krups i Nesspreso. Na taj je način prikupljeno 290 objava koje sadrže ukupno 8.980 riječi. Analiza teksta koju ćemo provesti uključuje nekoliko etapa: čišćenje, uređivanje i prilagodbu podataka, dekriptivnu statistiku na tekstualnim podatcima, analizu sentimenta, analizu frekvencija i tematsku analizu.

Uvoz podataka

Podatci za analizu su prikupljeni na prethodno opisan način i dostupni u GitHub repozitoriju kolegija. Učitajmo i pregledajmo cjelopkupni podatkovni skup:

kava <- read_excel("../Dta/kava.xlsx") #, encoding="UTF-8"
glimpse(kava)

## Rows: 289
## Columns: 45
## $ DATE                  <chr> "2022-01-10", "2022-01-08", "2022-01-07", "2022-~
## $ TIME                  <chr> "09:18:45", "18:32:43", "08:00:26", "18:00:00", ~
## $ TITLE                 <chr> "Hello.. #hello #monday #january #winter #day #w~
## $ FROM                  <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8>~
## $ AUTHOR                <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8>~
## $ URL                   <chr> "https://www.instagram.com/p/CYiubD4owlX/", "htt~
## $ URL_PHOTO             <chr> "https://mediatoolkit.com/img/50x50,sc,s-3IcNbqA~
## $ SOURCE_TYPE           <chr> "instagram", "twitter", "instagram", "twitter", ~
## $ GROUP_NAME            <chr> "Philips", "Philips", "Philips", "Philips", "Phi~
## $ KEYWORD_NAME          <chr> "Nespresso", "Nespresso", "LatteGo", "Nespresso"~
## $ FOUND_KEYWORDS        <chr> "nespresso", "Nespresso", "LatteGo, lattego", "n~
## $ LANGUAGES             <chr> "hr, et, no", "hr", "hr, bs", "hr, sk", "hr", "h~
## $ LOCATIONS             <chr> "EE, NO, HR", "HR", "HR, BA", "SK, HR", "HR", "H~
## $ TAGS                  <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ MANUAL_SENTIMENT      <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ AUTO_SENTIMENT        <chr> "neutral", "neutral", "positive", "neutral", "ne~
## $ MENTION_SNIPPET       <chr> "Hello.. #hello #monday #january #winter #day #w~
## $ REACH                 <dbl> 50, 0, 30, 22, NA, NA, NA, NA, 10, 77, 0, 50, 46~
## $ VIRALITY              <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.0000000, 0~
## $ FOLLOWERS_COUNT       <dbl> 0, 9, 0, 449, NA, NA, NA, NA, 0, NA, NA, 259, NA~
## $ LIKE_COUNT            <dbl> 5, NA, 3, NA, NA, NA, NA, NA, 1, 0, 0, 3, 91, 0,~
## $ COMMENT_COUNT         <dbl> 0, NA, 0, NA, NA, NA, NA, NA, 0, 0, 0, 2, 16, 0,~
## $ SHARE_COUNT           <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, 0, 0, NA, 6,~
## $ TWEET_COUNT           <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ LOVE_COUNT            <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ WOW_COUNT             <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ HAHA_COUNT            <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ SAD_COUNT             <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ ANGRY_COUNT           <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ TOTAL_REACTIONS_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ FAVORITE_COUNT        <dbl> NA, 0, NA, 0, NA, NA, NA, NA, NA, NA, NA, NA, NA~
## $ RETWEET_COUNT         <dbl> NA, 0, NA, 0, NA, NA, NA, NA, NA, NA, NA, NA, NA~
## $ VIEW_COUNT            <dbl> 0, NA, 0, NA, NA, NA, NA, NA, 0, NA, NA, 0, NA, ~
## $ DISLIKE_COUNT         <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ COMMENTS_COUNT        <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ LIKES                 <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ DISLIKES              <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ COUNT                 <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ REPOST_COUNT          <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ REDDIT_TYPE           <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ REDDIT_SCORE          <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ INFLUENCE_SCORE       <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 3, 1, 1, 3, ~
## $ TWEET_TYPE            <chr> NA, "ORIGINAL", NA, "ORIGINAL", NA, NA, NA, NA, ~
## $ TWEET_SOURCE_NAME     <chr> NA, "Twitter Web App", NA, "Twitter for Android"~
## $ TWEET_SOURCE_URL      <chr> NA, "https://mobile.twitter.com", NA, "http://tw~

Nakon što smo učitali podatke u radni prostor R, potrebno je učitati i druge podatke koji su nam potrebni za ovu analizu. Osim članaka, potrebni su nam leksikoni i stop riječi. Leksikone ćemo preuzeti iz FER-ovog repozitorija, a “stop riječi” ćemo napraviti sami. Ti su podatci trenutno pohranjeni na privatnoj MFiles bazi pa ćemo ih od tamo preuzeti na lokalno računalno:

## M-Files ----
# function to parse JSON from http conenctiion
parseJSON <- function(x) {
  xCon <- content(x, as = "text", type = "aplication/json", encoding = "UTF-8")
  xCon <- jsonlite::fromJSON(xCon, flatten = TRUE)
  xCon
}
# GET REST API function M-Files
mfiles_get <- function(token, resource){
  req <- GET(url = paste0('http://server.contentio.biz/REST', resource),
             add_headers('X-Authentication' = token, 'content-type' = "application/json"))
  result <- parseJSON(req)
  return(result)
}
# GET token M-Files
req <- POST(url = 'http://server.contentio.biz/REST/server/authenticationtokens.aspx', 
            config = add_headers('content-type' = "application/json"),
            body = list(Username = "msagovac", Password = "Wc8O10TaHz40",
                        VaultGuid = "{7145BCEB-8FE2-4278-AD3B-7AE70374FF8A}",
                        ComputerName  = "CT-VM-01"),
            encode = "json", verbose())

token <- parseJSON(req)[[1]]
# M-FILES DOWNLOAD FILES
mfiles_downlaod <- function(objType, objId, fileId) {
  req <- GET(url = paste0('http://server.contentio.biz/REST/objects/', objType, '/', 
                          objId, '/latest/files/',fileId , '/content'),
             add_headers('X-Authentication' = token))
  reqCon <- content(req, as = "text", encoding = "UTF-8")
  if (is.na(reqCon)) {
    reqCon <- content(req, as = "raw", encoding = "UTF-8")
    reqCon <- rawToChar(reqCon, multiple = FALSE)
    reqCon <- iconv(reqCon, "", "UTF-8")
  }
  reqCon
}
mfiles_downlaod_txt <- function(objType, objId, fileId, ext = ".csv") {
  req <- GET(url = paste0('http://server.contentio.biz/REST/objects/', objType, '/', 
                          objId, '/latest/files/',fileId , '/content'),
             add_headers('X-Authentication' = token))
  reqCon <- httr::content(req)
  tempFileSave <- paste0(tempfile(), ext)
  writeBin(reqCon, tempFileSave)
  return(tempFileSave)
}
# GET classess, props and others
prop <- mfiles_get(token, "/structure/properties")
prop <- prop %>% 
  select(DataType, ID, Name, ObjectType) %>% 
  dplyr::arrange(Name)
objs <- mfiles_get(token, "/structure/objecttypes")
mfilesClass <- mfiles_get(token, "/structure/classes")
CroSentilex_n <- read.delim(mfiles_downlaod_txt("0", 136679, 136711, ext = ".txt"),
                            header = FALSE,
                            sep = " ",
                            stringsAsFactors = FALSE) %>% 
  rename(word = "V1", sentiment = "V2" ) %>%
  mutate(brija = "NEG")
CroSentilex_p <- read.delim(mfiles_downlaod_txt("0", 136681, 136713, ext = ".txt"),
                            header = FALSE,
                            sep = " ",
                            stringsAsFactors = FALSE) %>% 
  rename(word = "V1", sentiment = "V2" ) %>%
  mutate(brija = "POZ")
Crosentilex_sve <- rbind(setDT(CroSentilex_n), setDT(CroSentilex_p))
#head(Crosentilex_sve)
CroSentilex_Gold  <- read.delim2(mfiles_downlaod_txt("0", 136680, 136712, ext = ".txt"),
                                 header = FALSE,
                                 sep = " ",
                                 stringsAsFactors = FALSE) %>%
  rename(word = "V1", sentiment = "V2" ) 
CroSentilex_Gold[1,1] <- "dati"
CroSentilex_Gold$sentiment <- str_replace(CroSentilex_Gold$sentiment , "-", "1")
CroSentilex_Gold$sentiment <- str_replace(CroSentilex_Gold$sentiment , "\\+", "2")
CroSentilex_Gold$sentiment <- as.numeric(unlist(CroSentilex_Gold$sentiment))
#head(CroSentilex_Gold)
# leksikoni
stopwords_cro <- get_stopwords(language = "hr", source = "stopwords-iso")
my_stop_words <- tibble(
  word = c(
    "jedan","i", "za", "je", "ti","mp","50","4300","5400",
    "e","prvi", "dva","dvije","drugi","u","na","my",
    "tri","tre?i","pet","kod", "bit.ly", "pixie", "https","family.hr",
    "ove","ova",  "ovo","bez",
    "evo","oko",  "om", "ek",
    "mil","tko","?est", "sedam",
    "osam",   "?im", "zbog",
    "prema", "dok","zato", "koji", 
    "im", "?ak","me?u", "tek",
    "koliko", "tko","kod","poput", 
    "ba?", "dakle", "osim", "svih", 
    "svoju", "odnosno", "gdje",
    "kojoj", "ovi", "toga","ima","treba","sad","to","kad", "?e","ovaj","?ta","onda","ce","ko"
  ),
  lexicon = "lux"
)
stop_corpus <- my_stop_words %>%
  bind_rows(stopwords_cro)

Prilagodba podataka

U sljedećem koraku ćemo stvoriti neke dodatne varijable korisne za analizu:

kava %>%
   mutate(kword = case_when(grepl("latteg", MENTION_SNIPPET, ignore.case = TRUE) ~ "LatteGo",
                            grepl("longhi", MENTION_SNIPPET, ignore.case = TRUE) ~ "DeLonghi",
                            grepl("krups", MENTION_SNIPPET, ignore.case = TRUE) ~ "Krups",
                            grepl("Nespresso", MENTION_SNIPPET, ignore.case = TRUE) ~ "Nespresso")) -> kava

Potom pretvaramo podatke u dataframe, izabiremo varijable za analizu, specificiramo vremenski pečat članka kao datumsku varijablu, pripisujemo id svakom članku, izabiremo vremenski raspon analize i dodajemo numerički označitelj svakom članku:

# prilagodi podatke
newskava <- kava %>% 
  as.data.frame() %>%
  select(TITLE,MENTION_SNIPPET, DATE, SOURCE_TYPE, AUTHOR, FROM, kword) %>%  
  mutate(datum = as.Date(DATE,"%Y-%m-%d")) %>%
  mutate(clanak = 1:n())

# brzi pregled strukture podataka
glimpse(newskava)

## Rows: 289
## Columns: 9
## $ TITLE           <chr> "Hello.. #hello #monday #january #winter #day #work #l~
## $ MENTION_SNIPPET <chr> "Hello.. #hello #monday #january #winter #day #work #l~
## $ DATE            <chr> "2022-01-10", "2022-01-08", "2022-01-07", "2022-01-06"~
## $ SOURCE_TYPE     <chr> "instagram", "twitter", "instagram", "twitter", "forum~
## $ AUTHOR          <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8><U+0001D4F8><U+0001D4F4><U+0001D4EA> <U+0001D4EB><U+0001D4F8>~
## $ FROM            <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8><U+0001D4F8><U+0001D4F4><U+0001D4EA> <U+0001D4EB><U+0001D4F8>~
## $ kword           <chr> "Nespresso", "Nespresso", "LatteGo", "Nespresso", "Nes~
## $ datum           <date> 2022-01-10, 2022-01-08, 2022-01-07, 2022-01-06, 2022-~
## $ clanak          <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,~

# izgled podataka
# newskava %>%
#   sample_n(.,10)

datatable(newskava, rownames = FALSE, filter="top", options = list(pageLength = 5, scrollX=T) )

U sljedećem koraku provodimo tokenizaciju, odnosno pretvaranje teksta na jedinice analize koje su u ovom slučaju su riječi:

# tokenizacija

newskava %>% 
  unnest_tokens(word, MENTION_SNIPPET) -> newskava_token 

#newsCOVID_token$word <- stri_encode(newsCOVID_token$word, "", "UTF-8") # prilagodi encoding

datatable(newskava_token, rownames = FALSE, filter="top", options = list(pageLength = 5, scrollX=T) )

Potom valja očistiti riječi od brojeva i nepotrebnih riječi. Na tako uređenim podatcima ćemo potom napraviti deskriptivno-statistički pregled teksta.

## Ukloni "stop words", brojeve, veznike i pojedinačna slova

newskava_token %>% 
  anti_join(stop_corpus, by = "word") %>%
  mutate(word = gsub("\\d+", NA, word)) %>%
  mutate(word = gsub("^[a-zA-Z]$", NA, word)) %>% 
  drop_na(.)-> newskava_tokenTidy

datatable(newskava_tokenTidy, rownames = FALSE, filter="top", options = list(pageLength = 5, scrollX=T) )

Na tako uređenim podatcima ćemo napraviti deskriptivno-statistički pregled teksta:

## Vremenski raspon podatka
range(newskava_token$DATE)

## [1] "2021-09-01" "2022-01-10"

## Najčešće riječi
newskava_tokenTidy %>%
  count(word, sort = T) %>%
  head(25)

##             word   n
## 1       hrvatska 147
## 2      nespresso  92
## 3      de’longhi  60
## 4        lattego  45
## 5            dom  35
## 6        bauhaus  33
## 7         coffee  31
## 8           kavu  31
## 9        philips  31
## 10       samsung  31
## 11          kave  21
## 12        istria  20
## 13       mikulec  19
## 14        aparat  18
## 15       citroën  18
## 16          jysk  18
## 17          kler  18
## 18    namještaja  18
## 19    pogledajte  18
## 20        qualis  18
## 21         salon  18
## 22        akcija  17
## 23         krups  17
## 24        možete  17
## 25 philipscoffee  17

## Vizualizacija najčešćih riječi
newskava_tokenTidy %>%
  count(word, sort = T) %>%
  filter(n > 10) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n)) +
  geom_col() +
  xlab(NULL) +
  coord_flip() +
  theme_economist()

## Vizualizacija najčešćih riječi kroz vrijeme
newskava_tokenTidy %>%
   mutate(Datum = floor_date(datum, "day")) %>%
   group_by(Datum) %>%
   count(word) %>% 
   mutate(gn = sum(n)) %>%
   filter(word %in%  c("nespresso", "de’longhi", "lattego", "krups")) %>%
   ggplot(., aes(Datum,  n / gn)) + 
   geom_point() +
   ggtitle("Učestalost korištenja kroz vrijeme") +
   ylab("% ukupnih riječi") +
   geom_smooth() +
   facet_wrap(~ word, scales = "free_y") +
   scale_y_continuous(labels = scales::percent_format())+
   theme_economist()

…i deskriptivno-statistički pregled objava:

## Broj domena
newskava_tokenTidy %>% 
  summarise(Domena = n_distinct(SOURCE_TYPE))

##   Domena
## 1      6

## Broj objava po domeni

kava %>% 
 # drop_na(.) %>%
  group_by(SOURCE_TYPE) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>% 
  head(20)

## # A tibble: 7 x 2
##   SOURCE_TYPE     n
##   <chr>       <int>
## 1 web           110
## 2 facebook       73
## 3 instagram      51
## 4 forum          44
## 5 youtube         5
## 6 twitter         4
## 7 reddit          2

## Broj objava po brandu

kava %>% 
 # drop_na(.) %>%
  group_by(kword) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>% 
  head(20)

## # A tibble: 4 x 2
##   kword         n
##   <chr>     <int>
## 1 Nespresso   135
## 2 DeLonghi     84
## 3 Krups        35
## 4 LatteGo      35

## Broj članaka po domeni 

newskava %>% 
   mutate(Datum = floor_date(datum, "week")) %>%
   group_by(Datum, SOURCE_TYPE) %>%
   summarise(n = n()) %>%
   ungroup() %>%
   ggplot(., aes(Datum,  n)) + 
   geom_line() +
   ggtitle("Broj članaka o kafe aparatima kroz vrijeme") +
   ylab("Broj članaka") +
   geom_smooth() +
   facet_wrap(~ SOURCE_TYPE, scales = "free_y") +
   theme_economist()

## Broj objava kroz vrijeme 

newskava %>% 
   mutate(Datum = floor_date(datum, "week")) %>%
   group_by(Datum, kword) %>%
   summarise(n = n()) %>%
   ungroup() %>%
   ggplot(., aes(Datum,  n)) + 
   geom_line() +
   ggtitle("Članci na najvažnijim portalima") +
   ylab("Broj objavljenih COVID članaka") +
   geom_smooth() +
   facet_wrap(~ kword, scales = "free_y") +
   theme_economist()

Analiza sentimenta

Nakon uređivanja podataka i osnovnog pregleda ćemo provesti analizu sentimenta. Za analizu sentimenta je potrebno preuzeti leksikone koji su za hrvatski jezik napravljeni u okviru FER-ovog Croatian Sentiment Lexicon. Analiza sentimenta i uključuje sentiment kroz vrijeme, doprinos riječi sentimentu, ‘wordCloud’ i analizu negativnosti brandova.

Pogledajmo prvo kako izgledaju leksikoni (koje smo učitali još na početku):

## Pregled leksikona (negativne riječi)
CroSentilex_n %>% sample_n(10)

##                 word sentiment brija
##  1:   nekomercijalan   0.15288   NEG
##  2:           punjač   0.13185   NEG
##  3:    predbacivanje   0.28771   NEG
##  4:         pijanist   0.35604   NEG
##  5:     moderniziran   0.46104   NEG
##  6:        srpanjski   0.47624   NEG
##  7: drvoprerađivački   0.32504   NEG
##  8:      dvostrukost   0.29568   NEG
##  9:      kanibalizam   0.22913   NEG
## 10:             teći   0.47736   NEG

## Pregled leksikona (pozitivne riječi)
CroSentilex_p %>% sample_n(10)

##              word sentiment brija
##  1:      nerješiv   0.45116   POZ
##  2:   podilaženje   0.34042   POZ
##  3:        konoba   0.46588   POZ
##  4: preglasavanje   0.21094   POZ
##  5:          štap   0.56702   POZ
##  6:         nejak   0.24581   POZ
##  7:        rubeša   0.23169   POZ
##  8:     upravljan   0.24896   POZ
##  9:      gazivoda   0.32586   POZ
## 10:   zaposjednut   0.33942   POZ

## Pregled leksikona (sve riječi)
Crosentilex_sve %>% sample_n(10)

##              word sentiment brija
##  1:       iluzija   0.58692   POZ
##  2:  maloljetnica   0.41214   POZ
##  3:       grižula   0.11224   NEG
##  4:     arkanovac   0.14322   POZ
##  5:    defanzivac   0.25468   NEG
##  6: višejezičnost   0.17275   POZ
##  7:        walter   0.54167   POZ
##  8:        tobias   0.25100   POZ
##  9:   ekskluzivan   0.50823   NEG
## 10:   demontirati   0.21763   POZ

## Pregled leksikona (crosentilex Gold)
CroSentilex_Gold %>% sample_n(10)

##           word sentiment
## 1          jug         0
## 2     prednost         2
## 3       svečan         2
## 4        modan         0
## 5      početak         0
## 6        korak         0
## 7     otkriven         0
## 8  predstavnik         0
## 9        vrsta         0
## 10     navesti         0

Provjerimo kretanje sentimenta u vremenu:

## Kretanje sentimenta u vremenu 

vizualiziraj_sentiment <- function(dataset, frq = "week") {

dataset %>%
  inner_join( Crosentilex_sve, by = "word") %>%
  filter(!is.na(word)) %>%
  select(word, brija, datum, sentiment) %>% 
  unique() %>%
  spread(. , brija, sentiment) %>%
  mutate(sentiment = POZ - NEG) %>%
  select(word, datum, sentiment) %>% 
  group_by(word) %>% 
  mutate(count = n()) %>%
  arrange(desc(count)) %>%
  mutate( score = sentiment*count) %>%
  ungroup() %>%
  group_by(datum) %>%
  arrange(desc(datum)) -> sm

 
sm %>%
  select(datum, score) %>%
  group_by(Datum = floor_date(datum, frq)) %>%
  summarise(Dnevni_sent = sum(score, na.rm = TRUE)) %>%
  ggplot(., aes(Datum, Dnevni_sent)) +
  geom_bar(stat = "identity") + 
  ggtitle(paste0("Sentiment kroz vrijeme/frekvencija podataka:", frq)) +
  ylab("SentimentScore") +
  theme_economist()-> gg_sentiment_kroz_vrijeme_qv


gg_sentiment_kroz_vrijeme_qv

}

vizualiziraj_sentiment(newskava_tokenTidy,"week")

Korisno je i promotriti koje riječi najviše doprinose sentimentu (pozitivnom, negativnom i neutralnom):

## Doprinos sentimentu
doprinos_sentimentu <- function(dataset, no = n) {
dataset %>%
  inner_join(CroSentilex_Gold, by = "word") %>% 
  count(word, sentiment,sort = TRUE) %>% 
  group_by(sentiment) %>%
  top_n(no) %>%
  ungroup() %>%
  mutate(sentiment = case_when(sentiment == 0 ~ "NEUTRALNO",
                                 sentiment == 1 ~ "NEGATIVNO",
                                 sentiment == 2 ~ "POZITIVNO")) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  ggtitle( "Doprinos sentimentu") +
  labs( x = "Riječ", y = "Broj riječi") +
  facet_wrap(~ sentiment, scales = "free_y") +
  coord_flip() +
  theme_economist() -> gg_doprinos_sentimentu
  
 gg_doprinos_sentimentu
 
}


doprinos_sentimentu(newskava_tokenTidy,15)

Korisno je pogledati i WordCloud sentiment. Pogledajmo “obični” WordCloud prije toga:

## WordCloud(vulgaris)
newskava_tokenTidy %>%
  anti_join(CroSentilex_Gold,by="word") %>% 
  count(word) %>% 
  arrange(desc(n)) %>%
  top_n(100) %>%
  with(wordcloud(word, n, max.words = 80))

Ovako izgleda WordCloud koji sadržava i prikaz sentimenta:

## ComparisonCloud
newskava_tokenTidy %>%
  inner_join(CroSentilex_Gold,by="word") %>% 
  count(word, sentiment) %>% 
  top_n(200) %>%
  mutate(sentiment = case_when(sentiment == 0 ~ "+/-",
                                 sentiment == 1 ~ "-",
                                 sentiment == 2 ~ "+")) %>%
  acast(word ~ sentiment, value.var = "n", fill = 0) %>%
  comparison.cloud(colors = c("firebrick3", "deepskyblue3","darkslategray"),
                   max.words = 120)

Analiza sentimenta se može iskoristiti za pregled negativnosti pojedinih brandova:

## Najnegativniji brandovi
wCount <- newskava_tokenTidy %>% 
  group_by(kword) %>%
  summarise(word = n())

CroSentilex_Gold_neg <- CroSentilex_Gold %>% filter(sentiment == 1)
CroSentilex_Gold_poz <- CroSentilex_Gold %>% filter(sentiment == 2)


newskava_tokenTidy %>% 
  semi_join(CroSentilex_Gold_neg, by= "word") %>%
  group_by(kword) %>% 
  summarise(negWords = n()) %>%
  left_join(wCount, by = "kword") %>%
  mutate(negativnostIndex = (negWords/word)*100) %>%
  arrange(desc(negativnostIndex))

## # A tibble: 2 x 4
##   kword     negWords  word negativnostIndex
##   <chr>        <int> <int>            <dbl>
## 1 LatteGo          1   547           0.183 
## 2 Nespresso        1  1086           0.0921

…također i pozitivnosti brandova:

## Najpozitivniji brandovi

CroSentilex_Gold_poz <- CroSentilex_Gold %>% filter(sentiment == 2)

newskava_tokenTidy %>% 
  semi_join(CroSentilex_Gold_poz, by= "word") %>%
  group_by(kword) %>% 
  summarise(pozWords = n()) %>%
  left_join(wCount, by = "kword") %>%
  mutate(pozitivnostIndex = (pozWords/word)*100) %>%
  arrange(desc(pozitivnostIndex))

## # A tibble: 4 x 4
##   kword     pozWords  word pozitivnostIndex
##   <chr>        <int> <int>            <dbl>
## 1 DeLonghi        41  1368             3.00
## 2 Nespresso       20  1086             1.84
## 3 LatteGo         10   547             1.83
## 4 Krups            4   233             1.72

Analiza važnosti pojmova

Nakon analize sentimenta je korisno analizirati i najbitnije riječi. To se radi pomoću IDF (inverse document frequency) metode. IDF metoda omogućuje identifikaciju važnih (ne nužno čestih) riječi u korpusu i može poslužiti za analizu najvažnijih pojmova po brandovima.

## Udio riječi po domenama

domenaWords <- newskava %>%
  unnest_tokens(word,MENTION_SNIPPET) %>% 
  count(kword, word, sort = T)
  
ukupnoWords <- domenaWords %>%
  group_by(kword) %>%
  summarise(totWords = sum(n))

domenaWords <- left_join(domenaWords, ukupnoWords)


# domenaWords %>% head(15)

# domenaWords %>% 
# ggplot(., aes(n/totWords, fill = domena)) +
#   geom_histogram(show.legend = FALSE) +
#   xlim(NA, 0.0009) +
#   facet_wrap(~domena, ncol = 2, scales = "free_y")

## Najbitnije riječi po domenma

idf <- domenaWords %>%
  bind_tf_idf(word, kword, n)

idf %>% head(30)

##        kword      word   n totWords          tf       idf      tf_idf
## 1  Nespresso nespresso 181     4143 0.043688149 0.2876821 0.012568297
## 2   DeLonghi  hrvatska 146     2607 0.056003069 0.6931472 0.038818369
## 3  Nespresso        za 144     4143 0.034757422 0.0000000 0.000000000
## 4  Nespresso         i 136     4143 0.032826454 0.0000000 0.000000000
## 5  Nespresso         u 115     4143 0.027757664 0.0000000 0.000000000
## 6  Nespresso        je 108     4143 0.026068067 0.0000000 0.000000000
## 7   DeLonghi         u  82     2607 0.031453778 0.0000000 0.000000000
## 8   DeLonghi de’longhi  72     2607 0.027617952 1.3862944 0.038286611
## 9    LatteGo   lattego  58     1088 0.053308824 1.3862944 0.073901721
## 10     Krups     krups  50     1142 0.043782837 0.6931472 0.030347950
## 11 Nespresso         s  47     4143 0.011344436 0.0000000 0.000000000
## 12  DeLonghi        za  45     2607 0.017261220 0.0000000 0.000000000
## 13 Nespresso        na  45     4143 0.010861694 0.0000000 0.000000000
## 14  DeLonghi         s  44     2607 0.016877637 0.0000000 0.000000000
## 15  DeLonghi         i  41     2607 0.015726889 0.0000000 0.000000000
## 16  DeLonghi        je  39     2607 0.014959724 0.0000000 0.000000000
## 17   LatteGo   philips  37     1088 0.034007353 0.6931472 0.023572101
## 18 Nespresso      kavu  37     4143 0.008930727 0.0000000 0.000000000
## 19 Nespresso      kave  36     4143 0.008689356 0.2876821 0.002499772
## 20  DeLonghi       dom  35     2607 0.013425393 1.3862944 0.018611547
## 21 Nespresso       ili  35     4143 0.008447985 0.2876821 0.002430334
## 22  DeLonghi   bauhaus  33     2607 0.012658228 1.3862944 0.017548030
## 23  DeLonghi        na  32     2607 0.012274645 0.0000000 0.000000000
## 24  DeLonghi   samsung  31     2607 0.011891063 1.3862944 0.016484513
## 25     Krups         i  30     1142 0.026269702 0.0000000 0.000000000
## 26   LatteGo        za  30     1088 0.027573529 0.0000000 0.000000000
## 27 Nespresso    aparat  28     4143 0.006758388 0.0000000 0.000000000
## 28     Krups        za  27     1142 0.023642732 0.0000000 0.000000000
## 29 Nespresso        uz  26     4143 0.006275646 0.0000000 0.000000000
## 30  DeLonghi      kavu  25     2607 0.009589567 0.0000000 0.000000000

# idf %>% 
#   select(-totWords) %>%
#   arrange(desc(tf_idf))

idf %>%
  arrange(desc(tf_idf)) %>%
  mutate(word = factor(word, levels = rev(unique(word)))) %>% 
  mutate(domena = factor(kword)) %>%
  group_by(domena) %>% 
  top_n(10,tf_idf) %>% 
  ungroup() %>%
  ggplot(aes(word, tf_idf, fill = kword)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~kword, scales = "free") +
  coord_flip() +
  theme_economist()

nGrami

Do sada smo analizirali tekst na osnovi pojedinačnih riječi. Takav pristup ograničava nalaze do kojih je moguće doći kada se tekst sagleda na osnovi fraza (dvije ili n riječi). U sljedećemo koraku ćemo tokenizirati tekst na bigrame (dvije riječi) kako bismo proveli frazeološku analizu. Korištenje bigrama otvara mogućnosti korištenja dodatnih pokazatelja pa ćemo provesti i analizu korelacije među riječima.

## tokeniziraj na bigram

newskava_bigram <- newskava %>%
  unnest_tokens(bigram, MENTION_SNIPPET, token = "ngrams", n = 2)

## pregledaj podatke

# newskava_bigram %>% head(25)


## najvažniji bigrami

newskava_bigram %>%
  count(bigram, sort = T) %>%
  head(25)

##                      bigram  n
## 1                   za kavu 64
## 2        de’longhi hrvatska 44
## 3                 aparat za 36
## 4          bauhaus hrvatska 33
## 5              nespresso je 24
## 6                      je u 22
## 7          istria de’longhi 20
## 8                 my istria 20
## 9             jysk hrvatska 18
## 10            kler hrvatska 18
## 11          namještaja kler 18
## 12             qualis salon 18
## 13         salon namještaja 18
## 14                    dom s 16
## 15       hrvatska family.hr 16
## 16         mirjanom mikulec 16
## 17               s mirjanom 16
## 18              tražimo dom 16
## 19                   dom po 15
## 20                  moj dom 15
## 21                   za sve 15
## 22      family.hr de’longhi 14
## 23          hrvatska svijet 14
## 24             lesnina xxxl 14
## 25 philipshomeliving coffee 14

newskava_bigram_sep <- newskava_bigram %>%
  separate(bigram, c("word1","word2"), sep = " ")

newskava_bigram_tidy <- newskava_bigram_sep %>%
  filter(!word1 %in% stop_corpus$word) %>%
  filter(!word2 %in% stop_corpus$word) %>%
  mutate(word1 = gsub("\\d+", NA, word1)) %>%
  mutate(word2 = gsub("\\d+", NA, word2)) %>%
  mutate(word1 = gsub("^[a-zA-Z]$", NA, word1)) %>%
  mutate(word2 = gsub("^[a-zA-Z]$", NA, word2)) %>% 
  drop_na(.)


newskava_bigram_tidy_bigram_counts <- newskava_bigram_tidy %>% 
  count(word1, word2, sort = TRUE)


#newsCOVID_bigram_tidy_bigram_counts

bigrams_united <- newskava_bigram_tidy %>%
  drop_na(.) %>%
  unite(bigram, word1, word2, sep = " ")

#bigrams_united

bigrams_united %>% 
  count(clanak,bigram,sort = T) -> topicBigram

# Najvažniji bigrami po brandovima

 bigram_tf_idf <- bigrams_united %>%
  count(kword, bigram) %>%
  bind_tf_idf(bigram, kword, n) %>%
  arrange(desc(tf_idf))

bigram_tf_idf %>%
  arrange(desc(tf_idf)) %>%
  mutate(bigram = factor(bigram, levels = rev(unique(bigram)))) %>% 
  group_by(kword) %>% 
  top_n(7) %>% 
  ungroup() %>%
  ggplot(aes(bigram, tf_idf, fill = kword)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~kword, ncol = 2, scales = "free") +
  coord_flip() + 
  theme_economist()

Provjerimo koje su riječi najviše korelirane sa izabranim ključnim riječima:

# Korelacije riječi ( R crash na T=30)

#newsCOVID_tokenTidy %>% 
#  filter(published == "2020-04-22") %>%
#  pairwise_count(word, domena, sort = T) %>%
#  filter_all(any_vars(!is.na(.))) -> pairsWords

newskava_tokenTidy %>% 
#  filter(datum > "2020-02-20") %>%
  group_by(word) %>%
  filter(n() > 20) %>%
  filter(!is.na(word)) %>%
  pairwise_cor(word,datum, sort = T) -> corsWords

#corsWords %>%
#  filter(item1 == "oporavak")

corsWords %>%
  filter(item1 %in% c("de’longhi", "krups", "lattego", "nespresso", "dom")) %>%
  group_by(item1) %>%
  top_n(10) %>%
  ungroup() %>%
  mutate(item2 = reorder(item2, correlation)) %>%
  ggplot(aes(item2, correlation)) +
  geom_bar(stat = "identity") +
  facet_wrap(~ item1, scales = "free") +
  coord_flip() + 
  theme_economist()

Tematska analiza

Na kraju provodimo tematsku analizu kao najsloženiji dio do sada provedene analize. Pri tome koristimo LDA (Latent Dirichlet allocation) algoritam kako bismo pronašli najvažnije riječi u algoritamski identificiranim temama. Ovdje je važno primijetiti da prije provedbe LDA modela tokenizirane riječi treba pretvoriti u matricu pojmova (document term matrix) koju ćemo kasnije koristiti kao input za LDA algoritam.

newskava_tokenTidy %>%
  count(clanak, word, sort = TRUE) %>%
  cast_dtm(clanak, word,n) -> dtm

newskava_LDA <- LDA(dtm, k = 4,  control = list(seed = 1234))

newskava_LDA_tidy <- tidy(newskava_LDA, matrix = "beta")
#newsCOVID_LDA_tidy

newskava_terms <- newskava_LDA_tidy %>%
  drop_na(.) %>%
  group_by(topic) %>%
  top_n(15, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

#newsCOVID_terms

newskava_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered() + 
  theme_economist()

Tematsku analizu je moguće i napraviti na bigramski tokeniziranom tekstu. Tada je često moguće doći do preciznijih i kontekstualno relevantnijih uvida:

# Bigrami 

topicBigram %>%
  cast_dtm(clanak, bigram,n) -> dtmB

newskava_LDA <- LDA(dtmB, k = 4,  control = list(seed = 1234))

newskava_LDA_tidy <- tidy(newskava_LDA, matrix = "beta")
#newsCOVID_LDA_tidy

newskava_terms <- newskava_LDA_tidy %>%
  drop_na(.) %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

#newsCOVID_terms


newskava_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered() + 
  theme_economist()

Zaključak

U ovom smo predavanju dali uvodni pregled mogućnosti analize teksta u okviru tidytext paketa. Riječ je o skupu alata koji omogućavaju “prilagodbu” teksta u tidy format i daljnu analizu s tidyverse alatima koje smo do sada već dobro upoznali. tidytext nije jedini dostupan okvir za analizu teksta u R, već postoji i niz drugih paketa (vidi na početku) koji omogućavaju korištenje naprednijih (algoritamkskih tehnika.

U predavanju su korišteni tekstovi objavljeni u svim hrvatskim medijima o proizvođačima aparata za kavu u razdoblju četiri mjeseca. Predavanje je imalo za cilj demonstrirati uvodne mogućnosti tekstualne analize te osnovnih tehnika i alata.

Analiza teksta (NLP) je trenutno (brzo) rastuće istraživačko područje sa sve većim brojem primjena, novih etodoloških pristupa i perspektiva. Dostupno je mnoštvo kvalitetnih i korisnih resursa pa se zainteresiranim studentima preporuča uključivanje u ovu (vrlo perspektivnu) istraživačku paradigmu.