Private_Personal_Projects
/
PlatStat
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Téléverser les fichiers vers "/"

This commit is contained in:
aslane 2024-01-18 21:48:06 +00:00
commit b3a27ffb76
5 changed files with 6132 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

905
app.R Normal file
View File

@ -0,0 +1,905 @@
library(shinythemes)
library (DT)
library(ggplot2)
library(gridExtra)
library(emmeans)
library(readxl)
library(dplyr)
library(officer)
library(car)
library(factoextra)
library(shinylogs)
library(plotly)
ui <- fluidPage(
theme = shinytheme("readable"),
navbarPage(
"Stat Plateform",
tabPanel("Accueil",
fluidRow(
column(4,
wellPanel(
fileInput("files", "Sélectionnez les fichiers Excel (xlsx) :", multiple = TRUE)
)
),
column(8,
wellPanel(
style = 'overflow-x: scroll;height: 450px;',
DT::dataTableOutput("merged_data_table")
)
)
),
wellPanel(
selectInput("ignore_columns", "Colonnes à ignorer :", multiple = TRUE, choices = NULL),
selectInput("cat_columns", "Colonnes catégorielles :", multiple = TRUE, choices = NULL),
selectInput("cat_id", "Colonne permettant d'identifier les populations :", multiple = FALSE, choices = NULL,selected = "Source"),
actionButton("analyze_button", "Analyse statistique",class="btn-primary"),
)
),
navbarMenu("Analyse",
tabPanel("Test de Shapiro",
DT::dataTableOutput("shapiro_table")
),
tabPanel("Test de Student",
DT::dataTableOutput("student_table")
),
tabPanel("Test de Welch",
DT::dataTableOutput("welch_table")
),
tabPanel("Test de Wilcoxon",
DT::dataTableOutput("wilcoxon_table")
),
tabPanel("ANOVA",
fluidRow(
column(4,
wellPanel(
selectInput("var_expliquees","Choisir les variables à expliquer",multiple = TRUE,choices = NULL),
selectInput("var_explicatives","Choisir les variables explicative",multiple = TRUE,choices = NULL),
actionButton("anova_button", "ANOVA",class="btn-primary"),
)
),
column(8,
wellPanel(
style = 'overflow-x: scroll;height: 450px;',
DT::dataTableOutput("anova_table")
)
)
)
),
tabPanel("Test de Krustal-Wallis",
DT::dataTableOutput("kw_table")
),
tabPanel("Test de Fisher",
DT::dataTableOutput("fisher_table")
),
tabPanel("Test de Levene",
DT::dataTableOutput("levene_table")
),
tabPanel("Test de Barlett",
DT::dataTableOutput("barlett_table")
),
tabPanel("Khi 2",
DT::dataTableOutput("khi2_table")
),
tabPanel("Tous les tests",
DT::dataTableOutput("test_table")
),
tabPanel("Rapport",
h3("Résultats des tests statistiques"),
fluidRow(
column(2,
fluidRow(
wellPanel(
h3("Télécharger le rapport :"),
downloadButton("downloadWord", "Download Word Document",class="btn-primary")
)
)
)
)
)
),
tabPanel("Graphique",
column(3,
wellPanel(
h2('Analyse Statistique'),
selectInput("dataset_graph", "dataset_graph à prendre", multiple = FALSE, choices = c("cars","airquality","iris")),
selectInput("type_graph", "Type de graphique", multiple = FALSE, choices = c("Barplot","Boxplot","Density plot","Histograme","Scatterplot")),
selectInput("graph_x", "X", multiple = FALSE, choices = NULL),
selectInput("graph_y", "Y", multiple = FALSE, choices = NULL),
selectInput("graph_fill", "Fill", multiple = FALSE, choices = NULL),
)
),
column(9,
fluidRow(
wellPanel(
plotlyOutput("graph_graph"),
)
)
)
),
tabPanel("Instructions",
fluidRow(
column(8,
includeMarkdown("README.md")
)
)
),
navbarMenu("Modèles",
tabPanel("Modèles classiques",
column(3,
wellPanel(
h2('ACP'),
selectInput("acp_col", "Numerical Columns", multiple = TRUE, choices = NULL),
actionButton("acp_button", "ACP",class="btn-primary"),
),
wellPanel(
h2('PLS'),
selectInput("pls_x", "X", multiple = TRUE, choices = NULL),
selectInput("pls_y", "Y", multiple = FALSE, choices = NULL),
actionButton("pls_button", "PLS",class="btn-primary")
)
),
column(9,
fluidRow(
wellPanel(
plotlyOutput("plotly_acp_graph")
),
wellPanel(
plotlyOutput("pls_acp_graph°")
)
)
)
),
tabPanel("Régression logistique"),
tabPanel("Modèle Mixte"),
),
)
)
server <- function(input, output, session) {
track_usage(
storage_mode = store_null()
)
convertToFactor <- function(data, columns) {
for (col in columns) {
data[[col]] <- as.factor(data[[col]])
}
return(data)
}
# Partie permettant de fusionner les fichiers
merged_data <- eventReactive(input$files, {
# On lit la liste des fichiers et on les fusionne
tables <- lapply(input$files$datapath, function(datapath) {
data <- read_excel(datapath)
filename <- input$files$name[input$files$datapath == datapath]
filename <- substr(filename,1,nchar(filename)-5)
data$Source <- filename # Ajoutez une colonne 'Source' avec le nom du fichier
return(data)
})
concatenated_table <- bind_rows(tables)
concatenated_table <- concatenated_table[,colSums(is.na(concatenated_table))==0]
return(concatenated_table)
})
#On sélectionne les colonnes à ignorer
observe({
if (!is.null(merged_data())) {
updateSelectInput(session, "ignore_columns",
choices = colnames(merged_data()), selected = NULL)
}
})
#On sélectionne les colonnes numériques
observe({
updateSelectInput(session, "cat_columns",
choices = setdiff(colnames(merged_data()),input$ignore_columns), selected = "Source")
})
#On utilise une fonction permettant d'obternir la liste des variables numériques
num_columns <- eventReactive(input$cat_columns,{
a <- colnames(merged_data())
a <- setdiff(a,input$ignore_columns)
a <- setdiff(a,input$cat_columns)
return(a)
})
#On utilise une fonction permettant d'obternir la liste des variables cat
cat_col <- eventReactive(input$cat_columns,{
return(input$cat_columns)
})
#On utilise une fonction permettant d'obternir la liste des variables
columns <- eventReactive(input$analyze_button,{
a <- colnames(merged_data())
a <- setdiff(a,input$ignore_columns)
return(a)
})
observe({
updateSelectInput(session, "cat_id",
choices = cat_col(), selected = "Source")
})
cat_id <- eventReactive(input$cat_id,{
return(input$cat_id)
})
observe({
updateSelectInput(session,"var_expliquees",choices=colnames(merged_data()))
})
explicative_col <- eventReactive(input$files,{
return(input$var_expliquees)
})
#On utilise une fonction permettant d'obtenir la liste des différentes sources
liste_source <- eventReactive(input$cat_id,{
return(unique(merged_data()[[input$cat_id]]))
})
# Afficher les résultats de la fusion dans une table
output$merged_data_table <- renderDataTable(merged_data(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
#=============================================================================
#Cette partie gère la partie "Graphiques"
observe({
if (!is.null(cat_id())){
updateSelectInput(session,"dataset_graph",
choices = c("cars","airquality","iris","All data"))
}
})
data <- eventReactive(input$dataset_graph,{
cat_id <- cat_id()
if (input$dataset_graph == 'cars') {
return(datasets::cars)
}
if (input$dataset_graph == "airquality"){
return(datasets::airquality)
}
if (input$dataset_graph == "iris"){
return(datasets::iris)
}
if (input$dataset_graph %in% liste_source()){
return(as.data.frame(merged_data()[merged_data()[[cat_id]]==input$dataset_graph,columns()]))
}
if (input$dataset_graph == 'All data') {
return(merged_data())
}
})
observe({
updateSelectInput(session,"graph_x", choices = colnames(data()))
updateSelectInput(session,"graph_y", choice = colnames(data()))
updateSelectInput(session,"graph_fill", choices = c(colnames(data())))
})
observeEvent("graph_x",{
output$graph_graph <- renderPlotly({
if (input$type_graph == 'Barplot'){
p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='bar')
p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y),legend=list(title=list(text=input$graph_fill)))
return(p)
return(ggplotly(p))
}
if (input$type_graph == 'Boxplot'){
p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='box')
p <- p %>% layout(boxmode = "group", xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y),coloraxis=list(title=input$graph_fill))
return(p)
}
if (input$type_graph == 'Density plot'){
p <- ggplot(data(), aes_string(x=input$graph_x)) +
geom_density()
return(ggplotly(p))
}
if (input$type_graph == 'Histograme'){
p <- ggplot(data(), aes_string(x=input$graph_x,color=input$graph_fill)) +
geom_histogram()
return(ggplotly(p))
}
if (input$type_graph == 'Scatterplot'){
p <- plot_ly(data = data(),x=~get(input$graph_x),y=~get(input$graph_y),color=~get(input$graph_fill),type='scatter')
p <- p %>% layout(xaxis=list(title=input$graph_x),yaxis=list(title=input$graph_y),legend=list(title=list(text=input$graph_fill)))
return(p)
}
})
})
#=============================================================================
#Cette partie gère l'analyse des données
shapiro_table <- eventReactive(input$files,{
num_col <- num_columns()
shapiro <- data.frame()
merged_data <- merged_data()
for (col in num_col){
tryCatch({
a <- shapiro.test(as.numeric(merged_data[[col]]))
shapiro <- rbind(shapiro,c(col,"","Shapiro",a$p.value))
colnames(shapiro) <- c("Column","Classe","Test","p-value")
},
error=function(e) {
print(co)
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
},
warning=function(w) {
message('A Warning Occured')
print(w)
return(NA)
})
}
return(shapiro)
})
output$shapiro_table <- renderDataTable(shapiro_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
student_table <- eventReactive(input$files,{
num_col <- num_columns()
cat_col <- input$cat_columns
merged_data <- merged_data()
student_table <- data.frame()
cat_id <- input$cat_id
for (cat in cat_col) {
for (clas in unique(merged_data()[[cat]])){
for (col in num_col) {
tryCatch({
x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col])
y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col])
if (length(x) >0 & length(y) > 0){
a = c(t.test(x,y))
student_table <- rbind(student_table,c(col,paste(cat,'-',clas),"Student",a$p.value))
colnames(student_table) <- c("Column","Classe","Test","p-value")
}
},
error=function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
},
warning=function(w) {
message('A Warning Occured')
print(w)
return(NA)
})
}
}
}
return(student_table)
})
output$student_table <- renderDataTable(student_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
welch_table <- eventReactive(input$files,{
num_col <- num_columns()
cat_col <- input$cat_columns
merged_data <- merged_data()
welch_table <- data.frame()
cat_id <- input$cat_id
for (cat in cat_col) {
for (clas in unique(merged_data()[[cat]])){
for (col in num_col) {
tryCatch({
x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col])
y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col])
if (length(x) >0 & length(y) > 0){
a = c(t.test(x,y,var.equal=FALSE))
welch_table <- rbind(welch_table,c(col,paste(cat,'-',clas),"Welch",a$p.value))
colnames(welch_table) <- c("Column","Classe","Test","p-value")
}
},
error=function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
},
warning=function(w) {
message('A Warning Occured')
print(w)
return(NA)
})
}
}
}
return(welch_table)
})
output$welch_table <- renderDataTable(welch_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
wilcoxon_table <- eventReactive(input$files,{
num_col <- num_columns()
cat_col <- input$cat_columns
merged_data <- merged_data()
wilcoxon_table <- data.frame()
cat_id <- input$cat_id
for (cat in cat_col) {
for (clas in unique(merged_data()[[cat]])){
for (col in num_col) {
tryCatch({
x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col])
y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col])
if (length(x) >0 & length(y) > 0){
a = c(wilcox.test(x,y))
wilcoxon_table <- rbind(wilcoxon_table,c(col,paste(cat,'-',clas),"Wilcoxon",a$p.value))
colnames(wilcoxon_table) <- c("Column","Classe","Test","p-value")
}
},
error=function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
},
warning=function(w) {
message('A Warning Occured')
print(w)
return(NA)
})
}
}
}
return(wilcoxon_table)
})
output$wilcoxon_table <- renderDataTable(wilcoxon_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
fisher_table <- eventReactive(input$files,{
num_col <- num_columns()
cat_col <- input$cat_columns
merged_data <- merged_data()
fisher_table <- data.frame()
cat_id <- input$cat_id
for (cat in cat_col) {
for (clas in unique(merged_data()[[cat]])){
for (col in num_col) {
tryCatch({
x = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[1]),], !!sym(cat) == clas)[,col])
y = pull(filter(merged_data[merged_data[[cat_id]]==(liste_source()[2]),], !!sym(cat) == clas)[,col])
if (length(x) >0 & length(y) > 0){
a = c(var.test(x,y))
fisher_table <- rbind(fisher_table,c(col,paste(cat,'-',clas),"Fisher",a$p.value))
colnames(fisher_table) <- c("Column","Classe","Test","p-value")
}
},
error=function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
},
warning=function(w) {
message('A Warning Occured')
print(w)
return(NA)
})
}
}
}
return(fisher_table)
})
output$fisher_table <- renderDataTable(fisher_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
levene_table <- eventReactive(input$files, {
num_col <- num_columns()
cat_col <- input$cat_columns
merged_data <- merged_data()
levene_table <- data.frame()
cat_id <- input$cat_id
for (cat in cat_col) {
for (num_column in num_col) {
levene_result <- tryCatch({
formula <- formula(paste(num_column, "~", cat))
a <- leveneTest(formula, data = merged_data)
return(a)
},
error = function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
return(NULL)
},
warning = function(w) {
message('A Warning Occured')
print(w)
formula <- formula(paste(num_column, "~", cat))
a <- leveneTest(formula, data = merged_data)
return(a)
})
if (!is.null(levene_result)) {
levene_result["Column"] = num_column
levene_result["Catégorie"] = cat
levene_result["Test"] = "Levene"
levene_table <- rbind(levene_table, levene_result)
}
}
}
rownames(levene_table) <- c(1:nrow(levene_table))
return(levene_table)
})
output$levene_table <- renderDataTable(levene_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
anova_table <- eventReactive(input$analyze_button,{
cat_col <- input$cat_columns
num_col <- num_columns()
anova_table = data.frame()
merged_data <- merged_data()
cat_id <- input$cat_id
for (cat in cat_col) {
for (col in num_col) {
tryCatch({
formula <- formula(paste(col, "~", cat, "*",cat_id()))
model <- lm(formula, data = na.omit(merged_data))
anova_result <- Anova(model)
anova_result <- as.data.frame(cbind(rownames(anova_result),anova_result))
anova_result["Col"] <- col
anova_result["Cat"] <- cat
anova_table <- rbind(anova_table,anova_result)
},
error=function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
},
warning=function(w) {
message('A Warning Occured')
print(w)
return(NA)
})
}
}
colnames(anova_table) <- c("Nom colonne","Sum Sq","Degré Df","F-value","Pr(>F)","Colonne","Catégorie")
rownames(anova_table) <- c(1:nrow(anova_table))
return(anova_table)
})
output$anova_table <- renderDataTable(anova_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
kw_table <- eventReactive(input$analyze_button,{
cat_col <- input$cat_columns
num_col <- num_columns()
kw_table = data.frame()
cat_id <- input$cat_id
for (cat in cat_col) {
for (col in num_col) {
tryCatch({
kruskal_test <- kruskal.test(merged_data()[[col]]~interaction(merged_data()[[cat]], merged_data()[[cat_id()]]))
kw_table <- rbind(kw_table,c(col,cat,"KW",kruskal_test$p.value))
colnames(kw_table) <-c("Column","Classe","Test","p-value")
},
error=function(e) {
message('An Error Occurred')
cat("Erreur :", conditionMessage(e), "\n")
traceback()
},
warning=function(w) {
message('A Warning Occured')
print(w)
kruskal_test <- kruskal.test(merged_data()[[col]]~interaction(merged_data()[[cat]], merged_data()[[cat_id()]]))
kw_table <- rbind(kw_table,c(col,cat,"KW",kruskal_test$p.value))
colnames(kw_table) <-c("Column","Classe","Test","p-value")
})
}
}
return(kw_table)
})
output$kw_table <- renderDataTable(kw_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
khi2_table <- eventReactive(input$files,{
cat_col <- input$cat_columns
num_col <- num_columns()
khi2_table = data.frame()
merged_data <- merged_data()
cat_id <- input$cat_id
liste_source <- liste_source()
for (i in 1:(length(cat_col)-1)){
for (j in (i+1):length(cat_col)){
table_croisee <- table(merged_data[[cat_col[[i]]]],merged_data[[cat_col[[j]]]])
a <- chisq.test(table_croisee)
khi2_table <- rbind(khi2_table,c(cat_col[i],cat_col[j],"Khi 2",a$p.value))
}
}
colnames(khi2_table) <- c("Column","Classe","Test","p-value")
return(khi2_table)
})
output$khi2_table <- renderDataTable(khi2_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
test_table <- eventReactive(input$files,{
test_table <- data.frame()
test_table <- rbind(shapiro_table(),student_table(),welch_table(),wilcoxon_table(),fisher_table())
return(test_table)
})
output$test_table <- renderDataTable(test_table(),
options = list(
pageLength = 10,
autoWidth = TRUE,
lengthMenu = list(c(10,50,100, -1), c("10","50","100", "All"))
)
)
#On gère ici la partie contrasts du test d'emmeans
contrasts_result <- eventReactive(input$analyze_button, {
cat_col <- input$cat_columns
num_col <- num_columns()
result_contrasts <- data.frame()
cat_id <- input$cat_id
merged_data <- convertToFactor(merged_data(), cat_col)
for (cat in cat_col) {
num_levels <- nlevels(merged_data[[cat]])
if (num_levels <= 1) {
warning(paste("The factor", cat, "has only", num_levels, "level(s) and cannot be contrasted."))
} else {
for (col in num_col) {
formula <- formula(paste(col, "~", cat, "*Source"))
model <- lm(formula, data = na.omit(merged_data))
post_hoc <- emmeans(model, pairwise ~ Source, by = cat)
result_contrasts <- append(result_contrasts, post_hoc$contrasts)
}
}
}
return(result_contrasts)
})
#On gère ici l'autre partie du test d'emmeans
emmeans_result <- eventReactive(input$analyze_button,{
cat_col <- input$cat_columns
num_col <- num_columns()
result_emmeans = data.frame()
merged_data <- convertToFactor(merged_data(), cat_col)
cat_id <- input$cat_id
for (cat in cat_col) {
num_levels <- nlevels(merged_data[[cat]])
if (num_levels <= 1) {
warning(paste("The factor", cat, "has only", num_levels, "level(s) and cannot be contrasted."))
} else {
for (col in num_col) {
formula <- formula(paste(col, "~", cat, "*Source"))
model <- lm(formula, data = na.omit(merged_data))
post_hoc <- emmeans(model, pairwise~Source, by=cat)
result_emmeans <- append(result_emmeans,post_hoc$emmeans)
}
}
}
return(result_emmeans)
})
#Cette partie permet de générer le .docx contenant le rapport
output$downloadWord <- downloadHandler(
filename = function() {
paste("stat_rapport.docx", sep = "")
},
content = function(file) {
cat_col <- input$cat_columns
num_col <- num_columns()
result <- test_table()
result_anova <- anova_table()
result_kw <- kw_table()
result_contrasts <- contrasts_result()
result_emmeans <- emmeans_result()
# Créer un document Word
doc <- read_docx()
# Ajouter un titre
doc <- body_add_par(doc,"Analysis Report", style="heading 1")
for (c in unique(result$Column)){
# Ajouter un sous-titre
msg <- paste("Column analysis :",c)
doc <- body_add_par(doc,msg, style="heading 2")
for (test in unique(result[result$Column==c,"Test"])){
msg_test <- paste("Test :",test)
doc <- body_add_par(doc,msg_test, style="heading 3")
doc <-body_add_table(doc,result[result$Column==c&result$Test == test,])
}
}
doc <- body_add_break(doc, pos = "after")
doc <- body_add_par(doc,"ANOVA result",style="heading 2")
for (i in 1:7) {
doc <- body_add_par(doc,num_col[i],style="heading 3")
doc <- body_add_table(doc,as.data.frame(result_anova[result_anova$Col==num_col[i],]))
doc <- body_add_par(doc," ")
doc <- body_add_par(doc," ")
}
doc <- body_add_break(doc, pos = "after")
doc <- body_add_par(doc,"Emmeans result",style="heading 2")
for (i in 1:7) {
doc <- body_add_par(doc,c,style="heading 3")
doc <- body_add_table(doc,as.data.frame(result_emmeans[i]))
doc <- body_add_par(doc," ")
doc <- body_add_par(doc," ")
}
doc <- body_add_break(doc, pos = "after")
doc <- body_add_par(doc,"KW Result",style="heading 2")
doc <- body_add_table(doc,as.data.frame(result_kw))
# Écrire le document Word dans un fichier
print(doc, target = file)
}
)
#=============================================================================
#Cette partie gère la partie "Modèles classiques"
observe({
updateSelectInput(session, "acp_col", choices = num_columns())
updateSelectInput(session, "pls_x", choices = num_columns())
updateSelectInput(session, "pls_y", choices = num_columns())
})
observeEvent(input$acp_button,{
output$plotly_acp_graph <- renderPlotly({
acp_data <- merged_data()[, input$acp_col]
res.pca <- prcomp(acp_data, scale = TRUE)
pl <- fviz_pca_ind(
res.pca,
col.ind = merged_data()[["Source"]], # Color by the quality of representation
repel = TRUE, # Avoid text overlapping
label = "None"
) + scale_color_discrete()
# Convertir le graphique ggplot2 en graphique plotly
pl <- ggplotly(pl)
return(pl)
})
})
observeEvent(input$pls_button,{
output$plotly_acp_graph <- renderPlotly({
acp_data <- merged_data()[, input$acp_col]
res.pca <- prcomp(acp_data, scale = TRUE)
pl <- fviz_pca_ind(
res.pca,
col.ind = merged_data()[["Source"]], # Color by the quality of representation
repel = TRUE, # Avoid text overlapping
label = "None"
) + scale_color_discrete()
# Convertir le graphique ggplot2 en graphique plotly
pl <- ggplotly(pl)
return(pl)
})
})
}
shinyApp(ui, server)

BIN
arbre1.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 662 KiB

BIN
arbre2.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 399 KiB

BIN
example_document.docx Normal file
View File

Binary file not shown.

5227
my_dataset.csv Normal file
View File

File diff suppressed because it is too large Load Diff