Question

我构建了一个闪亮的应用程序，该应用程序可以显示用户随时间推移的代理排名。 Shiny Application有一个下拉列表，您可以在其中选择一个用户，然后将绘制带有该用户数据的新折线图。但是，下面的代码仅在五个用户上进行了测试，这并不麻烦。但我希望有成千上万的用户可用。有没有更好的方法来调整此代码，这样我就不必在每个用户的代码中添加单独的Plotly图？

数据示例：

    devicereceipttime           sourceusername  GlobalRank
0   2018-12-04T09:26:54.000Z    1111            8507790
1   2018-12-04T09:27:05.000Z    2222            2648
2   2018-12-04T09:27:05.000Z    3333            156433
3   2018-12-04T09:27:10.000Z    5555            295
4   2018-12-04T17:14:51.000Z    1111            1
5   2018-12-04T17:14:51.000Z    4444            1
6   2018-12-04T17:15:11.000Z    2222            373436
7   2018-12-04T17:15:20.000Z    1111            250639
8   2018-12-04T17:15:32.000Z    1111            1
9   2018-12-04T17:15:38.000Z    2444            2965900
10  2018-12-04T17:16:00.000Z    2222            250639
11  2018-12-04T10:52:17.000Z    1111            799963
12  2018-12-04T10:52:26.000Z    3333            1
13  2018-12-04T10:52:26.000Z    1111            799963
14  2018-12-04T17:16:20.000Z    2222            250639
15  2018-12-04T10:52:26.000Z    4444            1
16  2018-12-04T10:52:27.000Z    4444            1
17  2018-12-04T10:52:26.000Z    1111            2648

闪亮的R代码：

#Import libraries
library(shiny)
library(plotly)
library(tidyr)
library(bindrcpp)

# Define UI for application that draws a histogram
ui <- bootstrapPage(

  selectInput(inputId = "n_breaks",
              label = "Select Data:",
              choices = c("User1","User2","User3","User4","User5"),
              selected = "User1"),

  plotlyOutput(outputId = "main_plot", height = "500px")
)

# Define server logic required to draw a Line chart
server <- function(input, output) {

  #Import data
  df1 = read.csv("Data/all_5_test_users.csv")
  #Do cool things with the data
  df2 <- df1 %>% 
    gather(variable, value, -(devicereceipttime:sourceusername)) %>% 
    unite(temp, sourceusername, variable) %>% 
    group_by(temp) %>% 
    mutate(id=1:n()) %>% 
    spread(temp, value) 

  #Remove the id column
  df2 <- subset(df2, select = -c(id))
  #Remove "_GlobalRank" from titles
  names(df2) = gsub(pattern = "_GlobalRank*", replacement = "", x = names(df2)) 

  output$main_plot <- renderPlotly({

    if (input$n_breaks == "User1") {
      #Create variable X 
      x <- df2$devicereceipttime[!is.na(df2$`1111`)]
      #Create variable Y
      y <- df2$`1111`[!is.na(df2$`1111`)]
      #Plotly plot
      plot_ly(x = x, y = y, type = 'scatter', mode = 'lines') %>%
        layout(
          margin = list(b = 190, l = 50)) # to fully display the x and y axis labels
    }
    else if (input$n_breaks == "User2") {
      #Create variable X 
      x <- df2$devicereceipttime[!is.na(df2$`2222`)]
      #Create variable Y 
      y <- df2$`2222`[!is.na(df2$`2222`)]
      #Plotly plot
      plot_ly(x = x, y = y, type = 'scatter', mode = 'lines') %>%
        layout(
          margin = list(b = 190, l = 50)) # to fully display the x and y axis labels 
    }
    else if (input$n_breaks == "User3") {
      #Create variable X 
      x <- df2$devicereceipttime[!is.na(df2$`3333`)]
      #Create variable Y 
      y <- df2$`3333`[!is.na(df2$`3333`)]
      #Plotly plot
      plot_ly(x = x, y = y, type = 'scatter', mode = 'lines') %>%
        layout(
          margin = list(b = 190, l = 50)) # to fully display the x and y axis labels  
    } 
    else if (input$n_breaks == "User4") {
      #Create variable X 
      x <- df2$devicereceipttime[!is.na(df2$`4444`)]
      #Create variable Y 
      y <- df2$`4444`[!is.na(df2$`4444`)]
      #Plotly plot
      plot_ly(x = x, y = y, type = 'scatter', mode = 'lines') %>%
        layout(
          margin = list(b = 190, l = 50)) # to fully display the x and y axis labels  
    }
    else if (input$n_breaks == "User5") {
      #Create variable X 
      x <- df2$devicereceipttime[!is.na(df2$`5555`)]
      #Create variable Y 
      y <- df2$`5555`[!is.na(df2$`5555`)]
      #Plotly plot
      plot_ly(x = x, y = y, type = 'scatter', mode = 'lines') %>%
        layout(
          margin = list(b = 190, l = 50)) # to fully display the x and y axis labels  
    }
  })   
}
# Run the application 
shinyApp(ui = ui, server = server)

