How can I run a Shiny application to generate ggtern ternary diagrams (R), displaying the variables directly as soon as the CSV file is loaded?

43 views Asked by At

I'm trying to generate different ggtern ternary diagrams with a Shiny application. However, it doesn't work anymore as soon as I try to display directly the choice of variables in my CSV file as soon as it's loaded. When I try to run the application, it closes and I get the following error message:

Error in server(...) : objet 'data_selected' introuvable

Here's my script:

# Installer les packages nécessaires s'ils ne sont pas déjà installés
if (!require(shiny)) install.packages("shiny")
if (!require(ggtern)) install.packages("ggtern")
if (!require(plyr)) install.packages("plyr")
if (!require(dplyr)) install.packages("dplyr")

# Charger les packages
library(shiny)
library(ggtern)
library(plyr)
library(dplyr)

# Définir l'interface utilisateur
ui <- fluidPage(
  titlePanel("Diagramme Ternaire"),
  # Sidebar
  sidebarLayout(
    sidebarPanel(
      "Générer le Diagramme Ternaire",
      width = 2,
      fileInput("dataFile", "Choisir le fichier CSV"),
      selectInput("xVar", "Variable x:", choices = NULL),
      selectInput("yVar", "Variable y:", choices = NULL),
      selectInput("zVar", "Variable z:", choices = NULL),
      actionButton("generatePlot", "Générer le Diagramme ternaire"),
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("Diagramme ternaire",
                 plotOutput("ternaryPlot")
        ),
        tabPanel("Diagramme ternaire 3 zones",
                 plotOutput("ternaryPlot3")
        ),
        tabPanel("Diagramme ternaire 4 zones",
                 plotOutput("ternaryPlot4")
        ),
        tabPanel("Diagramme ternaire 10 zones",
                 plotOutput("ternaryPlot10")
        ),
        tabPanel("Afficher le Jeu de Données",
                 tableOutput("dataTable")
        )
      )
    )
  )
)

