折叠菜单闪亮,但在闪亮的应用程序中削减标题

时间:2017-01-11 19:26:48

标签: javascript html css r shiny

我创建了一个像Google表单一样的闪亮应用。它工作正常,但当我使用页面顶部的按钮显示/隐藏侧边栏时,它会更改页面顶部的标题。我不希望这种情况发生。

问题似乎在这里:

runjs(' 
      var el2 = document.querySelector(".skin-green");
      el2.className = "skin-green sidebar-mini";
      ')# this is creating a sidebar mini, but it wraps up the title to trim it... I don't want that! 

即使在style = "position: fixed; overflow: visible;",功能下添加sidebarMenu,它仍无效。

我该如何解决这个问题?解决方案的一部分seems here

enter image description here

enter image description here

以下是完整代码:

# Apps
library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyjs)
# Fields definition -------------------------------------------------------
# Define the fields we want to save from the form
fields <- c("name", # the order here will be the same as the one that is saved in a CSV! 
            "title_reference",
            "year_publication",
            "first_author",
            "journal",
            "Species",
            "used_shiny",
            "favourite_pkg", 
            "os_type", 
            "r_num_years",
            "comments")

# Mandatory fields --------------------------------------------------------
# Defines mandatory fields: 
fieldsMandatory <- c("name", 
                     "favourite_pkg")
# Labeling with star for mandatory fields
labelMandatory <- function(label) {
  tagList(
    label,
    span("*", class = "mandatory_star")
  )
}

# Design ------------------------------------------------------------------
# Red star for mandatory fields 
appCSS <- 
  ".mandatory_star { color: red; }
#error { color: red; }"


# Increase the file size to be uploaded!
options(shiny.maxRequestSize=30*1024^2) # 30MB 

# To save the Data  -------------------------------------------------------
library(rdrop2) 
# This  is a folder that is going to be created on Dropbox 
outputDir <- "responses"

epochTime <- function() {
  as.integer(Sys.time())
}

humanTime <- function() {
  format(Sys.time(), "%Y%m%d-%H%M%OS")
}

saveData <- function(data) {
  data = c(data, timestamp = epochTime())
  data <- t(data)
  # Create a unique file name
  fileName <- sprintf("evo_rates_form_%s_%s.csv", 
                      humanTime(), 
                      digest::digest(data))
  # Write the data to a temporary file locally
  filePath <- file.path(tempdir(), 
                        fileName)
  write.csv(data, 
            filePath, 
            row.names = FALSE, 
            quote = TRUE)

  # Upload the file to Dropbox
  drop_upload(filePath, 
              dest = outputDir)
}


loadData <- function() {
  # Read all the files into a list
  filesInfo <- drop_dir(outputDir)
  filePaths <- filesInfo$path
  data <- lapply(filePaths, drop_read_csv, stringsAsFactors = FALSE)
  # Concatenate all data together into one data.frame
  data <- do.call(rbind, data)
  data
}


