render new image from disk in R markdown / Dashboard on user selection在用户选择时从磁盘渲染新图像

ax6ht2ek  于 2023-11-14  发布在  其他
关注(0)|答案(1)|浏览(69)

我有一个充满图表的文件夹,从上一步生成.所有这些都是PNG文件.我希望能够使用Flexdashboard选择任何人并加载它.由于没有闪亮或服务器服务是需要我尝试串扰包

library(crosstalk)
library(magrittr)
library(png)
    
df <- list.files("plots/", full.names = TRUE) %>%
      as_tibble() %>%
      magrittr::set_names("path") 
    
    shared_data <- SharedData$new(df,  key = ~path)
    
    p <- shared_data %>% readPNG(source = path)
    
    bscols( filter_select(id = "file_id", 
                         label = "CHOOSE", 
                         sharedData = shared_data, 
                         group = ~path), 
           p)

字符串
我被一个非常简单的错误卡住了,我无法解决,因为所有路径都从文件中正确读取:

Error in path.expand(source) : invalid 'path' argument


我也试着用过了:

bscols(filter_select("path", "CHOOSE", shared_data),
      knitr::include_graphics(shared_data, ~path))

Error in makeGroupOptions(sharedData, group, allLevels) : argument "group" is missing, with no default


也许有一个更简单的方法,但串扰似乎是一个非常简单的,因为它不需要发光或任何其他组件,但 Dataframe 。

2vuwiymt

2vuwiymt1#

更新答案(2023年10月)-

主动添加新文件到文件夹

AFAIK,如果我们希望UI在每次添加新文件时都能自动更新,我们将不得不使用Shiny及其React能力。

library(shiny)

########################### Client ################################### 

ui <- fluidPage(
  titlePanel("Image Viewer"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("imgSelect", "Select an image", choices = NULL ),
      br(),
    ),
    
    mainPanel(
      imageOutput("imgDisplay")
    ) #mp
  )
)

########################### Server ################################### 

server <- function(input, output, session) {
  
  image_dir <-  "plots"
  
  oldFiles<- function(){
    return(  list.files(path=image_dir, pattern = "\\.png$", full.names = TRUE))
  }
  nowFiles <- function() {
    return(list.files(path=image_dir, pattern = "\\.png$", full.names = TRUE))
  }
  
  # Constantly poll and check(compare) nowFiles against oldFiles
  imgData <- reactivePoll(3000, session, checkFunc = oldFiles , 
                          valueFunc = nowFiles)
  
  # Update dropdown  if files change
  observe({
    # Retain previous selection when new items are added 
    curr<- input$imgSelect #gives current selection
    if(curr ==''){ curr= imgData()[1] }
    # update ui
    updateSelectInput(session, "imgSelect", choices = imgData() , selected = curr )
  })
  
  #  Render new image on selection change
  observeEvent(input$imgSelect, {
    currImg <- input$imgSelect
   #image rendering
    output$imgDisplay <- renderImage({
      # return list to render image
      list(
        src = currImg,contentType = 'image/png',
        alt = "currImg"
      )
    }, deleteFile = FALSE) 
    #end image rendering
    
  })# End observeEvent
  
}#server

shinyApp(ui, server)

字符串

提示:

如果将以下行放在server()函数的外部,则可以在多个会话中共享同一文件列表

image_dir <-  "plots"
imgData <- reactivePoll(3000, session = NULL, 
                        checkFunc = function() {list.files(path=image_dir,
                                                           pattern = "\\.png$",
                                                           full.names = TRUE)}  , 
                        valueFunc = function() {list.files(path=image_dir, 
                                                           pattern = "\\.png$", 
                                                           full.names = TRUE) })

旧/已接受答案(2021年10月)

如果你需要的只是一个静态的设置,这仍然可以工作,并以最小的麻烦完成它

```{r}
# 
library(stringr)
library(bsselectR)

state_plots <- paste0(list.files("plots", full.names = TRUE, recursive = TRUE))
names(state_plots) <- str_replace_all(state_plots, 
                                      c("\\.png" = "", 
                                        "plots/" = ""))

bsselect(state_plots, type = "img", selected = "sns_heatmap", 
         live_search = TRUE, show_tick = TRUE)
型
输出量:
x1c 0d1x的数据

相关问题