所以我最近开始尝试闪亮，我非常喜欢。但是，到目前为止，我只有非常简单的可视化效果。现在，我试图创建一个折线图，其中包含汇总数据（amounts = yaxis）并基于x轴的离散值（YearsMon f.i. 201901）。
因此，我的想法是，我有一个滑块输入，可以在其中指定年份范围，还有一个过滤器，它使我能够过滤不同类别的汇总数据。
下面提供了数据集示例。
Generation Amount Rating
[1,] "201806" "100" "A"
[2,] "201807" "200" "B"
[3,] "201808" "300" "A"
[4,] "201809" "200" "B"
[5,] "201810" "200" "A"
[6,] "201811" "100" "B"
[7,] "201812" "130" "A"
[8,] "201901" "400" "B"
[9,] "201902" "300" "A"
[10,] "201903" "200" "B"
[11,] "201806" "300" "A"
[12,] "201807" "100" "B"
[13,] "201808" "400" "A"
[14,] "201809" "320" "B"
[15,] "201810" "200" "A"
[16,] "201811" "90" "B"
[17,] "201812" "230" "A"
[18,] "201901" "430" "B"
[19,] "201902" "190" "A"
[20,] "201903" "320" "B"
这是我尝试的以下代码：
Generation <- c(201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903, 201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903)
Amount <- c(100, 200, 300, 200, 200, 100, 130, 400, 300, 200, 300, 100, 400, 320, 200, 90, 230, 430, 190, 320)
Rating <- c("A", "B", "A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B" )
df1 = cbind(Generation, Amount, Rating)
ui1 <- fluidPage(
theme = shinytheme("slate"),
sidebarLayout(
sidebarPanel(
sliderTextInput(inputId = "range",
label = "Choose range",
choices = Generation,
selected = range(Generation),
grid = TRUE),
selectInput(inputId = "rat",
label = "Chose the rating",
choices = unique(df1$rating))
),#sidebar panel
mainPanel(verbatimTextOutput("graph1")
)# closing main panel
)# closing sidebarlayout
)# closing fluidpage
server1 = function(input, output) {
#interactive range
my_range <- reactive({
cbind(input$range[1],input$range[2])
})
#create the filter
df_final <- reactive({
filter(df1, between(Generation,input$range[1],input$range[2])) %>%
select(Generation,input$rat)
})
# createn the aggregation
df_final2 = reactive({
df_final() %>%
select(Generation, Rating, Amount) %>%
group_by(Generation) %>%
summarise(sum_amount = sum(Amount))
})
# plot the graph
output$graph1 <- renderPlot({
req(df_fianl2())
ggplot(df_final2(), aes(x = Generation, y = sum_amount)) +
geom_line(aes(colour = Rating)) +
geom_point()
})
}
所以我想看的基本上是折线图。在x轴上，可以使用SliderInput过滤的Generation（YearMon）。 在y轴上，由于金额在同一年多次重复，因此总计。因此，我想查看该年度的总数以作图。 最后但并非最不重要的一点是，我希望能够看到等级A和等级B的图。
不幸的是，我仍然对反应性概念感到困惑，因此，我不知道如何精确地以这种方式使其具有反应性。
我尝试在线查找一些解决方案，但发现只有一个我根本不了解的解决方案（Line Chart Dashboard with Aggregated Data Points）。因此，任何帮助都是高度重视的！
答案 0 :(得分：1)
考虑GyD的评论，这是一个简单的示例。我已经简化了您的代码，但仍有改进的空间：
library(shiny)
library(dplyr)
library(ggplot2)
library(shinythemes)
library(shinyWidgets)
Generation <- c(201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903, 201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903)
Amount <- c(100, 200, 300, 200, 200, 100, 130, 400, 300, 200, 300, 100, 400, 320, 200, 90, 230, 430, 190, 320)
Rating <- c("A", "B", "A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B" )
df1 = data.frame(Generation, Amount, Rating)
ui1 <- fluidPage(
theme = shinytheme("slate"),
sidebarLayout(
sidebarPanel(
sliderTextInput(inputId = "range",
label = "Choose range",
choices = Generation,
selected = range(Generation),
grid = TRUE),
selectInput(inputId = "rat",
label = "Choose the rating",
choices = unique(df1$Rating))
),#sidebar panel
mainPanel(plotOutput("graph1")
)# closing main panel
)# closing sidebarlayout
)# closing fluidpage
server1 = function(input, output) {
#interactive range
# my_range <- reactive({
# cbind(input$range[1],input$range[2])
# })
#create the filter and aggregation
df_final <- reactive({
df1 %>% filter(between(Generation,input$range[1],input$range[2]), Rating == input$rat) %>%
group_by(Generation, Rating) %>%
summarise(sum_amount = sum(Amount))
})
# plot the graph
output$graph1 <- renderPlot({
req(df_final())
ggplot(df_final(), aes(x = Generation, y = sum_amount)) +
geom_line(aes(colour = Rating)) +
geom_point()
})
}
shinyApp(ui1, server1)
更新
对于以下评论中的问题1：
library(shiny)
library(dplyr)
library(ggplot2)
library(shinythemes)
library(shinyWidgets)
Generation <- c(201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903, 201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903)
Amount <- c(100, 200, 300, 200, 200, 100, 130, 400, 300, 200, 300, 100, 400, 320, 200, 90, 230, 430, 190, 320)
Rating <- c("A", "B", "A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B" )
Test <- c(1, 2, 1, 1, 1, 2, 2, 1, 2, 2, 2, 1, 1, 2, 1, 2, 2, 1, 2, 1)
df1 = data.frame(Generation, Amount, Rating, Test)
ui1 <- fluidPage(
theme = shinytheme("slate"),
sidebarLayout(
sidebarPanel(
sliderTextInput(inputId = "range",
label = "Choose range",
choices = Generation,
selected = range(Generation),
grid = TRUE),
selectInput(inputId = "rat",
label = "Choose the rating",
choices = unique(df1$Rating)),
selectInput(inputId = "test",
label = "Choose the test",
choices = unique(df1$Test))
),#sidebar panel
mainPanel(plotOutput("graph1")
)# closing main panel
)# closing sidebarlayout
)# closing fluidpage
server1 = function(input, output) {
#interactive range
# my_range <- reactive({
# cbind(input$range[1],input$range[2])
# })
#create the filter and aggregation
df_final <- reactive({
df1 %>% filter(between(Generation,input$range[1],input$range[2]), Rating == input$rat, Test == input$test) %>%
group_by(Generation) %>%
summarise(sum_amount = sum(Amount))
})
# plot the graph
output$graph1 <- renderPlot({
req(df_final())
ggplot(df_final(), aes(x = Generation, y = sum_amount)) +
geom_line() +
geom_point()
})
}
shinyApp(ui1, server1)
请注意，我是如何在df1中添加“测试”列的，“评级”和“测试”都在过滤器中，但不在group_by中。
对于下面评论中的问题2：
library(shiny)
library(dplyr)
library(ggplot2)
library(shinythemes)
library(shinyWidgets)
Generation <- c(201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903, 201806, 201807, 201808, 201809, 201810, 201811, 201812, 201901, 201902, 201903)
Amount <- c(100, 200, 300, 200, 200, 100, 130, 400, 300, 200, 300, 100, 400, 320, 200, 90, 230, 430, 190, 320)
Rating <- c("A", "B", "A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B","A", "B" )
df1 = data.frame(Generation, Amount, Rating)
ui1 <- fluidPage(
theme = shinytheme("slate"),
sidebarLayout(
sidebarPanel(
sliderTextInput(inputId = "range",
label = "Choose range",
choices = Generation,
selected = range(Generation),
grid = TRUE),
selectInput(inputId = "rat",
label = "Choose the rating",
choices = c("A", "B", "A & B - one line", "A & B - two lines"))
),#sidebar panel
mainPanel(plotOutput("graph1")
)# closing main panel
)# closing sidebarlayout
)# closing fluidpage
server1 = function(input, output) {
#interactive range
# my_range <- reactive({
# cbind(input$range[1],input$range[2])
# })
#create the filter and aggregation
df_final <- reactive({
if(input$rat %in% c("A", "B")) {
df1 %>% filter(between(Generation,input$range[1],input$range[2]), Rating == input$rat) %>%
group_by(Generation) %>%
summarise(sum_amount = sum(Amount))
}else if(input$rat == "A & B - one line"){
df1 %>% filter(between(Generation,input$range[1],input$range[2])) %>%
group_by(Generation) %>%
summarise(sum_amount = sum(Amount))
}else if(input$rat == "A & B - two lines"){ # this if isn't necessary but included for clarity
df1 %>% filter(between(Generation,input$range[1],input$range[2])) %>%
group_by(Generation, Rating) %>%
summarise(sum_amount = sum(Amount))
}
})
# plot the graph
output$graph1 <- renderPlot({
req(df_final())
if(input$rat != "A & B - two lines"){
ggplot(df_final(), aes(x = Generation, y = sum_amount)) +
geom_line() +
geom_point()
}else{
ggplot(df_final(), aes(x = Generation, y = sum_amount)) +
geom_line(aes(colour = Rating)) +
geom_point()
}
})
}
shinyApp(ui1, server1)
请注意只有两行选项需要颜色参数。基本上，selectInput或radioButton仅指示ui中的选择（您可以根据需要重命名这些选择），真正的工作发生在服务器中。同样，我确定还有其他方法可以做到，但是，如果您掌握了tidyverse函数，您将能够根据需要操纵数据。