在R Shiny中更改要绘制的变量时，防止绘制的选定轨迹重置

ivqmmu1c  于 2023-02-20  发布在  其他
关注(0)|答案(2)|浏览(116)

我正在尝试做一个闪亮的应用程序，它包括一个侧边栏面板和一个绘图。在面板中，我有单选按钮来选择哪个ID应该被绘制。我也有多个变量，用户可以使用绘图图例关闭和打开。
我希望在应用程序第一次打开时绘图是空的。为此，我在绘图中使用了visible = "legendonly"。但是，当在侧边栏面板中更改ID时，我希望保留用户已经激活的轨迹（通过在图例中单击它们）;但是，由于绘图每次都重新生成，因此它再次使用visible = "legendonly"选项，这将导致绘图重置。
当在侧边栏面板中选择了不同的选项时，有没有办法保留轨迹（只保留已经选择的轨迹）？
见以下可重现示例;请注意，我做了这个例子在本地运行。2你需要分别加载数据和包到你的R会话中。3数据可以在问题的底部找到。

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年6月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

2条答案

按热度按时间
f87krz0w

f87krz0w1#

下面的代码使用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中的"17.3.1部分绘图更新"一章，绘图的函数参考和this answer。

数据：

### 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))
    • 编辑：**

下面是一个替代服务器函数，它使用单个plotlyProxyInvoke调用更新跟踪数据（避免for循环）：

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)
  
  IDDataList <- split(mdata %>% mutate(Date = make_date(Year, Month, 15)), ~ ID + Variable)
  
  observe({
    selectedIDDataList <- setNames(lapply(list("Date", "Value"), function(i){
      unname(lapply(IDDataList[paste0(input$myID, ".Var", c(1L, 2L))], function(j){j[[i]]}))
    }), c("x", "y"))
    plotlyProxyInvoke(myPlotProxy, "restyle", selectedIDDataList, seq_along(selectedIDDataList)-1)
  })
}
赞(0）分享  回复(0）举报  2023-02-20
jm81lzqq

jm81lzqq2#

我所能想到的是添加一个复选框来选择要绘制的变量，而不是在图例中关闭和打开它们。使用这种方法，而不是使用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)

赞(0）分享  回复(0）举报  2023-02-20
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备2022004421号-2 NULL123 https://www.null123.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com