Related
I have looked at similar posts and the responses don't seem to answer my question. I am trying to develop an R Shiny App (This is my first Shiny App) to draw a boxplot for some data. I am adapting it from some code that produces accurate boxplots in the console. The plots should look similar to this (I did simplify the labels for the app):
correct plot
When I run the app, I see the following:
app plot
Here is some reproducible code. Any insights would be greatly appreciated:
library(dplyr)
library(ggplot2)
library(shiny)
AlkCalcs2 <- data.frame(matrix(ncol = 6, nrow = 250))
AlkCalcs2$climate <- sample.int(2, 250, replace = TRUE)
AlkCalcs2$block <- sample.int(3, 250, replace = TRUE)
AlkCalcs2$treatment <- factor(sample.int(4, 250, replace = TRUE),
labels = c("Control", "Compost", "Basalt", "Basalt and Compost"))
AlkCalcs2$pre_dilution_alk_endp <- rnorm(250, 91, 58)
AlkCalcs2$pre_dilution_alk_infl <- rnorm(250, 65, 59)
AlkCalcs2$pre_dilution_alk_gran <- rnorm(250, 72, 55)
# Define server logic
server <- function(input, output, session) {
output$boxplot <- renderPlot({
ggplot(data = filter(AlkCalcs2,
climate == input$climate,
block %in% input$block)) +
geom_boxplot(mapping = aes(x = treatment, y = input$method)) +
labs(y = "Alkalinity",
x = element_blank(),
title = paste("Climate ", input$climate, sep = ""),
subtitle = paste("Block(s) ", input$block, sep = "")) +
theme(plot.title = element_text(size = 16, hjust = 0.5),
plot.subtitle = element_text(size = 16, hjust = 0.5),
axis.text = element_text(size = 12),
axis.title = element_text(size = 14))
})
}
# Define UI for application that draws a boxplot
ui <- fluidPage(
# Application title
titlePanel("Soybean Titration Analysis"),
# Sidebar with inputs
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "method",
label = "Alkalinity Calculation Method:",
choiceNames = c('Endpoint', 'Inflection Point', 'Gran Plotting'),
choiceValues = c('pre_dilution_alk_endp',
'pre_dilution_alk_infl',
'pre_dilution_alk_gran')),
radioButtons(inputId = "climate",
label = "Select Climate:",
choices = c(1, 2)),
checkboxGroupInput(inputId = "block",
label = "Select Block (Choose at least one):",
choices = c(1, 2, 3),
selected = 1)
),
# Show a boxplot of the data
mainPanel("Boxplot", plotOutput('boxplot'))
)
)
# Run the application
shinyApp(ui = ui, server = server)
It's more a ggplot issue than Shiny issue. Your plot data isn't right.
library(dplyr)
library(ggplot2)
library(shiny)
AlkCalcs2 <- data.frame(matrix(ncol = 6, nrow = 250))
AlkCalcs2$climate <- sample.int(2, 250, replace = TRUE)
AlkCalcs2$block <- sample.int(3, 250, replace = TRUE)
AlkCalcs2$treatment <- factor(sample.int(4, 250, replace = TRUE),
labels = c("Control", "Compost", "Basalt", "Basalt and Compost"))
AlkCalcs2$pre_dilution_alk_endp <- rnorm(250, 91, 58)
AlkCalcs2$pre_dilution_alk_infl <- rnorm(250, 65, 59)
AlkCalcs2$pre_dilution_alk_gran <- rnorm(250, 72, 55)
AlkCalcs2[['pre_dilution_alk_endp']]
# Define server logic
server <- function(input, output, session) {
output$boxplot <- renderPlot({
plot_data <- filter(AlkCalcs2,
climate == input$climate,
block %in% input$block)
ggplot(data = plot_data) +
geom_boxplot(mapping = aes(x = treatment, y = .data[[input$method]])) +
labs(y = "Alkalinity",
x = element_blank(),
title = paste("Climate ", input$climate, sep = ""),
subtitle = paste("Block(s) ", input$block, sep = "")) +
theme(plot.title = element_text(size = 16, hjust = 0.5),
plot.subtitle = element_text(size = 16, hjust = 0.5),
axis.text = element_text(size = 12),
axis.title = element_text(size = 14))
})
}
# Define UI for application that draws a boxplot
ui <- fluidPage(
# Application title
titlePanel("Soybean Titration Analysis"),
# Sidebar with inputs
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "method",
label = "Alkalinity Calculation Method:",
choiceNames = c('Endpoint', 'Inflection Point', 'Gran Plotting'),
choiceValues = c('pre_dilution_alk_endp',
'pre_dilution_alk_infl',
'pre_dilution_alk_gran')),
radioButtons(inputId = "climate",
label = "Select Climate:",
choices = c(1, 2)),
checkboxGroupInput(inputId = "block",
label = "Select Block (Choose at least one):",
choices = c(1, 2, 3),
selected = 1)
),
# Show a boxplot of the data
mainPanel("Boxplot", plotOutput('boxplot'))
)
)
# Run the application
shinyApp(ui = ui, server = server)
I am trying to show a plot chart after the button is clicked, which means the chart will only show up when the button is clicked, but the chart is just not showing up... any clue with this? Here is the code:
shinyApp(
ui = fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button", "Show Chart")
),
mainPanel(
plotOutput("bar")
)
)
),
server = function(input, output) {
observeEvent(input$button, {
category <- c('task1', 'task2', 'task2','task1','task1')
start_min <- c(0, 0, 16, 45, 40)
stop_min <- c(14.9,18.8,17.5,65.5, 70)
group <- c('A', 'B', 'A', 'A', 'B')
data <- data.frame(category,start_min,stop_min,group)
task_bars <- ggplot(data, mapping=aes(ymin=0, ymax=1,
xmin=start_min, xmax=stop_min,
fill=as.factor(category),
text=paste("Task:", str_wrap(string = category, width = 70,),
"<br>Start: ", format(start_min, digits=1), "min",
"<br>Stop: ", format(stop_min, digits=1), "min")
)) +
geom_rect(alpha=0.8) +
theme_minimal()+
theme(
axis.title.x=element_text(color="white"), axis.text.x=element_text(color="white"),
axis.text.y=element_blank(), axis.ticks.y=element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.border = element_blank(), panel.background = element_blank()) +
scale_fill_discrete(breaks=data$category)
task_bars <- plotly::ggplotly(task_bars, tooltip="text", width = 970, height = 120) %>%
plotly::config(displayModeBar = TRUE) %>%
plotly::layout(plot_bgcolor='black', paper_bgcolor='black', margin = list(b=30, l=0, r=10, t=30))
print(task_bars)
output$bar <- renderPlotly(task_bars)
})
}
)
You need to move the output$bar outside of the observeEvent. I created a reactiveValues object for your plot. The observeEvent creates the plot and then it will be displayed in the output.
You also had plotOutput in ui instead of plotlyOutput in ui.
library(shiny)
library(ggplot2)
library(plotly)
task_bars <- reactiveValues(plot = NULL)
shinyApp(
ui = fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button", "Show Chart")
),
mainPanel(
plotlyOutput("bar")
)
)
),
server = function(input, output) {
observeEvent(input$button, {
category <- c('task1', 'task2', 'task2','task1','task1')
start_min <- c(0, 0, 16, 45, 40)
stop_min <- c(14.9,18.8,17.5,65.5, 70)
group <- c('A', 'B', 'A', 'A', 'B')
data <- data.frame(category,start_min,stop_min,group)
task_bars$plot <- ggplot(data, mapping=aes(ymin=0, ymax=1,
xmin=start_min, xmax=stop_min,
fill=as.factor(category)
)) +
geom_rect(alpha=0.8) +
theme_minimal()+
theme(
axis.title.x=element_text(color="white"), axis.text.x=element_text(color="white"),
axis.text.y=element_blank(), axis.ticks.y=element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.border = element_blank(), panel.background = element_blank()) +
scale_fill_discrete(breaks=data$category)
})
output$bar <- renderPlotly({
if(input$button == 0){
return()
} else {
print(plotly::ggplotly(task_bars$plot, tooltip="text", width = 970, height = 120) %>%
plotly::config(displayModeBar = TRUE) %>%
plotly::layout(plot_bgcolor='black', paper_bgcolor='black', margin = list(b=30, l=0, r=10, t=30))
)
}
})
}
)
Not sure what's happening, but it keeps telling me "Error in htmltools::validateCssUnit(width) : CSS units must be a single-element numeric or character vector"....Been trying to search for reasons and can't seem to identify which piece of code is causing this error. I included the code with the error and the code I had previously that is working fine.
Error message when running:
#Libraries
library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)
library(readxl)
library(scales)
library(ggthemes)
library (plotly)
library(shinythemes)
#Load Data
data<-read_excel("C:/Users/Kanew/OneDrive/Desktop/RApp/Unemployment2.xlsx")
data$Date<-as.Date(data$MonthYear)
#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI #UI#UI#UI#UI#UI#UI#UI#UI#UI
if (interactive()) {
#navbar includes fluidpage (fluid = TRUE)
ui <-navbarPage(
#TAB 1 (Initial data display)
"Unemployment Exploration", fluid = TRUE,
tabPanel("Unemployment by Race",
mainPanel(
h1("National Unemployment Rate by Race"),
varSelectInput(
inputId = "Category",
label = "Select Race or National Rate",
data,
multiple = TRUE),
plotlyOutput("plot", ggplot(data, mapping = aes(x=Date, y = Rate, colour = Category)) +
geom_line() +
xlab("Year") + ylab("Unemployment Rate (%)") +
scale_y_continuous(breaks=c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18))+
scale_x_date(date_breaks = "years" , date_labels = "%Y")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))+
theme_economist() +
scale_fill_economist()),
setBackgroundColor("#778899"),
)),
#TAB 2 (Data tables)
tabPanel("Data",
DT::dataTableOutput("data")))
#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server
server <- function(input, output, session){
#Output for TAB 1
output$plot <- renderPlotly({
if(length(input$Category) == 0) return (data)
data %>% dplyr::select(!!!input$Category)},
rownames = TRUE)}
#Output for TAB 2
output$data <- DT::renderDataTable({DT::datatable(data)})
}
shinyApp(ui, server)
No error message:
#Libraries
library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)
library(readxl)
library(scales)
library(ggthemes)
library (plotly)
library(shinythemes)
#Load Data
data<-read_excel("C:/Users/Kanew/OneDrive/Desktop/RApp/Unemployment2.xlsx")
data$Date<-as.Date(data$MonthYear)
#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI#UI #UI#UI#UI#UI#UI#UI#UI#UI#UI
#navbar includes fluidpage (fluid = TRUE)
ui <-navbarPage(
#TAB 1 (Initial data display)
"Unemployment Exploration", fluid = TRUE,
tabPanel("Unemployment by Race",
mainPanel(
plotlyOutput("plot", height = 'auto', width = 'auto'),
setBackgroundColor("#778899"),
h1("National Unemployment Rate by Race"),
selectInput(
inputId = "Category",
label = "Select Race or National Rate",
choices = c("All",unique(data$Category)),
selected = "All"
))),
#TAB 2 (Data tables)
tabPanel("Data",
DT::dataTableOutput("data")))
#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server#Server
server <- function(input, output, session){
#Output for TAB 1
output$plot <- renderPlotly({
data %>%
filter(Category == input$Category | input$Category == "All") %>%
ggplot(data, mapping = aes(x=Date, y = Rate, colour = Category)) +
geom_line() +
xlab("Year") + ylab("Unemployment Rate (%)") +
scale_y_continuous(breaks=c(0, 2, 4, 6, 8, 10, 12, 14, 16, 18))+
scale_x_date(date_breaks = "years" , date_labels = "%Y")+
theme(axis.text.x = element_text(angle = 45, hjust = 1))+
theme_economist() +
scale_fill_economist()
})
#Output for TAB 2
output$data <- DT::renderDataTable({DT::datatable(data)
})
}
shinyApp(ui, server)
I have my shiny app in AWS ubuntu server attached with mysql database, my app doesnot work sometimes when number of database connection exceeded(16 new connections). I tried several ways from various sources in internet but not able to get the required solution.
Furthure i am also getting warning you have leaked pool object . I am attaching the sample code.
library("shiny")
library("shinydashboard")
library("pool")
library(ggplot2)
library("DBI")
library(plotly)
pool <- dbPool(drv = RMySQL::MySQL(),dbname = "db",host = "database.cw5east-2.rds.amazonaws.com",username = "host",password = "host", port = 3306)
mychoices = dbGetQuery(pool,"select available_scenario from scenario_name;")
ui <- (fluidPage(
titlePanel("Demonstration of renderUI in shiny - Dymanically creating the tabs based on user inputs"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'n', "available scenarios", choices = mychoices, multiple = TRUE),
verbatimTextOutput("selected")
),
mainPanel(
plotOutput('Cost'),
uiOutput('tabs')
)
)
))
server <- (function(input,output,session){
output$tabs = renderUI({
par(mfrow = c(2, 2))
if(!is.null(input$n)){
x <- input$n
y <- length(x)
z <- dbGetQuery(pool,paste0("select scenario_key from scenario_name where available_scenario = '",x[y],"'"))
frame <- dbGetQuery(pool,paste0("select x,price from plot1 where scenario_key ='",z,"'"))
frame1 <- dbGetQuery(pool,paste0("select obj,runs from plot2 where scenario_key ='",z,"'"))
frame2 <- dbGetQuery(pool,paste0("select V1,V2,V3 from tableee where scenario_key ='",z,"'"))
runs <- dbGetQuery(pool,paste0(" select count(*) from plot2 where scenario_key ='",z,"'"))
b<-dbGetQuery(pool, paste0("select scenario_key from scenario_name where available_scenario = '",input$n,"'"))
Tabs <- lapply(paste("Scenario name:", input$n, sep=" "), tabPanel,
renderPlotly({
ggplot(frame, aes(x=x,y=price,fill=price)) + # basic graphical object
geom_col(width = 0.3)+
#geom_bar(position = 'dodge',stat = "identity")+ # first layer
xlab(NULL)+ylab("Price in USD")+
geom_text(aes(label=price),size=5,position=position_dodge(width=0.9), vjust=-0.25)+
theme_minimal()+
theme(axis.text = element_text(size = 12),
axis.title = element_text(size=16),
axis.text.y =element_text(angle = 90,hjust = 1))
}),
renderPlotly({
ggplot(frame1,aes(x=runs,y=obj))+
geom_col(width=0.3,fill='orangered')+
geom_hline(aes(yintercept=mean(obj,na.rm = T),color="Mean"),linetype='dashed',size=1)+
scale_color_manual(values = "blue")+
labs(x= 'Day Number',y='Reveneue in USD',color=NULL)+
theme_minimal()+theme(axis.text = element_text(size = 12),
axis.title = element_text(size=16),
axis.text.y= element_text(angle = 90,hjust = 1) )
}),
DT::renderDataTable({
frame2
},colnames=c('Day','Total Wt(kg)','Total Pcs','Revenue($)')
)
)
do.call(tabsetPanel, Tabs)}
})
})
shinyApp(ui, server)
I am creating a table using renderTable and a plot (plotly) to be placed in ShinyDashboard. There is a whitespace that surrounds the table data that I am trying to get rid off. However, there is no whitespace around the plot.
How do I remove the whitespace that surround the table i have added to my shiny dashboard.
How do I align the header of the table "Recruitment" to the center?
I know there are some HTML solutions, but I am not familiar with those codes and will be glad if someone can explain.
Here are my codes:
Server codes
output$recruit_stats <- renderTable(recruit_stats, bordered = TRUE, colnames = TRUE)
output$Recruitment_bar_plot <- renderPlotly({
Recruitment_bar<-Recruitment_bar[(Recruitment_bar$hospital!="H"),];
R01 <- ggplot()+
geom_bar(data=Recruitment_bar,aes(x=hospital,y=count),stat = "identity", fill="navyblue")+
ylim(0,1200) +
geom_text(data=Recruitment_bar,aes(x=hospital,y=count*1.05,label=paste(count)),size=2.5, vjust=-1.0) +
theme(panel.background = element_blank(),
axis.text = element_text(size = 7),
axis.title = element_text(size=7),
axis.line = element_line(colour = "black", size = 0.5, linetype = "solid"),
plot.title = element_text(size=8, face="bold", hjust=0.5),
legend.position = "none", legend.text = element_text(size=6)) +
labs(fill="") + guides(fill = guide_legend(reverse=TRUE))+
ylab("No. Recruited") + ggtitle("No. of Patients Recruited (Jan 2017 to June 2018)")
ggplotly(R01, tooltip=c("count"));
})
UI codes
Recruitment<-tabItem(
tabName = "Recruitment",
fluidRow(
box(
box(title = "Recruitment",
status = "primary",
solidHeader = TRUE,column(12,tableOutput("recruit_stats"), align="c"),
width=8,
collapsed=TRUE)
),
box(
plotlyOutput("Recruitment_bar_plot", height = 400),
width=5,
status = "primary",
solidHeader = TRUE
)
)
)
I would drop boxes and try grid by columns. For table have a look at DT tutorials.
library(shiny)
library(shinydashboard)
dat5 <- c(rep("Female", 3376), rep("Male", 2180))
app <- shinyApp(
ui <- shinyUI(
dashboardPage(dashboardHeader(title = "PSM"),
dashboardSidebar(),
dashboardBody(
tabItem(
tabName = "Recruitment",
fluidRow(
column(width=6,
DT::dataTableOutput("recruit_stats")),
column(width=6,
plotOutput("pie_chart", height = 400))
)
)
))
),
server <- shinyServer(function(input,output){
output$pie_chart <- renderPlot({
df <- table(dat5)
cols <- rainbow(length(df))
barplot(df, col = cols)
})
output$recruit_stats <- DT::renderDataTable({
DT::datatable(as.data.frame(dat5), options = list(paging=TRUE, searching= TRUE ))
})
})
)
runApp(app)