Reactive function giving error in Shiny framework R - r

I am trying to make a reactive plot with radio buttons in shiny. However, after using the reactive expressions I am not able to see any plot.
Here is the reproducible code of the complete app
# Loading libs
library(shiny)
library(shinythemes)
library(ggplot2)
library(mapdata)
library(mapproj)
ui <- fluidPage(theme = shinytheme("cosmo"),
navbarPage("PageTitle",
tabPanel("US-Data-Visualizer",
sidebarPanel(tags$h2("Map Visualizer"), tags$h4("Visualize the counts on US map, state wise"),
radioButtons("radio_option", label = "Select from the following options:",
choices = list("Total Cases" = "state$TOTAL.CASES", "New Cases" = "state$NEW.CASES",
"Active Cases" = "state$ACTIVE.CASES", "Total Deaths" = "state$TOTAL.DEATHS",
"New Deaths" = "state$NEW.DEATHS", "Total Tests" = "state$TOTAL.TESTS"),
selected = "state$TOTAL.CASES")),
mainPanel(plotOutput("us_cases"))))
) #close fluid page
server <- function(input, output){
state <- read.csv("https://raw.githubusercontent.com/spriyansh/ShinyApps/master/datasets/USA_State_Wise_Data.csv", fileEncoding="UTF-8")
us_geo_data <- map_data("county")
reactive_df <- reactive({
us_geo_data <- data.table(us_geo_data)
covid_map <- data.frame(state_names=unique(us_geo_data$region),
values = input$radio_option)
setkey(us_geo_data,region)
covid_map <- data.table(covid_map)
setkey(covid_map,state_names)
map.df <- us_geo_data[covid_map]})
output$us_cases <- renderPlot(
ggplot(reactive_df()$map.df,
aes(x = reactive_df()$map.df$long, y = reactive_df()$map.df$lat,
group = reactive_df()$map.df$group,fill = reactive_df()$covid_map$values)) +
geom_polygon(alpha = 0.8) + coord_map()
)}
shinyApp(ui, server)

Your example is not reproducible because there is no data and no library calls. Please see here and here to know how to make a minimal, reproducible example.
Edit following OP's edit:
The problem is that you try to return different dataframes from reactive_df, which is impossible. You should instead merge covid_map and state_names together, so that all the information you need is in map.df, which is returned by reactive since it is the last action. Then, you can remove the long expressions in ggplot.
There was also a problem with the choices in radioButtons. It is better to only put the column names as choices and then to call filter the data with these column names with state[[input$radio_option]].
Here's your code:
# Loading libs
library(shiny)
library(shinythemes)
library(ggplot2)
library(mapdata)
library(mapproj)
library(data.table)
library(dplyr)
state <- read.csv("https://raw.githubusercontent.com/spriyansh/ShinyApps/master/datasets/USA_State_Wise_Data.csv", fileEncoding = "UTF-8")
us_geo_data <- map_data("county")
ui <- fluidPage(
theme = shinytheme("cosmo"),
navbarPage(
"PageTitle",
tabPanel(
"US-Data-Visualizer",
sidebarPanel(
tags$h2("Map Visualizer"), tags$h4("Visualize the counts on US map, state wise"),
radioButtons("radio_option",
label = "Select from the following options:",
choices = list(
"Total Cases" = "TOTAL.CASES", "New Cases" = "NEW.CASES",
"Active Cases" = "ACTIVE.CASES", "Total Deaths" = "TOTAL.DEATHS",
"New Deaths" = "NEW.DEATHS", "Total Tests" = "TOTAL.TESTS"
),
selected = "TOTAL.CASES"
)
),
mainPanel(plotOutput("us_cases"))
)
)
) # close fluid page
server <- function(input, output) {
reactive_df <- reactive({
us_geo_data <- data.table(us_geo_data)
covid_map <- data.frame(
state_names = unique(us_geo_data$region),
values = state[[input$radio_option]]
)
setkey(us_geo_data, region)
covid_map <- data.table(covid_map)
setkey(covid_map, state_names)
map.df <- dplyr::left_join(us_geo_data, covid_map, by = c("region" = "state_names"))
})
output$us_cases <- renderPlot(
ggplot(
reactive_df(),
aes(
x = long, y = lat,
group = group, fill = values
)
) +
geom_polygon(alpha = 0.8) +
coord_map()
)
}
shinyApp(ui, server)

