代码之家 › 专栏 › 技术社区 › A Duv

如何将rshiny reactivefilereader与reactiveui和不存在的文件一起使用?

shiny r

A Duv · 技术社区 · 7 年前

我该如何构建一个反应式ui,用不同的数据输入响应一个反应式filereader?

我感兴趣的是将reactivefilereader集成到一个应用程序中,该应用程序可以对数据中的组进行图形化,并逐组显示选定的点。

挑战:

不是每个我能从前缀和后缀识别的文件都存在。
每个文件有不同数量的组。

当我

尝试打开不存在的文件。
更新一个文件(这样它会检测到有更改)

潜在解决方案:

~~读取数据后,减慢/延迟下一步,以便重新加载数据。~~ 通过A固定 reactive() 和 req()
isolate() 依赖用户界面,因此它只在第一次加载文件时更改组的。

我包括模拟数据(及其生成)、一个ui、坏掉的服务器和一个没有反应式文件读取器的工作服务器。

更新

唯一剩下的就是 renderUI “group”不会在重新读取文件时重置。通常这是件好事,但我不想这样。

包装

library(tidyr); library(dplyr); library(ggplot2); library(readr); library(stringr)
library(shiny)
#library(DT)

模拟数据

a1 <- structure(list(Group = c("alpha_1", "alpha_1", "alpha_2", "alpha_2", "alpha_3", "alpha_3"), Sample = c("ps_1", "ps_2", "ps_1", "ps_2", "ps_1", "ps_2"), x = c(1, 1.1, 4, 4.1, 6.8, 7), y = c(2.1, 2, 7.3, 7, 10, 9.7)), .Names = c("Group", "Sample", "x", "y"), row.names = c(NA,-6L), class = c("tbl_df", "tbl", "data.frame"), spec = structure(list(cols = structure(list(Group = structure(list(), class = c("collector_character", "collector")),Sample = structure(list(), class = c("collector_character","collector")), x = structure(list(), class = c("collector_double", "collector")), y = structure(list(), class = c("collector_double", "collector"))), .Names = c("Group", "Sample", "x", "y")), default = structure(list(), class = c("collector_guess", "collector"))), .Names = c("cols", "default"), class = "col_spec"))
a2 <- structure(list(Group = c("alpha_6", "alpha_6", "alpha_7", "alpha_7", "alpha_9", "alpha_9", "alpha_10", "alpha_10"), Sample = c("ps_1", "ps_2", "ps_1", "ps_2", "ps_1", "ps_2", "ps_1", "ps_2"), x = c(3,3.2, 5, 5.1, 1, 1.1, 5, 5.1), y = c(8.1, 7, 3, 4, 14, 15, 4,3)), .Names = c("Group", "Sample", "x", "y"), row.names = c(NA, -8L), class = c("tbl_df", "tbl", "data.frame"), spec = structure(list(cols = structure(list(Group = structure(list(), class = c("collector_character", "collector")), Sample = structure(list(), class = c("collector_character","collector")), x = structure(list(), class = c("collector_double", "collector")), y = structure(list(), class = c("collector_double", "collector"))), .Names = c("Group", "Sample", "x", "y")), default = structure(list(), class = c("collector_guess", "collector"))), .Names = c("cols", "default"), class = "col_spec"))
b2 <- structure(list(Group = c("beta_3", "beta_3", "beta_4", "beta_4", "beta_6", "beta_6"), Sample = c("ps_1", "ps_2", "ps_1", "ps_2", "ps_1", "ps_2"), x = c(3, 3.2, 5, 5.1, 1, 1.1), y = c(8.1, 7, 3, 4, 14, 15)),.Names = c("Group", "Sample", "x", "y"), row.names = c(NA, -8L), class = c("tbl_df", "tbl", "data.frame"), spec = structure(list(cols = structure(list(Group = structure(list(), class = c("collector_character", "collector")), Sample = structure(list(), class = c("collector_character","collector")), x = structure(list(), class = c("collector_double", "collector")), y = structure(list(), class = c("collector_double", "collector"))), .Names = c("Group", "Sample", "x", "y")), default = structure(list(), class = c("collector_guess", "collector"))), .Names = c("cols", "default"), class = "col_spec"))
b3 <- structure(list(Group = c("beta_3", "beta_3", "beta_4", "beta_4", "beta_6", "beta_6"), Sample = c("ps_1", "ps_2", "ps_1", "ps_2", "ps_1", "ps_2"), x = c(3, 3.2, 5, 5.1, 1, 1.1), y = c(8.1, 7, 3, 4, 14, 15)), .Names = c("Group", "Sample", "x", "y"), row.names = c(NA, -8L), class = c("tbl_df", "tbl", "data.frame"), spec = structure(list(cols = structure(list(Group = structure(list(), class = c("collector_character", "collector")), Sample = structure(list(), class = c("collector_character","collector")), x = structure(list(), class = c("collector_double", "collector")), y = structure(list(), class = c("collector_double", "collector"))), .Names = c("Group", "Sample", "x", "y")), default = structure(list(), class = c("collector_guess", "collector"))), .Names = c("cols", "default"), class = "col_spec"))

