My final aim is to create 2 time series line graphs on the same plot, with the one being static and the other being animated (the former refers to the actual data and the latter on my model's fitted values). I am trying to accomplish that with plotly, however I am completely new and have crossed difficulties.
In order to get familiar with plotly first before attempting the above I initially tried to create just one animated graph on a plot. However I cannot even make that ostensibly simple script work. When running the below no graph is displayed on my plot area, like there are no data. My script is created based on following link: https://plot.ly/r/cumulative-animations/
plot_ly(data
, x=~data$RequCreatedFull_Date
, y=~data$fitted_TotalRequ_Qnt_pm
, name="Fitted"
, type='scatter'
, mode = "lines"
, line = list(color = "rgb(255,128,0)")
, frame = ~data$RequCreatedFull_Date
, line = list(simplyfy = F)) %>%
layout(title="name"
, xaxis = list(range =
c(as.numeric(min(data$RequCreatedFull_Date))*1000
,as.numeric(max(data$RequCreatedFull_Date))*1000)
, type = "date"
, title = "Requisition Date"
, zeroline = F)
, yaxis = list(title="Total Requisition Qnts"
, range = c(1000,30000)
, zeroline = F)) %>%
animation_opts(frame = 100,
transition = 0,
redraw=FALSE) %>%
animation_button(x = 1, xanchor = "right", y = 0, yanchor = "bottom")
data is a 53 obs, 4 variables (dates, actuals, fits, index) data frame.
When 'Play' button for animation is clicked and while the animation's frames proceed, when hovering on the plot area the data points' tooltips are displayed for a moment, however no graph is displayed.
Thank you in advance for all your assistance, hope I provided you with sufficient info.
I mistakenly took part of the script the below link for the animated plotting (https://plot.ly/r/cumulative-animations/). The problem is that I did not modify the to-be-framed variable (variable to be used in frame parameter of plot_ly function) before using it.
Therefore, in order for the plot to work properly I should: 1. define accumulate_by function, 2. use it with the to-be-framed variable as input, 3. the output column produced from step 2 will be the value for the frame parameter of 'plot_ly' function.
Initial working data frame is data2, with columns RequCreatedFull-Date(as POSIXct), Requs_Qnt_pm(as num), Type(as Factor), date(as num) where
date=(year(RequCreatedFull_Date)+(month(RequCreatedFull_Date)-1)/12).
Please refer to working script below:
library(plotly)
library(dplyr)
library(lubridate)
#step 1: function definition
accumulate_by <- function(dat, var) {
var <- lazyeval::f_eval(var, dat)
lvls <- plotly:::getLevels(var)
dats <- lapply(seq_along(lvls), function(x) {
cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
})
dplyr::bind_rows(dats)
}
#step 2: creation of to-be-used for framing variable
data2mod <- data2 %>%
accumulate_by(~date)
#graph creation
my_graph<-data2mod %>%
plot_ly(
x = ~date,
y = ~Requs_Qnt_pm,
split = ~Type,
frame = ~frame, #step 3, to be frame variable insertion
type = 'scatter',
mode = 'lines',
line = list(simplyfy = F)
) %>%
layout(
xaxis = list(
title = "x axis title",
zeroline = F
),
yaxis = list(
title = "y axis title",
zeroline = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
hide = T
) %>%
animation_button(
x = 1, xanchor = "right", y = 0, yanchor = "bottom"
)
In xaxis and in yaxis showline=TRUE
Related
I'm struggeling on a simple task. I have a database with 3 columns :
Year (numeric)
Age (numeric)
Pop (numeric)
Part60 : The % of individuals with age >= 60 (string like '% of poeple over 60 : 12%'). This value is the same for each rows of a year.
Dataset looks like :
I built a plotly bargraph with a frame based on the year. So I have a slider which allow me to show for each age the number of individuals and this is animated year by year.
I would like to add an anotation which shows the value of Part60 for the year of the frame... I know that it's possible with a ggplot sent to ggplotly function, however I want to do it from scratch with a plot_ly function as parameters are (for me) easier to control and follow the logic of my code.
This is my code :
gH <- plot_ly(data = dataH,
name = 'Hommes',
marker = list(color = ispfPalette[4]),
x = ~Pop,
y = ~Age,
frame = ~Annee)
gH <- gH %>% layout(yaxis = list(categoryorder="array",
categoryarray=dataH$Age))
gH <- gH %>% layout(yaxis = list(title = '',
zeroline = TRUE,
showline = TRUE,
showticklabels = TRUE,
showgrid = FALSE),
xaxis = list(title = '',
zeroline = TRUE,
showline = TRUE,
autorange = "reversed"),
shapes = hline(60))
gH <- gH %>% add_annotations(
x = 3000,
y = 62,
text = 'Part des 60 ans et + : 12 %',
showarrow = F,
color = ispfPalette[8]
Where text = 'Part des 60 ans et + : 12 %' should be replaced by something which allow me to get the value which belongs to the year of the slider.
Is someone may help me to do it ?
Thanks in advance for your great help.
Since I don't have your data, it's pretty difficult to give you the best answer. Although, here is a method in which you can add text that changes throughout the animation.
library(plotly)
library(tidyverse)
data(gapminder, package = "gapminder")
str(gapminder)
funModeling::df_status(gapminder)
# continent, lifeExp, year
gap <- gapminder %>% group_by(year, continent) %>%
summarise(Expectancy = mean(lifeExp))
# plot
p1 <- plot_ly(gap, x = ~Expectancy, y = ~continent,
frame = ~year, type = 'bar',
showlegend = F,
hovertemplate = paste0("Continent: %{y}<br>",
"<extra></extra>"),
texttemplate = "Life Expectancy: %{x:.2f}") %>%
layout(yaxis=list(title=""),
xaxis=list(title="Average Life Expectancy per Continent By Year"),
title=list(text=paste("Fancy Title")),
margin = list(t = 100))
p1
If you had text you wanted to animate that is not connected to each marker (bar, point, line), then you could do it this way.
# Something to add in the annotation text
gap2 <- gap %>% filter(continent == "Asia") %>%
droplevels() %>%
arrange(year)
# build to see frames
p2 <- plotly_build(p1)
# modify frames; need an annotation for each frame
# make sure the data is in order by year (order by frame)
lapply(1:nrow(gap2), # for each frame
function(i){
annotation = list(
data = gap2,
type = "text",
x = 77,
y = .5,
yref = "paper",
showarrow = F,
text = paste0("Asian Life Expectancy<br>",
sprintf("%.2f", gap2[i, ]$Expectancy)),
font = list(color = "#b21e29", size = 16))
p2$x$frames[[i]]$layout <<- list(annotations = list(annotation)) # change plot
})
p2
If anything is unclear, let me know.
I would like to ask you if you could help me in customizing of colors in a stacked bar chart created by plotly.
The problem is following - I have to recreate a dashboard (from an excel file to a html file). A part of the dashboard is a chart providing us with information about early production of each entity. The chart is a stacked bar chart type by plotly. As each entity is defined by a specific color (defined in RGB) throughout whole dashboard, I need to keep these colors in the donut chart as well. But there is a problem. I always get the following warning:
Warning message:
In RColorBrewer::brewer.pal(N, "Set2") :
n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
and the resulting donut chart containts only one Entity with a not-specified color. Also, the colors in the legend are not those which are defined.
Any idea what to do with it? Thank you so much in advance.
Code:
library(dplyr)
library(plotly)
dt <- as.data.frame(matrix(ncol = 13, nrow = 19))
colnames(dt) <- c("Entity", month.abb)
for (i in 1:nrow(dt)) {
dt[i, 1] <- paste("Entity", i, sep="")
dt[i, -1] <- floor(runif(12, min=0, max=100))
}
# assign colors to entities
dt$"EntityColor" <- c("#074263", "#0B5394", "#3D85C6", "#6D9EEB", "#A4C2F4", "#CFE2F3", "#5B0F00", "#85200C", "#A61C00", "#CC4125", "#DD7E6B", "#E6B8AF", "#F8CBAD", "#F4CCCC", "#274E13", "#38761D", "#E06666", "#CC0000", "#20124D")
data.table::melt(dt) %>%
plot_ly(x = ~variable,
y = ~value,
type = "bar",
color = ~Entity,
marker = list(colors = ~EntityColor)
) %>%
layout(yaxis = list(title = ""),
xaxis = list(title = ""),
barmode = 'stack')
Plot:
Refined approach after comments:
Since the colors turned out to be a bit tricky (see initial suggestion below) I had to break the whole thing down and use a combination of plot_ly() and add_traces() in a loop to make sure that the plotly settings did not apply colors in the wrong order.
The following plot should be exactly what you're looking for.
Plot:
Note that I've appended a continuous numerical column ID. Why? Because you wanted the names in alphabetical order, and the rows are added to the plot in the order they appear in your source. And It's a bit tricky since a straight up ordering using dt %>% arrange((Entity)) would give you Entity1, Enitity10, Entity11 etc. Let me know if you'd like to adjust this in any other way.
Code:
library(dplyr)
library(plotly)
# data
set.seed(123)
dt <- as.data.frame(matrix(ncol = 13, nrow = 19))
colnames(dt) <- c("Entity", month.abb)
for (i in 1:nrow(dt)) {
dt[i, 1] <- paste("Entity", i, sep="")
dt[i, -1] <- floor(runif(12, min=0, max=100))
}
# assign colors to entities
dt$"EntityColor" <- c("#074263", "#0B5394", "#3D85C6", "#6D9EEB", "#A4C2F4", "#CFE2F3", "#5B0F00", "#85200C", "#A61C00", "#CC4125", "#DD7E6B", "#E6B8AF", "#F8CBAD", "#F4CCCC", "#274E13", "#38761D", "#E06666", "#CC0000", "#20124D")
# sort data
dt$ID <- seq.int(nrow(dt))
dt <- dt %>% arrange(desc(ID))
# specify month as factor variable to ensure correct order
months=names(dt)[2:13]
months<- factor(months, levels = c(months))
# plotly setup
p <- plot_ly(type = 'bar')
# add trace for each entity
nrows = nrow(dt)
for(i in 1:nrows) {
p <- p %>% add_trace(x=months, y = unlist(dt[i,2:13], use.names=F), type = 'bar',
#name = paste(dt[i,1], dt[i,14], sep = "_"),
name = dt[i,1],
type = 'bar',
marker=list(color = dt[i,14])) %>%
layout(barmode = 'stack')
}
# Edit layout
p <- p %>% layout(title = list(xanchor='right', text='Correct colors, orderered legend'),
yaxis = list(title = ''),
xaxis = list(title = 'month'))
p
Color correctness verification:
Initial suggestion
Here's an initial suggestion. First of all, color = ~Entity has got to go. And marker = list(color = ~EntityColor) versus marker = list(colors = ~EntityColor) gives two different results. What makes matters even stranger is that the pie chart documentation uses:
marker = list(colors = colors, ...)
... and the bar chart documentation uses:
marker = list(color = c('rgba(204,204,204,1)', 'rgba(222,45,38,0.8)', ...)
...without the s at the end of color.
Either way, you should test both marker = list(color = ~EntityColor) and marker = list(colors = ~EntityColor) and see what's correct for you.
Plot:
Code:
dt <- as.data.frame(matrix(ncol = 13, nrow = 19))
colnames(dt) <- c("Entity", month.abb)
for (i in 1:nrow(dt)) {
dt[i, 1] <- paste("Entity", i, sep="")
dt[i, -1] <- floor(runif(12, min=0, max=100))
}
# assign colors to entities
dt$"EntityColor" <- c("#074263", "#0B5394", "#3D85C6", "#6D9EEB", "#A4C2F4", "#CFE2F3", "#5B0F00", "#85200C", "#A61C00", "#CC4125", "#DD7E6B", "#E6B8AF", "#F8CBAD", "#F4CCCC", "#274E13", "#38761D", "#E06666", "#CC0000", "#20124D")
data.table::melt(dt) %>%
plot_ly(x = ~variable,
y = ~value,
name= ~Entity,
type = "bar",
#color = ~Entity,
marker = list(colors = ~EntityColor)
) %>%
layout(yaxis = list(title = ""),
xaxis = list(title = ""),
barmode = 'stack')
Take a look and see how it works out for you.
My aim is to create 2 line graphs in the same plot area, however 1 should be static (always displayed), while the other animated (it will be displayed as soon as user clicks on the 'Play' button, as plotly provides). The concept is that we have a line graph with the actual values always displayed, and the animated one will be the fitted observations, showing how well they fit the actual line.
What I have achieved until now is to create both lines in an animated manner, however as mentioned before, I want the observations with Type=="Actuals" to be static, and the others (Type=="Fitted") only animated . Please refer to my current script below.
Initial working data frame is data2 which holds the actual and fitted values unified; with columns RequCreatedFull-Date(as POSIXct), Requs_Qnt_pm(as num), Type(as Factor-indicates whether the record refers to 'actual' or 'fitted' observation), date(as num) where
date=(year(RequCreatedFull_Date)+(month(RequCreatedFull_Date)-1)/12).
library(plotly)
library(dplyr)
library(lubridate)
#function definition for to be framed variable manipulation
accumulate_by <- function(dat, var) {
var <- lazyeval::f_eval(var, dat)
lvls <- plotly:::getLevels(var)
dats <- lapply(seq_along(lvls), function(x) {
cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
})
dplyr::bind_rows(dats)
}
#creation of to-be-used for framing variable
data2mod <- data2 %>%
accumulate_by(~date)
#graph creation
my_graph<-data2mod %>%
plot_ly(
x = ~date,
y = ~Requs_Qnt_pm,
split = ~Type,
frame = ~frame,
type = 'scatter',
mode = 'lines',
line = list(simplyfy = F)
) %>%
layout(
xaxis = list(
title = "x axis title",
zeroline = F
),
yaxis = list(
title = "y axis title",
zeroline = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
hide = T
) %>%
animation_button(
x = 1, xanchor = "right", y = 0, yanchor = "bottom"
)
UPDATE:
data2 table
#preparing 2 data tables for the plot (got to be merged with new Type var indicating actuals and fit observations)
agg_acts_rags_rf_ama2<-data.frame(agg_acts_rags_rf_ama, Type="Actuals", date=year(agg_acts_rags_rf_ama$RequCreatedFull_Date)+(month(agg_acts_rags_rf_ama$RequCreatedFull_Date)-1)/12)
agg_fits_rags_rf_ama2<-data.frame(agg_fits_rags_rf_ama, Type="Fitted", date=year(agg_fits_rags_rf_ama$RequCreatedFull_Date)+(month(agg_fits_rags_rf_ama$RequCreatedFull_Date)-1)/12)
names(agg_acts_rags_rf_ama2)[2]<-"Requs_Qnt_pm"
names(agg_fits_rags_rf_ama2)[2]<-"Requs_Qnt_pm"
#unifying the tables
data2<-rbind(agg_acts_rags_rf_ama2, agg_fits_rags_rf_ama2)
agg_acts_rags_rf_ama and agg_fits_rags_rf_ama hold only 2 columns, the RequCreatedFull_Date and a quantity column
accumulate_by <- function(dat, var) {
var <- lazyeval::f_eval(var, dat)
lvls <- plotly:::getLevels(var)
dats <- lapply(seq_along(lvls), function(x) {
cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
})
dplyr::bind_rows(dats)
}
d <- txhousing %>%
filter(year > 2005, city %in% c("Abilene", "Bay Area")) %>%
accumulate_by(~date)
If you implement a cumulative animation in the manner of the function above, the number of rows will increase too much.
I use a thousand frames and a row of ten thousand. Because of the large number of data, the work in progress has been disturbed.
https://plot.ly/r/cumulative-animations/
Is there any way to create a cumulative animation other than the example?
Help me!
I'm currently facing the same issue. The approach described here is not applicable for a few thousand rows of data.
I don't have a fully working solution, but my idea was to adapt the x-axis range based on the slider value instead of re-using the data for each frame (see example plot p_range_slider). This unfortunately doesn't provide us with the "Play"-button.
I thought it might be possible to use animation_slider() in a similar way but the steps argument passed to animation_slider() is not evaluated (see example plot p_animation_slider). The steps remain tied to the animation frames (as stated in ?animation_slider).
Update: this behaviour is intended by design see the sources:
# don't let the user override steps
slider$steps <- steps
Also building a subplot of both sharing the x-axis wasn't successful.
library(plotly)
DF <- data.frame(
n = 1:50,
x = seq(0, 12, length = 50),
y = runif(n = 50, min = 0, max = 10)
)
steps <- list()
for (i in seq_len(nrow(DF))) {
steps[[i]] <- list(
args = list("xaxis", list(range = c(0, i))),
label = i,
method = "relayout",
value = i
)
}
# Custom range slider -----------------------------------------------------
p_range_slider <- plot_ly(
DF,
x = ~ x,
y = ~ y,
type = "scatter",
mode = "markers"
) %>% layout(title = "Custom range slider",
xaxis = list(range = steps[[1]]$args[[2]]$range),
sliders = list(
list(
active = 0,
currentvalue = list(prefix = "X-max: "),
pad = list(t = 20),
steps = steps)))
p_range_slider
# Animation slider --------------------------------------------------------
p_animation_slider <- plot_ly(
DF,
x = ~ x,
y = ~ y,
type = "scatter",
mode = "markers",
frame = ~ n
) %>% layout(title = "Animation slider") %>% animation_slider(
active = 6,
currentvalue = list(prefix = "X-max: "),
pad = list(t = 20),
steps = steps # custom steps are ignored
)
p_animation_slider
# subplot(p_range_slider, p_animation_slider, nrows = 2, margin = 0.05, shareX = TRUE)
It seems for this approach to work animation_slider() would need to allow it's steps argument to perform custom actions (untied from the defined frames). Any other Ideas to approach this are highly appreciated.
Maybe it is possible to reproduce this approach for the python api using a filter (avoids axis-rescaling) in R? - Filter in R
Here is an example on how to use filter transform and a custom range slider in R, however, still no animation (without precomputing each frame):
DF <- data.frame(x = rep(1:10, 2), y = runif(20), group = rep(LETTERS[1:2], each = 10))
steps <- list()
for (i in seq_along(unique(DF$x))) {
steps[[i]] <- list(
args = list('transforms[0].value', i),
label = i,
method = "restyle",
value = i
)
}
p_filter_slider <- plot_ly(
DF,
x = ~ x,
y = ~ y,
color = ~ group,
type = "scatter",
mode = "lines+markers",
transforms = list(
list(
type = 'filter',
target = 'x',
operation = '<=',
value = ~ x
)
)
) %>% layout(title = "Custom filter slider",
xaxis = list(range = c(0.5, length(unique(DF$x))+0.5)),
sliders = list(
list(
active = 0,
currentvalue = list(prefix = "X-max: "),
pad = list(t = 20),
steps = steps))
)
p_filter_slider
Additional Infos:
animation_slider documentation
JS slider attributes
Related GitHub issue
RStudio Community question
Here is the same question on the plotly forum.
Had a similar problem. We had thousands of data points per minute, so as a first step I just made another column called "time_chunk" which just rounded the time to the minute.
Then I accumulated by the time_chunks instead of the very precise minute data (with decimal places). That gave me a more reasonable number of chunks.
The animation is not completely smooth but our data is approximately 20-40 minutes long, so it's reasonable and processes quickly.
So, theoretically:
fig <- fig %>%
mutate(time_chunk = floor(time_min))
fig <- accumulate_by(fig, ~ time_chunk)
I was using Highchart to plot some time series and wanted to add some annotation to the plot to highlight some key points. I knew putting the cursor on the graph can pop up the context, however, some automatic graph generation is needed and hence annotating is the best approach.
And I did that, with the last line in the code below. However, the effect is not what I expected. The text was located at the bottom left corner, not located at the right horizontal position yet the vertical position is right. The time series are created using xts library, which means the horizontal axis is simply the date data structure, nothing fancy. xValue is specified as the 900th element of all the time points which have a total length of 1018, so the 900th time point must be in the second half of the graph.
Anyone knows how I can put the annotation at the right location? Many thanks.
hc <- highchart(type = "stock") %>%
hc_title(text = "Some time series") %>%
hc_add_series(x, color='green', name="x", showInLegend = TRUE) %>%
hc_add_series(y, color='red', name="y", showInLegend = TRUE) %>%
hc_add_series(z, color='blue', name="z", showInLegend = TRUE) %>%
hc_navigator(enabled=FALSE) %>%
hc_scrollbar(enabled=FALSE) %>%
hc_legend(enabled=TRUE, layout="horizontal") %>%
hc_annotations(list(enabledButtons=FALSE, xValue = index(x)[900], yValue = -5, title =list(text = "Hello world! How can I make this work!")))
hc
The data can be roughly generated using the following script:
dt <- seq(as.Date("2014/1/30"), as.Date("2018/2/6"), "days")
dt <- dt[!weekdays(dt) %in% c("Saturday", "Sunday")]
n <- length(dt)
x <- xts(rnorm(n), order.by=dt)
y <- xts(rnorm(n), order.by=dt)
z <- xts(rnorm(n), order.by=dt)
Let's star with the #kamil-kulig example, this will be a little out of R world but I want to give some justification if you don't mind.
If we see annotations options is not a object but a list of object(s), so in highcharter is implemented the hc_add_annotation function.
Now, you are using a old version of highcharter. Highcharter devlopment version is using v6 of highchartsJS which made some changes: before the annotations.js was a pluging now is included as a module with some changes in the names of arguments.
Example I: Simple
The example by Kamil Kulig is replicated doing:
highchart(type = "stock") %>%
hc_add_annotation(
labelOptions = list(
backgroundColor = 'rgba(255,255,255,0.5)',
verticalAlign = 'top',
y = 15
),
labels = list(
list(
point = list(
xAxis = 0,
yAxis = 0,
x = datetime_to_timestamp(as.Date("2017/01/02")),
y = 1.5
),
text = "Some annotation"
)
)
) %>%
hc_xAxis(
minRange = 1
) %>%
hc_add_series(
pointStart = start,
pointInterval = day,
data = c(3, 4, 1)
)
Example II: With your data
Be careful in the way you add the x position. Highcharter include a datetime_to_timestamp function to convert a date into a epoch/timestap which is required for highcharts.
library(xts)
dt <- seq(as.Date("2014/1/30"), as.Date("2018/2/6"), "days")
dt <- dt[!weekdays(dt) %in% c("Saturday", "Sunday")]
n <- length(dt)
x <- xts(rnorm(n), order.by=dt)
y <- xts(rnorm(n), order.by=dt)
z <- xts(rnorm(n), order.by=dt)
highchart(type = "stock") %>%
hc_title(text = "Some time series") %>%
hc_add_series(x, color='green', name="x", showInLegend = TRUE) %>%
hc_add_series(y, color='red', name="y", showInLegend = TRUE) %>%
hc_add_series(z, color='blue', name="z", showInLegend = TRUE) %>%
hc_navigator(enabled=FALSE) %>%
hc_scrollbar(enabled=FALSE) %>%
hc_legend(enabled=TRUE, layout="horizontal") %>%
hc_add_annotation(
labels = list(
list(
point = list(
xAxis = 0,
yAxis = 0,
x = datetime_to_timestamp(as.Date(index(x)[900])),
y = 1
),
text = "Hello world! How can I make this work!"
)
)
)