閃亮模塊中的散點圖問題

Question

我有一個閃亮的應用程序，下面顯示的示例應該是可重現的，其中我試圖顯示ggplot2散點圖，其中可以排除這些點，如此示例中所示。我也在使用模塊，這可能是此問題的一部分。 https://gallery.shinyapps.io/106-plot-interaction-exclude/

我不斷收到這個「Error in eval：object'xaxis'not found」的消息。有任何想法嗎？我把模塊代碼放在前面，然後是app.R文件的其餘代碼。

library(ggplot2) 
    library(scales) 
    library(shiny) 
    library(shinydashboard) 


    ###### MODULE CODE ############### 
    scatter_graphUI <- function(id, tab_panel_name, height = "500px") { 
     ns <- NS(id) 

     tabPanel(tab_panel_name, 
     plotOutput(ns("scatter_1"), height = height, click = "plot1_click", brush = 
      brushOpts(id = "plot1_brush")), 
     actionButton(ns("exclude_toggle"), "Toggle points"), 
     actionButton(ns("exclude_reset"), "Reset") 
    ) 
    } 

    scatter_graph <- function(input, output, session, scatter_data, col_select) { 

     scatter_data_df <- reactive({ 
     mtcars 
     }) 

     vals <- reactiveValues() 
     data_df <- reactive({ 
     scatter_df <- scatter_data_df() 
     main_df <- scatter_df[,col_select] 
     vals$keeprows = rep(TRUE,nrow(main_df)) 
     main_df 
     }) 

     output$scatter_1 <- renderPlot({ 

      graph_df <- data_df() 
      # Plot the kept and excluded points as two separate data sets 
      keep <- graph_df[ vals$keeprows,] 
      exclude <- graph_df[!vals$keeprows,] 

      final_df <- keep 
      title = paste(colnames(final_df)[1], "vs", colnames(final_df)[2]) 
      line_method = "quad" 
      axis_text = 12 
      title_text = 16 
      split_colors = TRUE 
      colors = c("red","black") 

      # create red points for negative x axis returns if split_colors is TRUE 
      if (split_colors == TRUE) { 
      final_df[,"color"] <- ifelse(final_df[,2,drop=F]<0,colors[1],colors[2]) 
      } else { 
      final_df[,"color"] <- ifelse(final_df[,2,drop=F]<0,colors[2],colors[2]) 
      } 
      # create a generic graphing final_df 
      colnames(final_df) <- c("xaxis","yaxis","color") 

      # setup the graph 
      gg <- ggplot(final_df, aes(x = xaxis, y = yaxis)) + geom_point(color = final_df[,"color"]) 
      gg <- gg + geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) + 
      coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5,35)) 

      if (line_method == "loess") { 
      gg <- gg + stat_smooth(span = 0.9) 
      } else if (line_method == "quad") { 
      gg <- gg + stat_smooth(method = "lm", formula = y ~ poly(x, 2), size = 1) 
      } else if (line_method == "linear") { 
      gg <- gg + stat_smooth(method = "lm") 
      } else { 

      } 
      gg <- gg + theme_bw() 
      gg <- gg + labs(x = colnames(final_df)[2], y = colnames(final_df)[3], title = title) 
      gg 
     }) 


     # Toggle points that are clicked 
     observeEvent(input$plot1_click, { 
     main_df <- data_df() 
     res <- nearPoints(main_df, input$plot1_click, allRows = TRUE) 
     vals$keeprows <- xor(vals$keeprows, res$selected_) 
     }) 

     # Toggle points that are brushed, when button is clicked 
     observeEvent(input$exclude_toggle, { 
     main_df <- data_df() 
     res <- brushedPoints(main_df, input$plot1_brush, allRows = TRUE) 

     vals$keeprows <- xor(vals$keeprows, res$selected_) 
     }) 

     # Reset all points 
     observeEvent(input$exclude_reset, { 
     main_df <- data_df() 
     vals$keeprows <- rep(TRUE, nrow(main_df)) 
     }) 

    } 
    ######################################## 


##### REST OF APP CODE ######  
    header <- dashboardHeader(
     title = 'Test Dashboard' 
    ) 
    body <- dashboardBody(
     tabItems(
     tabItem(tabName = "scatter_eval", 
        tabBox(
        title = "Scatter", 
        selected = "Selected", 
        height = "600px", side = "right", 
        scatter_graphUI("selected_scatter", "Selected") 
       ) 
       ) 
     ) 
    ) 

    sidebar <- dashboardSidebar(
     sidebarMenu(
     menuItem("Scatter Evaluation", icon = icon("th"), tabName = "scatter_eval") 
    ) 
    ) 

    ui <- dashboardPage(skin = "blue", 
         header, 
         sidebar, 
         body 
    ) 


    server <- function(input, output, session) { 

     callModule(scatter_graph, id ="selected_scatter", scatter_data = reactive(selected_scatter_data()), 
       col_select = c(1,2)) 

    } 

    shinyApp(ui = ui, server = server) 
######## 

Answer 1

的問題是兩條線：

gg <- ggplot(final_df, aes(x = xaxis, y = yaxis)) + geom_point(color = final_df[,"color"]) 
gg <- gg + geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) + 
      coord_cartesian(xlim = c(1.5, 5.5), ylim = c(5,35)) 

因爲你沒有設置排除對象的新aes，它繼承了AES從ggplot電話。因此需要在exclude數據集中找到名爲xaxis和yaxis的列。由於您只更名爲final_df，因此會引發此錯誤。

當您更改顯示的圖表：

colnames(final_df) <- c("xaxis","yaxis","color") 

到：

colnames(final_df) <- c("xaxis","yaxis","color") 
colnames(exclude) <- c("xaxis","yaxis")