shiny ioslides selectInput scrollbar failure - input

I need to have two consecutive slides use similar selectInputs. When I do this, the scrollbar on the first slide fails. I use "selectize=FALSE" so that the user can deselect options. The scrollbar works fine when it's just one slide.
Am I doing something wrong, or is this a bug? Any help would be greatly appreciated!
---
title: "Scrollbar Failure Demo"
author: "KM"
date: "May 20, 2016"
runtime: shiny
output: ioslides_presentation
---
## Slide1
```{r Slide1, echo=FALSE}
fulllist <- c(1,2,3,4,5,6,7,8,9,10)
inputPanel(
selectInput("Option1", label="Pick Many", multiple=TRUE, selectize=FALSE,
choices=fulllist, selected=fulllist))
renderPlot({plot(input$Option1)
title(main="Scrollbar Fails on Slide 1")})
```
## Slide2
```{r Slide2, echo=FALSE}
inputPanel(
selectInput("Option2", label="Pick Many", multiple=TRUE, selectize=FALSE,
choices=fulllist, selected=fulllist))
renderPlot({plot(input$Option2)
title(main="Scrollbar Works on Slide 2")})
```

Related

Put 2 chunks of code side by side in RMarkdown or Quarto

How can I put 2 chunks of code side by side in the output file of RMarkdown or Quarto ?
Code
library(dplyr)
mtcars %>% select(gear)
library(dplyr)
select(mtcars, gear)
Desired layout in the PDF or HTML file
The canonical way for something like this is to use column divs:
::::: columns
::: column
```r
library(dplyr)
mtcars %>% select(gear)
```
:::
::: column
```r
library(dplyr)
select(mtcars, gear)
```
:::
:::::
This will work with HTML, reveal.js, Beamer, and Powerpoint. The default result looks a bit ugly in HTML, as there is no space between the two blocks, but we can fix that with a tiny bit of CSS. We can put it directly into the document:
<style>
.column { padding-right: 1ex }
.column + .column { padding-left: 1ex }
</style>
Things get more complicated if we wish to do the same for PDF. We'll need convert the divs into a table, as that's the most effective way to get elements side-by-side. But that requires some heavier tools. In the YAML header, add
output:
pdf_document:
pandoc_args:
- "--lua-filter=columns-to-table.lua"
Then save the below code into a file column-to-table.lua.
function Div (div)
if div.classes:includes 'columns' then
local columns = div.content
:filter(function (x)
return x.classes and x.classes[1] == 'column'
end)
:map(function (x)
return x.content
end)
local aligns = {}
local widths = {}
local headers = {}
for i, k in ipairs(columns) do
aligns[i] = 'AlignDefault'
widths[i] = 0.98/ #columns
end
return pandoc.utils.from_simple_table(
pandoc.SimpleTable('', aligns, widths, headers, {columns})
)
end
end
You can get rid of the lines around the table by adding
\renewcommand\toprule[2]\relax
\renewcommand\bottomrule[2]\relax
at the beginning of your document.
---
title: "Untitled"
output: html_document
---
:::::::::::::: {.columns}
::: {.column width="50%"}
```{r warning=FALSE,message=FALSE}
library(dplyr)
mtcars %>% select(gear)
```
:::
::: {.column width="50%"}
```{r warning=FALSE,message=FALSE}
library(dplyr)
select(mtcars, gear)
```
:::
::::::::::::::
used This SO question as a resource. This is using pandoc to format the document in Rmarkdown HTML output

Short header for a very long Section's title in beamer presentation R Markdown (Pandoc)

