Question

我有一个基本的R闪亮应用程序，我想为其建立亮/暗模式开关。我认为，如果我可以让它在table选项卡上正常工作，那么其余的工作就可以了。我知道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)

Answer 1

您可以通过以下方式在引导程序主题之间动态切换：从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)

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

此方法的优点是，如果您删除复选框，然后再次生成它，它将仍然有效。就我个人而言，我将在我的应用程序中使用dcruvolo有用的解决方案，直到我意识到我无法将其与shiny.router一起使用，因为一旦您暂时从用户界面中删除了该复选框，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)

Answer 2

已编辑：请参见末尾的注释

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

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

或者，您可以选择基本的Bootstrap主题并定义自己的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("...")
)

R亮/暗模式开关

2 个答案:

app.R

JS

编辑