I'm re-posting this from scratch in hopes someone can get me through this learning opportunity.
I'm having trouble passing a variable from ui.R to server.R in the following Shiny app.
I'm also including global.R. One section of that file pings my cloud-based MySQL db. I didn't want to share the password for that on here; you can get the query results as CSV files (2 of them) here.
The problem is with Line 22 of server.R. With the code as-is (y = n.emp,), it works as expected. When I replace that with (y = input$quant,), the code breaks. The error is in that line. I have isolated that.
I've tried aes_string, as previously suggested. It did not work. (Maybe I didn't use it properly?)
Can anyone help me on this? Thanks!
server.R
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
### ----- MANIPULATE DATA -----
colors17 <- c("#a7dfb9","#d0a0d4","#fde096","#96bbf1","#ecb489","#6eceea","#eaa99e","#8adbd3","#ddb9f1","#9cc18d","#ebaec8","#dceeb6","#b6bee4","#c5c88f","#dfb89b","#e9cf9d","#c8c09a")
colors6 <- c("#74d5e0", "#e5b197", "#93c1ed", "#cfd6a0", "#dfb1d8", "#9adabe")
naics_jll$market <- factor(naics_jll$m.mkt,
levels = as.character(MKT))
naics_jll <- naics_jll %>%
filter(m.mkt %in% input$markets
# , (other), (filters), (here)
)
### ----- PLOT -----
g <- ggplot(naics_jll)
g + geom_bar(stat = "identity",
position = input$geom_bar_pos,
aes(x = m.mkt,
y = n.emp,
fill = c1.name),
color = "lightgrey") +
scale_fill_manual (values=colors17) +
# facet_wrap(~ m.mkt) +
labs( y = input$quant, title = "Market Structure", subtitle = "by market & industry") +
theme(strip.text.x = element_text(size = 8),
axis.text.x = element_text(angle=90, size=6))
})
})
ui.R
# Define UI for application that draws a histogram
shinyUI(fluidPage(
title = "Company Data Explorer",
plotOutput('distPlot'),
hr(),
fluidRow(
column(3,
radioButtons("geom_bar_pos", "",
c("Stacked Bars" = "stack",
"Grouped Bars" = "dodge"),selected = "dodge")
),
column(4, offset = 1,
checkboxGroupInput("markets", "Include Markets:",
c("Boston" = "BOS",
"NYC" = "NYC",
"Chicago" = "CHI",
"San Francisco" = "SF",
"Los Angeles" = "LA",
"Washington, DC" = "DC"),
selected = c("BOS","NYC","CHI","SF","LA","DC"))),
column(4,
selectInput('quant', 'Y-Values', names(y_vals),names(y_vals)[[4]]))
)
))
global.R
library(shiny)
library(RNeo4j)
library(tidyverse)
library(stringr)
library(ggplot2)
### GET DATA
## MySQL SERVER CONNECT
con <- dbConnect(MySQL(),
user = 'shiny_apps',
password = '****',
host = 'mysql.mvabl.com',
dbname='sandbox191')
qmain <- dbSendQuery(con, "SELECT * FROM naics_jll;")
naics_jll <- as.data.frame(dbFetch(qmain,n=-1),na.rm=TRUE)
dbHasCompleted(qmain)
dbClearResult(qmain)
dbDisconnect(con)
## LOAD CSV
naics_jll <- select(naics_jll,-n.msa_naics,-c1.id,-q.level,-q.qtr,-q.nbrhd,-N.BldgClass)
y_vals <- subset(naics_jll,select = which(sapply(naics_jll,is.numeric)))
dropdown <- c("m.mkt","c1.name","q.nbrhd")
### "LEVELS" VARIABLES (currently unused)
IND <- naics_jll %>% distinct(c1.name)
MKT <- naics_jll %>% distinct(m.mkt)
I finally solved it, with help from Joe Cheng's gist. I needed to define my data source as reactive. Guess that's a new subject to read up on!!
Related
I am trying to create a dashboard using R Shiny from NYC Tree Census 2015. The dashboard should look something like in the picture here > Dashboard in Shiny Picture
My code is mentioned below:
library(shiny)
library(tidyverse)
library(ggplot2)
my_data <- read.csv("/Users/abhikpaul/Documents/Documents/Github/Fiverr/2015_Street_Tree_Census_-_Tree_Data.csv")
ui <- fluidPage(
titlePanel("The Dashboard of Tree Distribution in New York City"),
sidebarLayout(
sidebarPanel(
# Description ----
helpText("In this page you can get information about the tree distribution, status, health conditions, and species rank in New York City. Please choose the borough that you want to check. It may take 10 seconds for the graphics to load. Thank you for your patience!"),
#Input: Check boxes for Boroughs ----
checkboxGroupInput("checkboxInput",
label = "Borough",
choices = list("Bronx",
"Brooklyn",
"Manhattan",
"Queens",
"Staten Island"),
selected = "Bronx"),
),
# Main panel for displaying outputs ----
mainPanel(
# Tabs panel for displaying outputs ----
tabsetPanel(type = "tabs",
#Output: About ----
tabPanel("About",
h3("About this dataset", align = "left"),
p("The dataset displays the information of trees (including health, status, species, etc.) within the five boroughs in New York City. The dataset is organized by NYC parks & Recreation and partner organizations."),
h3("How to make NYC an urban forest?", align = "left"),
p("As a group, we are concerned about planting tree and green environments. Therefore, we will focus on identifying the locations that require more taking care of trees, the top species that have the most number of trees in each borough, the health conditions of those species, and the distribution of trees in each borough."),
HTML("<p>For more information, visit: <a href='https://data.cityofnewyork.us/Environment/2015-Street-Tree-Census-Tree-Data/uvpi-gqnh'>2015 NYC Tree Census</a></p>")
),
#Output: Status ----
tabPanel("Status", plotOutput(outputId = "statusplot")),
)
)
)
)
)
server <- function(input, output) {
my_data <- as_tibble(my_data)
my_data <- my_data[my_data$borough %in% checkboxInput,]
my_data <- data.frame(table(my_data$borough,my_data$status))
my_data <- my_data[apply(my_data!=0, 1, all),]
my_data <- my_data %>%
group_by(Var1) %>%
mutate(Percent = (Freq/sum(Freq) * 100))
output$statusplot <- renderPlot({
ggplot(my_data, aes(fill = Var2, y = Percent, x = Var1)) +
geom_bar(position = "dodge", stat = "identity")
})
}
shinyApp(ui = ui, server = server)
However, while running the app, I am getting an error as mentioned below
Warning: Error in match: 'match' requires vector arguments 50: %in% 47: server [/Users/abhikpaul/Documents/Documents/GitHub/Fiverr/my_app.R#90]Error in match(x, table, nomatch = 0L) : 'match' requires vector arguments
Can someone help me fix this issue as I am a newbie in R Shiny?
Try this
server <- function(input, output) {
output$statusplot <- renderPlot({
my_data <- as_tibble(my_data)
my_data <- my_data[my_data$borough %in% input$checkboxInput,]
my_data <- data.frame(table(my_data$borough,my_data$status))
my_data <- my_data[apply(my_data!=0, 1, all),]
my_data <- my_data %>%
group_by(Var1) %>%
mutate(Percent = (Freq/sum(Freq) * 100))
ggplot(my_data, aes(fill = Var2, y = Percent, x = Var1)) +
geom_bar(position = "dodge", stat = "identity")
})
}
I'm trying to include a stacked bar chart in shiny that depends on a select input. It works fine outside of shiny but in shiny it is not displaying multiple bars.
Code:
library(shiny)
library(ggplot2)
# Define UI ----
ui <- fluidPage(
# Application title
titlePanel("Group fairness analysis"),
# Sidebar
sidebarLayout(
sidebarPanel(
selectInput("group", "Group:",
c("Age" = "age",
"Gender" = "gender",
"Region" = "region",
"Ethnicity"="ethnicity"))
),
# Show a plot of the generated distribution
mainPanel(
h3("Accuracy bar chart"),
plotOutput("accPlot")
)
)
)
# Define server logic ----
server <- function(input, output) {
output$accPlot <- renderPlot({
g2 <- ggplot(df %>% count(get(input$group),correct) , aes(x=c(input$group),y=n,fill=as.factor(correct))) +
geom_bar(stat="identity",position=position_fill())+
scale_y_continuous(labels = scales::percent) +
geom_text(aes(label = paste0((n/nrow(df))*100,"%")), position = position_fill(vjust = 0.5), size = 5)+
theme_bw()+
ylab("")+
coord_flip()
g2
})
}
shinyApp(ui, server)
Sample data
# data -----------------------------------------------------------
n<-20 #number of users
threshold <- 60 #threshold in risk score for referral to YS
df <- data.frame(age = rep(0,n),
gender = rep(0,n),
ethnicity = rep(0,n),
region = rep(0,n),
score = rep(0,n),
referred = rep(0,n),
target = rep(0,n))
df$age <- as.factor(sample(c(15,16,17),size=n,replace=TRUE))
df$gender <- as.factor(sample(c('M','F'),size=n,replace=TRUE))
df$ethnicity<- as.factor(sample(c('European','Maori','Pacific','other'),size=n,replace=TRUE))
df$region<-as.factor(sample(c('North','Mid','South'),size=n,replace=TRUE))
df$score<-runif(n,min=0,max=100)
df$target<-sample(c(0,1),size=n,replace = TRUE)
df[which(df$score>=threshold),"referred"]<-1
df$colour<-rep(0,n)
df[which(df$referred==1 & df$target==1),"colour"]<-1
df[which(df$referred==1 & df$target==0),"colour"]<-2
df[which(df$referred==0 & df$target==1),"colour"]<-3
df[which(df$referred==0 & df$target==0),"colour"]<-4
df$correct<-rep(0,n)
df[which(df$referred==0 & df$target==0),"correct"]<-1
df[which(df$referred==1 & df$target==1),"correct"]<-1
df[which(df$referred==0 & df$target==1),"correct"]<-0
df[which(df$referred==1 & df$target==0),"correct"]<-0
It should look like
Your input$group from selectInput is a string, not a variable symbol. You can convert it to a symbol for your ggplot with rlang::sym and evaluate with !!.
In addition, your aesthetic for ggplot can use aes_string and refer to your column names as strings.
And would convert your correct column to a factor separately.
df$correct <- as.factor(df$correct)
...
g2 <- ggplot(df %>% count(!!rlang::sym(input$group), correct), aes_string(x=c(input$group), y="n", fill="correct")) +
...
I have a data set with three laps (15s/lap) each of which shows the different speed for every second:
AA <- as.data.frame(cbind(c(10,12,11,12,12,11,12,13,11,9,9,12,11,10,12,9,8,7,9,8,7,9,9,8,9,7,9,10,10,10,7,6,7,8,8,7,6,6,7,8,7,6,7,8,8),
c(rep("Lap_1",15),rep("Lap_2",15),rep("Lap_3",15))))
I want to compare the three laps together, but for the first one I'd like to use a sliderInput to select only some of the 15 secondes. I'm having some difficulties to add that to my code. Here is what I have for the moment:
install.packages("shiny")
install.packages("ggplot2")
library(shiny)
library(ggplot2)
colnames(AA) <- c("Speed","Lap")
AA$Speed <- as.numeric(as.character(AA$Speed))
ui=shinyUI(
fluidPage(
titlePanel("Title here"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("lap_choose",
label = "Choose the laps",
choices = c("Lap_1","Lap_2","Lap_3")),
sliderInput("secs_1",
"Seconds in L1:",
min = 0,
max = 15,
value = c(3,10),
step=1)),
mainPanel(
plotOutput("Comparison"))
)
)
)
server=function(input,output){
#data manipulation
data_1=reactive({
return(AA[AA$Lap%in%input$lap_choose,])
})
output$Comparison <- renderPlot({
ggplot(data=data_1(), aes(Speed, fill = Lap)) +
stat_density(aes(y = ..density..),
position = "identity",
color = "black",
alpha = 0.8) +
xlab("Distribution") +
ylab("Density") +
ggtitle("Comparison") +
theme(plot.title = element_text(hjust = 0.5,size=24, face="bold"))
})
}
shinyApp(ui,server)
I should use the secs_1 at some point to update data_1, but didn't find out how yet. Any ideas?
If i am understanding correctly, you want to filter out some values(based on sec_1 sliderInput) if "lap" variable is "lap_1".
Try using ifelse statement in data_1 function.
data_1=reactive({
xc <- AA[AA$Lap%in%input$lap_choose,]
gh <- ifelse(xc$Lap == "Lap_1" & xc$Speed %in% c(input$secs_1[1],input$secs_1[2]),
FALSE, TRUE)
return(xc[gh,])
})
Hello Stackoverflow Commununity !
I am working on a Dashboard using Flexdashboard and Shiny.
I want to introduce a filter on a graph.
The dataframe used for the graph is the following :
date <- seq(as.Date("2017/1/1"), as.Date("2018/1/1"), by = "month")
date <- as.character(date[-1])
proto <- as.data.frame(matrix(c(1,1,1,2,2,3,3,3,3,4,4,4,
0,0,0,0,1,1,1,1,1,2,2,2,
5,5,5,6,6,7,7,7,7,7,8,8), ncol = 3, nrow = length(date), byrow = F))
names(proto)[1] <- "cap_1"
names(proto)[2] <- "cap_2"
names(proto)[3] <- "cap_3"
row.names(proto) <- date
proto$total <- proto[,1] + proto[,2] + proto[,3]
If I run the graph out of the shiny code, it works perfectly for each column and I obtain :
Ggplot Graph for the total column
Now, I try to put this graph into my dashboard with the objective to have a filter on the graph to select the column (cap_1, cap_2, cap_3 or total) to plot.
Here is the code I used :
ProtoUI <- function(id) {
ns <- NS(id)
fillCol(height = 600, flex = c(NA, 1),
inputPanel(
selectInput(ns("cap"), "Capabilities:", choices = colnames(proto))
),
plotOutput(ns("proto_plot"), height = "100%")
)
}
Proto_serve <- function(input, output, session) {
output$proto_plot <- renderPlot({
ggplot(proto, aes(row.names(proto), input$cap, group = 1)) +
geom_line(size=1.5, color="blue") +
labs(x = "Date", y = "Number of prototypes", title = " ") +
geom_rangeframe() +
theme_tufte() +
theme(axis.text=element_text(size=12),
axis.title=element_text(size=13,face="bold"))
})
}
ProtoUI("proto")
callModule(Proto_serve, "proto")
And I obtain this graph :
Graph in the dashboard
Normally, the line must not be constant but should follow the data of the dataframe for the column selected.
Thanks for sharing your knowledge to solve my issue =)
Flavien.
I want to create a shiny app for plotting the most recent pollstR charts of US presidential primaries. Users should be able to select a Party (Dem or Rep), the Candidates and the states, where the primaries (or Caucusus) took place.
I have three problems:
Based on the selected party (Dem or Rep), users should get the next checkboxGroupInput, where only the Democratic or Republican candidates appear. I try to solved that with a conditionalPanel. However, I cannot use "Candidate" twice as a name for the Widget (later in the server.R I need input$Candidate). How can I solve that?
Based on the selected party (again Dem or Rep), users should get a list of all states, where primaries and caucusus took place up to now. At the moment, I am listing all US states, which I defined before (and hence I get errors, if I want to plot the results of states, where no polls are available). Is there a way to get the list of states from the dataset, which is generated in the server.R part (it is called polls$state there, but I cannot use it, because the ui.R does not now "polls").
I plot the results as bar-charts with ggplot and the facet_wrap function (with two columns). The more states I choose, the smaller the plots get. Is there a way to set the height of the plots and insert a vertical scrollbar in the main panel?
Here is the code for the UI:
shinyUI(fluidPage(
titlePanel("2016 Presidential primaries"),
sidebarLayout(position = "right",
sidebarPanel(
helpText("Choose between Democratic (Dem) and Republican (Rep)
Primaries and Caucuses:"),
selectInput("party",
label = "Dem or Rep?",
choices = c("Dem", "Rep",
selected = "Dem")),
conditionalPanel(
condition = "input.party == 'Dem'",
checkboxGroupInput("Candidate", label = h4("Democratic Candidates"),
choices = list("Clinton" = "Clinton", "Sanders" = "Sanders"),
selected = NULL)),
conditionalPanel(
condition = "input.party == 'Rep'",
checkboxGroupInput("Candidate", label = h4("Republican Candidates"),
choices = list("Bush" = "Bush", "Carson" = "Carson", "Christie" = "Christie",
"Cruz" = "Cruz", "Kasich" = "Kasich", "Rubio" = "Rubio",
"Trump" = "Trump"),
selected = NULL)),
checkboxGroupInput("state",
label = "Select State",
choices = states,
inline = TRUE,
selected = NULL)
),
mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("plot")),
tabPanel("Table", tableOutput("table"))
)
)
)
))
And here the code for the server.R:
### getting and cleaning the data for the shiny app-----------------------------
# load pollstR-package to get Huffpost opinion polls
require(pollstR)
# load dplyr and tidyr for data wrangling
require(dplyr)
require(tidyr)
# load ggplot2 for plotting
require(ggplot2)
# download 2016 GOP presidential primaries
repPoll <- pollstr_charts(topic='2016-president-gop-primary', showall = TRUE)
# extract and combine columns needed
choice <- repPoll$estimates$choice
value <- repPoll$estimates$value
election <- repPoll$estimates$slug
party <- repPoll$estimates$party
rep.df <- data_frame(election, choice, value, party)
# extract and combine slug and state info to add list of US state abbreviations
election <- repPoll$charts$slug
state <- repPoll$charts$state
r.stateAbb <- data_frame(election, state)
# join both data frames based on slug
rep.df <- left_join(rep.df, r.stateAbb, by = "election")
## download 2016 DEM presidential primaries
demPoll <- pollstr_charts(topic='2016-president-dem-primary', showall = TRUE)
# extract and combine columns needed
choice <- demPoll$estimates$choice
value <- demPoll$estimates$value
election <- demPoll$estimates$slug
party <- demPoll$estimates$party
dem.df <- data_frame(election, choice, value, party)
# extract and combine slug and state info to add list of US state abbreviations
election <- demPoll$charts$slug
state <- demPoll$charts$state
d.stateAbb <- data_frame(election, state)
# join both data frames based on slug
dem.df <- left_join(dem.df, d.stateAbb, by = "election")
# combine dem and rep datasets
polls <- bind_rows(dem.df, rep.df)
polls$party <- as.factor(polls$party)
polls$state <- as.factor(polls$state)
polls$choice <- as.factor(polls$choice)
shinyServer(function(input, output) {
df <- reactive({
polls %>% filter(party %in% input$party) %>% filter(choice %in% input$Candidate) %>%
filter(state %in% input$state)
})
# generate figures
output$plot <- renderPlot({
validate(
need(input$party, "Please select a party"),
need(input$Candidate, "Please choose at least one candidate"),
need(input$state, "Please select at least one state")
)
p <- ggplot(df())
p <- p + geom_bar(aes(x = choice, weight = value, fill = choice),
position = "dodge", width=.5)
# colorize bars based on parties
if (input$party == "Dem")
p <- p + scale_fill_brewer(palette = "Blues", direction = -1)
if (input$party == "Rep")
p <- p + scale_fill_brewer(palette = "Reds", direction = -1)
# add hlines for waffle-design
p <- p + geom_hline(yintercept=seq(0, 100, by = 10), col = 'white') +
geom_text(aes(label = value, x = choice, y = value + 1), position = position_dodge(width=0.9), vjust=-0.25) +
# facet display
facet_wrap( ~ state, ncol = 2) +
# scale of y-axis
ylim(0, 100) +
# delete labels of x- and y-axis
xlab("") + ylab("") +
# blank background and now grids and legend
theme(panel.grid.major.x = element_blank(), panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.background = element_blank(), legend.position = "none")
print(p)
}
)
# Generate a table view of the data
output$table <- renderTable({
polls %>% filter(party %in% input$party) %>% filter(choice %in% input$Candidate) %>%
filter(state %in% input$state)
})
}
)
Here is the solution for problem 1 and 2:
In ui.R, replace conditionalPanel and checkboxGroupInput with
uiOutput('candidates'),
uiOutput('states')
In server.R, add the following code before df <- reactive({..... Note that you need to change some of your input$Candidate code to lower case.
observeEvent(input$party, {
output$candidates <- renderUI({
checkboxGroupInput(
"candidate",
ifelse(input$party == 'Dem', "Democratic Candidates", "Republican Candidates"),
as.vector(unique(filter(polls,party==input$party)$choice))
)
})
})
observeEvent(input$candidate, {
output$states <- renderUI({
states_list <- as.vector(unique(filter(polls, party==input$party & choice==input$candidate)$state))
checkboxGroupInput(
"state",
"Select state",
# Excluding national surveys
states_list[states_list!="US"]
)
})
})
For problem 3, change the df reactive to observe, and then set plot height depending on how many states selected. Also change this line p <- ggplot(df)
observe({
df <- polls %>% filter(party %in% input$party) %>% filter(choice %in% input$candidate) %>% filter(state %in% input$state)
height <- ceiling(length(input$state) / 2) * 200
output$plot <- renderPlot({
#Your plot code
}, height=height)
})