Wstep

Projekt dotyczy danych wydobytych z popularnej platformy twitter.com poprzez API, na podstawie których przeprowadzone zostaną działania z zakresu data mining’u takie jak czyszczenie danych, wizualizacja, czy analiza sentymentu. Analiza sentymentu odbędzie się przy pomocy biblioteki tidytext, posiadającej dwa słowniki “nrc” oraz “bing”. Twitter oprócz bycia jednym z najbardziej popularnych social mediów, to również zbiór ogromnej ilosci danych, pozwalających na wgląd w zachowanie opinii publicznej, stając się jednym ze źródeł informacji m.in. dla przedsiębiorstw.

Pozyskanie danych z pakietem rtweet

Pierwszym krokiem jest zalaczenie niezbednych do analizy bibliotek.

library(rtweet)
library(ROAuth)
library(tm)
library(wordcloud)
library(plyr)
library(RColorBrewer)
library(dplyr)
library(ggplot2)
library(ggthemes)
library(wordcloud2)
library(lubridate)
library(ggthemes)
library(tidytext)
library(httr)
library(syuzhet)
library(plotly)
library(patchwork)
library(ape)
library(tidyverse)  
library(cluster)    
library(factoextra)
library(dendextend)
library(textdata)

Pakiet “rtweet” umożliwia szybkie i sprawne gromadzenie oraz porzdkowanie danych z platformy twitter.com za posrednictwem Rest API, ktore mozemy pozyskac ze strony https://developer.twitter.com/en/apply-for-access. Najpierw należy utworzyć konto oraz wypełnić formularz zgłoszeniowy, który będzie zawierał informacje o tym w jakim celu chcemy ewentualnie wykorzystać pozyskane dane.

Powinnismy uzyskac następujące dane: * Consumer key * Consumer Secret * Access Token * Access Secret