Related

Shiny: Create multiple tabs with separate inputs on each

I am building a shiny application with several tabs, each tab takes a user input (unique(data_in$cat), and generates some type of graph. The problem occurs in the second tab--for some reason, it does not generate the graph that is specified by data2. The first graph on the first tab is being displayed correctly.I see no error when I run this code, so I don't know where to start debugging!
library(shiny)
library(openxlsx)
library(ggplot2)
data_in <- read.xlsx("www/dem_data_clean.xlsx")
ui <- navbarPage(title = "Data",
tabPanel(title = "Over-all trends",
plotOutput("Histall"),
selectInput("Indall","Demographic Variable of Interest",choices = unique(data_in$cat))
),
tabPanel(title = "2017-2018"),
plotOutput("Hist17"),
selectInput("Ind17","Demographic Variable of Interest",choices = unique(data_in$cat))
)
server <- function(input, output, session) {
data1 <- reactive({
a <- subset(data_in,cat==input$Indall)
return(a)
})
data2 <- reactive({
a <- subset(data_in,cat==input$Ind17)
return(a)
})
output$Histall <- renderPlot({
ggplot(data1(), aes(x=Year,y=value, group =name, color=name)) + geom_line(stat = "identity") +
ylab("Percent of Population")
})
output$Hist17 <- renderPlot({
data2() %>%
filter(Year=="2017-18") %>%
ggplot(aes(name, value)) + geom_bar(stat = "identity")
})
}
shinyApp(ui, server)
Any suggestions to what I am doing wrong? I've tried playing around with different things for a few hours now to no avail!
The UI code is not correct, second plotOutput and selectInput are not within second tabPanel. It works if you fix it :
ui <- navbarPage(title = "Data",
tabPanel(title = "Over-all trends",
plotOutput("Histall"),
selectInput("Indall",
"Demographic Variable of Interest",
choices = unique(data_in$cat))
),
tabPanel(title = "2017-2018",
plotOutput("Hist17"),
selectInput("Ind17",
"Demographic Variable of Interest",
choices = unique(data_in$cat)))
)

radioButtons() input as a condition to filter a data frame in Shiny, doesn't seem to work

Using the midwest dataframe from ggplot2:
# (in app_ui.r)
poverty_sidebar <- sidebarPanel(
radioButtons(
inputId = "state",
label = "State",
choices = list("IL" = 1, "IN" = 2, "MI" = 3, "OH" = 4, "WI" = 5),
selected = 1
))
poverty_plot <- mainPanel(
plotOutput(
outputId = "poverty_plot"
)
)
# (in app_server.r)
server <- function(input, output) {
output$poverty_plot <- renderPlot({
filtered <- filter(midwest, state == input$state)
plot <- ggplot(data = filtered) +
geom_col(x = county, y = poppovertyknown)
return(plot)
})
Doesn't seem to work, gives me a "Object county not found" error. is doing filter(midwest, state == input$state) the wrong approach? Or does the error lie with my radio buttons?
So the code provided is close, you are making two mistakes
choices does not need to map to numeric
x = county, y = poppovertyknown should be in the aes of geom_col so aes(x = county, y = poppovertyknown)
Hence the final working code would be (Note I have added assignment to ui to make it work in single file with call to shinyApp(ui, server)),
library(shiny)
library(dplyr)
library(ggplot2)
poverty_sidebar <- sidebarPanel(
radioButtons(
inputId = "state",
label = "State",
choices = list("IL", "IN", "MI", "OH", "WI"), # remove mapping to integers
selected = "IL"
))
poverty_plot <- mainPanel(
plotOutput(
outputId = "poverty_plot"
)
)
ui <-
fluidPage(
poverty_sidebar,
poverty_plot
)
# (in app_server.r)
server <- function(input, output) {
output$poverty_plot <- renderPlot({
filtered <- filter(midwest, state == input$state)
print(filtered)
print(input$state)
filtered0 <<- filtered
plot <-
filtered %>%
ggplot() +
geom_col(aes(x = county, y = poppovertyknown)) # used aes()
return(plot)
})
}
shinyApp(ui, server)

Interactive renderplot graph with multidimensional dataset

I am trying to run an interactive rshiny plot. I have this output:
I want to be able to subset and plot by country, by scenario, by variable, by year (4 selections). I also want to be able to add value points by year and not have the whole plot by year done immediately.
I am only able to subset by country. My scenario and variable dropdowns are not reactive. And it plots all variables with all scenarios although I want one variable plot by one scenario and one country
How can I make my graph interactive?
library(reshape2)
library(lattice)
library(plyr)
library(shiny)
library(dplyr)
library(abind)
library(ggplot2)
ui <- fluidPage(
titlePanel("Comparing Trend and PP policies by MDGs and funding"),
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = h3("Country"),choices=unique(dmiubf$country), selected = ""),
selectInput("Senario","Show senario:", choices = unique(dmiubf$scn)),
selectInput("var","Show senario:", choices = unique(dmiubf$var)),
selectInput("year","Show vertical line in year(s):", choices = unique(dmiubf$year),multiple=TRUE)
),
mainPanel(
plotOutput("chart")
)
)
)
server <- function(input, output) {
cr <- reactive({
a = dmiubf[dmiubf$var==input$var, dmiubf$scn==input$senario]<-dmiubf[dmiubf[,"country"]=="Costa Rica",input$senario]<-"base"
dmiubf
})
output$chart <- renderPlot({
req(input$radio)
if (input$radio==c("Costa Rica")) {
plot0<-ggplot(data=cr()) + geom_point(aes(x=year,y=pcn, fill=scn),
size = 6)
print(plot0)
}
})
}
shinyApp(ui = ui, server = server)
I tried fixing your app, but without knowing how the input data looks like, its a bit hard. So i created a random dummy dataset. Therefore it is not always showing a plot, as no data is left after the filtering process.
But as a starting point I think this should help you:
library(shiny)
library(dplyr)
library(ggplot2)
dmiubf <- data.frame(
country=c(rep("Costa Rica",8), rep("England",8), rep("Austria",8), rep("Latvia",8)),
scn = rep(c("base","high","low","extra"),8),
year = sample(c(1998, 1999, 2000, 2001), 32, replace = T),
var = sample(c(1,2,3,4), 32, replace = T),
pcn = sample(c(10,20,30,40), 32, replace = T)
)
ui <- fluidPage(
titlePanel("Comparing Trend and PP policies by MDGs and funding"),
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = h3("Country"),choices= as.character(unique(dmiubf$country)), selected = ""),
selectInput("Senario","Show senario:", choices = as.character(unique(dmiubf$scn))),
selectInput("var","Show senario:", choices = sort(unique(dmiubf$var))),
selectInput("year","Show vertical line in year(s):", choices = sort(unique(dmiubf$year)), multiple=TRUE)
),
mainPanel(
plotOutput("chart")
)
)
)
server <- function(input, output) {
cr <- reactive({
a <- dmiubf[as.character(dmiubf$country)==input$radio &
dmiubf$var %in% as.numeric(input$var) &
dmiubf$year %in% as.numeric(input$year) &
as.character(dmiubf$scn)==input$Senario
,]
a
})
output$chart <- renderPlot({
validate(
need(nrow(cr())!=0, "No Data to plot")
)
ggplot(data=cr()) + geom_point(aes(x=year, y=pcn, fill=scn), size = 6)
})
}
shinyApp(ui = ui, server = server)

