Tendance avec des points et des lignes

Le #Tidytuesday de cette semaine va faire plaisir aux amateurs de jeu vidéo! On visualise l’évolution de la tendance du pointage et du prix dans le temps à l’aide d’une viz pas beige du tout…

CONTEXTE

Les données de cette semaine proviennent de Steam Spy et sont inspirées de Liza Wood, qui a récemment utilisée ces données pour identifier les jeux vidéos qui ont passés l’épreuve du temps. Son article de blog présente un analyse détaillée.

Parmi les informations disponibles, on retouve le temps de jeu (des deux dernières semaines), la date de sortie du jeu, l’éditeur, le métascore et bien plus.



OBJECTIFS

  1. Visualiser la tendance de l’évolution dans le temps du prix et du pointage de classement des jeu vidéo.
  2. Utiliser geom_jitter pour montrer les tendances



IMPORTER

video_games <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-07-30/video_games.csv")
FALSE Parsed with column specification:  
FALSE cols(  
FALSE   number = col_double(),  
FALSE   game = col_character(),  
FALSE   release_date = col_character(),  
FALSE   price = col_double(),  
FALSE   owners = col_character(),  
FALSE   developer = col_character(),  
FALSE   publisher = col_character(),  
FALSE   average_playtime = col_double(),  
FALSE   median_playtime = col_double(),  
FALSE   metascore = col_double()  
FALSE )



EXPLORER

glimpse(video_games)
## Observations: 26,688  
## Variables: 10  
## $ number           <dbl> 1, 3, 21, 47, 36, 52, 2, 4, 14, 40, 9, 17, 43, …  
## $ game             <chr> "Half-Life 2", "Counter-Strike: Source", "Count…  
## $ release_date     <chr> "Nov 16, 2004", "Nov 1, 2004", "Mar 1, 2004", "…  
## $ price            <dbl> 9.99, 9.99, 9.99, 4.99, 9.99, NA, 14.99, 4.99, …  
## $ owners           <chr> "10,000,000 .. 20,000,000", "10,000,000 .. 20,0…  
## $ developer        <chr> "Valve", "Valve", "Valve", "Valve", "Valve", "U…  
## $ publisher        <chr> "Valve", "Valve", "Valve", "Valve", "Valve", "U…  
## $ average_playtime <dbl> 110, 236, 10, 0, 0, 16, 0, 0, 0, 0, 0, 0, 0, 37…  
## $ median_playtime  <dbl> 66, 128, 3, 0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 270,…  
## $ metascore        <dbl> 96, 88, 65, NA, NA, NA, 93, 87, 73, NA, 80, 69,…
summary(video_games)
##      number         game           release_date           price          
##  Min.   :   1   Length:26688       Length:26688       Min.   :  0.490    
##  1st Qu.: 821   Class :character   Class :character   1st Qu.:  2.990    
##  Median :2356   Mode  :character   Mode  :character   Median :  5.990    
##  Mean   :2904                                         Mean   :  8.947    
##  3rd Qu.:4523                                         3rd Qu.:  9.990    
##  Max.   :8846                                         Max.   :595.990    
##                                                       NA's   :3095       
##     owners           developer          publisher          
##  Length:26688       Length:26688       Length:26688        
##  Class :character   Class :character   Class :character    
##  Mode  :character   Mode  :character   Mode  :character   
##                                                            
##                                                            
##                                                            
##                                                            
##  average_playtime   median_playtime     metascore      
##  Min.   :   0.000   Min.   :   0.00   Min.   :20.00    
##  1st Qu.:   0.000   1st Qu.:   0.00   1st Qu.:66.00    
##  Median :   0.000   Median :   0.00   Median :73.00    
##  Mean   :   9.057   Mean   :   5.16   Mean   :71.89    
##  3rd Qu.:   0.000   3rd Qu.:   0.00   3rd Qu.:80.00    
##  Max.   :5670.000   Max.   :3293.00   Max.   :98.00   
##  NA's   :9          NA's   :12        NA's   :23838
plt1 <-video_games %>%
     filter(metascore>=45) %>%
     ggplot(aes(x=" ", y = metascore)) +
     geom_boxplot(fill = "#FFFFFF", color = "black") +
     coord_flip() +
     theme_classic() +
     xlab("") + 
     ylab("metascore")+
    theme(axis.text.y=element_blank(),
          axis.ticks.y=element_blank())

plt2 <-video_games %>%
    filter(metascore>=45) %>%
     ggplot() +
     geom_histogram(aes(x = metascore, y = (..count..)/sum(..count..)),
                            position = "identity", binwidth = 1,
                            fill = "#FFFFFF", color = "black") +
     ylab("Fréquence Relative")+
     xlab("")+    theme_classic()+
     theme(axis.text.x = element_blank())+
     theme(axis.ticks.x = element_blank())  

