19 octobre 2018

Introduction à ggplot

Le jeu de donnée

load("/Users/raphaellemomal/Desktop/SOTR/Graphe in R/Hp.RData")
Harry <- Livres %>%  filter(Personnage == "Harry")
head(Harry)
## # A tibble: 6 x 5
##   Num_chap Livre               Chap Personnage Nb_rep
##      <int> <fct>              <int> <chr>       <int>
## 1        1 philosophers_stone     1 Harry          20
## 2        2 philosophers_stone     2 Harry          79
## 3        3 philosophers_stone     3 Harry          68
## 4        4 philosophers_stone     4 Harry          48
## 5        5 philosophers_stone     5 Harry         147
## 6        6 philosophers_stone     6 Harry         117

La syntaxe : Initialisation du graphe

Dans les aes on met les variables !

p <- ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep )) 
p

Les geom_

On peut ajouter sur notre graphe vide des "geom" qui sont des surcouches :

p +  geom_point()

Les geom_

On peut ajouter sur notre graphe vide des "geom" qui sont des surcouches :

p +  geom_point() + geom_line()

Les geom_

On peut ajouter sur notre graphe vide des "geom" qui sont des surcouches :

p +  geom_point() + geom_line() + geom_smooth(method ="lm") + geom_bar(stat = "identity")

Changer les couleurs ou les formes :

p <- ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep )) +
  geom_point(color = "orange", shape = 2) +
  geom_line(color = "firebrick")
p

Changer les couleurs et les formes

Si on veut mettre une couleur en fonction d'une variable pour toutes les couches

p <- ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep,color = Livre )) +
  geom_point( shape = 2) +
  geom_line()
p

Changer les couleurs et les formes

Si on veut mettre une couleur en fonction d'une variable juste pour un type de graphe (une couche)

p <- ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep )) +
  geom_point(aes(color = Livre), shape = 2) +
  geom_line()
p

Zoom sur le aes :

Toutes les variables doivent être dans un aes(), sinon il ne sait pas où la trouver et ne la considère pas comme une variable.

p <- ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep )) +
  geom_point(color = Livre, shape = 2) +
  geom_line(color = "firebrick")
p

Error in layer(data = data, mapping = mapping, stat = stat, geom = GeomPoint, : objet 'Livre' introuvable

Zoom sur le aes :

Toutes les variables doivent être dans un aes(), sinon il ne sait pas où la trouver et ne la considère pas comme une variable.

p <- ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep )) +
  geom_point(color = Harry$Livre, shape = 2) +
  geom_line(color = "firebrick")
p

Error in grDevices::col2rgb(colour, TRUE) : nom de couleur 'philosophers_stone' incorrecte

Zoom sur le aes :

Tous les arguments qui sont dans le aes sont considérés commes des variables. Voyez plutot :

p1 <- ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep )) + 
  geom_point(color = "blue")
p2 <- ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep, color = "blue")) + 
  geom_point()
grid.arrange(p1, p2, ncol =2)

Choisir ses couleurs (formes ect..)

ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep,color = Livre )) +
  geom_point( shape = 2) +
  geom_line() + 
  scale_color_manual(values  = c("darkblue","darkorange","black",
                                 "darkgreen","purple","darkred",
                                 "salmon"))

Choisir ses couleurs (formes ect..)

ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep,color = Livre )) +
  geom_point( shape = 2) +
  geom_line() + scale_color_brewer(palette = "Dark2")

Choisir ses couleurs (formes ect..)

ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep,color = Livre )) +
  geom_point( shape = 2) +
  geom_line() + scale_color_viridis(discrete=TRUE)

Changer le nom des axis

p <- ggplot(data = Harry, aes(x = Num_chap, y = Nb_rep,color = Livre )) +
  geom_point( shape = 2) +
  geom_line() + scale_color_viridis(discrete=TRUE) + 
  xlab ("Numero de chapitre") +
  ylab("Nombre de 'Harry'")
p

Exercice:

Representer la répartition du nombre de répétions de Harry au sein des différents chapitres pour chaque livre.

Proposition de représentation

p2 <- ggplot(data = Harry, aes(x = Livre, y = Nb_rep))
p2 + geom_boxplot()

Proposition de représentation

p2 <- ggplot(data = Harry, aes(x = Livre, y = Nb_rep))
p2 + geom_boxplot() + coord_flip()

Proposition de représentation

p2 <- ggplot(data = Harry, aes(x = Livre, y = Nb_rep))
p2 + geom_violin() + coord_flip()

Proposition de représentation

p2 <- ggplot(data = Harry, aes(x = Livre, y = Nb_rep))
p2 + geom_violin() + geom_point() + coord_flip()

Proposition de représentation

Les points sont un peu les un sur les autres. Mais répartis un peu au hasard!

p2 <- ggplot(data = Harry, aes(x = Livre, y = Nb_rep))
p2 + geom_violin() + geom_jitter() + coord_flip()

Proposition de représentation :

Les points sont un peu les uns sur les autres, et répartis selon leur distribution (mieux !).

p2 <- ggplot(data = Harry, aes(x = Livre, y = Nb_rep))
p2 + geom_violin() + geom_beeswarm() + coord_flip()

p2 <- p2 + geom_violin() + geom_beeswarm() + coord_flip()

Exercice 2

On veut comparer visuellement l'évolution du nombre de réplicats de Harry (par chapitre) dans chacun des livres.
Pour cela on propose de mettre :

* En ordonnée le nombre de réplicat de Harry
* En abscisse le numéro du chapitre 
* En couleur le livre
* Représenter un point par livre et par chapitre 
* Relier les points de chaque livre ensemble 

Exercice 2

ggplot(Harry, aes(x = Chap, y = Nb_rep, color = Livre)) + geom_point() + geom_line()

Les facets

On propose donc d'utiliser les facets :

ggplot(Harry, aes(x = Chap, y = Nb_rep, color = Livre)) +geom_point() + geom_line() + 
  facet_wrap(~Livre, ncol = 4) + theme(legend.position ="none")

Les facets

On ne veut pas forcement aller jusqu'à 30 chapitres pour tout le monde

ggplot(Harry, aes(x = Chap, y = Nb_rep, color = Livre)) +
  geom_point() +geom_line() + 
  facet_wrap(~Livre, scale ="free", ncol = 4) +
  theme(legend.position ="none")

Les facets

Mais pour pouvoir comparer on aimerait le même axe des ordonnées

ggplot(Harry, aes(x = Chap, y = Nb_rep, color = Livre)) +
  geom_point() +
  geom_line()  +
  facet_wrap(~Livre, scale ="free_x", ncol = 4) +
  theme(legend.position ="none")

