如何从闪亮的 ggplotly 中获取数据行
How can I grab the row of data from a ggplotly in shiny
下面的代码。
我正在尝试使用 plotly_click
事件来确定正在 select 编辑的数据。但是,我不知道该怎么做。 plotly_click 提供的数据非常少,根本不包括分组。我没有任何 JS 经验,但我知道一定有办法!我的目标是能够 select 一个数据点并能够在 data.frame d1
中获取它对应的行
d1=structure(list(Topic = c("compensation", "manager", "benefits",
"family", "communication", "worklifebalance", "perks", "compensation",
"benefits", "manager", "communication", "worklifebalance", "family",
"perks", "benefits", "compensation", "manager", "communication",
"family", "worklifebalance", "perks"),
variable = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
.Label = c("Prct", "Count"), class = "factor"),
value = c(2.23121245555964, 0.723305136692411, 0.576192227534633,
0.202280250091946, 0.190020840995464, 0.153242613706019,
0.0122594090964816, 0.913705583756345, 0.609137055837563,
0.50761421319797, 0.50761421319797, 0.304568527918782, 0.203045685279188,
0, 1.49977276170277, 1.21193758521436, 0.893803969095592,
0.439327374640206, 0.348432055749129, 0.242387517042872,
0.0757460990758976),
group = c("APAC", "APAC", "APAC", "APAC", "APAC", "APAC", "APAC",
"EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA",
"AMERICAS", "AMERICAS", "AMERICAS", "AMERICAS", "AMERICAS",
"AMERICAS", "AMERICAS")),
.Names = c("Topic", "variable", "value", "group"), class = c("data.table", "data.frame"),
row.names = c(NA, -21L))
library(needs)
needs(
stringr,
data.table,
tm,
ggplot2,
wordcloud,
readxl,
dplyr,
quanteda,
topicmodels,
reshape,
plotly,
shiny,
rCharts,
ggthemes,
shinyjs,
shinyWidgets,DT,shinythemes,
ggrepel,tidyverse,treemapify
)
options(stringsAsFactors = F)
library(shiny)
ui <- fluidPage(
fluidRow(plotlyOutput('keywords')),
fluidRow( verbatimTextOutput("selection")) )
server = function(input,output){
output$keywords = renderPlotly({
d0 = d1
p = ggplot(d0, aes(reorder(Topic,-value), value)) +
geom_point(aes(colour = value),
shape = 16,
size = 3,
show.legend = F) +
facet_wrap(~ group)+
theme_minimal()
ggplotly(p)
})
output$selection <- renderPrint({
s <- event_data("plotly_click")
cat("You selected: \n\n")
as.list(s)
})
}
shinyApp(ui, server)
我不确定这是否是你想要的,但你可以试试:
library(shiny)
library(plotly)
library(DT)
ui <- fluidPage(
fluidRow(plotlyOutput('keywords')),
fluidRow(verbatimTextOutput("selection")),
fluidRow(DT::dataTableOutput("table1"))
)
server = function(input,output){
output$keywords = renderPlotly({
d0 = d1
key <- row.names(d0)
d0 <- data.frame(d3, key)
p = ggplot(d0, aes(reorder(Topic,-value), value, key = key)) +
geom_point(aes(colour = value),
shape = 16,
size = 3,
show.legend = F) +
facet_wrap(~ group)+
theme_minimal()
ggplotly(p)
})
output$selection <- renderPrint({
s <- event_data("plotly_click")
cat("You selected: \n\n")
data.frame(s)
})
selection2 <- reactive({
s <- event_data("plotly_click")
cat("You selected: \n\n")
df <- data.frame(s)
})
output$table1 = renderDT({
d2 <- d1 %>% filter(key == selection2()$key)
d2
})
}
shinyApp(ui, server)
我只用过 plotly_selected
但我认为 plotly_clicked
应该是相似的。 plotly_selected
刷完剧情会触发
这是一个例子:
# 'data' is the data frame you used to draw the plot
brushed_data <- reactive({
d <- event_data("plotly_selected")
data_key <- d$key
if (!is.null(data_key) && length(data_key) > 0) {
# if it's not the row names, can be any column 'data[data$key %in% data_key,]
data[rownames(data) %in% data_key,]
} else {
data.frame()
}
})
键是在你画图的时候指定的,在我的例子中,我把key = rownames(data)
传递给add_markers
编辑 使用 ggplot2 和 plotly_click
改编了 Plotly 网站示例
library(plotly)
library(shiny)
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("click"),
verbatimTextOutput("brush")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
# use the key aesthetic/argument to help uniquely identify selected observations
key <- row.names(mtcars)
p <- ggplot(mtcars, aes(x = mpg, y = wt, colour = factor(vs), key = key)) +
geom_point() + facet_wrap(~ cyl)
ggplotly(p) %>% layout(dragmode = "select")
})
output$click <- renderPrint({
d <- event_data("plotly_click")
req(d)
print(mtcars[d$key, ])
})
output$brush <- renderPrint({
d <- event_data("plotly_selected")
req(d)
print(mtcars[d$key, ])
})
}
shinyApp(ui, server)
下面的代码。
我正在尝试使用 plotly_click
事件来确定正在 select 编辑的数据。但是,我不知道该怎么做。 plotly_click 提供的数据非常少,根本不包括分组。我没有任何 JS 经验,但我知道一定有办法!我的目标是能够 select 一个数据点并能够在 data.frame d1
d1=structure(list(Topic = c("compensation", "manager", "benefits",
"family", "communication", "worklifebalance", "perks", "compensation",
"benefits", "manager", "communication", "worklifebalance", "family",
"perks", "benefits", "compensation", "manager", "communication",
"family", "worklifebalance", "perks"),
variable = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
.Label = c("Prct", "Count"), class = "factor"),
value = c(2.23121245555964, 0.723305136692411, 0.576192227534633,
0.202280250091946, 0.190020840995464, 0.153242613706019,
0.0122594090964816, 0.913705583756345, 0.609137055837563,
0.50761421319797, 0.50761421319797, 0.304568527918782, 0.203045685279188,
0, 1.49977276170277, 1.21193758521436, 0.893803969095592,
0.439327374640206, 0.348432055749129, 0.242387517042872,
0.0757460990758976),
group = c("APAC", "APAC", "APAC", "APAC", "APAC", "APAC", "APAC",
"EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA",
"AMERICAS", "AMERICAS", "AMERICAS", "AMERICAS", "AMERICAS",
"AMERICAS", "AMERICAS")),
.Names = c("Topic", "variable", "value", "group"), class = c("data.table", "data.frame"),
row.names = c(NA, -21L))
library(needs)
needs(
stringr,
data.table,
tm,
ggplot2,
wordcloud,
readxl,
dplyr,
quanteda,
topicmodels,
reshape,
plotly,
shiny,
rCharts,
ggthemes,
shinyjs,
shinyWidgets,DT,shinythemes,
ggrepel,tidyverse,treemapify
)
options(stringsAsFactors = F)
library(shiny)
ui <- fluidPage(
fluidRow(plotlyOutput('keywords')),
fluidRow( verbatimTextOutput("selection")) )
server = function(input,output){
output$keywords = renderPlotly({
d0 = d1
p = ggplot(d0, aes(reorder(Topic,-value), value)) +
geom_point(aes(colour = value),
shape = 16,
size = 3,
show.legend = F) +
facet_wrap(~ group)+
theme_minimal()
ggplotly(p)
})
output$selection <- renderPrint({
s <- event_data("plotly_click")
cat("You selected: \n\n")
as.list(s)
})
}
shinyApp(ui, server)
我不确定这是否是你想要的,但你可以试试:
library(shiny)
library(plotly)
library(DT)
ui <- fluidPage(
fluidRow(plotlyOutput('keywords')),
fluidRow(verbatimTextOutput("selection")),
fluidRow(DT::dataTableOutput("table1"))
)
server = function(input,output){
output$keywords = renderPlotly({
d0 = d1
key <- row.names(d0)
d0 <- data.frame(d3, key)
p = ggplot(d0, aes(reorder(Topic,-value), value, key = key)) +
geom_point(aes(colour = value),
shape = 16,
size = 3,
show.legend = F) +
facet_wrap(~ group)+
theme_minimal()
ggplotly(p)
})
output$selection <- renderPrint({
s <- event_data("plotly_click")
cat("You selected: \n\n")
data.frame(s)
})
selection2 <- reactive({
s <- event_data("plotly_click")
cat("You selected: \n\n")
df <- data.frame(s)
})
output$table1 = renderDT({
d2 <- d1 %>% filter(key == selection2()$key)
d2
})
}
shinyApp(ui, server)
我只用过 plotly_selected
但我认为 plotly_clicked
应该是相似的。 plotly_selected
刷完剧情会触发
这是一个例子:
# 'data' is the data frame you used to draw the plot
brushed_data <- reactive({
d <- event_data("plotly_selected")
data_key <- d$key
if (!is.null(data_key) && length(data_key) > 0) {
# if it's not the row names, can be any column 'data[data$key %in% data_key,]
data[rownames(data) %in% data_key,]
} else {
data.frame()
}
})
键是在你画图的时候指定的,在我的例子中,我把key = rownames(data)
传递给add_markers
编辑 使用 ggplot2 和 plotly_click
library(plotly)
library(shiny)
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("click"),
verbatimTextOutput("brush")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
# use the key aesthetic/argument to help uniquely identify selected observations
key <- row.names(mtcars)
p <- ggplot(mtcars, aes(x = mpg, y = wt, colour = factor(vs), key = key)) +
geom_point() + facet_wrap(~ cyl)
ggplotly(p) %>% layout(dragmode = "select")
})
output$click <- renderPrint({
d <- event_data("plotly_click")
req(d)
print(mtcars[d$key, ])
})
output$brush <- renderPrint({
d <- event_data("plotly_selected")
req(d)
print(mtcars[d$key, ])
})
}
shinyApp(ui, server)