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)
))
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 must design a graph that accumulates variables as they are added in Shiny R using plotly.
For example, if I graph the variable x with respect to the date t with a select input, I add the variable and it is located on the right side of the variable x, indicating with a separator that it is the variable y and so with as many variables are selected.
This is my code:
library(shiny)
library(plotly)
library(dplyr)
set.seed(123)
df <- data.frame(x = seq.Date(as.Date("2000/1/1"), by = "month", length.out = 100),
cat = sample(c("m1","m2","m3"),100, replace = TRUE),
a = cumsum(rnorm(100)),
b = rnorm(100),
c = rnorm(100),
d = rnorm(100))
ui <- fluidPage(
selectInput("x","Variable",names(df)[-1],NULL,TRUE),
selectInput("y", "category", unique(df$cat), NULL, TRUE),
numericInput("ls","limite superior",NULL,-100,100),
numericInput("li","limite superior",NULL,-100,100),
plotlyOutput("plot1")
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
req(input$y, input$x)
df <- df%>%
filter(cat %in% input$y)%>%
select(one_of("x",input$x))
estado <- ifelse(df[[2]]>input$ls,"red",
ifelse(df[[2]]<input$ls & df[[2]]>input$li,
"orange","green"))
df$estado <- estado
p <- plot_ly(df,
x = ~x,
y = ~df[[2]],
type = "scatter",
mode = "lines")
## Makers
p <- p %>%
add_trace(x = ~x,
y= df[[2]],
marker = list(color = ~estado, size = 20, symbol = "square"),
showlegend = FALSE)
## Lengends and labels
p <- p %>%
layout(legend = list(orientation = 'h'))%>%
layout(title = paste('Comportamiento de calidad de agua residual', input$estacion, sep=' '),
plot_bgcolor = "#e5ecf6",
xaxis = list(title = 'Fecha'),
yaxis = list(title = paste(input$x,"mg/l", sep=" ")))
print(p)
})
}
shinyApp(ui, server)
I need that when adding the variables a, b, c, d, the graph will be made just after the variable that was already there so that it looks something like this:
Use subplot and do function.
df %>%
group_by(category) %>%
do(p = plot_ly(...) %>% (plot_features...)) %>%
subplot(sharex= FALSE,sharey=TRUE, nrow=1, margin = 0.0001)
With plot feautures i mean all the deatils of the plot (markers, lines, colors, etc)
I am trying to generate multiple graphs in Plotly for 30 different sales offices. Each graph would have 3 lines: sales, COGS, and inventory. I would like to keep this on one graph with 30 buttons for the different offices. This is the closest solution I could find on SO:
## Create random data. cols holds the parameter that should be switched
l <- lapply(1:100, function(i) rnorm(100))
df <- as.data.frame(l)
cols <- paste0(letters, 1:100)
colnames(df) <- cols
df[["c"]] <- 1:100
## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly(df,
type = "scatter",
mode = "lines",
x = ~c,
y= ~df[[cols[[1]]]],
name = cols[[1]])
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[-1]) {
p <- p %>% add_lines(x = ~c, y = df[[col]], name = col, visible = FALSE)
}
p <- p %>%
layout(
title = "Dropdown line plot",
xaxis = list(title = "x"),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
## Add all buttons at once
buttons = lapply(cols, function(col) {
list(method="restyle",
args = list("visible", cols == col),
label = col)
})
)
)
)
print(p)
It works but only on graphs with single lines/traces. How can I modify this code to do the same thing but with graphs with 2 or more traces? or is there a better solution? Any help would be appreciated!
### EXAMPLE 2
#create fake time series data
library(plotly)
set.seed(1)
df <- data.frame(replicate(31,sample(200:500,24,rep=TRUE)))
cols <- paste0(letters, 1:31)
colnames(df) <- cols
#create time series
timeseries <- ts(df[[1]], start = c(2018,1), end = c(2019,12), frequency = 12)
fit <- auto.arima(timeseries, d=1, D=1, stepwise =FALSE, approximation = FALSE)
fore <- forecast(fit, h = 12, level = c(80, 95))
## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly() %>%
add_lines(x = time(timeseries), y = timeseries,
color = I("black"), name = "observed") %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 2], ymax = fore$upper[, 2],
color = I("gray95"), name = "95% confidence") %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 1], ymax = fore$upper[, 1],
color = I("gray80"), name = "80% confidence") %>%
add_lines(x = time(fore$mean), y = fore$mean, color = I("blue"), name = "prediction")
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[2:31]) {
timeseries <- ts(df[[col]], start = c(2018,1), end = c(2019,12), frequency = 12)
fit <- auto.arima(timeseries, d=1, D=1, stepwise =FALSE, approximation = FALSE)
fore <- forecast(fit, h = 12, level = c(80, 95))
p <- p %>%
add_lines(x = time(timeseries), y = timeseries,
color = I("black"), name = "observed", visible = FALSE) %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 2], ymax = fore$upper[, 2],
color = I("gray95"), name = "95% confidence", visible = FALSE) %>%
add_ribbons(x = time(fore$mean), ymin = fore$lower[, 1], ymax = fore$upper[, 1],
color = I("gray80"), name = "80% confidence", visible = FALSE) %>%
add_lines(x = time(fore$mean), y = fore$mean, color = I("blue"), name = "prediction", visible = FALSE)
}
p <- p %>%
layout(
title = "Dropdown line plot",
xaxis = list(title = "x"),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
## Add all buttons at once
buttons = lapply(cols, function(col) {
list(method="restyle",
args = list("visible", cols == col),
label = col)
})
)
)
)
p
You were very close!
If for example you want graphs with 3 traces,
You only need to tweak two things:
Set visible the three first traces,
Modify buttons to show traces in groups of three.
My code:
## Create random data. cols holds the parameter that should be switched
library(plotly)
l <- lapply(1:99, function(i) rnorm(100))
df <- as.data.frame(l)
cols <- paste0(letters, 1:99)
colnames(df) <- cols
df[["c"]] <- 1:100
## Add trace directly here, since plotly adds a blank trace otherwise
p <- plot_ly(df,
type = "scatter",
mode = "lines",
x = ~c,
y= ~df[[cols[[1]]]],
name = cols[[1]])
p <- p %>% add_lines(x = ~c, y = df[[2]], name = cols[[2]], visible = T)
p <- p %>% add_lines(x = ~c, y = df[[3]], name = cols[[3]], visible = T)
## Add arbitrary number of traces
## Ignore first col as it has already been added
for (col in cols[4:99]) {
print(col)
p <- p %>% add_lines(x = ~c, y = df[[col]], name = col, visible = F)
}
p <- p %>%
layout(
title = "Dropdown line plot",
xaxis = list(title = "x"),
yaxis = list(title = "y"),
updatemenus = list(
list(
y = 0.7,
## Add all buttons at once
buttons = lapply(0:32, function(col) {
list(method="restyle",
args = list("visible", cols == c(cols[col*3+1],cols[col*3+2],cols[col*3+3])),
label = paste0(cols[col*3+1], " ",cols[col*3+2], " ",cols[col*3+3] ))
})
)
)
)
print(p)
PD: I only use 99 cols because I want 33 groups of 3 graphs
I'm asking myself how to solve the following problem the most elegant. My data encompasses of some actual values and some proposed values. Right now I have data that looks like the reproducible example below:
library(plotly)
library(dplyr)
test_dt <- data.frame(Age=1:5, Key=c("Actuals", "Actuals", "Actuals", "Other", "Other") , Value=rnorm(5))
plot_ly(data = (test_dt %>% group_by(., Key) %>% arrange(desc(Age))),
x = ~Age,
y = ~Value,
type = 'scatter',
mode = 'lines',
color = ~Key,
linetype = ~Key
) %>% layout(
yaxis = list(
title = "SD"),
margin = list(top=100, b=50)
)
The output of this code looks like this:
how plot a dashed line where i drew the red arrow?
My solution so far is that I access the last value of my actuals and insert this value as a new row for my "other" line. But I don't think that's very elegant and sometimes, if no other values exist which can happen in my data depending on the inputs then I have a legend plotted for my "other" line without actually having one.
act_age_max <- filter(test_dt, Key=="Actuals") %>% .[["Age"]] %>% max
propval_names <- filter(test_dt, Key!="Actuals") %>% .[["Key"]]
last_actual <- filter(test_dt, Age==act_age_max, Key=="Actuals") %>% .[["Value"]]
acts_year <- filter(test_dt, Age==act_age_max, Key=="Actuals") %>% .[["Year"]]
append_dt <- data.frame(Age=act_age_max, Key=propval_names, Value=last_actual)
plot_data <- rbind(test_dt, append_dt)
plot_ly(data = (plot_data %>% group_by(., Key) %>% arrange(desc(Age))),
x = ~Age,
y = ~Value,
type = 'scatter',
mode = 'lines',
color = ~Key,
linetype = ~Key
) %>% layout(
yaxis = list(
title = "SD"),
margin = list(top=100, b=50)
)
I'd like to plot a large scatterplot using the highcharter package, but only allow mouse over on a few outliers. Is there a way to enable mouseTracking on one series but not the other?
df <- data.frame( x = rnorm(1000), y = rnorm(1000) )
df$sig <- ifelse( abs(df$x) > 2, "signif", "not")
library(highcharter)
hc <- highchart() %>%
hc_add_series_df(df, type = "scatter", group=sig)
Right now I can only disable mouse over on all points, but the hc_plotOptions says something about using a series array?
hc_plotOptions(hc, scatter = list( enableMouseTracking= FALSE ))
There are a lot of way to do what you want.
I think the simplest is use:
hchart(df, "scatter", hcaes(x, y, group = sig), enableMouseTracking = c(FALSE, TRUE))
(Note this is the development version of highcharter.)
Which is same as:
highchart() %>%
hc_add_series(data = df %>% filter(sig == "not"), type = "scatter", enableMouseTracking = FALSE) %>%
hc_add_series(data = df %>% filter(sig == "signif"), type = "scatter", enableMouseTracking = TRUE)
Or
highchart() %>%
hc_add_series(data = list_parse(df %>% filter(sig == "not")), type = "scatter", enableMouseTracking = FALSE) %>%
hc_add_series(data = list_parse(df %>% filter(sig == "signif")), type = "scatter", enableMouseTracking = TRUE)