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
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..
I'm trying to add horizontal lines to an R plotly heatmap that will be located between several of the heatmap's rows.
Here's an example data.frame and a heatmap:
library(plotly)
set.seed(1)
df <- matrix(rnorm(18), nrow = 6, ncol = 3, dimnames = list(paste0("r",1:6),1:3)) %>%
reshape2::melt() %>%
dplyr::rename(row=Var1,col=Var2)
plot_ly(x = df$col, y = df$row,z = df$value,type = "heatmap")
Which gives:
Now suppose I want to add a horizontal line between "r2" and "r3" that runs across the entire heatmap, and a similar one between "r4" and "r5".
I don't know what should be the y location the corresponds to that.
I am able to get this done if my df$rows are integer/numeric rather than character:
library(plotly)
set.seed(1)
df <- matrix(rnorm(18), nrow = 6, ncol = 3, dimnames = list(1:6,1:3)) %>%
reshape2::melt() %>%
dplyr::rename(row=Var1,col=Var2)
plot_ly(x = df$col, y = df$row,z = df$value,type = "heatmap") %>%
add_lines(y = 2.5, x = c(min(df$col)-0.5,max(df$col)+0.5), line = list(color = "black",dash = "dot",size = 5),inherit = FALSE,showlegend = FALSE) %>%
add_lines(y = 4.5, x = c(min(df$col)-0.5,max(df$col)+0.5), line = list(color = "black",dash = "dot",size = 5),inherit = FALSE,showlegend = FALSE)
So my questions are:
Is there a way to place the horizontal lines between rows if the rows of the heatmap are character?
Is there a more compact way of adding multiple horizontal lines rather than explicitly having to code each one, as in my code above?
I am not sure if it would be possible to draw lines between two levels of a factor class.
As for your second question, we can use add_segments:
library(plotly)
set.seed(1)
df <- matrix(rnorm(18), nrow = 6, ncol = 3, dimnames = list(1:6,1:3)) %>%
reshape2::melt() %>%
dplyr::rename(row=Var1,col=Var2)
hdf <- data.frame(y1 = c(2.5, 4.5),
x1 = rep(min(df$col)-0.5, 2), x2 = rep(max(df$col)+0.5, 2))
plot_ly(x = df$col, y = df$row,z = df$value,type = "heatmap") %>%
add_segments(data =hdf , y=~y1, yend =~y1, x=~x1, xend =~x2,
line = list(color = "black",dash = "dot",size = 5),
inherit = FALSE,showlegend = FALSE)
I am trying to animate this test data.frame but the plotly plot doesn't even show up! The same code works for original plotly data though. I have doublechecked column's class and they are the same as plotly example. I am now puzzled why this fails.
This also works in marker mode but not in lines mode as you see.
total <- data.frame(replicate(4,sample(0:1, 100, rep=TRUE)))
names(total) <- c("date", "frame", "P1.10", "year")
total$date <- as.numeric(as.character(t(rbind(runif(100, min=2000, max=2010)))))
f.rank <- order(total$date)
total$frame[f.rank] <- 1:nrow(total)
total$P1.10 <- as.numeric(as.character(t(rbind(runif(100, min=1, max=10)))))
total$year <- 2000
p <- total %>%
plot_ly(
x = ~date,
y = ~P1.10,
frame = ~frame,
type = 'scatter',
mode = 'lines',
line = list(simplyfy = F)
) %>%
layout(
xaxis = list(
title = "Date",
zeroline = F
),
yaxis = list(
title = "P1.10",
zeroline = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
hide = T
) %>%
animation_button(
x = 1, xanchor = "right", y = 0, yanchor = "bottom"
)
You have ignored accumulate_by in the example. You also need an ID field. This is the same but using ggplot in combination.
set.seed(123)
library(plotly)
total <- data.frame(replicate(4,sample(0:1, 100, rep=TRUE)))
names(total) <- c("date", "frame", "P1.10", "year")
total$date <- as.numeric(as.character(t(rbind(runif(100, min=2000, max=2010)))))
f.rank <- order(total$date)
total$frame[f.rank] <- 1:nrow(total)
total$ID[f.rank] <- 1:nrow(total)
total$P1.10 <- as.numeric(as.character(t(rbind(runif(100, min=1, max=10)))))
total$year <- 2000
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)
}
total <- total %>%
accumulate_by(~ID)
p <- ggplot(total,aes(ID, P1.10, frame = frame)) +
geom_line()
p <- ggplotly(p) %>%
layout(
title = "",
yaxis = list(
title = "P1.10",
zeroline = F,
tickprefix = "$"
),
xaxis = list(
title = "Date",
zeroline = F,
showgrid = F
)
) %>%
animation_opts(
frame = 100,
transition = 0,
redraw = FALSE
) %>%
animation_slider(
currentvalue = list(
prefix = "Day "
)
)
How can I create a grouped bar chart in plotly that has a dropdown (or something else), so a viewer can select the grouping variable?
Working example:
library(dplyr)
library(plotly)
library(reshape2)
iris$Sepal.L <- iris$Sepal.Length %>%
cut(breaks = c(4,5,7,8),
labels = c("Length.a","Length.b","Length.c"))
iris$Sepal.W <- iris$Sepal.Width %>%
cut(breaks = c(1,3,5),
labels = c("Width.a","Width.b"))
# Get percentages
data1 <- table(iris$Species, iris$Sepal.L) %>%
prop.table(margin = 1)
data2 <- table(iris$Species, iris$Sepal.W) %>%
prop.table(margin = 1)
# Convert to df
data1 <- data.frame(Var1=row.names(data1), cbind(data1))
row.names(data1) <- NULL
data2 <- data.frame(Var1=row.names(data2), cbind(data2))
row.names(data2) <- NULL
plot_ly(
data = data1,
name = "Length.a",
x = ~Var1, y = ~Length.a,
type = "bar") %>%
add_trace(y=~Length.b, name = "Length.b") %>%
add_trace(y=~Length.c, name = "Length.c")
plot_ly(
data = data2,
name = "Width.a",
x = ~Var1, y = ~Width.a,
type = "bar") %>%
add_trace(y=~Width.b, name = "Width.b")
For example if I would like to select between viewing a plot with table(iris$Species, iris$Sepal.Length) and a plot with table(iris$Species, iris$Sepal.Width)
Bonus:
If it's easy; being able to interactively select the x variable as well would be cool, but not necessary.
You can find a solution here.
The idea is to plot your bar charts (with data1 and data2) all together and to make visible only one at a time.
items <- list(
list(label="Var1",
args=list(list(visible=c(T,T,T,F,F)))),
list(label="Var2",
args=list(list(visible=c(F,F,F,T,T))))
)
plot_ly(data=data1) %>%
add_bars(name = "Length.a",
x = ~Var1, y = ~Length.a, visible=T) %>%
add_bars(name = "Length.b",
x = ~Var1, y = ~Length.b, visible=T) %>%
add_bars(name = "Length.c",
x = ~Var1, y = ~Length.c, visible=T) %>%
add_bars(name = "Width.a",
x = ~Var1, y = ~Width.a, visible=F, data=data2, marker=list(color="#377EB8")) %>%
add_bars(name = "Width.b",
x = ~Var1, y = ~Width.b, visible=F, data=data2, marker=list(color="#FF7F00")) %>%
layout(
title = "Bar chart with drop down menu",
xaxis = list(title="x"),
yaxis = list(title = "y"),
showlegend = T,
updatemenus = list(
list(y = 0.9,
buttons = items)
))
This is a simple example of my data:
df1 <- structure(
list(
X = c(1250, 2500, 3750, 5000, 6250, 7500, 8750,
10000), Y = c(
0.112151039933887, 0.0792717402389768, 0.064716676038453,
0.0560426379617912, 0.0501241024200681, 0.0457556453076907, 0.0423607088430516,
0.0396242625334144
)
), .Names = c("X", "Y"), row.names = c(NA,-8L), class = "data.frame"
)
I want to create a smooth line with a tooltip that shows the values X and Y. This is what I'm doing right now
library(ggvis)
library(dplyr)
all_values <- function(x)
{
if(is.null(x)) return(NULL)
row <- smoothed[smoothed$id == x$id, ]
paste0(names(row), ": ", format(row), collapse = "<br />")
}
smoothed <- df1 %>% compute_smooth(Y ~ X) %>% rename(X=pred_ , Y=resp_)
smoothed$id <- 1:nrow(smoothed)
smoothed %>% ggvis(~X, ~Y, key:= ~id, stroke := "red", strokeWidth := 5) %>% layer_paths() %>%
add_tooltip(all_values, "hover")
The tooltip is always showing the same values.