Once a footnote has been set via add_footnote it seems like its hard to get rid of again.
library(magrittr)
library(huxtable)
jams <- hux(
Type = c("Strawberry", "Raspberry", "Plum"),
Price = c(1.90, 2.10, 1.80)
) %>% add_footnote("Tasty stuff!")
One solution I tried is this:
head(jams, -1)
Unfortunately, the line at the bottom of the huxtable remains. What I would like is a solution which returns a huxtable as if the footnote had never been set.
EDIT:
The code below will also remove the line:
jams <- head(jams, -1)
attributes(jams)$tb_borders$thickness[nrow(attributes(jams)$tb_borders$thickness), ] <- 0
I'm not sure how robust this is though.
EDIT: One issue is that if you use this to remove a footnote which was never set then you remove a line of data.
If you want to get rid of the border, just use the relevant function:
jams <- hux(
Type = c("Strawberry", "Raspberry", "Plum"),
Price = c(1.90, 2.10, 1.80)
) %>% add_footnote("Tasty stuff!")
head(jams, -1) %>% set_bottom_border(final(1), everywhere, 0)
Related
I am working with quarto to table some results from a qualitative data analysis, and present them in a {DT} or {gt} table.
I have a placeholder character in the table I'm receiving from another data source, but cannot seem to replace that placeholder with one or more carriage returns to make entries easier to read in the resulting DT or gt table.
Thanks for your collective help!
library(tidyverse)
library(DT)
library(gt)
df_text <- tibble::tibble(index = c("C-1", "C-2"),
finding = c("A finding on a single line.", "A finding with a return in the middle.<return>Second line is usually some additional piece of context or a quote.")) %>%
dplyr::mutate(finding = stringr::str_replace_all(finding, "<return>", "\\\n\\\n"))
DT::datatable(df_text)
gt::gt(df_text)
for gt you need
gt::gt(df_text) |> tab_style(style=cell_text(whitespace = "pre"),
locations=cells_body())
for DT you could modify the column with the required text to be html and then tell DT to respect your HTML
df_text <- tibble::tibble(index = c("C-1", "C-2"),
finding = c("A finding on a single line.", "A finding with a return in the middle.<return>Second line is usually some additional piece of context or a quote.")) %>%
dplyr::mutate(finding = paste0("<HTML>",
stringr::str_replace_all(finding, "<return>", "</br></br>"),
"</HTML>"))
DT::datatable(df_text,escape = FALSE)
Based on #Nir Graham's answer, I wrote a function. The type = "dt" isn't working for some reason, but Nir's recommendation to dplyr::mutate() inline does :shrug:
fx_add_returns <- function(x, type = c("dt", "gt")) {
type <- match.arg(type)
if (type == "dt"){
paste0("<HTML>",
stringr::str_replace_all(x, "<return>", "</br></br>"), "</HTML>")
}
if (type == "gt"){
stringr::str_replace_all(x, "<return>", "\\\n\\\n")
}
}
I'm looking for a workaround solution for a known issue where \cellcolor from the colortbl package does not work properly with \makecell. As mentioned, there probably already exists a workaround in Latex, but I'm hoping for a solution in terms of the R package kableExtra when producing pdfs using rmarkdown. Here's a screenshot; as can be seen, some cells are not filled entirely.
Here's a minimally reproducible example in rmarkdown:
library(kableExtra)
library(tidyverse)
# Data --------------------------------------------------------------------
df <- tribble(
~col1, ~col2,
"really long text that needs to be broken into multiple lines so it can fit", 4,
"really long text that needs to be broken", 4,
"really long text that needs a fix", 4,
) %>%
modify_at(
.x = .,
.at = 1,
.f = stringr::str_wrap,
width = 25
)
# Table -------------------------------------------------------------------
df %>%
mutate(across(.cols = 1, .fns = linebreak, align = "l")) %>%
kbl(x = ., escape = FALSE) %>%
row_spec(row = 1:3, background = "#e5e5e5")
One possible fix is to specify keep_tex: true in the YAML and fix the issue in the .tex file manually before using pandoc. But I'm generating many tables and this can't possibly be efficient. Any suggestion of a potential workaround would be greatly appreciated.
Why not use column_spec to force the line wrap rather than using makecell and linewrap?...
library(tibble)
library(dplyr) #for the pipe
library(kableExtra)
df <- tribble(
~col1, ~col2,
"really long text that needs to be broken into multiple lines so it can fit", 4,
"really long text that needs to be broken", 4,
"really long text that needs a fix", 4,
)
kbl(df) %>%
column_spec(1, width = "30mm") %>%
row_spec(row = 1:3, background = "#e5e5e5")
Another solution that worked for my use case (where column_spec(width) fails), is based on leandriis's comment in this post. Specifically, we wrap the \colorbox command around the \makecell command to have a completely colored cell. For example \colorbox[HTML]{hexcode}{\makecell{text}}. This requires that we create our own custom linebreak function, which not only wraps our text in \makecell but also wraps that latex code in a \colorbox.
# Custom linebreak --------------------------------------------------------
linebreak_custom <- function(x, align = "l", linebreaker = "\n") {
ifelse(
# If '\n' is detected in a string, TRUE, or else FALSE
test = str_detect(x, linebreaker),
# For TRUE's, wrap text in \makecell and then in \colorbox
yes = paste0(
"\\cellcolor[HTML]{e5e5e5}{\\colorbox[HTML]{e5e5e5}{\\makecell[", align, "]{",
str_replace_all(x, linebreaker, "\\\\\\\\"), "}}}"
),
# Return as is if no '\n' detected
no = x
)
}
# Data --------------------------------------------------------------------
df <- tribble(
~col1, ~col2,
"really long text that needs to be broken into multiple lines so it can fit", 4,
"really long text that needs to be broken", 4,
"really long text that needs a fix", 4,
) %>%
modify_at(
.x = .,
.at = 1,
.f = stringr::str_wrap,
width = 25
)
# Table -------------------------------------------------------------------
df %>%
mutate(across(.cols = 1, .fns = linebreak_custom, align = "l")) %>%
kbl(x = ., escape = FALSE) %>%
row_spec(row = 1:3, background = "#e5e5e5")
This produces the desired output:
As noted, this solution may not be robust to future versions of kableExtra (as it involves, quite frankly, "hacking" the source code), and the solution suggested by Peter above should still be better in many use cases. I've created an issue via Github to bring this to their attention, so perhaps there could be an official fix in their code in the future.
How do I add currency to my valueBox, £ in this case.
The valueBox generated in the server as:
valueBox(Test_data %>%
filter(`Region` == input$Region, `Locality` == input$Locality) %>%
summarise("Annual_Value" = sum(`Value (Annualised)`)) %>%
prettyNum(big.mark = ","),
req(input$Region))
I just went into the windows explorer and found "Character Map". From there I was able to copy paste the symbol into R. Since you didn't provide a reprex, here's a simple response. Basically, calculate the value you need, feed it into paste for the value in the valueBox.
calc_value <- 200
valueBox(value = paste('£', calc_value), subtitle = '')
I have a column 'lg_with_children' in my data frame that has 5 levels, 'Half and half', 'Mandarin', 'Shanghainese', 'Other', 'N/A', and 'Not important'. I want to condense the 5 levels down to just 2 levels, 'Shanghainese' and 'Other'.
In order to do this I used the revalue() function from the plyr package to successfully rename the levels. I used the code below and it worked fine.
data$lg_with_children <- revalue(data$lg_with_children,
c("Mandarin" = "Other"))
data$lg_with_children <- revalue(data$lg_with_children,
c("Half and half" = "Other"))
data$lg_with_children <- revalue(data$lg_with_children,
c("N/A" = "Other"))
data$lg_with_children <- revalue(data$lg_with_children,
c("Not important" = "Other"))
To condense the code a little I went back data before I revalued the levels and attempted to write a function. I tried the following after doing research on how to write your own functions (I'm rather new at this).
revalue_factor_levels <- function(df, col, source, target) {df$col <- revalue(df$col, c("source" = "target"))}
I intentionally left the df, col, source, and target generic because I need to revalue some other columns in the same way.
Next, I tried to run the code filling in the args and get this message:
warning message
I am not quite sure what the problem is. I tried the following adjustment to code and still nothing.
revalue_factor_levels <- function(df, col, source, target) {df$col <- revalue(df$col, c(source = target))}
Any guidance is appreciated. Thanks.
You can write your function to recode the levels - the easiest way to do that is probably to change the levels directly with levels(fac) <- list(new_lvl1 = c(old_lvl1, old_lvl2), new_lvl2 = c(old_lvl3, old_lvl4))
But there are already several functions that do it out of the box. I typically use the forcats package to manipulate factors.
Check out fct_recode from the forcats package. Link to doc.
There are also other functions that could help you - check out the comments below.
Now, as to why your code isn't working:
df$col looks for a column literally named col. The workaround is to do df[[col]] instead.
Don't forget to return df at the end of your function
c(source = target) will create a vector with one element named "source", regardless of what happens to be in the variable source.
The solution is to create the vector c(source = target) in 2 steps.
revalue_factor_levels <- function(df, col, source, target) {
to_rename <- target
names(to_rename) <- source
df[[col]] <- revalue(df[[col]], to_rename)
df
}
Returning the df means the syntax is:
data <- revalue_factor_levels(data, "lg_with_children", "Mandarin", "Other")
I like functions that take the data as the first argument and return the modified data because they are pipeable.
library(dplyr)
data <- data %>%
revalue_factor_levels("lg_with_children", "Mandarin", "Other") %>%
revalue_factor_levels("lg_with_children", "Half and half", "Other") %>%
revalue_factor_levels("lg_with_children", "N/A", "Other")
Still, using forcats is easier and less prone to breaking on edge cases.
Edit:
There is nothing preventing you from both using forcats and creating your custom function. For example, this is closer to what you want to achieve:
revalue_factor_levels <- function(df, col, ref_level) {
df[[col]] <- forcats::fct_others(df[[col]], keep = ref_level)
df
}
# Will keep Shanghaisese and revalue other levels to "Other".
data <- revalue_factor_levels(data, "lg_with_children", "Shanghainese")
Here is what I ended up with thanks to help from the community.
revalue_factor_levels <- function(df, col, ref_level) {
df[[col]] <- fct_other(df[[col]], keep = ref_level)
df
}
data <- revalue_factor_levels(data, "lg_with_children", "Shanghainese")
I am trying to make a table using either hwrite or xtable in rmarkdown to produce a html table. I have been unable to use a cellpadding or cellspacing option, this is the code I am using and attached is a photo of the output.
{r, echo = FALSE, results = 'asis'}
cat(hwrite(sd.m.table, row.names = FALSE, cellpadding = 10, row.style = list("font-weight:bold")))
Using xtable() similarly did not work as well. Does anyone have suggestions?
Generated output from code
I'm not familiar with the hwriter package, and I rarely use xtable anymore (because I get frustrated with customizing tables), so I can't give you specific advice on using those.
I'm most comfortable with pixiedust (because I wrote it), but the htmlTable and tableHTML packages produce nice HTML tables and are probably worth looking into as well.
Working example with pixiedust
---
title: "Untitled"
output: html_document
---
```{r}
library(pixiedust)
head(mtcars) %>%
dust() %>%
sprinkle(pad = 10) %>%
medley_all_borders()
```
EDIT:
To get the appearance you are seeking with your data, try using
library(pixiedust)
library(dplyr)
DF <-
data.frame(rep_complete_time = c("2017-01-04 08:58:22",
"2017-01-04 08:58:33",
"2017-01-06 11:35:28"),
result = c(4.99184, 4.07356, 5.01569),
body_fluid = c("Serum", "Serum", "Serum"),
result_type = c("QC", "QC", "QC"),
fluid_lot = c(4426, 4426, 4426),
level = c(1, 1, 1))
DF %>%
# for some reason, sprintf results aren't holding when used in a
# sprinkle. This seems like a bug in pixiedust.
mutate(result = sprintf("%0.1f", result)) %>%
dust() %>%
sprinkle_colnames("Rep Complete Time", "Result", "Body Fluid",
"Result Type", "Fluid Lot", "Level") %>%
# use part = "table" to apply borders to all parts of the table.
# by default, pixiedust only wants to work with the body of the table.
medley_all_borders(part = "table") %>%
# using the sprinkle_table function can apply sprinkles to all of the
# parts of a table.
sprinkle_table(pad = 10,
halign = "left")
I wasn't able to replicate your alignment problem. All of the columns in my results are aligned left.