Cannot disconnect connections in shiny app using pool package - r

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)

Related

Shiny Error: arguments must have the same length

I am trying to create a shiny app bar plot with dataframe columns (x variables) as input selections. One solution has been posted online already, but it has not worked for me.
My code is the following:
ui <- fluidPage(
sidebarLayout(position = "left",
sidebarPanel(
selectInput('x', "Funding:", choices = c('source_location',
'source_organizationtype','destination_purpose','destination_organizationtype'),
selected = NULL),
theme = shinytheme("cerulean")),
mainPanel(plotOutput("outplot"))
))
server <- function(input, output) {
output$outplot <- renderPlot( {
selected_data <- graph_funds_data %>% select(input$x, funding)
ggplot(selected_data, aes(x= reorder( !! input$x, funding), y = funding,
fill = !! input$x,
color = !! input$x)) +
geom_bar(position="stack", stat= 'identity') +
theme_minimal() + labs(x = as.name(input$x), y = 'Funding in Billions (USD)',
title = 'Total Incoming Ukraine Crisis Funding',
subtitle = 'January-April 2022') +
theme(legend.position="bottom", legend.title=element_blank(),
legend.direction="horizontal", legend.box="vertical")
} )
}
shinyApp(ui = ui, server = server, options = list(height=1000))
And I get 'Error: arguments must have same length'
I have also tried:
ui <- fluidPage(
sidebarLayout(position = "left",
sidebarPanel(
selectInput('x', "Funding:", choices = c('source_location',
'source_organizationtype','destination_purpose','destination_organizationtype'),
selected = NULL),
theme = shinytheme("cerulean")),
mainPanel(plotOutput("outplot"))
))
server <- function(input, output) {
output$outplot <- renderPlot( {
selected_data <- graph_funds_data %>% select(input$x, funding)
ggplot(selected_data(), aes(x= reorder(selected_data()[[input$x]], funding), y = funding,
fill = selected_data()[[input$x]],
color = selected_data()[[input$x]])) +
geom_bar(position="stack", stat= 'identity') +
theme_minimal() + labs(x = as.name(input$x), y = 'Funding in Billions (USD)',
title = 'Total Incoming Ukraine Crisis Funding',
subtitle = 'January-April 2022') +
theme(legend.position="bottom", legend.title=element_blank(),
legend.direction="horizontal", legend.box="vertical")
} )
}
shinyApp(ui = ui, server = server, options = list(height=1000))
And I get 'Error: Could not find function "selected_data"'
Does anyone know how to fix this?

How to add a date range to ggplot in Rshiny?

I am making a shiny app to generate stock price plots. I want to generate plots given a certain date range, but I get the error "argument 1 is not a vector" whenever I try to adjust the dates. If I remove the "daterangeinput" part from my app, everything works fine. I have attached my code + data.
Run the section below to get the data.
library(tidyquant)
library(tidyverse)
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(plotly)
sp500_names <- tq_index("SP500") %>%
slice_head(n = 10) %>%
select(symbol, company)
tickers <- sp500_names[,1]
prices <- tq_get(tickers,
get = "stock.prices",
from = today() - months(24),
to = today(),
complete_cases = F) %>%
select(symbol, date, close)
Code for shiny app:
ui <- fluidPage(
# Title
titlePanel("Stock Price Visualization and Forecasting"),
# Sidebar
sidebarLayout(
sidebarPanel(width = 3,
pickerInput(
inputId = "stocks",
label = h4("Pick a stock"),
choices = tickers$symbol,
selected = tickers,
options = list(`actions-box` = TRUE),
multiple = T),
# Date input
dateRangeInput("daterange", "Pick a Time Period",
# value = today(),
min = today() - months(23),
max = today())),
# Plot results
mainPanel(
plotlyOutput("plot",height=600)
)
)
)
server <- function(input, output, session) {
# Server logic based on user inputs
observeEvent(input$stocks,{
prices <- prices %>%
dplyr::filter(symbol %in% input$stocks) %>%
filter(date > input$daterange[1] & date <= input$daterange[2])
# Create plot
output$plot <- renderPlotly({
print(
ggplotly(prices %>%
ggplot(aes(date, close, color = symbol)) +
geom_line(size = 1, alpha = 0.9)+
theme_minimal(base_size=16) +
theme(axis.title=element_blank(),
plot.background = element_rect(fill = "white"),
panel.background = element_rect(fill="grey"),
panel.grid = element_blank(),
legend.text = element_text(colour="black"))
)
)
})
})
}
shinyApp(ui, server)
The issue is that you have not set any start and end dates for the date range and your apps does not take care of that. Hence an easy fix would be to simply set a default start and end date. Additionally IMHO I don't see any reason for an observeEvent. Instead I would suggest to use a reactive to filter your data based on user inputs, which could then be used for plotting:
library(tidyquant)
library(tidyverse)
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(plotly)
ui <- fluidPage(
# Title
titlePanel("Stock Price Visualization and Forecasting"),
# Sidebar
sidebarLayout(
sidebarPanel(
width = 3,
pickerInput(
inputId = "stocks",
label = h4("Pick a stock"),
choices = tickers$symbol,
selected = tickers,
options = list(`actions-box` = TRUE),
multiple = T
),
# Date input
dateRangeInput("daterange", "Pick a Time Period",
# value = today(),
start = min(prices$date),
end = today(),
min = min(prices$date),
max = today()
)
),
# Plot results
mainPanel(
plotlyOutput("plot", height = 600)
)
)
)
server <- function(input, output, session) {
prices_filtered <- reactive({
req(input$stocks)
prices %>%
dplyr::filter(symbol %in% input$stocks) %>%
filter(date > input$daterange[1] & date <= input$daterange[2])
})
output$plot <- renderPlotly({
req(input$stocks)
g <- ggplot(prices_filtered(), aes(date, close, color = symbol)) +
geom_line(size = 1, alpha = 0.9) +
theme_minimal(base_size = 16) +
theme(
axis.title = element_blank(),
plot.background = element_rect(fill = "white"),
panel.background = element_rect(fill = "grey"),
panel.grid = element_blank(),
legend.text = element_text(colour = "black")
)
ggplotly(g)
})
}
shinyApp(ui, server)

