When plotting a chart with quantmod's chartSeries() called from Shiny server, the technical indicators are added twice to the chart.
If the below code is executed from the console the results is as expected. When executed by the Shiny App server the RSI and MACD are added twice to the chart. Although the print statement only shows once.
getChart.raPortfolio <- function(obj) {
if(is.xts(obj$chart)) {
print("Was here!")
chart <- chartSeries(obj$chart,
name = obj$symbol,
theme = chartTheme("white"),
type = "line", TA=c(
addBBands(n = 50),
addMACD(fast = 12, slow = 26, signal = 9),
addRSI(n=14)
)
)
}
return(chart)
}
The problem was caused by the assign to chart object prior to return, which only caused an issue when called via Shiny (not when run on the console). Below behaves correctly, including when adding indicators.
getChart.raPortfolio <- function(obj) {
chartSeries(obj$data,
name = obj$symbol,
theme = chartTheme("white")
)}
Related
So I'm trying to write an html R markdown document with interactive shiny bits that allow the user to edit a graph and then download the results to a pdf. However, there is something catastrophically wrong with the way that I'm trying to do this because as soon as the html starts, it overwrites the original markdown file with the contents of the pdf - turning it into complete gibberish right in the editor.
I doubt that I've found a completely new way to fail at R but I haven't been able to find where anybody else has had this issue. Additionally, I've looked over the shiny reference material and I'm just going in circles at this point, so any help would be greatly appreciated.
I'm using Rstudio 1.0.44, rmarkdown 1.2 and shiny 0.14.2. A small (not)working example:
---
title: "Minimum Failing Example"
author: "wittyalias"
date: "December 5, 2016"
output: html_document
runtime: shiny
---
```{r echo = FALSE}
library(ggplot2)
today <- Sys.Date()
inputPanel(downloadButton("dnld", label = "Download pdf"))
renderPlot({
# Example code from http://www.cookbook-r.com/Graphs/Multiple_graphs_on_one_page_(ggplot2)/
p1 <<- ggplot(ChickWeight, aes(x=Time, y=weight, colour=Diet, group=Chick)) +
geom_line() +
ggtitle("Growth curve for individual chicks")
p1
})
reactive({
fname <- paste0("Chick Weight - ", today, ".pdf")
output$dnld <- downloadHandler(filename = fname,
content = makethepdf(file))
makethepdf <- function(fname) {
pdf(fname,
width = 14,
height = 8.5)
p1
dev.off()
}
})
```
EDIT: To be clear: I want the user to be able to download multiple pages of graphs, some of which will have different formatting. The user won't be downloading just a pdf version of the markdown document.
This happens because reasons I weren't able to identify makethepdf runs with the file = [name of the file]. Insert a print(fname) to see. The download handler isn't supposed to be inside an observer though. You need to have it outside on its own. I also failed to make pdf() dev.off() combination work for some reason so here's a working version below.
output$dnld = downloadHandler(filename = paste0("Chick Weight - ", today, ".pdf"),
content = function(file){
ggsave(file, plot = p1, width = 14, height = 8.5)
})
Use tempfile() and tempdir() to create a temporary file:
output$downloadReport = downloadHandler(
filename = function() {
normalizePath(tempfile("report_", fileext = ".docx"), winslash = "/")
},
content = function(file) {
out = rmarkdown::render("./report.Rmd",
output_file = file,
output_dir = tempdir(),
output_format = "pdf_document",
intermediates_dir = tempdir(),
envir = new.env(),
params = list( fontSize = 10)
)
})
I usually use a separate .Rmd template for my downloaded reports as the layout and text are usually similar but not identical to what works in an app.
I also find using parameters is a convenient way to pass input settings from my app to my report. See this RStudio post for details
Alright, so there are a number of problems with my code, but using some of the suggestions in the other answers I've been able to work it out.
The primary problem with this little document is that content in the downloadHandler is a function, but in my code I set content equal to the result of a function call. It looks like when the shiny app is first run it compiles content, thinking that it is a function, but actually ends up calling the function. It sends file as an arguement, which doesn't seem to exist except as a base function. Calling makethepdf with just file throws an error when I use it in the console, but for whatever reason in this app it just goes with the call, apparently with file = [name of the .Rmd] (just as OganM said).
To fix, change this:
output$dnld <- downloadHandler(filename = fname,
content = makethepdf(file))
to
output$dnld <- downloadHandler(filename = fname,
content = makethepdf)
To be clear: this code does not overwrite the .Rmd file if content calls makethepdf with any argument other than file. For instance, content = makethepdf(fnm)) causes the download button to display an object not found error and content = makethepdf(fname)) causes the download button to throw an attempt to apply non-function error when pressed.
My problem is very basic (I am a beginner user in R). I am trying to collect the value selected from a gradio widget (gwidgets2 package for R).
I am using a similar script as this simplified one :
U=vector(mode="character")
DF=function() {
Win=gbasicdialog(handler=function(h,...) {
T=svalue(A)
print(T)
# I can print but not assign the value using : assign (U,T, .GlobalEnv)
})
A<-gradio(c("1","2","3"), selected=1,container=Win,)
out <- visible(Win)
}
DF()
Using this script, I am able to print the value selected in the gradio widget, but when I try to assign this value to another variable passed to the global environment, I get an error.
It is strange as this structure of script works fine to collect values from other widgets (like gtable). What am I doing wrong ?
Thanks for the help.
I am not sure what goes wrong, but was able to run your code with a small change:
DF <- function() {
Win <- gbasicdialog(
handler = function(h, ...) {
.GlobalEnv$varT = svalue(A)
print(varT)
}
)
A <- gradio(c("1", "2", "3"), selected = 1, container = Win)
out <- visible(Win)
}
DF()
A small advice: avoid using the single letters T or F, as in your code T might be interpreted as TRUE and not object T.
I am using Shiny as an interface for viewing tables stored locally in a series of .RData files however I am unable to get the table to render.
My server code is like this:
output$table1 <- renderTable({
load(paste0(input$one,"/",input$two,".RData"))
myData})
On the ui side I am simply displaying the table in the main panel.
This other SO question suggests that the issue is that the environment that the data is loaded into goes away so the data isn't there to display. They suggest creating a global file and loading the .RData file in there, but I don't believe I will be able to load the data dynamically that way. Any guidance on how to use .RData files effectively within shiny would be appreciated.
Regards
I think you just need to move the load statement outside of the renderTable function. So you should have
load(paste0(input$one,"/",input$two,".RData"))
output$table1 <- renderTable({myData})
If you look at the help file for renderTable, the first argument is
expr: An expression that returns an R object that can be used with
xtable.
load does not return this.
I got around this by "tricking" R Shiny. I make a BOGUS textOutput, and in renderText, call a external function that, based in the input selected, sets the already globally loaded environments to a single environment called "e". Note, you MUST manually load all RDatas into environments in global.R first, with this approach. Assuming your data isn't that large, or that you don't have a million RDatas, this seems like a reasonable hack.
By essentially creating a loadEnvFn() like the below that returns a string input passed as input$datasetNumber, you can avoid the scoping issues that occur when you put code in a reactive({}) context. I tried to do a TON of things, but they all required reactive contexts. This way, I could change the objects loaded in e, without having to wrap a reactive({}) scope around my shiny server code.
#Global Environment Pre-loaded before Shiny Server
e = new.env()
dataset1 = new.env()
load("dataset1.RData", env=dataset1)
dataset2 = new.env()
load("dataset2.RData", env=dataset2)
dataset3 = new.env()
load("dataset3.RData", env=dataset3)
ui = fluidPage(
# Application title
titlePanel(title="View Datasets"),
sidebarLayout(
# Sidebar panel
sidebarPanel(width=3, radioButtons(inputId = "datasetNumber", label = "From which dataset do you want to display sample data?", choices = list("Dataset1", "Dataset2", "Dataset3"), selected = "Dataset2")
),
# Main panel
mainPanel(width = 9,
textOutput("dataset"), # Bogus textOutput
textOutput("numInEnv")
)
)
)
loadEnvFn = function(input) {
if (input$datasetNumber=="Dataset1") {
.GlobalEnv$e = dataset1
} else if (input$datasetNumber=="Dataset2") {
.GlobalEnv$e = dataset2
} else {
.GlobalEnv$e = dataset3
}
# Bogus return string unrelated to real purpose of function loadEnvFn
return(input$datasetNumber)
}
server = function(input, output, session) {
output$dataset = renderText(sprintf("Dataset chosen was %s", loadEnvFn(input))) # Bogus output
output$numInEnv = renderText(sprintf("# objects in environment 'e': %d", length(ls(e))))
}
shinyApp(ui, server)
I made a function that is performing some complex calculations via a for loop. In order to show progress, the function will print out the current progress via something like message(...), and the final outcome of this function is a data frame.
But when I implement this in Shiny, the for loop counter is printed only in the R console rather than the Shiny document as intended. Is there a way to showing the outputs in the R console in real time during executions?
A very minimal example is here. Notice that in the Shiny interface, the counter is not present.
foo <- function() {
ComplexResult = NULL # vector initiation
for(i in 1:5){
ComplexResult[i] = letters[i]
# At each stage of the for loop, we store some complex calculations
message(paste0("For loop counter is on i = ", i))
# This shows progress of the for loop, also other relevant messages if necessary.
Sys.sleep(0.1) # Comment this out to remove pauses during execution.
}
return(as.data.frame(ComplexResult))
}
runApp(shinyApp(
ui = fluidPage(
dataTableOutput("VeryFinalOutcome")
),
server = function(input,output, session) {
fooOutcome = foo()
output$VeryFinalOutcome = renderDataTable(fooOutcome) # This will only display the function output (i.e. the letters) in Shiny.
}
))
My attempt: the capture.output(foo(),type="message") function did not help. Even though it captured the messages successfully, but it can only be displayed after all execution. And there is a extra issue of not being able to store the actual foo() outputs.
Thanks
I am looking to add the custom interaction seen at http://dygraphs.com/gallery/#g/interaction under "Custom interaction model" into my Shiny web app.
As far as I understand it, this requires attaching some JS to the page and setting the interaction model on the graph:
interactionModel : {
'mousedown' : downV3,
'mousemove' : moveV3,
'mouseup' : upV3,
'click' : clickV3,
'dblclick' : dblClickV3,
'mousewheel' : scrollV3
}
However, interactionModel does not seem to be listed as a parameter in the dyOptions function on the R side.
Is there a way to work around this?
Update:
Looking at the source for dyOptions, it seems that options can be modified directly:
g <- dyGraph(series)
g$x$attr$option <- "Value"
However, setting the interactionModel here does not seem to work.
See: https://github.com/rstudio/dygraphs/blob/master/R/options.R
Update:
You can indeed set the options using:
g$x$attrs$option <- "Value" # Note that it is "attrs", not "attr"
This can be used to switch off the interaction mode:
graph$x$attrs$interactionModel <- "{}"
The remaining problem is passing JS function references via JSON to the page.
You can use the JS function to pass JavaScript over JSON to the client.
In ui.R:
tags$head(tags$script(src="interaction.js"))
In server.R:
g <- dygraph(series(), main = "Graph", xlab = "Date", ylab = "Amount") %>%
dySeries(label = "X")
g$x$attrs$interactionModel <- list(
mousedown = JS("downV3"),
mousemove = JS("moveV3"),
mouseup = JS("upV3"),
click = JS("clickV3"),
dblclick = JS("dblClickV3"),
mousewheel = JS("scrollV3"))