I am trying to create an interactive Version of this plot:
So far I have the following code that creates an interactive plot but is not exactly what I am looking for:
#Create Data
library(ggvis)
set.seed(123)
tdat <- data.frame(group = rep(LETTERS[1:2], each = 50),
time = rep(seq(from = as.Date("2010-01-01"), length.out = 50, by = "day"), 2),
val = c(cumsum(rnorm(50)) + 100,
cumsum(rnorm(50)) + 100))
# ggvis Code
# Function for the tooltip
getData <- function(dat){
paste(paste("Time:", as.character(dat$time)),
paste("Group:", as.character(dat$group)),
paste("Value:", dat$val),
sep = "<br />")
}
# Visualisation
tdat %>% ggvis(~time, ~val, stroke = ~group) %>% layer_lines(strokeWidth := 1) %>%
layer_points(size = 1, fill = ~group) %>% add_tooltip(getData)
This results in the following plot:
There are however some issues:
1) I don't want to have points, just lines. Without the layer_points, there are no tooltips...
2) The variable time is a date but shows up as an integer. How can I fix the ugly number?
Thank you very much.
Edit
The field of the tooltip can be formated to date if it is coerced to a char before calling the ggvis function but it introduces other issues. For example, the x-axis does not shown properly.
I found a solution for both:
#Create Data
library(ggvis)
set.seed(123)
tdat <- data.frame(group = rep(LETTERS[1:2], each = 50),
time = rep(seq(from = as.Date("2010-01-01"), length.out = 50, by = "day"), 2),
val = c(cumsum(rnorm(50)) + 100,
cumsum(rnorm(50)) + 100))
For the getData function a bit of reverse engineering made me find the solution. Apparently if you divide the numeric date by 86400000 and add the origin of 1970-01-01 makes it work.
# ggvis Code
# Function for the tooltip
getData <- function(dat){
paste(paste("Time:", as.Date(dat$time/86400000, origin='1970-01-01') ),
paste("Group:", as.character(dat$group)),
paste("Value:", dat$val),
sep = "<br />")
}
As for the points, just setting the opacity to zero makes it work:
# Visualisation
tdat %>% ggvis(~time, ~val, stroke = ~group) %>% layer_lines(strokeWidth := 1) %>%
layer_points(size = 1, fill = ~group, opacity := 0) %>% add_tooltip(getData)
Ouput:
Sorry for the bad output but this was the best I could get via a print screen.
Related
I am trying to develop a Business Cycle Clock similar to https://kosis.kr/visual/bcc/index/index.do?language=eng.
I've already achieved most of the things I wanted to replicate, but I can't figure it out how to add these traces (for example, in the link above set speed to 10 and trace length to 5 and then click on 'Apply' to understand what I mean).
Does anyone have any idea how to implement it? It would make the "clock" much easier to read. Thanks in advance.
Reprocible example:
library(plotly)
library(dplyr)
library(magrittr)
variable <- rep('A',10)
above_trend <- rnorm(10)
mom_increase <- rnorm(10)
ref_date <- seq.Date('2010-01-01' %>% as.Date,
length.out = 10,by='m')
full_clock_db <- cbind.data.frame(variable, above_trend, mom_increase, ref_date)
freq_aux = 'm'
ct = 'Brazil'
main_title = paste0('Business Cycle Clock para: ', ct)
m <- list(l=60, r=170, b=50, t=70, pad=4)
y_max_abs = 2
x_max_abs = 5
fig = plot_ly(
data = full_clock_db,
x = ~mom_increase,
y = ~above_trend,
color = ~variable,
frame = ~ref_date,
text = ~variable,
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
) %>%
animation_opts( frame = 800,
transition = 500,
easing = "circle",
redraw = TRUE,
mode = "immediate") %>%
animation_slider(
currentvalue = list(prefix = "Período", font = list(color="red"))
)
fig
Another more elegant solution would be to rely on ggplot2 + gganimate:
library(ggplot2)
library(gganimate)
ggplot(full_clock_db, aes(x = mom_increase, y = above_trend)) +
geom_point(aes(group = 1L)) +
transition_time(ref_date) +
shadow_wake(wake_length = 0.1, alpha = .6)
You cna play with different shadow_* functions to find the one to your liking.
One way would be to use a line plot and repeat points as necessary. Here's an example as POC:
library(dplyr)
library(plotly)
e <- tibble(x = seq(-3, 3, 0.01)) %>%
mutate(y = dnorm(x)) %>%
mutate(iter = 1:n())
accumulate <- function(data, by, trace_length = 5L) {
data_traf <- data %>%
arrange({{ by }}) %>%
mutate(pos_end = 1:n(),
pos_start = pmax(pos_end - trace_length + 1L, 1L))
data_traf %>%
rowwise() %>%
group_map(~ data_traf %>% slice(seq(.x$pos_start, .x$pos_end, 1L)) %>%
mutate("..{{by}}.new" := .x %>% pull({{by}}))) %>%
bind_rows()
}
enew <- e %>%
accumulate(iter, 100)
plot_ly(x = ~ x, y = ~ y) %>%
add_trace(data = e, type = "scatter", mode = "lines",
line = list(color = "lightgray", width = 10)) %>%
add_trace(data = enew, frame = ~ ..iter.new,
type = "scatter", mode = "lines") %>%
animation_opts(frame = 20, 10)
The idea is that for each step, you keep the trace_length previous steps and assign them to the same frame counter (here ..iter.new). Then you plot lines instead of points and you have a sort of trace..
Hi and thanks for reading me
I'm working with a bar chart on R with the Echarts4r package, but I want to do a waterfall chart and I don't find an option to do a plot like the following on the image:
It's possible to do this chart type? The code I'm using for now is the following:
library(echarts4r)
df <- data.frame(
var = sample(LETTERS, 5),
value = rnorm(5, mean = 200, sd = 100)
)
df |>
e_charts(var) |>
e_bar(value)
Not sure whether echarts4r offers an option out of the box but with some data wrangling you could achieve your result as a stacked bar chart like so:
Disclaimer: I borrowed the basic idea from here.
library(echarts4r)
library(dplyr)
set.seed(42)
df <- data.frame(
var = sample(LETTERS, 5),
value = rnorm(5, mean = 200, sd = 100)
)
df |>
mutate(bottom = cumsum(dplyr::lag(value, default = 0)),
bottom = ifelse(value < 0, bottom + value, bottom),
top = abs(value)) |>
e_charts(var) |>
e_bar(bottom, stack = "var", itemStyle = list(color = "transparent", barBorderColor = "transparent")) |>
e_bar(top, stack = "var")
The code output is a plot that I would like it be responsive, to adjust according to window dimension.
Using just ggplot gives me the result desired but I want to use the interactive tooltip of plotly, but when I do the figure is not responsive.
Is there any fix that it could work ? The code is bellow. I really appreciate any help !
library(dplyr)
library(ggplot2)
library(lubridate)
library(plotly)
df <- data.frame(matrix(c("2017-09-04","2017-09-05","2017-09-06","2017-09-07","2017-09-08",103,104,105,106,107,17356,18022,17000,20100,15230),ncol = 3, nrow = 5))
colnames(df) <- c("DATE","ORDER_ID","SALES")
df$DATE <- as.Date(df$DATE, format = "%Y-%m-%d")
df$SALES <- as.numeric(as.character(df$SALES))
df$ORDER_ID <- as.numeric(as.character(df$ORDER_ID))
TOTALSALES <- df %>% select(ORDER_ID,DATE,SALES) %>% mutate(weekday = wday(DATE, label=TRUE)) %>% mutate(DATE=as.Date(DATE)) %>% filter(!wday(DATE) %in% c(1, 7) & !(DATE %in% as.Date(c('2017-01-02','2017-02-27','2017-02-28','2017-04-14'))) ) %>% group_by(day=floor_date(DATE,"day")) %>% summarise(sales=sum(SALES)) %>% data.frame()
TOTALSALES <- ggplot(TOTALSALES ,aes(x=day,y=sales,text=paste('Vendas (R$):', format(sales,digits=9, decimal.mark=",",nsmall=2,big.mark = "."),'<br>Data: ',format(day,"%d/%m/%Y"))))+ geom_point(colour = "black", size = 1)+stat_smooth() +labs(title='TOTAL SALES',x='dias',y='valor')+ scale_x_date(date_minor_breaks = "1 week")
m <- list(
l = 120,
r = 2,
b = 2,
t = 50,
pad = 4
)
TOTALSALES <- ggplotly(TOTALSALES,tooltip = c("text")) %>% config(displayModeBar = F) %>% layout(autosize = F, width = 1000, height = 500, margin = m,xaxis = list(
zeroline = F
),
yaxis = list(
hoverformat = '.2f'
))
TOTALSALES
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!"
)
)
)