简体   繁体   中英

Dashboard deployed on shinyApps.io shows weird symbols

The local version of the dashboard looks different from the one deployed on the free Shiny server. To correct for this, I add some ccs and html to brute force the appearance. However, I am still running into some issues.

This is what it looks like locally: 在此处输入图像描述

This is what it looks like deployed on the shiny server:

在此处输入图像描述

  1. Notice the weird symbols on the top left: (]*)?>)\1, 在此处输入图像描述

  2. The symbols on the bottom left: 'TRUE TRUE TRUE'. 在此处输入图像描述

I have no idea what is causing this to happen. I've spent a lot of time tweaking the code, without any result.

I would really appreciate some insight, This issue only occurs when it is deployed on the server. and shows on BOTH tabs of the dashboard: :(

Here is my code:

library(shiny) # load the shiny package
library(ggplot2) # load the gglpot2 package if ploting using ggplot
library("shinythemes")
library(magrittr)
library(tidyverse)
library(shinyWidgets)
library(shiny)
library(shinymanager)
library(bsTools)
library(shinyBS)










# this was set placement to bottom, but selectize calls below were set to right set "right" here and no need to set it below

selectizeTooltip <- function(id, choice, title, placement = "right", trigger = "hover", options = NULL){
  
  options = shinyBS:::buildTooltipOrPopoverOptionsList(title, placement, trigger, options)
  options = paste0("{'", paste(names(options), options, sep = "': '", collapse = "', '"), "'}")
  bsTag <- shiny::tags$script(shiny::HTML(paste0("
         $(document).ready(function() {
           var opts = $.extend(", options, ", {html: true});
           var selectizeParent = document.getElementById('", id, "').parentElement;
           var observer = new MutationObserver(function(mutations) {
             mutations.forEach(function(mutation){
               $(mutation.addedNodes).filter('div').filter(function(){return(this.getAttribute('data-value') == '", choice, "');}).each(function() {
                 $(this).tooltip('destroy');
                 $(this).tooltip(opts);
               });
             });
           });
           observer.observe(selectizeParent, { subtree: true, childList: true });
         });")))
  htmltools::attachDependencies(bsTag, shinyBS:::shinyBSDep)
}


ui <- fluidPage(navbarPage(
  theme = shinytheme("superhero"),
  # can't comment within this section like I'd prefer ---
  # first - control the tooltip window- I added min-width and max-width
  # tool tip to the top by using z-index (I think that's why the tip was hidden) 
  #      -- however, it still wants to show the tip after selecting it and the tip is hidden then...
  # then control font-size by the entire form - (labels and input boxes don't inherit the form's styles)
  # I tried to set the styles for the labels here, but they wouldn't stick 
  
  # I captured the class names by visiting developer tools in my browser after rendering online
  # the class labels were not all the same when looking at it locally and after uploading
  
  tags$head(tags$style(HTML('.tooltip .tooltip-inner { min-width: 200px; max-width: 400px;
                              font-size: 1.5em; text-align:left; padding:10px; z-index: 2 !important;}
                              .shiny-input-container .control-label {margin-bottom: 1em;}
                              .selectize-dropdown .option .selectize-input {line-height:1.1em; font-size:2em!important;}
                              .well {min-height:200px; min-width:200px; font-size:1.5em!important;}'))),
  
  
  
  tabPanel(
    
    title = "Program Participation",
    sidebarLayout(
      sidebarPanel(
        uiOutput("choose_prog"),
        uiOutput("choose_name"),
        selectizeTooltip(id="choose_name", choice = "group 1", 
                         title = "group 1 definition this is a long definition that does not really display well within the narrow text box",
                         trigger = "hover"),
        selectizeTooltip(id="choose_name", choice = "group 2", 
                         title = "group 2 definition this is another long definition. When group 1 and group 3 is is selected, you no longer see this definition", 
                         trigger = "hover"),
        selectizeTooltip(id="choose_name", choice = "group 3", 
                         title = "group 3 definition this does not show if all of the other groups are selected ",
                         trigger = "hover"),
 
      ),
      
      mainPanel(
        plotOutput("plot")
        # br(),
        
      )
    )),
  
  # SECOND TAB 
  tabPanel(title = "Additional Information/ Documentation",
           pageWithSidebar(
             
             headerPanel("Data sources and other information"),
             
             sidebarPanel(
               
             ),
             
             
             mainPanel("Place holder for information about data"
             )
           )
           
           
           
  )
))

server <- function(input, output) {
  
  # result_auth <- secure_server(check_credentials = check_credentials(credentials))
  
  
  output$plot <- renderPlot({
    plot(mtcars$wt, mtcars$mpg)
  }, height = 800, width = 'auto')
  
  # Drop down selection to chose the program 
  output$choose_prog <- renderUI({
    selectInput("program", 
                label = HTML('<font style="color:orange; font-size:2em;">Select a program:</font>'),
                choices = c("A","B","C"))
  })
  # Drop down for name
  output$choose_name <- renderUI({
    
    # SelectInput works, but this only allows the selection of a SINGLE option
    selectInput("names",
                label = HTML('<font style="color:orange; font-size:2em;">Select user group of interest:</font>'),
                choices = c("group 1", "group 2", "group 3"), 
                multiple = T)})
  
  
  observeEvent(input$choose_name, {
    updateSelectizeInput(session, "choose_name", choices =  c("group 1", "group 2", "group 3"))
  })
}

shinyApp(ui = ui, server = server)

Your rending true true true (and other appearing randomness) is eliminated by updating the libraries to what you're actually using. For all of this programming, you only need to call:

library(shiny)
library(shinythemes)
library(tidyverse)

You used pageWithSidebar() in your second tabPanel . That function is deprecated. If you're going to use this app for a while, change that to fluidPage() or fluidRow() .

When I rendered this, it kept wanting to put the plot below the sidebar. You should add fluidRow() in the first tabPanel() . That way it will try to render them next to each other unless the fit is an issue.

You have the plot at a set height and an auto width. I'm not sure exactly how shiny reads and renders this. It may be useful to lock the aspect ratio.

In the tags$head ... call, I added .column-sm-8 {min-width:400px;} to make the main panel of the first tabPanel have a minimum width. It looks like this class (so this minimum width) will apply to any mainPanel you use.

Lastly, in the server function, you have the plot than the input form. Since it looks like your building the complexity as you go, it would be ideal to order the content here as it appears, when it gets really complex it will make following your work a lot easier. R doesn't care what order you put it in, though.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM