【问题标题】:How to put if-else condition inside Shiny action button code?如何将 if-else 条件放入 Shiny 操作按钮代码中?
【发布时间】:2017-08-18 10:56:15
【问题描述】:

我正在开发的软件是使用 RStudio 的“样本选择软件”。该软件将像这样运行。用户上传 Excel 文档。然后,用户点击“提交”按钮。之后,软件会根据Excel文档的行数自动选择一定数量的样本,并显示出来。我已经有上传Excel文件的R代码界面和' “提交”按钮界面。我还有一个单独的 R 代码,它读取特定的 Excel 文件和 if-else 语句,它将根据 Excel 文件中的行数选择多个样本。我的问题是我不知道如何组合这两个单独的代码。


上传文件和提交按钮界面的R代码如下:

library(shiny)
library(xlsx)
ui <- fluidPage(
   titlePanel("KPMG"),
   sidebarLayout(
      sidebarPanel(
        fileInput('file1', 'Choose xlsx file', 
                  accept = c(".xlsx")
                  ),
        actionButton('submit', "Submit")
      ),
      mainPanel(
        tableOutput("contents")
      )
   )
)

server <- function(input, output) {

  output$contents <- renderTable({
    inFile <- input$file1

    if(is.null(inFile))
      return(NULL)
    file.rename(inFile$datapath,
                paste(inFile$datapath, ".xlsx", sep = ""))
    read.xlsx(paste(inFile$datapath, ".xlsx", sep = ""), 1)
  })
}
shinyApp(ui = ui, server = server)

读取特定 Excel 文件的 R 代码和将根据 Excel 文件中的行数选择多个样本的 if-else 语句如下:

library(xlsx)
wb <- read.xlsx("CompanyList.xlsx", sheetIndex = 1, )
nrow(wb) -> rows

        if (rows == 1) {
          wb[sample(rows, 1), ]
        } else 
          if (rows >= 2 & rows <= 4) {
            wb[sample(rows, 1), ]
          } else 
            if (rows >= 5 & rows <= 12) {
              wb[sample(rows, 2), ]
            } else 
              if (rows >= 13 & rows <= 52) {
                wb[sample(rows, 5), ]
              } else
                if (rows >= 53 & rows <= 365) {
                  wb[sample(rows, 15), ]
                } else
                  if (rows > 365) {
                    wb[sample(rows, 25), ]
                  } 

【问题讨论】:

    标签: r excel shiny rstudio rstudio-server


    【解决方案1】:

    只需使用数据框对象wb 和outdf 将 if/else 逻辑放在 renderTable({...}) 方法中,即可通过每个条件语句构建输出表:

    library(shiny)
    library(xlsx)
    
    ui <- fluidPage(
      titlePanel("KPMG"),
      sidebarLayout(
        sidebarPanel(
          fileInput('file1', 'Choose xlsx file', 
                    accept = c(".xlsx")
          ),
          actionButton('submit', "Submit")
        ),
        mainPanel(
          tableOutput("contents")
        )
      )
    )
    
    server <- function(input, output) {
    
        output$contents <- renderTable({
          inFile <- input$file1
    
          if (is.null(inFile))
            return(NULL)
    
          file.rename(inFile$datapath, paste(inFile$datapath, ".xlsx", sep=""))          
          wb <- read.xlsx(paste(inFile$datapath, ".xlsx", sep = ""), 1)
    
          nrow(wb) -> rows
    
          if (rows == 1) {
            outdf <- wb[sample(rows, 1), ]
          } else 
            if (rows >= 2 & rows <= 4) {
              outdf <- wb[sample(rows, 1), ]
            } else 
              if (rows >= 5 & rows <= 12) {
                outdf <- wb[sample(rows, 2), ]
              } else 
                if (rows >= 13 & rows <= 52) {
                  outdf <- wb[sample(rows, 5), ]
                } else
                  if (rows >= 53 & rows <= 365) {
                    outdf <- wb[sample(rows, 15), ]
                  } else
                    if (rows > 365) {
                      outdf <- wb[sample(rows, 25), ]
                    } 
          outdf          
        })
    }
    
    
    shinyApp(ui = ui, server = server)
    

    【讨论】:

    • 非常感谢!我已经尝试了代码并且它有效。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2022-01-24
    • 1970-01-01
    • 1970-01-01
    • 2021-10-14
    • 1970-01-01
    相关资源
    最近更新 更多