我正在尝试根据动画情节图中的选定帧过滤闪亮的情节（对于此应用：http://www.seabbs.co.uk/shiny/ExploreGlobalTB/#）。这是否可以使用当前的event_data实现（供参考：https://plotly-book.cpsievert.me/linking-views-with-shiny.html）？从通读阅读GitHub我不认为这已经实现。如果没有任何其他建议来获得此功能？
图表之间的反应性（点击时）的工作示例如下（警告此代码使用getTBinR并从此处提取WHO TB数据（http://www.who.int/tb/country/data/download/en/）。
#install.packages(shiny)
library(shiny)
# install.packages(devtools)
# devtools::install_github("seabbs/getTBinR", ref = "improved_interactive_plots")
library(getTBinR)
ui <- fluidPage(
plotlyOutput("map_tb_burden"),
verbatimTextOutput("country")
)
server <- function(input, output, session) {
# Make map of metric
output$map_tb_burden <- renderPlotly({
map <- map_tb_burden(interactive = TRUE, year = c(2000:2016))
})
#Get country clicked on map
country <- reactive({
country <- event_data(event = "plotly_click", source = "WorldMap")
country <- country$key[[1]]
})
output$country <- renderText({
if (is.null(country())) {
"Select a country for more information"
} else {
paste0("Showing data for ", country())
}
})
}
shinyApp(ui, server)
此数据的框架是ggplot对象中的Year，然后使用plotly（映射函数代码：https://github.com/seabbs/getTBinR/blob/improved_interactive_plots/R/map_tb_burden.R）进行转换。理想情况下，我可以使用event_data框架，但如果失败，可以从plotly对象中选择当前帧吗？
从MLavoie的回答中修改的第二个例子。只是为了澄清目的是提取国家的点击和年份，因为这是动画结束。两个示例都在点击时提取国家/地区，以下内容清楚地表明年份动态不会动态变化。
library(shiny)
library(plotly)
library(getTBinR)
tb_burden <- get_tb_burden()
ui <- fluidPage(
plotlyOutput("map_tb_burden"),
dataTableOutput("country")
)
server <- function(input, output, session) {
# Make map of metric
output$map_tb_burden <- renderPlotly({
key <- tb_burden$iso3
g <- list(
showframe = FALSE,
showcoastlines = FALSE,
projection = list(type = 'Mercator')
)
plot_ly(data = tb_burden, frame = ~year, type = 'choropleth', z = ~e_inc_100k, text = ~country, color = ~e_inc_100k, colors = "Reds", locations = ~iso3, key = key) %>%
layout(geo = g)
})
#Get country clicked on map
countryB <- reactive({
d <- event_data("plotly_click")
ff <- data.frame(d[3])
ff
})
output$country <- renderDataTable({
d <- event_data("plotly_click")
# if (is.null(d))
# return(NULL)
withProgress(message = 'Click on a country', {
validate(
need(d, 'Click on a country!')
)
testing <- tb_burden %>% filter(iso3 == countryB()$key)
testing
})
})
}
shinyApp(ui, server)
答案 0 :(得分：0)
我仍然不确定你想要什么，但这里有些东西。我没有使用map_tb_burden而是使用plot_ly作为图片。在示例中，它只打印文本，但您可以决定进行绘图。
library(shiny)
library(plotly)
library(getTBinR)
tb_burden <- get_tb_burden()
ui <- fluidPage(
plotlyOutput("map_tb_burden"),
sliderInput("animation", "Looping Animation:", min = 2000, max = 2016, value = 2000, step = 1, animate= animationOptions(interval=1000, loop=FALSE, playButton = "PLAY", pauseButton = "PAUSE")),
dataTableOutput("country")
)
server <- function(input, output, session) {
# Make map of metric
output$map_tb_burden <- renderPlotly({
key <- tb_burden$iso3
g <- list(
showframe = FALSE,
showcoastlines = FALSE,
projection = list(type = 'Mercator')
)
tb_burdenb <- tb_burden %>% filter(year == input$animation)
key <- tb_burdenb$iso3
plot_ly(data = tb_burdenb, type = 'choropleth', z = ~e_inc_100k, text = ~country, color = ~e_inc_100k, colors = "Reds", locations = ~iso3, key = key) %>%
layout(geo = g)
})
sliderValues <- reactive({
# Compose data frame
data.frame(
Name = c("Animation"),
Value = as.character(c(input$animation)),
stringsAsFactors=FALSE)
})
#Get country clicked on map
countryB <- reactive({
d <- event_data("plotly_click")
ff <- data.frame(d[3])
ff
})
output$country <- renderDataTable({
d <- event_data("plotly_click")
# if (is.null(d))
# return(NULL)
withProgress(message = 'Click on a country', {
validate(
need(d, 'Click on a country!')
)
testing <- tb_burden %>% filter(iso3 == countryB()$key) %>% filter(year == input$animation)
testing
})
})
}
shinyApp(ui, server)