Как запустить приложение Shiny для создания троичных диаграмм ggtern (R), отображающих переменные сразу после загрузки файла CSV?

Question

Я пытаюсь создать различные троичные диаграммы ggtern с помощью приложения Shiny. Однако это больше не работает, как только я пытаюсь напрямую отобразить выбор переменных в моем CSV-файле сразу после его загрузки. Когда я пытаюсь запустить приложение, оно закрывается, и я получаю следующее сообщение об ошибке:

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

Вот мой сценарий:

      # 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)

Кроме того, можно ли оптимизировать этот скрипт? У меня сложилось впечатление, что он слишком плотный.

Вы можете помочь мне? заранее спасибо

УР

Среди многочисленных попыток изменить скрипт я пытался выяснить, какой «data_selected» изменить, чтобы приложение заработало. Но я не смог найти, в чем проблема.