[英]Exclude data points by click in plotly in a shiny app r
I want to exclude certain data points that are selected by the user by clicking, like in this example (but using plotly).我想排除用户通过单击选择的某些数据点,就像在这个例子中一样(但使用情节)。 I tried to do it with the code i show below but it doesnt work.我试图用下面显示的代码来做,但它不起作用。
What i'm triying to do is identify the position of the data point and then once i get the position, set the var delete
as TRUE
if the row_number()
is in the set of selected data points and then just filter is delete
is TRUE
.我正在尝试做的是识别数据点的 position,然后一旦我得到 position,如果row_number()
在所选数据点集中,则将 var delete
设置为TRUE
,然后过滤器delete
为TRUE
.
I dont know if this is the most effient form to perfom that.我不知道这是否是最有效的形式。
I would appreciate any help or guidance.我将不胜感激任何帮助或指导。
library(shiny)
library(plotly)
library(dplyr)
n <- 20
x <- 1:n
y <- cumsum(rnorm(n))
z <- runif(n,10,200)
cat <- sample(letters[1:5],n,replace = TRUE)
delete <- FALSE
df<-data.frame(cat,x,y,z, delete)
ui <- fluidPage(
selectInput("var","var", c("y","z"), "y"),
mainPanel(plotlyOutput("plot")),
verbatimTextOutput("selection"),
actionButton("delete","Delete", style = "display:inline-block;"),
actionButton("reset","Reset", style = "display:inline-block;"),
)
server <- function(input, output, session) {
myData <- reactive({df})
output$plot <- renderPlotly({
plot_ly(myData(),
x = ~x,
y = ~get(input$var),
type = "scatter",
mode = "markers",
text = ~cat,
marker = list(size = 10),
source = "A")
})
p1 <- reactive({
event_data("plotly_click", source = "A")
})
p2 <- reactiveValues(points = c())
observeEvent(p1(),{
p2$points <- c(p2$points,as.list(p1())$pointNumber)
})
observeEvent(input$reset,{
p2$points <- c()
})
output$selection <- renderPrint({ if(length(p2$points+1)<1){"Select data points to delete"}else{(p2$points+1)} })
observeEvent(input$delete,{
myData() <- myData() %>%
mutate(delete = ifelse(row_number() %in% c(p2$puntos+1),TRUE,delete)) %>%
filter(!delete)
})
}
shinyApp(ui, server)
Nice trick with event_data
there!那里有event_data
的好技巧! I think all that's needing done differently is to make myData$df
a named reactiveValue
(with one small correction to p2$points
lower down).我认为所有需要做的不同就是使myData$df
成为一个命名的reactiveValue
(对p2$points
进行小幅修正)。 This works for me now:这现在对我有用:
library(shiny)
library(plotly)
library(dplyr)
n <- 20
x <- 1:n
y <- cumsum(rnorm(n))
z <- runif(n,10,200)
cat <- sample(letters[1:5],n,replace = TRUE)
delete <- FALSE
df<-data.frame(cat,x,y,z, delete)
ui <- fluidPage(
selectInput("var","var", c("y","z"), "y"),
mainPanel(plotlyOutput("plot")),
verbatimTextOutput("selection"),
actionButton("delete","Delete", style = "display:inline-block;"),
actionButton("reset","Reset", style = "display:inline-block;"),
)
server <- function(input, output, session) {
myData <- reactiveValues(df = df)
output$plot <- renderPlotly({
plot_ly(myData$df,
x = ~x,
y = ~get(input$var),
type = "scatter",
mode = "markers",
text = ~cat,
marker = list(size = 10),
source = "A")
})
p1 <- reactive({
event_data("plotly_click", source = "A")
})
p2 <- reactiveValues(points = c())
observeEvent(p1(),{
p2$points <- c(p2$points,as.list(p1())$pointNumber)
})
observeEvent(input$reset,{
p2$points <- c()
})
output$selection <- renderPrint({ if(length(p2$points+1)<1){"Select data points to delete"}else{(p2$points+1)} })
observeEvent(input$delete,{
# browser()
myData$df <- myData$df %>%
mutate(delete = ifelse(row_number() %in% c(p2$points+1),TRUE,delete)) %>%
filter(!delete)
# And clear input?
p2$points <- c()
})
}
shinyApp(ui, server)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.