Si on veut changer les titres des facets

En utilisant des expression :

Harry$Livre_num <- factor(Harry$Livre, labels = paste("beta[",1:7,"]"))
ggplot(Harry, aes(x = Chap, y = Nb_rep, color = Livre_num)) +
  geom_point() +
  geom_line()  +
  facet_wrap(~Livre_num, scale ="free_x", 
             labeller = label_parsed , ncol=4) +
  theme(legend.position ="none")

Les facet grid

On peut aussi vouloir voir en fonction de 2 variables qualitatives :

HRH <- Livres %>% filter(Personnage  %in% c("Harry", "Ron", "Hermione"))
ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Livre)) +
  geom_point() +
  geom_line()  +
  facet_grid(Personnage~Livre, scale ="free", labeller = label_parsed) +
  theme(legend.position ="none")

Les thèmes : l'aspect general

Les thèmes prédéfinis :

p + theme_bw()

Les thèmes : l'aspect general

Les thèmes prédéfinis :

p + theme_classic()

Les thèmes : l'aspect general

Les thèmes prédéfinis :

p + theme_minimal()

Les thèmes : l'aspect general

Les thèmes prédéfinis :

p + theme_minimal()

p <- p + theme_minimal()

Les thèmes : l'aspect general

On peut aussi changer tout ce qu'on veut en ajoutant :

  • le texte (des abscisses, de la legende, du titre..) element_text(font = "bold" , size = 12 ,..)

  • les "rectanges" (le fond du graphe, le fond de la legende)
    element_rect(fill = "orange", color =" black")

  • Les lignes (des abscisses, du tour de la légende..) element_line(color = "blue" , linetype = 3, …)

Les thèmes : l'aspect general

Mais on peut aussi vouloir changer des détails soi-même

p + theme( text = element_text(face = "bold", 
                               size = 12))

Les thèmes : l'aspect general

On est pas obligés de changer tous le texte

p + theme( axis.text = element_text(face = "bold", 
                                    size = 12))

Les thèmes : l'aspect general

On est pas obligé de changer tous le text

p + theme( axis.text.x = element_text(face = "bold", 
                                      size = 12))

Les thèmes : l'aspect general

Bref on peut s'éclater

 p + theme( text = element_text(color =" white"),
            axis.text.x = element_text(color = "red"), 
            legend.background = element_rect(fill= "lightblue"), 
            plot.background = element_rect(fill="black"),
            axis.line = element_line(linetype = 3,
                                     colour = "blue"))

Choix du thème pour le reste de la présentation

theme_set(theme_minimal())

Choix de la palettte de couleurs pour le reste de la présentation :

scale_colour_discrete <- function(...) scale_color_brewer(palette="Dark2")

Exercice :

Pour la suite de notre présentation on veut un thème avec :

  • Un fond vert clair (darkseagreen1)
  • Le fond de la légende dans le même ton mais en un peu plus foncé ( darkseagrenn2 )
  • Le text dans le même ton mais en encore plus foncé ( darkseagrenn3 )
  • Le titre en gras
  • Les lignes des abscisse en flèche pointillé
  • Que la couleur de vos graphes soit visible de tous par default
  • Que le 'remplisaage' de vos graphes soit visible de tous par défault

Choix du thème pour le reste de la présentation

theme_set(theme_minimal() +
            theme( text = element_text(color =" gray50", face="bold"),
                   legend.background = element_rect(fill= "mintcream"),
                   axis.line = element_line(linetype = 3,
                                            colour = "darkblue"),
          strip.background = element_rect(fill = "mintcream", color ="black")))
scale_colour_discrete <- function(...) scale_color_hp(discrete = TRUE, house = "Ravenclaw")
scale_colour_continuous <- function(...) scale_color_hp( house = "Ravenclaw")
scale_fill_discrete <- function(...) scale_fill_hp(discrete = TRUE, house = "Ravenclaw")
scale_fill_continuous <- function(...) scale_fill_hp( house = "Ravenclaw")

Introduction à gganimate

Parce que c'est rigolo les graphes qui bougent!

Base

C'est très facile : il suffit d'avoir dans notre jeu de donné une colonne état (continue ou non).
Le premier graphe sera produit avec les données de l'état 1 puis il bougera doucement vers les données de l'état 2 ect.

Différent "Arguments"

  • Transition
  • Shadow
  • Ease_aes

Premier exemple : Transition linéaire

p <- Livres %>% filter( Livre == "philosophers_stone" & Personnage %in% c("Harry", "Ron", "Hermione")) %>% 
  mutate( Chap =as.integer(Chap)) %>% 
  ggplot( aes(x = Chap, y = Nb_rep, color = Personnage)) + geom_point(size  =4) + geom_line()
p

Premier exemple : Transition linéaire

p <- Livres %>% filter( Livre == "philosophers_stone" & Personnage %in% c("Harry", "Ron", "Hermione")) %>% 
  mutate( Chap =as.integer(Chap)) %>% 
  ggplot( aes(x = Chap, y = Nb_rep, color = Personnage)) + geom_point(size  =4) + geom_line()+
  transition_time(time=Chap) 
animate(p, heigh = 300, width = 600)

Premier exemple : Transition linéaire

p <- Livres %>% filter( Livre == "philosophers_stone" & Personnage %in% c("Harry", "Ron", "Hermione")) %>% 
  mutate( Chap =as.integer(Chap)) %>% 
  ggplot( aes(x = Chap, y = Nb_rep, color = Personnage)) + geom_point(size  =4) + geom_line()+
  transition_time(Chap) + shadow_wake(wake_length =0.15, wrap =FALSE) +
  ease_aes("linear")
animate(p, heigh = 300, width = 600)

Les différentes shadow

HRH <- Livres %>% filter( Livre == "philosophers_stone" & Personnage %in% c("Harry", "Ron", "Hermione")) %>% 
  mutate( Chap =as.integer(Chap)) 
p0 <- ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Personnage)) + geom_point(size  =4) + geom_line()+
  transition_time(Chap) + shadow_null() +
  labs(title = "shadow_null", subtitle = 'Chap : {frame_time}')
p1 <- ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Personnage)) + geom_point(size  =4) + geom_line()+
  transition_time(Chap) + shadow_wake(wake_length =0.15, wrap =FALSE) +
  labs(title = "shadow_wake", subtitle = 'Chap : {frame_time}')
p2 <-  ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Personnage)) + geom_point(size  =4) + geom_line()+
  transition_time(Chap) + shadow_mark() +
  labs(title = "shadow_mark", subtitle = 'Chap : {frame_time}')
