【问题标题】:Prevent plotly selected traces from resetting when changing the variable to be plotted in R Shiny防止在更改要在 R Shiny 中绘制的变量时重置绘图选择的轨迹
【发布时间】:2023-04-06 09:38:01
【问题描述】:

我正在尝试制作一个闪亮的应用程序,它由一个侧边栏面板和一个情节组成。在面板中,我有单选按钮来选择应该绘制哪个 ID。我还有多个变量,用户可以使用情节图例关闭和打开。

我希望在应用首次打开时绘图为空。为此,我在我的情节中使用visible = "legendonly"。但是,当在侧边栏面板中更改 ID 时,我想保留用户已经激活的痕迹(通过在图例中单击它们);但是,由于每次都会重新生成 plotly,因此它再次使用 visible = "legendonly" 选项并导致情节重置。

当在侧边栏面板中选择了不同的选项时,是否有办法保留痕迹(仅限已选择的痕迹)?

请参阅下面的可重现示例;请注意,我制作了此示例以在本地运行。您需要将数据和包分别加载到 R 会话中。数据可以在问题的底部找到。

library(shiny)
library(plotly)
library(lubridate)

### Read mdata into your R session
# UI 

uix <- shinyUI(pageWithSidebar(
  headerPanel("Data"),
  sidebarPanel(
    radioButtons('vars', 'ID', 
                 c("1", "2")),
    helpText('Select an ID.')
  ),
  mainPanel(
    h4("Plot"),
    plotlyOutput("myPlot")
  )
)
)
# SERVER 

serverx <- function(input, output) {
 
  #load("Data/mdata.RData") #comment out this part and load data locally
  
  # a large table, reative to input$show_vars
  output$uteTable = renderDataTable({
    ute[, input$show_vars, drop = FALSE]
  })
  
  output$myPlot = renderPlotly(
    {
      p <- plot_ly() %>% 
        layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
               yaxis = list(title = "Y"))
      
      ## Add the IDs selected in input$vars
      for (item in input$vars) {
        mdata %>% 
          mutate(Date = make_date(Year, Month, 15)) %>% 
          filter(ID == item) -> foo
        
        p <- add_lines(p, data = foo, x = ~Date, y = ~Value, color = ~Variable, visible = "legendonly",
                       evaluate = TRUE)
        
        p <- p %>% layout(showlegend = TRUE,
                          legend = list(orientation = "v",   # show entries horizontally
                                        xanchor = "center",  # use center of legend as anchor
                                        x = 100, y=1))        
      }
      print(p)
    })
}
shinyApp(uix, serverx)

reprex package (v0.3.0) 于 2020-06-12 创建

问题:改成ID == 2时是否可以保留Var1的踪迹?

想法: 我认为如果我可以在应用部署后立即将visible = 'legendonly 更改为TRUE,那么它只适用于第一个情节的例子。可能,我还需要将evaluate 更改为FALSE

数据:

mdata <- structure(list(Year = c(2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
2015L, 2015L, 2015L, 2015L, 2015L, 2015L), Month = c(1L, 1L, 
1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L, 
5L, 5L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 9L, 9L, 
9L, 9L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 11L, 12L, 12L, 12L, 
12L), Variable = c("Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
"Var2", "Var2"), ID = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 
2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 
1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2), Value = c(187.797761979167, 
6.34656438541666, 202.288468333333, 9.2249309375, 130.620451458333, 
4.61060465625, 169.033213020833, 7.5226940625, 290.015582677083, 
10.8697671666667, 178.527960520833, 7.6340359375, 234.53493728125, 
8.32400878125, 173.827054583333, 7.54521947916667, 164.359205635417, 
5.55496292708333, 151.75458625, 6.361610625, 190.124467760417, 
6.45046077083333, 191.377006770833, 8.04720916666667, 170.714612604167, 
5.98860073958333, 210.827157916667, 9.46311385416667, 145.784868927083, 
5.16647911458333, 159.9545675, 6.7466725, 147.442681895833, 5.43921594791667, 
153.057018958333, 6.39029208333333, 165.6476956875, 5.63139815625, 
197.179256875, 8.73210604166667, 148.1879651875, 5.58784840625, 
176.859451354167, 7.65670020833333, 186.215496677083, 7.12404453125, 
219.104379791667, 9.39468864583333)), class = c("grouped_df", 
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -48L), groups = structure(list(
    Year = 2015L, .rows = list(1:48)), row.names = c(NA, -1L), class = c("tbl_df", 
"tbl", "data.frame"), .drop = TRUE))