# Data export to simulate the problem
lz_write <- function(input) {
  write_csv(input, paste0(substitute(input), ".csv"))
}
lz_write(a1); lz_write(a2); lz_write(b2); lz_write(b3) # Messed up function for lapply...
# rm(list = ls()) # Clean the environment

用户界面

ui <- fluidPage(
  titlePanel("Minimal Example"),
  fluidRow(
    column(width = 2, class = "well", 
           # File selection
           HTML(paste("Which file?")),
           # Prefix:
           selectInput(inputId = "p",
                       label = "Prefix:",
                       choices = c("a", "b", "c"),  
                       selected = "a"), 

           # Suffix:
           numericInput(inputId = "s",
                        label = "Suffix:",
                        min = 1,
                        max = 3,
                        value = 1,
                        step = 1)), 
    column(width = 10,
           plotOutput(outputId = "scatterplot",
                      dblclick = "plot_dblclick",  # Might not be necessary, but it's not more work to include but more work to exclude
                      brush = brushOpts(id =  "plot_brush", resetOnNew = TRUE)))
    ), 
  fluidRow(
    column(width = 3,
           br(),
           uiOutput(outputId = "group_n")), 
    column(width = 9, 
           fixedRow( 
             column(width = 3,
                    HTML(paste0("Arg 1"))),
             column(width = 3,
                    HTML(paste0("Arg 2"))),
             column(width = 3,
                    uiOutput(outputId = "num_2"))
             )
    )
  ),
  fluidRow(
    br(), br(), br(), #Lets add some gaps or spacing
    DT::dataTableOutput(outputId = "Table")) # Summary table
)  # Not sure if actually necessary for this example

坏服务器 现在唯一的问题是,当文件被重新读取时,ui会重置…

