Toggle time series on/off with highcharts R - r

I am using highstock with highcharts R api. https://jkunst.com/highcharter/articles/stock.html
I have multiple time series on my graph and I would like a way to toggle them on and off like in the usual hchart() function. Below is a reproducible example. I would like to be able to toggle on and off the blue line.
library(quantmod)
library(highcharter)
library(tidyverse)
getSymbols(c("SPY", 'QQQ'))
highchart(type = "stock") %>%
hc_title(text = "Charting some Symbols") %>%
hc_subtitle(text = "Data extracted using quantmod package") %>%
hc_add_series(Cl(SPY), id = "spy", name = "SPY") %>%
hc_add_series(Cl(QQQ), id = "qqq", name = "QQQ")

Related

Cannot combine a Ribbon in highcharter (R) with normal line series

I am trying to produce a ribbon on my highcharter chart (roughly following is there an equivalent to geom_ribbon in highcharter?).
However, the following example to produce a highcharter graph in R produces an error:
library(quantmod)
library(dplyr)
library(highcharter)
getSymbols("VOD")
bb_data = BBands(Cl(VOD), n=20)
highchart(type = "stock") %>%
hc_add_series(bb_data, type = "arearange", hcaes(low = dn, high=up))
The error is:
Error: 'hcaes(low = dn, high = up)' argument is not named in hc_add_series
I have think this is because it is a time series object (xts).
It works if I cast it to a data.frame, but then I lose the date.
highchart(type = "stock") %>%
hc_add_series(as.data.frame(bb_data), type = "arearange", hcaes(low = dn, high=up))
I cannot combine it to with the moving average or price data as I would wish, as the ribbon is then missing from the subsequent plot:
highchart(type = "stock") %>%
hc_add_series(Cl(VOD), name = "VOD") %>%
hc_add_series(bb_data$mavg, name = "20d MA") %>%
hc_add_series(as.data.frame(bb_data), type = "arearange", hcaes(low = dn, high=up))
ok, so I had to first extract the date from the time series object and bind it with the time series object to form a data frame or data table and then plot using that.
bb_data2 = cbind(date = as.Date(index(bb_data)), data.table(bb_data))
highchart(type = "stock") %>%
hc_add_series(bb_data2, type = "arearange", hcaes(x=date, low = dn, high=up)) %>%
hc_add_series(Cl(VOD), name = "VOD") %>%
hc_add_series(bb_data$mavg, name = "20d MA")

Interactive chart with r2d3 and shiny app

I am trying to add an interactive bar chart to my Shiny app, using r2d3 package. I have a dataset like this dummy sample containing date, id and motion column just for reference:
df <- data.frame(stringsAsFactors=FALSE,
date = c("2019-08-06", "2019-08-07", "2019-08-08", "2019-08-09",
"2019-08-10", "2019-08-06", "2019-08-07", "2019-08-08",
"2019-08-09", "2019-08-10"),
id = c("18100410-1", "18100410-1", "18100410-1", "18100410-1",
"18100410-1", "18100496-1", "18100496-1", "18100496-1",
"18100496-1", "18100496-1"),
useage = c(16.43, 15.78, 14.43, 15.68, 15.5, 17.08, 0, 0, 14.78, 14.57)
) %>%
mutate(date = readr::parse_date(date, format = "%Y-%m-%d"))
My aim is to have an app that user can select each id from the right menu and then we have a bar chart shows usage hours per day as a bar chart ( here is dummy example).
I have tried this for my bar plot chart section, but obviously, I am missing something here. Any help would be greatly appreciated
bar_graphD3=reactive({
grouped <- ifelse(input$id != "ALL", expr(date), expr(id), expr(usage))
data <- sel_data() %>%
group_by(!!grouped) %>%
collect(usage) %>%
mutate(
y = n,
x = !!grouped
) %>%
select(x, y)
data <- data %>%
mutate(label = x)
r2d3(data, "bar_plot_sample.js")
})

Using ggplotly rangeslider for interactive relative performance (stock returns)

