I wish to plot a time series with dygraph inside a markdown document. I can select the time series from a list and plot it with plot() function but it does not work on the same way with dygraph function
library(dplyr)
library(tidyr)
library(dygraphs)
library(tseries)
df <- data.frame(date = c(as.yearmon(2018,1),as.yearmon(2018,1),as.yearmon(2018,2),as.yearmon(2018,2),
as.yearmon(2018,1),as.yearmon(2018,1),as.yearmon(2018,2),as.yearmon(2018,2)), sales = c(1,2,3,4),
cat_I = c("drink","drink","food","food","drink","drink","food","food"),
cat_II = c("cola","fanta","tomatoes","bananas","cola","fanta","tomatoes","bananas"))
cat <- data.frame(I = c("drink","drink","food","food"),
II = c("cola","fanta","tomatoes","bananas"))
ts <- list()
for(s in unique(cat$II)){
aux <- df %>% filter(cat_II==s) %>%
as.data.frame()
ts[[s]] <- ts(aux$sales,start=c(2018,1),frequency = 12)
}
selectInput("I", label = "category_I:",
choices = names(ts))
renderPlot({
plot(ts[[input$I]])
})
This works fine, but it doesn´t work when I try to plot with dygraph()
renderPlot({
dygraph(ts[[input$I]])
})
You should use dygraphs::renderDygraph instead of renderPlot
dygraphs::renderDygraph({
dygraph(ts[[input$I]])
})
Related
I want to plot the stock price time series for several stocks on individual plots. I've used plotfun but am unable to change to x-axis from Index to Date. I was wondering if I've missed something or is there better way to achieve this. Below is the code that I've created thus far and one of the two plotfun plots.
enter image description hereThanks for your time and consideration in advance.
library("quantmod")
library("ggplot2")
library("BatchGetSymbols")
library("magrittr")
library("broom")
library("dplyr")
library("zoo")
library("xts")
library("tidyverse")
library("tidyquant")
library("TSstudio")
library("rlang")
GetMySymbols <- function(x) {
getSymbols(x,
src ="yahoo",
from = "2010-07-01",
to = "2016-06-30",
auto.assign = FALSE)}
tickers <- c('TLS.AX','WOW.AX')
prices_Close <- map(tickers, GetMySymbols) %>% map(Cl) %>% reduce(merge.xts)
names(prices_Close) <- tickers
##plot.zoo(prices_Close, plot.type = 'multiple')
##plot.xts(prices_Close)
##plot.ts(df)
##df <- fortify(prices_Close)
mydf <- as.Data.frame(prices_Close)
plotfun <- function(col)
plot(mydf[,col], ylab = names(mydf[col]), type = "l")
par(ask = FALSE)
sapply(seq(1, length(mydf), 1), plotfun)
I've found the solution to the problem above:
for (i in 2:ncol(df)){
print(ggplot(df, aes_string(x = "Index", y= df[,i])) + geom_line() + xlab("Date"))
}
I wish to plot hierarchical time series which are contained inside a list as per the code bellow:
libraries and data creation
title: "prueba shiny"
runtime: shiny
output: html_document
---
library(dplyr)
library(tidyr)
library(dygraphs)
library(tseries)
df <- data.frame(date = c(as.yearmon(2018,1),as.yearmon(2018,1),as.yearmon(2018,2),as.yearmon(2018,2),
as.yearmon(2018,1),as.yearmon(2018,1),as.yearmon(2018,2),as.yearmon(2018,2)), sales = c(1,2,3,4),
cat_I = c("drink","drink","food","food","drink","drink","food","food"),
cat_II = c("cola","fanta","tomatoes","bananas","cola","fanta","tomatoes","bananas"))
cat <- data.frame(I = c("drink","drink","food","food"),
II = c("cola","fanta","tomatoes","bananas"))
creaition of individual time series for each end product (ts):
ts <- list()
for(s in unique(cat$II)){
aux <- df %>% filter(cat_II==s) %>%
as.data.frame()
ts[[s]] <- ts(aux$sales,start=c(2018,1),frequency = 12)
}
creation of a hierarchical list for endpoint products (ts_I_II) and grouped by categories
aux <- with(cat,split(II,I))
ts_I_II <- lapply(aux, function(x) ts[x])
catI_sales <- list()
for (s in unique(cat$I)){
catI_sales[[s]] <- do.call(cbind,ts_I_II[[s]])
}
desired plots:
1 - first plot contains all time series inside a category
aux <- do.call(cbind,ts_I_II$drink)
dygraph(aux, main = "sales by cat_II") %>% dyOptions(colors = RColorBrewer::brewer.pal(5, "Set2"))
2 - second plot is the end product time series
dygraph(ts_I_II$drink$cola, main = "sales by cat_II") %>% dyOptions(colors = RColorBrewer::brewer.pal(5, "Set2"))
I wish to create both plots by selecting the categories from a selectInput. I tried something like this without success:
selectInput("I", label = "category_I:",
choices = unique(cat$I), selected = cat$I[1])
selectInput("II", label = "II", choices = unique(cat$II))
plotOutput(outputId = "dy")
data <- reactive({
ts_I_II$input$II})
output$dy <- renderPlot({
dygraph(data)
selectInput("II", label = "category_II:",
choices = names(ts))
dygraphs::renderDygraph({
dygraph(ts[[input$II]])
})
selectInput("I", label = "category_I:",
choices = names(catI_sales))
dygraphs::renderDygraph({
dygraph(catI_sales[[input$I]])
})
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.
In the following shiny app, the plotly package is used to create an interactive correlation heat map. When individual tiles are clicked, the corresponding scatter plot appears. One can then download the individual scatters by clicking download plot as png. But is there a way to download all the possible scatter plots at once without having to click each individual tile and save each individual one? Thank you
library(plotly)
library(shiny)
# compute a correlation matrix
correlation <- round(cor(mtcars), 3)
nms <- names(mtcars)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat"),
plotlyOutput("scatterplot")
),
verbatimTextOutput("selection")
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
plot_ly(x = nms, y = nms, z = correlation,
key = correlation, type = "heatmap", source = "heatplot") %>%
layout(xaxis = list(title = ""),
yaxis = list(title = ""))
})
output$selection <- renderPrint({
s <- event_data("plotly_click")
if (length(s) == 0) {
"Click on a cell in the heatmap to display a scatterplot"
} else {
cat("You selected: \n\n")
as.list(s)
}
})
output$scatterplot <- renderPlotly({
s <- event_data("plotly_click", source = "heatplot")
if (length(s)) {
vars <- c(s[["x"]], s[["y"]])
d <- setNames(mtcars[vars], c("x", "y"))
yhat <- fitted(lm(y ~ x, data = d))
plot_ly(d, x = ~x) %>%
add_markers(y = ~y) %>%
add_lines(y = ~yhat) %>%
layout(xaxis = list(title = s[["x"]]),
yaxis = list(title = s[["y"]]),
showlegend = FALSE)
} else {
plotly_empty()
}
})
}
shinyApp(ui, server)
You can use webshot to capture a static image of Plotly's HTML output using the instructions here: https://plot.ly/r/static-image-export/
An example for loop below generates random scatter plots from mtcars.
library(plotly)
library(webshot)
## You'll need to run the function the first time if you dont't have phantomjs installed
#webshot::install_phantomjs()
ColumnOptions <- colnames(mtcars)
for (i in seq_len(5)){
xCol <- sample(ColumnOptions,1)
yCol <- sample(ColumnOptions,1)
ThisFileName <- paste0("Scatter_",xCol,"_vs_",yCol,".png")
plot_ly(x = mtcars[[xCol]], y = mtcars[[yCol]], type = "scatter", mode = "markers") %>%
export(., file = ThisFileName)
}
However, if you're going to be potentially doing this dozens of times, the amount of computation required to go through the following steps really adds up.
Generate a JSON plotly object from R
Use htmlwidgets/htmltoolsto generate a self-contained HTML web page
Render that HTML as a browser would see it with an external program --webshot
Use webshot to render an image of that HTML and save it as a PNG
This isn't really a reflection of plotly being slow, but to make an analogy it's kind've like using an airplane to travel half a mile -- the plane gets you there, but if you need to make that trip more than a few times you should probably consider a car.
The plotly loop above takes 27 seconds to render 5 PNG images, but the alternative method below using ggplot2 takes 1.2 seconds.
library(ggplot2)
ColumnOptions <- colnames(mtcars)
for (i in seq_len(5)){
xCol <- sample(ColumnOptions,1)
yCol <- sample(ColumnOptions,1)
ThisFileName <- paste0("ggplot2_Scatter_",xCol,"_vs_",yCol,".png")
ggplot() +
geom_point(aes(x = mtcars[[xCol]], y = mtcars[[yCol]])) +
labs(x = xCol, y = yCol) -> ThisPlot
ggsave(plot = ThisPlot, filename = ThisFileName)
}
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