Boxplots in R Shiny App showing only flat lines

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)

Barplot in shiny: when click the actionbutton, the second barplot always appear delay and the previous figure appears

I create a barplot shiny app.
The biggest problem I met now is when I click the acitonbutton to get a new picture ,
the barplot appear delay and when I choose another input and click actionbutton again, the last barplot will appear but instantly disappear and the second picture appear.
But the input first and second time is different. Why the first picture will appear twice?
Here is my sample code,it is normal because it's a small sample.
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(gridExtra)
mean_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))
sd_data <- data.frame(
Name = c(paste0("Group_", LETTERS[1:20])),
matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))
###
ui <- fluidPage(
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot")
#uiOutput("all")
)
)
)
server <- function(input, output, session) {
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
# geom_errorbar(aes(ymin = plotdata()[,input$selectGeneSymbol] - sddata()[,input$selectGeneSymbol], ymax = plotdata()[,input$selectGeneSymbol] + sddata()[,input$selectGeneSymbol]), width = .2, position = position_dodge(0.9)) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
})
output$plot <- renderPlot({
p1()
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
My real data is huge and I don't know if it is the main reason.
Or I should change the reactive() and EventReactive() or adjust the parameters ??
My sample data here is simple. You may not meet what the problem I met in my code.
I will show you some details, just like this:
That's ok.Though it may appeare slowly.
But when I choose another gene as input,
the first "Gene_1" result will appear again and then the "Gene_2" result will appear.
I hope somebody could help me or met this problem before.
Vary thankful.
As your data is large, there is a delay in generating the plot p1(). Hence, the previous plot is shown in renderPlot. The following update will show blank until a new plot is generated whenever user selects a new gene. Perhaps this will solve your issue. I cannot verify as I don't have large dataframe.
ui <- fluidPage(
pageWithSidebar(
headerPanel("123"),
sidebarPanel(
selectInput(
"selectGeneSymbol",
"123:",
choices = colnames(mean_data)[-1],
multiple =F,
width = 400,
selected = 1
),
actionButton(inputId = "plot1", label = "FPKM"),
tags$h6(tags$a(href="https://www.ncbi.nlm.nih.gov/", "link",target = "_top"))
),
mainPanel(
plotOutput("plot")
#,verbatimTextOutput("all")
)
)
)
server <- function(input, output, session) {
rv <- reactiveVal(0)
observeEvent(input$selectGeneSymbol, {rv(0)})
## put sd into mean_data
plotdata <- eventReactive(input$plot1, {
rv(0)
df <- mean_data %>% mutate(sd = sd_data[,input$selectGeneSymbol])
})
p1 <- eventReactive(input$plot1, {
req(plotdata())
p <- ggplot(data = plotdata(), aes(x = Name, y = .data[[input$selectGeneSymbol]], fill=Name,
ymin = .data[[input$selectGeneSymbol]] - sd, ymax = .data[[input$selectGeneSymbol]] + sd )) +
geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
geom_errorbar(width = .2, position = position_dodge(0.9)) +
theme_classic2() +
rotate_x_text(angle = 45) +
theme(legend.position = "none") +
labs(title = input$selectGeneSymbol, x = NULL, y = "123_value")
rv(1)
p
})
observeEvent(input$plot1, {rv(1)})
output$plot <- renderPlot({
if (rv()) {
p1()
}
})
#output$all <- renderPrint(rv())
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

ggplot not displayed in Shiny but works fromn the plot

The following minimal Shiny app fails to display when I launch the app. The sidebar shows up but not the main panel. I get no error messages or warnings. The app just hangs there.
The ggplot works in the console.
This must be an environmental parameter controlling the interface between Shiny & ggplot2. But what is it. Have tried setting dev.off() to no avail. Does anyone have any suggestions?
ui <- fluidPage(
sidebarPanel(
# client logo
# select trade
selectInput(inputId = "trade",
label = "Trade",
choices = trades,
selected = defaultTrade
)
),
mainPanel(
# performance time series plots
plotOutput(outputId = "tsPlotRev", height = "195px")
)
)
server <- function(input, output) {(
output$tsPlotVol <- renderPlot(
ggplot(data.frame(tsData), aes(x = as.Date(weekDate), y = as.numeric(revenue) / 1000000, color = as.factor(isHist))) +
geom_line() + scale_x_date(date_breaks = "4 week", date_labels = "%y-%W") +
theme(axis.text.x = element_text(angle = 45, hjust = 0.75), legend.position = "none") +
labs(x = NULL, y = "revenue (million USD)")
)
)}
shinyApp(ui = ui, server = server)

Resources