Text mining e n-Gram analisi del testo dei tweets estratti nel periodo immediatamente precedente e successivo alla valanga che ha colpito l’hotel Rigopiano in Abruzzo il 18 Gennaio 2017

UNIVERSITA’ DEGLI STUDI DI TORINO
Laurea Magistarle in Comunicazione pubblica e Politica
Corso di studio: Social Media Analysis e Big Data
Prof. Giuseppe Tipaldo

Introduzione

L’analisi quantifica e rende visibili le parole e le associazioni di parole più utilizzate dagli utenti del social network Twitter durante i giorni con al centro la valanga che ha colpito l’hotel Rigopiano in Abruzzo il 18 gennaio 2017. Il dataset utilizzato è fornito da CELI s.r.l.

PERIODO DI RIFERIMENTO: dal 16/01/2017 al 22/01/2017
TWEETS ANALIZZATI: 162.389
CAMPIONE ESTRATTO: 1000
STRUMENTI UTILIZZATI: RStudio (library: lubridate, wordcloud, reshape2, stringi, ggplot2, scales, RWeka, tm), R Markdown (html_notebook, Knit to HTML, Knit to PDF, Knit to WORD)

Caricamento dei dati e rappresentazione

## Attivo le librerie di funzioni
library(lubridate)
library(wordcloud)
library(reshape2)
library(stringi)
library(ggplot2)
library(scales)
library(RWeka)
library(tm)

## Carico i dati
snowtest <- read.csv("snowtest.csv", sep = ";")

## Ottimizzo il timestamp
snowtest$created <- dmy_hm(snowtest$datetime)

## Ottimizzo la TIME ZONE
snowtest$created <- with_tz(snowtest$created, "Europe/Rome")

## Distribuzione dei tweets per GIORNO DELLA SETTIMANA
ggplot(data = snowtest, aes(x = wday(datetime, label = TRUE))) +
  geom_bar(aes(fill = ..count..)) +
  theme(legend.position = "none") +
  xlab("Giorno della settimana") + ylab("Numero di tweets") + 
  scale_fill_gradient(low = "midnightblue", high = "aquamarine4")

## Quantità di tweets per ORARIO
# Estraggo i giorni
snowtest$timeonly <- as.numeric(snowtest$created - trunc(snowtest$created, "days"))
class(snowtest$timeonly) <- "POSIXct"

# Distribuzione dei tweets per ORARIO
ggplot(data = snowtest, aes(x = timeonly)) +
  geom_histogram(aes(fill = ..count..)) +
  theme(legend.position = "none") +
  xlab("Orario") + ylab("Numero di tweets") + 
  scale_x_datetime(breaks = date_breaks("2 hours"), 
                   labels = date_format("%H:00")) +
  scale_fill_gradient(low = "midnightblue", high = "aquamarine4")

## Somma dei caratteri dei TWEETS
snowtest$cl_text <- as.character(snowtest$text)
snowtest$lenght <- sapply(snowtest$cl_text, function(x) nchar(x))

# Distribuzione dei tweets per numero di caratteri
ggplot(data = snowtest, aes(x = lenght)) +
  geom_histogram(aes(fill = ..count..), binwidth = 16) +
  theme(legend.position = "none") +
  xlab("Caratteri per Tweet") + ylab("Numero di tweets") + 
  scale_fill_gradient(low = "midnightblue", high = "aquamarine4")

## Estraggo un campione
data <- snowtest[sample(1:nrow(snowtest), 1000, replace=FALSE),]

## Creo le funzioni per pulire il testo
removeURL <- function(x) gsub("http:[[:alnum:]]*", "", x)
removeURL <- function(x) gsub("https:[[:alnum:]]*", "", x)
removeHashTags <- function(x) gsub("#\\S+", "", x)
removeTwitterHandles <- function(x) gsub("@\\S+", "", x)

## Creo il Corpus da normalizzare con TM Package
corpusnow <- Corpus(VectorSource(data$text)) 
corpusnow <- tm_map(corpusnow, content_transformer(function(x) iconv(x, to='UTF-8', sub='byte')), mc.cores=1)
corpusnow <- tm_map(corpusnow, content_transformer(tolower))
corpusnow <- tm_map(corpusnow, removeNumbers) 
corpusnow <- tm_map(corpusnow, removePunctuation)
corpusnow <- tm_map(corpusnow, removeURL)
corpusnow <- tm_map(corpusnow, removeTwitterHandles)
corpusnow <- tm_map(corpusnow, removeHashTags)
corpusnow <- tm_map(corpusnow, removeWords, stopwords("italian"))
corpusnow <- tm_map(corpusnow, stripWhitespace)
corpusnow <- tm_map(corpusnow, PlainTextDocument)

##  Creo la matrice dei dati
dtm <-DocumentTermMatrix(corpusnow, control=list(wordLengths=c(4, 20)))

## Verifico la "sparsità" della matrice
dtm

<<DocumentTermMatrix (documents: 1000, terms: 4191)>>
Non-/sparse entries: 10505/4180495
Sparsity           : 100%
Maximal term length: 20
Weighting          : term frequency (tf)

