我正在尝试设置一个仪表板，用户可以在其中按年份、状态和产品过滤数据。理想情况下，它应该在每个产品有 2 个相关变量的情况下运行，一个满意度分数和一个重要性分数。从数据集中过滤时，应该为用户感兴趣的各个部分计算汇总平均值。然后是平均重要性和平均满意度分数被组合成一个 data.frame 并绘制在一个图上。
这就是我所在的地方...
我的用户界面
library(shiny)
library(dplyr)
library(shinydashboard)
library(tidyverse)
ui <- dashboardPage(
dashboardHeader(title="Membership Satisfaction"),
dashboardSidebar(
sidebarMenu(
menuItem("Demographics Dashboard", tabName = "demos", icon =
icon("dashboard"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "demos",
sidebarPanel(
checkboxGroupInput("inpt","Select variables to plot",
choices =
c("Web" = 1,"Huddle" = 3, "Other" = 5,
"Test" = 7)),
checkboxGroupInput("role",
"Select Primary Role of Interest",
choices = c("Student" = 1, "Not" = 2)),
checkboxGroupInput("range",
"Select year(S) of Interest",
choices = c("2016"=2,"July 2017"=1))),
fluidPage(
plotOutput("plot")
)))))
还有我的服务器:
server <- function(input,output){
library(tidyverse)
x <- reactive({
inpt <- as.double(input$inpt)
role <- as.double(input$role)
range <- as.double(input$range)
GapAnalysis_LongFormB %>%
filter(Product %in% inpt,
status %in% role,
year %in% range) %>%
summarize(avg = mean(Score, na.rm = TRUE)) %>%
pull(-1)
})
y <- reactive({
inpt <- as.double(input$inpt)+1
role <- as.double(input$role)
range <- as.double(input$range)
GapAnalysis_LongFormB %>%
filter(Product %in% inpt,
status %in% role,
year %in% range) %>%
summarize(avg = mean(Score, na.rm = TRUE))%>%
pull(-1)
})
xyCoords<- reactive({
x <- x()
y <- y()
data.frame(col1=x, col2=y)
})
output$plot <- renderPlot({
xyCoords <- xyCoords()
xyCoords %>%
ggplot(aes(x = col1, y = col2)) +
geom_point(colour ="green", shape = 17, size = 5 )+
labs(x = "Mean Satisfaction", y = "Mean Importance") +
xlim(0,5) + ylim(0,5) +
geom_vline(xintercept=2.5) +
geom_hline(yintercept = 2.5)
})
}
shinyApp (ui = ui, server = server)
以下是变量结构:
> dput(head(GapAnalysis_LongFormB))
structure(list(status = c(1, 5, 5, 1, 1, 5), year = c(1, 1, 1,
1, 1, 1), Product = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("1",
"2", "3", "4"), class = "factor"), Score = c(2, 5, 3, 5, 4, 4
)), .Names = c("status", "year", "Product", "Score"), row.names = c(NA,
6L), class = "data.frame")
它有效 - 只是没有完全按照我的需要去做。目前，它需要在绘制之前输入所有 3 个复选框输入变量(输入、角色、范围)。我需要它来要求一个产品，但为每个额外的输入绘制。意思是，如果他们选择 Web，它将绘制 Web 的平均值。如果他们选择 Web 和 2017 年，它将绘制 2017 年 Web 的平均值。
非常感谢任何帮助!!!!
最佳答案
变化
我认为这里有一些事情会造成一些麻烦:
首先，您使用的是 input$range尽管您从未定义 input$range .您已经定义了一个 input$yrs ，所以我把它改成了 input$range .
接下来，您正在使用 ==与 filter , 什么时候应该使用 %in%反而。这允许多个选择，而不仅仅是一个选择。如果您只需要一个选择，请使用 radioButtons()而不是 checkboxGroupInput() .
在您的 summarize ，您正在使用额外的和不必要的子集。我们已经使用了完全相同的 filter在数据集上，因此无需在 summarize 内应用子集.
最后，我认为您的 xyCoords 可能会遇到一些严重的问题。 .由于您在两个数据集上使用了不同的过滤器，因此 x 的矢量长度可能会有所不同。和 y .这会导致问题。我的建议是你以某种方式将这两个数据集与 full_join 结合起来。确保x和 y将始终是相同的长度。这不是关于 shiny 的问题以及更多关于 dplyr以及。
我也改了你的一些reactive对象。
用户界面:
library(shiny)
library(shinydashboard)
library(tidyverse)
ui <- dashboardPage(
dashboardHeader(title="Membership Satisfaction"),
dashboardSidebar(
sidebarMenu(
menuItem("Demographics Dashboard", tabName = "demos", icon =
icon("dashboard"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "demos",
sidebarPanel(
checkboxGroupInput("inpt","Select variables to plot", choices =
c("Web" = 1,"Huddle" = 3, "Other" = 5, "Test" = 7)),
checkboxGroupInput("role",
"Select Primary Role of Interest",
choices = c("Student" = 1, "Not" = 2)),
checkboxGroupInput("range",
"Select year(S) of Interest",
choices = c("2016"=2,"July 2017"=1))),
fluidPage(
plotOutput("plot")
)))))
服务器:
server <- function(input,output){
library(tidyverse)
GapAnalysis_LongFormImpt <- structure(list(status = c(1, 5, 5, 1, 1, 5), year = c(1, 1, 1,
1, 1, 1), Product = structure(c(2L, 2L, 2L, 2L, 2L, 2L), .Label = c("1",
"2", "3", "4"), class = "factor"), Score = c(1, 1, 3, 2, 2, 1
)), .Names = c("status", "year", "Product", "Score"), row.names = c(NA,
6L), class = "data.frame")
GapAnalysis_LongFormSat <- structure(list(status = c(5, 5, 1, 1, 5, 1), year = c(1, 1, 1,
1, 1, 1), Product = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = c("1",
"2", "3", "4"), class = "factor"), Score = c(2, 3, 2, 1, 1, 1
)), .Names = c("status", "year", "Product", "Score"), row.names = c(NA,
6L), class = "data.frame")
x <- reactive({
inpt <- as.double(input$inpt)
role <- as.double(input$role)
range <- as.double(input$range)
GapAnalysis_LongFormSat %>%
filter(Product %in% inpt,
status %in% role,
year %in% range) %>%
summarize(Avg = mean(Score, na.rm = TRUE)) %>%
pull(-1)
})
y <- reactive({
inpt <- as.double(input$inpt)
role <- as.double(input$role)
range <- as.double(input$range)
GapAnalysis_LongFormImpt %>%
filter(Product %in% inpt,
status %in% role,
year %in% range) %>%
summarize(Avg = mean(Score, na.rm = TRUE))%>%
pull(-1)
})
xyCoords<- reactive({
x <- x()
y <- y()
data.frame(col1=x, col2=y)})
output$plot <- renderPlot({
xyCoords <- xyCoords()
xyCoords %>%
ggplot(aes(x = col1, y = col2)) +
geom_point(colour ="green", shape = 17, size = 5 )+
labs(x = "Mean Satisfaction", y = "Mean Importance") +
xlim(0,5) + ylim(0,5) +
geom_vline(xintercept=2.5) +
geom_hline(yintercept = 2.5)})
}
shinyApp (ui = ui, server = server)
关于R Shiny dplyr 无功滤波器，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/50118326/