Я пытаюсь использовать логический вектор из реактивного выражения. Это вызывает ошибку в функции 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)
Спасибо за советы. Моя цель - создать data.table
на основе пользовательского ввода. График будет создан на основе данных в этом data.table
. Я хотел бы дать пользователю возможность выбирать (и отменять выбор точек) и тем самым разбивать data.table
на два подмножества (сохраненные строки и исключенные строки). По сути, единственное отличие от исходного примера состоит в том, что входной data.table
, используемый для NearPoints()
, должен быть реактивным. Если есть альтернативный способ сделать это, я буду рад узнать его.
Я все еще не совсем понимаю, к чему вы клоните. Вам нужна такая же функциональность в примере Rshiny, где выбранные точки отображаются серым цветом, а корреляция изменяется? Это будет одинаково независимо от того, читаете ли вы данные или используете встроенные данные.
Хорошо, извините за непонятность. Я расширил вопрос, чтобы было понятнее.
Я не уверен, что это именно тот результат, который вы ищете, но этот код считывается в локальном файле, а затем выполняет выбор точки чистки, выделяя серые точки после нажатия «точек переключения», а также регулируя корреляцию.
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)
Спасибо за это, это очень полезно. Однако в этом случае пользователь будет изменять данные только с помощью виджетов. Я изменил пример в исходном вопросе.
Решено:
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)
почему ты хочешь сделать это? Я считаю, что добавление
keeprows
кvals
делает его реактивным. Из?reactiveValues
: Эта функция возвращает объект для хранения реактивных значений. Он похож на список, но со специальными возможностями для реактивного программирования. Когда вы читаете из него значение, вызывающее реактивное выражение принимает реактивную зависимость от этого значения, а когда вы пишете в него, оно уведомляет любые реактивные функции, которые зависят от этого значения. Обратите внимание, что значения, взятые из объекта reactiveValues, являются реактивными, но сам объект reactiveValues - нет.