Character vector of length 1 all but the first element will be ignored error when filtering data in Shiny Application

I have the following Shiny Application:
library(shiny)
library(rhandsontable)
library(shinydashboard)
library(ggplot2)
library(dplyr)
setwd("C:/Users/Marc/Dropbox/PROJECTEN/Lopend/shiny_interactive_graph")
tweets <- data.frame(
city = c("new york", "texas", "texas"),
tweet = c("Test1", "Test", "tst")
)
shinyApp(
ui = dashboardPage(
dashboardHeader(
title = "Tweetminer",
titleWidth = 350
),
dashboardSidebar(
width = 350,
sidebarMenu(
menuItem("Menu Item")
)
),
dashboardBody(
fluidRow(
tabBox(
tabPanel("Set tweets2",
plotOutput('plot',
brush = brushOpts(
id = "plot1_brush"
)),
h4("Selected States"),
verbatimTextOutput("select_states"),
h4("Selected States' Tweets"),
verbatimTextOutput("tweets")
)
)
)
)
),
server = function(input, output) {
output$plot <- renderPlot({
all_states <- map_data("state")
# Add more states to the lists if you want
states_positive <-c("new york")
states_negative <- c("texas")
# Plot results
ggplot(all_states, aes(x=long, y=lat, group = group)) +
geom_polygon(fill="grey", colour = "white") +
geom_polygon(fill="green", data = filter(all_states, region %in% states_positive)) +
geom_polygon(fill="red", data = filter(all_states, region %in% states_negative))
})
selected_points <- reactiveVal()
observeEvent(input$plot1_brush,{
all_states <- map_data("state")
selected_points( brushedPoints(all_states, input$plot1_brush))
})
observeEvent(selected_points(), {
showModal(modalDialog(
title = "Important message",
tweets[(tweets$city %in% brushed_states()),],
easyClose = TRUE
))
})
output$brush_info <- renderPrint({
all_states <- map_data("state")
brushedPoints(all_states, input$plot1_brush)
})
#get states from brushed coordinates
brushed_states <- reactive({
all_states <- map_data("state")
brushed <- brushedPoints(all_states, input$plot1_brush)
unique(brushed$region)
})
#this is to show the selected states
output$select_states <- renderText({
brushed_states()
})
output$tweets <- renderPrint({
tweets[(tweets$city %in% brushed_states()),]
})
})
This basically allows to select a map on the map and then get a popup with all the relevant tweets. I fetch the relevant tweets by this line:
tweets[(tweets$city %in% brushed_states()),]
However, when I select Texas I only get his:
texas Test
While I expect:
texas Test
texas tst
I think this has to do with the following error:
Warning in charToRaw(enc2utf8(text)) :
argument should be a character vector of length 1
all but the first element will be ignored
I am kind of lost, what is exactly happening here.... Any thoughts on what is causing this error?
The reason it does not work is that the modalDialog expects text or html, but you are passing it a data.frame, which it does not know how to print. So you have to convert your data.frame to a printable version first. Here is an example implementation:
observeEvent(selected_points(), {
my_tweets <- tweets[(tweets$city %in% brushed_states()),]
showModal(modalDialog(
title = "Important message",
HTML(paste(apply(my_tweets,1,function(x) {paste(x,collapse=': ')}),collapse='<br>')),
easyClose = TRUE
))
})
Hope this helps!