# Définir le serveur
server <- function(input, output, session) {
  # Charger le fichier CSV en réaction au bouton "dataFile"
  data <- reactive({
    req(input$dataFile)
    df <- read.csv(input$dataFile$datapath, header = TRUE, sep = ",")
    
    # Mise à jour des choix initiaux des selectInput
    updateSelectInput(session, "xVar", choices = colnames(df))
    updateSelectInput(session, "yVar", choices = colnames(df))
    updateSelectInput(session, "zVar", choices = colnames(df))
    
    return(df)
  })
  
  observeEvent(input$dataFile, {
    # Obtenir la liste des noms de variables du fichier CSV
    var_names <- colnames(data())
  
    # Mettre à jour la liste des variables dans l'élément uiOutput
    output$variableList <- renderUI({
     selectInput("selectedVars", "Sélectionnez les variables:", choices = var_names, multiple = TRUE)
    })  
  })  
      
    # Créer les points du diagramme
    points1 <- data.frame(
      rbind(
        c(1,1.000,0.000,0.000),
        c(2,0.000,1.000,0.000),
        c(3,0.000,0.000,1.000)
      )
    )
    colnames(points1)=c("IDPoint","T","L","R")
    
    # Attribuer à chaque polygone un nombre et une étiquette
    polygon.labels1 <- data.frame(Label1=c("X"))
    polygon.labels1$IDLabel=1:nrow(polygon.labels1)
    
    # Créer une carte des polygones
    polygons1 <- data.frame(
      rbind(
        c(1,1),c(1,2),c(1,3),c(2,3)
      )
    )
    polygons1$PointOrder <- 1:nrow(polygons1)
    colnames(polygons1)=c("IDLabel","IDPoint","PointOrder")
    
    # Fusionner les trois précédents sets en un seul
    df1 <- merge(polygons1,points1)
    df1 <- merge(df1,polygon.labels1)
    df1 <- df1[order(df1$PointOrder),]
    
    # Déterminer les données des étiquettes
    Labs1=ddply(df1,"Label1",function(x){c(c(mean(x$T),mean(x$L),mean(x$R)))})
    colnames(Labs1)=c("Label","T","L","R")
    
    # Créer les points du diagramme 3
    points3 <- data.frame(
      rbind(
        c(1,1.000,0.000,0.000),
        c(2,0.500,0.500,0.000),
        c(3,0.500,0.000,0.500),
        c(4,0.500,0.500,0.500),
        c(5,0.000,1.000,0.000),
        c(6,0.000,0.500,0.500),
        c(7,0.000,0.000,1.000)
      )
    )
    colnames(points3)=c("IDPoint","T","L","R")
    
    # Attribuer à chaque polygone un nombre et une étiquette
    polygon.labels3 <- data.frame(Label3=c("X","Y","Z"))
    polygon.labels3$IDLabel=1:nrow(polygon.labels3)
    
    # Créer une carte des polygones
    polygons3 <- data.frame(
      rbind(
        c(1,1),c(1,2),c(1,4),c(1,3),
        c(2,2),c(2,4),c(2,6),c(2,5),
        c(3,3),c(3,7),c(3,6),c(3,4)
      )
    )
    polygons3$PointOrder <- 1:nrow(polygons3)
    colnames(polygons3)=c("IDLabel","IDPoint","PointOrder")
    
    # Fusionner les trois précédents sets en un seul
    df3 <- merge(polygons3,points3)
    df3 <- merge(df3,polygon.labels3)
    df3 <- df3[order(df3$PointOrder),]
    
    # Déterminer les données des étiquettes
    Labs3=ddply(df3,"Label3",function(x){c(c(mean(x$T),mean(x$L),mean(x$R)))})
    colnames(Labs3)=c("Label","T","L","R")
    
    # Créer les points du diagramme 4
    points4 <- data.frame(
      rbind(
        c(1,1.000,0.000,0.000),
        c(2,0.500,0.500,0.000),
        c(3,0.500,0.000,0.500),
        c(4,0.000,1.000,0.000),
        c(5,0.000,0.500,0.500),
        c(6,0.000,0.000,1.000)
      )
    )
    colnames(points4)=c("IDPoint","T","L","R")
    
    # Attribuer à chaque polygone un nombre et une étiquette
    polygon.labels4 <- data.frame(Label4=c("X","XYZ","Z","Y"))
    polygon.labels4$IDLabel=1:nrow(polygon.labels4)
    
    # Créer une carte des polygones
    polygons4 <- data.frame(
      rbind(
        c(1,1),c(1,2),c(1,3),
        c(2,2),c(2,5),c(2,3),
        c(3,3),c(3,5),c(3,6),
        c(4,4),c(4,5),c(4,2)
      )
    )
    polygons4$PointOrder <- 1:nrow(polygons4)
    colnames(polygons4)=c("IDLabel","IDPoint","PointOrder")
    
    # Fusionner les trois précédents sets en un seul
    df4 <- merge(polygons4,points4)
    df4 <- merge(df4,polygon.labels4)
    df4 <- df4[order(df4$PointOrder),]
    
    # Déterminer les données des étiquettes
    Labs4=ddply(df4,"Label4",function(x){c(c(mean(x$T),mean(x$L),mean(x$R)))})
    colnames(Labs4)=c("Label","T","L","R")
    
    # Créer les points du diagramme 10
    points10 <- data.frame(
      rbind(
        c(1,1.000,0.000,0.000),
        c(2,0.750,0.250,0.000),
        c(3,0.750,0.125,0.125),
        c(4,0.750,0.000,0.250),
        c(5,0.600,0.200,0.200),
        c(6,0.500,0.500,0.000),
        c(7,0.500,0.000,0.500),
        c(8,0.400,0.400,0.200),
        c(9,0.400,0.200,0.400),
        c(10,0.250,0.750,0.000),
        c(11,0.250,0.000,0.750),
        c(12,0.200,0.600,0.200),
        c(13,0.200,0.400,0.400),
        c(14,0.200,0.200,0.600),
        c(15,0.125,0.750,0.125),
        c(16,0.125,0.125,0.750),
        c(17,0.000,1.000,0.000),
        c(18,0.000,0.750,0.250),
        c(19,0.000,0.500,0.500),
        c(20,0.000,0.250,0.750),
        c(21,0.000,0.000,1.000)
      )
    )
    colnames(points10) = c("IDPoint","T","L","R")
    
    # Attribuer à chaque polygone un nombre et une étiquette
    polygon.labels10 <- data.frame(Label10=c("X","XY","XZ","XYZ","YX","ZX","Y","YZ","ZY","Z"))
    polygon.labels10$IDLabel=1:nrow(polygon.labels10)
    
    # Créer une carte des polygones
    polygons10 <- data.frame(
      rbind(
        c(1,1),c(1,2),c(1,4),
        c(2,6),c(2,2),c(2,3),c(2,5),c(2,8),
        c(3,3),c(3,4),c(3,7),c(3,9),c(3,5),
        c(4,5),c(4,14),c(4,12),
        c(5,6),c(5,8),c(5,12),c(5,15),c(5,10),
        c(6,7),c(6,11),c(6,16),c(6,14),c(6,9),
        c(7,17),c(7,10),c(7,18),
        c(8,15),c(8,12),c(8,13),c(8,19),c(8,18),
        c(9,13),c(9,14),c(9,16),c(9,20),c(9,19),
        c(10,11),c(10,21),c(10,20)
      )
    )
    polygons10$PointOrder <- 1:nrow(polygons10)
    colnames(polygons10)=c("IDLabel","IDPoint","PointOrder")
    
    # Fusionner les trois précédents sets en un seul
    df10 <- merge(polygons10,points10)
    df10 <- merge(df10,polygon.labels10)
    df10 <- df10[order(df10$PointOrder),]
    
    # Déterminer les données des étiquettes
    Labs10=ddply(df10,"Label10",function(x){c(c(mean(x$T),mean(x$L),mean(x$R)))})
    colnames(Labs10)=c("Label","T","L","R")
    
    
    # Obtenez les indices des colonnes correspondantes
    x_index <- which(colnames(data_selected) == input$xVar)
    y_index <- which(colnames(data_selected) == input$yVar)
    z_index <- which(colnames(data_selected) == input$zVar)
    ma_df <- data_selected[, c(x_index, y_index, z_index)]
    names(ma_df) <- c("x", "y", "z")
    # Vérifiez si les colonnes sélectionnées existent dans le jeu de données
    if (length(x_index) == 0 || length(y_index) == 0 || length(z_index) == 0) {
      # Affichez un message d'erreur si les colonnes n'existent pas
      showModal(modalDialog(
        title = "Erreur",
        "Les colonnes sélectionnées n'existent pas dans le jeu de données.",
        easyClose = TRUE
      ))
    } else {
      # Créer le diagramme
      base1 <- ggtern(data=df1,aes(L,T,R)) +
        geom_polygon(aes(group=Label1),color="black",alpha=0) +
        geom_text(data=Labs1, aes(label=Label), size=3, color="black") +
        geom_point(data=ma_df, aes(x, y, z), color="red", size=3) +
        theme_bw() +
        theme(plot.title=element_text(hjust=0.5)) +
        tern_limits(labels=c(10,20,30,40,50,60,70,80,90,100), breaks=seq(0.1,1,by=0.1)) +
        theme_clockwise() +
        theme_showarrows() +
        labs(
          title="Diagramme ternaire",
          T=input$xVar, L=input$yVar, R=input$zVar,
          Tarrow="% X",Larrow="% Y",Rarrow="% Z"
        ) +
        theme(tern.axis.arrow=element_line(linewidth=1,color="black"))
      
      # Générer le diagramme 3
      output$ternaryPlot <- renderPlot({print(base1)})
      
      # Créer le diagramme 3
      base3 <- ggtern(data=df3,aes(L,T,R)) +
        geom_polygon(aes(group=Label3),color="black",alpha=0) +
        geom_text(data=Labs3, aes(label=Label), size=3, color="black") +
        geom_point(data=ma_df, aes(x, y, z), color="red", size=3) +
        theme_bw() +
        theme(plot.title=element_text(hjust=0.5)) +
        tern_limits(labels=c(10,20,30,40,50,60,70,80,90,100), breaks=seq(0.1,1,by=0.1)) +
        theme_clockwise() +
        theme_showarrows() +
        labs(
          title="Diagramme ternaire 3 zones",
          T=input$xVar, L=input$yVar, R=input$zVar,
          Tarrow="% X",Larrow="% Y",Rarrow="% Z"
        ) +
        theme(tern.axis.arrow=element_line(linewidth=1,color="black"))
      
      # Générer le diagramme 3
      output$ternaryPlot3 <- renderPlot({print(base3)})
      
      #Créer le diagramme 4
      base4 <- ggtern(data=df4,aes(L,T,R)) +
        geom_polygon(aes(group=Label4),color="black",alpha=0) +
        geom_text(data=Labs4,aes(label=Label),size=3,color="black") +
        geom_point(data=ma_df, aes(x, y, z), color="red", size=3) +
        theme_bw() +
        theme(plot.title=element_text(hjust=0.5)) +
        tern_limits(labels=c(10,20,30,40,50,60,70,80,90,100),breaks=seq(0.1,1,by=0.1)) +
        theme_clockwise() +
        theme_showarrows() +
        labs(
          title="Diagramme ternaire 4 zones",
          T=input$xVar, L=input$yVar, R=input$zVar,
          Tarrow="% X",Larrow="% Y",Rarrow="% Z"
        ) +
        theme(tern.axis.arrow=element_line(size=1,color="black"))
      
      # Générer le diagramme 4
      output$ternaryPlot4 <- renderPlot({print(base4)})
      
      # Créer le diagramme 10
      base10 <- ggtern(data=df10,aes(L,T,R)) +
        geom_polygon(aes(group=Label10),color="black",alpha=0) +
        geom_text(data=Labs10,aes(label=Label),size=3,color="black") +
        geom_point(data=ma_df, aes(x, y, z), color="red", size=3) +
        theme_bw() +
        theme(plot.title=element_text(hjust=0.5)) +
        tern_limits(labels=c(10,20,30,40,50,60,70,80,90,100),breaks=seq(0.1,1,by=0.1)) +
        theme_clockwise() +
        theme_showarrows() +
        labs(
          title="Diagramme ternaire 10 zones",
          T=input$xVar, L=input$yVar, R=input$zVar,
          Tarrow="% X",Larrow="% Y",Rarrow="% Z"
        ) +
        theme(tern.axis.arrow=element_line(size=1,color="black"))
      
      # Générer le diagramme 10
      output$ternaryPlot10 <- renderPlot({print(base10)})
    }
  
  # Afficher les selectInput dès le chargement du fichier
  output$variableSelectors <- renderUI({
    tagList(
      selectInput("xVar", "Variable x:", choices = colnames(data())),
      selectInput("yVar", "Variable y:", choices = colnames(data())),
      selectInput("zVar", "Variable z:", choices = colnames(data()))
    )
  })
  
  # Afficher le jeu de données dans l'onglet correspondant
  output$dataTable <- renderTable({
    data_selected <- data()
    return(data_selected)
  })
}

shinyApp(ui, server)

Furthermore, is it possible to optimize this script? I have the impression that it's a little too dense.

Can you help me? Thanks in advance

UR

Among multiple attempts to modify the script, I tried to find out which "data_selected" to change for the application to work. But I couldn't find what the issue was.

0

There are 0 answers