Related
My app is supposed to load certain data as input file (in this post i will give a part of it written in form of data frame so you can use to run my example). and then plot three plots . i want that when the user click oh the plot at the top of page , a first new plot will be displayed based on the click info and when the new plot will be displayed then i want to plot a second new plot based on the click info of the first new plot.
library(dplyr)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(ggplot2)
library(gridExtra)
library(scales)
library(grid)
library(RColorBrewer)
library(officer)
library(svglite)
library(rvg)
library(readxl)
library(tools)
library(rsvg)
body <- dashboardBody(
fluidRow(
tabBox(
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1",height = 750,width=20,
tabPanel("Summary",dataTableOutput(outputId = "table")),
tabPanel("Visualization",sliderInput("scalegvt","Scale Data by:", min = 0, max = 100, value = c(70,100)),plotOutput("p1", height = 1000,click = "plot_click")
)
)
)
)
side<- dashboardSidebar(
width = 290,
sidebarMenu(
menuItem("Summary",tabName = "Summary") ,
uiOutput('choose_Da'),
selectizeGroupUI(
id = "m",
inline = FALSE,
params = list(
Lot = list(inputId = "Lot", title = "Lot"),
wafer = list(inputId = "wafer", title = "wafer"),
M_datum = list(inputId = "M_Datum", title = "M_Datum"),
Yield = list(inputId = "Yield", title = "Yield")
)
),inline=FALSE,
menuItem("Visualization",tabName = "Visualization")
))
ui <- function(request) {
dashboardPage(
dashboardHeader(title = "Yield Report",titleWidth = 290),
side,
body
)
}
server = function(input, output,session) {
newscale <- reactive({
req(input$scalegvt)
})
mydt<-data.frame(Lot=c(rep("A",4),rep("b",5),rep("n",3),rep("x",2)),M_Datum=as.Date(c("2012-06-05","2012-06-15","2012-06-10","2014-11-17","2014-03-18","2014-06-15","2014-06-10","2014-06-17","2015-11-27","2016-08-15","2016-09-10","2016-10-27","2017-09-10","2017-10-12")),wafer=(c(rep(5,14)+1:14)),Yield=c(rep(10,14)+57))
dz<-reactive({
req(res_mod())
dat<-res_mod()
dt<-dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
dt[,2]<-as.Date(format(as.Date(dt[,2]), "%Y-%m-01"))
req(dt$M_Datum,dt$Yield)
dr<-data.frame("M_Datum"=dt$M_Datum,"Yield"=dt$Yield)
req(dr$M_Datum,dr$Yield)
dx<-aggregate(Yield~M_Datum,dr,mean)
req(dx$M_Datum,dx$Yield)
dx$M_Datum<-format(dx$M_Datum, "%b %Y")
return(data.frame("M_Datum"=dx$M_Datum,"Yield"=dx$Yield))
})
#observeEvent(input$plot_click,
#{ a<- reactive(nearPoints(dz(), input$plot_click, threshold = 10, maxpoints = 1,
# addDist = F))
# b<-reactive(match(substr(a()$M_Datum,1,3),month.abb))
# req(res_mod())
#dat<-res_mod()
#dt<-dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
#dt<-dt[substr(dt$M_Datum,6,7)==as.character(b()),]
#req(dt$Lot,dt$Yield)
#dr<-data.frame("Lot"=dt$Lot,"Yield"=dt$Yield)
# req(dr$Lot,dr$Yield)
# dx<-aggregate(Yield~Lot,dr,mean)
# req(dx$Lot,dx$Yield)
# dza<-data.frame("Lot"=dx$Lot,"Yield"=dx$Yield)
# output$p2 <- renderPlot({ ggplot(dza, aes(x = Lot,y = Yield,group = 1)) +
# geom_point()})
#})
output$choose_Da <- renderUI({
dateRangeInput('dateRange',
label = 'Filter by date',
start = min(mydt$M_Datum) , end = max(mydt$M_Datum),min=min(mydt$M_Datum),max=max(mydt$M_Datum)
)
})
res_mod <- callModule(
module = selectizeGroupServer,
id = "m",
data = mydt,
vars = c("Lot","M_Datum","Yield","wafer"),
inline=FALSE
)
output$table <- renderDataTable({
dato<-res_mod()
return(dato[dato$M_Datum >= input$dateRange[1] & dato$M_Datum <= input$dateRange[2],]) },
options = list(scrollX = TRUE))
filtredplot<-reactive({
req(res_mod())
dat<-res_mod()
dt<-dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
dt[,2]<-as.Date(format(as.Date(dt[,2]), "%Y-%m-01"))
req(dt$M_Datum,dt$Yield)
dr<-data.frame("M_Datum"=dt$M_Datum,"Yield"=dt$Yield)
req(dr$M_Datum,dr$Yield)
dx<-aggregate(Yield~M_Datum,dr,mean)
req(dx$M_Datum,dx$Yield)
dz<-data.frame("M_Datum"=dx$M_Datum,"Yield"=dx$Yield)
dz$M_Datum<-factor(format(dz$M_Datum, "%b %Y"), levels=format(sort(unique(dz$M_Datum)),"%b %Y"))
hline_data <- data.frame(y = c(mean(dz$Yield)-sd(dz$Yield),mean(dz$Yield), mean(dz$Yield)+sd(dz$Yield)), type = factor(c(2, 1, 2)),
stringsAsFactors = FALSE)
ggplot(dz, aes(x=M_Datum, y=Yield,group = 1)) +
geom_point(size=7,colour="#007A9D",shape=4) +
theme(axis.text.x = element_text(angle = 0, vjust = 0.5, hjust=1))+
theme(legend.direction = "horizontal", legend.position = "top", legend.key = element_blank(),
legend.background = element_rect(fill = "white", colour = "white"),
axis.text.y.left = element_text(color = "#007A9D"),
axis.title.y.left = element_text(color = "#007A9D"),
plot.title = element_text(color="#007A9D")
)+
ylab("Mean Yield")+
xlab("")+
ggtitle(paste0("FCM-Yield Trend :"," ",paste0(c(input[["m-Customer_Name"]],input[["m-Local_Process_Id"]],input[["m-Process_Family"]],input[["m-MEMS_flag"]],input[["m-Device"]]),collapse = ",")))+
ylim(newscale())+
geom_hline(data = hline_data,
aes(yintercept = y, linetype = type, colour = type)) +
scale_colour_manual(values = c("#007A9D", "#EF783D"),
labels = c("Mean", "Mean+-sd"),
name = "Key:") +
scale_linetype_manual(values = 1:2,
labels = c("Mean", "Mean+-sd"),
name = "Key:")
})
output$p1<-renderPlot({
filtredplot() })
}
shinyApp(ui,server)
in that part of code turned to comment i have tried using the clik info to transform that month name to number to use it in order to filter data that means i want to plot the lot (x axis ) vs Yield ( as y axis in form of mean(avarage) ) so i can get average of yield pro lot in that month and then when i click again i want to get a second plot showing yield ( y axis not aggregated as mean this time) vs wafer (x axis) and of course only for that lot chosen by clickíng the first new plot.
The code posted is not a minimal reproducible example MRE. I did not go through it. But here is an MRE to achieve the task you have described: to output a second plot (p2) based on the plot_click of a first plot (p1) using nearPoints() shiny function.
library(shiny)
library(ggplot2)
data <- mpg
ui <- basicPage(
plotOutput("p1", click = "plot_click"),
plotOutput("p2")
)
server <- function(input, output) {
output$p1 <- renderPlot({
ggplot(data, aes(x = displ, y = cty)) +
geom_point()
})
observeEvent(input$plot_click,{
a <- nearPoints(data,
input$plot_click,
threshold = 10,
maxpoints = 1,
addDist = F)$model
if (length(a) > 0) {
df <- data[data$model == a, ]
output$p2 <- renderPlot({
ggplot(df, aes(x = model, y = displ, group = 1)) +
geom_point()
})
}
})
}
shinyApp(ui, server)
EDITED here is the above solution using your code. A click on p1 outputs a second plot p2, and a click on p2 outputs a third plot p3. I made the plots smaller because I'm working on a laptop. Note that because your sample data is small, not all datapoints result in a valid click. But there are enough "good" points to test out the solution.
library(dplyr)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(ggplot2)
body <- dashboardBody(
fluidRow(
tabBox(
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1",height = 750,width=20,
tabPanel("Summary",dataTableOutput(outputId = "table")),
tabPanel("Visualization",
sliderInput("scalegvt","Scale Data by:", min = 0, max = 100, value = c(70,100)),
plotOutput("p1", height = 300, width = 300, click = "plot_click_p1"),
plotOutput("p2", height = 300, width = 300, click = "plot_click_p2"),
plotOutput("p3", height = 300, width = 300,)
)
)
)
)
side <- dashboardSidebar(
width = 290,
sidebarMenu(
menuItem("Summary",tabName = "Summary") ,
uiOutput('choose_Da'),
selectizeGroupUI(
id = "m",
inline = FALSE,
params = list(
Lot = list(inputId = "Lot", title = "Lot"),
wafer = list(inputId = "wafer", title = "wafer"),
M_datum = list(inputId = "M_Datum", title = "M_Datum"),
Yield = list(inputId = "Yield", title = "Yield")
)
),inline=FALSE,
menuItem("Visualization",tabName = "Visualization")
))
ui <- function(request) {
dashboardPage(
dashboardHeader(title = "Yield Report",titleWidth = 290),
side,
body
)
}
server = function(input, output,session) {
newscale <- reactive({
req(input$scalegvt)
})
mydt<-data.frame(Lot=c(rep("A",4),rep("b",5),rep("n",3),rep("x",2)),M_Datum=as.Date(c("2012-06-05","2012-06-15","2012-06-10","2014-11-17","2014-03-18","2014-06-15","2014-06-10","2014-06-17","2015-11-27","2016-08-15","2016-09-10","2016-10-27","2017-09-10","2017-10-12")),wafer=(c(rep(5,14)+1:14)),Yield=c(rep(10,14)+57))
dz<-reactive({
req(res_mod())
dat<-res_mod()
dt<-dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
dt[,2]<-as.Date(format(as.Date(dt[,2]), "%Y-%m-01"))
req(dt$M_Datum,dt$Yield)
dr<-data.frame("M_Datum"=dt$M_Datum,"Yield"=dt$Yield)
req(dr$M_Datum,dr$Yield)
dx<-aggregate(Yield~M_Datum,dr,mean)
req(dx$M_Datum,dx$Yield)
dx$M_Datum<-format(dx$M_Datum, "%b %Y")
return(data.frame("M_Datum"=dx$M_Datum,"Yield"=dx$Yield))
})
observeEvent(input$plot_click_p1, {
a <- nearPoints(dz(),
input$plot_click_p1,
threshold = 10,
maxpoints = 1,
addDist = F)
b <- match(substr(a$M_Datum,1,3),month.abb)
req(res_mod())
dat <- res_mod()
dt <- dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
dt <- dt[substr(dt$M_Datum,6,7)==as.character(b),]
req(dt$Lot, dt$Yield)
dr <- data.frame("Lot"=dt$Lot,"Yield"=dt$Yield)
req(dr$Lot, dr$Yield)
dx <- aggregate(Yield~Lot,dr,mean)
req(dx$Lot,dx$Yield)
dza <- data.frame("Lot"=dx$Lot,"Yield"=dx$Yield)
output$p2 <- renderPlot({
ggplot(dza, aes(x = Lot,y = Yield,group = 1)) +
geom_point()
})
})
observeEvent(input$plot_click_p2, {
output$p3 <- renderPlot({
test <- nearPoints(mydt,
input$plot_click_p2,
threshold = 10,
maxpoints = 1,
addDist = F)
str(test)
ggplot(test, aes(x = Lot, y = Yield)) +
geom_point()
})
})
output$choose_Da <- renderUI({
dateRangeInput('dateRange',
label = 'Filter by date',
start = min(mydt$M_Datum) , end = max(mydt$M_Datum),min=min(mydt$M_Datum),max=max(mydt$M_Datum)
)
})
res_mod <- callModule(
module = selectizeGroupServer,
id = "m",
data = mydt,
vars = c("Lot","M_Datum","Yield","wafer"),
inline=FALSE
)
output$table <- renderDataTable({
dato <- res_mod()
return(dato[dato$M_Datum >= input$dateRange[1] & dato$M_Datum <= input$dateRange[2],])
},options = list(scrollX = TRUE))
filtredplot <- reactive({
req(res_mod())
dat <- res_mod()
dt <- dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
dt[,2] <- as.Date(format(as.Date(dt[,2]), "%Y-%m-01"))
req(dt$M_Datum,dt$Yield)
dr<-data.frame("M_Datum"=dt$M_Datum,"Yield"=dt$Yield)
req(dr$M_Datum,dr$Yield)
dx<-aggregate(Yield~M_Datum,dr,mean)
req(dx$M_Datum,dx$Yield)
dz<-data.frame("M_Datum"=dx$M_Datum,"Yield"=dx$Yield)
dz$M_Datum<-factor(format(dz$M_Datum, "%b %Y"), levels=format(sort(unique(dz$M_Datum)),"%b %Y"))
hline_data <- data.frame(y = c(mean(dz$Yield)-sd(dz$Yield),mean(dz$Yield), mean(dz$Yield)+sd(dz$Yield)), type = factor(c(2, 1, 2)),
stringsAsFactors = FALSE)
ggplot(dz, aes(x=M_Datum, y=Yield,group = 1)) +
geom_point(size=7,colour="#007A9D",shape=4) +
theme(axis.text.x = element_text(angle = 0, vjust = 0.5, hjust=1))+
theme(legend.direction = "horizontal", legend.position = "top", legend.key = element_blank(),
legend.background = element_rect(fill = "white", colour = "white"),
axis.text.y.left = element_text(color = "#007A9D"),
axis.title.y.left = element_text(color = "#007A9D"),
plot.title = element_text(color="#007A9D")
) +
ylab("Mean Yield")+
xlab("")+
ggtitle(paste0("FCM-Yield Trend :"," ",paste0(c(input[["m-Customer_Name"]],input[["m-Local_Process_Id"]],input[["m-Process_Family"]],input[["m-MEMS_flag"]],input[["m-Device"]]),collapse = ",")))+
ylim(newscale())+
geom_hline(data = hline_data,
aes(yintercept = y, linetype = type, colour = type)) +
scale_colour_manual(values = c("#007A9D", "#EF783D"),
labels = c("Mean", "Mean+-sd"),
name = "Key:") +
scale_linetype_manual(values = 1:2,
labels = c("Mean", "Mean+-sd"),
name = "Key:")
})
output$p1 <- renderPlot({
filtredplot()
})
}
shinyApp(ui,server)
I am new to shiny and trying to change chart variable based on toggle switch input but getting error.
I have used the toggleid inside the observe({}) but not sure if that's how it is done.
Based on condition I have stored the required variable name in Case_selected which I have tried to use with !!Case_selected to get the variable name out from it.
ui code:
fluidRow(
style = "border: 1px solid gray;",
h3("Top Countries with Confirmed Cases"),
column(3, style = "border: 1px solid gray;",
materialSwitch(
inputId = "id_switch_confirmedtotal",
label = "Death Cases",
value = FALSE,
status = "danger"
),
plotOutput("top_confirmed_total", height = "650px")),
column(3, style = "border: 1px solid gray;",
materialSwitch(
inputId = "id_switch_confirmeddaily",
label = "Death Cases",
value = FALSE,
status = "danger"
),
plotOutput("top_confirmed_daily", height = "650px")),
column(6,
h4("Latest 1 week Top Countries by Daily Confirmed Cases"),
plotOutput("lastweek_confirmed_daily", height = "650px")
)
),
server code:
observe({
x <- input$id_switch_confirmedtotal
# condition tested
if (is.null(x))
Case_selected <- "Confirmed"
else
Case_selected <- "Death"
})
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = !! Case_selected, n = 10) %>% # Confirmed
ggplot(aes( x = !! Case_selected, y = reorder(Country.Region, !! Case_selected),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
#scale_fill_tableau(palette = "Tableau 20")
})
Error: object 'Case_selected' not found
I have also tried with !! rlang::sym() but not sure why none of this is working.
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = !! rlang::sym(Case_selected) , n = 10) %>% # Confirmed
ggplot(aes( x = !! rlang::sym(Case_selected), y = reorder(Country.Region, !! rlang::sym(Case_selected)),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
scale_fill_tableau(palette = "Tableau 20") +
labs(title = "Top10 TotalConfirmed Countries",
subtitle = glue("as of {max(ts_all_long$date)}"),
y = "", x = "Total Confirmed Cases",
caption = "Data source: covid19.analytics
Created by: ViSa")
})
Original Code that works without using any variable toggle option:
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = Confirmed, n = 10) %>%
ggplot(aes( x = Confirmed, y = reorder(Country.Region, Confirmed),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
#scale_fill_tableau(palette = "Tableau 20")
})
Update ts_all_long
Update for reproduce able example:
library(tidyverse)
library(lubridate)
file_url1 <- "https://raw.githubusercontent.com/johnsnow09/covid19-df_stack-code/main/ts_all_long4.csv"
ts_all_long <- read.csv(url(file_url1))
ts_all_long <- ts_all_long %>%
mutate(date = as.Date(date))
ui.R
library(shiny)
library(shinydashboard)
library(shinythemes)
library(shinyWidgets)
library(highcharter)
shinyUI(fluidPage(
theme=shinytheme("lumen"),
themeSelector(),
navbarPage(
title = "Covid19 Dashboard",
id = "Covid19_Dashboard",
tabPanel("By Confirmed Cases",
# Application title
titlePanel("Global level"),
# fluidRow(h5("(this Page may take some time, kindly wait to load!!)",
# col = "gray30", align = "center")),
fluidRow(
style = "border: 1px solid gray;",
h3("Top Countries with Confirmed Cases"),
column(3, style = "border: 1px solid gray;",
materialSwitch(
inputId = "id_switch_confirmedtotal",
label = "Death Cases",
value = FALSE,
status = "danger"
),
plotOutput("top_confirmed_total", height = "650px")
)
)
)))
server.R
library(shiny)
library(tidyverse)
library(ggthemes)
library(covid19.analytics)
library(tidytext)
library(scales)
library(lubridate)
library(glue)
library(highcharter)
library(shinyWidgets)
shinyServer(function(input, output) {
observe({
x <- input$id_switch_confirmedtotal
# condition tested
if (is.null(x))
Case_selected <- "Confirmed"
else
Case_selected <- "Death"
})
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = .data[[Case_selected]], n = 10) %>% # Confirmed
ggplot(aes( x = .data[[Case_selected]],
y = reorder(Country.Region, .data[[Case_selected]]),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
scale_fill_tableau(palette = "Tableau 20") +
labs(title = "Top10 TotalConfirmed Countries",
subtitle = glue("as of {max(ts_all_long$date)}"),
y = "", x = "Total Confirmed Cases",
caption = "Data source: covid19.analytics
Created by: ViSa")
})
})
You need to define Case_selected as reactive so that you can use it throughout the app. Also use .data to refer to column name.
shinyServer(function(input, output) {
rv <- reactiveValues()
observe({
x <- input$id_switch_confirmedtotal
# condition tested
if (!x) rv$Case_selected <- "Confirmed"
else rv$Case_selected <- "Death"
})
output$top_confirmed_total <- renderPlot({
ts_all_long %>%
filter(date == max(date, na.rm = TRUE)) %>%
slice_max(order_by = .data[[rv$Case_selected]], n = 10) %>% # Confirmed
ggplot(aes( x = .data[[rv$Case_selected]],
y = reorder(Country.Region, .data[[rv$Case_selected]]),
fill = Country.Region)) +
geom_col(show.legend = FALSE) +
scale_x_continuous(label = unit_format(scale = 1e-6, unit = "M")) +
scale_fill_tableau(palette = "Tableau 20") +
labs(title = "Top10 TotalConfirmed Countries",
subtitle = glue("as of {max(ts_all_long$date)}"),
y = "", x = "Total Confirmed Cases",
caption = "Data source: covid19.analytics
Created by: ViSa")
})
})
I'm trying to make a Shiny app which will take an uploaded CSV file and convert it into a tibble and then make a series of plots with the same X but using different columns for Y data, one per plot. I want the user to be able to use check boxes to select which plots they want to display and plot the result using plot_grid.
So far I managed to get the script to render the plots the way I want them and to draw them all on the fly from plot_grid if I name them manually. I'm having trouble including checkboxGroupInput output as an input for plot_grid, the characted vector returned cannot be used as a grob object. Here's the relevant code:
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
#Select which plots will be displayed
checkboxGroupInput(inputId = "whichPlot",
label = "Select data to plot",
choices = c("Temperature" = "tempChart()",
"Pressure" = "pressureChart()",
"Dissolved Oxygen" = "airsat()",
"pH" = "phChart()",
"Air flow" = "airChart()",
"Oxygen flow" = "O2Chart()"),
selected = "Temperature"),
#Select time scale
selectInput("timeScale",
"Choose time scale to plot",
choices = c("Minutes",
"Hours",
"Days"),
selected = "Minutes"),
#Apply button to make graphs
actionButton("DoIt", "Plot data"),
br(),
),
mainPanel(
plotOutput("plot"),
#the outputs below are not necessary, I just use them to see if I'm going in the right direction
textOutput("tableTitle"),
tableOutput("table"),
textOutput("selection"),
tableOutput("dataSummary")
)
)
)
server <- function(input, output) {
#A dummy tibble that I use for testing. will be replaced by Load button
dataDF <- tibble(date = c("01/01/2021","01/01/2021","01/01/2021","01/01/2021"), time = c("10:51:02","10:52:02","10:53:02","10:54:02"),
temp = c(20.000,22.000,23.000,24.000), pressure = c(50.000,50.000,50.000,50.000),
pH = c(7.000, 7.230, 7.100, 7.040), pO2 = c(100.000, 90.000, 80.000, 70.000),
airflow = c(1.000,1.000,1.000,1.000), O2flow = c(1.000,1.000,1.000,1.000), user = c("user","user","user","user"),
level = c(3,3,3,3), acid = c("00:00:00","00:00:00","00:00:00","00:00:00"), base =c("00:00:00","00:00:00","00:00:00","00:00:00"),
mins = c(0,2,3,4), hrs = c(0,60,180,360), dys = c(0,15,25,35))
output$table <- renderTable(head(dataDF))
#This changes the X axis scale and works well
colsel <- reactive({
switch(input$timeScale,
"Minutes" = 13,
"Hours" = 14,
"Days" = 15)
})
dataT <- reactive({
df <-dataDF[, 3:8]
df$runTime = pull(dataDF, colsel())
df
})
#A control table output to make sure tibble transformation worked (it works!)
output$dataSummary <- renderTable({
head(dataT())})
#Create a list of plots to be drawn from the checkboxes
plots <- reactive({
paste(input$whichPlot, sep = ",")
})
#save all the plots to individual objects to be chosen from later
airChart <- reactive({
ggplot(dataT(), aes(x = runTime, y = airflow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Air flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0, 1)
})
tempChart <- reactive({
ggplot (dataT(), aes(runTime, temp))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = expression(paste("Temperature [", degree, "C]")))+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(15, 45)
})
airsat <- reactive({
ggplot(dataT(), aes(runTime, pO2))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "%O2 saturation")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(80, 100)
})
phChart <- reactive({
ggplot(dataT(), aes(runTime, pH))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "pH")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(1,15)
})
O2Chart <- reactive({
ggplot(dataT(), aes(runTime, O2flow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "O2 flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,10)
})
pressureChart <- reactive({
ggplot(dataT(), aes(runTime, pressure))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Pressure [mbar]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,220)
})
#Plot my charts
observeEvent(input$DoIt,{
output$plot <- renderPlot({
(plot_grid(plots(), ncol = 2, labels = "auto"))
})
})
}
shinyApp(ui = ui, server = server)
When I try to use it, I get an error
Warning in as_grob.default(plot) :
Cannot convert object of class character into a grob.
Warning in grid.echo.recordedplot(dl, newpage, prefix) :
No graphics to replay
If I replace the last line with
output$plot <- renderPlot({
(plot_grid(tempChart(), airsat(), O2Chart(), pressureChart(), ncol = 2, labels = "auto"))
it works just fine. I'm not sure if there's a way to bypass the character to grob issue or if I'm making it unnecessarily too difficult. I looked at other solutions with if (which I don't fully understand) but I don't think they'll help here. It's my first contact with Shiny, so don't be too harsh please.
I'd use a different strategy here. Instead of storing every plot separately in a reactive, you can store them all in one list. Here I used a reactiveValues object that gets updated via an observeEvent. (In principal, you could even use a simple list to store the plots, because in your case the reactivity comes from the observeEvent. Using reactiveValues allows you to use single plots outside the cowplot with reactivity.)
Then you can use input$whichPlot just to index the list of plots. Also, putting an output$plot <- renderPlot inside an observeEvent isn't usually considered good practice, because renderPlot itself already has reactivity.
In order to only update the plot when input$DoIt is pressed, I use the bindEvent from the brand new shiny 1.6.0.
library(shiny)
library(cowplot)
library(ggplot2)
library(scales)
library(dplyr)
ui <- fluidPage(
titlePanel("Title"),
sidebarLayout(
sidebarPanel(
#Select which plots will be displayed
checkboxGroupInput(inputId = "whichPlot",
label = "Select data to plot",
choices = c("Temperature" = "temperature",
"Pressure" = "pressure",
"Dissolved Oxygen" = "dissolved_oxygen",
"pH" = "ph",
"Air flow" = "air_flow",
"Oxygen flow" = "oxygen_flow"),
selected = "Temperature"),
#Select time scale
selectInput("timeScale",
"Choose time scale to plot",
choices = c("Minutes",
"Hours",
"Days"),
selected = "Minutes"),
#Apply button to make graphs
actionButton("DoIt", "Plot data"),
br(),
),
mainPanel(
plotOutput("plot"),
#the outputs below are not necessary, I just use them to see if I'm going in the right direction
textOutput("tableTitle"),
tableOutput("table"),
textOutput("selection"),
tableOutput("dataSummary")
)
)
)
server <- function(input, output) {
#A dummy tibble that I use for testing. will be replaced by Load button
dataDF <- tibble(date = c("01/01/2021","01/01/2021","01/01/2021","01/01/2021"), time = c("10:51:02","10:52:02","10:53:02","10:54:02"),
temp = c(20.000,22.000,23.000,24.000), pressure = c(50.000,50.000,50.000,50.000),
pH = c(7.000, 7.230, 7.100, 7.040), pO2 = c(100.000, 90.000, 80.000, 70.000),
airflow = c(1.000,1.000,1.000,1.000), O2flow = c(1.000,1.000,1.000,1.000), user = c("user","user","user","user"),
level = c(3,3,3,3), acid = c("00:00:00","00:00:00","00:00:00","00:00:00"), base =c("00:00:00","00:00:00","00:00:00","00:00:00"),
mins = c(0,2,3,4), hrs = c(0,60,180,360), dys = c(0,15,25,35))
output$table <- renderTable(head(dataDF))
#This changes the X axis scale and works well
colsel <- reactive({
switch(input$timeScale,
"Minutes" = 13,
"Hours" = 14,
"Days" = 15)
})
dataT <- reactive({
df <-dataDF[, 3:8]
df$runTime = pull(dataDF, colsel())
df
})
#A control table output to make sure tibble transformation worked (it works!)
output$dataSummary <- renderTable({
head(dataT())})
# initialise reactiveValues object
plots <- reactiveValues(
temperature = NULL,
pressure = NULL,
dissolved_oxygen = NULL,
ph = NULL,
air_flow = NULL,
oxygen_flow = NULL
)
# the plots only change when dataT or input$timeScale changes
observeEvent(c(dataT(), input$timeScale), {
plots$temperature <- ggplot (dataT(), aes(runTime, temp))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = expression(paste("Temperature [", degree, "C]")))+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(15, 45)
plots$pressure <- ggplot(dataT(), aes(runTime, pressure))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Pressure [mbar]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,220)
plots$dissolved_oxygen <- ggplot(dataT(), aes(runTime, pO2))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "%O2 saturation")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(80, 100)
plots$ph <- ggplot(dataT(), aes(runTime, pH))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "pH")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(1,15)
plots$air_flow <- ggplot(dataT(), aes(x = runTime, y = airflow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "Air flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0, 1)
plots$oxygen_flow <- ggplot(dataT(), aes(runTime, O2flow))+
geom_line(size = 1, color = "#00B388")+
labs(x = paste("Runtime in",input$timeScale), y = "O2 flow [L/min]")+
scale_x_continuous(breaks = breaks_extended(n = 10))+
ylim(0,10)
})
output$plot <- renderPlot({
premade_plots <- reactiveValuesToList(plots)
do.call("plot_grid", c(premade_plots[input$whichPlot],
ncol = 2, labels = "auto"))
}) %>%
bindEvent(input$DoIt)
}
shinyApp(ui = ui, server = server)
Check if this helps
library(shiny)
library(tidyverse)
ui <- fluidPage(
checkboxGroupInput("grp", "Select", choices = NULL),
plotOutput("plot")
)
server <- function(input, output, session) {
tibble(x = 1:10,
y1 = sample(1:10),
y2 = sample(1:10),
y3 = sample(1:10),
y4 = sample(1:10)) %>%
pivot_longer(-x) -> df
observe({
updateCheckboxGroupInput(session, "grp", "Select",
choices = unique(df$name),
selected = unique(df$name)[1])
})
output$plot <- renderPlot({
df %>%
filter(name == req(input$grp)) %>%
ggplot(aes(x, value)) +
geom_col() +
facet_wrap(~name, ncol = 1)
})
}
shinyApp(ui, server)
I know this question has been asked many times before, but none of the solutions that I've read seem to work for me.
I have an R shiny app that works perfectly on my computer, but when I try to deploy it to an online server, I get the error "cannot coerce type 'closure' to vector of type 'character'". Here is my code (I have it all combined in app.R):
ui <- navbarPage(title = 'COVID Tweets',
tabPanel(
# App title ----
title = "US",
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Slider for the number of bins ----
sliderInput(inputId = "dateUS",
label = "Date:",
min = as.Date('2020-01-21'),
max = as.Date('2020-05-02'),
value = as.Date('2020-03-12'),
animate = animationOptions(interval = 2000)
),
radioButtons(inputId = 'sentimentUS',
label = 'Sentiment measure',
choices = c('Anxiety' = 'mean_anx',
'Sadness' = 'mean_sad',
'Anger' = 'mean_anger')
),
radioButtons(inputId = 'covid_measure',
label = 'COVID-19 measure',
choices = c('New Cases' = 'new_cases_mean_log10_no0',
'New Deaths' = 'new_deaths_mean_log10_no0',
'% New Cases' = 'pct_new_cases_mean')
)
),
mainPanel(
plotOutput(outputId = "my_plot")
)
)
),
tabPanel(
# App title ----
title = "State",
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
sliderInput(inputId = "date",
label = "Date:",
min = as.Date('2020-01-21'),
max = as.Date('2020-05-02'),
value = as.Date('2020-03-12'),
animate = animationOptions(interval = 2000)
),
radioButtons(inputId = 'sentiment',
label = 'Sentiment measure',
choices = c('Anxiety' = 'mean_anx',
'Sadness' = 'mean_sad',
'Anger' = 'mean_anger')
),
selectInput(inputId = 'state',
label = 'State Spotlight',
choices = fips,
selected = 36
),
radioButtons(inputId = 'curve_measure',
label = 'COVID-19 measure',
choices = c('New Cases' = 'new_cases_mean_curve',
'New Deaths' = 'new_deaths_mean_curve',
'% New Cases' = 'pct_new_cases_mean_curve')
)
),
mainPanel(
plotOutput(outputId = "state_plot")
)
)
)
)
# SERVER FUNCTION ---------------------------------------------------------
server_function <- shinyServer(function(input, output) {
output$my_plot <- renderPlot({
colorUS <- case_when(input$sentimentUS == 'mean_anx'~'darkorchid3',
input$sentimentUS == 'mean_sad'~'dodgerblue3',
input$sentimentUS == 'mean_anger'~'firebrick3')
df_sent <- sentiment_bystate %>%
filter(date == input$dateUS,
input$sentimentUS > 0) %>%
select(date, fips, input$sentimentUS)
li_sent <- c(0,df_sent %>%
filter(input$sentimentUS > 0) %>%
pull(input$sentimentUS) %>% max())
df_covid <- states_df %>%
filter(date == input$dateUS) %>%
select(date, fips, input$covid_measure)
li_covid <- c(0,df_covid %>%
filter(input$covid_measure > 0) %>%
pull(input$covid_measure) %>% max())
# create the plot
plot_sentiment <- plot_usmap(data = df_sent,
values = input$sentimentUS) +
theme(legend.position = 'right') +
scale_fill_continuous(name = 'Sentiment\n(%)',
low = 'white',
high = colorUS,
limits = li_sent) +
ggtitle('Sentiment Measure') +
theme(plot.title = element_text(hjust = 0.5,
size = 24),
legend.title = element_text(size = 14),
legend.text = element_text(size = 10),
legend.title.align = .5)
plot_covid <- plot_usmap(data = df_covid,
values = input$covid_measure) +
theme(legend.position = 'right') +
scale_fill_continuous(name = 'Number',
low = 'white',
high = 'tomato4',
limits = li_covid) +
ggtitle('COVID-19 Measure') +
theme(plot.title = element_text(hjust = 0.5,
size = 24),
legend.title = element_text(size = 14),
legend.text = element_text(size = 10),
legend.title.align = .5)
# Display the plot
gridExtra::grid.arrange(plot_sentiment,plot_covid, ncol = 1)
})
output$state_plot <- renderPlot({
color <- case_when(input$sentiment == 'mean_anx'~'darkorchid3',
input$sentiment == 'mean_sad'~'dodgerblue3',
input$sentiment == 'mean_anger'~'firebrick3')
df_sentstate <- sentiment_bystate %>%
filter(date == input$date,
fips == input$state) %>%
select(date, fips, input$sentiment)
df_senttime <- sentiment_bystate %>%
filter(fips == input$state,
date >= states_df %>% filter(fips %in% input$state) %>%
pull(date) %>% min())
state_map <- plot_usmap(include = input$state,
data = df_sentstate,
values = input$sentiment) +
scale_fill_continuous(name = input$sentiment,
low = 'white',
high = color,
limits = c(0,sentiment_bystate %>%
filter(fips == input$state) %>%
pull(input$sentiment) %>% max())) +
theme(legend.position = "right")
state_curve <- ggplot(data = states_df %>%
filter(fips == input$state)) +
geom_line(aes(x = date, y = states_df %>%
filter(fips == input$state) %>%
pull(input$curve_measure)), color = 'black',size = 2) +
geom_point(data = df_senttime,
aes(x = date, y = df_senttime %>%
pull(input$sentiment)*(states_df %>%
filter(fips == input$state) %>%
pull(input$curve_measure) %>% max(na.rm = TRUE)/df_senttime
%>% pull(input$sentiment) %>% max())),
color = color, size = 2) +
geom_vline(xintercept = input$date) +
labs(x = 'Date', y = 'Severity') +
theme_classic() +
theme(plot.title = element_text(hjust = 0.5,
size = 18),
legend.title = element_text(size = 12))
gridExtra::grid.arrange(state_map,state_curve,ncol = 1)
})
})
# SHINY APP CALL --------------------------------------------------------------
shinyApp(ui = ui, server = server_function)
I'm building a shiny application (Here!), Whose code below and the database for compilation can be found on my github. I can't understand why the graphics "Number of Deaths by Covid19 in Brazil" and "Number of Confirmed with Covid19 in Brazil" are not compiling? On my computer, sometimes the graphics are generated, sometimes not! In addition, the renderText () function is also not working and the graphics do not respond when changing the choice of state?
Obs: We did not notice an error when the code size decreased and only kept the graphics that are not compiling with the code below. That is, apparently, the brilliant cannot compile all the graphics for some reason!
Here is the code I am using:
Minimal code (I don't see the error in this case):
library("shiny")
library("readr")
library("dplyr")
library("tidyverse")
library("treemap")
library("ggplot2")
library("dplyr")
library("tidyr")
library("hrbrthemes")
library("ggrepel")
library("shinythemes")
library("rio")
library(miceadds)
load(url("https://rawcdn.githack.com/fsbmat-ufv/fsbmat-ufv.github.io/a16ef0fe0a27374cdbb7f88106c080ca0cd2ded3/blog_posts/26-03-2020/Corona/covid19.RData"))
data <- x
rm(x)
data$deaths[is.na(data$deaths)] <- 0
data$date <- as.Date(data$date)
data <- data[order(data$date) , ]
data <- data %>%
dplyr::filter(place_type == "state") %>%
dplyr::group_by(state,date, confirmed,deaths) %>%
select(date, state, confirmed, deaths, estimated_population_2019)
names(data) <- c("date", "state", "confirmed", "deaths", "Pop")
aggSetor <-data%>%filter(date==last(data$date))%>%group_by(state) %>% summarise(quantidade = sum(deaths),
confirmedM = mean(confirmed))
aggSetor$escala <- scale(aggSetor$confirmedM)
ui <- fluidPage( # App title ----
titlePanel("Coronavirus in Brazil"),
fluidRow(
column(width = 4, class = "well",
h4("Number of Deaths by Covid19 in Brazil"),
plotOutput("plot1", height = 200,
dblclick = "plot1_dblclick",
brush = brushOpts(
id = "plot1_brush",
resetOnNew = TRUE
)
)
),
column(width = 4, class = "well",
h4("Number of Confirmed with Covid19 in Brazil"),
plotOutput("plot2", height = 200,
dblclick = "plot2_dblclick",
brush = brushOpts(
id = "plot2_brush",
resetOnNew = TRUE
)
)
),
column(width = 4, class = "well",
h4("Treemap of deaths and number of confirmed by State"),
plotOutput("plot3", height = 200,
dblclick = "plot3_dblclick",
brush = brushOpts(
id = "plot3_brush",
resetOnNew = TRUE
)
)
)
)
)
server <- function(input, output) {
filt <- selectInput("codeInput",label ="Escolha um Estado",
choices = as.list(unique(data$state)))
output$codePanel <- renderUI({ filt
})
dataset<-reactive({
subset(data, state == input$codeInput)
})
dataset2<-reactive({
df <- dataset()
teste1 <- dplyr::lag(df$deaths)
teste1[is.na(teste1)] <- 0
teste2 <- dplyr::lag(df$confirmed)
teste2[is.na(teste2)] <- 0
df$teste1 <- teste1
df$teste2 <- teste2
df$deaths_day <- df$deaths-df$teste1
df$confirmed_day <- df$confirmed-df$teste2
df <- df %>% select(1:5,8:9)
return(df)
})
dataset3 <- reactive({
ndeaths <- data %>% group_by(date) %>% summarise(deaths = sum(deaths))
return(ndeaths)
})
dataset4 <- reactive({
nconfirmed <- data %>% group_by(date) %>% summarise(confirmed = sum(confirmed))
return(nconfirmed)
})
# -------------------------------------------------------------------
# Single zoomable plot (on left)
#ranges <- reactiveValues(x = date, y = confirmed)
output$plot1 <- renderPlot({
xlab <- "Data"
legenda <- "fonte: https://brasil.io/dataset/covid19"
ggplot2::ggplot(dataset3(), aes(x = date, y = deaths)) +
geom_bar(stat = "identity", alpha = .7, color = "red", fill = "red") +
scale_x_date(date_breaks = "1 day",
date_labels = "%d/%m") +
scale_y_continuous(limits = c(0, max(dataset3()$deaths+20, na.rm = TRUE) + 3),
expand = c(0, 0)) +
geom_text(aes(label=deaths), position=position_dodge(width=0.9), vjust=-0.25) +
labs(x = xlab,
y = "Number of Deaths",
title = " ",
caption = legenda) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90))
})
output$plot2 <- renderPlot({
xlab <- "Data"
legenda <- "fonte: https://brasil.io/dataset/covid19/caso"
ggplot2::ggplot(dataset4(), aes(x = date, y = confirmed)) +
geom_bar(stat = "identity", alpha = .7, color = "red", fill = "red") +
scale_x_date(date_breaks = "1 day",
date_labels = "%d/%m") +
scale_y_continuous(limits = c(0, max(dataset4()$confirmed+300, na.rm = TRUE) + 3),
expand = c(0, 0)) +
geom_text(aes(label=confirmed), position=position_dodge(width=0.5), vjust=-0.25) +
labs(x = xlab,
y = "Number of Confirmed",
title = " ",
caption = legenda) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90))
})
output$plot3 <- renderPlot({
treemap(aggSetor, index = "state", vSize = "quantidade", vColor = "escala",
type = "value", palette = "-RdGy", lowerbound.cex.labels = 0.3,
title = "Color related to deaths - Size related to confirmed")
})
}
shinyApp(ui = ui, server = server)
Complete code:
library("shiny")
library("readr")
library("dplyr")
library("tidyverse")
library("treemap")
library("ggplot2")
library("dplyr")
library("tidyr")
library("hrbrthemes")
library("ggrepel")
library("shinythemes")
library("rio")
#library(miceadds)
#setwd("~/GitHub/fsbmat-ufv.github.io/blog_posts/26-03-2020/Shiny/Corona")
#data <- read_csv(url("https://rawcdn.githack.com/fsbmat-ufv/fsbmat-ufv.github.io/fcba93f491ed21eba0628471649eb9a5bda033f2/blog_posts/26-03-2020/Corona/covid19.csv"))
#export(data, "covid19.rdata")
load(url("https://rawcdn.githack.com/fsbmat-ufv/fsbmat-ufv.github.io/a16ef0fe0a27374cdbb7f88106c080ca0cd2ded3/blog_posts/26-03-2020/Corona/covid19.RData"))
#load("covid19.Rdata")
data <- x
rm(x)
#data <- miceadds::load.Rdata2(filename=url("https://rawcdn.githack.com/fsbmat-ufv/fsbmat-ufv.github.io/a16ef0fe0a27374cdbb7f88106c080ca0cd2ded3/blog_posts/26-03-2020/Corona/covid19.RData"))
data$deaths[is.na(data$deaths)] <- 0
data$date <- as.Date(data$date)
data <- data[order(data$date) , ]
data <- data %>%
dplyr::filter(place_type == "state") %>%
dplyr::group_by(state,date, confirmed,deaths) %>%
select(date, state, confirmed, deaths, estimated_population_2019)
names(data) <- c("date", "state", "confirmed", "deaths", "Pop")
aggSetor <-data%>%filter(date==last(data$date))%>%group_by(state) %>% summarise(quantidade = sum(deaths),
confirmedM = mean(confirmed))
aggSetor$escala <- scale(aggSetor$confirmedM)
#tabPanelSobre <- source("sobre.r")$value
ui <- fluidPage(#theme=shinytheme("united"),
headerPanel(
HTML(
'<div id="stats_header">
Coronavirus in Brazil
<img align="right" alt="fsbmat Logo" src="./img/fsbmat.png" />
</div>'
),
"Coronavirus in Brazil"
),
# App title ----
titlePanel("Coronavirus in Brazil"),
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
uiOutput("codePanel")#,
#tags$p("Autor: Fernando de Souza Bastos - Professor da Universidade Federal de Vicosa - MG")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Formatted text for caption ----
h3(textOutput("caption")),
# Output: 1 ----
plotOutput("deathsPlot", height = 300,
dblclick = "deathsPlot_dblclick",
brush = brushOpts(
id = "deathsPlot_brush",
resetOnNew = TRUE
)
),
plotOutput("confirmedPlot", height = 300,
dblclick = "confirmedPlot_dblclick",
brush = brushOpts(
id = "confirmedPlot_brush",
resetOnNew = TRUE
)
),
plotOutput("dayPlot", height = 300,
dblclick = "dayPlot_dblclick",
brush = brushOpts(
id = "dayPlot_brush",
resetOnNew = TRUE
)
),
DT::dataTableOutput("text")
)
),
fluidRow(
column(width = 4, class = "well",
h4("Number of Deaths by Covid19 in Brazil"),
plotOutput("plot1", height = 200,
dblclick = "plot1_dblclick",
brush = brushOpts(
id = "plot1_brush",
resetOnNew = TRUE
)
)
),
column(width = 4, class = "well",
h4("Number of Confirmed with Covid19 in Brazil"),
plotOutput("plot2", height = 200,
dblclick = "plot2_dblclick",
brush = brushOpts(
id = "plot2_brush",
resetOnNew = TRUE
)
)
),
column(width = 4, class = "well",
h4("Treemap of deaths and number of confirmed by State"),
plotOutput("plot3", height = 200,
dblclick = "plot3_dblclick",
brush = brushOpts(
id = "plot3_brush",
resetOnNew = TRUE
)
)
)
)#,
#tabPanelSobre()
)
server <- function(input, output) {
filt <- selectInput("codeInput",label ="Escolha um Estado",
choices = as.list(unique(data$state)))
output$codePanel <- renderUI({ filt
})
dataset<-reactive({
subset(data, state == input$codeInput)
})
dataset2<-reactive({
df <- dataset()
teste1 <- dplyr::lag(df$deaths)
teste1[is.na(teste1)] <- 0
teste2 <- dplyr::lag(df$confirmed)
teste2[is.na(teste2)] <- 0
df$teste1 <- teste1
df$teste2 <- teste2
df$deaths_day <- df$deaths-df$teste1
df$confirmed_day <- df$confirmed-df$teste2
df <- df %>% select(1:5,8:9)
return(df)
})
dataset3 <- reactive({
ndeaths <- data %>% group_by(date) %>% summarise(deaths = sum(deaths))
return(ndeaths)
})
dataset4 <- reactive({
nconfirmed <- data %>% group_by(date) %>% summarise(confirmed = sum(confirmed))
return(nconfirmed)
})
# output$caption and output$mpgPlot functions
formulaText <- reactive({
paste("Results Regarding the State of", input$codeInput)
})
# Return the formula text for printing as a caption ----
output$caption <- renderText({
formulaText()
})
output$text<-renderDataTable(dataset())
# # Generate a plot of the requested variable against mpg ----
# # and only exclude outliers if requested
output$deathsPlot <- renderPlot({
xlab <- "Data"
legenda <- "fonte: https://brasil.io/dataset/covid19/caso"
ggplot2::ggplot(dataset(), aes(x = date, y = deaths)) +
geom_bar(stat = "identity", alpha = .7, color = "red", fill = "red") +
scale_x_date(date_breaks = "1 day",
date_labels = "%d/%m") +
scale_y_continuous(limits = c(0, max(dataset()$deaths+20, na.rm = TRUE) + 3),
expand = c(0, 0)) +
geom_text(aes(label=deaths), position=position_dodge(width=0.9), vjust=-0.25) +
labs(x = xlab,
y = "Numbers of Deaths",
title = "Number of deaths by COVID-19",
caption = legenda) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90))
})
output$confirmedPlot <- renderPlot({
xlab <- "Data"
legenda <- "fonte: https://brasil.io/dataset/covid19/caso"
ggplot2::ggplot(dataset(), aes(x = date, y = confirmed)) +
geom_bar(stat = "identity", alpha = .7, color = "red", fill = "red") +
scale_x_date(date_breaks = "1 day",
date_labels = "%d/%m") +
scale_y_continuous(limits = c(0, max(dataset()$confirmed+100, na.rm = TRUE) + 3),
expand = c(0, 0)) +
geom_text(aes(label=confirmed), position=position_dodge(width=0.9), vjust=-0.25) +
labs(x = xlab,
y = "Numbers of Confirmed",
title = "Number of Cases Confirmed with Covid19",
caption = legenda) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90))
})
output$dayPlot <- renderPlot({
xlab <- "Data"
legenda <- "fonte: https://brasil.io/dataset/covid19/caso"
#Graph with the number of confirmed daily cases
ggplot(dataset2(), aes(x=date, y=confirmed_day))+
geom_line( color="steelblue")+
geom_point() +
geom_text_repel(aes(label=confirmed_day), size = 3)+
xlab("Data") + ylab("Number of confirmed daily cases")+
theme_ipsum() +
theme(axis.text.x=element_text(angle=60, hjust=1))+
scale_x_date(date_breaks = "2 day", date_labels = "%d %b")
})
# -------------------------------------------------------------------
# Single zoomable plot (on left)
#ranges <- reactiveValues(x = date, y = confirmed)
output$plot1 <- renderPlot({
xlab <- "Data"
legenda <- "fonte: https://brasil.io/dataset/covid19"
ggplot2::ggplot(dataset3(), aes(x = date, y = deaths)) +
geom_bar(stat = "identity", alpha = .7, color = "red", fill = "red") +
scale_x_date(date_breaks = "1 day",
date_labels = "%d/%m") +
scale_y_continuous(limits = c(0, max(dataset3()$deaths+20, na.rm = TRUE) + 3),
expand = c(0, 0)) +
geom_text(aes(label=deaths), position=position_dodge(width=0.9), vjust=-0.25) +
labs(x = xlab,
y = "Number of Deaths",
title = " ",
caption = legenda) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90))
})
# -------------------------------------------------------------------
# Linked plots (middle and right)
#ranges2 <- reactiveValues(x = NULL, y = NULL)
output$plot2 <- renderPlot({
xlab <- "Data"
legenda <- "fonte: https://brasil.io/dataset/covid19/caso"
ggplot2::ggplot(dataset4(), aes(x = date, y = confirmed)) +
geom_bar(stat = "identity", alpha = .7, color = "red", fill = "red") +
scale_x_date(date_breaks = "1 day",
date_labels = "%d/%m") +
scale_y_continuous(limits = c(0, max(dataset4()$confirmed+300, na.rm = TRUE) + 3),
expand = c(0, 0)) +
geom_text(aes(label=confirmed), position=position_dodge(width=0.5), vjust=-0.25) +
labs(x = xlab,
y = "Number of Confirmed",
title = " ",
caption = legenda) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90))
})
output$plot3 <- renderPlot({
treemap(aggSetor, index = "state", vSize = "quantidade", vColor = "escala",
type = "value", palette = "-RdGy", lowerbound.cex.labels = 0.3,
title = "Color related to deaths - Size related to confirmed")
})
}
shinyApp(ui = ui, server = server)
Apparently, the problem is the communication of shiny with the database. The same application using Fleshboard worked perfectly, follow the link for viewing, click here!