r语言 - Ggplot:绘图 - 交互 - 排除 - >防止排除点重置



我想防止在选择第二个变量以selectizeInput显示时重置曲线。例如,在下面的代码中,我们在cyl (6) 的 selectizeInput 中选择一个值(mtcars数据集),并从曲线中排除一个点,然后我们选择cyl (4)的第二个值来显示,因此cyl=6的前一条曲线会自行重置(被排除的点再次出现)。

有没有办法防止这种行为,并且在选择第二个变量时,排除点保持"排除"状态?

示例代码:

library(ggplot2)
library(shiny)
ui <- fluidPage(
fluidRow(
column(width = 6,
plotOutput("plot1", height = 350,
click = "plot1_click"), 
selectizeInput("valuecyl", "Select value of cyl:", choices=unique(mtcars$cyl), multiple = TRUE))
)
)
server <- function(input, output) {
# For storing which rows have been excluded
vals <- reactiveValues()
data_df <- reactive({
data <- mtcars
data <- data[data$cyl %in% input$valuecyl, ]
vals$keeprows = rep(TRUE, nrow(data))
data
})
output$plot1 <- renderPlot({
data<- data_df()
keep    <- data[ vals$keeprows, , drop = FALSE]
exclude <- data[!vals$keeprows, , drop = FALSE]
print(keep)
ggplot(keep, aes(wt,mpg,colour=as.factor(cyl))) + geom_point(data=keep) + geom_line(data=keep) +
geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) 
})
# Toggle points that are clicked
observeEvent(input$plot1_click, {
data <-  data_df()
res <- nearPoints(data, input$plot1_click, allRows = TRUE)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})

}
shinyApp(ui, server)

这里的问题是每次用户在selectize中选择值时,您都会覆盖vals$keeprows并将其替换为rep(TRUE, nrow(data))

您需要通过保留用户保留的行并添加来自额外选择的新行来更新keeprows变量。

为此,我稍微修改了您的代码:

#added the data in the reactiveValues for convenience
vals <- reactiveValues(keeprows=logical(0),data=mtcars[0,])
#this observes the input and updates the data when the user adds a cyl value
observeEvent(input$valuecyl,{
#get the id (here rownames) of the points excluded by the user
excluded_ids <- rownames(vals$data)[!vals$keeprows]
#make the new data
vals$data=mtcars[mtcars$cyl %in% input$valuecyl,] 
#keep the rows that the user had not previously excluded.
vals$keeprows = !(rownames(vals$data) %in% excluded_ids)
})

由于我在reactiveValues中添加了数据并删除了data_df,因此您需要在代码中将data_df()替换为vals$data才能正常工作。

最新更新