Text Mining on British Airlines Reviews

In questo progetto abbiamo voluto analizzare le recensioni degli ultimi 4 anni scritte dai clienti della British Airlines. Il nostro obiettivo è quello di applicare delle tecniche di Text Mining per poter confrontare , raggrupare e individuare il significato che si cela dietro ogni recensione.

library(tm)
## Warning: il pacchetto 'tm' è stato creato con R versione 4.3.3
## Caricamento del pacchetto richiesto: NLP
library(tidyr)
library(tidyselect)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ purrr     1.0.2
## ✔ forcats   1.0.0     ✔ readr     2.1.4
## ✔ ggplot2   3.4.4     ✔ stringr   1.5.1
## ✔ lubridate 1.9.3     ✔ tibble    3.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ ggplot2::annotate() masks NLP::annotate()
## ✖ dplyr::filter()     masks stats::filter()
## ✖ dplyr::lag()        masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(gridExtra)
## 
## Caricamento pacchetto: 'gridExtra'
## 
## Il seguente oggetto è mascherato da 'package:dplyr':
## 
##     combine
library(lubridate)
library(ggplot2)
library(SnowballC)
library(wordcloud)
## Warning: il pacchetto 'wordcloud' è stato creato con R versione 4.3.3
## Caricamento del pacchetto richiesto: RColorBrewer
library(tidytext)
## Warning: il pacchetto 'tidytext' è stato creato con R versione 4.3.3
library(knitr)