编辑：我尝试了以下操作：

#Import libraries

library(shiny)
library(plotly)
library(tidyr)
library(bindrcpp)

# Define UI for application that draws a histogram
ui <- bootstrapPage(

  selectInput(choices = c("User1" = "1111", "User2" = "2222", "User3" = "3333", "User4" = "4444", "User5" = "5555")),

  plotlyOutput(outputId = "main_plot", height = "500px")
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  #Import data
  df1 = read.csv("Data/all_5_test_users.csv")
  #Do cool things with the data
  df2 <- df1 %>% 
    gather(variable, value, -(devicereceipttime:sourceusername)) %>% 
    unite(temp, sourceusername, variable) %>% 
    group_by(temp) %>% 
    mutate(id=1:n()) %>% 
    spread(temp, value) 

  #Remove the id column
  df2 <- subset(df2, select = -c(id))
  #Remove "_event_count_slc" from titles
  names(df2) = gsub(pattern = "_GlobalRank*", replacement = "", x = names(df2)) 

  output$main_plot <- renderPlotly({

    observeEvent(input$n_breaks,{
      #Create variable X 
      x <- df2$devicereceipttime[!is.na(df[[input$n_breaks]])]
      #Create variable Y
      y <- df[[input$n_breaks]][!is.na(df[[input$n_breaks]])]
      #Plotly plot
      plot_ly(x = x, y = y, type = 'scatter', mode = 'lines') %>%
        layout(
          margin = list(b = 190, l = 50)) # to fully display the x and y axis labels  
      updatePlotly("your plot id")
      })
    })
  }  

# Run the application 
shinyApp(ui = ui, server = server)

但是出现以下错误：

Listening on http://127.0.0.1:7673
Warning: Error in UseMethod: no applicable method for 'ggplotly' applied to an object of class "c('Observer', 'R6')"
Stack trace (innermost first):
    82: "plotly"::"ggplotly"
    81: func
    80: origRenderFunc
    79: output$main_plot
     4: <Anonymous>
     3: do.call
     2: print.shiny.appobj
     1: <Promise>
Warning: Error in [[: object of type 'closure' is not subsettable



df2
# A tibble: 55,296 x 6
   devicereceipttime          `1111`  `2222`  `3333`  `4444`  `5555`
   <fct>                      <int>   <int>   <int>   <int>   <int>
 1 2018-12-04T00:00:00.000Z      0       1      0       0       0
 2 2018-12-04T00:00:05.000Z      0       1      0       0       0
 3 2018-12-04T00:00:24.000Z      0       1      0       0       0
 4 2018-12-04T00:00:26.000Z      0       1      0       0       0
 5 2018-12-04T00:00:45.000Z      0       1      0       0       0
 6 2018-12-04T00:00:50.000Z      0       1      0       0       0
 7 2018-12-04T00:01:00.000Z      0       1      0       0       0
 8 2018-12-04T00:01:26.000Z      0       1      0       0       0
 9 2018-12-04T00:01:45.000Z      0       1      0       0       0
10 2018-12-04T00:01:46.000Z      0       1      0       0       0
# ... with 55,286 more rows

x轴是日期时间，y轴是所选用户的计数。

Answer 1

首先，除非您希望每次有人加载应用程序时都加载数据集，否则请始终在server和Ui函数之外加载数据。

回答您的问题：

首先，让您选择selectInput作为键值来简化您的工作，这样您就可以使用该值来显示并稍后输入更新：

choices = c("User1" = "1111","User2" = "2222","User3" = "3333")

在这种情况下，您必须从课程数据框中获取键/值

然后，您可以在obserEvent上使用selectInput，使用新选择的输入来更新绘图，如下所示：

observeEvent(input$n_breaks,{
    #Create variable X 
  x <- df2$devicereceipttime[!is.na(df[[input$n_breaks]])]
  #Create variable Y
  y <- df[[input$n_breaks]][!is.na(df[[input$n_breaks]])]
    updatePlotly("your plot id")
    })

使用Plotly使用更少的if else语句的闪亮应用程序

1 个答案: