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

Я пытаюсь использовать логический вектор из реактивного выражения. Это вызывает ошибку в функции 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)

почему ты хочешь сделать это? Я считаю, что добавление keeprows к vals делает его реактивным. Из ?reactiveValues: Эта функция возвращает объект для хранения реактивных значений. Он похож на список, но со специальными возможностями для реактивного программирования. Когда вы читаете из него значение, вызывающее реактивное выражение принимает реактивную зависимость от этого значения, а когда вы пишете в него, оно уведомляет любые реактивные функции, которые зависят от этого значения. Обратите внимание, что значения, взятые из объекта reactiveValues, являются реактивными, но сам объект reactiveValues ​​- нет.

Qwfqwf 26.10.2018 23:13

Спасибо за советы. Моя цель - создать data.table на основе пользовательского ввода. График будет создан на основе данных в этом data.table. Я хотел бы дать пользователю возможность выбирать (и отменять выбор точек) и тем самым разбивать data.table на два подмножества (сохраненные строки и исключенные строки). По сути, единственное отличие от исходного примера состоит в том, что входной data.table, используемый для NearPoints(), должен быть реактивным. Если есть альтернативный способ сделать это, я буду рад узнать его.

Lech Kaczmarczyk 26.10.2018 23:31

Я все еще не совсем понимаю, к чему вы клоните. Вам нужна такая же функциональность в примере Rshiny, где выбранные точки отображаются серым цветом, а корреляция изменяется? Это будет одинаково независимо от того, читаете ли вы данные или используете встроенные данные.

Qwfqwf 27.10.2018 00:48

Хорошо, извините за непонятность. Я расширил вопрос, чтобы было понятнее.

Lech Kaczmarczyk 27.10.2018 09:28
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
1
4
190
2

Ответы 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)

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

Lech Kaczmarczyk 27.10.2018 12:15

Решено:

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)

Другие вопросы по теме