r - 闪亮：应用发布时看起来不同
问题描述
当我在 R 中运行该应用程序时，我已经为一个看起来很完美的应用程序编写了代码。看看输入选择和间距有多清晰：
然而，当我在“Shiny Cloud”上发布应用程序时，它看起来是这样的：注意所有东西是如何聚集在一起的，底部的文字也看起来很小。
任何想法为什么会发生这种情况？：/
这是我的代码：
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)
这是闪亮云上的用户登录：
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.
解决方案
我不是一个聪明伶俐的人。不过，我在 HTML 或 R 方面还算不错。我不完全确定这是最好的选择，但它确实有效！
这是您的代码以及我的更改。我在代码中添加了很多注释，这样你就可以看到我做了什么以及为什么做了我所做的。如果您想要更多解释，请告诉我！
一些关键点：
- 我主要通过两种方式控制工具提示的大小和外观：我添加了一个 z-index（将此图层放在顶部），我在文本块中添加了一个最小宽度。
- 为了摆脱出现的任意字母和“TRUE”，我将选择框后的自由文本移动到 UI 代码（从服务器代码）。
- 我将字体大小从 px 或 pt 更改为 em。这样，如果屏幕大小发生变化，文本大小也会发生变化。如果你想让它变大或变小，有两个主要的文本大小位置 - 'ui' 调用的顶部（在脚本样式中），'ui' 调用的底部（“STEM”下面的文本学生：”在这里调整大小），最后，标签在“服务器”调用中调整大小。我会一起改变它们。如果您更改标签 - 您需要更改脚本标签（或下拉框的文本大小不同）
这是代码：
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)
推荐阅读
- awk - awk 拆分字段并将拆分放在文件末尾
- java - 为什么我的 glassfish 服务器会重定向到另一台服务器？
- google-api - 使用 JWT 授权 GMail API
- c++ - 为什么虚函数优于派生类对象？
- git - 我是否必须不止一次 git pull ？
- json - Unity JSON Serializer 不允许调用 JSON 字段 n JSON 对象
- javascript - 我怎样才能让这个滑块在一定的延迟下自动循环？IE。1000毫秒
- javascript - 当用户让计算机进入睡眠状态时，将用户从网站中注销
- javascript - 查找子字符串的第一个和最后一个索引
- python - 在 Python 中调用模拟方法的类的测试实例