闪亮模块问题中的散点图

时间:2016-02-09 01:29:25

标签: r shiny

我有一个闪亮的应用程序,下面显示的示例应该是可重现的,我试图显示一个ggplot2散点图,其中可以排除点,如此示例所示。我也在使用模块,这可能是这个问题的一部分。 https://gallery.shinyapps.io/106-plot-interaction-exclude/

我一直得到这个"错误在eval:object' xaxis'找不到"信息。有任何想法吗?我把模块代码放在了前面,然后是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)
########

1 个答案:

答案 0 :(得分: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,因此它会从ggplot调用继承aes。因此,它需要在xaxis数据集中找到名为yaxisexclude的列。由于您只重命名了final_df,因此会抛出此错误。

更改时会显示图表:

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

为:

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