[Etude de marché - Article 8]
Aurélien Daval
La dernière étape dans la production d’une étude de marché est la restitution des résultats au client final. C’est ce que nous allons voir dans cet article.
NB: le code est divisé en plusieurs sous-partie. Pour avoir le code au complet, ce dernier est disponible dans sa totalité en conclusion de cet article.
6. La restitution des résultats.
Plusieurs solution sont envisageables pour restituer les résultats au client final :
- Un rapport PowerPoint.
- Un rapport automatisé via R (utile notamment pour les baromètres).
- Un Dashboard en ligne.
Outre le moyen choisi pour transmettre les résultats, il faut travailler la forme de ce rapport/dashboard : le client doit en effet faire sien les résultats de l’analyse. Il doit pouvoir les comprendre rapidement et retenir ces résultats. Pour conclure : la forme (rapport/dashboard) compte autant que le fond (les traitements statistiques).
Pour cette étude Ad’Hoc, nous avons choisi de construire un Dashboard. C’est notamment ce qui permet de suivre en direct les résultats et plonger le client avec nous dans l’analyse. Deux solutions s’offrent à nous pour construire un Dashboard avec R :
- le package “flexdashboard”.
- le package “shinydashboard”.
Nous allons utilisé pour ce tutoriel le package “shinydashboard”. En effet, lors de la programmation de notre questionnaire, nous avions utilisé le package “shiny”. Ce dernier nous est donc déjà familié.
6.0. Téléchargement des données et transformation des données.
Dans les précédents articles, nous avons travaillé sur une base de données fictives. Pour ce Dashboard, je vous propose de prendre les réponses qui s’enregistrent en direct sur notre Bucket (via le service AWS) depuis notre questionnaire en ligne.
NB: Lors de la rédaction de cet article, il y a 20 réponses.
Pour savoir comment nous avions connecté notre questionnaire au bucket AWS, je vous propose de relire cet article.
Pour télécharger les données depuis notre bucket, nous allons créer une fonction “loadData” avec le package “aws.s3”. Cette fonction a été développée par Dean Attali dans cet article.
Pour cette fonction, nous allons donc utiliser deux fonctions du package AWS :
- get_bucket() : répertorie le contenu du bucket sous forme de liste (ici les fichiers csv).
- get_object() : récupère le contenu du bucket.
D’autres fonctions sont nécessaires :
- lapply(X, FUN) : deux arguments sont attendus. Le premier est un vecteur/un objet X. Le second une fonction appliquée à chaque élément de X. Cette fonction renvoie une liste de même longueur dont chaque élément est le résultat de l’application de l’argument FUN.
- readBin() : permet de lire des données binaires.
- read.csv() : permet de lire le CSV.
- do.call() : exécute une fonction à une liste d’arguments.
- rbind() : permet de combiner plusieurs vecteurs/matrices l’un après l’autre (par lignes).
Ainsi, la fonction permet de lire chaque élément dans le bucket, de télécharger les CSV dans le même format, puis de les coller à la suite pour faire une seule base de données. Ce qui donne :
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(aws.s3)
library(dplyr)
library(expss)
library(survey)
library(openxlsx)
##### Télécharger les données + les rendres exploitables #####
# Permettre l'accès de l'application à Amazon S3
Sys.setenv("AWS_ACCESS_KEY_ID" = "XXXXXXXXXXXXX",
"AWS_SECRET_ACCESS_KEY" = "XXXXXXXXXXXXX",
"AWS_DEFAULT_REGION" = "eu-west-3")
# Fonction pour télécharger les fichiers csv et en faire une database.
loadData <- function() {
# Obtenir la liste des CSV dans le Bucket:
file_names <- get_bucket("svyapp")
# Lire les données du buckets et les téléchargers dans le même format.
data <- lapply(file_names, function(x) {
object <- get_object(x, "svyapp")
object_data <- readBin(object, "character")
read.csv(text = object_data, sep = ";", stringsAsFactors = FALSE)
})
# Concaténer tous les fichiers en une seule base de données
data <- do.call(rbind, data)
data
}
# Téléchargement des données.
survey_responses <- loadData()
# Sélection des 3 premières questions.
survey_responses <- survey_responses %>% select(Q1, Q2, Q3)Les données sont maintenant téléchargées en une seule base de données. Cependant, on observe que pour la question 3, les réponses sont dans une seule colonne. Il faut donc créer une colonne par réseau social et effectuer une recode.
Pour permettre la recode, on va créer une colonne “Q3help” qui va compter le nombre de caractère dans la colonne de réponse (Q3) via la fonction “nchar”. Pourquoi cette colonne d’aide ? Cette dernière va être utile pour distinguer les recodes simples (le répondant à choisi un seul réseau social, il suffit de le recoder dans la bonne colonne en y ajoutant un 1) et les recodes plus compliquées où le répondant a choisi plusieurs réseaux sociaux (et où il faut associer chaque réseau social dans sa bonne colonne).
La recode va se faire par colonne. Pour le premier réseau social (survey_responses$Q3A1 –> Facebook), nous allons utiliser la fonction ifelse(test logique, x, y). Cette fonction permet de tester la logique d’une expression: si le résultat de l’expression est vrai, le résultat X sera affiché. Sinon, ca sera le résultat Y.
Ainsi, lorsqu’il y a une seule réponse (survey_responses$Q3help <= 2) et que cette réponse est 1 (Q3 == 1), alors on recode 1.
Nous allons ensuite utiliser la fonction case_when() pour effecturer la recode lorsque le répondant a notifé plusieurs réseaux sociaux. Cette dernière permet de multiplier les expressions à tester. Si aucun test n’est vrai, alors la fonction n’indique rien (NA).
Ainsi, il faut identifier lorsque le répondant a choisi le premier réseau social C(1,..) dans la colonne des réponses (survey_responses$Q3) et l’inscrire dans la colonne Q3A1 (c’est la colonne qui représente le premier réseau social –> Facebook). Pour identifier le choix 1, on utilise la fonction grepl() qui recherche les correspondances dans une expression. Ensuite, on s’attaque à la prochaine colonne (Q3A2 –> Google +) en identifiant le 2 (en unique réponse ou dans la chaine de caractère des multiples réponses) pour effectuer la recode. Et ainsi de suite jusqu’au dernier réseau.
NB: pour la recode du premier réseau social “1”, lorsque le répondant a sélectionné plusieurs réponses, on cherche la corresponsance avec “1,”. En effet, si l’on ajoute pas la virgule, il va y avoir une recode avec le réseau social 11. Idem pour le second réseau social: on cherche une correspondnace avec “2,” ou “2)” pour ne pas recoder le 12ième réseau social.
Ce qui donne :
# Nombre de caractères en Q3.
survey_responses$Q3help <- nchar(survey_responses$Q3)
# Recode Q3A.
survey_responses$Q3A1 <- ifelse(
# S'il n'y a qu'une réponse et que cette réponse est 1: Recode 1.
survey_responses$Q3help <= 2 & survey_responses$Q3 == 1 , "1",
# S'il y a plusieurs réponses : si "1," est dedans, Recode 1.
case_when(grepl("1,", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
# Recode des autres réseaux sociaux.
survey_responses$Q3A2 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 2 , "1",
case_when(grepl("2,| 2)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A12 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 12 , "1",
case_when(grepl("12)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A99 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 99 , "1", "0")La base de données prête, il n’y a plus qu’à organiser notre Dashboard.
6.1. Structure du Dashboard.
Avant de commencer à organiser les différents onglets, il faut comprendre la structure du Dashboard. 3 élements sont nécessaires :
- Header : permet d’apposer un titre à notre Dashboard et des menus déroulants.
- Sidebar : une barre latérale à gauche qui permet une navigation rapide.
- Body : le contenu de votre Dashboard.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody()
)
server <- function(input, output) { }
shinyApp(ui, server)Si vous lancez maintenant ce script, vous aurez l’apparence du Dashboard.
6.1.2. Les différentes pages
La page Terrain
Maintenant que le menu est programmé, il faut s’occuper de la première page “Terrain”. C’est dans la partie “dashboardBody()” que ça se passe.
Plusieurs éléments sont nécessaires :
- L’argument “tabItems”: cette argument permet notifier qu’il y aura plusieurs pages. * L’argument “tabItem” (sans s): c’est notre première page. Pour lier cette page à notre raccourci, on ajoute le même ID que celui inscrit dans le raccourci : ici, tabName = “terrain”.
On ajoute également un titre “h2()” et un espace entre le titre et le prochain élément via br(). Ce qui donne pour l’instant :
dashboardBody(
tabItems(
#### Page "Terrain" ####
tabItem(tabName = "terrain",
# Titre de la page
h2("Suivi du Terrain"),
br(),La table “Suivi du terrain” permet de suivre la progression des différents quotas. Pour suivre cela de façon visuelle, je vous propose de programmer plusieurs barres de progression (en fonction des différents quotas).
Pour cela, nous allons utiliser la fonction progressBar du package “shinyWidgets”. Plusieurs arguments sont attendus :
- Id.
- Value : pour cette première barre, nous souhaitons afficher le nombre total de répondants. Pour cela, il suffit de compter le nombre de lignes via la fonction “nrow”.
- Total : permet de calculer les pourcentages de l’avancement.
- Title : ajouter un titre à notre barre de progression.
- Display pct : ajouter le pourcentage sur la barre de progression.
Ce qui donne :
# Progression global du terrain
progressBar(id = "gobalprogress",
value = nrow(survey_responses),
total = 1000,
title = "Avancement du terrain",
display_pct = TRUE), Les barres de progression suivantes se programment sur la même structure. Il faut ajuster les différents arguments.
La page “TAP - Données Brutes”
La seconde page permettra d’avoir accès au TAP en direct et de pouvoir le télécharger. Pour matérialiser une nouvelle page, il faut utiliser la fonction “tabItem”.
Nous allons tout d’abord mettre en place un bouton qui permettra de télécharger le TAP directement en Excel. Pour cela :
- Dans la partie UI : matérialiser le bouton avec la fonction “downloadButton (ID, Texte sur le bouton)”.
- Dans la partie “Server” : il faut créer un Excel via la fonction createWorkbook avec les différents tableaux (list_of_datasets) que l’on va reporter sur cet Excel via les fonctions xl_write et saveWorkbook. Ensuite, il faut lier le bouton créé précédemment au pop-up pour télécharger ce fichier via la fonction “downloadHandler”.
Ce qui donne pour la partie UI :
tabItem(tabName = "db",
h2("Tris A Plat - Données Brutes"),
br(),
#Bouton pour télécharger en Excel
downloadButton("tapbrute", "Télécharger le TAP"),
br(),
br())Et pour la partie Server :
wb = createWorkbook()
sh = addWorksheet(wb, "Tables")
list_of_datasets <- list(Q1, Q2, Q2m, Q3, Q3m)
xl_write(list_of_datasets, wb, sh)
saveWorkbook(wb, "TAP.xlsx", overwrite = TRUE)
output$tapbrute <- downloadHandler(
filename = function() {
paste0("TAP Données brutes", ".xlsx")
},
content = function(file) {
saveWorkbook(wb, file = file, overwrite = TRUE)
})Nous allons proposer à l’utilisateur de pouvoir lire en direct les tableaux sur cette page. Pour cela, il faut :
- Dans la partie UI : il faut matérialiser à cette place qu’il y aura un tableau à cette place avec la fonction “dataTableOutput”.
- Dans la partie Server : pour générer le tableau en HTML, il faut utiliser la fonction “renderDataTable” et la fonction “as.datatable_widget”.
Ce qui donne pour la partie UI :
# Premier tableau
DT::dataTableOutput('TAPQ1')Et pour la partie Server :
# Question 1.
output$TAPQ1 = DT::renderDataTable(
as.datatable_widget(Q1))Les deux autres pages (“TAP - Données redressées” et “TC”) se construisent sur le même modèle.
6.2. Conclusion
Nous avons programmé la première partie du Dashboard. Ces derniers reprennent les différentes analyses vu précédemment. L’article suivant permettra de visualier le résultats de ces questions.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(aws.s3)
library(dplyr)
library(expss)
library(survey)
library(openxlsx)
##### Télécharger les données + les rendres exploitables #####
#_____________________________________________________________________________________________________#
# Permettre l'accès de l'application à Amazon S3
Sys.setenv("AWS_ACCESS_KEY_ID" = "XXXXXXXXXXXXX",
"AWS_SECRET_ACCESS_KEY" = "XXXXXXXXXXXXX",
"AWS_DEFAULT_REGION" = "eu-west-3")
# Fonction pour télécharger les fichiers csv et en faire une database.
loadData <- function() {
# Get a list of all files
file_names <- get_bucket("svyapp")
# Read all files into a list
data <- lapply(file_names, function(x) {
object <- get_object(x, "svyapp")
object_data <- readBin(object, "character")
read.csv(text = object_data, sep = ";", stringsAsFactors = FALSE)
})
# Concatenate all data together into one data.frame
data <- do.call(rbind, data)
data
}
# Téléchargement des données.
survey_responses <- loadData()
# Sélection des 3 premières questions.
survey_responses <- survey_responses %>% select(Q1, Q2, Q3)
# Préparation de la database.
# Nombre de caractères en Q3.
survey_responses$Q3help <- nchar(survey_responses$Q3)
# Recode Q3A.
survey_responses$Q3A1 <- ifelse(
# S'il n'y a qu'une réponse et que cette réponse est 1: Recode 1.
survey_responses$Q3help <= 2 & survey_responses$Q3 == 1 , "1",
# S'il y a plusieurs réponses : si "1," est dedans, Recode 1.
case_when(grepl("1,", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
# Recode des autres réseaux sociaux.
survey_responses$Q3A2 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 2 , "1",
case_when(grepl("2,| 2)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A3 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 3 , "1",
case_when(grepl("3,|3)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A4 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 4 , "1",
case_when(grepl("4,|4)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A5 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 5 , "1",
case_when(grepl("5,|5)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A6 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 6 , "1",
case_when(grepl("6,|6)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A7 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 7 , "1",
case_when(grepl("7,|7)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A8 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 8 , "1",
case_when(grepl("8,|8)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A9 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 9 , "1",
case_when(grepl("9,|9)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A10 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 10 , "1",
case_when(grepl("10,|10)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A11 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 11 , "1",
case_when(grepl("11|11)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A12 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 12 , "1",
case_when(grepl("12)", survey_responses$Q3, ignore.case = TRUE) ~ "1", TRUE ~ "0"))
survey_responses$Q3A99 <- ifelse(
survey_responses$Q3help <= 2 & survey_responses$Q3 == 99 , "1", "0")
# Sélection des 3 premières questions.
survey_responses <- survey_responses %>% select(-Q3, -Q3help)
# Recode Age
survey_responses <- as.data.table(survey_responses)
survey_responses[Q2 <= 34, RecodeAge := 1]
survey_responses[Q2 >= 35 & Q2 <= 49, RecodeAge := 2]
survey_responses[Q2 >= 50 & Q2 <= 64, RecodeAge := 3]
survey_responses[Q2 >= 65, RecodeAge := 4]
# Ajout d'une colonne qui comptabilise le nombre de Réseaux Sociaux
survey_responses <- data.frame(survey_responses)
cols.num <- c("Q3A1", "Q3A2", "Q3A3", "Q3A4", "Q3A5", "Q3A6", "Q3A7", "Q3A8", "Q3A9", "Q3A10", "Q3A11", "Q3A12")
survey_responses[cols.num] <- sapply(survey_responses[cols.num],as.numeric)
sapply(survey_responses, class)
survey_responses <- compute(survey_responses, {
NbRS = sum_row(Q3A1 %to% Q3A12)
})
##### Redressement #####
#_____________________________________________________________________________________________________#
# Transformation de la question Q1 en numérique.
survey_responses <- data.frame(survey_responses)
cols.num <- c("Q1")
survey_responses[cols.num] <- sapply(survey_responses[cols.num], as.numeric)
sapply(survey_responses, class)
# Création d'un objet non redressé.
data.unweighted <- svydesign(ids=~1, data=survey_responses)
# Définition de la structure de la population.
Q1.dist <- data.frame(Q1 = c("1", "2"),
Freq = nrow(survey_responses) * c(0.476, 0.524))
RecodeAge.dist <- data.frame(RecodeAge = c("1", "2", "3", "4"),
Freq = nrow(survey_responses) * c(0.25, 0.243, 0.244, 0.263))
# Lier la strucutre de la pop à l'échantillon --> Calcul des poids
data.rake <- rake(design = data.unweighted,
sample.margins = list(~Q1, ~RecodeAge),
population.margins = list(Q1.dist, RecodeAge.dist))
# Ajouter les poids à la database
survey_responses$weight <- weights(data.rake)
# Suppression
rm(data.rake, data.unweighted, Q1.dist, RecodeAge.dist, cols.num)
##### Libellés #####
#_____________________________________________________________________________________________________#
# Adaptation des noms des variables.
survey_responses = apply_labels(survey_responses,
Q1 = "Q1 : Genre",
Q2 = "Q2 : Age",
Q3A1 = "Q3 : Facebook",
Q3A2 = "Q3 : Google +",
Q3A3 = "Q3 : Instagram",
Q3A4 = "Q3 : Linkedin",
Q3A5 = "Q3 : Periscope",
Q3A6 = "Q3 : Pinterest",
Q3A7 = "Q3 : Reddit",
Q3A8 = "Q3 : Snapchat",
Q3A9 = "Q3 : TikTok",
Q3A10 = "Q3 : Tumblr",
Q3A11 = "Q3 : Twitter",
Q3A12 = "Q3 : Viadeo",
Q3A99 = "Q3 : Aucun de ces réseaux")
# Adaptation des variables - Q1.
val_lab(survey_responses$Q1) = num_lab("
1 Homme
2 Femme ")
##### TAP #####
#_____________________________________________________________________________________________________#
# Ajout des pourcentages sur le côté gauche.
Q1 = survey_responses %>%
tab_cells(Q1) %>% # Question à traiter
tab_stat_cases(total_row_position = "above") %>% # Effectif
tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
tab_pivot(stat_position = "inside_columns") # Création de la table.
# Question numérique
Q2 = survey_responses %>%
tab_cells(Q2) %>% # Question à traiter
tab_net_cells("Moins de 35 ans" = 18:34, "35-49 ans" = 35:49, "50-64 ans" = 50:64, "65 ans et plus" = 65:80, position = "top") %>% # Sous-Totaux
tab_stat_cases(total_row_position = "above") %>% # Effectif
tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
tab_pivot(stat_position = "inside_columns") # Création de la table.
# Moyenne, max, min.
Q2m = survey_responses %>%
tab_cells(Q2) %>%
tab_stat_mean() %>%
tab_stat_max() %>%
tab_stat_min() %>%
tab_pivot() #
# Question à choix multiple.
Q3 = survey_responses %>%
tab_cells(mdset(Q3A1%to%Q3A99)) %>% # Question à traiter
tab_stat_cases(total_row_position = "above") %>% # Effectif
tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
tab_pivot(stat_position = "inside_columns") # Création de la table.
# Moyenne, max, min. du nombre de réponse
Q3m = survey_responses %>%
tab_cells(NbRS) %>%
tab_stat_mean() %>%
tab_stat_max() %>%
tab_stat_min() %>%
tab_pivot() #
##### TAP Redressé #####
#_____________________________________________________________________________________________________#
# TAP redressé.
Q1r = survey_responses %>%
tab_cells(Q1) %>% # Question à traiter
tab_weight(weight) %>% # Prise en compre des poids.
tab_stat_cases(total_row_position = "above") %>% # Effectif
tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
tab_pivot(stat_position = "inside_columns") # Création de la table.
Q2r = survey_responses %>%
tab_cells(Q2) %>% # Question à traiter
tab_weight(weight) %>% # Prise en compre des poids.
tab_net_cells("Moins de 35 ans" = 18:34, "35-49 ans" = 35:49, "50-64 ans" = 50:64, "65 ans et plus" = 65:80, position = "top") %>% # Sous-Totaux
tab_stat_cases(total_row_position = "above") %>% # Effectif
tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
tab_pivot(stat_position = "inside_columns") # Création de la table.
Q2mr = survey_responses %>%
tab_cells(Q2) %>%
tab_weight(weight) %>%
tab_stat_mean() %>%
tab_stat_max() %>%
tab_stat_min() %>%
tab_pivot() #
Q3r = survey_responses %>%
tab_cells(mdset(Q3A1%to%Q3A99)) %>% # Question à traiter
tab_weight(weight) %>% # Prise en compre des poids.
tab_stat_cases(total_row_position = "above") %>% # Effectif
tab_stat_cpct(total_statistic="u_cpct", total_row_position = "above") %>% # Pourcentage
tab_pivot(stat_position = "inside_columns") # Création de la table.
Q3mr = survey_responses %>%
tab_cells(NbRS) %>%
tab_weight(weight) %>%
tab_stat_mean() %>%
tab_stat_max() %>%
tab_stat_min() %>%
tab_pivot()
##### TC #####
#_____________________________________________________________________________________________________#
# Adaptation des variables - Recode Age
val_lab(survey_responses$RecodeAge) = num_lab("
1 Moins de 35 ans
2 35-49 ans
3 50-64 ans
4 65 ans et plus")
# Création d'une table croisée - Significativité 2 par 2:
TC1 = survey_responses %>%
tab_cells(mdset(Q3A1%to%Q3A99)) %>%
tab_cols(total(), Q1, RecodeAge) %>% # Colonne.
tab_weight(weight) %>% # Prise en compre des poids.
tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
tab_last_sig_cpct() %>%
tab_pivot()
# Création d'une table croisée - Significativité avec la première colonne.
TC2 = survey_responses %>%
tab_significance_options (compare_type = "first_column") %>%
tab_cells(mdset(Q3A1%to%Q3A99)) %>%
tab_cols(total(), Q1, RecodeAge) %>% # Colonne.
tab_weight(weight) %>% # Prise en compre des poids.
tab_stat_cpct(total_statistic = c("u_cases", "w_cases"), total_row_position = "above") %>% # Pourcentage avec total brute/redressé
tab_last_sig_cpct() %>%
tab_pivot()
##### app.R #####
#_____________________________________________________________________________________________________#
ui <- dashboardPage(
# Titre du Dashboard
dashboardHeader(title = "Su-R-vey"),
# Barre de menu à gauche
dashboardSidebar(
# Différents onglets:
sidebarMenu(
menuItem("Terrain", tabName = "terrain", icon = icon("dashboard")),
menuItem("TAP", icon = icon("table"), tabName = "tap",
menuSubItem("Données brutes", icon = icon("table"), tabName = "db"),
menuSubItem("Données redressées", icon = icon("table"), tabName = "dr")),
menuItem("TC", icon = icon("table"), tabName = "tc"),
menuItem("Graphiques", icon = icon("chart-bar"), tabName = "chart")
)),
# Construction des différentes pages.
dashboardBody(
tabItems(
#### Page "Terrain" ####
tabItem(tabName = "terrain",
# Titre de la page
h2("Suivi du Terrain"),
br(),
# Progression global du terrain
progressBar(id = "gobalprogress",
value = nrow(survey_responses),
total = 1000,
title = "Avancement du terrain",
display_pct = TRUE),
br(),
h2("Suivi des quotas"),
br(),
h4("Genre"),
# Progression quota
# Genre
progressBar(id = "hommeprogress",
value = sum(survey_responses$Q1 == 1),
total = 480,
title = "Homme",
display_pct = TRUE),
progressBar(id = "femmeprogress",
value = sum(survey_responses$Q1 == 2),
total = 520,
title = "Femme",
display_pct = TRUE),
br(),
h4("Age"),
# Progression quota Age
progressBar(id = "1834",
value = sum(survey_responses$RecodeAge == 1),
total = 250,
title = "18-34 ans",
display_pct = TRUE),
progressBar(id = "3549",
value = sum(survey_responses$RecodeAge == 2),
total = 243,
title = "35-49 ans",
display_pct = TRUE),
progressBar(id = "5064",
value = sum(survey_responses$RecodeAge == 3),
total = 244,
title = "50-64 ans",
display_pct = TRUE),
progressBar(id = "65plus",
value = sum(survey_responses$RecodeAge == 4),
total = 263,
title = "65 ans et plus",
display_pct = TRUE),
),
##### Page "TAP - Données Brutes" #####
tabItem(tabName = "db",
h2("Tris A Plat - Données Brutes"),
br(),
#Bouton pour télécharger en Excel
downloadButton("tapbrute", "Télécharger le TAP"),
br(),
br(),
# Premier tableau
DT::dataTableOutput('TAPQ1'),
br(),
# Question suivantes
DT::dataTableOutput('TAPQ2'),
br(),
DT::dataTableOutput('TAPQ2m'),
br(),
DT::dataTableOutput('TAPQ3'),
br(),
DT::dataTableOutput('TAPQ3m')
),
##### Page "TAP - Données redressées" #####
tabItem(tabName = "dr",
h2("Tris A Plat - Données Redressées"),
br(),
#Bouton pour télécharger en Excel
downloadButton("tapred", "Télécharger le TAP"),
br(),
br(),
# Premier tableau
DT::dataTableOutput('TAPQ1r'),
br(),
# Question suivantes
DT::dataTableOutput('TAPQ2r'),
br(),
DT::dataTableOutput('TAPQ2mr'),
br(),
DT::dataTableOutput('TAPQ3r'),
br(),
DT::dataTableOutput('TAPQ3mr')),
##### Page "TC" #####
tabItem(tabName = "tc",
h2("Tris Croisé"),
br(),
#Bouton pour télécharger en Excel
downloadButton("tct", "Télécharger le TC"),
br(),
br(),
DT::dataTableOutput('TC1'),
br(),
# Question suivantes
DT::dataTableOutput('TC2'),
br()),
##### Page "Graphiques" #####
tabItem(tabName = "chart",
h2("Graphiques"),
br()
))))
server <- function(input, output) {
##### TAP - Données Brutes - Server #####
# Question 1.
output$TAPQ1 = DT::renderDataTable(
as.datatable_widget(Q1))
# Question 2.
output$TAPQ2 = DT::renderDataTable(
as.datatable_widget(Q2))
output$TAPQ2m = DT::renderDataTable(
as.datatable_widget(Q2m))
# Question 3.
output$TAPQ3 = DT::renderDataTable(
as.datatable_widget(Q3))
output$TAPQ3m = DT::renderDataTable(
as.datatable_widget(Q3m))
# Téléchargement du TAP via Excel.
wb = createWorkbook()
sh = addWorksheet(wb, "Tables")
list_of_datasets <- list(Q1, Q2, Q2m, Q3, Q3m)
xl_write(list_of_datasets, wb, sh)
saveWorkbook(wb, "TAP.xlsx", overwrite = TRUE)
output$tapbrute <- downloadHandler(
filename = function() {
paste0("TAP Données brutes", ".xlsx")
},
content = function(file) {
saveWorkbook(wb, file = file, overwrite = TRUE)
})
##### TAP - Données Redressées - Server #####
# Question 1.
output$TAPQ1r = DT::renderDataTable(
as.datatable_widget(Q1r))
# Question 2.
output$TAPQ2r = DT::renderDataTable(
as.datatable_widget(TC2))
# Téléchargement du TAP via Excel.
wb = createWorkbook()
sh = addWorksheet(wb, "Tables")
list_of_datasets2 <- list(Q1r, Q2r, Q2mr, Q3r, Q3mr)
xl_write(list_of_datasets2, wb, sh)
saveWorkbook(wb, "TAP.xlsx", overwrite = TRUE)
output$tapred <- downloadHandler(
filename = function() {
paste0("TAP Données redressées", ".xlsx")
},
content = function(file) {
saveWorkbook(wb, file = file, overwrite = TRUE)
})
##### TC - Server #####
# Question 1.
output$TC1 = DT::renderDataTable(
as.datatable_widget(TC1))
# Question 2.
output$TC2 = DT::renderDataTable(
as.datatable_widget(TC2))
# Téléchargement du TAP via Excel.
wb = createWorkbook()
sh = addWorksheet(wb, "Tables")
list_of_datasets3 <- list(TC1, TC2)
xl_write(list_of_datasets3, wb, sh)
saveWorkbook(wb, "TC.xlsx", overwrite = TRUE)
output$tct <- downloadHandler(
filename = function() {
paste0("Tris Croisés", ".xlsx")
},
content = function(file) {
saveWorkbook(wb, file = file, overwrite = TRUE)
})
}
shinyApp(ui, server)