【发布时间】:2021-09-23 14:06:59
【问题描述】:
我正在使用运行时 Shiny 创建一个 R Markdown 文件,该文件使用 for 循环动态创建内容。我已经设法让它工作(下面的示例),但是在将 CSS/其他元素应用于输出时遇到了问题。
我要达到的是最后一个部分(下面示例中的水果信息),用于在循环中的每个实例的样式化、彩色框中显示文本、图像、链接。我可以使用呈现为 HTML 的“普通”Rmarkdown 文件来实现这一点,但似乎无法用 Shiny 复制它。
这是 Markdown/Shiny 的可复制示例的完整代码。再往下是我对 Markdown/nonShiny 所做的事情
我正在使用 renderPrint,因为 renderText 似乎没有返回任何内容。
```
---
title: "Title"
author: "Author"
date: "14/07/2021"
output:
html_document:
df_print: paged
toc: true
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(DT)
##CREATE DATAFRAME
fruit = c("Apple", "Apple", "Apple", "Banana", "Banana", "Orange")
size = c("One", "Two", "Three", "One", "One", "Two")
country = c("UK", "UK", "ES", "DE", "UK", "DE")
df <- data.frame(fruit, size, country)
df$description <- paste(df$fruit, "from", df$country, "with a size", df$size)
```
添加选择输入
```{r user_select_project, echo=FALSE}
fluidRow(column(4, selectInput("fruit", "Choose Fruit:", choices = sort(unique(df$fruit)), multiple = TRUE, selected = sort(unique(df$fruit)))),
column(4, selectInput("size", "Choose Size:", choices = sort(unique(df$size)), multiple = TRUE, selected = sort(unique(df$size)))),
column(4, selectInput("country", "Choose Country:", choices = sort(unique(df$country)), multiple = TRUE, selected = sort(unique(df$country)))))
```
为数据表创建反应式DRAM
```{r fruitdata, echo=FALSE}
fruit_data <- reactive({
df %>%
filter(fruit %in% input$fruit) %>%
filter(size %in% input$size) %>%
filter(country %in% input$country)
})
```
渲染数据表
```{r fruittable, echo=FALSE}
renderDT({
fruit_data_new <- fruit_data()
fruit_data_table <- fruit_data_new[, 1:3]
DT::datatable(fruit_data_table,
options = list(pageLength = 5),
rownames = FALSE,
colnames = c("Fruit", "Size", "Country"), escape = F)
})
```
渲染水果信息 - 问题在这里
根据您的选择返回以下项目
```{r myfruit, echo = FALSE, results = "asis"}
fruit_data_display <- reactive({
df %>%
filter(fruit %in% input$fruit) %>%
filter(size %in% input$size) %>%
filter(country %in% input$country)
})
fruit_data_template <- "%s is the fruit
The size is %s
It comes from %s
"
renderPrint({
fruit_data_display <- fruit_data_display()
fruit_data_template <- fruit_data_template
if (nrow(fruit_data_display) < 1) {
"Nothing matches your current selection"
} else {
for (i in seq(nrow(fruit_data_display))) {
current <- fruit_data_display[i, ]
cat(sprintf(fruit_data_template, current$fruit, current$size, current$country))
}
}
})
```
以上所有方法都有效,但是(因为,我猜,我使用的是 renderPrint?),输出只是基本文本。如上所述,使用 renderText 没有返回任何内容。将样式元素添加到模板 simple 会返回输出中的代码。
我试图得到的是一系列带有元素样式的框。
这是我如何在以 HTML 呈现的标准 Markdown 文档中工作的代码 - 这是使用略有不同的数据,但它是相同的想法。使用下面的代码,我设法制作了一些文本超链接,一些粗体,还包括图像。我想用上面的运行时闪亮代码实现同样的目标。
```
##This goes in the main body:
<style>
div.blue { background-color:#add8e6; border-radius: 5px; padding: 20px;}
</style>
##This goes in as code
## 1: create data
input <- data.frame(
name = LETTERS[1:4],
data = runif(n = 4),
text = replicate(4, paste(sample(x = LETTERS, size = 10, replace = TRUE), collapse = "")),
stringsAsFactors = FALSE)
input$image <- c("imageA.png", "imageB.png", "imageC.png", "imageD.png")
input$image_caption <- c("Image A Caption", "Image B Caption", "Image C Caption", "Image D Caption")
input$hyperlink <- "https://www.bbc.co.uk"
##2: Create a template
template <- "#### This is section %s with automated styling applied
<div class = 'blue'>
Section <b>data</b> is now in a blue box `%0.2f`.
</div>
Additional section <b>text</b> is now a hyperlink to the BCU website: [%s.](%s){target='_blank'}
And we now have <b>images</b> with their <b>image_captions</b> underneath.

"
#3 create a for loop
for (i in seq(nrow(input))) {
current <- input[i, ]
cat(sprintf(template, current$name, current$data, current$text, current$hyperlink, current$image_caption, current$image))
}
```
在标准的 Rmarkdown 中,它的渲染类似于附加的图像:
希望我已经正确解释了这个问题,并且提供的代码支持了一个可复制的示例。任何帮助将不胜感激。谢谢。
【问题讨论】:
标签: css r shiny r-markdown runtime