Interactive chart with r2d3 and shiny app - r

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")
})

Related

Looping through a SharedData object for plotting addPolylines in Leaflet in R

How do you loop through a SharedData object in order to plot separate addPolylines to a Leaflet map in R?
I have dataset with distinct "routes", and I add them one by one in a for loop to not make them connected with each other. Next, I want them all to be responsive to a slider added by the Crosstalk package, but I am having issues looping through the SharedData$new object.
I have tried:
#Load libraries
library(dplyr); library(leaflet)
# An example of my data:
data <- data.frame(lon = c(12.42111, 12.42111, 12.41170, 12.42111, 12.39508, 12.39970, 12.42111, 12.39508),
lat = c(55.73615, 55.73615, 55.74155, 55.73615, 55.73074, 55.73871, 55.73615, 55.73074),
date = c("2020-03-28 12:46:29", "2020-03-28 13:20:42", "2020-03-28 13:50:47", "2020-03-28 18:33:44",
"2020-03-28 19:24:11", "2020-03-28 20:31:29", "2020-03-28 21:33:29", "2020-03-28 21:42:05"),
group = c(1, 1, 1, 1, 2, 2, 2, 2))
data$date <- as.POSIXct(data$date, format="%Y-%m-%d %H:%M:%S")
# Create leaflet map
temp_leaflet <- leaflet(data) %>% addTiles()
# for loop way of adding grouped routes
for (i in unique(factor(data$group))) {
temp_leaflet <- temp_leaflet %>%
addPolylines(data = data[data$group == i, ],
lng = ~lon, lat = ~lat, group = i)
}
temp_leaflet <- temp_leaflet %>%
hideGroup(unique(factor(data$group))) %>%
addLayersControl(
overlayGroups = unique(factor(data$group)),
options = layersControlOptions(collapsed = F))
So this is way I do it, but if I want to be able to change the two routes by time in a slider (date column) with the Crosstalk package, I simply can't figure out how to loop through a SharedData$new object, and group it, so that it is hidden by default.
Any thoughts on how to achieve this end?

Toggle time series on/off with highcharts 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")

Change the 'Frame' Label in Plotly Animation

TLDR: I want to label the frame slider with the three letter abbreviation instead of the number for each month.
I created a bar chart showing average snow depth each month over a 40 year period. I'm pulling my data from NOAA and then grouping by year and month using lubridate. Here is the code:
snow_depth <- govy_data$snwd %>%
replace_na(list(snwd = 0)) %>%
mutate(month_char = month(date, label = TRUE, abbr = TRUE)) %>%
group_by(year = year(date), month = month(date), month_char) %>%
summarise(avg_depth = mean(snwd))
The mutate function creates a column (month_char) in the data frame holding the three letter abbreviation for each month. The class for this column is an ordered factor.
The code below shows how I'm creating the chart/animation:
snow_plot <- snow_depth %>% plot_ly(
x = ~year,
y = ~avg_depth,
color = ~avg_temp,
frame = ~month,
text = ~paste('<i>Month</i>: ', month_char,
'<br><b>Avg. Depth</b>: ', avg_depth,
'<br><b>Avg. Temp</b>: ', avg_temp),
hoverinfo = 'text',
type = 'bar'
)
snow_plot
This code generates a plot that animates well and looks like this:
What I'd like to do is change the labels on the slider so instead of numbers, it shows the three letter month abbreviation. I've tried switching the frame to ~month_char which is the ordered factor of three letter month abbreviations. What I end up with, isn't right at all:
The data frame looks like:
I fear, with the current implementation of animation sliders in R's plotly API the desired behaviour can't be realized. This is due to the fact, that no custom animation steps are allowed (this includes the labels). Please see (and support) my GitHub FR for further information.
This is the best I was currently able to come up with:
library(plotly)
DF <- data.frame(
year = rep(seq(1980L, 2020L), each = 12),
month = rep(1:12, 41),
month_char = rep(factor(month.abb), 41),
avg_depth = runif(492)
)
fig <- DF %>%
plot_ly(
x = ~year,
y = ~avg_depth,
frame = ~paste0(sprintf("%02d", month), " - ", month_char),
type = 'bar'
) %>%
animation_slider(
currentvalue = list(prefix = "Month: ")
)
fig
(Edit from OP) Here's the resulting graph using the above code:

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")

Change y-axis in Dygraph to NOT be scientific notation

I have created a dygraph and want change the y-axis from scientific notation to decimal form.
This is what the code looks like:
df_xts <- xts(df$Var1,order.by=df$Date)
dygraph(A_xts,
main="DF - Var1",group="group1") %>%
dySeries("V1",label="Var1") %>%
dyOptions(stackedGraph = FALSE,colors=c("blue")) %>%
dyRangeSelector()
I'm guessing it would be placed under dyOptions but I'm not sure.
Thanks!
With my sample data it looks like this:
df_xts <- xts(runif(10) * 1e10, order.by = as.POSIXct(x = 1:10, origin = "2015-01-01") )
dygraph(df_xts, main="DF - Var1") %>%
dySeries("V1",label="Var1") %>%
dyOptions(maxNumberWidth = 20, stackedGraph = FALSE,colors=c("blue")) %>%
dyRangeSelector

Resources