Problem in creating boxplots with R shiny app - r

I'm very new to the Shiny app R. I'm trying to make simple boxplots in the Shiny R app for some dataset.
Here I am showing some example data in a file df.csv. The data looks like below. Showing the dput of the data below:
structure(list(Samples = structure(1:10, .Label = c("Sample1",
"Sample10", "Sample2", "Sample3", "Sample4", "Sample5", "Sample6",
"Sample7", "Sample8", "Sample9"), class = "factor"), Type = structure(c(2L,
1L, 2L, 2L, 2L, 1L, 2L, 2L, 1L, 1L), .Label = c("Normal", "Tumor"
), class = "factor"), A1BG = c(0, 0.01869105, 0.026705782, 0.016576987,
0, 0.007636787, 0.015756547, 0.00609601, 0.115575528, 0.04717536
), A1BG.AS1 = c(0, 0.096652515, 0.086710002, 0.04683499, 0.188283185,
0.104318353, 0.102735593, 0.100064808, 0.04717536, 0.159745808
), A1CF = c(1.616942802, 1.367084444, 1.101855892, 1.3823884,
0.631627098, 2.407159505, 1.687449785, 1.229844138, 0.87989414,
0.642785868), A2M = c(3.357654845, 3.149165846, 3.654774122,
2.851143092, 2.952601867, 4.002335454, 4.123949457, 3.691343955,
3.553064673, 3.425443559), A2M.AS1 = c(0.217308191, 0.08268571,
0.297320544, 0.101579093, 0.020102613, 0.35578965, 0.288014115,
0.145352771, 0.043808388, 0.104677012), A2ML1 = c(0, 0.017949113,
0.00984907, 0.002289616, 0, 0.002100359, 0.032146138, 0.052275569,
0.537892142, 0), A2ML1.AS1 = c(0.631627098, 0.04717536, 1.229844138,
0, 4.002335454, 0, 1.229844138, 1.229844138, 0.04717536, 0)), row.names = c(NA,
-10L), class = "data.frame")
With the above information, I am trying to make a shiny app. My code looks like below:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("thegene", "Gene", choices = c("A2M", "A1CF", "A2MP1"), selected = "A2M"),
radioButtons("colour","Colour of histogram",choices=c("red","green","blue"),selected="red"),
width = 3
),
mainPanel(
plotOutput("boxplot"),
width = 9
)
)
)
server <- function(input, output) {
df <- read.csv("df.csv")
library(reshape2)
library(ggplot2)
library(ggpubr)
library(EnvStats)
df.m <- melt(df, c("Samples", "Type"))
output$boxplot <- renderPlot({
ggplot(data=df.m, aes(x = Type, y = value, fill=variable)) +
geom_boxplot() +
theme_bw(base_size = 14) + xlab("") + ylab("Expression logFPKM") +
theme(axis.text=element_text(size=15, face = "bold", color = "black"),
axis.title=element_text(size=15, face = "bold", color = "black"),
strip.text = element_text(size=15, face = "bold", color = "black")) +
stat_compare_means(method = "t.test", size=5) + stat_n_text()
})
}
# Run the application
shinyApp(ui = ui, server = server)
So, I reshaped the information and then tried making an app to create a boxplot for each gene between Tumor (6 samples) and Normal (4 samples).
I don't see any error, but I also don't get the desired result. The output of my above code looks like below:
1) The number of samples in the boxplot below each Type is wrong.
2) For the Selection of genes, I could see only three genes there. I don't see other genes there. How to check for other genes?
3) The color of the histogram is also not working.
Any help is appreciated. Thank you.