【问题讨论】:

    标签: r shiny plotly r-plotly shinyapps


    【解决方案1】:

    以下使用plotlyProxy 替换现有绘图对象(和轨迹)的数据,因此避免重新渲染绘图。这种方法比重新渲染更快。

    library(shiny)
    library(plotly)
    library(lubridate)
    
    # UI
    uix <- shinyUI(pageWithSidebar(
      headerPanel("Data"),
      sidebarPanel(
        radioButtons('myID', 'ID', 
                     c("1", "2")),
        helpText('Select an ID.')
      ),
      mainPanel(
        h4("Plot"),
        plotlyOutput("myPlot")
      )
    )
    )
    
    # SERVER
    serverx <- function(input, output, session) {
    
      output$myPlot = renderPlotly({
        p <- plot_ly() %>% 
          layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
                 yaxis = list(title = "Y"))
        
        mdata %>% 
          mutate(Date = make_date(Year, Month, 15)) %>% 
          filter(ID == 1) -> IDData
        
        p <- add_lines(p, data = IDData, x = ~Date, y = ~Value, 
                                         color = ~Variable, visible = "legendonly")
        
        p <- p %>% layout(showlegend = TRUE,
                          legend = list(orientation = "v",   # show entries horizontally
                                        xanchor = "center",  # use center of legend as anchor
                                        x = 100, y=1))        
        p
      })
      
      
      myPlotProxy <- plotlyProxy("myPlot", session)
      
      observe({
        mdata %>%
          mutate(Date = make_date(Year, Month, 15)) %>%
          filter(ID == input$myID) -> IDData
        
        req(IDData)
        uniqueVars <- unique(IDData$Variable)
        
        for(i in seq_along(uniqueVars)){
          IDData %>% filter(Variable == uniqueVars[i]) -> VarData
          plotlyProxyInvoke(myPlotProxy, "restyle", list(x = list(VarData$Date), 
                                                         y = list(VarData$Value)), list(i-1))
        }
      })
      
    }
    
    shinyApp(uix, serverx)
    

    更多信息请参见plotly book、plotly 的function referencethis answer 中的“17.3.1 部分情节更新”一章。

    数据:

    ### Read mdata into your R session
    mdata <- structure(list(Year = c(2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
    2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
    2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
    2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
    2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 
    2015L, 2015L, 2015L, 2015L, 2015L, 2015L), Month = c(1L, 1L, 
    1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L, 
    5L, 5L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 9L, 9L, 
    9L, 9L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 11L, 12L, 12L, 12L, 
    12L), Variable = c("Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
    "Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
    "Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
    "Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
    "Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
    "Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1", 
    "Var2", "Var2"), ID = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 
    2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 
    1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2), Value = c(187.797761979167, 
    6.34656438541666, 202.288468333333, 9.2249309375, 130.620451458333, 
    4.61060465625, 169.033213020833, 7.5226940625, 290.015582677083, 
    10.8697671666667, 178.527960520833, 7.6340359375, 234.53493728125, 
    8.32400878125, 173.827054583333, 7.54521947916667, 164.359205635417, 
    5.55496292708333, 151.75458625, 6.361610625, 190.124467760417, 
    6.45046077083333, 191.377006770833, 8.04720916666667, 170.714612604167, 
    5.98860073958333, 210.827157916667, 9.46311385416667, 145.784868927083, 
    5.16647911458333, 159.9545675, 6.7466725, 147.442681895833, 5.43921594791667, 
    153.057018958333, 6.39029208333333, 165.6476956875, 5.63139815625, 
    197.179256875, 8.73210604166667, 148.1879651875, 5.58784840625, 
    176.859451354167, 7.65670020833333, 186.215496677083, 7.12404453125, 
    219.104379791667, 9.39468864583333)), class = c("grouped_df", 
    "tbl_df", "tbl", "data.frame"), row.names = c(NA, -48L), groups = structure(list(
        Year = 2015L, .rows = list(1:48)), row.names = c(NA, -1L), class = c("tbl_df", 
    "tbl", "data.frame"), .drop = TRUE))
    

    【讨论】:

      【解决方案2】:

      我能想到的是添加一个复选框来选择要绘制的变量,而不是在图例中关闭和打开它们。使用此方法,而不是使用visible = legendonly,我保留未选中默认值的复选框。此外,当用户更改 ID 时,变量保持不变,因此会为下一个 ID 绘制。见下文;

      library(shiny)
      library(plotly)
      library(lubridate)
      
      ### Read mdata into your R session
      
      # UI 
      
      uix <- shinyUI(pageWithSidebar(
        headerPanel("Data"),
        sidebarPanel(
          radioButtons('vars', 'ID', 
                       c("1", "2")),
          checkboxGroupInput('varp', 'Variable',
                             c("Var1", "Var2")),
          helpText('Select an ID and Variables to be plotted.')
        ),
        mainPanel(
          h4("Plot"),
          plotlyOutput("myPlot")
        )
      )
      )
      
      # SERVER 
      
      serverx <- function(input, output) {
      
        #load("Data/mdata.RData") #comment out this part and load data locally
      
        # a large table, reative to input$show_vars
        output$uteTable = renderDataTable({
          ute[, input$show_vars, drop = FALSE]
        })
      
        output$myPlot = renderPlotly(
          {
            p <- plot_ly() %>% 
              layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
                     yaxis = list(title = "Y"))
      
            ## Add the IDs selected in input$vars
            for (item in input$vars) {
              mdata %>% 
                mutate(Date = make_date(Year, Month, 15)) %>% 
                filter(ID == item,
                       Variable %in% input$varp)-> foo
      
              p <- add_lines(p, data = foo, x = ~Date, y = ~Value, color = ~Variable, evaluate = TRUE)
      
              p <- p %>% layout(showlegend = TRUE,
                                legend = list(orientation = "v",   # show entries horizontally
                                              xanchor = "center",  # use center of legend as anchor
                                              x = 100, y=1))        
            }
            print(p)
          })
      }
      
      shinyApp(uix, serverx)
      

      【讨论】:

      • 这个问题(自己)现在为您解答了吗?
      • @TonioLiebrand 不,正如我在赏金横幅中解释的那样,我认为这是一种解决方法。
      猜你喜欢
      • 2023-02-16
      • 2016-09-28
      • 2018-05-22
      • 1970-01-01
      • 2014-04-13
      • 1970-01-01
      • 2017-01-18
      • 2016-08-16
      • 2013-04-09
      相关资源
      最近更新 更多