The goal is to create an interactive (Single) plot that the user can select
the year of interest, the status of the member, and the service of interest
and each will select the correct data point. Each x,y coordinate is the
mean satisfaction and mean importance respectively. I have it working with
just the services (plot colm), but Id like to be able to have the user
have more selection. My attempt for multiple inputs is plotOutput("test")..
Any ideas how to get this code working?? THANK YOU!!
UI:
importance <- c(4.25, 3.08)
satisfaction <- c(3.90, 3.18)
dfGap <- data.frame(importance, satisfaction)
imp.A <- c("3.2","2.5","3.3","4.5","4","3.7")
sat.b <- c("2.2", "3.7","5","1.2","2.6","3")
yr.c <- c("2016","2016","2017","2016", "2016","2017")
status.d <- c("Student", "Not","Student", "Not","Student","Student")
service.e <- c("Huddle", "Web", "Test", "Web","Other","Huddle")
dfTest <- data.frame(imp.A,sat.b,yr.c,status.d, service.e)
colDepend = ("darkred")
range <- c("2016"=1,"2017"=2)
choices <- c("Web" = 1,"Huddle" = 2, "Other" = 3, "Test" = 4)
role <- c("Student" = 1, "Not" = 2)
library(shiny)
library(shinydashboard)
library(ggplot2)
ui <- dashboardPage(
dashboardHeader(title="Membership Satisfaction"),
dashboardSidebar(
sidebarMenu(
menuItem("Value Dashboard", tabName = "dashboard", icon =
icon("dashboard")),
menuItem("Services Dashboard", tabName = "service", icon =
icon("dashboard")),
menuItem("Demographics Dashboard", tabName = "demos", icon =
icon("dashboard"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "service",
sidebarPanel(checkboxGroupInput("vars","Select variables to
plot", choices = choices)),
fluidPage(
plotOutput("colm"),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
h6(strong("Gap Analysis: Plot points calculated as mean
importance and mean satisfaction."),
style = "font-family:'calibri"),
br(),
br(),
h6(strong("Strength: These are the primary strengths. We are
meeting highly important services with high satisfaction."),
style = "font-family:'calibri"),
h6(strong("Potential Advantages: Member satisfaction is being
met, however these services may not be as important for brand
equity."),
style = "font-family:'calibri"),
h6(strong("Secondary Opportunitites: These services are not
crucial (not highly important) and should not be a primary
focus."),
style = "font-family:'calibri"),
h6(strong("Target Issues: Targeting efforts here can improve
membership. These are services that are highly important
however are not meeting needs of members."),
style = "font-family:'calibri")
)),
tabItem(tabName = "demos",
sidebarPanel(
checkboxGroupInput("inpt","Select variables to plot", choices =
choices),
checkboxGroupInput("role",
"Select Primary Role of Interest",
choices = role),
checkboxGroupInput("yrs",
"Select year(S) of Interest",
choices = range)),
fluidPage(
plotOutput("test")
)
))
)
)
Server:
server <- function(input,output){
output$matrixValue<- renderTable({
matrixValue
},include.rownames=TRUE)
output$matrixRENEW<- renderTable({
matrixRENEW
},include.rownames=TRUE)
output$value_BP <- renderPlot({
barplot(matrixValue, beside = T,
legend.text=rownames(matrixValue),
args.legend=list(x="topleft"),
main = titleValue,col=cols)})
output$renew_BP<- renderPlot({
barplot(matrixRENEW, beside = T,
legend.text=rownames(matrixRENEW),
args.legend=list(x="topleft"),
main = titleRENEW,col=cols)})
output$colm <- (renderPlot({
ggplot(dfGap[input$vars,], aes(satisfaction,importance))+
theme(text=element_text(size=12))+
geom_point(colour =input$vars, 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)+
annotate("text", x = 4.8, y = 5,
label = "Strengths",
color = "chartreuse4",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = .3, y = 5,
label = "Target Issues",
color = "firebrick4",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = .78, y = 0,
label = "Secondary Opportunities",
color = "dodgerblue3",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = 4.4, y = 0,
label = "Potential Advantages",
color = "grey10",
style = "font-family:'calibri",
size =6.5,
fontface =2)
}))
output$test <- renderPlot({
ggplot(dfTest[service.e[service.e==input$inpt,],], aes(imp.A,sat.b))+
theme(text=element_text(size=12))+
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)+
annotate("text", x = 4.8, y = 5,
label = "Strengths",
color = "chartreuse4",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = .3, y = 5,
label = "Target Issues",
color = "firebrick4",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = .78, y = 0,
label = "Secondary Opportunities",
color = "dodgerblue3",
style = "font-family:'calibri",
size =6.5,
fontface =2)+
annotate("text", x = 4.4, y = 0,
label = "Potential Advantages",
color = "grey10",
style = "font-family:'calibri",
size =6.5,
fontface =2)})
}
shinyApp (ui = ui, server = server)
The service tab is working how I'd like the demos tab to work, I'm just struggling with getting the different user inputs to map to a plot in a similar way. Any help is GREATLY appreciated!!
