Использование (логического) вектора из реактивного выражения в реактивном контексте / попытка применить нефункциональную ошибку

Question

Я пытаюсь использовать логический вектор из реактивного выражения. Это вызывает ошибку в функции xor (), когда я пытаюсь выполнить логическую операцию над этим вектором в другом реактивном выражении. Я хотел бы создать реактивное выражение (логический вектор), а затем использовать его в другой реактивной функции. Игрушечный пример ниже. Ошибка появляется при нажатии точек на графике.

В исходном здесь keeprows () не является реактивным, но я хотел бы сделать это структурированным, как показано на схеме ниже (с сайта Shiny). Первый объект вводится для реактивного выражения, а затем второй (реактивный) объект (который представляет собой таблицу с пользовательскими подмножествами) используется для выбора точек и т. Д. Элементами после бифуркации являются таблицы с сохраненными и исключенными точками. У меня проблема с выполнением этого последнего подмножества для работы.

Может ли кто-нибудь объяснить мне корень этой проблемы?

library(ggplot2)
library(shiny)
library(dplyr)

ui <- fluidPage(
  fluidRow(
    column(width = 6,
           plotOutput("plot1", height = 350,
                      click = "plot1_click",
                      brush = brushOpts(
                        id = "plot1_brush"
                      )
           ),
           actionButton("exclude_toggle", "Toggle points"),
           sliderInput(inputId = "efficiency", value = 20, label = "MPG", min = min(mtcars$mpg), max = max(mtcars$mpg))
    )
  )
)

server <- function(input, output) {
  # For storing which rows have been excluded

  mt_subset <- reactive(mtcars %>% filter(mpg > input$efficiency))

  vals <- reactiveValues()
  vals$keeprows <- reactive(rep(TRUE, nrow(mt_subset()), label = "TuProblem", quoted = FALSE))

  output$plot1 <- renderPlot({
    # Plot the kept and excluded points as two separate data sets
    keep    <- mt_subset()[ vals$keeprows(), , drop = FALSE]
    exclude <- mt_subset()[!vals$keeprows(), , drop = FALSE]

    ggplot(keep, aes(wt, mpg)) + geom_point() +
      geom_smooth(method = lm, fullrange = TRUE, color = "black") +
      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))
  })

  # Toggle points that are clicked
  observeEvent(input$plot1_click, {
    res <- nearPoints(mt_subset(), input$plot1_click, allRows = TRUE)

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

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

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

}

shinyApp(ui, server)

Answer 1

Решено:

library(ggplot2)
library(shiny)
library(dplyr)

ui <- fluidPage(
  fluidRow(
    column(width = 6,
           plotOutput("plot1", height = 350,
                      click = "plot1_click",
                      brush = brushOpts(
                        id = "plot1_brush"
                      )
           ),
           actionButton("exclude_toggle", "Toggle points"),
           sliderInput(inputId = "efficiency", value = 20, label = "MPG", min = min(mtcars$mpg), max = max(mtcars$mpg))
    )
  )
)

server <- function(input, output) {
  mt_subset <- reactive(mtcars %>% filter(mpg > input$efficiency))
  vals <- reactiveValues()
  observeEvent(mt_subset(), {
  vals$keeprows <- rep(TRUE, nrow(mt_subset()), label = "TuProblem", quoted = FALSE)
  })
  output$plot1 <- renderPlot({
    # Plot the kept and excluded points as two separate data sets
    keep    <- mt_subset()[ vals$keeprows, , drop = FALSE]
    exclude <- mt_subset()[!vals$keeprows, , drop = FALSE]
    ggplot(keep, aes(wt, mpg)) + geom_point() +
      geom_smooth(method = lm, fullrange = TRUE, color = "black") +
      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))
  })
  observeEvent(input$plot1_click, {
    res <- nearPoints(mt_subset(), input$plot1_click, allRows = TRUE)
    vals$keeprows <- xor(vals$keeprows, res$selected_)
  })

  observeEvent(input$exclude_toggle, {
    res <- brushedPoints(mt_subset(), input$plot1_brush, allRows = TRUE)

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

}
shinyApp(ui, server)

Answer 2

Я не уверен, что это выходной файл, который вы ищете, но этот код читает в локальном файле, а затем выполняет выбор точки чистки, затенение зачищенных точек после нажатия «точек переключения» и настройку корреляция.

library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux
library(shiny)
library(readxl)

data(iris)
write.xlsx(x = iris, file = "iris.xlsx")

ui <- fluidPage(
  fluidRow(
    fileInput(inputId = "file",
              label = "Load file"),
    column(width = 6,
           plotOutput("plot1", height = 350,
                      click = "plot1_click",
                      brush = brushOpts(
                        id = "plot1_brush"
                      )
           ),
           actionButton("exclude_toggle", "Toggle points"),
           actionButton("exclude_reset", "Reset")
    )
  )
)

server <- function(input, output) {

  # Get file
  getFile <- reactive({ if (is.null(input$file)) {
    return(NULL)
  } else {
    return(input$file)
  }})

  # Read data
  data <- reactive({ if (is.null(getFile())) {
    return(NULL)
  } else {
    as.data.frame(read_excel(getFile()$datapath))
  }})

  # For storing which rows have been excluded
  vals <- reactiveValues()
  observeEvent(data(), {
    vals$keeprows <- rep(T, nrow(data()))
  })

  # Toggle points that are clicked
  observeEvent(input$plot1_click, {
    res <- nearPoints(data(), 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, {
    res <- brushedPoints(data(), input$plot1_brush, allRows = TRUE)

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

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

  output$plot1 <- renderPlot({
    if (is.null(data())) {
      return(NULL)
    } else {

      # Indices for keep and exclude
      keep_v <- which(vals$keeprows)
      exclude_v <- which(!vals$keeprows)

      # Subset data
      keep <- data()[keep_v, , drop = F]
      exclude <- data()[exclude_v, , drop = F]

      ggplot(keep, aes(Sepal.Length, Sepal.Width)) + geom_point() +
        geom_smooth(method = lm, fullrange = TRUE, color = "black") +
        geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25)

    }
  })

}

shinyApp(ui, server)