token <- create_token (
  app = "XXXXXXXXXXX",
  consumer_key = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
  consumer_secret = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
  access_token = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX',
  access_secret = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX')

get_token()

## <Token>
## <oauth_endpoint>
##  request:   https://api.twitter.com/oauth/request_token
##  authorize: https://api.twitter.com/oauth/authenticate
##  access:    https://api.twitter.com/oauth/access_token
## <oauth_app> WizualizacjaR
##   key:    I8xaevANVuoHedPoxGfdfuHy6
##   secret: <hidden>
## <credentials> oauth_token, oauth_token_secret
## ---

ElonMuskTweets <- get_timeline ("@ElonMusk", n = 3200)

Wstępna analiza danych twitterowych

Podzielono tweetty na 3 podgrupy:

1. te, których twórcą jest Elon Musk (organic)
2. te, które Elon Musk podał dalej (retweets)
3. te, na które Elon Musk odpowiedział (replies)

ElonMuskTweets_organic <- ElonMuskTweets[ElonMuskTweets$is_retweet==FALSE, ]
ElonMuskTweets_organic <- subset(ElonMuskTweets_organic, is.na(ElonMuskTweets_organic$reply_to_status_id))
ElonMuskTweets_organic <- ElonMuskTweets_organic %>% arrange(-favorite_count)
ElonMuskTweets_organic <- ElonMuskTweets_organic %>% arrange(-retweet_count)
ElonMuskTweets_retweets <- ElonMuskTweets[ElonMuskTweets$is_retweet==TRUE,]
ElonMuskTweets_replies <- subset(ElonMuskTweets, !is.na(ElonMuskTweets$reply_to_status_id))

df <- data.frame(
  category=c("Organic", "Retweets", "Replies"),
  count=c(c(417, 2554, 228))
)
df$fraction = df$count / sum(df$count)
df$percentage = df$count / sum(df$count) * 100
df$ymax = cumsum(df$fraction)
df$ymin = c(0, head(df$ymax, n=-1))
Segmentation_of_tweets <- paste(df$category, df$percentage, "%")
ggplot(df, aes(ymax=ymax, ymin=ymin, xmax=4, xmin=3, fill=Segmentation_of_tweets)) +
  geom_rect() +
  coord_polar(theta="y") +
  xlim(c(2, 4)) +
  theme_minimal() +
  theme(legend.position = "right") + labs(title = "Podzial na rodzaje postów zamieszczanych na Twitter.com", caption = "Twitter.com")

colnames(ElonMuskTweets)[colnames(ElonMuskTweets) == "screen_name"] <- "Twitter_Account"
ts_plot(group_by(ElonMuskTweets, Twitter_Account), "year") +
  theme_minimal() +
  theme(plot.title = element_text(face = "bold")) +
  labs(
    x = NULL,
    y = NULL,
    title = "Czestotliwosc twittow Elona Muska",
    subtitle = "Zagregowana suma",
    caption = "Twitter.com"
  )

ElonMusk_app <- ElonMuskTweets %>%
  select(source) %>%
  group_by(source) %>%
  summarize(count=n())

## `summarise()` ungrouping output (override with `.groups` argument)

ElonMusk_app <- subset(ElonMusk_app, count > 11)


data <- data.frame(
  category=ElonMusk_app$source,
  count=ElonMusk_app$count
)
data$fraction = data$count / sum(data$count)
data$percentage = data$count / sum(data$count) * 100
data$ymax = cumsum(data$fraction)
data$ymin = c(0, head(data$ymax, n=-1))
Source <- paste(data$category, data$percentage, "%")
ggplot(data, aes(ymax=ymax, ymin=ymin, xmax=4, xmin=3, fill=Source)) +
  geom_rect() +
  coord_polar(theta="y") + # Try to remove that to understand how the chart is built initially
  xlim(c(2, 4)) +
  theme_void() +
  theme(legend.position = "right")+
  labs(
    x = NULL, y = NULL,
    title = "Podzial ze wzgledu na sposob udostepniania postu",
    caption = "Twitter.com"
  )

ElonMuskTweets$date <- day(ElonMuskTweets$created_at)
ElonMuskTweets$hour <- hour(ElonMuskTweets$created_at)



theme_set(theme_tufte())
 ggplot(ElonMuskTweets, aes(x = hour)) +
  geom_density(color = "tomato3", fill = "tomato3", alpha=0.4)  +
  labs(title ="Wykres gestosci", subtitle="Czestosc oznaczen na twitterze",  caption="Source: Twitter.com") +
  xlab("Godziny") +
  ylab("Gestosc oznaczen na twitterze")

Czyszczenie danych

ElonMuskTweets$text <- gsub("@[[:alpha:]]*","", ElonMuskTweets$text) #usuwamy wszystkich uzytkownikow
Corpus <- Corpus(VectorSource(ElonMuskTweets$text))
Corpus <- tm_map(Corpus, content_transformer(tolower))
removeURL <- function(x) gsub("http[^[:space:]]*", "", x)
Corpus <- tm_map(Corpus, content_transformer(removeURL))
removeNumPunct <- function(x) gsub("[^[:alpha:][:space:]]*", "", x)
Corpus <- tm_map(Corpus, content_transformer(removeNumPunct))
Stopwords <- c(setdiff(stopwords('english'), c("r", "big")),
               "use", "see", "used", "via", "amp", "rt", "RT","by","youve" , "bbc")
Corpus <- tm_map(Corpus, removeWords, Stopwords)
Corpus <- tm_map(Corpus, stripWhitespace)
Corpus <- tm_map(Corpus,removeNumbers)
Corpus <- tm_map(Corpus,removePunctuation,preserve_intra_word_dashes = TRUE)
inspect(Corpus[1:10])

## <<SimpleCorpus>>
## Metadata:  corpus specific: 1, document level (indexed): 0
## Content:  documents: 10
## 
##  [1]  exactly                                                                                                                                   
##  [2]  gary snail still winning gaining himher                                                                                                   
##  [3] embrace tunnels                                                                                                                            
##  [4]  tunnels solution traffic can many levels want usable tunnel depth far exceeds tallest buildings work even new york beijing                
##  [5]  just guess probably mid teens booster stacking orbital pad likely limiting factors well build several ships just improve production system
##  [6]  pretty accurate simulation although sn will raptors sn craters sn sn close behind high production rate allows fast iteration              
##  [7]  couldnt agree major software improvements already place extend life coming                                                                
##  [8]  definitely smartwatches phones yesterdays technology neuralinks future                                                                    
##  [9] feed seems like make whole outfit material                                                                                                 
## [10]  ancient greece committed suicide nobody digs grave better

ap.tdm <-TermDocumentMatrix(Corpus)
ap.m <-as.matrix(ap.tdm)
dim(ap.m)

## [1] 5754 3199

ap.v <-sort(rowSums(ap.m),decreasing=TRUE)
ap.d <-data.frame(word=names(ap.v),freq=ap.v)

freq.terms <- findFreqTerms(ap.tdm, lowfreq = 10)
term.freq <- rowSums(as.matrix(ap.tdm))
term.freq <- subset(term.freq, term.freq >= 10)
df <- data.frame(term = names(term.freq), freq = term.freq)
df_4 <-df[order(-df$freq),]
y <- df_4 %>% top_n(10)

## Selecting by freq

ggplot(y, aes(x = term, y = freq)) + geom_bar(stat = "identity", fill="steelblue") +
  xlab("Slowa") + ylab("Ilosc wystapien") + labs(title = 'TOP 20 SLOW',
                                                 subtitle ='Slowa, ktore najczesciej wystepuja w postach Elona Muska' , caption = "Twitter.com") + coord_flip() +
  theme(axis.text = element_text(size = 10))

w <- ap.d %>%top_n(100)

## Selecting by freq

pal2 <- brewer.pal(8,"Dark2")
wordcloud(w$word,w$freq,scale=c(8,.2),min.freq=3,
          max.words=Inf, random.order=FALSE,rot.per=.15,colors=pal2)

wordcloud2(data=ap.d, size=1.6, color='random-dark')

wordcloud2(data=ap.d, size = 0.7, shape = 'pentagon')

Analiza sentymentu

Analiza sentymentu jest jedna z rodzajow analizy tekstu. Dzięki niej możemy sklasyfikować przeróżne dane tekstowe otrzymując informacji o nacechowaniu całej wypowiedzi oraz jej pojedynczej składowej. Stosowana jest do określania ludzkich opinii, odczuć oraz postaw wobec produktów, usług, organizacji, co daje możliwość wykorzystania jej w analizie społecznej ekonomicznej oraz biznesowej. W analizie skorzystamy z dwóch słowników pochodzących z pakietu tidytext “bing” oraz “nrc”.

get_sentiments("bing")

## # A tibble: 6,786 x 2
##    word        sentiment
##    <chr>       <chr>    
##  1 2-faces     negative 
##  2 abnormal    negative 
##  3 abolish     negative 
##  4 abominable  negative 
##  5 abominably  negative 
##  6 abominate   negative 
##  7 abomination negative 
##  8 abort       negative 
##  9 aborted     negative 
## 10 aborts      negative 
## # ... with 6,776 more rows

colnames(df) <-c("word","n")

df %>%  
  inner_join(get_sentiments("bing"), by = "word") %>%
  group_by(sentiment) %>%
  ungroup() %>%
  mutate(word = reorder(word, n))%>%
  ggplot(aes(word, n, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  scale_fill_manual(values = c("red2", "green3")) +
  facet_wrap(~sentiment, scales = "free_y") +
  ylim(0, 120) +
  labs(y = NULL, x = NULL) +
  coord_flip() +
  theme_minimal()

get_sentiments("nrc")

## # A tibble: 13,901 x 2
##    word        sentiment
##    <chr>       <chr>    
##  1 abacus      trust    
##  2 abandon     fear     
##  3 abandon     negative 
##  4 abandon     sadness  
##  5 abandoned   anger    
##  6 abandoned   fear     
##  7 abandoned   negative 
##  8 abandoned   sadness  
##  9 abandonment anger    
## 10 abandonment fear     
## # ... with 13,891 more rows

wykres1 <- df %>%
  inner_join(get_sentiments("nrc"), by = "word") %>%
  filter(sentiment=="positive") %>%
  ggplot(aes(word, n, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  scale_fill_manual(values = c("green3")) +
  facet_wrap(~sentiment, scales = "free_y") +
  ylim(0, 200) +
  labs(y = NULL, x = NULL) +
  coord_flip() +
  theme_minimal()

Analiza “klastrowa”

corpustdm <- TermDocumentMatrix(Corpus, control = list(minWordLength=c(1,Inf)))
t <- removeSparseTerms(corpustdm,sparse=0.98)
m <- as.matrix(t)

distance <- dist(scale(m))
print(distance, digits = 2)

##        can just will make true now launch much one good yes tesla sure haha
## just    70                                                                 
## will   106  113                                                            
## make    57   68  104                                                       
## true    66   76  110   64                                                  
## now     62   72  106   59   67                                             
## launch  64   74  106   62   70  62                                         
## much    71   80  112   68   76  72     75                                  
## one     61   71  106   57   67  62     65   71                             
## good    67   77  110   64   72  67     70   76  66                         
## yes     82   90  119   80   86  82     85   90  83   87                    
## tesla   91   98  124   90   96  92     95   99  93   96 107                
## sure    64   74  108   60   70  65     68   74  64   70  84    94          
## haha    61   72  107   58   61  62     64   72  61   66  82    93   64     
## great   72   80  114   69   76  72     75   81  72   77  90    99   75   72
## yeah    63   72  107   60   68  63     66   73  62   68  83    93   66   63
##        great
## just        
## will        
## make        
## true        
## now         
## launch      
## much        
## one         
## good        
## yes         
## tesla       
## sure        
## haha        
## great       
## yeah      72

hc <- hclust(distance, method = "ward.D")
plot(hc, hang= -1)
rect.hclust(hc,k=10)

op = par(bg = "#DDE3CA")
plot(hc, col = "#487AA1", col.main = "#45ADA8", col.lab = "#7C8071",
     col.axis = "#F38630", lwd = 3, lty = 3, sub = "", hang = -1, axes = FALSE)
axis(side = 2, at = seq(0, 400, 100), col = "#F38630", labels = FALSE,
     lwd = 2)
mtext(seq(0, 400, 100), side = 2, at = seq(0, 400, 100), line = 1,
      col = "#A38630", las = 2)

mypal = c("#556270", "#4ECDC4", "#1B676B", "#FF6B6B", "#C44D58")
clus5 = cutree(hc, 5)
op = par(bg = "#E8DDCB")
plot(as.phylo(hc), type = "fan", tip.color = mypal[clus5], label.offset = 1,
     cex = log(mtcars$mpg, 10), col = "red")

hc1 <- hclust(distance, method = "complete")
hc2 <- hclust(distance, method = "ward.D2")


dendrogram1 <- as.dendrogram (hc1)
dendrogram2 <- as.dendrogram (hc2)

tanglegram(dendrogram1, dendrogram2)

Podsumowanie

Środowisko R oprócz danych liczbowych pozwala również na wykonanie dokładnych analiz tekstowych bądź pojedynczych słów. Pozwala na odkrywanie statystycznych zależności oraz schematów. W pracy przedstawiono tylko jedne z wielu sposobów na przetworzenie tego rodzaju danych. Jest ich zdecydowanie więcej z czego ochoczo korzystają wszelakiego rodzaju przedsiębiorstwa oraz instytucje.

Źródło

1. https://www.tidytextmining.com/
2. http://pbiecek.github.io/Przewodnik/