## Ottimizzo la matrice con al massimo il 10% di spazio vuoto.
# dtm <- removeSparseTerms(dtm, 0.1) 

## Sommo le frequenze
freq <- colSums(as.matrix(dtm))

## La lunghezza dovrebbe coincidere con il numero totale delle parole
  length(freq)

[1] 4191

## Ordino le parole in base alla frequenza (asc)
ord <- order(freq, decreasing=TRUE)

## Mostro le parole più frequenti
freq[head(ord)]

     neve terremoto rigopiano   valanga     hotel   slavina 
      684       236       200       139       103        97 

## Mostro le parole meno frequenti
freq[tail(ord)]

        wooooo          xxiii    youanimalit zaccheddufranc         zinnen          zitti 
             1              1              1              1              1              1 

## Mostro le parole che ricorrono almeno 30 volte
findFreqTerms(dtm,lowfreq=30)

 [1] "abruzzo"        "ancora"         "centro"         "dispersi"       "dopo"          
 [6] "emergenza"      "gelo"           "hotel"          "italia"         "maltempo"      
[11] "neve"           "persone"        "poliziadistato" "repubblicait"   "rigopiano"     
[16] "scosse"         "senza"          "slavina"        "soccorritori"   "soccorsi"      
[21] "sotto"          "terremoto"      "travolto"       "valanga"        "video"         

## Mostro le parole maggiormente correlate alla parola "neve"
findAssocs(dtm, "neve", 0.1)

$neve
      emergenza           farti httpstcoxlvruqd        iperbole      rendendosi         segui†
           0.12            0.12            0.12            0.12            0.12            0.12 
         selfie       spalavano           utili matteosalvinimi           molta       terremoto 
           0.12            0.12            0.12            0.11            0.11            0.11 
         disagi          strade 
           0.10            0.10 

## Mostro le parole maggiormente correlate alla parola "terremoto"
findAssocs(dtm, "terremoto", 0.1)

$terremoto
     tranquillitã         ginocchio            parole        campotosto             forti 
             0.22              0.18              0.18              0.17              0.17 
        alluvione            italia            scosse           abruzzo           laquila 
             0.15              0.15              0.15              0.14              0.14 
           centro             corpo           esperti             messa           passare 
             0.13              0.13              0.13              0.13              0.13 
            paura           assenza           bastava           causata          chiudere 
             0.13              0.12              0.12              0.12              0.12 
        dellaltra   dottorgiustizia httpstcoaurqickez   httpstcocbaezhd httpstcohxveyebwd 
             0.12              0.12              0.12              0.12              0.12 
          infatti           ipotesi           mancava           origine           salvano 
             0.12              0.12              0.12              0.12              0.12 
    saramenichini            sbando             aiuta           aiutano          cuccioli 
             0.12              0.12              0.11              0.11              0.11 
         disperso         enpaonlus         gentiloni              neve             aiuti 
             0.11              0.11              0.11              0.11              0.10 

## Mostro le parole maggiormente correlate alla parola "rigopiano"
findAssocs(dtm, "rigopiano", 0.2)

$rigopiano
       hotel      slavina      valanga       lhotel     travolto    dellhotel    farindola 
        0.41         0.31         0.30         0.27         0.25         0.22         0.22 
    immagini repubblicait     sommerso         vive 
        0.22         0.21         0.21         0.21 

N-Gram analysis and wordcloud

Uni-gram Frequenza

## creo la funzione di singola tokenizzazione
OnegramTokenizer <- function(x) NGramTokenizer(x,Weka_control(min = 1, max =1))

## genero la matrice con le frequenze
dtm <- DocumentTermMatrix(corpusnow, control = list(tokenize = OnegramTokenizer))

## Ordino le frequenze in maniera decrescente
freq <- sort(colSums(as.matrix(dtm)), decreasing=TRUE)

## le inserisco in un dataframe
wf <- data.frame(word=names(freq), freq=freq)

## visualizzo le parole che ricorrono almeno 60 volte
p <- ggplot(subset(wf, freq > 50), aes(word, freq))
p <- p + geom_bar(stat="identity", fill="darkred", colour="blue")
p + theme(axis.text.x=element_text(angle=45, hjust=1)) + ggtitle("Uni-Gram Frequenza") + xlab("Parole") + ylab("Frequenza") 

## Creo una tabella e la ordino in maniera decrescente
tm_unifreq <- sort(colSums(as.matrix(dtm)), decreasing=TRUE)

## trasformo la tabella in dataframe
tm_uniwordfreq <- data.frame(word=names(tm_unifreq), freq=tm_unifreq)

## mostro le 10 parole più ricorrenti
head(tm_uniwordfreq,10)

## visualizzo le parole che ricorrono almeno 14 volte
wordcloud(names(tm_unifreq), tm_unifreq, min.freq=14, max.words=50, scale=c(5, .8), colors=brewer.pal(6, "Dark2"))

Bi-Gram Frequenza

