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
- Visualiser la tendance de l’évolution dans le temps du prix et du pointage de classement des jeu vidéo.
- 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 :23838plt1 <-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
Pingback: ADV11 - Moyenne ou médiane? | Johanie Fournier, agr.