I am trying to make a shiny app, which consists of a sidebar panel and a plot. In the panel, I have radio buttons to select which ID should be plotted. I also have multiple variables which user can turn off and on using plotly legend.
I want the plot to be empty when app first opens. For that, I am using visible = "legendonly" in my plotly. But then, I want to keep the traces that user already activated (by clicking on them in the legend) when the ID is changed in the sidebar panel; however, since plotly get regenerated every time, again it uses visible = "legendonly" option and that causes the plot to reset.
Is there a way to keep the traces (only the ones that are already selected) when a different option gets selected in the sidebar panel?
See a reproducible example below; please note that I made this example to run locally. You need to load data and packages separately into your R session. Data can be found at the bottom of the question.
library(shiny)
library(plotly)
library(lubridate)
### Read mdata into your R session
# UI
uix <- shinyUI(pageWithSidebar(
headerPanel("Data"),
sidebarPanel(
radioButtons('vars', 'ID',
c("1", "2")),
helpText('Select an ID.')
),
mainPanel(
h4("Plot"),
plotlyOutput("myPlot")
)
)
)
# SERVER
serverx <- function(input, output) {
#load("Data/mdata.RData") #comment out this part and load data locally
# a large table, reative to input$show_vars
output$uteTable = renderDataTable({
ute[, input$show_vars, drop = FALSE]
})
output$myPlot = renderPlotly(
{
p <- plot_ly() %>%
layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
yaxis = list(title = "Y"))
## Add the IDs selected in input$vars
for (item in input$vars) {
mdata %>%
mutate(Date = make_date(Year, Month, 15)) %>%
filter(ID == item) -> foo
p <- add_lines(p, data = foo, x = ~Date, y = ~Value, color = ~Variable, visible = "legendonly",
evaluate = TRUE)
p <- p %>% layout(showlegend = TRUE,
legend = list(orientation = "v", # show entries horizontally
xanchor = "center", # use center of legend as anchor
x = 100, y=1))
}
print(p)
})
}
shinyApp(uix, serverx)
Created on 2020-06-12 by the reprex package (v0.3.0)
Question: is it possible to keep the Var1 trace when changing to ID == 2?
Idea: I think it'd be possible if I could change the visible = 'legendonly to TRUE right after app deployment, so it only applies to the first example of the plot. Probably, I need to change evaluate to FALSE as well.
Data:
mdata <- structure(list(Year = c(2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L), Month = c(1L, 1L,
1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L,
5L, 5L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 9L, 9L,
9L, 9L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 11L, 12L, 12L, 12L,
12L), Variable = c("Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2"), ID = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1,
2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2,
1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2), Value = c(187.797761979167,
6.34656438541666, 202.288468333333, 9.2249309375, 130.620451458333,
4.61060465625, 169.033213020833, 7.5226940625, 290.015582677083,
10.8697671666667, 178.527960520833, 7.6340359375, 234.53493728125,
8.32400878125, 173.827054583333, 7.54521947916667, 164.359205635417,
5.55496292708333, 151.75458625, 6.361610625, 190.124467760417,
6.45046077083333, 191.377006770833, 8.04720916666667, 170.714612604167,
5.98860073958333, 210.827157916667, 9.46311385416667, 145.784868927083,
5.16647911458333, 159.9545675, 6.7466725, 147.442681895833, 5.43921594791667,
153.057018958333, 6.39029208333333, 165.6476956875, 5.63139815625,
197.179256875, 8.73210604166667, 148.1879651875, 5.58784840625,
176.859451354167, 7.65670020833333, 186.215496677083, 7.12404453125,
219.104379791667, 9.39468864583333)), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -48L), groups = structure(list(
Year = 2015L, .rows = list(1:48)), row.names = c(NA, -1L), class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE))
The following uses plotlyProxy to replace the data for the existing plotly object (and traces) and therefore avoids re-rendering the plot. This approach is faster than re-rendering.
library(shiny)
library(plotly)
library(lubridate)
# UI
uix <- shinyUI(pageWithSidebar(
headerPanel("Data"),
sidebarPanel(
radioButtons('myID', 'ID',
c("1", "2")),
helpText('Select an ID.')
),
mainPanel(
h4("Plot"),
plotlyOutput("myPlot")
)
)
)
# SERVER
serverx <- function(input, output, session) {
output$myPlot = renderPlotly({
p <- plot_ly() %>%
layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
yaxis = list(title = "Y"))
mdata %>%
mutate(Date = make_date(Year, Month, 15)) %>%
filter(ID == 1) -> IDData
p <- add_lines(p, data = IDData, x = ~Date, y = ~Value,
color = ~Variable, visible = "legendonly")
p <- p %>% layout(showlegend = TRUE,
legend = list(orientation = "v", # show entries horizontally
xanchor = "center", # use center of legend as anchor
x = 100, y=1))
p
})
myPlotProxy <- plotlyProxy("myPlot", session)
observe({
mdata %>%
mutate(Date = make_date(Year, Month, 15)) %>%
filter(ID == input$myID) -> IDData
req(IDData)
uniqueVars <- unique(IDData$Variable)
for(i in seq_along(uniqueVars)){
IDData %>% filter(Variable == uniqueVars[i]) -> VarData
plotlyProxyInvoke(myPlotProxy, "restyle", list(x = list(VarData$Date),
y = list(VarData$Value)), list(i-1))
}
})
}
shinyApp(uix, serverx)
For further information please also see chapter "17.3.1 Partial plotly updates" in the plotly book, plotly's function reference and this answer.
Data:
### Read mdata into your R session
mdata <- structure(list(Year = c(2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L, 2015L,
2015L, 2015L, 2015L, 2015L, 2015L, 2015L), Month = c(1L, 1L,
1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L,
5L, 5L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 9L, 9L,
9L, 9L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 11L, 12L, 12L, 12L,
12L), Variable = c("Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2", "Var1", "Var1", "Var2", "Var2", "Var1", "Var1",
"Var2", "Var2"), ID = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1,
2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2,
1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2), Value = c(187.797761979167,
6.34656438541666, 202.288468333333, 9.2249309375, 130.620451458333,
4.61060465625, 169.033213020833, 7.5226940625, 290.015582677083,
10.8697671666667, 178.527960520833, 7.6340359375, 234.53493728125,
8.32400878125, 173.827054583333, 7.54521947916667, 164.359205635417,
5.55496292708333, 151.75458625, 6.361610625, 190.124467760417,
6.45046077083333, 191.377006770833, 8.04720916666667, 170.714612604167,
5.98860073958333, 210.827157916667, 9.46311385416667, 145.784868927083,
5.16647911458333, 159.9545675, 6.7466725, 147.442681895833, 5.43921594791667,
153.057018958333, 6.39029208333333, 165.6476956875, 5.63139815625,
197.179256875, 8.73210604166667, 148.1879651875, 5.58784840625,
176.859451354167, 7.65670020833333, 186.215496677083, 7.12404453125,
219.104379791667, 9.39468864583333)), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -48L), groups = structure(list(
Year = 2015L, .rows = list(1:48)), row.names = c(NA, -1L), class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE))
Edit:
The following is an alternative server function to update the trace data with a single plotlyProxyInvoke call (avoiding the for-loop):
serverx <- function(input, output, session) {
output$myPlot = renderPlotly({
p <- plot_ly() %>%
layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
yaxis = list(title = "Y"))
mdata %>%
mutate(Date = make_date(Year, Month, 15)) %>%
filter(ID == 1) -> IDData
p <- add_lines(p, data = IDData, x = ~Date, y = ~Value,
color = ~Variable, visible = "legendonly")
p <- p %>% layout(showlegend = TRUE,
legend = list(orientation = "v", # show entries horizontally
xanchor = "center", # use center of legend as anchor
x = 100, y=1))
p
})
myPlotProxy <- plotlyProxy("myPlot", session)
IDDataList <- split(mdata %>% mutate(Date = make_date(Year, Month, 15)), ~ ID + Variable)
observe({
selectedIDDataList <- setNames(lapply(list("Date", "Value"), function(i){
unname(lapply(IDDataList[paste0(input$myID, ".Var", c(1L, 2L))], function(j){j[[i]]}))
}), c("x", "y"))
plotlyProxyInvoke(myPlotProxy, "restyle", selectedIDDataList, seq_along(selectedIDDataList)-1)
})
}
What I could think of was adding a check box to select the variables to be plotted instead of turning them off and on in the legend. Using this method, instead of using visible = legendonly, I leave the check box with no default values selected. Also, when user changes the ID, variables stay the same and therefore get plotted for the next ID. See below;
library(shiny)
library(plotly)
library(lubridate)
### Read mdata into your R session
# UI
uix <- shinyUI(pageWithSidebar(
headerPanel("Data"),
sidebarPanel(
radioButtons('vars', 'ID',
c("1", "2")),
checkboxGroupInput('varp', 'Variable',
c("Var1", "Var2")),
helpText('Select an ID and Variables to be plotted.')
),
mainPanel(
h4("Plot"),
plotlyOutput("myPlot")
)
)
)
# SERVER
serverx <- function(input, output) {
#load("Data/mdata.RData") #comment out this part and load data locally
# a large table, reative to input$show_vars
output$uteTable = renderDataTable({
ute[, input$show_vars, drop = FALSE]
})
output$myPlot = renderPlotly(
{
p <- plot_ly() %>%
layout(title = "Title", xaxis = list(tickformat = "%b %Y", title = "Date"),
yaxis = list(title = "Y"))
## Add the IDs selected in input$vars
for (item in input$vars) {
mdata %>%
mutate(Date = make_date(Year, Month, 15)) %>%
filter(ID == item,
Variable %in% input$varp)-> foo
p <- add_lines(p, data = foo, x = ~Date, y = ~Value, color = ~Variable, evaluate = TRUE)
p <- p %>% layout(showlegend = TRUE,
legend = list(orientation = "v", # show entries horizontally
xanchor = "center", # use center of legend as anchor
x = 100, y=1))
}
print(p)
})
}
shinyApp(uix, serverx)
Related
So imagine I have a dataset where the column "date" contains years 2011-2017 and months for each year, however months are written out in letters. For example:
date: 11-Jan
I would like to make the months numeric so I get:
date: 11-01
Any suggestions on how I can tackle this problem?
Kind regards!
Make your input proper dates, parse them, then format them.
x <- c("11-Jan", "12-Feb")
Sys.setlocale("LC_TIME", "C") #parsing of months depends on locale
format(
as.Date(paste0(x, "-1"), format = "%y-%b-%d"),
"%y-%m"
)
#[1] "11-01" "12-02"
See help("strptime") for details on format strings.
Assuming your data is like:
df1 <- structure(list(day_mon = c("16-Dec", "18-Nov", "12-Oct", "8-Oct",
"15-May", "29-Jun", "22-Feb", "25-May", "23-Jan", "24-Oct", "23-May",
"27-Sep", "9-Apr", "28-Oct", "18-Jan", "8-Apr", "7-Jan", "13-Dec",
"28-Nov", "24-May"), year = c(2012L, 2014L, 2011L, 2015L, 2015L,
2015L, 2011L, 2015L, 2012L, 2015L, 2011L, 2012L, 2014L, 2012L,
2013L, 2011L, 2017L, 2016L, 2014L, 2014L)),
row.names = c(
1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L,
13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L), class = "data.frame")
You can:
# Format the month and day: mon_day_fmt => character vector
df1$mon_day_fmt <- paste(
sprintf(
"%02d",
match(
gsub(
"\\d+\\-(\\w+)",
"\\1",
with(
df1,
day_mon
)
),
month.abb
)
),
sprintf(
"%02d",
as.integer(
gsub(
"^(\\d+)\\-\\w+$",
"\\1",
with(
df1,
day_mon
)
)
)
),
sep = "-"
)
# Create a date vector: date => Date Vector
df1$date <- as.Date(
paste(
df1$year,
df1$mon_day_fmt,
sep = "-"
)
)
I've built an interactive map to filter Toronto Auto Thefts by day of the week and year. However, I've been looking at the map that gets built and it does not seem as if the data is being filtered at all. It looks like the same points get plotted every input change.
I'm not sure what is not working considering the code looks fine. Here is what I have:
data <- structure(list(occurrenceyear = c(2017L, 2018L, 2018L, 2018L,
2018L, 2018L, 2017L, 2018L, 2018L, 2018L), occurrencedayofweek = structure(c(7L,
6L, 7L, 3L, 3L, 8L, 2L, 7L, 8L, 7L), .Label = c("", "Friday ",
"Monday ", "Saturday ", "Sunday ", "Thursday ", "Tuesday ",
"Wednesday "), class = "factor"), Lat = c(43.7639694, 43.5895691,
43.6753197, 43.7586555, 43.727829, 43.6431503, 43.6683502, 43.6842308,
43.6707535, 43.6820869), Long = c(-79.1886063, -79.5458221, -79.3138199,
-79.4392548, -79.4406738, -79.5390091, -79.3820572, -79.4840012,
-79.3930817, -79.4356079)), row.names = c(NA, 10L), class = "data.frame")
ui <- fluidPage(
titlePanel("Toronto Auto Thefts"),
sidebarLayout(
sidebarPanel(
selectInput("checkGroup", h3("Weekday"), choices = list("Monday" = 1,
"Tuesday" = 2,
"Wednesday" = 3,
"Thursday" = 4,
"Friday" = 5,
"Saturday" = 6,
"Sunday" = 7), selected = 1),
selectInput("checkGroup2", h3("Year"), choices = list("2014" = 1,
"2015" = 2,
"2016" = 3,
"2017" = 4,
"2018" = 5), selected = 1),
),
mainPanel (leafletOutput("map", "100%", 500))
))
server <- function(input, output, session){
output$map <- renderLeaflet({
df <- data[data$occurrencedayofweek == input$checkGroup & data$occurrenceyear == input$checkGroup2]
leaflet() %>%
addTiles() %>%
addCircles(data = df)
})
}
Is data a dataframe? If so, you need a comma, here:
data[data$occurrencedayofweek == input$checkGroup & data$occurrenceyear == input$checkGroup2, ]
You've got quite a few problems in your example.
Typos between data and df
Whitespace in your level names
Your input choices don't correspond properly to your data
I think this addresses them all:
library(shiny)
library(leaflet)
df <- structure(list(occurrenceyear = c(2017L, 2018L, 2018L, 2018L,
2018L, 2018L, 2017L, 2018L, 2018L, 2018L), occurrencedayofweek = structure(c(7L,
6L, 7L, 3L, 3L, 8L, 2L, 7L, 8L, 7L), .Label = c("", "Friday ",
"Monday ", "Saturday ", "Sunday ", "Thursday ", "Tuesday ",
"Wednesday "), class = "factor"), Lat = c(43.7639694, 43.5895691,
43.6753197, 43.7586555, 43.727829, 43.6431503, 43.6683502, 43.6842308,
43.6707535, 43.6820869), Long = c(-79.1886063, -79.5458221, -79.3138199,
-79.4392548, -79.4406738, -79.5390091, -79.3820572, -79.4840012,
-79.3930817, -79.4356079)), row.names = c(NA, 10L), class = "data.frame")
df$occurrencedayofweek <- trimws(as.character(df$occurrencedayofweek))
df$occurrenceyear <- as.character(df$occurrenceyear)
ui <- fluidPage(
titlePanel("Toronto Auto Thefts"),
sidebarLayout(
sidebarPanel(
selectInput("checkGroup", h3("Weekday"), choices = c("Monday",
"Tuesday",
"Wednesday",
"Thursday",
"Friday",
"Saturday",
"Sunday"), selected = 'Monday'),
selectInput("checkGroup2", h3("Year"), choices = 2014:2018, selected = 2017)
),
mainPanel (leafletOutput("map", "100%", 500))
)
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
df <- df[df$occurrencedayofweek == input$checkGroup & df$occurrenceyear == input$checkGroup2,]
leaflet() %>%
addTiles() %>%
addCircles(data = df)
})
}
shinyApp(ui, server)
Using this data:
Data2 <- structure(list(year = c(2008L, 2009L, 2010L, 2011L, 2012L, 2013L,
2014L, 2015L, 2016L, 2017L, 2018L, 2019L, 2008L, 2009L, 2010L,
2011L, 2012L, 2013L, 2014L, 2015L, 2016L, 2017L, 2018L, 2019L,
2008L, 2009L, 2010L, 2011L, 2012L, 2013L, 2014L, 2015L, 2016L,
2017L, 2018L, 2019L), variable = c("var1", "var1", "var1", "var1",
"var1", "var1", "var1", "var1", "var1", "var1", "var1", "var1",
"var2", "var2", "var2", "var2", "var2", "var2", "var2", "var2",
"var2", "var2", "var2", "var2", "var3", "var3", "var3", "var3",
"var3", "var3", "var3", "var3", "var3", "var3", "var3", "var3"
), frequency = c(1L, 0L, 0L, 0L, 1L, 1L, 3L, 4L, 3L, 10L, 9L,
0L, 0L, 1L, 0L, 0L, 3L, 2L, 2L, 3L, 8L, 9L, 12L, 3L, 0L, 0L,
0L, 0L, 0L, 2L, 1L, 0L, 1L, 2L, 4L, 0L)), class = "data.frame", row.names = c(NA,
-36L))
I try to produce a plot like this one:
library(ggplot2)
ggplot(Data2, aes(year, variable, size = frequency, color = variable)) +
geom_point()+ theme(text = element_text(size = 18))
However I have some problem with the view of this graph:
How can I change the x axis to have all years, make bigger the geom_point (I tried the size but it is a fix option and all circles made the same) and from frequency show from 1 and not 0 cicles if exist?
An easy way to get years to show up is to turn them into factors. As far as starting your size scale at one: I'm not sure if you want to remove points representing 0, or just start the scale from 1. The following code should give you and idea of how to do either, or both. To remove 0s from a plot it might be easiest to just turn them into NAs, which won't be plotted (it will throw a warning, but that's okay). You can change your size scale breaks using scale_size_continuous:
Data2 %>%
mutate(frequency = ifelse(frequency == 0, NA, frequency),
year = as.factor(year)
) %>%
ggplot(aes(year, size = frequency, variable, color = variable)) +
geom_point() +
theme(text = element_text(size = 18)) +
scale_size_continuous(breaks = c(1, 4, 8, 12))
When the axis labels are not all showing up, or when they are superimposed, a standard trick is to rotate them. In this case I will rotate the x axis labels by 45 degrees.
library(ggplot2)
ggplot(Data2, aes(year, variable,
size = frequency, color = variable)) +
geom_point() +
theme(text = element_text(size = 18),
axis.text.x = element_text(angle = 45, hjust = 1))
I have a quick&dirty solution for no 0 frequencies: Data2[Data2==0] <- NA
alternatively only for frequency:
library(data.table)
setDT(Data2)
Data2[frequency==0, frequency:= NA]
For having proper years:
Data2$year = as.Date(strptime(Data2$year, "%Y"))
ggplot(Data2, aes(year, variable, size = frequency, color = variable)) +
geom_point()+
theme( axis.text.x = element_text(angle = 60, hjust = 1) )
Given the following data.frame
data <- structure(list(
a = c(3.022210021321, 3.31806778755904, 3.34379454984061, 3.47242836124846, 3.55604033866356, 1.11199792191451, 1.24063173332236, 1.31781202016707, 1.30494863902628, 1.3692655447302, 1.07983946906255, 1.2084732804704, 1.40142399758216, 1.60723809583472, 1.64582823925707),
b = c(2.64027979608152, 2.79483009168741, 2.90522315997732, 3.08185206924119, 2.86106593266136, 0.653204566863006, 0.697361794178973, 0.67528318052099, 0.653204566863006, 0.697361794178973, 2.06623584097395, 2.28702197755379, 2.48572950047564, 2.72859425071346, 2.77275147802942),
c = c(2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L),
d = c(1.16264425026133, 1.16264425026133, 1.16264425026133, 1.16264425026133, 1.16264425026133, 1.48373054411498, 1.48373054411498, 1.48373054411498, 1.48373054411498, 1.48373054411498, 3.35362520562369, 3.35362520562369, 3.35362520562369, 3.35362520562369, 3.35362520562369),
e = c(2015L, 2016L, 2017L, 2018L, 2019L, 2015L, 2016L, 2017L, 2018L, 2019L, 2015L, 2016L, 2017L, 2018L, 2019L),
f = c("X", "X", "X", "X", "X", "Y", "Y", "Y", "Y", "Y", "Z", "Z", "Z", "Z", "Z"),
h = structure(c(2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L), .Label = c("low", "mid", "high"), class = c("ordered", "factor"))),
row.names = c(NA, -15L),
class = "data.frame")
and the following code snippet
library(plotly)
p <- data %>% plot_ly(
x = ~a,
y = ~b,
size = ~c,
sizes = c(100, 850),
color = ~d,
colors = "YlOrRd",
alpha = 0.365,
frame = ~e,
text = ~paste0("Info: ", f),
hoverinfo = "text",
type = 'scatter',
mode = 'markers') %>%
add_text(textfont = list(size = 10, color = "black"), textposition = "top", text=~f, showlegend = F)
legend.plot <- plot_ly() %>%
add_markers(x = 1,
y = seq_len(length(unique(data$c))),
size = sort(unique(data$c)),
showlegend = F,
color = I("black"),
marker = list(sizeref=0.1, sizemode="area")) %>%
layout(
annotations = list(
list(x = 1.2,
y = 0.4,
text = "Size by: c",
showarrow = F,
xref='paper',
yref='paper')),
xaxis = list(
zeroline=F,
showline=F,
showticklabels=F,
showgrid=F),
yaxis=list(
side = "right",
range = c(0,10),
showgrid=F,
zeroline=F,
tickmode = "array",
tickvals = seq_len(length(unique(data$c))),
ticktext = c("low","mid","high")))
subplot(p, legend.plot, widths = c(0.85, 0.15), titleX=TRUE, titleY=TRUE) %>%
config(displayModeBar = F) %>%
colorbar(title = "Color by: d", x = 0.9, y = 1)
I manage to almost get a plotly plot that I want (ignoring the warnings along the way for now).
I am, however, unable to figure out, how to make the legend for size to stay during the animation. It appears in the initial stage, before the play button is hit, but as soon as I press play, it goes away.
So the static plot data points are disappearing from the subplot when I run the animation. Any hints?
This works. The reason that your pseudo-legend disappears is that you only have it for the first frame. What I did here is adding the data for all the 5 years (that's why I have rep) and making sure that frame is included in both plots.
legend.plot <- plot_ly() %>%
add_markers(x = rep(1,15),
y = rep(seq_len(length(unique(data$c))),5),
size = rep(sort(unique(data$c)),5),
showlegend = F,
color = I("black"),
frame = ~data$e,
marker = list(sizeref=0.1, sizemode="area")) %>%
layout(
annotations = list(
list(x = 1.2,
y = 0.4,
text = "Size by: c",
showarrow = F,
xref='paper',
yref='paper')),
xaxis = list(
zeroline=F,
showline=F,
showticklabels=F,
showgrid=F),
yaxis=list(
side = "right",
range = c(0,10),
showgrid=F,
zeroline=F,
tickmode = "array",
tickvals = seq_len(length(unique(data$c))),
ticktext = c("low","mid","high")))
I would like to write a reusable function whose input parameters would be the dataframe and the names of columns i want to subset it with.
The function is defined as below:
funct <- function(df, colnames){
df_subset = df[ , colnames]
return(df_subset) }
flights_subset <- funct(flights, c("MONTH","YEAR") ) #1st arg is a df, 2nd arg is a string
To give more clarity, i have given code to create the input file 'flights' and the returned file i am expecting from the function 'flights_subset'
flights <- structure(list(YEAR = c(2011L, 2011L, 2011L, 2011L, 2011L), MONTH = c(1L,
1L, 1L, 1L, 1L), DAYOFMONTH = 1:5, DAYOFWEEK = c(6L, 7L, 1L,
2L, 3L), DEPTIME = c(1400L, 1401L, 1352L, 1403L, 1405L)), .Names = c("YEAR",
"MONTH", "DAYOFMONTH", "DAYOFWEEK", "DEPTIME"), row.names = 5424:5428, class = "data.frame")
flights_subset <- structure(list(MONTH = c(1L, 1L, 1L, 1L, 1L), YEAR = c(2011L,
2011L, 2011L, 2011L, 2011L)), .Names = c("MONTH", "YEAR"), class = "data.frame", row.names = 5424:5428)
Your version is fine, you just need to fix the typo in function. Also, there's no need for a return statement.
funct <- function(df, colnames){
df[ , colnames]
}
or you can use dplyr
library(dplyr)
funct <- function(df, colnames){
df %>% select_(colnames)
}
flights_subset <- funct(flights, c("MONTH", "YEAR"))