I was wondering if there is a way in which its possible to integrate the manipulate package or gWidgetsManipulate package so that their outputs can be viewable/manipulable in the html/markdown output file, as I think that this would be extremely useful when developing reproducible interactive research reports. I know that googleVis has some functionality that allows it to be integrated with knitr so that the outputs go into the html file by using options like results='asis' but googleVis is currently quite restrictive in its capabilities when using sliders for example.
If the package outputs of manipulate or gWidgetsManipulate hasn't quite been integrated yet, would it be possible to suggest a workaround for the time being that will allow it to be viewed in the html file?
i.e. my current code in my Rmd file before running knitr-ing to html looks like the below...but I get the following errors.
```{r}
library(manipulate)
manipulate(plot(1:x), x = slider(5, 10))
```
with output
library(manipulate)
## Error: there is no package called 'manipulate'
manipulate(plot(1:x), x = slider(5, 10))
## Error: could not find function "manipulate"
so trying the package gWidgetsManipulate instead...
```{r}
library(gWidgetsManipulate)
manipulate(plot(1:x), x = slider(5, 10))
```
you get the error...
library("gWidgetsManipulate")
## Loading required package: gWidgets
manipulate(plot(1:x), x = slider(5, 10))
## Error: unable to find an inherited method for function ".gwindow", for signature "NULL"
I have tried to specify a guiToolkit to fix this error by using things like
options(guiToolkit="WWW")
but to no avail...
Any help would be greatly appreciated, thanks in advance
If you don't absolutely need to use the gwidgets, I have a solution with Rook and googleVis that does what you want: displaying an interactive chart in html.
The script for the slider: it contains a little javascript function to display the currently chosen value. It also submits the form at each change. You can easily change the min/max/... values here.
slider_script <- '
<input type="range" min="5" max="10" name="plot_max" value="%s" step="1" onchange="document.form1.submit(); showValue(this.value);" />
<span id="range">%s</span>
<script type="text/javascript">
function showValue(newValue)
{
document.getElementById("range").innerHTML=newValue;
}
</script>
'
We build the code of the web page. The structure is typical for rook: html code is written inside res$write().
### this script builds the webpage
webreport_app <- function(
){
newapp = function(env) {
req = Rook::Request$new(env)
res = Rook::Response$new()
# initialise variables for first execution
if (is.null(req$POST())){
plot_max <- 5
} else{
plot_max <- as.numeric(req$POST()[["plot_max"]])
}
res$write('<body style="font-family:Arial">')
res$write("<H3>My App</H3>")
res$write('<form name = "form1" method="POST">\n')
res$write('<br> Number of dots: \n')
res$write(sprintf(slider_script, plot_max, plot_max))
res$write('<br><input type="submit" name="Go!">\n</form>\n')
if (!is.null(req$POST())) {
# generate the plot
library(googleVis)
data_for_plot <- data.frame(x_var = 1:plot_max, y_var = 1:plot_max)
Scatter1 <- gvisScatterChart(data_for_plot)
# extract chart script
chart_script <- capture.output(print(Scatter1, 'chart'))
# write to html
res$write(paste(chart_script, collapse="\n"))
res$write("<br><br></body></html>")
}
res$finish()
}
return(newapp)
}
And finally launch the setup and launch the html server via Rook:
library(Rook)
# launch the web app
if (exists("report_server")){
report_server$remove(app, all = TRUE)
report_server$stop()
rm(report_server)
}
report_server = Rhttpd$new()
report_server$add(app = webreport_app(), name = "My_app")
report_server$start()
report_server$browse("My_app")
report_server$browse()
Related
I am able to create an Rmarkdown file and I'm trying to embed a shiny app into the html output. The interactive graph shows if I run the code in the Rmarkdown file. But in the html output it only shows a blank box. Can anybody help fix it?
Run the code in Rmarkdown file:
In the html output:
My Rmarkdown file (please add the three code sign at the end yourself somehow i cannot do here):
---
title: "Data Science - Tagging"
pagetitle: "Data Science - Style Tagging"
author:
name: "yyy"
params:
creation_date: "`r format(Sys.time(), c('%Y%m%d', '%h:%m'))`"
runtime: shiny
---
```{r plt.suppVSauto.week.EB, out.width = '100%'}
data <- data.frame(BclgID = c('US','US','US','UK','UK','UK','DE','DE','DE'),
week = as.Date(c('2020-06-28', '2020-06-21', '2020-06-14', '2020-06-28', '2020-06-21', '2020-06-14', '2020-06-28', '2020-06-21', '2020-06-14')),
value = c(1,2,3,1,2,2,3,1,1))
shinyApp(
ui <- fluidPage(
radioButtons(inputId = 'BclgID', label = 'Catalog',
choices = type.convert(unique(plot$BclgID), as.is = TRUE),
selected = 'US'),
plotOutput("myplot")
),
server <- function(input, output) {
mychoice <- reactive({
subset(data, BclgID %in% input$BclgID)
})
output$myplot <- renderPlot({
if (length(row.names(mychoice())) == 0) {
print("Values are not available")
}
p <- ggplot(mychoice(), aes(x=as.factor(week), y=value)) +
geom_line() +
labs(title = "test",
subtitle = "",
y="Value",
x ="Date") +
theme(axis.text.x = element_text(angle = 90)) +
facet_wrap( ~ BclgID, ncol = 1)
print(p)
}, height = 450, width = 450)
}
)
EDIT:
Coming back another year later in case anyone still finds this useful. Having done some more work with both shiny and rmarkdown so I understand both better, there isn't really a reason to use them together. Rmarkdown's advantage is being able to come up with a somewhat static pdf that is readable, where shiny is dynamic and requires input.
While my answer below works, if you're using shiny for a GUI, consider removing the rmarkdown portion of what you are writing. It probably isn't adding much/anything, and trying to use the two together can cause headaches.
Original answer below:
I see this was asked a long time ago, so you've probably moved on, but I ran into the same problem and this came up first, so I'll answer it in case anyone else runs into this problem.
I found the answer on this page:
https://community.rstudio.com/t/embedding-shiny-with-inline-not-rendering-with-html-output/41175
The short of it is shiny documents need to be run and not rendered. Rather than calling:
>rmarkdown::render("filename.rmd")
we need to call:
>rmarkdown::run("filename.rmd")
If you are inside Rstudio, it seems the "knit" function changes from render to run when using shiny in RMD.
This is a small sample of many separate analyses I want to run together, flagging each analysis with a heading generated in the function. The first heading outputs as expected, but the headings generated by the function do not. How can I get the headings generated by the function to format as html?
R version 3.3.2 (2016-10-31)
Platform: x86_64-apple-darwin13.4.0 (64-bit)
Running under: OS X El Capitan 10.11.6
RStudio 1.0.136
knitr 1.15.1
```{r initialize, echo=F, comment=NA}
htmPrint = function(htm) {
structure(htm, class='knit_asis')
}
doAnalysis = function(dat, depVar, indVar) {
print(htmPrint(paste0('<h3>AusMCP1 on ', indVar, '</h3>')))
eval(parse(text=paste0('print(summary(lm(', depVar, '~', indVar, ', data=dat)))')))
print(htmPrint('<hr>'))
}
demoData = data.frame(dep1=rnorm(100), dep2=rnorm(100), ind1=runif(100), ind2=runif(100), ind3=runif(100))
varDep = names(demoData)[1:2]
varInd = names(demoData)[3:5]
```
This is a small sample of many separate analyses I want to run together, flagging each analysis with a heading generated in the function.
I could use *results=asis* in the chunk command, but it produces
unwanted formatting and extraneous output in the analysis output.
```{r doAnalyses}
htmPrint('<h2>Begin analyses</h2>')
for (k in 1:length(varDep)) for (i in 1:length(varInd)) doAnalysis(demoData, varDep[k], varInd[i])
```
I think you'll have to use results = 'asis' and just alter you function to get the output that you want. I'm going to use some methods referenced in a previous question that make use of the package pander.
You don't have to use your htmPrint function as you can get the same functionality with cat and html tags. Then you'd just use print_lm instead of print and remove the summary, since you're getting nice tabular output.
```{r initialize, echo=F, comment=NA}
library(pander)
#Use the pander print method to print the model tables.
#You could use other package print methods as well.
print_lm <- function (x, ...) UseMethod("pander")
doAnalysis = function(dat, depVar, indVar) {
cat('<h3>AusMCP1 on ', indVar, '</h3>')
eval(parse(text=paste0('print_lm(summary(lm(', depVar, '~', indVar, ', data=dat)))')))
cat('<hr>')
}
demoData = data.frame(dep1=rnorm(100), dep2=rnorm(100), ind1=runif(100), ind2=runif(100), ind3=runif(100))
varDep = names(demoData)[1:2]
varInd = names(demoData)[3:5]
```
I use *results=asis* and changed the output of your doAnalysis function to create formatted output.
```{r doAnalyses, echo = FALSE, results='asis'}
cat('<h2>Begin analyses</h2>')
for (k in 1:length(varDep)) for (i in 1:length(varInd)) doAnalysis(demoData, varDep[k], varInd[i])
```
You could also do all of the modelling beforehand, and use the broom package to tidy all of your model summaries to your liking, then print them out using kable() or tabular print method of your choice.
I´m starting to play with plot.ly in R and I´m amazed with the possibilities to publish my graphs directly in html using htmlwidgets.
Until now I´m unable to save multiple widgets in the same html.
I have saved multiple widgets in stand-alone htmls and than combine it by hand in the html code, but I would like to be able to do it in R.
A simple example:
#graph
graph<- ggplot(df, aes(x = Data, y=tax))+ geom_bar(stat='identity')
gg <- ggplotly(graph)
# save as HtmlWigdet
htmlwidgets::saveWidget(as.widget(gg), "Index.html")
How can I parse multiple ggplotly objects to saveWidgets?
(This is my first question here in stackoverflow, hope I did it right! Regards!)
This is the function I adapted from bits and pieces of the htmltools package to save a tag list and then return an iframe tag. You can wrap multiple htmlwidgets with htmltools::tagList, and then use this function to save the whole bunch.
save_tags <- function (tags, file, selfcontained = F, libdir = "./lib")
{
if (is.null(libdir)) {
libdir <- paste(tools::file_path_sans_ext(basename(file)),
"_files", sep = "")
}
htmltools::save_html(tags, file = file, libdir = libdir)
if (selfcontained) {
if (!htmlwidgets:::pandoc_available()) {
stop("Saving a widget with selfcontained = TRUE requires pandoc. For details see:\n",
"https://github.com/rstudio/rmarkdown/blob/master/PANDOC.md")
}
htmlwidgets:::pandoc_self_contained_html(file, file)
unlink(libdir, recursive = TRUE)
}
return(htmltools::tags$iframe(src= file, height = "400px", width = "100%", style="border:0;"))
}
What is the use-case you're after? You may want to consider adding these graphs to a Flexdashboard (which is created in R Markdown). It's been my recent goto, combined with Plotly.
I have a shiny application that allows my user to explore a dataset. The idea is that the user explores the dataset, and any interesting things the user finds he will share with his client via email. I don't know in advance how many things the user will find interesting. So, next to each table or chart I have an "add this item to the report" button, which isolates the current view and adds it to a reactiveValues list.
Now, what I want to do is the following:
Loop through all the items in the reactiveValues list,
Generate some explanatory text describing the item (This text should preferably be formatted HTML/markdown, rather than code comments)
Display the item
Capture the output of this loop as HTML
Display this HTML in Shiny as a preview
write this HTML to a file
knitr seems to do exactly the reverse of what I want - where knitr allows me to add interactive shiny components in an otherwise static document, I want to generate HTML in shiny (maybe using knitr, I don't know) based on static values the user has created.
I've constructed a minimum not-working example below to try to indicate what I would like to do. It doesn't work, it's just for demonstration purposes.
ui = shinyUI(fluidPage(
title = "Report generator",
sidebarLayout(
sidebarPanel(textInput("numberinput","Add a number", value = 5),
actionButton("addthischart", "Add the current chart to the report")),
mainPanel(plotOutput("numberplot"),
htmlOutput("report"))
)
))
server = shinyServer(function(input, output, session){
#ensure I can plot
library(ggplot2)
#make a holder for my stored data
values = reactiveValues()
values$Report = list()
#generate the plot
myplot = reactive({
df = data.frame(x = 1:input$numberinput, y = (1:input$numberinput)^2)
p = ggplot(df, aes(x = x, y = y)) + geom_line()
return(p)
})
#display the plot
output$numberplot = renderPlot(myplot())
# when the user clicks a button, add the current plot to the report
observeEvent(input$addthischart,{
chart = isolate(myplot)
isolate(values$Report <- c(values$Report,list(chart)))
})
#make the report
myreport = eventReactive(input$addthischart,{
reporthtml = character()
if(length(values$Report)>0){
for(i in 1:length(values$Report)){
explanatorytext = tags$h3(paste(" Now please direct your attention to plot number",i,"\n"))
chart = values$Report[[i]]()
theplot = HTML(chart) # this does not work - this is the crux of my question - what should i do here?
reporthtml = c(reporthtml, explanatorytext, theplot)
# ideally, at this point, the output would be an HTML file that includes some header text, as well as a plot
# I made this example to show what I hoped would work. Clearly, it does not work. I'm asking for advice on an alternative approach.
}
}
return(reporthtml)
})
# display the report
output$report = renderUI({
myreport()
})
})
runApp(list(ui = ui, server = server))
You could capture the HTML of your page using html2canvas and then save the captured portion of the DOM as a image using this answer, this way your client can embed this in any HTML document without worrying about the origin of the page contents
As the termplot function in R is containing some weird code that is giving me annoying bugs, I want to override it in my own test code until I find a more permanent solution. Problem is that the changed function is not loaded by the mgcv package. The mgcv package loads termplot from the stats package in its namespace, using importFrom() in the NAMESPACE file.
How can I convince mgcv to use the changed termplot? I tried :
unlockBinding("termplot", as.environment("package:stats"))
assign("termplot", my.termplot, as.environment("package:stats"))
lockBinding("termplot", as.environment("package:stats"))
and when applied to lm-objects, this works and the altered termplot is used. But when using gam-objects made by the mgcv package, this doesn't work. I'm not really going to build the stats package from source if I can avoid it...
To clarify, I also tried with
assignInNamespace("termplot", my.termplot, ns="stats")
assignInNamespace("termplot", my.termplot, ns="mgcv")
in all possible combinations, before attaching mgcv, after attaching mgcv, and I didn't manage to get it working.
EDIT :
I tried all options given here (apart from rebuilding either package), and couldn't get it to work. The easy way out for me is using a wrapper function. That discussion can be found here. Thanks for all the tips.
A reproducible example :
my.termplot <- function (x) print("my new termplot")
unlockBinding("termplot", as.environment("package:stats"))
assignInNamespace("termplot", my.termplot, ns="stats", envir=as.environment("package:stats"))
assign("termplot", my.termplot, as.environment("package:stats"))
lockBinding("termplot", as.environment("package:stats"))
y <- 1:10
x <- 1:10
xx <- lm(y~x)
termplot(xx)
require(mgcv)
dat <- gamSim(1, n = 400, dist = "normal", scale = 2)
b <- gam(y ~ s(x0) + s(x1) + s(x2) + x3, data = dat)
plot(b,all=TRUE)
plot.gam calls termplot for the non-smooth terms (x3 in this case), but fails to find the new termplot function.
EDIT2 : apparently, my example works. I see now I solved my own question: In the first code, I didn't add both the namespace and the package in assignInNamespace. It is important to remember to change the function both in the namespace and the package before loading the other package. Thx #hadley for pointing me in the right direction, #Marek for testing the code and reporting it works, and the rest for taking the effort to answer.
I'm stumped - I can't figure out how plot.gam is locating termplot - it's not using the ordinary scoping rules as far as I can tell. This seems to need a deeper understanding of namespaces than I currently possess.
my.termplot <- function (x) print("my new termplot")
# where is it defined?
getAnywhere("termplot")
# in package and in namespace
unlockBinding("termplot", as.environment("package:stats"))
assign("termplot", my.termplot, "package:stats")
unlockBinding("termplot", getNamespace("stats"))
assign("termplot", my.termplot, getNamespace("stats"))
getAnywhere("termplot")[1]
getAnywhere("termplot")[2]
# now changed in both places
y <- 1:10
x <- 1:10 + runif(10)
xx <- lm(y ~ x)
termplot(xx) # works
library("mgcv")
b <- gam(y ~ s(x), data = data.frame(x, y))
plot(b) # still calls the old termplot
# I'm mystified - if try and find termplot as
# seen from the environment of plot.gam, it looks
# like what we want
get("termplot", environment(plot.gam))
Try overwriting the function that you are calling termplot from. At a guess, this is plot.gam in the mgcv package.
First load the necessary package.
library(mgcv)
Here's your alternate termplot function, added to the stats namespace.
my.termplot <- function (model, ...)
{
message("In my.termplot")
}
unlockBinding("termplot", as.environment("package:stats"))
assign("termplot", my.termplot, as.environment("package:stats"))
lockBinding("termplot", as.environment("package:stats"))
Likewise, here's the wrapper function, added to the mgcv namespace.
my.plot.gam <- function (x, ...)
{
message("In my.plot.gam")
my.termplot()
}
unlockBinding("plot.gam", as.environment("package:mgcv"))
assign("plot.gam", my.plot.gam, as.environment("package:mgcv"))
lockBinding("plot.gam", as.environment("package:mgcv"))
Here's an example to test it, taken from ?gam.
dat <- gamSim(1, n = 400, dist = "normal", scale = 2)
b <- gam(y ~ s(x0) + s(x1) + s(x2) + s(x3), data = dat)
plot(b)
I think the trace() function does automatically what is attempted above. Do:
trace('termplot', edit='gedit')
Where 'gedit' is the name of a text editor. The editor will open with the original code and you can paste whatever substitution code you desire.
To return to the original version just untrace('termplot')
Caveat: I tried using this when the text editor had many files open and it didn't work. So I use 'gedit', a text editor on my system that I don't use often. This way I am sure that R will open a new instance of 'gedit'.
I'm not positive this will help, but I think it's worth a try. The search sequence when there are namespaces is really confusing.