Reorder reactive ggplot - r

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")

Related

Bold/highlight single line in multiple line chart when hover over using ggplotly

I just started learning R and I am creating an interactive line chart using ggplot2 and plotly.
Is there a way to bold/highlight the corresponding line in a multiple line graph when the mouse hovers over?
The line chart that I have is plotted according to the inputs and multiple lines will be plotted in a single line chart if there are multiple inputs.
This is the code I have in R Shiny.
data_sales <- structure(list(town = c("ANG MO KIO", "ANG MO KIO", "ANG MO KIO",
"BEDOK", "BEDOK", "BEDOK"), Date = structure(c(17167, 17198,
17226, 17167, 17198, 17226), class = "Date"), median_sales = c(336500,
355000, 375000, 359000, 361500, 360000), percentage_change_sales = c(NA,
5.49777117384844, 5.6338028169014, NA, 0.696378830083555, -0.414937759336098
), transaction_vol = c(56L, 41L, 89L, 70L, 70L, 101L), percentage_change_vol = c(NA,
-26.7857142857143, 117.073170731707, NA, 0, 44.2857142857143)), row.names = c(1L,
2L, 3L, 32L, 33L, 34L), class = "data.frame")
ui <- fluidPage(
titlePanel("Change in Sales by Town"),
verticalLayout(
pickerInput(inputId = "town",
label = "Town",
choices = c("Ang Mo Kio" = "ANG MO KIO",
"Bedok" = "BEDOK"),
options = list('actions-box' = TRUE),multiple = T,
selected = "ANG MO KIO"),
mainPanel("Trend in sales",
fluidRow( plotlyOutput("sales_percentage_plot")
)
)
)
)
server <- function(input, output){
#For Resale Price
output$sales_percentage_plot <-renderPlotly({
data<-data_sales[data_sales$town %in% input$town, ]
p<-ggplot(data, (aes(Date,percentage_change_sales,colour = town))) +
geom_line() +
geom_point()
p<-ggplotly(p)
p
})
}
shinyApp (ui=ui, server=server)
Thanks in advance for the help given!
A little bit dirty but simple solution is:
library(shiny)
library(shinyWidgets)
library(plotly)
data_sales <-
structure(
list(
town = c("ANG MO KIO", "ANG MO KIO", "ANG MO KIO",
"BEDOK", "BEDOK", "BEDOK"),
Date = structure(c(17167, 17198,
17226, 17167, 17198, 17226), class = "Date"),
median_sales = c(336500,
355000, 375000, 359000, 361500, 360000),
percentage_change_sales = c(
NA,
5.49777117384844,
5.6338028169014,
NA,
0.696378830083555,
-0.414937759336098
),
transaction_vol = c(56L, 41L, 89L, 70L, 70L, 101L),
percentage_change_vol = c(
NA,
-26.7857142857143,
117.073170731707,
NA,
0,
44.2857142857143
)
),
row.names = c(1L,
2L, 3L, 32L, 33L, 34L),
class = "data.frame"
)
normal_size <- 0.5
bold_size <- 1.0
ui <- fluidPage(titlePanel("Change in Sales by Town"),
verticalLayout(
pickerInput(
inputId = "town",
label = "Town",
choices = c("Ang Mo Kio" = "ANG MO KIO",
"Bedok" = "BEDOK"),
options = list('actions-box' = TRUE),
multiple = T,
selected = "ANG MO KIO"
),
mainPanel("Trend in sales",
fluidRow(plotlyOutput(
"sales_percentage_plot"
)))
))
server <- function(input, output) {
#For Resale Price
output$sales_percentage_plot <- renderPlotly({
data <- data_sales[data_sales$town %in% input$town,]
# default size vector
sizes <- rep(normal_size, length(unique(data$town)))
# capture plotly event
eventdata <- event_data("plotly_hover")
p <-
ggplot(data, (
aes(
Date,
percentage_change_sales,
colour = town,
size = town
)
)) +
geom_line() +
geom_point()
if (!is.null(eventdata)) {
# search selected row in data
x <- data %>%
filter(Date == eventdata$x &
percentage_change_sales == eventdata$y)
# change size vector
sizes[which(unique(data$town) == x$town)] <- bold_size
}
# change line and point size manually
p <- p +
scale_size_manual(values = sizes)
# without tooltip settings, "town" appears twice...
p <- ggplotly(p, tooltip = c("x", "y", "colour"))
p
})
}
shinyApp (ui = ui, server = server)
I don't know why sometimes hover event occurs twice in a row.

Problem in creating boxplots with R shiny app

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.

How to display multiple rows in the table from plotly graphs using R Shiny and delete the last row from the table?

