Inserting html produced in r function - html

I want to construct html on the fly and have that html rendered
in Quarto.
The actual application involves inserting an iFrame,
but for simplicity, let's just make an <img> tag.
Here is my .qmd code:
```{r}
source("awash-functions.r")
```
How do you inject html text produced in an r function into a **quarto** document?
In R markdown, I had the function `sprintf` a string. That doesn't seem to work here!
Here is `awash-functions.r`:
imageLink <- function(iUrl, iText) {
sprintf("<img src = '%s' width='24'> %s", iUrl, iText)
}
let's call the function and see what appears:
```{r echo=FALSE}
imageLink("https://www.united.com/8cd8323f017505df6908afc0b72b4925.svg", "united logo")
```
and now, here's what it's supposed to look like:
<img src = 'https://www.united.com/8cd8323f017505df6908afc0b72b4925.svg'> united logo
It renders, and the function clearly gets called,
but it shows the html code, not the image:
I know it's something simple, but I can't find it. Many thanks!

Two things to note:
Firstly, Quarto by default wraps any code chunk output within the <pre><code> tag. To get the output asis you need to use the chunk option results: asis.
Secondly, sprintf (or even print) returns output enclosed within quotes. So after using results: asis, you would get the html tags but would also get the quotes. So you need to wrap the sprintf with cat to get intended results.
---
format: html
---
```{r}
#| echo: false
imageLink <- function(iUrl, iText) {
cat(sprintf("<img src = '%s'> %s", iUrl, iText))
}
```
```{r}
#| echo: false
#| results: asis
imageLink("https://www.united.com/8cd8323f017505df6908afc0b72b4925.svg", "united logo")
```
and now, here's what it's supposed to look like:
<img src = 'https://www.united.com/8cd8323f017505df6908afc0b72b4925.svg'> united logo

Related

Converting HTML with equations pages to docx

