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)
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 am trying to figure out how to iterate through columns in a data table in R to graph in plotly. Not sure how to do this. Below is the code:
library(data.table)
library(plotly)
library(dplyr)
month_date = c("2019-01-01", "2019-01-02", "2019-01-03")
num_cars = c(100,201,168)
num_planes = c(10,15,17)
master = data.frame(month_date, num_cars, num_planes)
names(master)[2:3] %>%
lapply(function(z){
plot_ly(master,
x = ~month_date,
y = z,
type = 'scatter',
mode = 'lines')
})
Appreciate the help.
A WORKAROUND
I can get this to work below but I don't love using the index. If anyone has something more elegant, would be good:
2:3 %>%
lapply(function(z){
print(z)
plot_ly(master,
x = ~month_date,
y = ~master[,z],
type = 'scatter',
mode = 'lines')
})
Here is an option with for loop
plst <- vector('list', length(master)-1)
names(plst) <- names(master)[-1]
for(nm in names(plst)) {
plst[[nm]] <- plot_ly(master, x = ~ month_date, y = get(nm),
type = 'scatter', mode = 'lines')
}
-check the plots
plst$num_cars
plst$num_planes
Or using the OP's code, just change the 'z' with get(z)
names(master)[2:3] %>%
lapply(function(z){
plot_ly(master,
x = ~month_date,
y = get(z), # // or it can be master[[z]]
type = 'scatter',
mode = 'lines')
})
You can consider using subplot to combine plots after getting the data in long format.
library(plotly)
library(dplyr)
master %>%
tidyr::pivot_longer(cols = -month_date) %>%
group_by(name) %>%
group_map(~ plot_ly(data=., x = ~month_date,
y = ~value, type = "scatter", mode="lines")) %>%
subplot(nrows = 1, shareX = TRUE, shareY=FALSE)
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)
))
I want to put a specific line for each bar likes the following:
But, I can't. To do this, I have tried the following code to put a particular text at least, but it does not work anymore:
mydata <- data.frame(A=runif(1:10),
B=runif(1:10),
C=runif(1:10))
highchart() %>%
hc_chart(type = "column", inverted = TRUE) %>%
hc_title(text = "MyGraph") %>%
hc_yAxis(title = list(text = "Weights")) %>%
hc_plotOptions(column = list(
dataLabels = list(enabled = FALSE),
stacking = "normal",
enableMouseTracking = FALSE)
) %>%
hc_legend(layout="vertical") %>%
hc_tooltip(formatter = function(){ return("<b> test</b><br/>")},
useHtml = TRUE) %>%
hc_series(list(name="A",data=mydata$A),
list(name="B",data=mydata$B),
list(name="C",data=mydata$C))
My question is how can I add red lines into the bar chart for each bar line?
Here is a possible solution:
set.seed(1)
mydata <- data.frame(A=runif(1:10), B=runif(1:10), C=runif(1:10))
library(highcharter)
hc <- highchart() %>%
hc_chart(type = "column", inverted = TRUE) %>%
hc_title(text = "MyGraph") %>%
hc_yAxis(title = list(text = "Weights")) %>%
hc_plotOptions(column = list(
dataLabels = list(enabled = FALSE),
stacking = "normal", groupPadding=0,
enableMouseTracking = FALSE)
) %>%
hc_legend(layout="vertical") %>%
hc_tooltip(formatter = function(){ return("<b> test</b><br/>")},
useHtml = TRUE) %>%
hc_series(list(name="A",data=mydata$A),
list(name="B",data=mydata$B),
list(name="C",data=mydata$C))
# x position of red lines
linepos <- c(1.3, 0.7, 1.8, 1.2, 1.0, 1.6, 0.7, 1.7, 0.8, 1.1)
# height of red lines
lw <- 0.35
for (k in 1:length(linepos)) {
df <- data.frame(x=c(k-1-lw,k-1+lw),y=rep(linepos[k],2))
hc <- hc %>%
hc_add_series(data = df, type = 'line', marker=list(enabled=FALSE),
x = ~x, y= ~y, color='red', lineWidth=5, showInLegend=FALSE,
enableMouseTracking = FALSE)
}
hc
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)
)