R: table1 output - r

Some days ago I found table1 library to get nice tables.
The only one problem (for me), its that output is a HTML table. I am using rtf library to export R table to word, but I dont know how export this output table (HTML) to word .
I wonder if exist some posibilty of get a different output. Or a different way to convert to R table. I am no using R-studio.
Thanks in advance.
library(table1)
table1(~mpg| carb*am,data = mtcars)

Thanks to #r2evans for the information, I could get a R table, maybe I lost a little bit the format but is ok when I export to word with rtf library:
library(rvest)
library(table1)
tbl_1=table1(~mpg| carb*am,data = mtcars)
as.data.frame(read_html(tbl_1) %>% html_table(fill=TRUE))

Note that you can get a lot more control over the output with some other packages. In the example below I'm using Tplyr and reporter. Tplyr generates the statistics and reporter will create the RTF. It takes a lot more work than table1. But you gain a lot more types of statistics and reports. You could basically produce any safety report.
library(Tplyr)
library(reporter)
dt <- tplyr_table(mtcars, am) %>%
add_layer(group_count(cyl)) %>%
add_layer(group_desc(mpg)) %>%
build()
tbl <- create_table(dt, show_cols = c("ord_layer_index", "row_label1",
"var1_0", "var1_1")) %>%
stub(c("ord_layer_index", "row_label1"), label = "Variables") %>%
define(ord_layer_index, label = "Variable", label_row = TRUE,
format = c("1" = "Cylinders",
"2" = "Miles Per Gallon"),
dedupe = TRUE, blank_after = TRUE) %>%
define(row_label1, label = "", indent = .25) %>%
define(var1_0, label = "Automatic", align = "center", n = 19) %>%
define(var1_1, label = "Manual", align = "center", n = 13)
pth <- file.path(tempdir(), "test1.rtf")
rpt <- create_report(pth,
output_type = "RTF",
orientation = "portrait") %>%
titles("Table 1.0",
"Characteristics of MTCars by Transmission Type",
"Population: All Cars") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl)
write_report(rpt)
file.show(pth)
Here is the RTF output:

Related

R shiny table with plots inside the table

I'm developing an R shiny app and ideally I would need to do precisely what is done here:
More specifically, I have dataframe with stocks open, close, high, low data and I would need to replicate what's displayed in the attached image in column "Range".
I understand I should attach some code, but the truth here, I can't find anything close to what I'm asking online.
A sample dataframe would be:
df = data.frame(STOCK=c("IBM","MSFT","FB"), OPEN=c(100,90, 80), CLOSE=c(102, 85, 82), LOW=c(99,81,78), HIGH=c(105, 91, 88))
Then, I have no idea of what to do from here. Any suggestions? Thanks
You can use custom-rendering follow this guide
https://glin.github.io/reactable/articles/examples.html#custom-rendering-1
library(dplyr)
library(sparkline)
data <- chickwts %>%
group_by(feed) %>%
summarise(weight = list(weight)) %>%
mutate(boxplot = NA, sparkline = NA)
reactable(data, columns = list(
weight = colDef(cell = function(values) {
sparkline(values, type = "bar", chartRangeMin = 0, chartRangeMax = max(chickwts$weight))
}),
boxplot = colDef(cell = function(value, index) {
sparkline(data$weight[[index]], type = "box")
}),
sparkline = colDef(cell = function(value, index) {
sparkline(data$weight[[index]])
})
))

Gridlines for a table not showing in mail when using Kable for CSS