I am working on a beamer_presentation which consists of several sections. The section titles are too long to fit into the CambridgeUS headline. I have already tried several options from related latex sources to use some short title for the section (say just "Chapter 1" instead of "Chapter 1 with a very-very-very-very-very long title" by \AtBeginSection{\title[Short title]{Long title}}) but yet can't figure out how to manage this in header-includes of R Markdown YAML. I set the section title through # in Markdown
---
title: Title for the whole presentation
subtitle: 'Presentation'
author:
- Author
institute: "Institution"
date: " `r format(Sys.Date(), '%B %d, %Y')`"
output:
beamer_presentation:
latex_engine: xelatex
toc: true
highlight: tango
theme: "CambridgeUS"
colortheme: "lily"
fonttheme: "serif"
slide_level: 3
keep_tex: true
header-includes:
- \setbeamertemplate{navigation symbols}{}
- \AtBeginDocument{\title[Presentation]{Title for whole presentation}}
- \renewcommand{\raggedright}{\leftskip=0pt \rightskip=0pt plus 0cm}
- \def\sectionname{Chapter}
- \AtBeginSubsection{}
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
```
# Chapter 1 with a very-very-very-very-very long title
## Intro
### The first page
In beamer, this is trivial, you can use \section[short version]{long version}. But Markdown makes such an easy job excruciatingly difficult.
However you can trick markdown like this:
---
title: Title for the whole presentation
subtitle: 'Presentation'
author:
- Author
institute: "Institution"
date: " `r format(Sys.Date(), '%B %d, %Y')`"
output:
beamer_presentation:
latex_engine: xelatex
toc: false
highlight: tango
theme: "CambridgeUS"
colortheme: "lily"
fonttheme: "serif"
slide_level: 3
keep_tex: true
header-includes:
- \setbeamertemplate{navigation symbols}{}
- \AtBeginDocument{\title[Presentation]{Title for whole presentation}}
- \renewcommand{\raggedright}{\leftskip=0pt \rightskip=0pt plus 0cm}
- \def\sectionname{Chapter}
- \AtBeginSubsection{}
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
```
```{=latex}
\tableofcontents[hideallsubsections]
\end{frame}
\section[short version for headline]{Chapter 1 with a very-very-very-very-very long title}
\subsection[short subsection for headline]{Intro}
\begin{frame}
\frametitle{The first page}
```
some text
(be careful where you place this command, otherwise you might end up with empty extra frames - that's why I had to switch off the automatic toc and insert it manually...)

How do I dynamically change label text color of R Shiny radioButtons widget when users select an option?

I am building a Shiny App where users have to complete several mandatory questions in the form of radioButtons, numericInputs, and textInputs in order to generate an output. To highlight which questions still need to be completed, I would like the label text to initially be rendered as "red", but then switch to "black" once a value has been selected and/or inputted into the widgets.
library(shiny)
ui <- fluidPage(
sidebarPanel(
radioButtons("my_radio_button", tags$p("Choose an Option", style = "color:red;"), choices = c("Option 1", "Option 2"), selected = character(0)),
)
)
server <- function(input, output, session) {
observeEvent(input$val, {
x <- input$my_radio_button
if (x == "Option 1" | x == "Option 2") {
## MAKE "Choose an Option" LABEL TURN BLACK
}
})
}
shinyApp(ui, server)
I found this example on stack exchange (R shiny conditionally change numericInput background colour) where they conditionally changed the background colour of the widget, but I don't know enough about programming to modify it to change the label text instead.
Any help would be greatly appreciated. Thanks!
You can use shinyjs
add shinyjs::useShinyjs() to the beginning of ui
add an id to the label param of the radioButtons ui element. I've used r_label in the example below
Observe for changes to input$my_radio_button, which trigger calls to shinyjs::html()
Full code below:
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
sidebarPanel(
radioButtons("my_radio_button",
label=tags$p("Choose an Option", style = "color:red;", id="r_label"),
choices = c("Option 1", "Option 2"), selected = character(0)),
)
)
server <- function(input, output, session) {
observeEvent(input$my_radio_button, {
shinyjs::html("r_label", "<p style='color:black'>Choose an Option</p>")
})
}
shinyApp(ui, server)

Rmarkdown knit pdf - getting underlined text instead of italic using *italic* (huxtable issue?)