p3 <-  ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Personnage)) + geom_point(size  =4) + geom_line()+
  transition_time(Chap) + shadow_trail() +
  labs(title = "shadow_trail", subtitle = 'Chap : {frame_time}')

Les différentes shadows

animate(p0, heigh = 300, width = 600)

Les différentes shadows

animate(p1, heigh = 300, width = 600)

Les différentes shadows

animate(p2, heigh = 300, width = 600)

Les différentes shadows

animate(p3, heigh = 300, width = 600)

Les différentes transitions

Transition Reveal

transition_reveal: permet de garder en mémoire là ou il était avant. Fait passer les points par le chemin exact (pas comme dans shadow_mark()).

pr <-ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Personnage)) + geom_point(size  =4) +
  transition_reveal(Personnage, Chap)   + geom_line() +
  ease_aes("linear") + labs(title = "transition_reveal", subtitle = 'Chap : {frame_along}')

animate(pr, heigh = 300, width = 600)

Transition States

Si on veut faire des pauses au différents états et ne pas voir ça comme un continuum :

ps <-ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Personnage)) +geom_point(size  =4) +
  transition_states(Chap, transition_length = 1, state_length = 2)   + 
  labs(title = "transition_states", subtitle = 'Chap : {closest_state}') + shadow_mark()  + 
  geom_line()

animate(ps, heigh = 300, width = 600)

Transition Layers

pl <-ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Personnage, label = Chap)) +
  geom_point(size  =4) +
  geom_line() +  geom_text_repel() +
  transition_layers(layer_length = 1, transition_length = 1)   + 
  labs(title = "transition_layers", subtitle = 'Layers: {closest_layer}') 
animate(pl, heigh = 300, width = 600)

Transition Manual

Si on veut faire des pauses au différents états et ne pas voir ça comme un continuum :

pm <-ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Personnage)) +geom_point(size  =4) +
  transition_manual( Chap)   + geom_line() +
  ease_aes("linear") + labs(title = "transition_manual", subtitle = 'Chap : {current_frame}')

animate(pm, heigh = 300, width = 600)

Transition Filter

pm <-ggplot(HRH, aes(x = Chap, y = Nb_rep, color = Personnage)) +geom_point(size  =4) +
  transition_filter(Personnage == "Harry", Personnage =="Ron", 
                    Personnage =="Hermionne",
                    transition_length = 1, filter_length = 1)   + geom_line() +
  ease_aes("linear") + labs(title = "transition_filter", subtitle = ' {closest_filter}')

animate(pm, heigh = 300, width = 600)

Ease_aes

Pour l'interpolation entre les états (temps ou autre)

p3<- Harry %>%  
ggplot( aes(x = Chap, y = Nb_rep)) + geom_point() +
  transition_states(Livre, transition_length = 2, state_length = 1) +
  labs(title = 'Livre: {closest_state}', x = 'Numero Chaitre', y = "Number of replicats") +
  ease_aes('linear')
animate(p3, heigh = 300, width = 600)

Ease_aes

Pour l'interpolation entre les états (temps ou autre)

p4 <- Harry %>%  
ggplot( aes(x = Chap, y = Nb_rep)) + geom_point() +
  transition_states(Livre, transition_length = 2, state_length = 1) +
  labs(title = 'Livre: {closest_state}', x = 'Numero Chaitre', y = "Number of replicats") + 
  ease_aes('elastic-in')
animate(p4, heigh = 300, width = 600)

Ease_aes

Pour l'interpolation entre les états (temps ou autre)

p4 <- Harry %>%  
ggplot( aes(x = Chap, y = Nb_rep)) + geom_point() +
  transition_states(Livre, transition_length = 2, state_length = 1) +
  labs(title = 'Livre: {closest_state}', x = 'Numero Chaitre', y = "Number of replicats") + 
  ease_aes('circular-in')
animate(p4, heigh = 300, width = 600)

Exemples

p1 <- Livres %>%  mutate( Chap =as.integer(Chap)) %>% spread(Personnage, Nb_rep) %>% 
  ggplot( aes(x = Ron, y = Hermione, color = Livre)) +geom_point() +
  transition_time(Chap) + shadow_wake(wake_length =0.15, wrap =FALSE) +                 
  labs(title = 'Chapitre: {frame_time}', x = 'Numero Chaitre', y = "Number of replicats")
animate(p1, heigh = 300, width = 600)

Exemples

p2 <- Harry %>%  
ggplot( aes(x = Chap, y = Nb_rep)) +geom_point() +
  transition_states(Livre, transition_length = 1, state_length = 3) +
  labs(title = 'Livre: {closest_state}', x = 'Numero Chaitre', y = "Number of replicats")

animate(p2, heigh = 300, width = 600)

Exemple using Rhabit Package

load("/Users/raphaellemomal/Desktop/SOTR/Rhabit.Rdata")
p <- ggplot(tr_m, aes(x,y)) +
  geom_raster(data= Base,aes(fill = val)) +
  coord_equal() + scale_fill_viridis(name = "Estimation") +
  geom_point( size=3,color = rgb(0.2,0.2,0.2,0.1)) +
  transition_time(Temps)+  labs(title ='Temps : {frame_time}')
animate(p, heigh = 400, width = 400)

Exercice :

Exercice :

p <- Livres %>% filter(Personnage %in% c("Harry", "Ron", "Hermione")) %>%  mutate(Livre2 = as.numeric(Livre)) %>% 
ggplot( aes( x = Nb_rep, color = Personnage, fill= Personnage)) +
  geom_density()+transition_states(Livre, transition_length = 1, state_length = 1, wrap = FALSE) +
  labs(title = 'Livre: {closest_state}', x = 'Numero Chapitre', y = "Number of replicats") 
animate(p, heigh = 300, width = 600)

Exercice :

Faire des densités qui bougent :)

Exercice :

Faire des densités qui bougent :)

p <- Livres %>% filter(Personnage %in% c("Harry", "Ron", "Hermione","Bellatrix", "Voldemort")) %>% 
  mutate(Livre2 = as.numeric(Livre)) %>% 
ggplot( aes( x = Nb_rep, color = Personnage, fill= Personnage)) +
  geom_density()+transition_time(Livre2) +
  labs(title = 'Livre: {frame_time}', x = 'Numero Chaitre', y = "Number of replicats") +
  facet_wrap(~Personnage, scale ="free")
animate(p, heigh = 300, width = 600)

Réseaux avec ggplot : Vue d'ensemble

ggraph + tidygraph

Galerie 1

Galerie 2

Galerie 3

Le but aujourd'hui

Savoir utiliser ggraph+tidygraph pour représenter des réseaux (type "boule de noeuds")

