【问题标题】:CSS styling of Shiny runtime RMarkdown document with a For Loop带有 For 循环的 Shiny 运行时 RMarkdown 文档的 CSS 样式
【发布时间】: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.
![%s](/img/%s)

"

#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


    【解决方案1】:

    我想我已经设法解决了这个问题,经过大量的试验和错误,以防万一有人感兴趣。

    我找到的解决方案是创建一个带有 for 循环的列表,然后在将结果传递给 renderUI 处理的 HTML 输出之前取消列表。

    这可以在 text_output 的创建中启用一些基本样式,例如粗体文本、换行符和 href 外部链接。

    仅供参考...原始代码的其余部分是相同的,只是在虚拟 fruit 数据框中添加了一个新变量 (web) 以便测试外部链接。

    到目前为止,我似乎无法使用此解决方案做的一件事是使用 img src 包含图像。我会发布一个关于这个的新问题(或者如果我能解决这个问题,请更新这个问题)。

    renderUI({
      if (nrow(fruit_data_display()) < 1) {
        HTML(paste("<b>", "Nothing matches your current selection", "</b>"))
      } else {
      text_output <- list()
      fruit_data_display <- fruit_data_display()
      for(i in(nrow(fruit_data_display))) {
        text_output[[i]] <- paste("<h4 style='color:blue;'>", fruit_data_display$fruit, "</h4>", 
                                  "<p style='background-color: powderblue;'>",
                                  "<b>Description:</b>",
                                  "The size of the fruit is", fruit_data_display$size, "<br>",
                                  "The country it comes from is", "<a href='", fruit_data_display$web,
                                  "'target='_blank'>", fruit_data_display$country ,"</a>", "<p>")
        text_output <- paste(unlist(text_output))
      }
        HTML(paste(text_output))
      }
      
    })
    

    【讨论】:

      猜你喜欢
      • 2019-03-15
      • 1970-01-01
      • 2020-10-12
      • 2021-12-05
      • 1970-01-01
      • 2014-09-05
      • 2013-10-08
      • 2021-11-25
      相关资源
      最近更新 更多