Sub-setting data interactively with plotly or googlevis charts in Shiny App

R Gugus,
Is there any way to sub-set and view data in data.table by clicking on an interactive plotly or googlevis chart in shiny app?
For example, I would like to see the highlighted row in the picture when I click on the related part on plotly chart generated by the following code:
library(shiny)
library(plotly)
library(DT)
library(dplyr)
shinyApp(
ui = shinyUI(fluidPage(
titlePanel("Movie Ratings!"),
mainPanel(
plotlyOutput("chart", width = "100%"),
dataTableOutput("DToutput")
)
)),
server = function(input, output, session) {
df <- structure(c(106487,495681,1597442,2452577,2065141,2271925,4735484,3555352,8056040,4321887,
2463194,347566,621147,1325727,1123492,800368,761550,1359737,1073726,36,53,141,
41538,64759,124160,69942,74862,323543,247236,112059,16595,37028,153249,427642,
1588178,2738157,2795672,2265696,11951,33424,62469,74720,166607,404044,426967,
38972,361888,1143671,1516716,160037,354804,996944,1716374,1982735,3615225,
4486806,3037122,17,54,55,210,312,358,857,350,7368,8443,6286,1750,7367,14092,
28954,80779,176893,354939,446792,33333,69911,53144,29169,18005,11704,13363,
18028,46547,14574,8954,2483,14693,25467,25215,41254,46237,98263,185986),
.Dim=c(19,5),.Dimnames=list(c("1820-30","1831-40","1841-50","1851-60","1861-70",
"1871-80","1881-90","1891-00","1901-10","1911-20",
"1921-30","1931-40","1941-50","1951-60","1961-70",
"1971-80","1981-90","1991-00","2001-06"),
c("Europe","Asia","Americas","Africa","Oceania")))
df.m <- melt(df)
df.m <- rename(df.m, c(Var1 = "Period", Var2 = "Region"))
output$chart <- renderPlotly({
a <- ggplot(df.m, aes(x = Period, y = value/1e+06,fill = Region)) +
ggtitle("Migration to the United States by Source Region (1820-2006), In Millions")
b <- a + geom_bar(stat = "identity", position = "stack")
p <- ggplotly(b)
p
})
output$DToutput <- renderDataTable({df.m})
})
Ultimate aim is to produce an app where the user can navigate easily by between data and charts anywhere in the app. I have a similar app but written in a different code: http://mqasim.me/sw1000/
Current click events in Plotly return all data in the trace so it will be difficult to isolate elements in the stack. Also, will need to build the plot with plot_ly(). One way to deal with the selected table rows being on a different page is to eliminate the need for pagination.
curveNumber: for mutiple traces, information will be returned in a stacked fashion
See this Plotly tutorial for coupled events and section 2.3 of the Shiny page of DT for selecting rows.
library(shiny)
library(plotly)
library(DT)
library(dplyr)
library(reshape2)
shinyApp(
ui = shinyUI(fluidPage(
titlePanel("Movie Ratings!"),
mainPanel(
plotlyOutput("chart", width = "100%"),
DT::dataTableOutput("DToutput")
)
)),
server = function(input, output, session) {
df <- structure(c(106487,495681,1597442,2452577,2065141,2271925,4735484,3555352,8056040,4321887,
2463194,347566,621147,1325727,1123492,800368,761550,1359737,1073726,36,53,141,
41538,64759,124160,69942,74862,323543,247236,112059,16595,37028,153249,427642,
1588178,2738157,2795672,2265696,11951,33424,62469,74720,166607,404044,426967,
38972,361888,1143671,1516716,160037,354804,996944,1716374,1982735,3615225,
4486806,3037122,17,54,55,210,312,358,857,350,7368,8443,6286,1750,7367,14092,
28954,80779,176893,354939,446792,33333,69911,53144,29169,18005,11704,13363,
18028,46547,14574,8954,2483,14693,25467,25215,41254,46237,98263,185986),
.Dim=c(19,5),.Dimnames=list(c("1820-30","1831-40","1841-50","1851-60","1861-70",
"1871-80","1881-90","1891-00","1901-10","1911-20",
"1921-30","1931-40","1941-50","1951-60","1961-70",
"1971-80","1981-90","1991-00","2001-06"),
c("Europe","Asia","Americas","Africa","Oceania")))
df.m <- melt(df)
df.m <- rename(df.m, Period = Var1, Region = Var2)
output$chart <- renderPlotly({
plot_ly(data = df.m, x = Period, y = value/1e+06, color = Region, type = "bar", source = "select") %>%
layout(title = "Migration to the United States by Source Region (1820-2006), In Millions",
xaxis = list(type = "category"),
barmode = "stack")
})
output$DToutput <- DT::renderDataTable({
datatable(df.m, selection = list(target = "row+column"),
options = list(pageLength = nrow(df.m), dom = "ft"))
})
proxy = dataTableProxy('DToutput')
# highlight rows that are selected on plotly output
observe({
event.data = plotly::event_data("plotly_click", source = "select")
if(is.null(event.data)) {
rowNums <- NULL
} else {
rowNums <- row.names(df.m[df.m$Period %in% event.data$x,])
}
proxy %>% selectRows(as.numeric(rowNums))
})
})

Resources