# ShinyAPP ----------------------------------------------------------------
# Shiny app with 3 fields that the user can submit data for
shinyApp(
  ui = dashboardPage(skin = "green",
                     dashboardHeader(title = "Evolutionary Rates Form", titleWidth = 250),
                     dashboardSidebar(#disable = TRUE,
                       width = 150,
                       sidebarMenu(menuItem("Menu"),
                                   menuItem("Form", tabName = "form_tab", icon = icon("file-text")),
                                   menuItem("Help", tabName = "help_tab", icon = icon("question"))
                       )
                     ),
                     dashboardBody(

                       shinyjs::useShinyjs(), 
                       shinyjs::inlineCSS(appCSS), # you need this if you want to change the "design" of you form

                       # Form inputs -------------------------------------------------------------
                       tabItems(
                         # First tab content
                         tabItem(tabName = "form_tab",

                                 div(
                                   h2("Main form"),
                                   id = "form",
                                   ## text input 
                                   textInput("name", 
                                             list(tags$span(
                                               labelMandatory("Name (First and last name)"),   
                                               tipify(bsButton("pB2", "?", 
                                                               style = "inverse", 
                                                               size = "extra-small"), 
                                                      "Please insert your name here") # Close tipify
                                             ) # Close span
                                             ), # Close list
                                             ""), # Close textInput
                                   textInput("favourite_pkg", 
                                             labelMandatory("Favourite R package")),
                                   textInput("title_reference",
                                             "Title of the reference"),
                                   textInput("year_publication",
                                             "Year of publication"),
                                   textInput("first_author",
                                             "First author"),
                                   textInput("journal",
                                             "Journal"),
                                   textInput("Species","Species"),


                                   ## Checkbox input 
                                   checkboxInput("used_shiny", 
                                                 "I've built a Shiny app in R before", 
                                                 FALSE),
                                   ## Slider input 
                                   sliderInput("r_num_years", 
                                               "Number of years using R",
                                               0, 25, 2, ticks = FALSE),

                                   ## Dropdown menu input 
                                   selectInput("os_type", 
                                               "Operating system used most frequently",
                                               c("",  "Windows", "Mac", "Linux")),

                                   ## Upload data!
                                   fileInput(inputId = 'upload', 
                                             label = 'Choose CSV File',
                                             accept=c('text/csv', 
                                                      'text/comma-separated-values,text/plain', 
                                                      '.csv'),
                                             multiple = FALSE),

                                   # Add your comments here 
                                   textInput("comments", "Comments", placeholder = "Type your comments and ideas here"),
                                   # verbatimTextOutput("value"),



                                   ## Action button 
                                   actionButton("submit", 
                                                "Submit"),

                                   # Submission progression bar or Error
                                   shinyjs::hidden(
                                     span(id = "submit_msg", 
                                          "Submitting..."),
                                     div(id = "error",
                                         div(br(), 
                                             tags$b("Error: "), # b tags is for bold text 
                                             span(id = "error_msg"))
                                     ) # Closing div
                                   ) # Closing shinyjs::hidden

                                 ) # Closing div
                         ), # closing tab 1 

                         # Second tab content
                         tabItem(tabName = "help_tab",
                                 h2("Need help or information?"),
                                 h3("Contact"),
                                 HTML('Please send an email to <a href="mailto:adress@gmail.com?subject=Question about Evolutionary Rates Archive Project Form">Evolutionary Rates Archive Project (evolutionaryrates@gmail.com)</a>.'),
                                 h3("What's needed in the form?"),
                                 div(span("The red star ("), span("*",style="color:red"), span(") means that it's a mandatory field")
                                 ), # Close div 
                                 br(),
                                 p("Thank you for your feeddback. We appreciate all comments and ideas.")
                         ) # Closing tab 2
                       ), # Closing tabItems

                       # Thank you message -------------------------------------------------------    
                       shinyjs::hidden(
                         div(
                           id = "thankyou_msg",
                           h2("Thanks, your response was submitted successfully!"),
                           actionLink("submit_another", 
                                      "Submit another response")
                         ) # Closing div 
                       ) # Closing shinyjs::hidden

                     ) # Closing DashboardBody
  ), # Closing DashboardPage

  # Server ------------------------------------------------------------------
  server = function(input, output, session) {

    runjs(' 
          var el2 = document.querySelector(".skin-green");
          el2.className = "skin-green sidebar-mini";
          ')# this is createing a sidebar mini, but it wraps up the title to trim it... 

    # Whenever a field is filled, aggregate all from data
    formData <- reactive({
      data <- sapply(fields, function(x) input[[x]])
      data
    })

    observe({
      # check if all mandatory fields have a value
      mandatoryFilled <-
        vapply(fieldsMandatory,
               function(x) {
                 !is.null(input[[x]]) && input[[x]] != ""
               },
               logical(1))
      mandatoryFilled <- all(mandatoryFilled)

      # enable/disable the submit button
      shinyjs::toggleState(id = "submit", 
                           condition = mandatoryFilled)

      if (is.null(input$upload)) return()
      file.copy(from = input$upload$datapath, 
                to = paste0("evol_input_",input$upload$name)) 

    })

    observeEvent(input$button, {
      shinyjs::info("Please type your name")
    })

    # When the Submit button is clicked, save the form data (action to take when submit button is pressed)
    observeEvent(input$submit, {
      shinyjs::disable("submit")

      shinyjs::show("submit_msg")
      shinyjs::hide("error")

      tryCatch({
        saveData(formData())
        drop_upload(paste0("evol_input_",
                           input$upload$name), #input$upload$datapath, it's going to retreive the files directly into the tempdi() directory
                    dest = "responses/dataframes")
        shinyjs::reset("form")
        shinyjs::hide("form")
        shinyjs::show("thankyou_msg")
      },
      error = function(err) {
        shinyjs::text("error_msg", err$message)
        shinyjs::show(id = "error", anim = TRUE, animType = "fade")
      },
      finally = {
        shinyjs::enable("submit")
        shinyjs::hide("submit_msg")
      })
    })

    # Hide the thank you message and show the form 
    observeEvent(input$submit_another, {
      shinyjs::show("form")
      shinyjs::hide("thankyou_msg")
    })    
  }
    )

同时,当侧栏坍塌时,有没有办法缩短标题?例如,“进化率表格”将崩溃为“ERF”。

0 个答案:

没有答案