I am trying to send a mail via mailR and it is working fine. I have a Data Frame and I wanted to colour code specific cells. I used Kable() to format and I got the desired output and it is showing the way it should in Rstudio viewer. But while sending that HTML in the mail, the gridlines are not visible.
I've tried adding 'bordered' in kable_styling()
#color coding for a data frame
library(knitr)
library(kableExtra)
library(dplyr)
a<-mtcars[1:10, 1:2] %>%
mutate(
car = row.names(.),
mpg = cell_spec(mpg, "html", color = ifelse(mpg > 20, "red", "blue")),
cyl = cell_spec(cyl, "html", color = "white", align = "c", angle = 45,
background = factor(cyl, c(4, 6, 8),
c("#666666", "#999999", "#BBBBBB")))
) %>%
select(car, mpg, cyl) %>%
kable(format = "html", escape = F) %>%
kable_styling(c("striped","bordered"), full_width = F)
#=================Send Email
library(mailR)
body_B <- paste("<p>
",a,"
<br> Note: report
<p>",sep="")
Subject <- paste(Sys.Date(), 'xyz',sep= ":")
send.mail(from = "asdf#gmail.com",
to = c("asdf#gmail.com"),
subject = Subject,
body = body_B,
html = TRUE,
smtp = list(host.name = "smtp.gmail.com", port = 587,
user.name = "#####",
passwd = "#####", ssl = T),
authenticate = T,
#attach.files = raw_data,
send = TRUE)
When you print a, you're using the print.kableExtra method, but body_B doesn't have the kableExtra class, so you'll just use the default methods producing the body for your message. If you read the source to kableExtra:::print.kableExtra, you'll see it really does quite a bit of manipulation before sending the object to the browser, so you'll need to duplicate that.
Here's an attempt at that. This might not be the simplest way to do it, but this produces a file that displays properly:
# Generate an HTML header
html_header <- htmltools::tags$head(rmarkdown::html_dependency_jquery(),
rmarkdown::html_dependency_bootstrap(theme = "simplex"),
html_dependency_kePrint())
# Declare body_B to be HTML
html_table <- htmltools::HTML(body_B)
# Glue the two parts together
html_result <- htmltools::tagList(html_header, html_table)
# Create a temp file and write the result there
html_file <- tempfile(fileext = ".html")
htmltools::save_html(html_result, file = html_file, background = "white")
# That will require several different files. You probably want to
# merge them all into one to display. Pandoc can do that...
system(paste(rmarkdown::pandoc_exec(), "--self-contained --template", html_file, "-o", html_file, "</dev/null"))
# The result is now in the file named in html_file. If you want it as
# a character variable, you can read it.
html_lines <- readLines(html_file)
I haven't tried putting this in an email, but I don't see why it wouldn't work.

conditionally format dynamically created table in R

I would like to render a table in R, with cells formatted according to some non-trivial logic. (e.g. if a value is odd, color the cell yellow; if it is also >5, make the text bold, etc.). This logic would be applied to each column of a dynamically created table, i.e. the column names are unknown so cannot be used in the code.
If found this JQuery approach helpful, but I'm not sure it completely solves my problem, plus I would prefer an R-based approach.
I also came close using the condformat package, but for some reason the following doesn't work:
library(condformat)
data(iris)
# Create a condformat object
cf <- condformat(iris)
# Add rules to it:
for (col in colnames(iris)[1:2]) {
cf <- cf %>% rule_css(!!col,
expression = ifelse(eval(parse(text=col)) < 3.3, "red", "black"),
css_field = 'color')
}
# Render it
cf
The first column of the resulting table doesn’t abide by the rule; instead, it is given the colors from column 2. But if I instead loop over just that first column, the coloring for it is correct.
Any help with the above code, or with the problem generally, would be greatly appreciated.
kableExtra is a very powerful tool for creating HTML tables in R.
library(kableExtra)
iris[1:10, 1:2] %>%
mutate(
Sepal.Length = cell_spec(
Sepal.Length,
"html",
background = ifelse(Sepal.Length %% 2 == 1, "yellow", "red"),
bold = ifelse(Sepal.Length > 5, T, F)
),
Sepal.Width = cell_spec(
Sepal.Width,
"html",
background = ifelse(Sepal.Width %% 2 == 1, "blue", "green"),
bold = ifelse(Sepal.Width > 10, T, F)
),
) %>%
kable(format = "html", escape = F) %>%
kable_styling("striped", full_width = F)
Please refer to the documentation for additional details:
Create Awesome HTML Table with knitr::kable and kableExtra
In order to do this on a dynamic table, you could loop over the columns of the data.frame like this (taking most of the code from Ozan147's answer):
library(kableExtra)
test <- iris[1:10, ]
for(i in 1:ncol(test)){
if(is.numeric(test[[i]])){
test[[i]] <- cell_spec(
test[[i]],
"html",
background = ifelse(test[[i]] %% 2 == 1, "yellow", "red"),
bold = ifelse(test[[i]] > 5, T, F)
)
}
}
test %>%
kable(format = "html", escape = F) %>%
kable_styling("striped", full_width = F)

body_add_flextable returning error - no applicable method for 'docx_str'

I have been trying to add a flextable created via rtable::FlexPivot into a word document using officer.
library(magrittr)
library(rtable)
library(officer)
library(flextable)
data = mtcars
data = group_by(data, vs, am, gear, carb)
data = summarise(data, avg = mean( mpg ), min = min( mpg ))
data$avg_col = ifelse( data$avg < 17, "red", "black" )
data$min_col = ifelse( data$min < 20, "gray", "purple" )
data$avg = sprintf( "%.3f", data$avg)
data$min = sprintf( "%.2f", data$min)
ft = FlexPivot( dataset = data, space = FALSE, columns.transpose = TRUE,
id = c("gear", "carb"), transpose = c("vs", "am"),
columns = c("avg", "min"),
color = c("avg"="avg_col", "min" = "min_col") )
my_doc <- read_docx() %>%
body_add_par(value='Some text etc etc') %>%
body_add_flextable(value=ft)
This returns an error message saying
Error in UseMethod("docx_str") : no applicable method for
'docx_str' applied to an object of class "FlexTable"
Any idea what might be causing this? I am using pandoc 2.1.3. pandoc_version() returns '2.1.3'.
rtable is designed to work with ReporteRs not with officer. Note that package ReporteRs will be removed from CRAN the 16th of July 2018 (due to incompatibility with java >=9), package officer is replacing ReporteRs and package flextable is replacing ReporteRs::FlexTable objects.
newFT <- flextable(ft) #add this line
#then this
my_doc <- read_docx() %>%
body_add_par(value='Some text etc etc') %>%
body_add_flextable(value=newFT)

How to Format R Shiny DataTable Like Microsoft Excel Table

I have some tables in Microsoft Excel that I need to recreate in an R Shiny App. The formatting in R has to remain at least mostly the same as the original context.
Here are images of the original tables:
Table 1
Table 2
Notice the formatting: There are lines under table headers and above totals, headers and totals are bolded, numbers in the Monthly Bill column have thousands seperated by commas and have dollar symbols, and the final number in Table 2 is boxed in.
If the lines were not recreatable it would be fine, but I need to at least be able to bold the selected topics, headers, and totals, and be able to get the correct number format for the Monthly Bill column.
I have tried using the DT package but I can't figure out how to format rows instead of columns. I noticed DT uses wrappers for JavaScript functions but I don't personally know JavaScript myself. Is there a way to format this the way I that I need through R packages or Javascript?
Edit:
Although it would be simple, I cannot merely include an image of the tables because some of the numbers are going to be linked to user input and must have the ability to update.
pixiedust makes it easy to do cell-specific customizations.
T1 <- data.frame(Charge = c("Environmental", "Base Power Cost",
"Base Adjustment Cost", "Distribution Adder",
"Retail Rate Without Fuel", "Fuel Charge Adjustment",
"Retail Rate With Fuel"),
Summer = c(0.00303, 0.06018, 0.00492, 0.00501, 0.07314,
0.02252, 0.09566),
Winter = c(0.00303, 0.05707, 0.00468, 0.01264, 0.07742,
0.02252, 0.09994),
Transition = c(0.00303, 0.05585, 0.00459, 0.01264,
0.07611, 0.02252, 0.09863),
stringsAsFactors = FALSE)
T2 <- data.frame(Period = c("Summer", "Winter", "Transition", "Yearly Bill"),
Rate = c(0.09566, 0.09994, 0.09863, NA),
Monthly = c(118.16, 122.44, 121.13, 1446.92),
stringsAsFactors = FALSE)
library(shiny)
library(pixiedust)
library(dplyr)
options(pixiedust_print_method = "html")
shinyApp(
ui =
fluidPage(
uiOutput("table1"),
uiOutput("table2")
),
server =
shinyServer(function(input, output, session){
output$table1 <-
renderUI({
dust(T1) %>%
sprinkle(rows = 1,
border = "bottom",
part = "head") %>%
sprinkle(rows = c(5, 7),
cols = 2:4,
border = "top") %>%
sprinkle(rows = c(5, 7),
bold = TRUE) %>%
sprinkle(pad = 4) %>%
sprinkle_colnames(Charge = "") %>%
print(asis = FALSE) %>%
HTML()
})
output$table2 <-
renderUI({
T2 %>%
mutate(Monthly = paste0("$", trimws(format(Monthly, big.mark = ",")))) %>%
dust() %>%
sprinkle(rows = 1,
border = "bottom",
part = "head") %>%
sprinkle(rows = 4,
cols = 1,
bold = TRUE) %>%
sprinkle(rows = 4,
cols = 3,
border = "all") %>%
sprinkle(na_string = "",
pad = 4) %>%
sprinkle_colnames(Period = "",
Monthly = "Monthly Bill") %>%
print(asis = FALSE) %>%
HTML()
})
})
)
This would be easier if you provided an example of your data, but sticking with DT, you should be able to utilize formatStyle to change formatting of both rows and columns. For an example to bold the first row, see the following (assuming your data frame is called df):
df %>%
datatable() %>%
formatStyle(
0,
target = "row",
fontWeight = styleEqual(1, "bold")
)
The rstudio DT page offers more examples: http://rstudio.github.io/DT/010-style.html
Alternatively, I think you might be better off using the stargazer package.
The base plot would look very similar to your desired result.
stargazer::stargazer(df, type = "html", title = "Table 1")
That will get you started, but see here for a LOT more flexibility: https://www.jakeruss.com/cheatsheets/stargazer/

Resources