r shiny 使闪亮的打印消息到用户界面

Question

我有一个简单闪亮的应用程序。首先，我在工作目录中生成了 2 个 csv 文件：

write.csv(data.frame(a = 1:4, b = 2:5), "x.csv", row.names = F)
write.csv(data.frame(a = 1:4, c = 11:14), "y.csv", row.names = F)

在我的应用中，我希望用户：

读入 2 个文件（x.csv 和 y.csv）和...
点击按钮 'Run'!
之后我希望 server.R 写出 2 个 csv 文件 - 但也打印出某些消息供用户查看。

我下面的代码有效，但目前用户的消息看起来非常难看，每条消息都位于暗灰色背景上。两个问题：

我的方法是唯一为用户打印消息的方法吗？或者也许有更优雅的？
如何修改灰色背景、字体大小、颜色等？

非常感谢！

library(shiny)
library(shinyjs)

# ui code:

ui <- fluidPage(

  useShinyjs(),
  br(),
  # User should upload file x.csv here:
  fileInput("file_x", label = h5("Upload file 'x.csv'!")),
  br(),
  # User should upload file y.csv here:
  fileInput("file_y", label = h5("Upload file 'y.csv'!")),
  br(),
  # Users clicks the button:
  actionButton("do_it", "Run!"),
  br(),
  hidden(p("First, please upload one of the 2 files above!",
           id = "p_nofiles",
           style = "font-weight:bold;color:red;")),
  br(),
  verbatimTextOutput("message_1"),
  br(),
  verbatimTextOutput("message_2"),
  br(),
  verbatimTextOutput("message_3")

)

# server code:

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

  observeEvent(input$do_it, {

    # If there file_x input is NULL, show the message in p_nofile
    if (is.null(input$file_x) | is.null(input$file_y)) {
      shinyjs::show("p_nofiles")
    } else {
      # if both files are selected, hide the p_nofiles message
      shinyjs::hide("p_nofiles")

      # Check my button's value:
      output$print_action <- renderPrint({input$do_it})

      # Read in file x_csv:
      infileX <- input$file_x
      if (is.null(infileX)) {  
        return(NULL)     
        }
      x <- read.csv(infileX$datapath)

      # Read in file y_csv:
      infileY <- input$file_y
      if (is.null(infileY)) {  
        return(NULL)     
      }
      y <- read.csv(infileY$datapath)

      #-------------------------------------------------------------------------------------------
      # MESSAGES I WANT THE USER TO SEE:

      # MESSAGE 1 - always there: What names do x and y have in common?
      mes1 <- paste0("x and y have these columns in common: ", 
                     intersect(names(x), names(y)), "\n")
      output$message_1 <- renderText({mes1})

      # MESSAGE 2 - with 2 alternative texts: Do x and y have the same number of rows?
      if (nrow(x) == nrow(y)) { 
        mes2 <- "x and y have the same number of rows!\n"
      } else {
          mes2 <- "x has a different number of rows than y\n"
      }
      output$message_2 <- renderText({mes2})

      # MESSAGE 3 - to be printed only under one condition:
      # Do x and y have a different number of columns? Print only it's different, otherwise - nothing
      if (ncol(x) != ncol(y)) { 
        mes3 <- "x and y do NOT have the same number of columns!\n"
        output$message_3 <- renderText({mes3})
      } else {output$message_3 <- renderText({NULL})}

      #-------------------------------------------------------------------------------------------
      # Writing out the same file x - but under a different name:

      filenameX <- paste0("x", input$do_it, ".csv")
      write.csv(x, file = filenameX, row.names = FALSE)

       # Writing out the same file y - but under a different name:
      filenameY <- paste0("y", input$do_it, ".csv")
      write.csv(y, file = filenameY, row.names = FALSE)
    }
  })
}

shinyApp(ui, server)

Answer 1

我编辑了你的代码，试试这个。需要注意的是服务器中有showModal(...)的部分。

library(shiny)
library(shinyjs)

UI代码：

ui <- fluidPage(

  useShinyjs(),
  br(),
  # User should upload file x.csv here:
  fileInput("file_x", label = h5("Upload file 'x.csv'!")),
  br(),
  # User should upload file y.csv here:
  fileInput("file_y", label = h5("Upload file 'y.csv'!")),
  br(),
  # Users clicks the button:
  actionButton("do_it", "Run!"),
  br(),
  hidden(p("First, please upload one of the 2 files above!",
           id = "p_nofiles",
           style = "font-weight:bold;color:red;"))
  # br(),
  # verbatimTextOutput("message_1"),
  # br(),
  # verbatimTextOutput("message_2"),
  # br(),
  # verbatimTextOutput("message_3")

)

服务器代码：

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

observeEvent(input$do_it, {

# If there file_x input is NULL, show the message in p_nofile
if (is.null(input$file_x) | is.null(input$file_y)) {
  shinyjs::show("p_nofiles")
} else {
  # if both files are selected, hide the p_nofiles message
  shinyjs::hide("p_nofiles")

  # Check my button's value:
  output$print_action <- renderPrint({input$do_it})

  # Read in file x_csv:
  infileX <- input$file_x
  if (is.null(infileX)) {
    return(NULL)
    }
  x <- read.csv(infileX$datapath)

  # Read in file y_csv:
  infileY <- input$file_y
  if (is.null(infileY)) {
    return(NULL)
  }
  y <- read.csv(infileY$datapath)

  #-------------------------------------------------------------------------------------------
  # MESSAGES I WANT THE USER TO SEE:

  # MESSAGE 1 - always there: What names do x and y have in common?
  mes1 <- paste0("x and y have these columns in common: ",
                 intersect(names(x), names(y)), "\n")
  # output$message_1 <- renderText({mes1})


  # MESSAGE 2 - with 2 alternative texts: Do x and y have the same number of rows?
  if (nrow(x) == nrow(y)) {
    mes2 <- "x and y have the same number of rows!\n"
  } else {
      mes2 <- "x has a different number of rows than y\n"
  }
  # output$message_2 <- renderText({mes2})

  # MESSAGE 3 - to be printed only under one condition:
  # Do x and y have a different number of columns? Print only it's different, otherwise - nothing
  if (ncol(x) != ncol(y)) {
    mes3 <- "x and y do NOT have the same number of columns!\n"
    # output$message_3 <- renderText({mes3})
  } else {mes3 <- renderText({NULL})}

  showModal(modalDialog(
    title = "Mensagens to User",
    "More Text",
    mes1,
    HTML("<br />"),
    mes2,
    HTML("<br />"),
    mes3,
    easyClose = TRUE,
    footer = "Footer"
    ))

  #-------------------------------------------------------------------------------------------
  # Writing out the same file x - but under a different name:

  filenameX <- paste0("x", input$do_it, ".csv")
  write.csv(x, file = filenameX, row.names = FALSE)

   # Writing out the same file y - but under a different name:
  filenameY <- paste0("y", input$do_it, ".csv")
  write.csv(y, file = filenameY, row.names = FALSE)
}
  })
}

shinyApp(ui, server)

r shiny 使闪亮的打印消息到用户界面

r shiny make shiny print messages to user interface

r

verbatim

shiny

UI代码：

服务器代码：