We are trying to plot around 4000 data points from column a1 as bars using Highcharts. The colors of the a1 bars are based on the values of another column called a3. If a3 is negative on one row, the corresponding bar about a1 should be red, and positive a3 should give color green.
The problem is that the graph takes around 25 seconds to generate, and it takes 20 seconds just to print the graph. Could someone help us fix the code and make it faster? We tried to disable animations and shadows, but that did not help too much. Here is the code:
fun <- function(){
## Generate a random data set with roughly 4,000 lines
df <- as.data.frame(cbind(x = seq(1:3900),
a1 = rnorm(3900, 1000000, 2000000),
a2 = abs(rnorm(3900, 1000000, 2000000)),
a3 = rnorm(3900, 20000, 30000),
a4 = rnorm(3900, 1000, 500),
a5 = rnorm(3900, 0.01, 0.02)))
## Modify the data set to assign colors to each bar based on the values
## of a3. Green bars signify positive a3's and red bars signify
## negative a3's
df <- df %>%
mutate(a6 = cumsum(a3)) %>%
mutate(color = ifelse(a3 > 0,
"rgba(50,205,50,0.6)",
"rgba(223,83,83,0.6)")) %>%
mutate(y = a1,
a1 = comma_format()(round(a1, 0)),
a3 = comma_format()(round(a3, 0)),
a4 = comma_format()(round(a4, 4)),
a5 = comma_format()(round(a5, 0)),
a6 = comma_format()(round(a6, 0))
)
## Store the data in a list so that it is readable by Highcharts
input <- list()
input <- lapply(unname(split(df, seq(nrow(df)))), as.list)
## Draw the graph with Highcharts
a <- rCharts::Highcharts$new()
a$series(data = input,
name = "a1 values",
type = "column")
a$plotOptions(series = list(turboThreshold = 4000))
a$chart(zoomType = "xy", animation = FALSE)
a$addParams(width = 1000, height = 400, title = list(text = "The Slow Chart"))
a$tooltip(formatter = "#! function()
{return 'Date:<b> ' + this.point.x +
'</b> <br/>a1 values:<b> ' + this.point.a1 +
'</b> <br/>a3 values:<b> ' + this.point.a2 +
'</b> <br/>a4 values:<b> ' + this.point.a3 +
'</b> <br/>a5 values:<b> ' + this.point.a5 +
'</b> <br/>a6 values:<b> ' + this.point.a6} !#")
print(a)
}
Any help is appreciated!
First of all, please show what packages are you using in your code (dplyr, scales).
There's a boost module for highcharts. sadly rCharts dont include that module by default so you need to add manually.
By other hand. There is a new wrapper for highcharts called highcharter which have an implementation of this module. Using it dont take more than 1 second to chart the 3900 columns.
highchart2() %>%
hc_title(text = "Not so slow chart ;)") %>%
hc_subtitle(text = "Thanks boost module") %>%
hc_chart(zoomType = "x", animation = FALSE, type = "column") %>%
hc_plotOptions(series = list(turboThreshold = 4000)) %>%
hc_add_serie(data = input)
Check the speed/here:
http://rpubs.com/jbkunst/highcharts-too-slow-when-plotting-4000-bars-rcharts
Related
Issue
I'm trying to produce a visualisation using {echarts4r} that involves plotting points with labels displayed on the chart itself, where the labels are unrelated to the position of the points. This sounds like it should be simple, but so far I haven't found any viable method of doing this and I'm beginning to wonder if it's even possible.
Desired output
Here is a minimal example. I will use {ggplot2} to demonstrate what I'd (roughly) like to reproduce:
data <- data.frame(
date_eaten = as.Date(c("2020-01-01", "2020-01-02", "2020-01-03")),
tastiness = c(5, 7, 10),
fruit = c("apple", "orange", "mango")
)
data
#> date_eaten tastiness fruit
#> 1 2020-01-01 5 apple
#> 2 2020-01-02 7 orange
#> 3 2020-01-03 10 mango
library(ggplot2)
ggplot(data, aes(x = date_eaten, y = tastiness, label = fruit)) +
geom_point() +
geom_text(nudge_y = 0.2)
Attempt using e_labels()
This method is visually exactly what I want, however, it seems that there is no option to specify which columns to take the labels from.
library(echarts4r)
data %>%
e_chart(date_eaten) %>%
e_scatter(tastiness, symbol_size = 10) %>%
e_labels()
Attempt using e_mark_point()
This option allows for more customisation, however this is not really a viable solution as it is very clunky and doesn't strictly 'link back' to the original data:
data %>%
e_chart(date_eaten) %>%
e_scatter(tastiness, symbol_size = 10) %>%
e_mark_point(data = list(
xAxis = as.Date("2020-01-01"),
yAxis = 5,
value = "apple"
)) %>%
e_mark_point(data = list(
xAxis = as.Date("2020-01-02"),
yAxis = 7,
value = "orange"
)) %>%
e_mark_point(data = list(
xAxis = as.Date("2020-01-03"),
yAxis = 10,
value = "mango"
))
I think this is the solution. Currently I'm not sure exactly how it works as documentation is a bit limited, but it seems to work:
data %>%
e_chart(date_eaten) %>%
e_scatter(tastiness, symbol_size = 10, bind = fruit) %>%
e_labels(formatter = htmlwidgets::JS("
function(params) {
return(params.name)
}
"))
I have an R list that contains 2500 lists in it. Each of 2500 lists contain 1 vector and 2 values. For the sake of reproducibility, I subset a tiny version of the data so it looks something like this:
head(models, 1)
>$model_1
>$model_1$m
> [1] 0.01335775 0.01336487 0.01336805 0.01338025 0.01340532 0.01343117 0.01346120 0.01349530 0.01353788 > 0.01357654 0.01360668
>$model_1$Cab
>[1] 59.6774
>$model_1$LAI
>[1] 4.01739
>$model_2
>$model_2$m
> [1] 0.02367338 0.02360433 0.02352800 0.02346125 0.02339469 0.02333403 0.02325861 0.02317945 0.02310961 >0.02303802 0.02295710
>$model_2$Cab
>[1] 59.6774
>$model_2$LAI
>[1] 0.5523946
Now, I want to make a line plot (using ggplot2) whose x axis is values from 400 to 410 and y axis is the vector in each lists (models$model_1$m, models$model_2$m and so on.) Therefore, there will be a lot of lines in the plot. I also want to color (continuous coloring) each line with their respective models$model_2$Cab values and have a continuous legend showing each models$model_2$Cab value and its color.
For reproducibility (Please note that this is greatly simplified version of the original data):
> dput(head(models, 10))
list(model_1 = list(m = c(0.0133577497667816, 0.0133648693063468,
0.0133680481888036, 0.01338024983382, 0.0134053218864944, 0.0134311717034271,
0.0134612003419723, 0.0134953017438241, 0.0135378825635721, 0.0135765418166368,
0.0136066826886183), Cab = 59.6773970406502, LAI = 4.01739045299768),
model_2 = list(m = c(0.023673375903171, 0.0236043348551818,
0.0235280045196734, 0.0234612496831449, 0.0233946873132861,
0.0233340349230324, 0.0232586128971129, 0.0231794538902946,
0.0231096074536893, 0.023038021285693, 0.0229570982021948
), Cab = 59.6773970406502, LAI = 0.552394618641403), model_3 = list(
m = c(0.0138277418755234, 0.0138310132688916, 0.0138301891768216,
0.0138383905159343, 0.0138587906203227, 0.0138802253169266,
0.0139048786261519, 0.0139332011615252, 0.0139700189737812,
0.0140030367215791, 0.0140275202380309), Cab = 59.6773970406502,
LAI = 3.01987725977579), model_4 = list(m = c(0.017483089696901,
0.0174591709902523, 0.017429967081058, 0.0174099884420304,
0.0173976896061841, 0.0173882607103241, 0.0173752969257632,
0.0173632160871019, 0.0173599236031355, 0.0173536114293099,
0.0173384748063733), Cab = 59.6773970406502, LAI = 1.37503600459533),
model_5 = list(m = c(0.0182499047037402, 0.0182203724940146,
0.0181853063358603, 0.0181595102703982, 0.0181404648083386,
0.0181246681180869, 0.0181039409709977, 0.01808352264341,
0.0180719579429791, 0.018057532687598, 0.0180342187796566
), Cab = 59.6773970406502, LAI = 1.22529135635182), model_6 = list(
m = c(0.0158200567917405, 0.0158083674745268, 0.0157919331298277,
0.0157846269346119, 0.0157870246965916, 0.0157914665730281,
0.0157954117645301, 0.0158014906653224, 0.0158162176575737,
0.0158275775312257, 0.0158302513933357), Cab = 59.6773970406502,
LAI = 1.81571552453658), model_7 = list(m = c(0.0133628950691214,
0.0133699680411211, 0.0133730986417069, 0.0133852517083498,
0.0134102666346747, 0.0134360623898904, 0.0134660252680654,
0.0135000559061319, 0.0135425658393117, 0.013581155812944,
0.013611227528355), Cab = 59.6773970406502, LAI = 3.99643688124574),
model_8 = list(m = c(0.0183501671255408, 0.0183199017377111,
0.0182840698901064, 0.0182575139774255, 0.0182375872739662,
0.0182209588085648, 0.0181992175650369, 0.0181777101462036,
0.0181650648958527, 0.0181495798700031, 0.0181251977995322
), Cab = 59.6773970406502, LAI = 1.20735517669905), model_9 = list(
m = c(0.0143687162679524, 0.0143678440890305, 0.0143626995592654,
0.0143666036037224, 0.0143820089259476, 0.0143987279254991,
0.0144176359711743, 0.0144397860850458, 0.0144704682720878,
0.0144974726755733, 0.0145159061770205), Cab = 59.6773970406502,
LAI = 2.51320168699674), model_10 = list(m = c(0.0138736072820698,
0.0138765215672426, 0.0138753253418108, 0.0138831561248062,
0.0139031250366076, 0.0139241525443688, 0.0139483098566198,
0.0139760994306543, 0.0140123870383231, 0.0140448852992375,
0.0140688465774421), Cab = 59.6773970406502, LAI = 2.96397596054064))
What I want to achieve is something like this (but with a better-looking ggplot2):
This could be achieved like so:
Convert your list of lists to a list of dataframes.
Add a variable with your x-axis variable to each df
Bind the list of data frames by row
Plot, where I make use of scale_colour_gradientn(colors = rainbow(20)) to mimic your rainbow color scale.
library(dplyr)
library(ggplot2)
models <- lapply(models, as.data.frame) %>%
lapply(function(x) { x$x <- 400:410; x}) %>%
bind_rows(.id = "id")
ggplot(models, aes(x = x, y = m, color = LAI, group = id)) +
geom_line() +
scale_x_continuous(breaks = scales::pretty_breaks()) +
scale_colour_gradientn(colors = rainbow(20))
I want to make a 2 box plots with y being weight and x being the before and after. so two different boxplot will be displayed at the same time.
`rats_before = data.frame(
rat_num = paste0(rep("rat number",200),1:200),
weight = rweibull(200,shape= 10,scale = 20))
rats_after = data.frame(
rat_num = paste0(rep("rat number",200),1:200),
weight = rweibull(200,shape= 9,scale = 21))
rats = merge(rats_before,rats_after, by = c("rat_num"))`
i know the next part is not even close but it will give you a idea of what im trying to do.
rat_boxplot = qplot(y = weight, x = (rats_after, rats_before), geom = "boxplot", data = rats)
Or, if you want to do this in base R -
rats_before = data.frame(
rat_num = paste0(rep("rat number",200),1:200),
weight = rweibull(200,shape= 10,scale = 20))
rats_after = data.frame(
rat_num = paste0(rep("rat number",200),1:200),
weight = rweibull(200,shape= 9,scale = 21))
rats <- rbind(rats_before, rats_after)
rats$type <- c(rep("before", nrow(rats_before)), rep("after", nrow(rats_after)))
rats$type <- factor(rats$type)
rats$type <- relevel(rats$type, ref = 2)
boxplot(weight ~ type, data = rats)
You can add a column to each df ans userbind which will bind the rows of the two df instead of merge you can use. Then you simply have to use the aes of a ggplot.
rats_before$condition = "before"
rats_after$condition = "after"
rats = rbind(rats_before,rats_after)
ggplot(rats)+geom_boxplot(aes(condition,weight))
Hope I understood your question.
Tom
I wanted to see an exact output of a Highcharter plot side by side in RStudio Viewer if it possible, exactly showed in this reference: http://jkunst.com/highcharter/highcharts.html, So let me define it like this for a simple usage
highcharter_all_plot <- function(){
library(highcharter)
library(dplyr)
library(stringr)
library(purrr)
n <- 5
set.seed(123)
colors <- c("#d35400", "#2980b9", "#2ecc71", "#f1c40f", "#2c3e50", "#7f8c8d")
colors2 <- c("#000004", "#3B0F70", "#8C2981", "#DE4968", "#FE9F6D", "#FCFDBF")
df <- data.frame(x = seq_len(n) - 1) %>%
mutate(
y = 10 + x + 10 * sin(x),
y = round(y, 1),
z = (x*y) - median(x*y),
e = 10 * abs(rnorm(length(x))) + 2,
e = round(e, 1),
low = y - e,
high = y + e,
value = y,
name = sample(fruit[str_length(fruit) <= 5], size = n),
color = rep(colors, length.out = n),
segmentColor = rep(colors2, length.out = n)
)
print(head(df))
create_hc <- function(t) {
dont_rm_high_and_low <- c("arearange", "areasplinerange",
"columnrange", "errorbar")
is_polar <- str_detect(t, "polar")
t <- str_replace(t, "polar", "")
if(!t %in% dont_rm_high_and_low){
df <- df %>% dplyr::select(-e, -low, -high)
}
highchart() %>%
hc_title(text = paste(ifelse(is_polar, "polar ", ""), t),
style = list(fontSize = "15px")) %>%
hc_chart(type = t,
polar = is_polar) %>%
hc_xAxis(categories = df$name) %>%
hc_add_series(df, name = "Fruit Consumption", showInLegend = FALSE)
}
hcs <- c("line", "spline", "area", "areaspline",
"column", "bar", "waterfall" , "funnel", "pyramid",
"pie" , "treemap", "scatter", "bubble",
"arearange", "areasplinerange", "columnrange", "errorbar",
"polygon", "polarline", "polarcolumn", "polarcolumnrange",
"coloredarea", "coloredline") %>% map(create_hc)
return(hcs)
}
x <- highcharter_all_plot()
#Then plot can be accessed in by calling x[[1]], x[[2]], x[[3]]..
As far as my understanding of side by side plot, I only know of 2 these handy methods, which is:
1) Using par(mfrow)
par(mfrow=c(3,4)) -> (which only can by applied to base plot)
2) Using grid.arrange from gridExtra
library(gridExtra)
grid.arrange(x[[1]], x[[2]], x[[3]], x[[4]], nrow=2, ncol=2)
-> (Cannot work since x not a ggplot type)
So I wanted to know if there is a way that this can be applied? I am new using Highcharter
If you inspect the Highcharter website you provided, you will see that those charts are not sided by side using R, but they are just renderer in separate HTML containers and positioned by bootstrap (CSS). So, if you want to render your charts in an HTML environment, I suggest rendering every chart into a separate div.
But maybe Shiny is a tool you are looking for. Maybe this is a duplicate of Shiny rcharts multiple chart output
Maybe this will help you too: https://github.com/jbkunst/highcharter/issues/37
I'm new to rCharts, in fact this is my first attempt. So please forgive a naive question.
I'm trying to create a simple rCharts visual which has a only one horizontal line (X-axis) and no Y-axis. I want to be able to choose the length and each point in the line has mouseover which represents some data. Also I would like to add colors to some of the special points.
This seems very simple, but I'm having great difficulty in this.
library(rCharts)
age <- c(1:2000)
dot <- rep(1,2000)
name <- paste(letters[0], 1:2000, sep="")
df <- data.frame(age=age,dot=dot,name=name)
n1 <- nPlot(dot~age, data=df, type="scatterChart")
n1$chart(tooltipContent = "#! function(key,x,y,e){var d = e.series.values[e.pointIndex];return 'x:'+ x + 'y:' + y + 'name:' + d.name }!#")
n1
Now this will create a line with mouseover but the line in at y=1 and there are x and y axes also. I want just one line, something like a timeline with special events marked.
Thanks a lot.
Well, turning off the y-axis is fairly simple. I added some other ideas to the code.
library(rCharts)
age <- c(1:2000)
dot <- c(
rep(1,1000),
rep(2,1000)
)
name <- c(
rep(letters[1], 1000),
rep(letters[2], 1000)
)
df <- data.frame(age=age,dot=dot,name=name)
n1 <- nPlot(dot~age, data=df, group = "name", type="scatterChart")
n1$chart(
tooltipContent = "#! function(key,x,y,e){
var d = e.series.values[e.pointIndex]
return 'x:'+ x + 'y:' + y + 'name:' + d.name
}!#",
showYAxis = FALSE, #turns off y axis
forceY = c(0,4) #forces y axis to 0 min and 4 max
)
n1
While I think this solves the issue, I am anticipating some things. One is if you define each point, then the data will become large. We could change to lineChart to minimize data sent, but then the tooltip only shows on the points defined. I am sure there is a way to bind an event to the path to show a tooltip then also, but it is beyond my abilities. I would guess you might like the x to be a date format. I'll be happy to demo an example of that also if you would like.
n2 <- nPlot(
dot~age
, data=data.frame(
name = c(rep("A",2),rep("B",2)),
dot = c(1,1,2,2),
age = c(1,1000,1000,2000)
)
, group = "name"
, type="lineChart"
)
n2$chart(
tooltipContent = "#! function(key,x,y,e){
var d = e.series.values[e.pointIndex]
return 'x:'+ x + 'y:' + y + 'name:' + d.name
}!#",
showYAxis = FALSE, #turns off y axis
forceY = c(0,4) #forces y axis to 0 min and 4 max
)
n2
Here is the additional code based on the comments
require(dplyr)
require(magrittr)
require(rCharts)
data <- jsonlite::fromJSON('[
[5,
0, "a1"], [480, 0, "a2"], [250, 0, "a3"], [100, 0, "a4"], [330, 0, "a5"],
[410, 0, "a6"], [475,
0, "a7"], [25, 0, "a8"], [85, 0, "a9"], [220, 0, "a10"],
[600, 0, "a11"]
]') %>% as.data.frame(stringsAsFactors = F) %>%
set_colnames(c("x","y","name")) %>%
mutate(x = as.numeric(x)) %>%
mutate(y = as.numeric(y))
data$grp <- c(rep("A",3),rep("B",5),rep("Z",3))
n1 <- nPlot(
y~x
,group = "grp"
,data = data
,type="scatterChart"
,height=200
)
n1$chart(
tooltipContent = "#! function(key,x,y,e){
var d = e.series.values[e.pointIndex]
var mytip = [];
mytip.push('<h1>name:'+ d.name + '</h1>');
mytip.push('<p>x:' + x + '</p>');
mytip.push('<p>y:' + y + '</p>');
return mytip.join('');
}!#",
showYAxis = FALSE, #turns off y axis
forceY = c(-1,1) #forces y axis to 0 min and 4 max
,showDistX = TRUE #turn on markers on the x axis
,showDistY = FALSE
)
n1$yAxis(
showMaxMin = FALSE
,axisLabel = NULL
)
n1
note: there is a bug in the fisheye that interferes with the tooltip; we can remove to get tooltips to appear immediately
Let me know how this works.