Flexdashboard 复选框流出页面
Flexdashboard checkbox flows off page
我在带有复选框的 flexdashboard 中创建了一个数据表，但该复选框从页面上消失了。我试图调整填充 {data-padding = 10} 但没有任何改变。下面是仪表板的代码和图片。如何将所有内容向右移动，使其与页面标题对齐？
---
title: "School Dashboard"
author: "Shannon Coulter"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
source_code: embed
theme: spacelab
---
```{r}
library(tidyverse)
library(crosstalk)
library(DT)
library(flexdashboard)
```
Student Lookup
================================================================================
### Chronic Absenteeism Lookup
```{r ca-lookup, echo=FALSE, message=FALSE, warning=FALSE}
ican_tab <- tibble(
year = c("2022", "2022", "2022", "2022", "2022"),
date = c("March", "March","March","March","March"),
school = c("ABC", "CDE","ABC","DEF","GHI"),
grade = c("6th", "7th","8th","4th","5th"),
race_eth = c("White", "Hispanic","White","Filipino","White"),
abs_levels = c("Not At-Risk of Chronic Absenteeism", "At-Risk of Chronic Absenteeism",
"Severe Chronic Absenteeism", "Severe Chronic Absenteeism",
"Moderate Chronic Absenteeism")
)
sd <- SharedData$new(ican_tab)
bscols(list(
filter_checkbox("abs_levels", "Level", sd, ~ abs_levels, inline = TRUE),
datatable(
sd,
extensions = c("Buttons",
"Scroller"),
options = list(
autoWidth = TRUE,
scrollY = F,
columnDefs = list(list(
className = 'dt-center',
targets = c(2, 3, 4, 5)
)),
lengthMenu = c(5, 10, 25, 100),
dom = "Blrtip",
deferRender = TRUE,
scrollY = 300,
scroller = TRUE,
buttons = list('copy',
'csv',
'pdf',
'print')
),
filter = "top",
style = "bootstrap",
class = "compact",
width = "100%",
colnames = c(
"Year",
"Date",
"School",
"Grade",
"Race",
"Level"
)
) %>%
formatStyle('abs_levels',
backgroundColor = styleEqual(
unique(ican_tab$abs_levels),
c(
"#73D055ff",
"#95D840FF",
"#B8DE29FF",
"#DCE319FF"
)
))
))
```
[![在此处输入图片描述][1]][1]
解决此问题的最简单方法可能是向仪表板添加样式标签。你可以把它放在任何地方。我通常把它放在 YAML 之后或我的第一个 R 块之后，我只是把我的 knitr 选项和库放在那里。这不会进入 R 块。
<style>
body { /*push content away from far right and left edges*/
margin-right: 2%;
margin-left: 2%;
}
</style>
根据您更新的问题和评论进行更新
我没有你的 table 周围的内容，所以我会给你一些可行的选择。在大多数情况下，任何一种选择都是不够的。您可以混合搭配最适合您的选项。
这是我得到的原始 table:
- 选项 1：您可以使用 CSS 将 table 推离边缘（如我的原始回复
- 选项 2：更改字体大小
- 选项 3：限制数据的大小table htmlwidget
- 选项 4：手动缩小列
- 选项 5：更改过滤器标签（同时保持相同的过滤器和数据）
从审美上看最好？这取决于仪表板上还有什么。
我认为无论您选择使用什么其他选项，您都需要原始 CSS（选项 1，在我的原始答案中）。
选项 1 以上
选项 2
要更改字体大小，您必须在制作后修改 filter_checkbox 和 datatable。我不会展示所有的编程代码，而是向您展示要添加或修改的内容以及我如何分解对象。
您 filter_checkbox 的原始代码保持不变。但是，您会将其分配给一个对象，而不是将其包含在 bscols.
中
您 datatable 中的大部分代码将保持不变。参数 options 有一个附加项。我已经包含了该参数的原始和更改。
# filter checkbox object
fc = filter_checkbox(...parameters unchanged...)
fc$attribs$style <- css(font.size = "90%") # <-change the font size
dt = datatable(
...
...
options = list( # this will be modified
autoWidth = TRUE, # <- same
scrollY = F, # <- same
initComplete = JS( # <- I'M NEW! change size of all font
"function(settings, json) {",
"$(this.api().table().container()).css({'font-size': '90%'});",
"}"),
columnDefs = list( # <- same
list(className = 'dt-center', targets = c(2, 3, 4, 5))),
...
... # remainder of datatable and formatStyles() original code
)
# now call them together
bscols(list(fc, dt))
顶部版本有 90% 的字体大小，而底部是原始版本 table。
选项 3
要限制 datatable 小部件的大小，您需要在 bscols 之外创建对象，就像我在选项 2 中所做的那样。如果您要将小部件命名为 dt 就像在我的示例中一样，这就是您可以限制小部件大小的方式。此示例将 datatable 设置为查看器屏幕宽度和高度的 50%（或网页的 1/4）。请记住，过滤器不是小部件的一部分，因此总的来说，table 仍然超过网页的 1/4。当然，您必须根据自己的目的调整大小。我建议使用 vw、em、rem 等动态大小调整机制。
dt$sizingPolicy$defaultWidth <- "50vw"
dt$sizingPolicy$defaultHeight <- "40vh"
最上面的图片有选项1、2、3；最下面是原来的table.
选项 4
要修改列的宽度，您可以在调用datatable 时将此修改添加到参数options 中。这可能很好，因为大多数列不需要像最后一列那么大的宽度。但是，如果您更改字体大小或缩放 table，它会动态更改字体大小，因此可能不需要此选项。
尽管在这里使用 em，但在从 R 代码到 html_document 的过程中，它被更改为像素。所以这是 而不是 动态调整大小。 （不是个好主意！唉！）
columnDefs = list(
list(className = 'dt-center', targets = c(2, 3, 4, 5)),
list(width = '5em', targets = c(1,2,3,4,5))), # <- I'm NEW!
选项 5
对于这个选项，我把后面的编程crosstalk::filter_checkbox()拿过来，稍微修改了一下代码。我将函数更改为 filter_checkbox2()。如果你使用它，你可以两种方式渲染它，只保留你更喜欢的那个。
第一段代码是三个函数，它们协同工作以创建一个 filter_checkbox 对象，并经过我的修改，这样您就可以拥有与关卡不完全相同的标签。
It's important to note that the filters are alphabetized by datatable. It doesn't matter if they're factors, ordered, etc. If you use this new parameter groupLabels, they need to be in an order that aligns with the levels when they're alphabetized.
我把这段代码单独放在一个 include=F 块中：
# this is nearly identical to the original function
filter_checkbox2 = function (id, label, sharedData, group,
groupLabels = NULL, # they're optional
allLevels = FALSE, inline = FALSE, columns = 1) {
options <- makeGroupOptions(sharedData, group,
groupLabels, allLevels) # added groupLabels
labels <- options$items$label
values <- options$items$value
options$items <- NULL
makeCheckbox <- if (inline)
inlineCheckbox
else blockCheckbox
htmltools::browsable(attachDependencies(tags$div(id = id,
class = "form-group crosstalk-input-checkboxgroup crosstalk-input",
tags$label(class = "control-label", `for` = id, label),
tags$div(class = "crosstalk-options-group",
crosstalk:::columnize(columns,
mapply(labels, values, FUN = function(label, value) {
makeCheckbox(id, value, label)
}, SIMPLIFY = FALSE, USE.NAMES = FALSE))),
tags$script(type = "application/json", `data-for` = id,
jsonlite::toJSON(options, dataframe = "columns",
pretty = TRUE))),
c(list(crosstalk:::jqueryLib()),crosstalk:::crosstalkLibs())))
}
inlineCheckbox = function (id, value, label) { # unchanged
tags$label(class = "checkbox-inline",
tags$input(type = "checkbox",
name = id, value = value),
tags$span(label))
}
# added groupLabels (optional)
makeGroupOptions = function (sharedData, group, groupLabels = NULL, allLevels) {
df <- sharedData$data(withSelection = FALSE, withFilter = FALSE,
withKey = TRUE)
if (inherits(group, "formula"))
group <- lazyeval::f_eval(group, df)
if (length(group) < 1) {
stop("Can't form options with zero-length group vector")
}
lvls <- if (is.factor(group)) {
if (allLevels) {levels(group) }
else { levels(droplevels(group)) }
}
else { sort(unique(group)) }
matches <- match(group, lvls)
vals <- lapply(1:length(lvls), function(i) {
df$key_[which(matches == i)]
})
lvls_str <- as.character(lvls)
if(is.null(groupLabels)){groupLabels = lvls_str} # if none provided
if(length(groupLabels) != length(lvls_str)){ # if the # labels != the # groups
message("Warning: The number of group labels does not match the number of groups.\nGroups were used as labels.")
groupLabels = lvls_str
}
options <- list(items = data.frame(value = lvls_str, label = groupLabels, # changed from lvls_str
stringsAsFactors = FALSE), map = setNames(vals, lvls_str),
group = sharedData$groupName())
options
}
当我使用这个新版本时，我将 label = "Level" 更改为 label = "Chronic Absenteeism Level"。然后从过滤器标签中删除“慢性旷工”。数据和 datatable 没有改变，只是过滤器复选框标签。
filter_checkbox2("abs_levels", "Chronic Absenteeism Level",
sd, ~ abs_levels, inline = TRUE,
groupLabels = unlist(unique(ican_tab$abs_levels)) %>%
str_replace(" Chronic Absenteeism", "") %>% sort())
第一张图片是您的 table，带有选项 1、2、3 和 5（不是 4）。
下图中最上面的版本有选项 1、2、3 和 5（不是 4）。最下面是原文table。之后
如果我有任何不清楚的地方或有任何其他问题，请告诉我。
我在带有复选框的 flexdashboard 中创建了一个数据表，但该复选框从页面上消失了。我试图调整填充 {data-padding = 10} 但没有任何改变。下面是仪表板的代码和图片。如何将所有内容向右移动，使其与页面标题对齐？
---
title: "School Dashboard"
author: "Shannon Coulter"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
source_code: embed
theme: spacelab
---
```{r}
library(tidyverse)
library(crosstalk)
library(DT)
library(flexdashboard)
```
Student Lookup
================================================================================
### Chronic Absenteeism Lookup
```{r ca-lookup, echo=FALSE, message=FALSE, warning=FALSE}
ican_tab <- tibble(
year = c("2022", "2022", "2022", "2022", "2022"),
date = c("March", "March","March","March","March"),
school = c("ABC", "CDE","ABC","DEF","GHI"),
grade = c("6th", "7th","8th","4th","5th"),
race_eth = c("White", "Hispanic","White","Filipino","White"),
abs_levels = c("Not At-Risk of Chronic Absenteeism", "At-Risk of Chronic Absenteeism",
"Severe Chronic Absenteeism", "Severe Chronic Absenteeism",
"Moderate Chronic Absenteeism")
)
sd <- SharedData$new(ican_tab)
bscols(list(
filter_checkbox("abs_levels", "Level", sd, ~ abs_levels, inline = TRUE),
datatable(
sd,
extensions = c("Buttons",
"Scroller"),
options = list(
autoWidth = TRUE,
scrollY = F,
columnDefs = list(list(
className = 'dt-center',
targets = c(2, 3, 4, 5)
)),
lengthMenu = c(5, 10, 25, 100),
dom = "Blrtip",
deferRender = TRUE,
scrollY = 300,
scroller = TRUE,
buttons = list('copy',
'csv',
'pdf',
'print')
),
filter = "top",
style = "bootstrap",
class = "compact",
width = "100%",
colnames = c(
"Year",
"Date",
"School",
"Grade",
"Race",
"Level"
)
) %>%
formatStyle('abs_levels',
backgroundColor = styleEqual(
unique(ican_tab$abs_levels),
c(
"#73D055ff",
"#95D840FF",
"#B8DE29FF",
"#DCE319FF"
)
))
))
```
[![在此处输入图片描述][1]][1]
解决此问题的最简单方法可能是向仪表板添加样式标签。你可以把它放在任何地方。我通常把它放在 YAML 之后或我的第一个 R 块之后，我只是把我的 knitr 选项和库放在那里。这不会进入 R 块。
<style>
body { /*push content away from far right and left edges*/
margin-right: 2%;
margin-left: 2%;
}
</style>
根据您更新的问题和评论进行更新
我没有你的 table 周围的内容，所以我会给你一些可行的选择。在大多数情况下，任何一种选择都是不够的。您可以混合搭配最适合您的选项。
这是我得到的原始 table:
- 选项 1：您可以使用 CSS 将 table 推离边缘（如我的原始回复
- 选项 2：更改字体大小
- 选项 3：限制数据的大小table htmlwidget
- 选项 4：手动缩小列
- 选项 5：更改过滤器标签（同时保持相同的过滤器和数据）
从审美上看最好？这取决于仪表板上还有什么。
我认为无论您选择使用什么其他选项，您都需要原始 CSS（选项 1，在我的原始答案中）。
选项 1 以上
选项 2
要更改字体大小，您必须在制作后修改 filter_checkbox 和 datatable。我不会展示所有的编程代码，而是向您展示要添加或修改的内容以及我如何分解对象。
您 filter_checkbox 的原始代码保持不变。但是，您会将其分配给一个对象，而不是将其包含在 bscols.
您 datatable 中的大部分代码将保持不变。参数 options 有一个附加项。我已经包含了该参数的原始和更改。
# filter checkbox object
fc = filter_checkbox(...parameters unchanged...)
fc$attribs$style <- css(font.size = "90%") # <-change the font size
dt = datatable(
...
...
options = list( # this will be modified
autoWidth = TRUE, # <- same
scrollY = F, # <- same
initComplete = JS( # <- I'M NEW! change size of all font
"function(settings, json) {",
"$(this.api().table().container()).css({'font-size': '90%'});",
"}"),
columnDefs = list( # <- same
list(className = 'dt-center', targets = c(2, 3, 4, 5))),
...
... # remainder of datatable and formatStyles() original code
)
# now call them together
bscols(list(fc, dt))
顶部版本有 90% 的字体大小，而底部是原始版本 table。
选项 3
要限制 datatable 小部件的大小，您需要在 bscols 之外创建对象，就像我在选项 2 中所做的那样。如果您要将小部件命名为 dt 就像在我的示例中一样，这就是您可以限制小部件大小的方式。此示例将 datatable 设置为查看器屏幕宽度和高度的 50%（或网页的 1/4）。请记住，过滤器不是小部件的一部分，因此总的来说，table 仍然超过网页的 1/4。当然，您必须根据自己的目的调整大小。我建议使用 vw、em、rem 等动态大小调整机制。
dt$sizingPolicy$defaultWidth <- "50vw"
dt$sizingPolicy$defaultHeight <- "40vh"
最上面的图片有选项1、2、3；最下面是原来的table.
选项 4
要修改列的宽度，您可以在调用datatable 时将此修改添加到参数options 中。这可能很好，因为大多数列不需要像最后一列那么大的宽度。但是，如果您更改字体大小或缩放 table，它会动态更改字体大小，因此可能不需要此选项。
尽管在这里使用 em，但在从 R 代码到 html_document 的过程中，它被更改为像素。所以这是 而不是 动态调整大小。 （不是个好主意！唉！）
columnDefs = list(
list(className = 'dt-center', targets = c(2, 3, 4, 5)),
list(width = '5em', targets = c(1,2,3,4,5))), # <- I'm NEW!
选项 5
对于这个选项，我把后面的编程crosstalk::filter_checkbox()拿过来，稍微修改了一下代码。我将函数更改为 filter_checkbox2()。如果你使用它，你可以两种方式渲染它，只保留你更喜欢的那个。
第一段代码是三个函数，它们协同工作以创建一个 filter_checkbox 对象，并经过我的修改，这样您就可以拥有与关卡不完全相同的标签。
It's important to note that the filters are alphabetized by
datatable. It doesn't matter if they're factors, ordered, etc. If you use this new parametergroupLabels, they need to be in an order that aligns with the levels when they're alphabetized.
我把这段代码单独放在一个 include=F 块中：
# this is nearly identical to the original function
filter_checkbox2 = function (id, label, sharedData, group,
groupLabels = NULL, # they're optional
allLevels = FALSE, inline = FALSE, columns = 1) {
options <- makeGroupOptions(sharedData, group,
groupLabels, allLevels) # added groupLabels
labels <- options$items$label
values <- options$items$value
options$items <- NULL
makeCheckbox <- if (inline)
inlineCheckbox
else blockCheckbox
htmltools::browsable(attachDependencies(tags$div(id = id,
class = "form-group crosstalk-input-checkboxgroup crosstalk-input",
tags$label(class = "control-label", `for` = id, label),
tags$div(class = "crosstalk-options-group",
crosstalk:::columnize(columns,
mapply(labels, values, FUN = function(label, value) {
makeCheckbox(id, value, label)
}, SIMPLIFY = FALSE, USE.NAMES = FALSE))),
tags$script(type = "application/json", `data-for` = id,
jsonlite::toJSON(options, dataframe = "columns",
pretty = TRUE))),
c(list(crosstalk:::jqueryLib()),crosstalk:::crosstalkLibs())))
}
inlineCheckbox = function (id, value, label) { # unchanged
tags$label(class = "checkbox-inline",
tags$input(type = "checkbox",
name = id, value = value),
tags$span(label))
}
# added groupLabels (optional)
makeGroupOptions = function (sharedData, group, groupLabels = NULL, allLevels) {
df <- sharedData$data(withSelection = FALSE, withFilter = FALSE,
withKey = TRUE)
if (inherits(group, "formula"))
group <- lazyeval::f_eval(group, df)
if (length(group) < 1) {
stop("Can't form options with zero-length group vector")
}
lvls <- if (is.factor(group)) {
if (allLevels) {levels(group) }
else { levels(droplevels(group)) }
}
else { sort(unique(group)) }
matches <- match(group, lvls)
vals <- lapply(1:length(lvls), function(i) {
df$key_[which(matches == i)]
})
lvls_str <- as.character(lvls)
if(is.null(groupLabels)){groupLabels = lvls_str} # if none provided
if(length(groupLabels) != length(lvls_str)){ # if the # labels != the # groups
message("Warning: The number of group labels does not match the number of groups.\nGroups were used as labels.")
groupLabels = lvls_str
}
options <- list(items = data.frame(value = lvls_str, label = groupLabels, # changed from lvls_str
stringsAsFactors = FALSE), map = setNames(vals, lvls_str),
group = sharedData$groupName())
options
}
当我使用这个新版本时，我将 label = "Level" 更改为 label = "Chronic Absenteeism Level"。然后从过滤器标签中删除“慢性旷工”。数据和 datatable 没有改变，只是过滤器复选框标签。
filter_checkbox2("abs_levels", "Chronic Absenteeism Level",
sd, ~ abs_levels, inline = TRUE,
groupLabels = unlist(unique(ican_tab$abs_levels)) %>%
str_replace(" Chronic Absenteeism", "") %>% sort())
第一张图片是您的 table，带有选项 1、2、3 和 5（不是 4）。
下图中最上面的版本有选项 1、2、3 和 5（不是 4）。最下面是原文table。之后
如果我有任何不清楚的地方或有任何其他问题，请告诉我。