Abbiamo lavorato utilizzando il dataset BA_AirlineReviews.csv ottenuto dalla piattaforma Kaggle (https://www.kaggle.com/code/tanshihjen/textanalysis-airlinereviews?rvi=1)

aerei <- read.csv("C:/Users/Utente/Desktop/LUCA/università/TERZO_ANNO/DATA MINING/text_mining/BA_AirlineReviews.csv",header=TRUE, sep=",")
aerei<- aerei[,-1] #rimuovo variabile X
summary(aerei)
##  OverallRating    ReviewHeader           Name             Datetime        
##  Min.   : 1.000   Length:3701        Length:3701        Length:3701       
##  1st Qu.: 2.000   Class :character   Class :character   Class :character  
##  Median : 4.000   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 4.734                                                           
##  3rd Qu.: 8.000                                                           
##  Max.   :10.000                                                           
##  NA's   :5                                                                
##  VerifiedReview      ReviewBody        TypeOfTraveller      SeatType        
##  Length:3701        Length:3701        Length:3701        Length:3701       
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##                                                                             
##     Route            DateFlown          SeatComfort    CabinStaffService
##  Length:3701        Length:3701        Min.   :1.000   Min.   :1.000    
##  Class :character   Class :character   1st Qu.:2.000   1st Qu.:2.000    
##  Mode  :character   Mode  :character   Median :3.000   Median :3.000    
##                                        Mean   :2.875   Mean   :3.254    
##                                        3rd Qu.:4.000   3rd Qu.:5.000    
##                                        Max.   :5.000   Max.   :5.000    
##                                        NA's   :116     NA's   :127      
##  GroundService   ValueForMoney      Recommended          Aircraft        
##  Min.   :1.000   Length:3701        Length:3701        Length:3701       
##  1st Qu.:1.000   Class :character   Class :character   Class :character  
##  Median :3.000   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :2.784                                                           
##  3rd Qu.:4.000                                                           
##  Max.   :5.000                                                           
##  NA's   :846                                                             
##  Food.Beverages     InflightEntertainment Wifi.Connectivity
##  Length:3701        Length:3701           Min.   :1.000    
##  Class :character   Class :character      1st Qu.:1.000    
##  Mode  :character   Mode  :character      Median :1.000    
##                                           Mean   :1.925    
##                                           3rd Qu.:3.000    
##                                           Max.   :5.000    
##                                           NA's   :3092

Sono presenti 19 variabili totali, nelle ultime 9 sono compresi i voti che il cliente ha espresso riguardo i diversi confort del volo. Per l’analisi teniamo in considerazione le seguenti variabili: OverallRating, ReviewHeader, ReviewBody, Datetime, TypeOfTraveller.

  1. OverallRating = il voto complessivo dato dal cliente al volo
  2. ReviewHeader = l’oggetto della recensione
  3. ReviewBody = la recensione
  4. Datetime = la data in cui è stata pubblicata la recensione
  5. TypeOfTraveller = il tipo di volo su cui ha viaggiato il cliente

Consideriamo solamente gli utlimi 4 anni, per farlo bisogna cambiare il formato della data

aerei= as_tibble(aerei) #lo converto in tibble
aerei= aerei %>%
  select( OverallRating, ReviewHeader, ReviewBody, Datetime, TypeOfTraveller)

# Rimuove le parti "th", "st", "rd", e "nd" dalle stringhe delle date
aerei$Datetime <- gsub("(\\d+)(th|st|rd|nd) ", "\\1 ", aerei$Datetime)

# Converte le date in formato data utilizzando lubridate
aerei$Datetime <- dmy(aerei$Datetime)

#consideriamo solo gli anni dal 2020 in poi:
aerei= aerei[year(aerei$Datetime) >= 2020, ]
aerei #658 recensioni
## # A tibble: 658 × 5
##    OverallRating ReviewHeader              ReviewBody Datetime   TypeOfTraveller
##            <int> <chr>                     <chr>      <date>     <chr>          
##  1             1 "\"Service level far wor… 4 Hours b… 2023-11-19 Couple Leisure 
##  2             3 "\"do not upgrade member… I recentl… 2023-11-19 Business       
##  3             8 "\"Flight was smooth and… Boarded o… 2023-11-16 Couple Leisure 
##  4             1 "\"Absolutely hopeless a… 5 days be… 2023-11-16 Couple Leisure 
##  5             1 "\"Customer Service is n… We travel… 2023-11-14 Couple Leisure 
##  6             1 "\"I can’t imagine a wor… Booked a … 2023-11-12 Solo Leisure   
##  7             8 "\"sufficient leg and ar… Booked on… 2023-11-08 Couple Leisure 
##  8             7 "“crew were polite”"      The fligh… 2023-11-07 Solo Leisure   
##  9             2 "\"Angry, disappointed, … Angry, di… 2023-11-05 Family Leisure 
## 10             3 "\"BA now stands for Bas… As an inf… 2023-11-05 Couple Leisure 
## # ℹ 648 more rows

Creazione del corpus

Si crea un Virtual Corpus (VCorpus) al fine di applicare le funzioni disponibili per il Text Cleaning contenute nella library(tm) senza però caricare i documenti completamente in memoria ma caricarli solo quando sono necessari per l’analisi. Per la creazione del VCorpus bisogna creare una variabile chiave denominato doc_id e il testo deve essere contenuto in una variabile di nome (‘text’)

aerei$doc_id= sample(10000:99999, nrow(aerei), replace = F) 
#per creare un id di 5 cifre in modo semplice si estrae casualmente senza reinserimento #da 10000 a 99999 
aerei= aerei %>% rename (text = ReviewBody) #modifico il nome della variabile #ReviewBody in text
corpus_aerei= DataframeSource(aerei)
corpus_aerei= VCorpus(corpus_aerei) #creazione del corpus virtuale

Di seguito viene stampata la prima recensione

content(corpus_aerei[[1]])
## [1] "4 Hours before takeoff we received a Mail stating a cryptic message that there are disruptions to be expected as there is a limit on how many planes can leave at the same time. So did the capacity of the Heathrow Airport really hit British Airways by surprise, 4h before departure? Anyhow - we took the one hour delay so what - but then we have been forced to check in our Hand luggage. I travel only with hand luggage to avoid waiting for the ultra slow processing of the checked in luggage. Overall 2h later at home than planed, with really no reason, just due to incompetent people. Service level far worse then Ryanair and triple the price. Really never again. Thanks for nothing."

Pulizia del testo

Prima dell’analisi è opportuno eseguire un’adeguata pulizia del testo rimuovendo.

  1. StopWords
  2. Punteggiatura
  3. Simboli particolari
  4. Numeri
  5. Spazi aggiuntivi
  6. Rendere tutto in minuscolo
toSpace = content_transformer(function(x, pattern) { return(gsub(pattern, ' ', x))})
# Funzione 'tm_map' ricerca i simboli speciali all'interno del corpus e applica la #funzione 'toSpace'.
corpus_aerei <- tm_map(corpus_aerei, toSpace, "-")
corpus_aerei <- tm_map(corpus_aerei, toSpace, ":")
corpus_aerei <- tm_map(corpus_aerei, toSpace, "'")
corpus_aerei <- tm_map(corpus_aerei, toSpace, "'")
corpus_aerei <- tm_map(corpus_aerei, toSpace, " -")

# Rimozione della punteggiatura.
corpus_aerei <- tm_map(corpus_aerei, removePunctuation)

#Trasform tutte le lettere in minuscol 
corpus_aerei= tm_map(corpus_aerei, content_transformer(tolower))

#rimozione stopwords 
mystopwords <- c("airways", "british")  #stopWords scelte da noi 
corpus_aerei <- tm_map(corpus_aerei, removeWords, c(stopwords("english"), mystopwords))

#rimozione dei numeri
corpus_aerei= tm_map(corpus_aerei, removeNumbers)

#funzione per rendere gli spazi solo 1 
corpus_aerei <- tm_map(corpus_aerei, stripWhitespace)

Stemming

Il processo di stemming è fondamentale per ridurre le parole alle loro forme base o radici. Bisogna però tener conto che si tratta di una tecnica invasiva che potrebbe falsare l’analisi.

corpus_aerei<- tm_map(corpus_aerei,stemDocument)

Creazione della matrice Document Term

La matrice Document Term ha per righe i documenti e per colonne le parole trasformando il VCorpus in una matrice di conteggio.

dtm_air= DocumentTermMatrix(corpus_aerei)

#in freq sono riportati i conteggi di apparizione per ogni parola 
freq = colSums(as.matrix(dtm_air)) 
length(freq) #rilevate 4249 parole 
## [1] 4174

Quali sono le parole più frequenti?

# Ordiniamo in maniera decrescente i termini in base alla loro frequenza di apparizione.
ordr <- order(freq,decreasing=TRUE)
# Verifichiamo ora le paroli più frequenti.
findFreqTerms(dtm_air,lowfreq=80)
##   [1] "aircraft" "airlin"   "airport"  "also"     "anoth"    "arriv"   
##   [7] "ask"      "back"     "bag"      "baggag"   "board"    "book"    
##  [13] "busi"     "cabin"    "call"     "can"      "cancel"   "chang"   
##  [19] "check"    "class"    "club"     "comfort"  "connect"  "covid"   
##  [25] "crew"     "custom"   "day"      "delay"    "differ"   "drink"   
##  [31] "due"      "economi"  "email"    "even"     "experi"   "find"    
##  [37] "first"    "fli"      "flight"   "food"     "friend"   "full"    
##  [43] "gate"     "get"      "given"    "good"     "got"      "great"   
##  [49] "heathrow" "help"     "hour"     "howev"    "inform"   "just"    
##  [55] "last"     "late"     "later"    "left"     "lhr"      "like"    
##  [61] "london"   "long"     "loung"    "luggag"   "made"     "make"    
##  [67] "meal"     "minut"    "miss"     "money"    "much"     "need"    
##  [73] "never"    "new"      "next"     "now"      "number"   "offer"   
##  [79] "one"      "onlin"    "option"   "paid"     "passeng"  "pay"     
##  [85] "peopl"    "phone"    "plane"    "poor"     "premium"  "provid"  
##  [91] "realli"   "rebook"   "receiv"   "refund"   "return"   "said"    
##  [97] "say"      "seat"     "seem"     "servic"   "staff"    "still"   
## [103] "take"     "ticket"   "time"     "told"     "took"     "travel"  
## [109] "tri"      "trip"     "two"      "use"      "voucher"  "wait"    
## [115] "way"      "week"     "well"     "will"     "work"     "year"

SENTIMENT ANALYSIS

Quali sono le parole più usate per sentimento?

Si è interessati a comprendere il contenuto delle recensioni per poter distinguere le recensioni positive da quelle negative. Nella library ‘tidytext’ è presente un tibble (‘get_sentiments(“bing”)’)che contiene migliaia di termini a cui sono associati un sentimento (positivo o negativo). L’idea è quella di confrontare le parole presenti nelle nostre recensioni sulla base di questo tibble e contare le parole che hanno un significato positivo e quelle con un significato negativo.

Per farlo è però opportuno ritornare al formato tibble dal formato Corpus, per poter applicare le funzioni del tidyr

tibble_aerei= corpus_aerei$dmeta #tibble su cui sono salvate le variabili OverallRating-ReviewHeader-Datetime-TypeOfTraveller       
tibble_aerei$text=NA
for (j in 1:nrow(tibble_aerei))
{
  tibble_aerei$text[j]= content(corpus_aerei[[j]])
}
#un ciclo che scorre tutti i testi e li salva nella variabile text che implementiamo manulamente

Dal tibble ottenuto si è intenzionati a scomporlo ottenendo ‘words_aerei’ (un tibble che per ogni riga riporta una parola) Si procede poi tramite inner_join a ottenere un ulteriore tibble ‘sentiment’ che presenta tutte le parole contenute nelle recensioni che sono presenti anche in ‘get_sentiments(“bing”)’ alle quali corrispondono un ‘sentiment’ negativo o positivo

get_sentiments("bing") #tibble contenente la seria di parole con significato positivo o negativo 
## # A tibble: 6,786 × 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 
## # ℹ 6,776 more rows
words_aerei= tibble_aerei %>% unnest_tokens(word, text) 
sentiment= words_aerei %>% inner_join(get_sentiments("bing"), by="word")
sentiment
## # A tibble: 4,345 × 6
##    OverallRating ReviewHeader         Datetime   TypeOfTraveller word  sentiment
##            <int> <chr>                <date>     <chr>           <chr> <chr>    
##  1             1 "\"Service level fa… 2023-11-19 Couple Leisure  disr… negative 
##  2             1 "\"Service level fa… 2023-11-19 Couple Leisure  limit negative 
##  3             1 "\"Service level fa… 2023-11-19 Couple Leisure  delay negative 
##  4             1 "\"Service level fa… 2023-11-19 Couple Leisure  slow  negative 
##  5             1 "\"Service level fa… 2023-11-19 Couple Leisure  thank positive 
##  6             3 "\"do not upgrade m… 2023-11-19 Business        delay negative 
##  7             3 "\"do not upgrade m… 2023-11-19 Business        delay negative 
##  8             3 "\"do not upgrade m… 2023-11-19 Business        clear positive 
##  9             3 "\"do not upgrade m… 2023-11-19 Business        delay negative 
## 10             3 "\"do not upgrade m… 2023-11-19 Business        ente… positive 
## # ℹ 4,335 more rows

In s sono salvate le 80 parole più utilizzate (40 per sentimento) ordinate in ordine decrescente

s = sentiment %>% count(word, sentiment, sort=TRUE) %>%
  group_by(sentiment) %>% arrange(desc(n)) %>% slice(1:40)

Rappresentzione grafica

s %>% ggplot(aes(x=reorder(word,n), y=n))+  #sull'asse delle X inseriamo le parole ordinate sulla base delle ripetizioni, sull'asse delle y il conteggio 
  geom_col(aes(fill=sentiment), show.legend=F) +
  coord_flip()+ #giriamo il grafico per ragioni estetiche 
  facet_wrap(~sentiment, scales="free_y") +#si divide sulla base del sentimento 
  labs(x="parole", y="numero di ripetzioni", title="Parole più usate per sentimento") #titoli

Sentiment Analysis corelata alla valutazione data dal cliente?

Nella variabile OverallRating è assegnato un punteggio in decimi con cui il cliente ha valutato la sua esperienza di volo, ci chiediamo se la votazione sia corelata al conteggio di parole positive e negative presenti nel testo. Per ogni recensione selezioniamo le parole che sono presenti anche nel tibble (‘get_sentiments(“bing”)’), selezioniamo però solo le recensioni con più contenuto che quindi presentano almeno 10 parole con significato positivo o negativo. Si salva un punteggio salvato nella variabile ‘rating’ (rating = numero di parole positive - numero di parole negative), e infine si calcola la corelazione tra la variabile rating e la variabile OverallRating.

valutazioni= c() #vettore in cui ci salveremo i valori rating
index= c() #vettore un cui salveremo gli indici (importante per poi far la corelazione solo con le recensioni selezionate)
for(j in 1:nrow(tibble_aerei))
{
  recensione=tibble_aerei[j,] %>% unnest_tokens(word, text)
  sent= recensione %>% inner_join(get_sentiments("bing"), by="word")
  rating=0
  if(nrow(sent)>10)
  {
    index=cbind(index, j)
    for(k in 1:nrow(sent))
    {
      
      if(sent$sentiment[k]== 'negative')
      {
        rating= rating -1
      }
      else
      {
        rating= rating +1
      }
    }
    valutazioni= cbind(valutazioni, rating)
  }

}
valutazioni= as.numeric(valutazioni)
index= as.numeric(index)

cor(tibble_aerei$OverallRating[index], valutazioni)
## [1] 0.6603381

La corelazione di 0.66 non è un pessimo risultato ma neanche ottimale. La corelazione però è condizioata dall’utilizzo delle parole del cliente, non è detto che un cliente che ha avuto una pessima esperienza con la compagnia e che quindi la valuti estremamente male, si spenda troppo a scrivere una recensione completa e arricchita di termini in questo caso negativi.

Serie Storica

Avendo a disposizione le date in cui sono state scritte le recensioni è interessante visualizzare una serie storica dell’andamento della variabile rating (rating = numero di parole positive - numero di parole negative).

parole_per_data = sentiment %>% group_by(Datetime) %>% count(sentiment) %>%
  spread(sentiment, n)
#in parole_per_data sono contate il numero totale di parole negative e parole positive scritte raggruppate per ogni data 
#ovviamente se non sono sate scritte parole di significato positivo o negativo sono preseti degli NA, li sostituiamo semplicemente con degli zero
parole_per_data  <- parole_per_data  %>% 
  mutate_all(~replace_na(., 0))
## `mutate_all()` ignored the following grouping variables:
## • Column `Datetime`
## ℹ Use `mutate_at(df, vars(-group_cols()), myoperation)` to silence the message.

Rappresentazione grafica della serie storica

parole_per_data %>% mutate(rating=positive-negative)%>% #si crea la variabile rating 
  ggplot(aes(x=Datetime, y=rating)) +
  scale_x_date(limits=c(as.Date("2020-01-01"), as.Date("2023-11-19")), date_breaks = "6 month", date_labels = "%b") +
  geom_line(stat="identity", col="darkblue") + geom_smooth(col="yellow") + labs(title="Serie Storica di Rating")+
  theme_gray()
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'

descrizione serie…

Di seguito vengono considerate solo le recensioni dei primi 3 mesi per visualizzare almeglio il picco iniziale

parole_per_data %>% mutate(rating=positive-negative)%>%
  ggplot(aes(x=Datetime, y=rating)) +
  scale_x_date(limits=c(as.Date("2020-01-01"), as.Date("2020-04-01")), date_breaks = "1 week", date_labels = "%b") +
  geom_line(stat="identity", col="darkblue") + geom_smooth(col="yellow") + labs(title="Serie Storica di Rating") +
  theme_gray()
## `geom_smooth()` using method = 'loess' and formula = 'y ~ x'
## Warning: Removed 426 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 426 rows containing missing values (`geom_line()`).

parole_per_data$Datetime[which.max(parole_per_data$positive)]
## [1] "2020-01-11"

Il giorno in cui sono state scritte le recensioni più positive è stato l’11 gennaio 2020

kable(tibble_aerei[tibble_aerei$Datetime == parole_per_data$Datetime[which.max(parole_per_data$positive)],])
OverallRating ReviewHeader Datetime TypeOfTraveller text
9 “could not fault one aspect of the service” 2020-01-11 Solo Leisure fantast flight travel solo london gatwick glasgow airway’ club europ cabin fault one aspect servic arriv gatwick around hour prior departur ba club world passeng entitl fast track secur gatwick quick staff pleasant enough loung gatwick clean modern made nice relax start journey board quick flight depart time land minut earli crew attent friend flight meal delici smoke salmon serv curri rice overal realli love fli experi ever slight leg room flight entertain ’d given flight fantast crew credit airlin
10 “All in all great service” 2020-01-11 Solo Leisure rio de janeiro london heathrow love aircraft class busi world travel plus economi class cabin busi class front row rear row seat a opinion seat window seat bit space usual seat littl extra help privat tuck behind second galley area toilet side jk settl sleep even meal crew accommod offer water bottl immedi good hour sleep normal woke minut breakfast realli enjoy fruit yoghurt muesli full english breakfast great servic good flight felt fulli relax
3 “disappointed by the service” 2020-01-11 Business gatwick tirana incred disappoint servic provid flight virtual imposs differenti made flight differ economi busi class passeng board time economi class passeng curtain divid economi class busi class peopl economi class taken liberti remov cabin bag space seat three seat behind seat seat economi differ middl seat empti thus creat divid window aisl seat encount odd problem meal well love cabin crew member notifi choic eat pasta dinner choic finish better economi pay less get servic flight left time land earli opinion best inflight w fi servic pound get unlimit high speed wi fi can stream youtub video offer cheaper packag well can get unlimit text
10 “Crew very friendly” 2020-01-11 Couple Leisure keflavik london heathrow cabin crew amaz weather terrifi drove airport knew thing go tough expect delay see european flight cancel expect surpris see flight board snow blizzard condit surpris got settl seat crew friend long stori short hour ground wait di ice machin final made way take staff relax calm passeng includ connect flight sat one person look option ba onlin app help non alcohol drink snack provid time first offic kept us inform time ba fault de ice machin delay much eventu procedur done readi take pilot team manag condit will never now smooth take cloud smooth journey way back heathrow cabin crew provid excel servic busi lucki champagn meal excel veg shepherd pie chicken curri love just want thank ba know get lot negat review say can t fault particular crew made real effort talk us well done

Sono infatti state scritte 4 recensioni, 3 hanno una valutazione molto buona (OverallRating >= 9) e una recensione valuta il servizio 3/10