如何为R/Shiny中复制粘贴输入区域定义Server逻辑？

核心修改思路 #

1. 新增文本输入的解析逻辑，将用户粘贴的文本转换为符合要求的data.table格式
2. 统一查询数据的获取入口，根据用户选择的输入源（文件/文本）自动切换数据源
3. 增加输入格式验证，避免非法输入导致应用崩溃

修改后的完整代码 #

library(shiny)
library(data.table)
library(dplyr)
library(DT)

DF<- data.table(chr=c("chr1","chr2"),start=c(10,20),end=c(20,30))%>% setkey(chr, start, end) 

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel (
      p(strong ("Find overlap between query file and data"),style = "color:blue;"),
      br(),
      selectInput("choose","Choose file source",choices = c("file","text"),selected = "file"),
      conditionalPanel("input.choose=='file'",
                       fileInput("query.file", "Upload genomic coordinates in .bed 
                                 format:",multiple = F,accept = ".bed")),
      conditionalPanel("input.choose=='text'",
                       textAreaInput("query.text", "Enter genomic coordinates (chr start end, one line per region):", rows = 5)),
      actionButton("run", "run"),
      width = "2"),
    mainPanel(
      dataTableOutput("DFtable"),
      dataTableOutput("overlap_table"))
  )
)

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

  ## 处理上传的BED文件
  user_query.file <- reactive({
    req(input$query.file)
    ext <- tools::file_ext(input$query.file$name)
    switch(ext,
           bed = fread(input$query.file$datapath,header=F)%>% 
             dplyr::rename (chr =V1, start=V2, end=V3) %>% setkey(chr, start, end)%>% unique()
    )
  })

  ## 处理粘贴的文本数据
  user_query.text <- reactive({
    req(input$query.text)
    # 直接读取文本内容，支持空格/制表符分隔的BED格式
    text_data <- fread(text = input$query.text, header = F)
    
    # 验证输入格式是否正确（必须为3列）
    validate(
      need(ncol(text_data) == 3, "请输入正确的格式：每行包含chr、start、end三列，用空格或制表符分隔")
    )
    
    text_data %>%
      dplyr::rename(chr = V1, start = V2, end = V3) %>%
      setkey(chr, start, end) %>%
      unique()
  })

  ## 统一获取查询数据（根据用户选择的输入源切换）
  user_query <- reactive({
    req(input$choose)
    if (input$choose == "file") {
      user_query.file()
    } else {
      user_query.text()
    }
  })

  ## 执行重叠分析
  overlap <- eventReactive(input$run, {
    req(user_query())
    withProgress(message = 'Analysis in progress', value = 0, {
      foverlaps(user_query(), DF, nomatch = 0) %>% 
        unique()
    })
  })

  ## 输出结果
  output$DFtable<- renderDataTable({ DF })
  output$overlap_table <- renderDT({overlap () }) 

}

shinyApp(ui, server)

关键修改点说明 #

• 文本解析逻辑：使用fread(text = input$query.text)直接读取文本框内容，无需临时文件，自动处理空格/制表符分隔的格式
• 格式验证：通过validate()和need()检查输入是否为3列，给用户明确的错误提示
• 统一数据源：新增user_query() reactive对象，自动根据用户选择的输入源返回对应的数据，让重叠分析逻辑无需区分输入类型
• UI优化：给文本输入框添加了格式提示，帮助用户正确输入

测试文本输入示例 #

在文本框中粘贴以下内容，点击run即可得到期望输出：

chr1 15 15
chr2 25 30

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