r - Shiny :应用发布时看起来不同-6ren

r - Shiny :应用发布时看起来不同

转载作者：行者123 更新时间：2023-12-04 15:01:26

我已经为一个在 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)

这是用户登录 Shiny 的云:

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.

最佳答案

我不是一个 Shiny 精明的人。不过，我在 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)

关于r - Shiny :应用发布时看起来不同，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/66895870/

文章推荐： c++ - Velocity verlet 算法 - n 体问题的能量增加

文章推荐： flutter 数据表如何在列之间添加垂直边框

文章推荐： python - 如何在 Python 中将多个文本填充行合并为一个？

文章推荐： Powershell:未填充参数/参数

shiny - 在没有 Shiny 服务器的情况下托管 Shiny 应用程序
我正在通过 Rscript.exe 在托管到我的本地网络的服务器上运行 Shiny 应用程序。如果我们要将其移植到网上，我们可以通过我们设置的服务器基础设施来实现。 Shiny Server 是否添加
shiny - Shiny 数据表的列标题被移动
当我运行我的 Shiny 应用程序时，我的数据表的标题向左移动。见下文。假设这张表在选项卡 A 上。当我单击不同的选项卡(选项卡 B)时，标题会正确对齐，然后再次单击选项卡 A。有关更正的标题，请
Rstudio Shiny 如何在 Shiny 页面中显示 Shiny 服务器的版本？
是否有查询正在运行的 RStudio Shiny 网页以显示正在运行的服务器版本的变量或方法？例如。显示类似 shiny-0.10.1在网页上。有任何想法吗？最佳答案您可以使用 packageV
shiny - Shiny 的交互式相关热图
我想在以下位置重现示例:https://scip.shinyapps.io/scip_app/ 基本上，我有一个 300 x 300 调整后的相关矩阵和一个 300 x 300 未调整的相关矩阵，我想
R+ Shiny 哪个锤子？直 Shiny 、柔性仪表板还是 Shiny 仪表板？
关闭。这个问题是opinion-based 。目前不接受答案。想要改进这个问题吗？更新问题，以便 editing this post 可以用事实和引文来回答它。 . 去年关闭。社区去年审查了是否重
shiny - 如何从我的帐户(从 Shiny 的服务器)中删除不工作的 Shiny 应用程序？
在我部署应用程序时，应用程序中仍然存在一些异常情况，因此我想将它们从我的帐户中删除。我试过了，但没有找到任何选择。任何帮助将不胜感激。谢谢最佳答案在从 shiny.io 填充 token 信息后，
shiny - R Shiny - R Shiny 服务器开源的 WebSEAL 身份验证
据我了解，Shiny Server 的开源版本不支持身份验证。我们有一个环境使用 WebSEAL 代理服务来验证用户并将他们的访问引导到 Web 应用程序。我们希望向经过身份验证的用户公开 Shi
R shiny - shiny 应用程序在本地和其他 shiny 服务器上运行良好，但在我的服务器上不起作用。它没有给我错误信息
我想将一个 R 应用程序(在装有 OS RHEL6.8 的实际 Shiny 服务器上运行良好)转移到另一个"new" Shiny 服务器。我的应用程序在第一台服务器上运行良好。这个想法是将它放在性能更
shiny - 在 RMarkdown 中编织 Shiny 时出错。 appshot.shiny.appobj 中的错误
我正在通过 #RMarkdown 创建一个测试页面并尝试在其中添加 #Shiny 内容。在编织到 HTML 时，我收到以下错误。 Error in appshot.shiny.appobj(list(
shiny - 在 Shiny 的两个列表框之间移动项目
有没有一种简单的方法可以在 shiny 中创建这样的东西？最佳答案 RStudio 目前正在处理 sortable 包:RStudio/sortable 请注意，它目前正在开发中(标记为实验性)，因
runapp从其他带有操作按钮的 Shiny 应用程序中 Shiny
当我在一个非常简单的 Shiny 应用程序中按下操作按钮时，我试图调用另一个 Shiny 的应用程序。另一个应用程序位于一个带有 ui.R 和 server.R 文件的名为 Benefits 的文件夹
r - Shiny 的服务器发生错误加载命名空间没有包rcpp但安装了rcpp并在R作品中加载 Shiny
我最近试图在我的服务器上打开一个 Shiny 的服务器应用程序，并遇到了我以前从未见过的错误。 Error in loadNamespace(j -c "R -e \"install.pack
shiny - R Shiny 应用程序显示旧数据
我有 Shiny 的应用程序，它显示旧数据(延迟 4 天!)，但服务器数据已刷新(当天)。奇怪的是，服务器上不存在旧数据集 - 似乎只存在于 Shiny 缓存中。在服务器上，我有 1 个数据集由
Shiny 应用程序无法在没有日志文件的 Shiny 服务器上运行
我有一个在本地 R 服务器(端口 8787)上运行的应用程序。当我将它移动到 Shiny Server(端口 3838)时，我收到消息 ERROR: An error has occurred. Ch
shiny - 如何改变 Shiny 导航栏中的填充
我试图消除此表格与浏览器窗口左侧之间的空间，但当我这样做时，它弄乱了导航栏链接和标题的间距。如何在不改变 navbar/ui/li 元素的填充/边距的情况下删除 excelR 表上的填充/边距？ l
r - Shiny - 表格中的复选框 Shiny
我已经阅读并实现了来自 link 的 Shiny 表中的复选框.但是当我在 R 中运行时，列中的输出是 , 等在每个“选择”单元格中，我希望“选择”列中的输出是复选框，我的问题的解决方案是什么？谢谢
shiny - 使用源代码模块时重新加载 Shiny 的应用程序而不重新启动
我一直在开发一个 Shiny 的应用程序，它开始变得相当大。我通过将应用程序的不同部分放入各自文件中的模块中解决了这个问题，然后获取文件。问题是，当我在源文件的服务器部分(下例中的 events.
r - Shiny :无法在 Shiny 的数据表中设置列宽
我对 Shiny 和 DataTables 还很陌生，所以这可能是个愚蠢的问题。由于某种原因，我无法更改列宽。我试过了 output$table<-DT::renderDataTable( {w
shiny-server - 在 Shiny 服务器的本地位置托管应用程序
我安装了我的 Shiny 服务器，它在这个目录下的多个应用程序上工作正常: /srv/ Shiny 服务器/app1/srv/ Shiny 服务器/app2 我可以使用 www.mydomain.co
shiny - 在 Shiny 中包含带选项的 Markdown
我想在我的 Shiny 应用程序中包含我的 myMardown.md 文档。为了显示目录，我使用了 toc 选项，还使用了 css (myStyle.css) myMarkdown.md : ---

行者123

个人简介

我是一名优秀的程序员,十分优秀！

作者热门文章

滴滴打车优惠券免费领取

全站热门文章

首页

博学

6Ren·AI

商城

r - Shiny :应用发布时看起来不同