I'm trying to plot the graph using plotly where the person clicks on the geom_points and it should populate that geom_point row into the rendered table below.
I have been successful in doing that. So Person clicks on the geom_point on the graph, that geom_point data (row) gets displayed. Now I am trying to append multiple rows to the same table instead of overwriting the previous row the person selected. Basically, I want the person should click on the multiple geom_points and the table should show all the geom_points data instead of overwriting the previous one.
library(shiny)
library(plotly)
library(DT)
d1=structure(list(Topic = c("compensation", "manager", "benefits",
"family", "communication", "worklifebalance", "perks", "compensation",
"benefits", "manager", "communication", "worklifebalance", "family",
"perks", "benefits", "compensation", "manager", "communication",
"family", "worklifebalance", "perks"),
variable = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
.Label = c("Prct", "Count"), class = "factor"),
value = c(2.23121245555964, 0.723305136692411, 0.576192227534633,
0.202280250091946, 0.190020840995464, 0.153242613706019,
0.0122594090964816, 0.913705583756345, 0.609137055837563,
0.50761421319797, 0.50761421319797, 0.304568527918782, 0.203045685279188,
0, 1.49977276170277, 1.21193758521436, 0.893803969095592,
0.439327374640206, 0.348432055749129, 0.242387517042872,
0.0757460990758976),
group = c("APAC", "APAC", "APAC", "APAC", "APAC", "APAC", "APAC",
"EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA",
"AMERICAS", "AMERICAS", "AMERICAS", "AMERICAS", "AMERICAS",
"AMERICAS", "AMERICAS")),
.Names = c("Topic", "variable", "value", "group"), class = c("data.table", "data.frame"),
row.names = c(NA, -21L))
ui <- fluidPage(
fluidRow(plotlyOutput('keywords')),
fluidRow(verbatimTextOutput("selection")),
fluidRow(DT::dataTableOutput("table1"))
)
d0 = d1
key <- row.names(d0)
server = function(input,output){
output$keywords = renderPlotly({
d0 <- data.frame(d0, key)
p = ggplot(d0, aes(reorder(Topic,-value), value, key = key)) +
geom_point(aes(colour = value),
shape = 16,
size = 3,
show.legend = F) +
facet_wrap(~ group)+
theme_minimal()
ggplotly(p)
})
output$selection <- renderPrint({
s <- event_data("plotly_click")
cat("You selected: \n\n")
data.frame(s)
})
selection2 <- reactive({
s <- event_data("plotly_click")
cat("You selected: \n\n")
df <- data.frame(s)
})
output$table1 = renderDT({
d2 <- d1 %>% filter(key == selection2()$key)
d2
})
}
shinyApp(ui, server)
if you will run this code and click on points. you will notice that it overwrites the rows in the table. I expect that it should keep appending the rows when you keep clicking on points. I am new to using shiny but if there is a way to do use reactiveValues or observeEvent or anything else?
You have to update value of d2 so you can do it with reactiveVal(). Here's what I've changed in yours server function:
d2 <- reactiveVal(data.frame())
observeEvent(event_data("plotly_click"), {
d2Temp <- rbind(
d2(),
d1 %>% filter(key == selection2()$key)
)
d2(d2Temp)
})
output$table1 = renderDT({
d2()
})
Firstly you must initialise d2 reactive value with an empty data.frame. Then, observe "plotly_click" and bind new row to old data.frame. Lastly update value of yours reactiveVal with d2(d2Temp).

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.

Shiny input to Plotly does not produce a plot

