如何在Rmd Shiny文档中实现图片动态加载并解决404问题？

背景 #

我基于R Markdown开发了一个Shiny应用，核心逻辑如下：

• 用户通过selectInput选择图片类型，选项自动读取www/motives目录下的所有图片文件名
• 选择后展示对应图片，同时该选项还控制其他功能
• 设计初衷是让用户通过SharePoint同步文件夹轻松增删图片，无需手动维护路径列表或联系管理员修改选项集合

当前问题 #

只有浏览器提前解析过路径的图片才能正常显示。例如在HTML注释中添加对应img标签（仅注释），图片就能正常加载；但由于用户会动态增删motives文件夹中的图片，无法硬编码这些标签。未被预解析的图片（如示例中的type-b）会出现以下错误：

Failed to load resource: the server responded with a status of 404 (Not Found)

示例应用代码（app.Rmd） #

---
pagetitle: "Test"
output: html_document
runtime: shiny
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(dplyr)

# create image files just for this example app
png(filename = "www/motives/default.png", width = 200, height = 200)
plot(1:5, 1:5, type = "p", col = "grey", pch = 16, xaxt = "n", yaxt = "n", xlab = NA, ylab = NA)
dev.off()
png(filename = "www/motives/type-a.png", width = 200, height = 200)
plot(1:5, 1:5, type = "p", col = "blue", pch = 16, xaxt = "n", yaxt = "n", xlab = NA, ylab = NA)
dev.off()
png(filename = "www/motives/type-b.png", width = 200, height = 200)
plot(1:5, 1:5, type = "p", col = "red", pch = 16, xaxt = "n", yaxt = "n", xlab = NA, ylab = NA)
dev.off()

selectInput("type", label = "Type", choices = "default")

# get motives from all files in the motives-folder
motives <- data.frame(path = list.files("www/motives")) %>%
  mutate(title = gsub(".png", "", .$path))

updateSelectInput(inputId = "type",
                  choices = motives$title)

# create title output
title <- reactive({
  if(input$type != "default") {
    paste0("Special type '", input$type, "'")
  } else {
    "Default type"
  }
})

# create motive output
motive <- reactive({
  HTML(paste0('<img src="app_files/www/motives/', input$type, '.png" />'))
})

`r renderText({title()})`

## 错误现象
- 默认主题图片可正常显示
- type-a主题图片可正常显示
- type-b主题图片无法加载，触发404错误

---

## 解决方案

### 方案1：注册自定义资源路径（推荐）
使用Shiny的`addResourcePath`注册`motives`目录，统一资源访问路径，避免依赖浏览器预解析：
1. 在`setup`代码块中添加注册逻辑：
```r
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(dplyr)
shiny::addResourcePath("motives", "www/motives") # 新增这行

2. 修改图片路径拼接逻辑：
```r
# create motive output
motive <- reactive({
  HTML(paste0('<img src="motives/', input$type, '.png" />')) # 移除app_files前缀
})

方案2：动态生成隐藏标签预加载图片 #

自动生成所有图片的隐藏img标签，实现预加载，支持动态增删：

1. 添加预加载UI的输出逻辑：

```{r, include=FALSE}
# ... 原有代码 ...
output$preloadImgs <- renderUI({
  # 生成所有图片的隐藏标签
  imgs <- lapply(motives$path, function(img_path) {
    tags$img(src = paste0("motives/", img_path), style = "display: none;")
  })
  do.call(tagList, imgs)
})

2. 在UI部分添加预加载标签的输出：
```r
<div id="motive">`r renderUI({motive()})`</div>
`r uiOutput("preloadImgs")` <!-- 新增这行 -->

方案3：使用Shiny原生renderImage输出 #

用Shiny专门的图片输出函数替代手动拼接HTML，更符合原生逻辑：

1. 修改图片输出逻辑：

```{r, include=FALSE}
# ... 原有代码 ...
# 替换原有的motive reactive
output$motiveImg <- renderImage({
  list(
    src = file.path("www/motives", paste0(input$type, ".png")),
    contentType = "image/png",
    width = 200,
    height = 200
  )
}, deleteFile = FALSE)

2. 替换UI中的图片输出部分：
```r
<h4>`r renderText({title()})`</h4>
<div id="motive">`r imageOutput("motiveImg")`</div> <!-- 替换原renderUI -->

内容的提问来源于stack exchange，提问作者Stefan Jelkovich