I am trying to convert an html document to docx using pandoc.
pandoc -s Template.html --mathjax -o Test.docx
During the conversion to docx everything goes smooth less the equations.
In the html file the equation look like this:
<div class="jp-Cell jp-MarkdownCell jp-Notebook-cell">
<div class="jp-Cell-inputWrapper">
<div class="jp-Collapser jp-InputCollapser jp-Cell-inputCollapser">
</div>
<div class="jp-InputArea jp-Cell-inputArea"><div class="jp-RenderedHTMLCommon jp-RenderedMarkdown jp-MarkdownOutput " data-mime-type="text/markdown">
\begin{equation}
\log_{10}(\mu)={-2.64}+\frac{4437.038}{T-544.391}
\end{equation}
</div>
</div>
</div>
</div>
After running the pandoc command the result in the docx document is:
\begin{equation} \log_{10}(\mu)={-2.64}+\frac{4437.038}{T-544.391} \end{equation}
Do you have idea how can I overcome this issue?
Thanks
A Lua filter can help here. The code below looks for div elements with a data-mime-type="text/markdown" attribute and, somewhat paradoxically, parses it context as LaTeX. The original div is then replaced with the parse result.
local stringify = pandoc.utils.stringify
function Div (div)
if div.attributes['mime-type'] == 'text/markdown' then
return pandoc.read(stringify(div), 'latex').blocks
end
end
Save the code to a file parse-math.lua and let pandoc use it with the --lua-filter / -L option:
pandoc --lua-filter parse-math.lua ...
As noted in a comment, this gets slightly more complicated if there are other HTML elements with the text/markdown media type. In that case we'll check if the parse result contains only math, and keep the original content otherwise.
local stringify = pandoc.utils.stringify
function Div (div)
if div.attributes['mime-type'] == 'text/markdown' then
local result = pandoc.read(stringify(div), 'latex').blocks
local first = result[1] and result[1].content or {}
return (#first == 1 and first[1].t == 'Math')
and result
or nil
end
end

Render ggplot2 plot in HTML template within RMarkdown

I've built a function in rmarkdown to produce some HTML output with given values, but I want it to work if one of the passed values references a ggplot object.
Basically, knitr renders this perfectly:
x <- [R computation]
y <- [ggplot figure]
<div id="some_number">`r x`</div>
<div id="some_figure">
```{r}
y
```
</div>
But I don't want to have to rewrite that every time I use that particular chunk of html with different x and y. So I wrote the following function:
html_func <- function(x,y) {
template <- "
<div id=\"some_num\">{x}</div>
<div id=\"some_fig\">{y}</div>
"
instance <- glue::glue(template)
output <- knitr::asis_output(instance)
return(output)
}
number <- [R computation]
figure <- [ggplot figure]
html_func(number, figure)
The rendered page shows the "number" computed correctly within the div, but doesn't render the plot.
How can I get it to produce the plot within the HTML container?
UPDATE: Commenter suggested using live data so here we go.
This works:
```{r}
library(ggplot2)
data(mtcars)
number <- mean(mtcars$mpg)
figure <- ggplot2::ggplot(mtcars, aes(x=hp, y=mpg)) +
geom_point()
```
<div id="some_number">`r number`</div>
<div id="some_figure">
```{r echo=FALSE}
figure
```
</div>
But this does not. The computation outputs fine, but the plot does not render.
```{r}
library(ggplot2)
data(mtcars)
number <- mean(mtcars$mpg)
figure <- ggplot2::ggplot(mtcars, aes(x=hp, y=mpg)) +
geom_point()
html_func <- function(x,y) {
template <- "
<div id=\"some_num\">{x}</div>
<div id=\"some_fig\">{y}</div>
"
instance <- glue::glue(template)
output <- knitr::asis_output(instance)
return(output)
}
html_func(number, figure)
```
Here's a screenshot comparing the two.
So this is a BAD solution.
```{r}
html_func_open <- function(x) {
template <- "
<div id=\"some_num\">{x}</div>
<div id=\"some_fig\">
"
instance <- glue::glue(template)
output <- knitr::asis_output(instance)
return(output)
}
html_func_close <- function() {
template <- "
</div>
"
instance <- glue::glue(template)
output <- knitr::asis_output(instance)
return(output)
}
html_func_open(number)
figure
html_func_close()
```
I get the output I want by doing the plot outside of the HTML template, then closing up the HTML in a second function. This allows the HTML on either side of the figure to be as complex as I want. But it's not really an ideal solution, since It requires multiple lines every time I want to add in a new figure, which limits the complexity with which I can build HTML containers.
So still seeking a better solution where I can just pass the figure to the function and have it render properly.

Shiny renderText: half italicized, half not?

In my shiny app, I have a textOutput named acronym where I would like to renderText some text which is half non-italicized, half-italicized.
I tried doing it like this:
output$acronym_1 <- renderText(paste("SID SIDE:", tags$em("Siderastrea siderea")))
But this did not get the second half in italics. How do I do this?
Thanks in advance.
The following code will produce italicized text
library(shiny)
ui = fluidPage(uiOutput("htmlText"))
server <- function(input, output)
output$htmlText <- renderUI(HTML(paste(
"Non-italic text.", em("Italic text")
)))
shinyApp(ui, server)
I don't think textOutput is capable of text markup since the output string will be created by cat according to the documentation.
renderText(expr, env = parent.frame(), quoted = FALSE,
outputArgs = list())
expr An expression that returns an R object that can be used as an argument to cat.

Output html from function during knitr output

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.

R Shiny - Using htmlOutput / uiOutput from UI.R in server.R as an input

In my shiny dashboard I am generating complex SQL that takes input from the user and generates the SQL code and executes it after the user has inputted their username / password.
I generate an htmlOutput in UI.R to show the code prior to code runs.
The code, when displayed as a textOutput contains line breaks br(), comments enclosed in em() and shiny-html-output div elements.
My objective is to be able to use the htmlOutput as an input in the sqlQuery function.
Parts of SERVER.R
qry_SQL <- reactive({tempfunc(1, "TD")})
# tempfunc creates my SQL using inputs present in UI.R
output$qry_out_text <- renderText(qry_SQL())
#Generates output in text format that contains <br/>, <em> and <div id="key1A_main_TD_1" class="shiny-html-output"> elements
output$qry_out_text2 <- renderUI(qry_SQL())
# Generates html output that I would ideally like to pass to sqlQuery
output$qry_out <- renderDataTable({
input$Execute
validate(
need(input$Username!=""&&input$Password!="","Please input Username and Password for TERADATA"),
need(input$Execute>0,"Click Execute")
)
ch <- odbcConnect(dsn="CustomDSN",uid=input$Username, pwd = input$Password)
import <<- sqlQuery(ch, PASS_HTML_OUTPUT_HERE, errors = FALSE )
odbcClose(ch)
head(import, n =100)
})
Ideally I need help on what to input in the PASS_HTML_OUTPUT_HERE block above.
qry_SQL() when outputted using textOutput yields the following:
SELECT c1.COL1, c1.COL2
FROM TABLE as c1
WHERE cast(c1.DateNow as date) between '2015-09-19' and '2015-10-16'
and <div id="key1A_main_TD_1" class="shiny-html-output"></div>
<div id="key2A_main_TD_1" class="shiny-html-output"></div>
<div id="key3A_main_TD_1" class="shiny-html-output"></div>
<div id="key4A_main_TD_1" class="shiny-html-output"></div>
<div id="key5A_main_TD_1" class="shiny-html-output"></div>
In this case key1A_main_TD_1 yields "( AND c1.Details like '%unhappy%') "
The other div tags do not yield anything as nothing has been inputted by the user.
qry_SQL() when outputted using htmlOutput yields the following:
SELECT c1.COL1, c2.COL2
FROM TABLE1 as c1
WHERE cast(c1.DateNow as date) between '2015-09-19' and '2015-10-16'
and
(c1.Details like '%unhappy%')
My problem is that I would like to pass qry_SQL() as HTML, with the div tags resolved.
Cheers,
Anand