[英]R ggplot2 click with boxplot
當我單擊圖表中的一個點時,該點將突出顯示為紅色。
但很快它又回到了黑色。
有沒有辦法保持選擇?
library(shiny)
library(ggplot2)
server <- function(input, session, output) {
mtcars$cyl = as.character(mtcars$cyl)
D = reactive({
nearPoints(mtcars, input$click_1,allRows = TRUE)
})
output$plot_1 = renderPlot({
set.seed(123)
ggplot(D(),aes(x=cyl,y=mpg)) +
geom_boxplot(outlier.shape = NA) +
geom_jitter(aes(color=selected_),width=0.02,size=4)+
scale_color_manual(values = c("black","red"),guide=FALSE)
})
output$info = renderPrint({
D()
})
}
ui <- fluidPage(
plotOutput("plot_1",click = clickOpts("click_1")),
verbatimTextOutput("info")
)
shinyApp(ui = ui, server = server)
好吧,我的方法與Valter的略有不同:選擇的點變為紅色,而你可以取消選擇它們然后它們變回黑色。
實現這種效果的關鍵(甚至是Valter對1個選定點的回答)是使用reactiveValues
來跟蹤選定的點。
library(shiny)
library(ggplot2)
server <- function(input, session, output) {
mtcars$cyl = as.character(mtcars$cyl)
vals <- reactiveValues(clicked = numeric())
observeEvent(input$click_1, {
# Selected point/points
slt <- which(nearPoints(mtcars, input$click_1,allRows = TRUE)$selected)
# If there are nearby points selected:
# add point if it wasn't clicked
# remove point if it was clicked earlier
# Else do nothing
if(length(slt) > 0){
remove <- slt %in% vals$clicked
vals$clicked <- vals$clicked[!vals$clicked %in% slt[remove]]
vals$clicked <- c(vals$clicked, slt[!remove])
}
})
D = reactive({
# If row is selected return "Yes", else return "No"
selected <- ifelse(1:nrow(mtcars) %in% vals$clicked, "Yes", "No")
cbind(mtcars, selected)
})
output$plot_1 = renderPlot({
set.seed(123)
ggplot(D(),aes(x=cyl,y=mpg)) +
geom_boxplot(outlier.shape = NA) +
geom_jitter(aes(color=selected),width=0.02,size=4)+
scale_color_manual(values = c("black","red"),guide=FALSE)
})
output$info = renderPrint({
D()
})
}
ui <- fluidPage(
plotOutput("plot_1",click = clickOpts("click_1")),
verbatimTextOutput("info")
)
shinyApp(ui = ui, server = server)
我不確定問題是什么,但這是我提出的第一個解決方法:
library(shiny)
library(ggplot2)
server <- function(input, session, output) {
mtcars$cyl = as.character(mtcars$cyl)
df <- reactiveValues(dfClikced = mtcars)
observe({
if (!is.null(input$click_1)) {
df$dfClikced <- nearPoints(mtcars, input$click_1, allRows = TRUE)
}})
output$plot_1 = renderPlot({
set.seed(123)
if (names(df$dfClikced)[NCOL(df$dfClikced)]== "selected_") {
ggplot(df$dfClikced,aes(x=cyl,y=mpg)) +
geom_boxplot(outlier.shape = NA) +
geom_jitter(aes(color=selected_),width=0.02,size=4)+
scale_color_manual(values = c("black","red"),guide=FALSE)
} else {
ggplot(df$dfClikced,aes(x=cyl,y=mpg)) +
geom_boxplot(outlier.shape = NA) +
geom_jitter(width=0.02,size=4)+
scale_color_manual(values = c("black","red"),guide=FALSE)
}
})
output$info = renderPrint({
df$dfClikced
})
}
ui <- fluidPage(
plotOutput("plot_1",click = clickOpts("click_1")),
verbatimTextOutput("info")
)
shinyApp(ui = ui, server = server)
讓我知道...
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.