Prise en main

Données Harry Potter

Deux frames : characters et relations

##   id                   name House
## 1  0 Regulus Arcturus Black     S
## 2  1           Sirius Black     G
## 3  2         Lavender Brown     G
## 4  3              Cho Chang     R
## 5  4     Vincent Crabbe Sr.     S
## 6  5         Vincent Crabbe     S
##   source target type
## 1      0      1    -
## 2      0     25    -
## 3      0     45    -
## 4      1      0    -
## 5      1     11    +
## 6      1     21    +

Premier pas en tidygraph

library(tidygraph)
hp<-as_tbl_graph(relations)
hp
## # A tbl_graph: 65 nodes and 513 edges
## #
## # A directed multigraph with 1 component
## #
## # Node Data: 65 x 1 (active)
##   name 
##   <chr>
## 1 0    
## 2 1    
## 3 2    
## 4 3    
## 5 4    
## 6 5    
## # ... with 59 more rows
## #
## # Edge Data: 513 x 3
##    from    to type 
##   <int> <int> <chr>
## 1     1     2 -    
## 2     1    26 -    
## 3     1    40 -    
## # ... with 510 more rows

Attention à l'ordre de la première colonne

Graph minimal en ggraph

ggraph()+geom_*, deux lignes avec de nouveaux geom :

  • edges : link, arc, elbow, density, diagonal, hive
  • nodes : point, arc_bar, circle, tile, treemap
ggraph(hp)+
  geom_edge_link(aes(color=type)) +  
  geom_node_point() 

Layouts

ggraph propose les layouts de igraph

ggraph_layouts <- c('linear','star', 'circle', 'gem', 'dh', 'graphopt','grid','mds',
                    'randomly','fr','kk', 'drl', 'lgl')

Exemple :

ggraph(data, layout="kk")+
  geom_edge_*()+
  geom_node_*()

Ou:

layout=create_layout(data,"kk")
ggraph(layout)+
  geom_edge_*()+
  geom_node_*()

Comment reproduire cette figure ?

Solution

set_graph_style() #fixe un thème dédié aux réseaux
library(gridExtra)

p1<-ggraph(hp, layout="kk", maxiter = 100)+
  geom_edge_link(aes(color=type,alpha=..index..), show.legend=FALSE) +  
  geom_node_point() 
p2<-ggraph(hp,layout="star",center=22)+
  geom_edge_link(aes(color=type,alpha=..index..), show.legend=FALSE) +  
  geom_node_point() 
p3<-ggraph(hp,layout="linear")+
  geom_edge_arc(aes(color=type,alpha=..index..), show.legend=FALSE) +  
  geom_node_point() 
p4<-ggraph(hp,layout="linear",circular=TRUE)+
  geom_edge_arc(aes(color=type,alpha=..index..), show.legend=FALSE) +  
  geom_node_point() 

grid.arrange(p1,p2,p3,p4,nrow=2,ncol=2)

Mosaïque facilitée

ggraph(hp,layout="mds")+
  geom_edge_link(aes(color=type)) +  
  geom_node_point()+
  facet_edges(~type)

Vaincre la malédiction de la "boule de noeuds"

  • voisinnage d'un noeud
  • tailles proportionnelles à certaines mesures
  • filtrage d'arêtes/ de noeuds
  • mosaïque selon une variable

\(\Rightarrow\) Rendre le réseau lisible avec des commandes simples de ggraph x tidygraph

Travailler les données : tidygraph()

  • Travailler sur les arêtes ou les noeuds avec le verbe activate()
  • Repérer un voisinnage avec edge_is_incident() (7 autres booléens codés)
  • Mesure d'importance des noeuds : centrality_*() (32 codés)

Création de neib, importance, et house

HPData<-hp %>% 
  activate(edges) %>%
  mutate(neib=edge_is_incident(id)) %>%  
  activate(nodes) %>% 
  mutate(importance = centrality_degree(), house=characters$House)

Le réseau

p<-ggraph(HPData,layout="linear",circular=TRUE) + 
  geom_node_point(aes(size=importance, color=importance),show.legend=FALSE)
p+geom_edge_arc()

scale_edge_colour_manual

p<-p +  scale_edge_colour_manual(values=c("black","deepskyblue3"))
p+geom_edge_arc(aes(color=type))

aes(filter=boolean)

p + geom_edge_arc(aes(color=type, filter=neib)) 

Comment reproduire cette figure ?

Solution

pal<-c("#b20003","#dfb000","#151515","#006bff","#2c8309","#b4bab5")
order=characters$id[order(characters$House)]+1

ggraph(HPData,layout="star",center=id,order=order) + 
  geom_edge_link(aes(color=type,filter=neib)) +  
  geom_node_point(aes(color=house,size = importance)) +
  scale_color_manual("House",values=pal,
                     breaks=c("G","S","H","R","W","NW"),
                     labels=c("Gryffindor","Slytherin","Hufflepuff","Ravenclaw","Wizards",
                              "Non-wizards"))+
  scale_edge_colour_manual(values=c("darkred","orange"))+
  geom_node_text(aes(label = name), nudge_y = 0.1) +
  guides(size=FALSE)

layout="linear", alpha=..index..

Illustration sur données écologiques simulées

Selection d'arêtes

  • Situation type : données d'abondance continues, on souhaite retrouver le réseau d'interaction des espèces.

  • Modèles Graphiques Gaussiens : les entrées non-nulles de la matrice de précision donne les arêtes du graph.

\(\Rightarrow\) On estime \(\Omega\) avec parcimonie (ex: glasso)

Un graphe scale-free

Les voisins de 1 selon le seuil

Coups de pouces

But : facet avec les graphs correspondants aux troncatures des quantiles 10%, 25%, 50% et 91%.

  • Deux niveaux de difficultés : estim_tidy (facile) et estim_brut (plus dur)
  • Indice : ce n'est pas un filtrage…
  • Attention à l'ordre de la première colonne pour as_tbl_graph()
  • Pour comparer avec l'original : récupérer les coordonnées d'un create_layout()

Solution niveau 1

Le plus dur : conserver les mêmes positions de points que l'original.

load("~/SOTR_FancyGraphs.RData")
dat <- original_graph  %>%  as_tbl_graph() 

original_Layout<-create_layout(dat,"kk")
##              x          y name ggraph.orig_index circular ggraph.index
## 1 -0.003331937 -0.2193424    1                 1    FALSE            1
## 2  0.968587040 -0.4349930    2                 2    FALSE            2
## 3  0.638850864  0.2125941    3                 3    FALSE            3

Ajouter les coordonnées aux noeuds

