R-dplyr反应式过滤器
我正在尝试设置一个仪表板,用户可以在其中按年份、状态和产品筛选数据。理想情况下,它应该在每个产品都有两个相关变量的情况下运行,一个是满意度得分,一个是重要性得分。当从数据集中筛选时,应该为用户感兴趣的各个部分计算一个汇总平均值。然后,将平均重要性和平均满意度分数合并到一个data.frame中,并绘制在一个绘图上 这就是我现在的位置 我的用户界面 它工作-只是没有做我需要的。目前,它需要在所有3个复选框输入变量(inpt、role、range)中输入,然后才能打印。我需要它来要求一个产品,但为每一个额外的输入绘图。也就是说,如果他们选择Web,它将绘制Web的平均值。如果他们选择Web和2017年,它将绘制2017年Web的平均值 非常感谢您的帮助 变化 我认为这里有一些事情会引起一些麻烦: 首先,您使用的是R-dplyr反应式过滤器,r,filter,shiny,dplyr,reactive,R,Filter,Shiny,Dplyr,Reactive,我正在尝试设置一个仪表板,用户可以在其中按年份、状态和产品筛选数据。理想情况下,它应该在每个产品都有两个相关变量的情况下运行,一个是满意度得分,一个是重要性得分。当从数据集中筛选时,应该为用户感兴趣的各个部分计算一个汇总平均值。然后,将平均重要性和平均满意度分数合并到一个data.frame中,并绘制在一个绘图上 这就是我现在的位置 我的用户界面 它工作-只是没有做我需要的。目前,它需要在所有3个复选框输入变量(inpt、role、range)中输入,然后才能打印。我需要它来要求一个产品,但为每
input$range
,尽管您从未定义过input$range
。您已经定义了一个input$yrs
,因此我将其更改为input$range
接下来,您要将==
与过滤器一起使用,而此时您应该在%
中使用%。这允许多个选择,而不仅仅是单个选择。如果您只需要一个选项,请使用radioButtons()
而不是checkboxGroupInput()
在您的摘要中
,您正在使用一个附加的和不必要的子集。我们已经在数据集上使用了完全相同的过滤器
,因此无需在摘要
中应用子集
最后,我认为您的xyCoords
可能会遇到一些严重的问题。由于您在两个数据集上使用不同的过滤器,因此可能会导致x
和y
的向量长度不同。这会引起问题。我的建议是以某种方式将这两个数据集与full_join
结合起来,以确保x
和y
的长度始终相同。这不是关于shiny
的问题,而是关于dplyr
的问题
我还更改了一些被动对象
用户界面:
库(闪亮)
图书馆(shinydashboard)
图书馆(tidyverse)
ui我没有运行代码,但将看作.integer(输入$inpt+1)
。那不应该是as.integer(input$inpt)+1
我认为它们都会产生相同的结果(至少在我运行代码时没有任何更改)您的代码中有一些拼写错误,应该是摘要(Avg=
。一个=
而不是两个。谢谢!!这只允许在填充所有字段后进行打印,有没有办法让它为每个细分/变量进行打印?对原始代码进行了更正…对于打印每个变量/细分,我建议使用您拥有的代码为所有要选择的内容添加默认值checkboxGroupInput
@davegreenwald中的所选的
参数我现在遇到了颜色/形状编码方面的所有问题…也许您可以帮助??链接到问题->
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")
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)