Rmarkdown text (between chunks) when formated italic using * * knits to pdf underlined and not italic format when I print huxtable.
Here is my example:
```
---
title: "<center><center>"
author: "<center> jd <center><br>"
date: "<center> `r Sys.Date()` <center>"
output:
pdf_document:
fig_caption: yes
toc: yes
toc_depth: 3
number_sections: true
latex_engine: xelatex
html_document:
code_folding: show
df_print: paged
theme: yeti
highlight: tango
toc: yes
toc_float:
collapsed: false
smooth_scroll: false
number_sections: true
fontsize: 10pt
---
This * * makes text *italic*.
```{r lib, message = FALSE}
library(huxtable)
library(tidyverse)
data(iris)
dt_hux <- iris[1:5,1:5] %>% as_hux() %>%
set_font_size(8) %>% set_font("Arial") %>%
set_bold(1, everywhere) %>%
set_top_border(1, everywhere) %>%
set_bottom_border(c(1, 6), everywhere)```
Until this point using * * will give italic format in knit pdf (if next chunck is not run).
But after the next chunk is run * * will underline text (in whole Rmarkdown). Commenting out **dt_hux** returns formatting to italic. Also knit to html will print italic formatting even with dt_hux.
```{r table}
options(huxtable.latex_use_fontspec = TRUE)
options(huxtable.print=print_latex)
dt_hux```
```
Is there a solution to this issues as I need to print huxtable in pdf?
From the TeXnical perspective the problem is that the ulem package is loaded without the normalem option. A couple of workarounds:
use classoption: normalem (based on Knitr hook to add code before \documentclass line in tex file to avoid options clash with xcolor). Caveat: this will pass the option to all packages and might be undesired in case the same option name is also used by other packages (I'm not aware of any other package that uses this option, but just in case ...)
add \normalem either as header-include or at the start of your document
This problem was fixed in huxtable 5.2.0, so you just need to update your package.

R markdown: simplify creating tables of figures and text

For R markdown Rmd web pages I want to generate tables containing in the first column thumbnail images (that link to a larger image or a web site) and
descriptive text in the 2nd column. One example is the following image:
I know I can create this manually in raw HTML, but that is very fiddly and time-consuming. There must be some easier way.
On a different page, I tried a markdown / pandoc table, but that didn't work, and I reverted to manual coding of HTML
icon | title
--------------------------------------------------+--------------------------
<img src="images/books/R-Graphics.jpg" height=50> |Paul Murrell, *R Graphics*, 2nd Ed.
<img src="images/books/R-graphics-cookbook.jpg" height=50> | Winston Chang, R Graphics Cookbook
<img src="images/books/lattice.png" height=50> | Deepayan Sarkar, *lattice*
<img src="images/books/ggplot2.jpg" height=50> | Hadley Wickham, *ggplot2*
Perhaps the htmltools package would be useful here, but I can't quite see how to use it in my Rmd files for this application.
Probably forgot escaping quotes? This works fine for me:
---
title: "The Mighty Doge"
output: html_document
---
```{r}
library(knitr)
create_thumbnail <- function(file) {
paste0("<img src=\"", file, "\" style=\"width: 50px;\"/>")
}
df <- data.frame(Image = rep("unnamed.png", 5),
Description = rep("Doge", 5))
df$Image <- create_thumbnail(df$Image)
kable(df)
```
Here is an approach that uses htmltools and seems much more flexible, in that I can control the details somewhat more easily.
I'm not familiar with bootstrap <div> constructs, so I used HTML table constructs. I had to define functions for tr(), td() etc.
```{r html-setup, echo=FALSE}
library(htmltools)
# table tags
tab <- function (...)
tags$table(...)
td <- function (...)
tags$td(...)
tr <- function (...)
tags$tr(...)
# an <a> tag with href as the text to be displayed
aself <- function (href, ...)
a(href, href=href, ...)
```
Then functions to construct my table entries the way I wanted:
```{r table-functions, echo=FALSE}
# thumnail figure with href in a table column
tabfig <- function(name, img, href, width) {
td(
a(class = "thumbnail", title = name, href = href,
img(src = img, width=width)
)
)
}
tabtxt <- function(text, ...) {
td(text, ...)
}
```
Finally, use them to input the entries:
## Blogs
```{r do-blogs, echo=FALSE}
width="160px"
tab(
tr(
tabfig("FlowingData", "images/blogs/flowingdata.png", "http://flowingdata.com/", width=width),
tabtxt("Nathan Yau,", aself("flowingdata.com/"),
"A large number of blog posts illustrating data visualization methods with tutorials on how do do these with R and other software.")
),
tr(
tabfig("Junk Charts", "images/blogs/junkcharts.png", "http://junkcharts.typepad.com/", width=width),
tabtxt("Kaiser Fung,", aself("http://junkcharts.typepad.com/"),
"Fung discusses a variety of data displays and how they can be improved.")
),
tr(
tabfig("Data Stories", "images/blogs/datastories.png", "http://datastori.es/", width=width),
tabtxt("A podcast on data visualization with Enrico Bertini and Moritz Stefaner,",
aself("http://datastori.es/"),
"Interviews with over 100 graphic designers & developers.")
)
)
```
I still need to tweak the padding, but this gives me more or less what I was after: