R 闪亮亮/暗模式开关答案

【问题标题】：R Shiny light/dark mode switchR 闪亮亮/暗模式开关
【发布时间】：2020-05-06 09:56:10
【问题描述】：

我有一个基本的 R 闪亮应用程序，我想为其构建一个明暗模式开关。我认为，如果我可以让它为表格选项卡工作，那么其余的应该没问题。我知道shinyjs 是最好的方法，但我似乎无法在任何地方找到代码。

library(dplyr)
library(shiny)
library(shinythemes)

ui <- fluidPage(theme = shinytheme("slate"),
                tags$head(tags$style(HTML(
                  "
                  .dataTables_length label,
                  .dataTables_filter label,
                  .dataTables_info {
                      color: white!important;
                      }

                  .paginate_button {
                      background: white!important;
                  }

                  thead {
                      color: white;
                      }

                  "))),
                mainPanel(tabsetPanel(
                  type = "tabs",
                  tabPanel(
                    title = "Table",
                    icon = icon("table"),
                    tags$br(),
                    DT::DTOutput("table")
                  )
                )))

server <- function(input, output) {
  output$table <- DT::renderDT({
    iris
  })
}

shinyApp(ui = ui, server = server)

【问题讨论】：

标签： r shiny

【解决方案1】：

已编辑：见最后的注释

如果您想使用引导主题，可以使用复选框输入和添加/删除 <link> 元素（即加载引导 css 主题的 html 元素）的 javascript 事件来执行此操作。我将shinytheme 切换为darkly，因为有相应的浅色主题（flatly）。我删除了您在 tags$head 中定义的 css，因为它将根据主题切换添加/删除。（参见下面的完整示例）

即使这样可行，也可能存在性能问题。请注意，每次更改主题时，都会获取文件并将其重新加载到浏览器中。主题之间也存在风格差异，这可能会导致在应用新主题时重新组织或稍微移动内容（这可能会对用户造成干扰）。如果您要选择这种方法，我建议您找到一个设计良好的明暗主题组合。

或者，您可以选择一个基本的引导主题并定义您自己的 css 主题。您可以使用切换开关（如本例）或媒体查询prefers-color-scheme。然后 shinyjs 类函数，您可以从 R 服务器切换主题。通常建议使用这种方法，但开发和验证确实需要更长的时间。

使用引导方法，您可以通过以下方式切换主题。

app.R

在 ui 中，我创建了一个复选框输入并将其放置为最后一个元素（用于示例目的）。

checkboxInput(
  inputId = "themeToggle",
  label = icon("sun")
)

JS

为了切换引导主题，我定义了 shinythemes 包定义的 html 依赖路径。您可以在您的 R 包库 (library/shinythemes/) 中找到这些。

const themes = {
    dark: 'shinythemes/css/darkly.min.css',
    light: 'shinythemes/css/flatly.min.css'
}

要加载新主题，需要将路径呈现为 html 元素。我们还需要一个删除现有 css 主题的函数。最简单的方法是选择与href 匹配的元素，如themes 变量中定义的那样。

// create new <link>
function newLink(theme) {
    let el = document.createElement('link');
    el.setAttribute('rel', 'stylesheet');
    el.setAttribute('text', 'text/css');
    el.setAttribute('href', theme);
    return el;
}

// remove <link> by matching the href attribute
function removeLink(theme) {
    let el = document.querySelector(`link[href='${theme}']`)
    return el.parentNode.removeChild(el);
}

我还删除了tags$head中定义的样式，并在js中创建了一个新的<style>元素。

// css themes (originally defined in tags$head)
const extraDarkThemeCSS = ".dataTables_length label, .dataTables_filter label, .dataTables_info { color: white!important;} .paginate_button { background: white!important;} thead { color: white;}"

// create new <style> and append css
const extraDarkThemeElement = document.createElement("style");
extraDarkThemeElement.appendChild(document.createTextNode(extraDarkThemeCSS));

// add element to <head>
head.appendChild(extraDarkThemeElement);

最后，我创建了一个事件并将其附加到复选框输入。在此示例中，checked = 'light' 和 unchecked = 'dark'。

toggle.addEventListener('input', function(event) {
    // if checked, switch to light theme
    if (toggle.checked) {
        removeLink(themes.dark);
        head.removeChild(extraDarkThemeElement);
        head.appendChild(lightTheme);

    }  else {
        // else add darktheme
        removeLink(themes.light);
        head.appendChild(extraDarkThemeElement)
        head.appendChild(darkTheme);
    }
})

这是完整的app.R 文件。

library(dplyr)
library(shiny)
library(shinythemes)

ui <- fluidPage(
    theme = shinytheme("darkly"),
    mainPanel(
        tabsetPanel(
            type = "tabs",
            tabPanel(
                title = "Table",
                icon = icon("table"),
                tags$br(),
                DT::DTOutput("table")
            )
        ),
        checkboxInput(
            inputId = "themeToggle",
            label = icon("sun")
        )
    ),
    tags$script(
        "
        // define css theme filepaths
        const themes = {
            dark: 'shinythemes/css/darkly.min.css',
            light: 'shinythemes/css/flatly.min.css'
        }

        // function that creates a new link element
        function newLink(theme) {
            let el = document.createElement('link');
            el.setAttribute('rel', 'stylesheet');
            el.setAttribute('text', 'text/css');
            el.setAttribute('href', theme);
            return el;
        }

        // function that remove <link> of current theme by href
        function removeLink(theme) {
            let el = document.querySelector(`link[href='${theme}']`)
            return el.parentNode.removeChild(el);
        }

        // define vars
        const darkTheme = newLink(themes.dark);
        const lightTheme = newLink(themes.light);
        const head = document.getElementsByTagName('head')[0];
        const toggle = document.getElementById('themeToggle');

        // define extra css and add as default
        const extraDarkThemeCSS = '.dataTables_length label, .dataTables_filter label, .dataTables_info {       color: white!important;} .paginate_button { background: white!important;} thead { color: white;}'
        const extraDarkThemeElement = document.createElement('style');
        extraDarkThemeElement.appendChild(document.createTextNode(extraDarkThemeCSS));
        head.appendChild(extraDarkThemeElement);


        // define event - checked === 'light'
        toggle.addEventListener('input', function(event) {
            // if checked, switch to light theme
            if (toggle.checked) {
                removeLink(themes.dark);
                head.removeChild(extraDarkThemeElement);
                head.appendChild(lightTheme);
            }  else {
                // else add darktheme
                removeLink(themes.light);
                head.appendChild(extraDarkThemeElement)
                head.appendChild(darkTheme);
            }
        })
        "
    )
)

server <- function(input, output) {
    output$table <- DT::renderDT({
        iris
    })
}

shinyApp(ui, server)

编辑

在这个例子中，我使用了checkBoxInput。您可以使用以下 css 类“隐藏”输入。我建议添加一个视觉隐藏的文本元素以使该元素可访问。用户界面将更改为以下内容。

checkboxInput(
    inputId = "themeToggle",
    label = tagList(
        tags$span(class = "visually-hidden", "toggle theme"),
        tags$span(class = "fa fa-sun", `aria-hidden` = "true")
    )
)

然后在css后面添加css。您还可以使用 #themeToggle + span .fa-sun 选择图标并设置其样式


/* styles for toggle and visually hidden */
#themeToggle, .visually-hidden {
    position: absolute;
    width: 1px;
    height: 1px;
    clip: rect(0 0 0 0);
    clip: rect(0, 0, 0, 0);
    overflow: hidden;
}

/* styles for icon */
#themeToggle + span .fa-sun {
   font-size: 16pt;
}

这是更新后的用户界面。（我删除了 js 以使示例更短）

ui <- fluidPage(
    theme = shinytheme("darkly"),
    tags$head(
        tags$style(
            "#themeToggle, 
            .visually-hidden {
                position: absolute;
                width: 1px;
                height: 1px;
                clip: rect(0 0 0 0);
                clip: rect(0, 0, 0, 0);
                overflow: hidden;
            }",
            "#themeToggle + span .fa-sun {
                font-size: 16pt;
            }"
        )
    ),
    mainPanel(
        tabsetPanel(
            type = "tabs",
            tabPanel(
                title = "Table",
                icon = icon("table"),
                tags$br(),
                DT::DTOutput("table")
            )
        ),
        checkboxInput(
            inputId = "themeToggle",
            label = tagList(
                tags$span(class = "visually-hidden", "toggle theme"),
                tags$span(class = "fa fa-sun", `aria-hidden` = "true")
            )
        )
    ),
    tags$script("...")
)