data_avec_coord<- estim_tidy %>%  
  as_tbl_graph() %>% 
  activate(nodes) %>% 
  mutate(x=original_Layout$x,y=original_Layout$y) %>% 
  activate(edges) %>%
  mutate(neib =as.factor( 1*edge_is_incident(id)), 
         seuil=round(as.numeric(seuil),3))

Finalement :

ggraph(data_avec_coord,layout="auto")+
  geom_node_point(color="sienna2")+
  geom_edge_link(aes(colour=neib, alpha=neib),show.legend=FALSE)+
  scale_edge_colour_manual(values=c("#520a65","orange"))+
  geom_node_text(aes(label = name),nudge_x = 0.2,nudge_y = 0.2)+
  facet_edges(~seuil)+
  th_foreground(foreground = 'antiquewhite', border = TRUE)

Niveau 2 : transformation des données

Une solution avec tibble(), map(), gather, unnest() et filter() :

quant<-quantile(c(estim_brut),probs=c(0.1,0.25,0.5,0.91))
df<-data.frame(estim_brut)
colnames(df)<-seq(1,ncol(df))

fun <- tibble(P = list(df), seuil =quant )  %>% 
  mutate(P = map(P,~rownames_to_column(.) %>% 
                   gather(key, value , -rowname))) %>% 
  unnest() %>% 
  mutate(value = ifelse(abs(value) > seuil ,1,0)) %>% 
  filter(value !=0)

facile<-fun[,c(3,2,1)]

Pour un gradient de seuil plus important

En clair

les packages ggraphet tidygraph

  • data.frames pour les noeuds et les arêtes : faciles d'ajouter, de modifier, de calculer des statistiques du graph
  • fluide grâce aux pipes
  • grammaire ggplot : un investissement avantageux !
  • Large spectre de possibilités
  • Par un data imaginist jeune, dynamique et motivé (et modeste)

  • Packages assez jeunes
  • D'autres packages existent ggdendro, ggtree, ggnetwork, geomnet, GGally, plus spécialisés. Mais avec autant de grammaires différentes…

ggraph et tidygraph : une combinaison généraliste qui a de l'avenir !

Graphes en pagaille

Joli graphique facile

Comparaison de moyennes :

HRH <- Livres %>% filter(Personnage  %in% c("Harry", "Ron", "Hermione"))
p <- ggplot(data = HRH, aes(x = Personnage, y = Nb_rep) ) + geom_boxplot()
p

Comparaison de moyennes :

p <- ggplot(data = HRH, aes(x = Personnage, y = Nb_rep) ) + geom_boxplot()
p + stat_compare_means()

Comparaison de moyennes :

my_comparisons <- list( c("Harry", "Ron"), c("Harry", "Hermione"), c("Hermione", "Ron") )
p <- ggplot(data = HRH, aes(x = Personnage, y = Nb_rep))  + geom_boxplot()  
p + stat_compare_means(aes(label = ..p.signif..),
                  method = "t.test",  comparison = my_comparisons) 

Comparaison de moyennes :

p <- ggboxplot(HRH, x = "Personnage", y = "Nb_rep",
                color = "Personnage", palette =c("#00AFBB", "#E7B800", "#FC4E07"),
                add = "jitter", shape = "Personnage", legend = "bottom")
 p + stat_compare_means(comparisons =  my_comparisons)

Comparaison de moyennes :

ggplot(data = HRH, aes(x = Personnage,  y = Nb_rep)) +
  stat_compare_means(aes(label = ..p.signif..),
                     method = "t.test", comparison = my_comparisons)  + 
  geom_boxplot(aes(color = Personnage)) + geom_beeswarm(aes(color = Personnage)) + 
  scale_color_manual(values = c("#00AFBB",  "#E7B800", "#FC4E07"))

Comparaison de moyennes :

On peut rajouter des arguments aux tests:

p + stat_compare_means(aes(label = ..p.signif..),
                  method = "t.test",method.args =  list(alternative = "greater"),
                  comparison = my_comparisons, paired = FALSE) 