I am trying to make an interactive stock performance plot from R. It is to compare the relative performance of several stocks. Each stock's performance line should start at 0%.
For static plots I would use dplyr group_by and mutate to calculate performance (see my code).
With ggplot2 and plotly/ggplotly, rangeslider() allows to interactively select the x-axis range. Now I'd like performance to be starting at 0 from any start range selected.
How can I either move the dplyr calculation into the plotting or have a feedback loop to recalculate as the range is changed?
Ideally it should be usable in static RMarkdown HTML. Alternatively I'd also switch to Shiny.
I tried several options for rangeslider. Also I tried with ggplot stat_function but could not achieve the desired result. Also I found dygraphs which has dyRangeSelector. But also here I face the same problem.
This is my code:
library(plotly)
library(tidyquant)
stocks <- tq_get(c("AAPL", "MSFT"), from = "2019-01-01")
range_from <- as.Date("2019-02-01")
stocks_range <- stocks %>%
filter(date >= range_from) %>%
group_by(symbol) %>%
mutate(performance = adjusted/first(adjusted)-1)
p <- stocks_range %>%
ggplot(aes(x = date, y = performance, color = symbol)) +
geom_line()
ggplotly(p, dynamicTicks = T) %>%
rangeslider(borderwidth = 1) %>%
layout(hovermode = "x", yaxis = list(tickformat = "%"))
If you do not want to use shiny, you can either use the dyRebase option in dygraphs, or you have to insert custom javascript code in plotly. In both examples, I rebase to one, not zero.
Option 1: with dygraphs
library(dygraphs)
library(tidyquant)
library(timetk)
library(tidyr)
stocks <- tq_get(c("AAPL", "MSFT"), from = "2019-01-01")
stocks %>%
dplyr::select(symbol, date, adjusted) %>%
tidyr::spread(key = symbol, value = adjusted) %>%
timetk::tk_xts() %>%
dygraph() %>%
dyRebase(value = 1) %>%
dyRangeSelector()
Note that `dyRebase(value = 0) does not work.
Option 2: with plotly using event handlers. I try to avoid ggplotly, hence my plot_ly solution. Here the time selection is just by zooming, but I think it can be done by a range selector as well. The javascript code in onRenderRebaseTxt rebases every trace to the first visible data point (taking care of possible missing values). It is only called with the relayout event, hence the first rebasing must be done before the plot.
library(tidyquant)
library(plotly)
library(htmlwidgets)
library(dplyr)
stocks <- tq_get(c("AAPL", "MSFT"), from = "2019-01-01")
pltly <-
stocks %>%
dplyr::group_by(symbol) %>%
dplyr::mutate(adjusted = adjusted / adjusted[1L]) %>%
plotly::plot_ly(x = ~date, y = ~adjusted, color = ~symbol,
type = "scatter", mode = "lines") %>%
plotly::layout(dragmode = "zoom",
datarevision = 0)
onRenderRebaseTxt <- "
function(el, x) {
el.on('plotly_relayout', function(rlyt) {
var nrTrcs = el.data.length;
// array of x index to rebase to; defaults to zero when all x are shown, needs to be one per trace
baseX = Array.from({length: nrTrcs}, (v, i) => 0);
// if x zoomed, increase baseX until first x point larger than x-range start
if (el.layout.xaxis.autorange == false) {
for (var trc = 0; trc < nrTrcs; trc++) {
while (el.data[[trc]].x[baseX[trc]] < el.layout.xaxis.range[0]) {baseX[trc]++;}
}
}
// rebase each trace
for (var trc = 0; trc < nrTrcs; trc++) {
el.data[trc].y = el.data[[trc]].y.map(x => x / el.data[[trc]].y[baseX[trc]]);
}
el.layout.yaxis.autorange = true; // to show all traces if y was zoomed as well
el.layout.datarevision++; // needs to change for react method to show data changes
Plotly.react(el, el.data, el.layout);
});
}
"
htmlwidgets::onRender(pltly, onRenderRebaseTxt)
I found a solution with plotly_relayout which reads out the visible x-axis range. This is used to recompute the performance. It works as a Shiny app. Here's my code:
library(shiny)
library(plotly)
library(tidyquant)
library(lubridate)
stocks <- tq_get(c("AAPL", "MSFT"), from = "2019-01-01")
ui <- fluidPage(
titlePanel("Rangesliding performance"),
mainPanel(
plotlyOutput("plot")
)
)
server <- function(input, output) {
d <- reactive({ e <- event_data("plotly_relayout")
if (is.null(e)) {
e$xaxis.range <- c(min(stocks$date), max(stocks$date))
}
e })
stocks_range_dyn <- reactive({
s <- stocks %>%
group_by(symbol) %>%
mutate(performance = adjusted/first(adjusted)-1)
if (!is.null(d())) {
s <- s %>%
mutate(performance = adjusted/nth(adjusted, which.min(abs(date - date(d()$xaxis.range[[1]]))))-1)
}
s
})
output$plot <- renderPlotly({
plot_ly(stocks_range_dyn(), x = ~date, y = ~performance, color = ~symbol) %>%
add_lines() %>%
rangeslider(start = d()$xaxis.range[[1]], end = d()$xaxis.range[[2]], borderwidth = 1)
})
}
shinyApp(ui = ui, server = server)
Definign the start/end of the rangeslider only works with plot_ly, not with a ggplot object converted by ggplotly. I am unsure if this is a bug, therefore opened an issue on Github.

Library (rChart) and internal widget saving in power bi custom visual

I am creating a custom visual for power bi using rcharts but when it goes for saving the widget it say returns me an error. This is my code:
source('./r_files/flatten_HTML.r')
libraryRequireInstall("plotly")
library(rCharts)
library(fmsb)
library(plyr)
library(dplyr)
library(reshape2)
library(RColorBrewer)
dataset = Values
dataset$Nome <- as.factor(dataset$Nome)
dataset$TesteExercise <- as.factor(dataset$TesteExercise)
dataset$PlayerPosition <- as.factor(dataset$PlayerPosition)
pospassmatrix1 <- dataset %>%
group_by(TesteExercise) %>%
summarise(ValueTotal1 = sum(Value))
pospassmatrix2 <- dataset %>%
group_by(PlayerPosition) %>%
summarise(ValueTotal2 = sum(Value))
plot <- Highcharts$new()
plot$chart(polar = TRUE, type = "line",height=500)
plot$xAxis(categories=pospassmatrix1$TesteExercise, tickmarkPlacement= 'on', lineWidth= 0)
plot$yAxis(gridLineInterpolation='circle', lineWidth= 0,endOnTick=T,tickInterval=10)
plot$series(data = pospassmatrix1$ValueTotal1,name = "sum1", pointPlacement="on")
plot$series(data = pospassmatrix2$ValueTotal2,name = "sum2", pointPlacement="on")
####################################################
p = plot
############# Create and save widget ###############
internalSaveWidget(p, 'out.html');
####################################################
Anyone has a clue of how I can use rchart graphs as a widget or transform this in a ggplot adaptation ?
pbi error

Highcharter setExtremes Function in R

I'm trying to set extremes on a time series stock chart that corresponds to a user pushing a button. Here's the breakdown:
User clicks on a button on the top of the chart (I have edited the "All", "1M", "3M" buttons typically at the top)
When the button is clicked, a custom area on the xAxis (2 months) is zoomed in on. For example, October 1st through December first. Right now, the zoom goes to the end of the graph.
It's very similar to the below link.
X Axis Set Extremes
My R code right now for the button is the following:
hc_rangeSelector(buttons=list(list(type='month', text='New', count=2)))
This says I am looking for a month interval zoom, the text is "New", and it shows 2 months. I've seen that setExtremes is the function i'm looking for but I haven't seen it implemented using R.
You could place a JavaScript function in chart.events.load option in Highcharter. Using Renderer you could add a button that will use setExtremes function on click.
Demo in JSFiddle (without Highcharter nor `R, data is different, but functionality of the button is the same): http://jsfiddle.net/e69eLm6q/
Code to run in R:
library("quantmod")
usdjpy <- getSymbols("USD/JPY", src = "oanda", auto.assign = FALSE)
eurkpw <- getSymbols("EUR/KPW", src = "oanda", auto.assign = FALSE)
hc <- highchart(type = "stock") %>%
hc_title(text = "Charting some Symbols") %>%
hc_add_series(data = usdjpy, id = "usdjpy", pointInterval = 36000000) %>%
hc_add_series(data = eurkpw, id = "eurkpw", pointInterval = 36000000) %>%
hc_rangeSelector(buttons=list(list(type='month', text='New', count=2))) %>%
hc_chart(
events = list(
load = JS("function(){
var chart = this;
chart.renderer.button('do stuff',200, 100)
.attr({
zIndex: 3
})
.on('click', function () {
chart.xAxis[0].setExtremes(Date.UTC(1970, 4, 1), Date.UTC(1970, 6, 1));
})
.add();
}")
)
)
hc

Resources