plt2 + plt1 + plot_layout(nrow = 2, heights = c(2, 1))



plt1 <-video_games %>%
     filter(price<=20) %>%
     ggplot(aes(x=" ", y = price)) +    geom_boxplot(fill = "#FFFFFF", color = "black") +
     coord_flip() + 
     theme_classic() +
     xlab("") +
     ylab("Prix")+
     theme(axis.text.y=element_blank(),
          axis.ticks.y=element_blank())

plt2 <-video_games %>%
    filter(price<=20) %>%
     ggplot() +
     geom_histogram(aes(x = price, y = (..count..)/sum(..count..)),
                            position = "identity", binwidth = 1,
                            fill = "#FFFFFF", color = "black") +
     ylab("Fréquence Relative")+
     xlab("")+    theme_classic()+
    theme(axis.text.x = element_blank())+
    theme(axis.ticks.x = element_blank())  

plt2 + plt1 + plot_layout(nrow = 2, heights = c(2, 1))





Donc, le format de la date est à modifier pour qu’on puisse lire et travailler le format. On doit aussi faire un peu de ménage dans les valeurs extrêmes pour les metascores et le pointage. Le choix des valeurs qu’on peut considérer aberhante est très discutable. Dans mon cas, je cherche à retirer le moins de données possible tout en m’assurant que les moyennes que je vais calculer vont être représentatives pour chacune des variables.



Partie 1: Metascore



PRÉPARER:

#moyenne globale  
moyenne_globale_score <- video_games %>%
     filter(metascore>=45) %>%
     summarise(score_moy_globale=mean(metascore, na.rm=TRUE))    

#moyenne annuelle  
moyenne_annee_score <- video_games %>%
     mutate(release_date = ifelse(release_date == "8 Oct, 2014", "Oct 8, 2014", release_date),
           date = mdy(release_date),
           annee = year(date))  %>%
     filter(metascore>=45) %>%
     group_by(annee)%>%
     summarise(score_moy_annee=mean(metascore, na.rm=TRUE))    

#fichier de travail  
games_score <- video_games %>%
     mutate(release_date = ifelse(release_date == "8 Oct, 2014", "Oct 8, 2014", release_date),
           date = mdy(release_date),
           annee = year(date))%>%
    filter(metascore>=45) %>%
    group_by(annee, metascore) %>%
    summarise(moy_annee=mean(metascore)) %>%
    right_join(moyenne_annee_score, by="annee") %>%
    mutate(score_moy_global=moyenne_globale_score$score_moy_globale)



VISUALISER

#Graphique score  
gg1<-ggplot(games_score, aes(x=annee, y=metascore, fill=annee))  
gg1 <- gg1 + geom_jitter(color="#8597A0", size=5, alpha = 0.25, width = 0.20)  
gg1 <- gg1 + geom_hline(aes(yintercept = score_moy_global), color = "#6D7C83", size = 0.5)   
gg1 <- gg1 + geom_segment(aes(x = annee, xend = annee,y = score_moy_global, yend = score_moy_annee), size = 0.5, color='#6D7C83')  
gg1 <- gg1 + geom_point(mapping=aes(x=annee, y=score_moy_annee, fill=annee), fill="#386FA4",color="#6D7C83", shape=21, size=7, stroke=1)  
#retirer la légende  
gg1 <- gg1 + theme(legend.position = "none")  
#ajuster les axes   
gg1 <- gg1 + scale_y_continuous(breaks=seq(40,100,20), limits = c(40, 100))  
gg1 <- gg1 + scale_x_continuous(breaks=seq(2004,2018,1), limits = c(2003, 2018))  
#modifier le thème  
gg1 <- gg1 +  theme(panel.border = element_blank(),                      panel.background = element_blank(),
                      plot.background = element_blank(),
                      panel.grid.major.y= element_line(size=0.1,linetype="dotted", color="#6D7C83"),
                      panel.grid.major.x= element_blank(),
                      panel.grid.minor = element_blank(),
                      axis.line.x = element_blank(),
                      axis.line.y = element_blank(),                      
                      axis.ticks.y = element_blank(),
                      axis.ticks.x = element_blank())
#ajouter les étiquettes  
gg1<-gg1 + annotate(geom="text", x=2003,y=74, label="Moy=72", color="#6D7C83", size=4, hjust=0.5,vjust=0, fontface="bold") 
#ajouter les titres  
gg1<-gg1 + labs(title="L'évolution des jeux vidéo",
                subtitle="\nLe pointage n'a pas beaucoup varié au cours des dernières années. Pour ce qui est du  prix par contre, on voit\nclairement qu'il y a de plus en plus de jeux vidéo qui sont disponible à petit prix.\n",
                y="Metascore",
                 x=" ")  