On peut le faire bouger mais sans les p-values :(

p1 <- p + transition_states(Livre, state_length =  3, transition_length = 1 ) + 
  labs(title ='Livre : {closest_state}')
animate(p1, width= 800, height =  500)

Des jolis barplots

Par_livre <- HRH %>% group_by(Livre, Personnage) %>% summarise(Nb_rep= sum(Nb_rep)) %>% 
  mutate(Perso = paste(Personnage, as.numeric(Livre)))
ggbarplot(Par_livre, x = "Perso", y = "Nb_rep",
          fill = "Livre",    color = "white", palette = "Dark2",  
          sort.val = "desc", sort.by.groups = FALSE, x.text.angle = 90 )

Des jolis barplots

Par_livre <- HRH %>% group_by(Livre, Personnage) %>% summarise(Nb_rep= sum(Nb_rep)) %>% 
  mutate(Perso = paste(Personnage, as.numeric(Livre)))
ggbarplot(Par_livre, x = "Perso", y = "Nb_rep",
          fill = "Livre", color = "white",           
          palette = "Dark2",  sort.val = "desc", sort.by.groups = TRUE, x.text.angle = 90 )

Des jolis barplots

Par_livre <- HRH %>% group_by(Livre, Personnage) %>% summarise(Nb_rep= sum(Nb_rep)) %>% 
  mutate(Perso = paste(Personnage, as.numeric(Livre)))
p1 <- ggbarplot(Par_livre, x = "Perso", y = "Nb_rep",
          fill = "Livre", color = "white",  palette = "Dark2",
          sort.val = "desc", group = "Livre", sort.by.groups = TRUE,  x.text.angle = 90)

Des jolis barplots

p1

Des lolipop plots

p2 <- ggdotchart(Par_livre, x = "Perso", y = "Nb_rep",
          color = "Livre", palette = "Dark2", sorting = "descending", add = "segments", 
           rotate = TRUE, group = "Personnage", dot.size = 6, label = round(as.numeric(Par_livre$Livre)), 
           font.label = list(color = "white", size = 9, vjust = 0.5), legend =" none",
           ggtheme = theme_pubr()           
           )

Des jolis Lolipop plot

p2

Plots de densité sur le coté :

require(ggExtra)
Data <- Livres %>% spread(Personnage, Nb_rep)
pmain <- ggplot(Data, aes(x = Harry, y = Ginny, color = Livre, fill =Livre  )) + geom_point() + theme(legend.position = "bottom") 
ggMarginal(pmain, type = "density")

Plots de densité sur le coté :

library(cowplot) 

xdens <- axis_canvas(pmain, axis = "x")+
  geom_density(data = Data, aes(x = Harry, fill = Livre),
              alpha = 0.7, size = 0.2)   + scale_fill_hp(discrete = TRUE, house = "Ravenclaw")

ydens <- axis_canvas(pmain, axis = "y", coord_flip = TRUE)+
  geom_density(data = Data, aes(x = Ginny, fill = Livre),
                alpha = 0.7, size = 0.2)   + scale_fill_hp(discrete = TRUE, house = "Ravenclaw")
  coord_flip() 
## <ggproto object: Class CoordFlip, CoordCartesian, Coord, gg>
##     aspect: function
##     clip: on
##     default: FALSE
##     distance: function
##     expand: TRUE
##     is_free: function
##     is_linear: function
##     labels: function
##     limits: list
##     modify_scales: function
##     range: function
##     render_axis_h: function
##     render_axis_v: function
##     render_bg: function
##     render_fg: function
##     setup_data: function
##     setup_layout: function
##     setup_panel_params: function
##     setup_params: function
##     transform: function
##     super:  <ggproto object: Class CoordFlip, CoordCartesian, Coord, gg>
p1 <- insert_xaxis_grob(pmain, xdens, grid::unit(.2, "null"), position = "top")
p2<- insert_yaxis_grob(p1, ydens, grid::unit(.2, "null"), position = "right")

Plots de densité sur le coté :

ggdraw( p2 )

Exercice :

Si on veut représenter des histogramme ?
Des boxplots ?

Pour des histogrammes

xdens <- axis_canvas(pmain, axis = "x")+
  geom_histogram(data = Data, aes(x = Harry, fill = Livre),
              alpha = 0.7, size = 0.2)  + scale_fill_hp(discrete = TRUE, house = "Ravenclaw")
ydens <- axis_canvas(pmain, axis = "y", coord_flip = TRUE)+
  geom_histogram(data = Data, aes(x = Ginny, fill = Livre),
                alpha = 0.7, size = 0.2)+
  coord_flip()  + scale_fill_hp(discrete = TRUE, house = "Ravenclaw")
p1 <- insert_xaxis_grob(pmain, xdens, grid::unit(.2, "null"), position = "top")
p2<- insert_yaxis_grob(p1, ydens, grid::unit(.2, "null"), position = "right")

Pour des histogrammes

ggdraw( p2 )

Pour des boxplots

 library(cowplot) 

# Marginal densities along x axis
xdens <- axis_canvas(pmain, axis = "x", coord_flip = TRUE)+
  geom_boxplot(data = Data, aes(y = Harry, fill = Livre)) + coord_flip() + 
  scale_fill_hp(discrete = TRUE, house = "Ravenclaw")
# Marginal densities along y axis
# Need to set coord_flip = TRUE, if you plan to use coord_flip()
ydens <- axis_canvas(pmain, axis = "y")+
  geom_boxplot(data = Data, aes(y = Ginny, fill = Livre))  +
  scale_fill_hp(discrete = TRUE, house = "Ravenclaw")
p1 <- insert_xaxis_grob(pmain, xdens, grid::unit(.2, "null"), position = "top")
p2<- insert_yaxis_grob(p1, ydens, grid::unit(.2, "null"), position = "right")

Pour des boxplots

ggdraw(p2)

Package `ggridges

Visualiser des densités séparément

Code

  • Avec le geom_density_ridges
  • Astuce pour réordonner l'axe des y : scale_y_discrete
library(ggridges)

set<-c("Ron","Hermione","Ginny","Neville","Luna")
HP<-Livres %>% filter(Personnage %in% set)

p<-ggplot(HP,aes(Nb_rep,Personnage,fill=Personnage))+
geom_density_ridges(alpha = 0.7)+
theme_minimal()+
scale_y_discrete(limits = set)+
labs(x="Répétitions",y="")+
theme(axis.text.y = element_text(size=13))
p <- p + scale_fill_hp(discrete=TRUE, house = "Gryffindor")

On peut animer !

p + labs(title='Livre : {closest_state}')+
transition_states(as.numeric(Livre), transition_length = 2, state_length = 1)

GGpairs :

On créer notre base de données :

mot <- c("dead", "love", "laugh", "book")
perso <- c("Harry", "Ron", "Ginny", "Hermione", "Voldemort")

Data <- Livres %>% filter(as.numeric(Livre) %in% c(1,3,6)) %>%
  spread(Personnage, Nb_rep) %>% select(c(mot, perso, Livre))  %>% 
  mutate_at(vars(mot), funs(ifelse(. !=0, "Present", "Absent")))

On étudies les Noms entre eux

require(GGally)
ggpairs(Data, perso, title = "Croisement du nombre d'expression des prénoms")

On étudies les Noms entre eux

require(GGally)
ggpairs(Data, perso, title = "Croisement du nombre d'expression des prénoms ", mapping = aes(color = Livre))

On compare les mots et les personnage :

ggduo(Data,  mot, perso,
      title = "Croisement du nombre d'expression des prénoms et de la présence de mot") 

Linear Regression

Regression linéaire univariée :

Data %>%  ggplot(aes(x = Ron, y = Hermione)) + geom_point()

Regression linéaire univariée :

Data %>%  ggplot(aes(x = Ron, y = Hermione)) + geom_point() +
  stat_cor() 

Regression linéaire univariée :

Data %>%  ggplot(aes(x = Ron, y = Hermione)) + geom_point() +
  stat_cor() +
     stat_poly_eq(label.y = 75,
    aes(label =  paste(..eq.label.., ..adj.rr.label.., sep = "~~~~")),
     parse = TRUE, formula = y~x
    )

Les plot "à la plot.lm"

require(ggfortify)
# Compute a linear model
m <- lm(Ron  ~ Hermione, data = Data)
# Create the plot
autoplot(m, which = 1:4, label.size = 2, data = Data,colour = "Livre") +
  theme(legend.position = "none")

Exercice

Si on veut faire une correlation par Livre?

Exercice

Si on veut faire une correlation par Livre ?

Data %>%  ggplot(aes(x = Ron, y = Hermione, color = Livre)) + geom_point() +
  stat_cor() 

Regression linéaire univariée :

Data %>% 
  ggplot(aes(x = Ron, y = Hermione, color = Livre)) + geom_point() +
  geom_smooth(method="lm") +
     stat_poly_eq(
    aes(label =  paste(..eq.label.., ..adj.rr.label.., sep = "~~~~")),
     parse = TRUE, formula = y~x
    )

Regression linéaire :

formula <- y ~ poly(x, 3, raw = TRUE)
Data %>% 
  ggplot(aes(x = Ron, y = Hermione, color = Livre)) + geom_point() +
  geom_smooth(formula = formula, method ="lm") +
     stat_poly_eq(
    aes(label =  paste(..eq.label.., ..adj.rr.label.., sep = "~~~~")),
     parse = TRUE, formula = formula
    )

Regression linéaire Multivariée

On veut expliquer Harry en fonction de Ginny, Ron, Choe, Cedric et du livre dans lequel on est.

Data <- Livres  %>% spread(Personnage, Nb_rep)
mod <-lm(darkness~(Harry+Ron+Voldemort+Lucius+ Livre), data = Data)
md <- step(mod)
## Start:  AIC=175.1
## darkness ~ (Harry + Ron + Voldemort + Lucius + Livre)
## 
##             Df Sum of Sq    RSS    AIC
## - Voldemort  1     0.013 430.03 173.11
## - Ron        1     0.641 430.66 173.40
## <none>                   430.02 175.10
## - Harry      1    13.560 443.58 179.31
## - Lucius     1    13.937 443.95 179.48
## - Livre      6    75.556 505.57 195.47
## 
## Step:  AIC=173.11
## darkness ~ Harry + Ron + Lucius + Livre
## 
##          Df Sum of Sq    RSS    AIC
## - Ron     1     0.747 430.78 171.45
## <none>                430.03 173.11
## - Harry   1    13.802 443.83 177.43
## - Lucius  1    15.900 445.93 178.37
## - Livre   6    81.559 511.59 195.84
## 
## Step:  AIC=171.45
## darkness ~ Harry + Lucius + Livre
## 
##          Df Sum of Sq    RSS    AIC
## <none>                430.78 171.45
## - Harry   1    13.292 444.07 175.53
## - Lucius  1    16.388 447.16 176.92
## - Livre   6    81.194 511.97 193.99

Regression linéaire multivariée

grid.arrange(ggcoef(mod), ggcoef(md), ncol =2)

Regression linéaire multivariée

grid.arrange(ggcoef(mod, exclude_intercept = TRUE),
             ggcoef(md, exclude_intercept = TRUE), ncol =2)

Regression linéaire multivariée

ggcoef(md, exclude_intercept = TRUE,  exponentiate = TRUE,
  vline_color = "purple",  vline_linetype =  "solid",
  errorbar_color = "blue",  errorbar_height = .25)

Regression linéaire multivariée

p <- ggcoef(md, mapping = aes(x = estimate, y = term,  size = p.value))
p

Mais bon là plus c'est gros plus la p-value est grande c'est pas trop ce qu'on veut mettre en avant

Regression linéaire multivariée

require(scales)

p+ scale_size_continuous(trans = "reverse")

Regression linéaire multivariée : Le lasso

X <- Data %>% select(Harry, Ron, Lucius, Livre,Voldemort) %>% 
 model.matrix(~Harry+Ron+Lucius+Livre+Voldemort -1,.)
y <- Data$dead %>% as.numeric()
mod_lasso <- glmnet(X,y)
autoplot(mod_lasso, xvar = "lambda")

Représentation des coefficients

ggcoef(mod_lasso,mapping= aes(x = estimate, y =term, size = lambda),exclude_intercept = TRUE)

Les coefficients

On recupère les coefficients sous forme d'une matrice.
Chaque colonne est une étape du chemin de régularisation :

head(coef(mod_lasso))
## 6 x 66 sparse Matrix of class "dgCMatrix"
##                                                                           
## (Intercept)             1.965 1.936614 1.910751 1.887185 1.865712 1.846147
## Harry                   .     .        .        .        .        .       
## Ron                     .     .        .        .        .        .       
## Lucius                  .     .        .        .        .        .       
## Livrephilosophers_stone .     .        .        .        .        .       
## Livrechamber_of_secrets .     .        .        .        .        .       
##                                                                
## (Intercept)             1.825384 1.800339 1.777527 1.7291669630
## Harry                   .        .        .        0.0003014127
## Ron                     .        .        .        .           
## Lucius                  .        .        .        .           
## Livrephilosophers_stone .        .        .        .           
## Livrechamber_of_secrets .        .        .        .           
##                                                                         
## (Intercept)             1.6466977674 1.571561920 1.503109827 1.440729939
## Harry                   0.0009958058 0.001628459 0.002204849 0.002730094
## Ron                     .            .           .           .          
## Lucius                  .            .           .           .          
## Livrephilosophers_stone .            .           .           .          
## Livrechamber_of_secrets .            .           .           .          
##                                                                        
## (Intercept)             1.383891706 1.332169686 1.285354062 1.242701700
## Harry                   0.003208678 0.003660604 0.004149815 0.004595504
## Ron                     .           .           .           .          
## Lucius                  .           .           .           .          
## Livrephilosophers_stone .           .           .           .          
## Livrechamber_of_secrets .           .           .           .          
##                                                                
## (Intercept)              1.2093775172  1.181012137  1.155149809
## Harry                    0.0051270347  0.005657023  0.006140377
## Ron                     -0.0004950301 -0.001125908 -0.001701654
## Lucius                   .             .            .          
## Livrephilosophers_stone  .             .            .          
## Livrechamber_of_secrets  .             .            .          
##                                                               
## (Intercept)              1.131584974  1.110113574  1.090549635
## Harry                    0.006580792  0.006982081  0.007347722
## Ron                     -0.002226255 -0.002704252 -0.003139785
## Lucius                   .            .            .          
## Livrephilosophers_stone  .            .            .          
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              1.072723701  1.054173765  1.037446870
## Harry                    0.007680879  0.007981347  0.008250142
## Ron                     -0.003536627 -0.003904034 -0.004241353
## Lucius                   .            .            .          
## Livrephilosophers_stone  .            .           -0.004312560
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              1.024462756  1.012647910  1.000668507
## Harry                    0.008491061  0.008709397  0.008907339
## Ron                     -0.004553298 -0.004835634 -0.005096003
## Lucius                   .            .            .          
## Livrephilosophers_stone -0.017883189 -0.030151128 -0.040514488
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              0.991923061  0.985316720  0.980437474
## Harry                    0.009079601  0.009241773  0.009393879
## Ron                     -0.005331825 -0.005550993 -0.005739686
## Lucius                   .           -0.000380945 -0.002725583
## Livrephilosophers_stone -0.050545110 -0.061698707 -0.073656819
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              0.977009487  0.974362215  0.972169827
## Harry                    0.009534653  0.009663417  0.009780964
## Ron                     -0.005914428 -0.006073887 -0.006219279
## Lucius                  -0.004870931 -0.006841960 -0.008645508
## Livrephilosophers_stone -0.085906847 -0.097667104 -0.108658306
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              0.970273504  0.968592349  0.967082075
## Harry                    0.009888171  0.009985901  0.010074971
## Ron                     -0.006351800 -0.006472570 -0.006582621
## Lucius                  -0.010292348 -0.011794509 -0.013163968
## Livrephilosophers_stone -0.118800184 -0.128099687 -0.136600067
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              0.965715897  0.964475664  0.963347720
## Harry                    0.010156138  0.010230099  0.010297492
## Ron                     -0.006682899 -0.006774271 -0.006857527
## Lucius                  -0.014412113 -0.015549535 -0.016585985
## Livrephilosophers_stone -0.144357753 -0.151432010 -0.157880458
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              0.962320953  0.961054527  0.960021276
## Harry                    0.010358899  0.010413257  0.010464117
## Ron                     -0.006933387 -0.007000314 -0.007063283
## Lucius                  -0.017530394 -0.018392446 -0.019170484
## Livrephilosophers_stone -0.163757265 -0.168585101 -0.173244180
## Livrechamber_of_secrets  .            .            .          
##                                                                           
## (Intercept)              0.959168780  0.95844372  0.957812887  0.957255280
## Harry                    0.010510596  0.01055300  0.010591667  0.010626918
## Ron                     -0.007120795 -0.00717323 -0.007221023 -0.007264579
## Lucius                  -0.019881299 -0.02053064 -0.021123290 -0.021663864
## Livrephilosophers_stone -0.177603831 -0.18164120 -0.185357318 -0.188764872
## Livrechamber_of_secrets  .            .           .            .          
##                                                                           
## (Intercept)              0.956757112  0.95630891  0.955903807  0.955536591
## Harry                    0.010659046  0.01068833  0.010715009  0.010739323
## Ron                     -0.007304271 -0.00734044 -0.007373397 -0.007403428
## Lucius                  -0.022156747 -0.02260603 -0.023015516 -0.023388686
## Livrephilosophers_stone -0.191882135 -0.19472963 -0.197328290 -0.199698469
## Livrechamber_of_secrets  .            .           .            .          
##                                                               
## (Intercept)              0.955203089  0.954807691  0.954416486
## Harry                    0.010761478  0.010780061  0.010798399
## Ron                     -0.007430791 -0.007454749 -0.007477409
## Lucius                  -0.023728740 -0.024022345 -0.024301708
## Livrephilosophers_stone -0.201859459 -0.203570028 -0.205225665
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              0.954093452  0.953825300  0.953599657
## Harry                    0.010815209  0.010830557  0.010844561
## Ron                     -0.007498125 -0.007517026 -0.007534262
## Lucius                  -0.024557829 -0.024792028 -0.025006011
## Livrephilosophers_stone -0.206782959 -0.208235267 -0.209582151
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              0.953407324  0.953241487  0.953097059
## Harry                    0.010857335  0.010868984  0.010879605
## Ron                     -0.007549978 -0.007564305 -0.007577364
## Lucius                  -0.025201405 -0.025379740 -0.025542445
## Livrephilosophers_stone -0.210826114 -0.211971436 -0.213023432
## Livrechamber_of_secrets  .            .            .          
##                                                               
## (Intercept)              0.952970198  0.952857968  0.952758091
## Harry                    0.010889287  0.010898113  0.010906157
## Ron                     -0.007589267 -0.007600116 -0.007610002
## Lucius                  -0.025690846 -0.025826171 -0.025949550
## Livrephilosophers_stone -0.213987945 -0.214871012 -0.215678637
## Livrechamber_of_secrets  .            .            .          
##                                     
## (Intercept)              0.952668780
## Harry                    0.010913488
## Ron                     -0.007619011
## Lucius                  -0.026062022
## Livrephilosophers_stone -0.216416648
## Livrechamber_of_secrets  .

Exercice :

  • Niveau 1: Faire en ggplot la même chose que ggcoef pour un lambda que vous voulez
  • Niveau 2: Faire en ggplot exactement la même chose que ggcoef
  • Niveau 3: Faire en ggplot le graphe suivant :
  • Niveau 4: Idem mais au moment ou un coef devient non nulle il doit avoir une étiquette avec le nom de la variable
  • Niveau 5: Et si on a plusieurs variables réponses ?

Solution :

p <- mod_lasso %>% coef %>%
  as.matrix %>% as.data.frame() %>% 
  rownames_to_column() %>% 
   `colnames<-`(c("rowname", round(mod_lasso$lambda,4))) %>% 
   slice(2:n()) %>% 
  gather(key, value, -rowname) %>% 
  mutate(key = factor(key, levels = unique(key)),
         Label = ifelse(value!=0, rowname, ""),
         nudge = (value!=0) * 0.1) %>% 
  ggplot(aes( x = rowname , y = value, label = Label, color = value)) +geom_point() + coord_flip() +
  # transition_manual(key) +
  labs( title = 'lambda~ {closest_state}') +
   # labs( title = 'lambda~ {current_frame}') + 
  geom_text_repel(nudge_x =0.1) + 
  #theme_pomological_fancy() + 
 # scale_color_gradient2(name = "Coefficient",mid= "#F5C04A", high ="#C03728", low = "#919C4C") +
  scale_fill_gradientn(colours = hp(256, house = "Ravenclaw"))+
  theme(legend.position = "bottom", legend.key.width = unit(2,"cm")) +
  transition_states(key, transition_length = 1, state_length = 1) 

Rendu

animate(p, heigh = 300, width = 600)

Autre proposition

p <- mod_lasso %>% coef %>%
  as.matrix %>% as.data.frame() %>% 
  rownames_to_column() %>% 
  `colnames<-`(c("rowname", round(mod_lasso$lambda,4))) %>% 
  slice(2:n()) %>% 
  gather(key, value, -rowname) %>% 
  mutate(lambda = as.numeric(key), key = factor(key, levels = unique(key)),
         Label = ifelse(value!=0, rowname, ""),
         nudge = (value!=0) * 0.1) %>% 
  ggplot(aes( x = lambda , y = value, label = Label, color = rowname)) +geom_point() +
  geom_line() +
  geom_text(aes(x = 1), hjust = 0) +
  geom_segment(aes(xend = 1, yend = value), linetype = 2, colour = 'grey') + 
  coord_cartesian(clip = 'off') +
 # theme_pomological_fancy() + 
  theme(plot.margin = margin(5.5, 50, 5.5, 5.5), legend.position = "none") +
  labs( title = 'lambda~ {frame_along}')  +
  transition_reveal(rowname, as.numeric(key))  

Rendu

animate(p, heigh = 300, width = 600)