Try this.
I made a few changes, you might keep some and reverse others.
I do not have ggpubr or EnvStats, so I removed some of the plotting summaries.
I have static data defined, you should likely return to your read.csv solution.
I added session to the server declaration, required if you want to update any inputs programmatically.
I have an inefficient reactive block that just returns all of the original data; as it stands now, this is anti-idiomatic, but was added solely to demonstrate the proper use of updateSelectInput if/when the source data changes. This is necessary only if your data changes dynamically (e.g., user-uploads data or a database query), otherwise alldat() should really just be df.m (and your input should be defined statically).
I updated the use of the color radio button.
library(shiny)
library(reshape2)
library(ggplot2)
library(ggpubr)
library(EnvStats)
df <- structure(list(Samples = structure(1:10, .Label = c("Sample1",
"Sample10", "Sample2", "Sample3", "Sample4", "Sample5", "Sample6",
"Sample7", "Sample8", "Sample9"), class = "factor"), Type = structure(c(2L,
1L, 2L, 2L, 2L, 1L, 2L, 2L, 1L, 1L), .Label = c("Normal", "Tumor"
), class = "factor"), A1BG = c(0, 0.01869105, 0.026705782, 0.016576987,
0, 0.007636787, 0.015756547, 0.00609601, 0.115575528, 0.04717536
), A1BG.AS1 = c(0, 0.096652515, 0.086710002, 0.04683499, 0.188283185,
0.104318353, 0.102735593, 0.100064808, 0.04717536, 0.159745808
), A1CF = c(1.616942802, 1.367084444, 1.101855892, 1.3823884,
0.631627098, 2.407159505, 1.687449785, 1.229844138, 0.87989414,
0.642785868), A2M = c(3.357654845, 3.149165846, 3.654774122,
2.851143092, 2.952601867, 4.002335454, 4.123949457, 3.691343955,
3.553064673, 3.425443559), A2M.AS1 = c(0.217308191, 0.08268571,
0.297320544, 0.101579093, 0.020102613, 0.35578965, 0.288014115,
0.145352771, 0.043808388, 0.104677012), A2ML1 = c(0, 0.017949113,
0.00984907, 0.002289616, 0, 0.002100359, 0.032146138, 0.052275569,
0.537892142, 0), A2ML1.AS1 = c(0.631627098, 0.04717536, 1.229844138,
0, 4.002335454, 0, 1.229844138, 1.229844138, 0.04717536, 0)), row.names = c(NA,
-10L), class = "data.frame")
df.m <- reshape2::melt(df, c("Samples", "Type"))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("thegene", "Gene", choices = c("A2M", "A1CF", "A2MP1"), selected = "A2M"),
radioButtons("colour","Colour of histogram",choices=c("red","green","blue"),selected="red"),
width = 3
),
mainPanel(
plotOutput("boxplot"),
width = 9
)
)
)
server <- function(input, output, session) {
alldat <- reactive({
# this is not an efficient use of a reactive block: since it does
# not depend on any dynamic data, it will fire only once, so if
# your data is static then this might be a touch overkill ... but
# the premise is that your `df.m` is data that can change based on
# updating it (e.g., DB query) or user-uploaded data (e.g., CSV
# upload)
choices <- unique(df.m$variable)
selected <- isolate(input$thegene)
if (!selected %in% choices) selected <- choices[1]
updateSelectInput(session, "thegene", choices = choices, selected = selected)
df.m
})
dat <- reactive({
x <- alldat()
x[ x$variable == input$thegene,,drop=FALSE]
})
output$boxplot <- renderPlot({
ggplot(data = dat(), aes(x = Type, y = value, fill = variable)) +
geom_boxplot() +
theme_bw(base_size = 14) + xlab("") + ylab("Expression logFPKM") +
theme(axis.text=element_text(size=15, face = "bold", color = "black"),
axis.title=element_text(size=15, face = "bold", color = "black"),
strip.text = element_text(size=15, face = "bold", color = "black")) +
scale_fill_manual(values = input$colour)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Some notes/opinions:
When there is dynamic data due to filtering or user-supplied modifiers, I find it nice to have a reactive block that does just the filtering/modifying, so that the modified data can be used in multiple dependent reactive blocks, ergo my dat <- reactive(...)
More the point, I find many not-so-good shiny apps that try to do way too much in a single reactive block; when I see a lot going on, I tend to think either (a) split the reactive block into smaller ones, especially when code is repeated in multiple blocks; and/or (b) write external functions that do most of that work, so that the shiny app itself appears more compact. Declarative function names can make readability/maintainability much easier (and can be unit-tested!).
I have not added any safeguards to this; one such safeguard (though this app does not show it right away) would be the use of req() to ensure that the inputs have "stabilized" during startup. With larger apps, one might notice that a few reactive blocks fire before (say) input$thegene has a valid value, which can cause some plots/tables to flicker.
When there is a select input that will quickly be over-written/updated, I generally go with something like choices="(initializing)" or something similar; in this case, having reasonable default choices makes sense as long as those choices are very likely or certain to be present in the real data.

Related

R shiny plot colour conditionally based on values on separate data frame

I'm fairly new to r and shiny, so bear with me - I have created a plot which shows the accumulated weekly distance covered by players in a sports team, where the user can select the player and the week range. Each player has an individual target distance they should meet and I want the data points in the plot to be green if they have met the target and red if they have not.
The data for weekly distance and target distance are located in different data frames (and they need to be) so I need that when a player is selected in selectInput(), the weekly distance is pulled from the first data frame and the target for the same player is pulled from the second data frame and used for conditional formatting.
EDIT - This is the gps2 data frame (though the PlayerName column lists the actual name which I've changed to initials here):
structure(list(Week = c(14, 14, 14, 14, 14, 15), PlayerName = c("CF",
"DR", "GB", "KB", "RA",
"AM"), Distance = c(3.8088, 2.1279, 2.4239, 1.3565,
4.5082, 4.4097), SprintDistance = c(291.473, 146.97, 11.071,
67.596, 252.787, 0), TopSpeed = c(22.6402, 21.3442, 20.5762,
21.6002, 20.5602, 18.6401)), row.names = c(NA, -6L), groups = structure(list(
Week = c(14, 15), .rows = structure(list(1:5, 6L), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), row.names = 1:2, class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"))
And the targets data frame:
structure(list(PlayerName = c("AM", "AB", "AMc",
"BC", "CD", "CM"), Distance = c(28.2753333333333,
34.867, NA, 31.633, 34.6122, 32.1405), SprintDistance = c(1355.2,
1074.85, NA, 2426.55, 2430.54, 2447.9), TopSpeed = c(32.61, 30.3,
NA, 36.82, 42, 33.44)), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
I have been working on this for a few days now and can't wrap my head around how to do it or find a post which describes what I want to do. So far this is what I have:
# DEFINE UI ####
ui <- fluidPage(
titlePanel("GPS Monitoring Dashboard"),
sidebarLayout(
sidebarPanel(
#select player
selectInput(inputId = "name",
label = strong("Choose player"),
choices = unique(gps2$PlayerName),
selected = "AB"),
#select weeks
numericRangeInput(inputId = "week",
label = strong("Choose weeks"),
value = c(36, 37))),
# graphs and tables
mainPanel(
plotOutput(outputId = "TD"),
tableOutput(outputId = "TDsum"))
)
)
# DEFINE SERVER ####
server <- function(input, output) {
# Total Distance ----
# Data for distance plot
TD_plot <- reactive({
gps2 %>%
filter(PlayerName == input$name,
Week >= input$week [1] &
Week <= input$week [2],
) %>%
select(Distance)
})
# Build distance plot
output$TD <- renderPlot({
ggplot(TD_plot()) +
geom_point(aes(Week, Distance,
color = Distance > 5),
stat = "identity", size = 3) +
scale_color_manual(name = "Target met", values = set_names(c("green", "red"), c(TRUE, FALSE))) +
geom_line(aes(Week, Distance), size = 1) +
labs(title = "Weekly Total Distance", x = "Week", y = "Distance (km)")
})
# Data for distance table
TD_sum <- reactive({
gps2 %>%
filter(PlayerName == input$name,
Week >= input$week [1] &
Week <= input$week [2])%>%
select(Distance) %>%
pivot_wider(.,
names_from = Week,
values_from = Distance)
})
# Build distance table
output$TDsum <- renderTable(TD_sum())
}
shinyApp(ui = ui, server = server)
Right now the data points changes based on an arbitrary value (5) as I was trying to expand on that. I hope this explains in enough detail what I'm trying to do, thanks in advance for your help!
Here's a working example that may be helpful.
First, would left_join your actual distances by players, and their target distances. This will rename columns with "Actual" or "Target" as suffixes to keep them apart.
In geom_point you can use color = DistanceActual > DistanceTarget to have differential color based on whether a distance is greater or less than the target.
I simplified the other functions for demonstration.
library(shiny)
library(tidyverse)
full_data <- left_join(gps2, df_targets, by = "PlayerName", suffix = c("Actual", "Target"))
# DEFINE UI ####
ui <- fluidPage(
titlePanel("GPS Monitoring Dashboard"),
sidebarLayout(
sidebarPanel(
#select player
selectInput(inputId = "name",
label = strong("Choose player"),
choices = unique(full_data$PlayerName),
selected = "player1"),
#select weeks
numericRangeInput(inputId = "week",
label = strong("Choose weeks"),
value = c(36, 37))),
# graphs and tables
mainPanel(
plotOutput(outputId = "TD"),
tableOutput(outputId = "TDsum"))
)
)
# DEFINE SERVER ####
server <- function(input, output) {
# Filter by week and player name
TD_data <- reactive({
full_data %>%
filter(PlayerName == input$name,
Week >= input$week [1],
Week <= input$week [2])
})
# Build distance plot
output$TD <- renderPlot({
ggplot(TD_data()) +
geom_point(aes(Week, DistanceActual, color = DistanceActual > DistanceTarget), stat = "identity", size = 3) +
scale_color_manual(name = "Target met", values = set_names(c("green", "red"), c(TRUE, FALSE))) +
geom_line(aes(Week, DistanceActual), size = 1) +
labs(title = "Weekly Total Distance", x = "Week", y = "Distance (km)")
})
# Build distance table
output$TDsum <- renderTable(
TD_data() %>%
select(Week, DistanceActual)
)
}
shinyApp(ui = ui, server = server)

R and Shiny: object not found

EDITED to include full UI and sample data
I did read the other StackOverflow qs on this issue, but none seemed to address the cause of my error.
When the app loads, I get "error object [name of district I've selected] not found" for the District (inputID = "d"). I know it must be an issue with the subsetting reactive in the server, but I've tried everything (loading the data in the server, removing the vector from the filter function, changing the data type of the variables).
I also took this code from another Shiny App I built, which works. I can't see any differences between the two, besides that one is geom_point() and this is geom_col() so again, not sure what is going on.
Thanks!
Sample data:
sample <- sample_n(pop, 10)
dput(sample)
structure(list(GazID = c(NA, NA, "13872", NA, "13610", "13985",
"13984", "13434", "13428", "13631"), Province = c("Niolandskaia",
"Kaluzhskaia", "Iaroslavskaia", "Vyborgskaia", "Moskovskaia",
"Volynskaia", "Volynskaia", "Orenburgskaia", "Orenburgskaia",
"Arkhangel'skaia"), District = c(NA, "Suhinichinbezuezdniigorod",
"Romanov", NA, "Zvenigorod", "Kovel", "Lutsk", "Ufa", "Orenburg",
"Mezen"), TotalPop = c(NA, NA, 104104, NA, 71746, 103381, 102779,
93145, 62740, 26796), Male = c(NA, NA, 48604, NA, 36948, 52266,
50393, 46403, 32617, 13078), Female = c(NA, NA, 55500, NA, 34798,
51115, 52386, 46742, 30123, 13718), City = c(NA, 5552, NA, NA,
1253, 4254, 5552, 6682, 9533, NA), Rural = c(NA, NA, NA, NA,
70493, 99127, 97228, 86483, 53207, NA)), row.names = c(NA, -10L
), class = c("tbl_df", "tbl", "data.frame"))
Above the UI:
library(tidyverse)
library(readr)
library(shiny)
library(stringr)
library(rebus)
pop <- read_csv("pop.csv")
pop$TotalPop <- str_replace_all(pop$TotalPop, pattern = fixed(","), replacement = "")
pop$Male <- str_replace_all(pop$Male, pattern = fixed(","), replacement = "")
pop$Female <- str_replace_all(pop$Female, pattern = fixed(","), replacement = "")
pop$City <- str_replace_all(pop$City, pattern = fixed(","), replacement = "")
pop$Rural <- str_replace_all(pop$Rural, pattern = fixed(","), replacement = "")
pop$District <- str_remove_all(pop$District, pattern = "[^[:alnum:]]")
pop$TotalPop <- as.numeric(pop$TotalPop)
pop$Male <- as.numeric(pop$Male)
pop$Female <- as.numeric(pop$Female)
pop$City <- as.numeric(pop$City)
pop$Rural <- as.numeric(pop$Rural)
pop$GazID <- as.character(pop$GazID)
pop$District <- str_trim(pop$District)
The UI:
ui <- fluidPage(
titlePanel("Population Data from VSO"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "y", #internal label
label = "Population to map", #label that user sees
choices = c("Total population" = "TotalPop",
"Male population" = "Male",
"Female population" = "Female",
"Urban population" = "City",
"Rural population" = "Rural"),
selected = "TotalPop"),
selectizeInput(inputId = "d",
label = "Select district",
choices = c(pop$District),
multiple = TRUE, # can choose multiple
options = list(maxItems = 5))),
mainPanel(
plotOutput("plot")
)
)
)
The server:
server <- function(input, output) {
pop_subset <- reactive({
req(input$d)
filter(pop, District %in% c(input$d)
)})
output$plot <- renderPlot({
ggplot(data = pop_subset(), aes_string(x = pop_subset()$District, y = input$y)) +
geom_col(aes(fill = pop_subset()$District)) +
labs(x = "District", y = "Population") +
scale_fill_discrete(name = "Districts")
})}
shinyApp(ui = ui, server = server)
The problem is that you are using aes_string in your ggplot, but trying to pass District without quotes. I realize you need aes_string because you are using input$y, so just change your plot call to
output$plot <- renderPlot({
req(pop_subset())
ggplot(data = pop_subset(), aes_string(x = "District", y = input$y)) +
geom_col(aes(fill = District)) +
labs(x = "District", y = "Population") +
scale_fill_discrete(name = "Districts")
})
For reproducibility, packages and some sample data (no idea of its true representative nature, doesn't really matter I think).
library(dplyr)
library(shiny)
library(ggplot2)
set.seed(42)
n <- 50
pop <- data_frame(
TotalPop = sample(1e4, size=n, replace=TRUE)
) %>%
mutate(
Male = pmax(0, TotalPop - sample(1e4, size=n, replace=TRUE)),
Female = TotalPop - Male,
City = sample(LETTERS, size=n, replace=TRUE),
District = sample(letters, size=n, replace=TRUE)
)

Reorder reactive ggplot

I'm trying to reorder the x axis by the values in the y axis. The x axis is a name, the y axis is an integer. Both are reactive, user defined inputs. I have created a datatable that renders in the correct order, but ggplot does not take that order. Instead it does an alphabetical order.
My current code is:
Packages
library(shiny)
library(readxl) # to load the data into R
library(tidyverse)
library(stringr)
library(DT)
library(tools)
library(magrittr)
Data
lpop <-read.csv("londonpopchange.csv", header=TRUE)
UI
# Define UI for application that plots features of movies
ui <- fluidPage(
# Sidebar layout with a input and output definitions
sidebarLayout(
# Inputs
sidebarPanel(
# Select variable for y-axis
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("Mid Year 2016" = "MYE2016",
"Births" = "Births",
"Deaths" = "Deaths",
"Births minus Deaths" = "BirthsminusDeaths",
"Internal Migration Inflow" = "InternalMigrationInflow",
"Internal Migration Outflow" = "InternalMigrationOutflow",
"Internal Migration Net" = "InternalMigrationNet",
"International Migration Inflow" = "InternationalMigrationInflow",
"International Migration Outflow" = "InternationalMigrationOutflow",
"International Migration Net" = "InternationalMigrationNet"),
selected = "MYE2016"),
# Select variable for x-axis
selectInput(inputId = "x",
label = "X-axis:",
choices = c("Borough" = "Name"),
selected = "Name")
),
# Output
mainPanel(
h1(textOutput("MainTitle")),
br(),
plotOutput(outputId = "geom_bar"),
DT::dataTableOutput("mytable")
)
)
)
Server
# Define server function required to create the scatterplot
server <- function(input, output) {
#this creates the title
output$MainTitle <- renderText({
paste(input$y, "for London Boroughs")
})
#creates a data table that reacts to the user variable input and arranges
#by the y variable
df <- reactive({
lpop %>%
select(input$x, input$y, "WF") %>%
arrange_(.dots = input$y) #%>%
# setNames(1:2, c("x", "y"))
})
#outputs the user defined data frame
output$mytable = ({DT::renderDataTable({df()})})
# Create the bar plot object the plotOutput function is expecting
output$geom_bar <- renderPlot({
ggplot(data = df(), aes_string(x = input$x, y = input$y, fill = "WF")) +
geom_bar(stat = "identity") +
scale_fill_manual(values=c("#000000", "#00D253")) +
theme(axis.text.x = element_text(angle = 90)) +
xlab(input$x)
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
It renders as so: https://jwest.shinyapps.io/ShinyPopulation/
If I use the reorder function in ggplot, it amalgamates all "Names" into one bar, see below.
# Create the bar plot object the plotOutput function is expecting
output$geom_bar <- renderPlot({
ggplot(data = df(), aes_string(x = reorder(input$x, input$y), y = input$y, fill = "WF")) +
geom_bar(stat = "identity") +
scale_fill_manual(values=c("#000000", "#00D253")) +
theme(axis.text.x = element_text(angle = 90)) +
xlab(input$x)
})
}
How can I render it by the Y axis? Is it something to do with scale_x_discrete(limits = ...). If it is I am confused as to how i'm meant to reference the first column of the reactive df
The csv can be downloaded here: https://drive.google.com/file/d/1QLT8CX9XFSx3WU_tADyWgyddHYd3-VSp/view?usp=sharing
DPUT
structure(list(Code = structure(c(7L, 1L, 12L, 13L, 14L), .Label = c("E09000001",
"E09000002", "E09000003", "E09000004", "E09000005", "E09000006",
"E09000007", "E09000008", "E09000009", "E09000010", "E09000011",
"E09000012", "E09000013", "E09000014", "E09000015", "E09000016",
"E09000017", "E09000018", "E09000019", "E09000020", "E09000021",
"E09000022", "E09000023", "E09000024", "E09000025", "E09000026",
"E09000027", "E09000028", "E09000029", "E09000030", "E09000031",
"E09000032", "E09000033"), class = "factor"), Name = structure(c(6L,
7L, 12L, 13L, 14L), .Label = c("Barking and Dagenham", "Barnet",
"Bexley", "Brent", "Bromley", "Camden", "City of London", "Croydon",
"Ealing", "Enfield", "Greenwich", "Hackney", "Hammersmith and Fulham",
"Haringey", "Harrow", "Havering", "Hillingdon", "Hounslow", "Islington",
"Kensington and Chelsea", "Kingston upon Thames", "Lambeth",
"Lewisham", "Merton", "Newham", "Redbridge", "Richmond upon Thames",
"Southwark", "Sutton", "Tower Hamlets", "Waltham Forest", "Wandsworth",
"Westminster"), class = "factor"), Geography = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "London Borough", class = "factor"),
MYE2016 = c(249162L, 7246L, 273239L, 181783L, 272078L), Births = c(2671L,
68L, 4405L, 2446L, 3913L), Deaths = c(1180L, 38L, 1168L,
895L, 1140L), BirthsminusDeaths = c(1491L, 30L, 3237L, 1551L,
2773L), InternalMigrationInflow = c(22189L, 856L, 21271L,
19109L, 22469L), InternalMigrationOutflow = c(25132L, 792L,
23324L, 20488L, 29113L), InternalMigrationNet = c(-2943L,
64L, -2053L, -1379L, -6644L), InternationalMigrationInflow = c(11815L,
756L, 5054L, 5333L, 7480L), InternationalMigrationOutflow = c(6140L,
441L, 3534L, 4336L, 4460L), InternationalMigrationNet = c(5675L,
315L, 1520L, 997L, 3020L), Other = c(-24L, -1L, -14L, 46L,
-3L), Estimated.Population..mid.2017 = c(253361L, 7654L,
275929L, 182998L, 271224L), WF = structure(c(1L, 1L, 1L,
1L, 1L), .Label = c("London Borough", "Waltham Forest"), class = "factor")), .Names = c("Code",
"Name", "Geography", "MYE2016", "Births", "Deaths", "BirthsminusDeaths",
"InternalMigrationInflow", "InternalMigrationOutflow", "InternalMigrationNet",
"InternationalMigrationInflow", "InternationalMigrationOutflow",
"InternationalMigrationNet", "Other", "Estimated.Population..mid.2017",
"WF"), row.names = c(NA, 5L), class = "data.frame")

Shiny app loading locally, disconnects from server when deployed

My app runs fine locally. I can interact with it, etc. But when deployed globally it immediately throws the "Disconnected from Server" error. I've been googling for days and have tried everything I know how to try.
First things first:
I tried uninstalling then reinstalling a bunch of packages
I updated all the packages I am using
There is no information at all in the shiny logs. "This application currently has no logs."
My data (csv) is only 17MB (3 columns, 1M-ish rows)
when I reduced it to only about 200 rows I continued having the same issue
I went through the settings, changed the startup timeout to 300 and systematically changed each of the other settings, one by one.
I've read the browser's JavaScript logs end to end. They didn't make a ton of sense (probably because I don't know JavaScript), but nothing obvious stood out.
I am not loading my data with the entire file path, just the end part
My "Deploy" log in RStudio indicates successful deployment:
Preparing to deploy application...DONE
Uploading bundle for application: 193997...DONE
Deploying bundle: 994423 for application: 193997 ...
Waiting for task: 489405538
building: Building image: 992534
building: Fetching packages
building: Installing packages
building: Installing files
building: Pushing image: 992534
deploying: Starting instances
rollforward: Activating new instances
terminating: Stopping old instances
Application successfully deployed to https://jesstme.shinyapps.io/shinynames/
Deployment completed: https://jesstme.shinyapps.io/shinynames/
Link to the app itself:
https://jesstme.shinyapps.io/shinynames/
Server code:
#set wd & environment----
setwd("/Users/OldJess/Dropbox/R Stuff (Home)/ShinyNames")
#load packages------
library(datasets)
library(ggplot2)
library(viridis)
library(ggthemes)
library(gridExtra)
library(dplyr)
library(rdrop2)
library(shiny)
library(devtools)
#base <- read.csv("data/NationalNamesBrief.csv", stringsAsFactors = FALSE, row.names = NULL, na.strings = c("NA","","#MULTIVALUE"))
#temporary df for demonstration purposes
base <- structure(list(Name = c("Ellie", "Ellie", "Ellie", "Ellie", "Ellie",
"Ellie"),
Year = c(1880L, 1881L, 1882L, 1883L, 1883L, 1884L),
Gender = c("F", "F", "F", "F", "M", "F"),
Count = c(17L, 27L, 37L, 24L, 7L, 28L)),
.Names = c("Name", "Year", "Gender", "Count"),
row.names = c(NA, 6L), class = "data.frame")
#clean data----
base$name <- tolower(base$Name)
base$MF <- as.factor(base$Gender)
#add ranking data by Year
base <- base %>%
group_by(Year) %>%
arrange(Year, desc(Count)) %>%
mutate(Rank = row_number())
#add ranking data by Year AND Gender
base <- base %>%
group_by(Year, Gender) %>%
arrange(Year, desc(Count)) %>%
mutate(GenderRank = row_number())
#create functions----
#function to create line & heat charts
lineHeatCharts <- function(pickaname){
pickanameLower <- tolower(pickaname)
subDf <- subset(base[base$name == pickanameLower,])
heat <- ggplot(subDf, aes(x = Year, y = MF, fill = Count)) +
scale_fill_viridis(name = "",
option = "B",
limits = c(0, max(subDf$Count))) +
geom_tile(color = "white", size = 0) +
theme_tufte() +
theme(axis.text.x = element_text(angle = 90, vjust = 1, hjust = 1),
axis.ticks.x = element_blank()) +
scale_x_continuous(breaks = seq(min(subDf$Year),
max(subDf$Year), by = 5)) +
labs(x = "Year", y = "")
line <- ggplot(subDf, aes(x = Year, y = Count, fill = MF)) +
geom_line(aes(colour = factor(subDf$Gender)), size = 1.5) +
theme_tufte() +
theme(axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
scale_x_continuous(breaks = seq(min(subDf$Year),
max(subDf$Year), by = 5)) +
labs(x = "", y = "", color = "")
return(grid.arrange(line, heat,
ncol = 1, nrow = 2,
heights = c(5, 2), top = max(subDf$Name)))
}
# Define server logic
function(input, output) {
output$view <- renderPlot({
lineHeatCharts(input$list)
})
}
UI code:
library(shiny)
library(shinythemes)
# Define UI for dataset viewer application
fluidPage(theme = shinytheme("flatly"),
# Application title
titlePanel("First Names on U.S. Social Security Applications, 1880 - 2014"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "list", label = "Enter a name:", value = "Ellie"),
helpText("Note: This page will take about 30 seconds to load the first time you open it. Data are from US Social Security applications via data.gov. For privacy, only names with at least 5 babies per year are included. Errors in Social Security form submission, like incorrect sex, are not corrected. Names with special characters and spaces are not included."),
submitButton("Refresh View")
),
mainPanel(
h4(""),
plotOutput("view")
)
)
)
Try this:
#set wd & environment----
#setwd("/Users/OldJess/Dropbox/R Stuff (Home)/ShinyNames")
#load packages------
library(datasets)
library(ggplot2)
library(viridis)
library(ggthemes)
library(gridExtra)
library(dplyr)
library(shiny)
library(shinythemes)
#base <- read.csv("data/NationalNamesBrief.csv", stringsAsFactors = FALSE, row.names = NULL, na.strings = c("NA","","#MULTIVALUE"))
#temporary df for demonstration purposes
base <- structure(list(Name = c("Ellie", "Ellie", "Ellie", "Ellie", "Ellie", "Ellie"),
Year = c(1880L, 1881L, 1882L, 1883L, 1883L, 1884L),
Gender = c("F", "F", "F", "F", "M", "F"),
Count = c(17L, 27L, 37L, 24L, 7L, 28L)),
.Names = c("Name", "Year", "Gender", "Count"),
row.names = c(NA, 6L), class = "data.frame")
#clean data----
base$name <- tolower(base$Name)
base$MF <- as.factor(base$Gender)
#add ranking data by Year
base <- base %>%
group_by(Year) %>%
arrange(Year, desc(Count)) %>%
mutate(Rank = row_number())
#add ranking data by Year AND Gender
base <- base %>%
group_by(Year, Gender) %>%
arrange(Year, desc(Count)) %>%
mutate(GenderRank = row_number())
#create functions----
#function to create line & heat charts
lineHeatCharts <- function(pickaname){
pickanameLower <- tolower(pickaname)
if(!any(base$name %in% pickanameLower)){
return()
}
subDf <- subset(base[base$name == pickanameLower,])
heat <- ggplot(subDf, aes(x = Year, y = MF, fill = Count)) +
scale_fill_viridis(name = "",
option = "B",
limits = c(0, max(subDf$Count))) +
geom_tile(color = "white", size = 0) +
theme_tufte() +
theme(axis.text.x = element_text(angle = 90, vjust = 1, hjust = 1),
axis.ticks.x = element_blank()) +
scale_x_continuous(breaks = seq(min(subDf$Year), max(subDf$Year), by = 5)) +
labs(x = "Year", y = "")
line <- ggplot(subDf, aes(x = Year, y = Count, fill = MF)) +
geom_line(aes(colour = factor(subDf$Gender)), size = 1.5) +
theme_tufte() +
theme(axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
scale_x_continuous(breaks = seq(min(subDf$Year),
max(subDf$Year), by = 5)) +
labs(x = "", y = "", color = "")
return(grid.arrange(line, heat, ncol = 1, nrow = 2, heights = c(5, 2), top = max(subDf$Name)))
}
ui <- fluidPage(theme = shinytheme("flatly"),
# Application title
titlePanel("First Names on U.S. Social Security Applications, 1880 - 2014"),
sidebarLayout(
sidebarPanel(
textInput(inputId = "list", label = "Enter a name:", value = "Ellie"),
helpText("Note: This page will take about 30 seconds to load the first time you open it. Data are from US Social Security applications via data.gov. For privacy, only names with at least 5 babies per year are included. Errors in Social Security form submission, like incorrect sex, are not corrected. Names with special characters and spaces are not included."),
submitButton("Refresh View")
),
mainPanel(
h4(""),
plotOutput("view")
)
)
)
server <- function(input, output, session) {
output$view <- renderPlot({
lineHeatCharts(input$list)
})
}
shinyApp(ui, server)
As it turns out there were two problems:
1) I needed to remove the setwd() 2nd line of my code
2) Shiny logs weren't working.
I posted on Google's Shiny forum, and a RStudio person fixed the issue with the logs. Once the logs were working I saw that the error pointed to my attempts to setwd. Deleted that and the problem was fixed. Keeping this question up because I'm sure this issue will plague someone else at some point.

Getting an error when trying to create a Shiny app

I have two map plots of 'Total Population' and 'Population Density' created using a shape file. Now, I'm trying to build a shiny app so that I can change from Total Population to Population Density and the plot should change accordingly. When I ran the code, i got following error code:
Warning: Error in : ggplot2 doesn't know how to deal with data of class matrix
Here's the code that i've been trying to use:
library(shiny)
library(ggplot2) #Loading necessary libraries
ui <- fluidPage(
selectInput("mr",
label="Type of Plot",
choices=c("Total Population", "Density"),
selected="Total Population"),
plotOutput("curv") #Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
output$curv <- renderPlot({
ggplot() +
geom_polygon(data = final.plot==input$mr,
aes(x = long, y = lat, group = group, fill = Population),
color = "black", size = 0.20) +
coord_map()+
scale_fill_distiller(name="Population", palette = "YlGn")+
labs(title="Population in Australia")
}) # Output with the data file and input string to change when input changes.
}
shinyApp(ui = ui, server = server)
Any help is greatly appreciated.
UPDATE:
My dataset looks like this:
id long lat order hole piece
1 Ashmore and Cartier Islands 123.1169 -12.25333 1 FALSE 1
2 Ashmore and Cartier Islands 123.1206 -12.25611 2 FALSE 1
3 Ashmore and Cartier Islands 123.1222 -12.25861 3 FALSE 1
4 Ashmore and Cartier Islands 123.1239 -12.25528 4 FALSE 1
5 Ashmore and Cartier Islands 123.1258 -12.25333 5 FALSE 1
6 Ashmore and Cartier Islands 123.1275 -12.25619 6 FALSE 1
group Population Density
1 Ashmore and Cartier Islands.1 NA NA
2 Ashmore and Cartier Islands.1 NA NA
3 Ashmore and Cartier Islands.1 NA NA
4 Ashmore and Cartier Islands.1 NA NA
5 Ashmore and Cartier Islands.1 NA NA
6 Ashmore and Cartier Islands.1 NA NA
This is stored in the DataFrame called "final.plot". There's values of Population and Density for other states. I was able to create a static visualisation of Population and it looks like this:
There's a similar one for Density and I'm trying to create Shiny app where i can switch between these two so that the plot changes accordingly. Right now I've tried the following code:
library(shiny)
library(ggplot2) #Loading necessary libraries
ui <- fluidPage(
selectInput("pop",
label="Type of Plot",
choices=c("Population", "Density"),
selected="Total Population"),
plotOutput("curv") #Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
output$curv <- renderPlot({
ggplot() +
geom_polygon(data = final.plot,
aes(x = long, y = lat, group = group, fill = input$pop),
color = "black", size = 0.25) +
coord_map()+
scale_fill_distiller(name="Density", palette = "Spectral")+
labs(title="Population in Australia")
})
}
shinyApp(ui = ui, server = server)
But I'm getting an error saying "Discrete value supplied to continuous scale".
UPDATE 2:
Here's the link for the dataset i'm using:
Dataset
I've had a quick look at your code and have a couple of suggestions.
1) When providing your data set you can use the function dput() - this writes a text representation of your data.frame which people answering your question can simply paste into R. For example:
dput(final.plot)
This will produce text output that I can assign to a dataframe by prefixing final.plot <- to the output. I have recreated your dataframe and used dput() to output it as text below. Now other users can quickly cut & paste your data:
Note this dataset is faulty - see below
final.plot <- structure(list(id = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = "Ashmore and Cartier Islands", class = "factor"),
long = c(123.1169, 123.1206, 123.1222, 123.1239, 123.1258, 123.1275),
lat = c(-12.25333, -12.25611, -12.25861, -12.25528, -12.25333, -12.25619),
order = 1:6, hole = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE),
piece = c(1L, 1L, 1L, 1L, 1L, 1L),
group = structure(c(1L, 1L, 1L, 1L, 1L, 1L),
.Label = "Ashmore and Cartier Islands.1", class = "factor"),
Population = c(NA, NA, NA, NA, NA, NA),
Density = c(NA, NA, NA, NA, NA, NA)),
.Names = c("id", "long", "lat", "order", "hole", "piece", "group", "Population", "Density"),
class = "data.frame",
row.names = c(NA, -6L))
The error "Discrete value supplied to continuous scale" is caused by two issues.
i) You are passing NA in both your Population and Density columns. The dataframe below adds some (unrealistic) numbers to these columns and the error is removed when I run the plotting code in isolation.
Corrected Toy Dataset
final.plot <- structure(list(id = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = "Ashmore and Cartier Islands", class = "factor"),
long = c(123.1169, 123.1206, 123.1222, 123.1239, 123.1258, 123.1275),
lat = c(-12.25333, -12.25611, -12.25861, -12.25528, -12.25333, -12.25619),
order = 1:6, hole = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE),
piece = c(1L, 1L, 1L, 1L, 1L, 1L),
group = structure(c(1L, 1L, 1L, 1L, 1L, 1L),
.Label = "Ashmore and Cartier Islands.1", class = "factor"),
Population = c(1, 2, 3, 4, 5, 6),
Density = c(7, 3, 9, 1, 3, 6)),
.Names = c("id", "long", "lat", "order", "hole", "piece", "group", "Population", "Density"),
class = "data.frame",
row.names = c(NA, -6L))
ii) When run interactively the error is caused because you are not passing appropriate data to fill in fill = input$pop. You should be passing the values from final.plot$Population or final.plot$Density depending on what was selected. You are instead passing the output of the dropdown box - "Population" or "Density". This can be corrected using a switch statement within renderPlot:
# User input assigns appropriate data to selectedData which can be passed to other functions:
selectedData <- switch(input$pop,
"Population" = final.plot$Population,
"Density" = final.plot$Density)
2) It would be helpful if you could provide the code which produced the static map you show in your Update above. When debugging Shiny code I find it easiest to get the function working non-interactively first and then to incorporate it into Shiny. I tried to extract your plotting code below but it is not producing the expected results:
library(ggplot2) #Loading necessary libraries
library(mapproj)
library(maps)
ggplot() +
geom_polygon(data = final.plot,
[![aes(x = long, y = lat, group = group, fill = Population),
color = "black", size = 0.25) +
coord_map()+
scale_fill_distiller(name="Density", palette = "Spectral")+
labs(title="Population in Australia")`
3) I am not familiar with plotting data onto maps in R but I believe your app will need to load in library(mapproj) and library(maps) to get the results you need. Here is all the above put together:
library(shiny)
library(ggplot2) #Loading necessary libraries
#I added the two lines below:
library(mapproj)
library(map)
ui <- fluidPage(
selectInput("pop",
label="Type of Plot",
choices=list("Population", "Density"),
selected="Population"), #NOTE: Total Population changed to Population so that it selects correct default value
plotOutput("curv") #Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
#You will probably want to simply import your dataframe final.plot using read.table etc:
final.plot <- structure(list(id = structure(c(1L, 1L, 1L, 1L, 1L, 1L), .Label = "Ashmore and Cartier Islands", class = "factor"),
long = c(123.1169, 123.1206, 123.1222, 123.1239, 123.1258, 123.1275),
lat = c(-12.25333, -12.25611, -12.25861, -12.25528, -12.25333, -12.25619),
order = 1:6, hole = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE),
piece = c(1L, 1L, 1L, 1L, 1L, 1L),
group = structure(c(1L, 1L, 1L, 1L, 1L, 1L),
.Label = "Ashmore and Cartier Islands.1", class = "factor"),
Population = c(1, 2, 3, 4, 5, 6),
Density = c(7, 3, 9, 1, 3, 6)),
.Names = c("id", "long", "lat", "order", "hole", "piece", "group", "Population", "Density"),
class = "data.frame",
row.names = c(NA, -6L))
output$curv <- renderPlot({
#Assign value of selectedData based upon user input:
selectedData <- switch(input$pop,
"Population" = final.plot$Population,
"Density" = final.plot$Density)
ggplot() +
geom_polygon(data = final.plot,
aes(x = long, y = lat, group = group, fill = selectedData),
color = "black", size = 0.25) +
coord_map()+
scale_fill_distiller(name="Density", palette = "Spectral")+
labs(title="Population in Australia")
})
}
shinyApp(ui = ui, server = server)
Now all you need to do is substitute your code which produced the static map shown in your update for the faulty code in renderPlot in your shiny app.

Resources