R 从带有反应变量的渲染图中排除数据点

目前，我正在探索构建

Shinny

仪表盘的可能性。我想创建一个仪表板，用户可以在其中从绘图中排除数据。数据通过用户选择的excel表格获得

  ui <- fluidPage(
    sidebarLayout(
      sidebarPanel(
        fileInput('datafile', 'Choose xlsx file',
                  accept = c(".xlsx")),

        uiOutput("x"),
        uiOutput("y"),

      ),
      mainPanel(plotOutput("plot",click = "plot1_click",
                           brush = brushOpts(
                             id = "plot1_brush"
                           )),
                uiOutput("Exclude"),
                uiOutput("Reset")

    )
  )
  )

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

    Data <- reactive({
      infile <- input$datafile
      if (is.null(infile)) {
        return(data.frame())
      }
      read.xlsx(infile$datapath) %>%
        select_if(colSums(!is.na(.)) > 0) 
    })

    output$x <- renderUI({
      if (ncol(Data() > 0)) {
        selectInput("x", "x-axis", names(Data()), selected = NULL, multiple = FALSE)


      }
    })

    output$y <- renderUI({
      if (ncol(Data() > 0)) {
        selectInput("y", "y-axis", paste0(names(Data())), selected = NULL, multiple = FALSE)


      }
    })

    vals <- reactiveValues(
      if (ncol(Data() > 0)) {
        keeprows = rep(TRUE, nrow(Data()))
      }
    )

    observeEvent(input$plot1_click, {
      if (ncol(Data() > 0)) {

        res <- nearPoints(Data(), input$plot1_click, allRows = TRUE)

        vals$keeprows <- xor(vals$keeprows, res$selected_)
      }
    })
    observeEvent(input$exclude_toggle, {
      if (ncol(Data() > 0)) {

        res <- brushedPoints(Data(), input$plot1_brush, allRows = TRUE)

        vals$keeprows <- xor(vals$keeprows, res$selected_)
      }
    })
    observeEvent(input$exclude_reset, {
      if (ncol(Data() > 0)) {
        vals$keeprows <- rep(TRUE, nrow(Data()))
      }
    })


    observe({
      if (ncol(Data() > 0)) {
        data    <- Data()[ vals$keeprows, , drop = FALSE]

        output$plot = renderPlot({
          ggplot() + geom_point(data=data, aes_string(x=input$x, y=sym(input$y),color = NULL))


        })
      }
    })

  }


  shinyApp(ui = ui, server = server)

---

ui以下是一些可以尝试的建议：


在
ui
中，您可能需要
action按钮
来切换
exclude\u开关
和
exclude\u重置

单独创建您的
reactivevalue
，对于
keeprows

读入数据文件后，将
keeprows
设置为TRUE

不要将
输出
放在
观察
中。相反，您可以只引用
Data（）
，这样在加载新数据时它就会更改

当您使用
aes\u string
时，我从您的绘图中删除了
sym
，并且不确定您是否有其他意图


我试着保持其余的大部分不变，让我知道这是否对你有效

library(shiny)
library(openxlsx)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput('datafile', 'Choose xlsx file',
                accept = c(".xlsx")),
      uiOutput("x"),
      uiOutput("y"),
    ),
    mainPanel(plotOutput("plot",click = "plot1_click",
                         brush = brushOpts(
                           id = "plot1_brush"
                         )),
              actionButton("exclude_toggle", "Exclude"),
              actionButton("exclude_reset", "Reset")
    )
  )
)

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

  vals <- reactiveValues(keeprows = NULL)

  Data <- reactive({
    infile <- input$datafile
    if (is.null(infile)) {
      return(data.frame())
    }

    mydata <- read.xlsx(infile$datapath) %>%
      select_if(colSums(!is.na(.)) > 0) 

    if (ncol(mydata) > 0) {
      vals$keeprows = rep(T, nrow(mydata))
    }

    return(mydata)
  })

  output$x <- renderUI({
    if (ncol(Data() > 0)) {
      selectInput("x", "x-axis", names(Data()), selected = NULL, multiple = FALSE)
    }
  })

  output$y <- renderUI({
    if (ncol(Data() > 0)) {
      selectInput("y", "y-axis", paste0(names(Data())), selected = NULL, multiple = FALSE)
    }
  })

  observeEvent(input$plot1_click, {
    if (ncol(Data() > 0)) {
      res <- nearPoints(Data(), input$plot1_click, allRows = TRUE)
      vals$keeprows <- xor(vals$keeprows, res$selected_)
    }
  })

  observeEvent(input$exclude_toggle, {
    if (ncol(Data() > 0)) {
      res <- brushedPoints(Data(), input$plot1_brush, allRows = TRUE)
      vals$keeprows <- xor(vals$keeprows, res$selected_)
    }
  })

  observeEvent(input$exclude_reset, {
    if (ncol(Data() > 0)) {
      vals$keeprows <- rep(TRUE, nrow(Data()))
    }
  })

  output$plot = renderPlot({
    req(input$x, input$y)
    mydata <- Data()[vals$keeprows, , drop = FALSE]
    ggplot() + 
      geom_point(data=mydata, aes_string(x=input$x, y=input$y, color = NULL))
  })

}

shinyApp(ui = ui, server = server)

库（闪亮）
库（openxlsx）
非常感谢。这是一个非常好的解决方案。我真的很感谢你的帮助。对于我为什么使用
sym
进行绘图的问题，这基本上是一个快速而肮脏的解决方案，因为用户将选择的excel文件的列名通常包含空格。
ggplot
无法识别这一点。通过使用
sym
我创建了一个变通方法，但它不是一个非常优雅的解决方案。如果你有任何想法如何做得更好，我很高兴听到。再次感谢您的帮助！我想我明白了。但是，当您使用read.xlsx读取Excel文件时，列名中的空格不是已经转换为句点了吗？