I'm building an shiny application to show some quality control data to our clients. First i had the application created with GGplot functionalities. Now i am converting all graphs to Plotly output. For one of these plots (a boxplot). I have the problem that i cant pass a shiny input selector to the plot.
In GGplot there is no problem at all and the plot is changed each time i choose a different plotColumn. Here i solved the problem of column parsing with the aes_string function. Basically i am looking for something similar in plotly.
Working GGPLOT example:
ggplot(finalDf, aes_string("runName",input$getBoxplotField),na.rm = T) +
geom_boxplot(aes_string(fill="runName"), notch = F) +
geom_jitter() +
scale_y_continuous(labels = format1) +
theme_bw()
Not working Plot_ly example
p <- plot_ly(finalDf,x = runName, y = input$getBoxplotField, type = "box")
exampleDf
> dput(head(finalDf))
structure(list(runName = c("Gentrap.1451849446759", "Gentrap.1451849446759",
"Gentrap.1451849446759", "Gentrap.1451849446759", "Gentrap.1451849446759",
"Gentrap.1451849446759"), sampleName = c("Hart_FC42b_L5_I2_SRD329",
"S1", "S2", "S3","S4", "S5"), readGroupName = c(NA,
NA, NA, NA, NA, NA), maxInsertSize = c(227615351L, 202850798L,
249001722L, 234388122L, 188295691L, 249009605L), medianCvCoverage = c(0.501303,
0.494183, 0.574364, 0.487233, 0.495491, 0.483041), medianInsertSize = c(197L,
203L, 200L, 208L, 200L, 194L), median3PrimeBias = c(0.283437,
0.263973, 0.372476, 0.266946, 0.296308, 0.292954), median5PrimeBias = c(0.139005,
0.21233, 0.123449, 0.185168, 0.169128, 0.152902), median5PrimeTo3PrimeBias = c(0.586081,
0.9234, 0.409042, 0.83276, 0.680496, 0.640518), nBasesAligned = c(1627112497,
1572782400, 1772774189, 1595461211, 1593529487, 1705441762),
nBasesCoding = c(795255442, 778886694, 762223625, 819014623,
759061861, 838846117), nBasesIntergenic = c(140893219, 176728812,
194156767, 120900630, 137267440, 148815172), nBasesIntron = c(134528982,
111795186, 121091943, 96554581, 142587231, 139962698), nBasesRibosomal = c(NA,
NA, NA, NA, NA, NA), nBasesUtr = c(556434854, 505371708,
695301854, 558991377, 554612955, 577817775), nCorrectStrandReads = c(NA_integer_,
NA_integer_, NA_integer_, NA_integer_, NA_integer_, NA_integer_
), nIncorrectStrandReads = c(NA_integer_, NA_integer_, NA_integer_,
NA_integer_, NA_integer_, NA_integer_), nReadsAligned = c(33157934L,
32082625L, 36181227L, 32595741L, 32538544L, 34783342L), nReadsProperPair = c(31935921L,
30983730L, 35015854L, 31358224L, 31405592L, 33479007L), nReadsSingleton = c(3919886L,
4311016L, 4382092L, 3848808L, 3873270L, 4122759L), nReadsTotal = c(37077604L,
36393382L, 40563115L, 36444288L, 36411547L, 38905908L), pctChimeras = c(0.004783,
0.003078, 0.003063, 0.004278, 0.002983, 0.00485), rateIndel = c(0.000071,
0.000076, 0.000081, 0.000066, 0.000072, 0.00007), rateReadsMismatch = c(0.001438,
0.001643, 0.001627, 0.001467, 0.001716, 0.001471), stdevInsertSize = c(120.677992,
129.927513, 114.820226, 138.486257, 118.98163, 115.25774),
group = c("Gentrap.1451849446759", "Gentrap.1451849446759",
"Gentrap.1451849446759", "Gentrap.1451849446759", "Gentrap.1451849446759",
"Gentrap.1451849446759")), .Names = c("runName", "sampleName",
"readGroupName", "maxInsertSize", "medianCvCoverage", "medianInsertSize",
"median3PrimeBias", "median5PrimeBias", "median5PrimeTo3PrimeBias",
"nBasesAligned", "nBasesCoding", "nBasesIntergenic", "nBasesIntron",
"nBasesRibosomal", "nBasesUtr", "nCorrectStrandReads", "nIncorrectStrandReads",
"nReadsAligned", "nReadsProperPair", "nReadsSingleton", "nReadsTotal",
"pctChimeras", "rateIndel", "rateReadsMismatch", "stdevInsertSize",
"group"), row.names = c(NA, 6L), class = "data.frame")
server.R
shinyServer(function(input, output, session) {
output$selectBoxplotField <- renderUI({
selectInput("getBoxplotField", label = "Select variable to plot", choices = names(getAllSampleStats()))
})
output$boxplot <- renderPlotly({
finalDf #as defined above in the example
p <- plot_ly(finalDf, x = runName, y = input$getBoxplotField , type = "box")
})
}
GUI.R
shinyUI(navbarPage(
theme = "bootstrap_sandstone.css",
"SPIN", fluid = T,
tabPanel("Gentrap",
fluidPage(fluidRow(
sidebarlogin(pipelineName = "gentrap"),
column(10,
tabsetPanel(
tabPanel("Metrics distribution",
fluidRow(
column(2),
column(8, plotlyOutput("boxplot")),
column(2)
),
fluidRow(
column(3, uiOutput("selectBoxplotField")),
column(3, checkboxInput("checkboxplot", label = "Compare to All", value = TRUE))
),
fluidRow(
column(9, helpText("If no plot shows up it means this data is not present in the Sentinel QC database"))
)),
))
)))
))
The problem is fixed by passing the DF plus columns directly to the X and Y axes without first passing the DF name as a argument.
Proper plot will be generated when this is done:
plot_ly(x = finalDf[,'runName'], y = finalDf[,input$getBoxplotField] , type = "box", color = 'red') %>%
layout(xaxis = list(showticklabels = FALSE, title = ''), yaxis = yName)
This is wrong:
plot_ly(finalDf, x = runName, y = input$getBoxplotField , type = "box", color = 'red') %>%
layout(xaxis = list(showticklabels = FALSE, title = ''), yaxis = yName)

Resources