## Stessa procedura della uni-gram ma con la tokenizzazione su due parole
BigramTokenizer <- function(x) NGramTokenizer(x,Weka_control(min = 2, max = 2))
dtm2 <- DocumentTermMatrix(corpusnow, control = list(tokenize = BigramTokenizer))
freq2 <- sort(colSums(as.matrix(dtm2)), decreasing=TRUE)
wf2 <- data.frame(word=names(freq2), freq=freq2)

p2 <- ggplot(subset(wf2, freq > 14), aes(x = word, y = freq))
p2 <- p2 + geom_bar(stat="identity", fill="darkgreen", colour="blue")
p2 + theme(axis.text.x=element_text(angle=45, hjust=1)) + ggtitle("Bi-Gram Frequenza") + xlab("sentenze") + ylab("Frequenza") 

tm_bifreq <- sort(colSums(as.matrix(dtm2)), decreasing=TRUE)
tm_biwordfreq <- data.frame(word=names(tm_bifreq), freq=tm_bifreq)

head(tm_biwordfreq,10)

wordcloud(names(tm_bifreq), tm_bifreq, min.freq=14, max.words=100, scale=c(3, .1), colors=brewer.pal(6, "Dark2"))

Tri-Gram Frequenza

## Stessa procedura della uni-gram ma con la tokenizzazione su tre parole
TrigramTokenizer <- function(x) NGramTokenizer(x,Weka_control(min = 3, max = 3))
dtm3 <- DocumentTermMatrix(corpusnow, control = list(tokenize = TrigramTokenizer))
freq3 <- sort(colSums(as.matrix(dtm3)), decreasing=TRUE)
wf3 <- data.frame(word=names(freq3), freq=freq3)

p3 <- ggplot(subset(wf3, freq > 7), aes(x = word, y = freq))
p3 <- p3 + geom_bar(stat="identity", fill="darkred", colour="green")
p3 + theme(axis.text.x=element_text(angle=45, hjust=1)) + ggtitle("Tri-Gram Frequenza") + xlab("Sentenze") + ylab("Frequenza")

tm_trifreq <- sort(colSums(as.matrix(dtm3)), decreasing=TRUE)
tm_triwordfreq <- data.frame(word=names(tm_trifreq), freq=tm_trifreq)

head(tm_triwordfreq,10)

wordcloud(names(tm_trifreq), tm_trifreq, max.words=16, scale=c(1, 0.8), colors=brewer.pal(6, "Dark2"))

NA

Quadri-Gram Frequenza

## Stessa procedura della uni-gram ma con la tokenizzazione su quattro parole
QuadrigramTokenizer <- function(x) NGramTokenizer(x,Weka_control(min = 4, max = 4))
dtm4 <- DocumentTermMatrix(corpusnow, control = list(tokenize = QuadrigramTokenizer))
freq4 <- sort(colSums(as.matrix(dtm4)), decreasing=TRUE)
wf4 <- data.frame(word=names(freq4), freq=freq4)

p4 <- ggplot(subset(wf4, freq > 6), aes(x = word, y = freq))
p4 <- p4 + geom_bar(stat="identity", fill="darkred", colour="green")
p4 + theme(axis.text.x=element_text(angle=45, hjust=1)) + ggtitle("Quadri-Gram Frequenza") + xlab("sentenze") + ylab("Frequenza")

tm_quadrifreq <- sort(colSums(as.matrix(dtm4)), decreasing=TRUE)
tm_quadriwordfreq <- data.frame(word=names(tm_quadrifreq), freq=tm_quadrifreq)

head(tm_quadriwordfreq,5)

wordcloud(names(tm_quadrifreq), tm_quadrifreq, max.words=20, scale=c(1, 0.3), colors=brewer.pal(6, "Dark2"))

Five-Gram Frequenza

## Stessa procedura della uni-gram ma con la tokenizzazione su cinque parole
FivegramTokenizer <- function(x) NGramTokenizer(x,Weka_control(min = 5, max = 5))
dtm5 <- DocumentTermMatrix(corpusnow, control = list(tokenize = FivegramTokenizer))
freq5 <- sort(colSums(as.matrix(dtm5)), decreasing=TRUE)
wf5 <- data.frame(word=names(freq5), freq=freq5)

p5 <- ggplot(subset(wf5, freq > 6), aes(x = word, y = freq))
p5 <- p5 + geom_bar(stat="identity", fill="darkred", colour="green")
p5 + theme(axis.text.x=element_text(angle=45, hjust=1)) + ggtitle("Five-Gram Frequenza") + xlab("Sentenze") + ylab("Frequenza")

tm_fivefreq <- sort(colSums(as.matrix(dtm5)), decreasing=TRUE)
tm_fivewordfreq <- data.frame(word=names(tm_fivefreq), freq=tm_fivefreq)

head(tm_fivewordfreq,5)

wordcloud(names(tm_fivefreq), tm_fivefreq, max.words=20, scale=c(0.8, 0.9), colors=brewer.pal(6, "Dark2"))