R闪亮:在navbarPage中使用navbarPage应用程序(结合ShinyChat和DataTable选项示例)

Question

谢谢你提前阅读..。

我试图创建一个数据管理网站，在那里我可以给人们提供数据更新，并与他们保持讨论，以解决出现的数据相关问题。我用得越多，就越相信这是生活的答案。不过，对我来说，在更复杂的应用程序上，语法仍然很困难。

我正在尝试结合下面的精彩例子，从闪亮的画廊，并从那里构建(我鞠躬给每个谁贡献了代码的画廊和GitHub存储库.特别令人印象深刻的东西)：

DataTable Options http://shiny.rstudio.com/gallery/datatables-options.html

和

ShinyChat http://shiny.rstudio.com/gallery/chat-room.html

基本上-我想迫使反应性ShinyChat应用成为DataTable选项应用程序的第一个选项卡。我的沮丧之处在于正确地组合了ui.R和server.R脚本。我将发布这两篇文章的全文:广泛的ui.R和server.R脚本，所以没有人为了帮助我而去寻找信息，但是要知道其他文件需要下载才能让ShinyChat运行。

DataTable Options ui.R脚本是：

library(shiny)

shinyUI(navbarPage(
  title = 'DataTable Options',
  tabPanel('Display length',     dataTableOutput('ex1')),
  tabPanel('Length menu',        dataTableOutput('ex2')),
  tabPanel('No pagination',      dataTableOutput('ex3')),
  tabPanel('No filtering',       dataTableOutput('ex4')),
  tabPanel('Individual filters', dataTableOutput('ex5')),
  tabPanel('Function callback',  dataTableOutput('ex6'))
))

DataTable Options server.R脚本是：

library(shiny)

shinyServer(function(input, output) {

  # display 10 rows initially
  output$ex1 <- renderDataTable(iris, options = list(pageLength = 10))

  # -1 means no pagination; the 2nd element contains menu labels
  output$ex2 <- renderDataTable(iris, options = list(
    lengthMenu = list(c(5, 15, -1), c('5', '15', 'All')),
    pageLength = 15
  ))

  # you can also use paging = FALSE to disable pagination
  output$ex3 <- renderDataTable(iris, options = list(paging = FALSE))

  # turn off filtering (no searching boxes)
  output$ex4 <- renderDataTable(iris, options = list(searching = FALSE))

  # turn off filtering on individual columns (3rd and 4th column)
  output$ex5 <- renderDataTable(iris, options = list(
    columnDefs = list(list(targets = c(3, 4) - 1, searchable = FALSE)),
    pageLength = 10
  ))

  # write literal JS code in I()
  output$ex6 <- renderDataTable(
   iris,
    options = list(rowCallback = I(
      'function(row, data) {
        // Bold cells for those >= 5 in the first column
        if (parseFloat(data[0]) >= 5.0)
          $("td:eq(0)", row).css("font-weight", "bold");
      }'
    ))
  )
})

ShinyChat ui.R脚本是：

library(shiny)

shinyUI(
  bootstrapPage(
    # We'll add some custom CSS styling -- totally optional
    includeCSS("shinychat.css"),

    # And custom JavaScript -- just to send a message when a user hits "enter"
    # and automatically scroll the chat window for us. Totally optional.
    includeScript("sendOnEnter.js"),

    div(
      # Setup custom Bootstrap elements here to define a new layout
      class = "container-fluid", 
      div(class = "row-fluid",
          # Set the page title
          tags$head(tags$title("ShinyChat")),

          # Create the header
          div(class="span6", style="padding: 10px 0px;",
              h1("ShinyChat"), 
              h4("Hipper than IRC...")
          ), div(class="span6", id="play-nice",
            "IP Addresses are logged... be a decent human being."
          )

      ),
      # The main panel
      div(
        class = "row-fluid", 
        mainPanel(
          # Create a spot for a dynamic UI containing the chat contents.
          uiOutput("chat"),

          # Create the bottom bar to allow users to chat.
          fluidRow(
            div(class="span10",
              textInput("entry", "")
            ),
            div(class="span2 center",
                actionButton("send", "Send")
            )
          )
        ),
        # The right sidebar
        sidebarPanel(
          # Let the user define his/her own ID
          textInput("user", "Your User ID:", value=""),
          tags$hr(),
          h5("Connected Users"),
          # Create a spot for a dynamic UI containing the list of users.
          uiOutput("userList"),
          tags$hr(),
          helpText(HTML("<p>Built using R & <a href = \"http://rstudio.com/shiny/\">Shiny</a>.<p>Source code available <a href =\"https://github.com/trestletech/ShinyChat\">on GitHub</a>."))
        )
      )
    )
  )
)

