使用Plotly使用更少的if else语句的闪亮应用程序
我构建了一个闪亮的应用程序，该应用程序可以显示用户随时间推移的代理排名。 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轴是所选用户的计数。
1 个答案:
答案 0 :(得分：0)
首先，除非您希望每次有人加载应用程序时都加载数据集，否则请始终在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")
})
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？