【讨论】：

感谢这完全符合我的目的，也感谢您的深入解释。在看到浅色模式后，我现在注意到的一件事是，对于我在表格的 Show Entries 部分中的下拉菜单，它与深色模式的背景颜色相同，我似乎无法弄清楚如何在不更改文字的情况下更改它也显示条目。
很高兴听到。我知道问题出在哪里。在线const extraDarkThemCSS = ...。选择器.dataTables_length label 正在覆盖选择输入的字体颜色，因为它是一个嵌套的子项。选择输入将继承父属性（即字体颜色）。要解决此问题，请将以下代码添加到 const extraDarkThemeCss = '....' : .dataTables_length label select {color: black; }`。我在最后添加了它。使用任何你喜欢的颜色。
我还添加了额外的 CSS 来“隐藏”复选框。由于图标充当按钮，因此不再需要它。查看上面的修改
感谢这很好用。如果该 .dataTables_length 标签中有多个 select 语句，您将如何仅通过名称引用其中的一个特定语句？
使用伪选择器可能是你最好的选择。 DT 生成的 html 标记使用普通选择器（即 id、class 等）有点难以定位。相反，使用:nth-child(x) 会让你到达那里。例如：.dataTables_length label select:nth-child(1) {...}

【解决方案2】：

您可以通过从here 下载它们的 CSS 文件、将它们放入项目中的文件夹并在动态生成的 UI 块中使用 includeCSS 来在引导主题之间动态切换：

library(dplyr)
library(shiny)
library(shinythemes)

ui <- fluidPage(
  theme = shinytheme("flatly"),
  uiOutput("style"),
  tags$head(
    tags$style(
      HTML(
        "
        .dataTables_length label,
        .dataTables_filter label,
        .dataTables_info {
            color: white!important;
            }

        .paginate_button {
            background: white!important;
        }

        thead {
            color: white;
            }

        "
      )
    )
  ),
  mainPanel(
    tabsetPanel(
      type = "tabs",
      tabPanel(
        title = "Table",
        icon = icon("table"),
        tags$br(),
        DT::DTOutput("table")
      )
    ),
    checkboxInput("style", "Dark theme")
  )
)

server <- function(input, output) {
  output$table <- DT::renderDT({
    iris
  })
  
  output$style <- renderUI({
    if (!is.null(input$style)) {
      if (input$style) {
        includeCSS("www/darkly.css")
      } else {
        includeCSS("www/flatly.css")
      }
    }
  })
}

shinyApp(ui = ui, server = server)

据我了解，这将解决问题。

这种方法的优点是，如果您删除复选框然后再次生成它，它仍然可以工作。就个人而言，我打算在我的应用程序中使用 dcruvolos 有用的解决方案，直到我意识到我不能将它与 shiny.router 一起使用，因为一旦你暂时从 UI 中删除复选框，JS 代码就会停止工作（如果我理解正确）。

这是一个uiOutput 形式的复选框，您可以添加或删除它，它将继续工作：

library(dplyr)
library(shiny)
library(shinythemes)

ui <- fluidPage(
  theme = shinytheme("flatly"),
  uiOutput("style"),
  tags$head(
    tags$style(
      HTML(
        "
        .dataTables_length label,
        .dataTables_filter label,
        .dataTables_info {
            color: white!important;
            }

        .paginate_button {
            background: white!important;
        }

        thead {
            color: white;
            }

        "
      )
    )
  ),
  mainPanel(
    tabsetPanel(
      type = "tabs",
      tabPanel(
        title = "Table",
        icon = icon("table"),
        tags$br(),
        DT::DTOutput("table")
      )
    ),
    uiOutput("style_checkbox")
  )
)

server <- function(input, output) {
  
  output$table <- DT::renderDT({
    iris
  })
  
  current_theme <- reactiveVal(FALSE)
  
  output$style_checkbox <- renderUI({
    checkboxInput("style", "Dark theme", value = current_theme())
  })
  
  output$style <- renderUI({
    if (!is.null(input$style)) {
      current_theme(input$style)
      if (input$style) {
        includeCSS("www/darkly.css")
      } else {
        includeCSS("www/flatly.css")
      }
    }
  })
}

shinyApp(ui = ui, server = server)

【讨论】：