ShinyChat server.R脚本是：

library(shiny)
library(stringr)

# Globally define a place where all users can share some reactive data.
vars <- reactiveValues(chat=NULL, users=NULL)

# Restore the chat log from the last session.
if (file.exists("chat.Rds")){
  vars$chat <- readRDS("chat.Rds")
}

#' Get the prefix for the line to be added to the chat window. Usually a newline
#' character unless it's the first line.
linePrefix <- function(){
  if (is.null(isolate(vars$chat))){
    return("")
  }
  return("<br />")
}

shinyServer(function(input, output, session) {
  # Create a spot for reactive variables specific to this particular session
  sessionVars <- reactiveValues(username = "")

  # Track whether or not this session has been initialized. We'll use this to
  # assign a username to unininitialized sessions.
  init <- FALSE

  # When a session is ended, remove the user and note that they left the room. 
  session$onSessionEnded(function() {
    isolate({
      vars$users <- vars$users[vars$users != sessionVars$username]
      vars$chat <- c(vars$chat, paste0(linePrefix(),
                     tags$span(class="user-exit",
                       sessionVars$username,
                       "left the room.")))
    })
  })

  # Observer to handle changes to the username
  observe({
    # We want a reactive dependency on this variable, so we'll just list it here.
    input$user

    if (!init){
      # Seed initial username
      sessionVars$username <- paste0("User", round(runif(1, 10000, 99999)))
      isolate({
        vars$chat <<- c(vars$chat, paste0(linePrefix(),
                        tags$span(class="user-enter",
                          sessionVars$username,
                          "entered the room.")))
      })
      init <<- TRUE
    } else{
      # A previous username was already given
      isolate({
        if (input$user == sessionVars$username || input$user == ""){
          # No change. Just return.
          return()
        }

        # Updating username      
        # First, remove the old one
        vars$users <- vars$users[vars$users != sessionVars$username]

        # Note the change in the chat log
        vars$chat <<- c(vars$chat, paste0(linePrefix(),
                        tags$span(class="user-change",
                          paste0("\"", sessionVars$username, "\""),
                          " -> ",
                          paste0("\"", input$user, "\""))))

        # Now update with the new one
        sessionVars$username <- input$user
      })
    }
    # Add this user to the global list of users
    isolate(vars$users <- c(vars$users, sessionVars$username))
  })

  # Keep the username updated with whatever sanitized/assigned username we have
  observe({
    updateTextInput(session, "user", 
                    value=sessionVars$username)    
  })

  # Keep the list of connected users updated
  output$userList <- renderUI({
    tagList(tags$ul( lapply(vars$users, function(user){
      return(tags$li(user))
    })))
  })

  # Listen for input$send changes (i.e. when the button is clicked)
  observe({
    if(input$send < 1){
      # The code must be initializing, b/c the button hasn't been clicked yet.
      return()
    }
    isolate({
      # Add the current entry to the chat log.
      vars$chat <<- c(vars$chat, 
                      paste0(linePrefix(),
                        tags$span(class="username",
                          tags$abbr(title=Sys.time(), sessionVars$username)
                        ),
                        ": ",
                        tagList(input$entry)))
    })
    # Clear out the text entry field.
    updateTextInput(session, "entry", value="")
  })

  # Dynamically create the UI for the chat window.
  output$chat <- renderUI({
    if (length(vars$chat) > 500){
      # Too long, use only the most recent 500 lines
      vars$chat <- vars$chat[(length(vars$chat)-500):(length(vars$chat))]
    }
    # Save the chat object so we can restore it later if needed.
    saveRDS(vars$chat, "chat.Rds")

    # Pass the chat log through as HTML
    HTML(vars$chat)
  })
})

Answer 1

也许我来晚了一点..。但最简单的方法是两个tabPanel()，一个包含聊天，另一个包含DataTable。

而且，在splitLayout()中这样在ui.R中很容易实现所有的功能。

shinyUI(fluidPage(
  splitLayout(
    #here include the DataTable,
    #here include the Chat
  )
)) 

我认为它甚至可以在server.R中粘贴代码，因为没有名称冲突。