gg1<-gg1 + theme(plot.title    = element_text(hjust=0,size=36, color="#6D7C83", face="bold", family="Arial Rounded MT Bold"),
                   plot.subtitle = element_text(hjust=0,size=12, color="#6D7C83", family="Arial Rounded MT Bold"),
                   axis.title.y  = element_text(hjust=1, vjust=0, size=12, color="#6D7C83", face="bold"),
                   axis.title.x  = element_blank(),
                   axis.text.y   = element_text(hjust=0.5, vjust=0, size=12, color="#6D7C83", face="bold"),
                    axis.text.x   = element_blank())

Partie 2: Prix



PRÉPARER:

#PRIX  #moyenne prix  
med_globale_prix <- video_games %>%
     summarise(prix_med_globale=mean(price, na.rm=TRUE))    

#median annuel  
med_annee_prix <- video_games %>%
     mutate(release_date = ifelse(release_date == "8 Oct, 2014", "Oct 8, 2014", release_date),
           date = mdy(release_date),
           annee = year(date))  %>%
     group_by(annee)%>%
     summarise(prix_med_annee=mean(price, na.rm=TRUE))    

#fichier de travail  
games_prix <- video_games %>%
    filter(price<=20) %>%
    mutate(release_date = ifelse(release_date == "8 Oct, 2014", "Oct 8, 2014", release_date),
           date = mdy(release_date),
           annee = year(date))  %>%
     group_by(annee, price) %>%
     summarise(moy_annee=mean(price)) %>%
     right_join(med_annee_prix, by="annee") %>%
     mutate(prix_med_globale=med_globale_prix$prix_med_globale)



VISUALISER

#Graphique Prix 
gg2<-ggplot(games_prix, aes(x=annee, y=price, fill=annee))  
gg2 <- gg2 + geom_jitter(color="#8597A0", size=6, alpha = 0.25, width = 0.20)  
gg2 <- gg2 + geom_hline(aes(yintercept = prix_med_globale), color = "#6D7C83", size = 0.5)   
gg2 <- gg2 + geom_segment(aes(x = annee, xend = annee,y = prix_med_globale, yend = prix_med_annee), size = 0.5, color='#6D7C83')  
gg2 <- gg2 + geom_point(mapping=aes(x=annee, y=prix_med_annee, fill=annee), fill="#386FA4",color="#6D7C83", shape=21, size=8.5, stroke=1)  
#retirer la légende  
gg2 <- gg2 + theme(legend.position = "none")  
#ajuster les axes   
gg2 <- gg2 + scale_y_continuous(breaks=seq(0,20,5), limits = c(0, 20))  
gg2 <- gg2 + scale_x_continuous(breaks=seq(2004,2018,1), limits = c(2003, 2018))  
#modifier le thème  
gg2 <- gg2 +  theme(panel.border = element_blank(),
                      panel.background = element_blank(),
                      plot.background = element_blank(),
                      panel.grid.major.y= element_line(size=0.1,linetype="dotted", color="#6D7C83"),
                      panel.grid.major.x= element_blank(),
                      panel.grid.minor = element_blank(),
                      axis.line.x = element_blank(),
                      axis.line.y = element_blank(),
                      axis.ticks.y = element_blank(),
                      axis.ticks.x = element_blank())  
#ajouter les étiquettes  
gg2<-gg2 + annotate(geom="text", x=2003,y=9.5, label="Moy=9", color="#6D7C83", size=5, hjust=0.5,vjust=0, fontface="bold")  
#ajouter les titres  
gg2<-gg2 + labs(title=" ",
                subtitle=" ",
                y="Prix ($US)",
                x=" ")  
gg2<-gg2 + theme(plot.title    = element_blank(),
                   plot.subtitle = element_blank(),
                   axis.title.y  = element_text(hjust=1, vjust=0, size=14, color="#6D7C83", face="bold"),
                   axis.title.x  = element_blank(),
                   axis.text.y   = element_text(hjust=0.5, vjust=0, size=14, color="#6D7C83", face="bold"),
                    axis.text.x   = element_text(hjust=0.5, vjust=0, size=14, color="#6D7C83", face="bold"))



Voici ce que ça donne:



CONCLUSION: on voit bien les tendances!

Finalement, on peut constater que la tendance du métascore est de rester relativement stable dans le temps. Pour le prix, après la hausse du prix moyen qui a eu lieu vers les années 2012, la tendance est à la baisse. Le nuage de point nous indique aussi qu’il y a une augmentation du nombre de jeux qui sont crées et vendu à moins de 5$ depuis 2015.

Alors, tu veux en savoir plus sur ma démarche? Un épisode de podcast est maintenant disponible dans lequel je t’explique toute la réflexion qui à mené à la création de cette viz.

Publicités

Une réflexion sur “Tendance avec des points et des lignes

  1. Pingback: ADV11 - Moyenne ou médiane? | Johanie Fournier, agr.

Laisser un commentaire

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.