Shiny: App looks different when published

Question

I have written the code for an app that looks perfect when I run the app in R. See how clear the input choices and spacing is:

However, when I publish the app on the "Shiny Cloud", it looks like this: Notice how everything is bunched up, and the text at the bottom also looks tiny.

Any idea's for why this is happening? :/

Here is my code:

library(shiny)
library(shinyBS)
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)


selectizeTooltip <- function(id, choice, title, placement = "bottom", 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(theme = shinytheme("superhero"),  # shinythemes::themeSelector(), #
                

                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", placement = "right", 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", placement = "right", 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 ", placement = "right", trigger = "hover"),
                    htmlOutput("text"),
                    
                    
                  ),
                  
                  mainPanel(
                    plotOutput("plot"),
                  )
                )
                
)

server <- function(input, output) {
  
  # Drop down selection to chose the program 
  output$choose_prog <- renderUI({
    selectInput("program", 
                label = HTML('<FONT color="orange"><FONT size="4pt">Select a Program:'),
                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 color="orange"><FONT size="4pt">Select user group of interest:'),
                choices = c("group 1", "group 2", "group 3"), 
                multiple = T)
    
    

    
  })
  
  
  output$text <- renderText(paste("<br/>","<h4> STEM Students:</h3>", "This is a definition that I added in the side panel that looks perfect here"))
  
  observeEvent(input$choose_name, {
    updateSelectizeInput(session, "choose_name", choices =  c("group 1", "group 2", "group 3"))
  })
}

shinyApp(ui = ui, server = server)

Here is the user log on shiny cloud:

2021-04-06T19:12:44.462496+00:00 shinyapps[3893862]: ✔ tidyr   1.1.3     ✔ stringr 1.4.0
2021-04-06T19:12:44.462497+00:00 shinyapps[3893862]: ✔ readr   1.4.0     ✔ forcats 0.5.1
2021-04-06T19:12:44.462497+00:00 shinyapps[3893862]: ✔ purrr   0.3.4     
2021-04-06T19:12:44.536345+00:00 shinyapps[3893862]: ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
2021-04-06T19:12:44.536347+00:00 shinyapps[3893862]: ✖ tidyr::extract()   masks magrittr::extract()
2021-04-06T19:12:44.536349+00:00 shinyapps[3893862]: ✖ dplyr::lag()       masks stats::lag()
2021-04-06T19:12:44.536349+00:00 shinyapps[3893862]: ✖ dplyr::filter()    masks stats::filter()
2021-04-06T19:12:44.536349+00:00 shinyapps[3893862]: ✖ purrr::set_names() masks magrittr::set_names()
2021-04-06T19:12:44.816407+00:00 shinyapps[3893862]: Loading required package: html5
2021-04-06T19:12:44.828697+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.828698+00:00 shinyapps[3893862]: Attaching package: ‘html5’
2021-04-06T19:12:44.829434+00:00 shinyapps[3893862]: The following object is masked from ‘package:dplyr’:
2021-04-06T19:12:44.828699+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.829435+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.829435+00:00 shinyapps[3893862]:     select
2021-04-06T19:12:44.829436+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.829780+00:00 shinyapps[3893862]: The following object is masked from ‘package:purrr’:
2021-04-06T19:12:44.829781+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.829781+00:00 shinyapps[3893862]:     map
2021-04-06T19:12:44.829781+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.830105+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.830106+00:00 shinyapps[3893862]:     a, br, code, div, em, h1, h2, h3, h4, h5, h6, hr, img, p, pre,
2021-04-06T19:12:44.830105+00:00 shinyapps[3893862]: The following objects are masked from ‘package:shiny’:
2021-04-06T19:12:44.830382+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.830383+00:00 shinyapps[3893862]:     dt, embed, rt, time, var
2021-04-06T19:12:44.830639+00:00 shinyapps[3893862]:     legend, title
2021-04-06T19:12:44.830107+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.830894+00:00 shinyapps[3893862]: The following objects are masked from ‘package:utils’:
2021-04-06T19:12:44.830639+00:00 shinyapps[3893862]: The following objects are masked from ‘package:graphics’:
2021-04-06T19:12:44.830383+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.830639+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.830106+00:00 shinyapps[3893862]:     span, strong
2021-04-06T19:12:44.830640+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.830382+00:00 shinyapps[3893862]: The following objects are masked from ‘package:stats’:
2021-04-06T19:12:44.830895+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.831154+00:00 shinyapps[3893862]:     slot
2021-04-06T19:12:44.830895+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.831153+00:00 shinyapps[3893862]: The following object is masked from ‘package:methods’:
2021-04-06T19:12:44.831153+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.830895+00:00 shinyapps[3893862]:     cite, data, head, menu
2021-04-06T19:12:44.860031+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.831418+00:00 shinyapps[3893862]:     body, col, q, source, sub, summary, table
2021-04-06T19:12:44.831419+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.831417+00:00 shinyapps[3893862]: The following objects are masked from ‘package:base’:
2021-04-06T19:12:44.831418+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.831154+00:00 shinyapps[3893862]: 
2021-04-06T19:12:44.860032+00:00 shinyapps[3893862]: Listening on http://127.0.0.1:39705
2021-04-06T19:13:01.703741+00:00 shinyapps[3893862]: Warning: Error in : Must subset rows with a valid subscript vector.
2021-04-06T19:13:01.703742+00:00 shinyapps[3893862]: ℹ Logical subscripts must match the size of the indexed input.
2021-04-06T19:13:01.712399+00:00 shinyapps[3893862]:   128: <Anonymous>
2021-04-06T19:13:01.703743+00:00 shinyapps[3893862]: ✖ Input has size 70 but subscript `r` has size 0.

Answer 1

I'm not a shiny savvy individual. I'm not too bad at HTML or R, though. I'm not altogether sure that this is the best option, but it works!

This is your code with my changes. I added a lot of comments in the code so that you can see what and why I did what I did. If you want more of an explanation, let me know!

Some key points:

• I controlled the tooltip sizing and appearance primarily in two ways: I added a z-index (put this layer on top) and I added a min-width to the text block.
• To get rid of the arbitrary letters and "TRUE"s showing up, I moved the free text after the selection boxes to the UI code (from the server code).
• I changed the font sizing from px or pt to em. That way if the screen size changes, the text size changes. If you want to make it bigger or smaller, there are 2 main places the text is sized - the top of the 'ui' call (in the script styling), at the bottom of the 'ui' call (the text below "STEM students:" is sized here), and lastly, the labels are sized in the 'server' call. I would change them together. If you change the label's - you need to change the script tags (or your dropdown boxes' text get sized differently)

Here's the code:

library(shiny)
library(shinythemes)

# 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(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;}'))),
                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"),
                    
                    # this was in the server call, moved to ui
                    # the styles were moved to style tags and the closing tags added - nolonger h4, because of inconsistent rendering
                    # this text inherits the font-size from above, to make the text beow "STEM students" smaller I did 75% of the size of the heading
                    # had to add line-height, because it was overlapping the text here
                    
                    # moving this to ui got rid of the characters in the top left corner and the "TRUE"s at the bottom
                    
                    HTML("<div class = 'moreText' style='line-height:1em;'>",
                         "<br/ >",
                         "<span>STEM Students:</span>",
                         "<br />",
                         "<span style='font-size:.75em!important;'>This is a definition that added in the side panel that looks perfect here</span>"),
                    htmlOutput("text")
                  ),
                  
                  mainPanel(
                    plotOutput("plot"),
                  )
                )
)

server <- function(input, output) {
  
  # 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)