server_broken <- function(input, output, session) { # Broken version

  #Larger subset: A Reactive Expression # May be used later...
  args <- reactive({
    list(input$p, input$s)  #which file do we wish to input. This was our tag
  })
  # Reactive File-reader Subset
  path <- reactive({
    paste0(input$p, input$s, ".csv")
  }) # Reactive Filename, kinda like our args... 



  filereader <- function(input) { # The function we pass into a reactive filereader. 
    suppressWarnings(read_csv(input, col_types = cols(
      Group = col_character(),
      Sample = col_character(),
      x = col_double(),
      y = col_double())
    ))
  }

  ##BROKEN REACTIVE FILE READER HERE##
  data_1 <- reactiveValues() # The function we use for livestream data
  observe({
    if(file.exists(path()) == TRUE) {
      fileReaderData <-  reactiveFileReader(500, session, path(), filereader) 
    }  else { 
      message("This file does not exist") 
    ## OR DO I DO SOMETHING ELSE HERE??##
    }
    data_1$df <- reactive({ 
     ## STOPS APP CRASHING, BUT NO LONGER REFRESHES CONSTANTLY ##
      req(fileReaderData()) 
      fileReaderData()
    })   
  }) # Honestly don't understand still

  data <- reactive(data_1$df()) # Pulling things out just so the rest of our code can stay the same. 

  ## END OF BROKEN FILE READER##
  ## Reactive UI HERE##
  data_m <- reactive({
    req(data()) 
    args()
    tmp <- isolate(select(data(), Group))
    tmp %>% distinct()
  }) # number of groups

  output$num_2 <- renderUI({
    req(data())
    numericInput(inputId = "n",
                 label = "Group:",
                 min = 1,
                 max = length(data_m()$Group), 
                 value = 1 
    )
  }) #This is our 'reactive' numeric input for groups. This caps the max of our function based on the number of groups there are per file

  n <- reactive(input$n) #which marker number we are dealing with. 
  ## End of reactive UI##
  data_n <- reactive({
    req(data()); req(data_m())
    dt <- filter(data(), Group == data_m()[[1]][input$n])
  }) 


  # Create scatterplot object the plotOutput function is expecting ----
  ranges <- reactiveValues(x = NULL, y = NULL)


  output$scatterplot <- renderPlot({
    validate(need(data(), "The specified file does not exist. Please try another"))
    p <- as.numeric(input$p)
    plot <- ggplot(data_n(), aes(x, y)) +  
      labs(title = paste0("Group ", data_n()$Group[1])) + 
      labs(x = "X vals", y = "Y vals") + 
      geom_point() + theme_bw() # I already have customized aesthetics. Removed for minimalism  
    plot + coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = TRUE) # So we see all points more readily. messes up the zoom but oh well
  })

  # When a double-click happens, check if there's a brush on the plot.
  # If so, zoom to the brush bounds; if not, reset the zoom.
  observeEvent(input$plot_dblclick, {
    brush <- input$plot_brush
    if (!is.null(brush)) {
      ranges$x <- c(brush$xmin, brush$xmax)
      ranges$y <- c(brush$ymin, brush$ymax)
    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
  })  


  #Creating text ----
  output$group_n <- renderText({
    req(data())
    paste0("There are ", length(data_m()$Group), " groups in this file.",
           tags$br("This is Group: ", data_m()$Group[n()])
    )
  }) 

  #Building a table for you to visibly see points. You may need to update the DT to the github version ----
  output$Table <- DT::renderDataTable({
    req(data())
    brushedPoints(data_n(), brush = input$plot_brush) %>%
      select(Sample) 
  })

}

功能服务器

它已经被移除,因为断裂的至少不会崩溃,而且问题很明显。请参见以前对原始文件的编辑。

咨询的消息来源

Interactive file input and reactive reading in shinyapp
https://github.com/rstudio/shiny/issues/167
- 寻找灵感 isolate 和 observers
https://groups.google.com/forum/#!topic/shiny-discuss/QgdUfWGsuVU

会话信息

R版本3.4.2(2017-09-28)
平台:x86_64-w64-mingw32/x64(64位)
运行于:Windows 7 x64(内部版本7601)Service Pack 1

更新

在 Observe() 阻止了应用程序崩溃,它确实更新了文件(忘记删除一些内容)。剩下的就是把依赖用户界面保存在某个地方…

1 回复 | 直到 7 年前

A Duv 7 年前

简而言之,问题是由于没有正确理解 observers ,缺少 () 在一次反应之后,没有打电话 req 阻止某些部分重新执行(请参见 HERE )中。

具体的逐行更新可以通过查找 ##CHANGE: 下面…最重要的变化(没有明显的顺序)是:

使用 isolate() 对于 renderUI
使用 req() 在 伦德瑞 放慢速度,直到组中有更新时才运行,但调用 args() 使其依赖于文件选择
预先计算 伦德瑞

更新的服务器

server_fixed <- function(input, output, session) { 

  #Larger subset: A Reactive Expression # May be used later...
  args <- reactive({
    list(input$p, input$s)  #which file do we wish to input. This was our tag
  })
  # Reactive File-reader Subset
  path <- reactive({
    paste0(input$p, input$s, ".csv")
  }) # Reactive Filename, kinda like our args... 



  filereader <- function(input) { # The function we pass into a reactive filereader. 
    suppressWarnings(read_csv(input, col_types = cols(
      Group = col_character(),
      Sample = col_character(),
      x = col_double(),
      y = col_double())
    ))
  }

  data_1 <- reactiveValues() # The function we use for livestream data
  observe({
    if(file.exists(path()) == TRUE) {
      fileReaderData <-  reactiveFileReader(500, session, path(), filereader) 
    }  else { 
      message("This file does not exist")
    }
    data_1$df <- reactive({
      # if(exists(fileReaderData())) {
      #   fileReaderData()
      # } # Crashed from the beginning
      req(fileReaderData()) 
      fileReaderData()
    })   
  }) 

  data <- reactive(data_1$df()) ##CHANGE: FORGOT THE ()##

  # Group setting...
  data_m <- reactive({
    req(data()) 
    args()
    tmp <- isolate(select(data(), Group))
    tmp %>% distinct()
  }) #number of markers, keeping only the marker name

  data_m_length <- reactive({ ##CHANGE: TOOK OUT OF output$num_2## 
  ##CHANGE: ADDED AN ISOLATE to fix the # of groups per file ##

    isolate(length(data_m()$Group))
  })

  output$num_2 <- renderUI({
    req(data_m_length()) ## CHANGE: ONLY EXECUTE ONCE WE HAVE OUR isolated data_m_length##
    args() ## CHANGE: DEPENDENT UPON changing files##
    isolate(
    numericInput(inputId = "n",
                 label = "Group:",
                 min = 1,
                 max = data_m_length(), 
                 value = 1 # THIS SHOULD BE CACHED! 
    )) ##CHANGE: ADDED IT IN ISOLATE when testing. NOT SURE IF STILL NEEDED##
  }) #This is our 'reactive' numeric input for groups. This caps the max of our function based on the number of groups there are per file

  n <- reactive(input$n) #which marker number we are dealing with. 

  data_n <- reactive({
    req(data()); req(data_m())
    dt <- filter(data(), Group == data_m()[[1]][n()])
  }) 


  # Create scatterplot object the plotOutput function is expecting ----
  ranges <- reactiveValues(x = NULL, y = NULL)


  output$scatterplot <- renderPlot({
    validate(need(data(), "The specified file does not exist. Please try another"))
    p <- as.numeric(input$p)
    plot <- ggplot(data_n(), aes(x, y)) +  
      labs(title = paste0("Group ", data_n()$Group[1])) + 
      labs(x = "X vals", y = "Y vals") + 
      geom_point() + theme_bw() # I already have customized aesthetics. Removed for minimalism  
    plot + coord_cartesian(xlim = ranges$x, ylim = ranges$y, expand = TRUE) # So we see all points more readily. messes up the zoom but oh well
  })

  # When a double-click happens, check if there's a brush on the plot.
  # If so, zoom to the brush bounds; if not, reset the zoom.
  observeEvent(input$plot_dblclick, {
    brush <- input$plot_brush
    if (!is.null(brush)) {
      ranges$x <- c(brush$xmin, brush$xmax)
      ranges$y <- c(brush$ymin, brush$ymax)
    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
  })  


  #Creating text ----
  output$group_n <- renderText({
    req(data())
    paste0("There are ", length(data_m()$Group), " groups in this file.",
           tags$br("This is Group: ", data_m()$Group[n()])
    )
  }) 

  #Building a table for you to visibly see points. You may need to update the DT to the github version ----
  output$Table <- DT::renderDataTable({
    req(data())
    brushedPoints(data_n(), brush = input$plot_brush) %>%
      select(Sample) 
  })

}

剩下的就是用 suppressError 和 validate 恰如其分。