Table format and output in R - r

Can anyone give me any hints on how to output this table in R (link)? for example, how to bold the first line, add a dotted line , and make a double title for the table. I prefer R markdown, rft is also OK , I am trying to avoid Latex . Thank you so much!!

Here is one way using the htmlTable package
install.packages('devtools')
devtools::install_github('gforge/htmlTable')
(you can also find htmlTable, the function, in the Gmisc package on cran (install.packages('Gmisc')), but it will be removed soon and available in a stand-alone package called htmlTable)
out <-
structure(c("37(34%)", "1 (Ref)", "1 (Ref)", "1 (Ref)", "1 (Ref)",
"1 (Ref)", "45(23%)", "0.68 (0.63, 0.73)", "0.38 (0.32, 0.44)",
"0.21 (0.17, 0.28)", "0.08 (0.05, 0.13)", "0.05 (0.02, 0.11)",
"", "0.03", "0.04", "0.03", "0.02", "0.02", "110(34%)", "0.68 (0.65, 0.71)",
"0.38 (0.34, 0.42)", "0.21 (0.18, 0.25)", "0.08 (0.06, 0.11)",
"0.05 (0.03, 0.08)", "", "0.03", "0.04", "0.03", "0.02", "0.02"
),
.Dim = c(6L, 5L),
.Dimnames = list(NULL, c("r", "hr", "p", "hr", "p")))
## format rows/cols
colnames(out) <- c('(n = ***)','HR (92% CI)','P','HR (92% CI)','P')
rownames(out) <- c('PD No (%)','None','Age','Age (<60 vs > 60)',
' Age > 60',' Age < 60')
## add padding row called subset
out <- rbind(out[1:4, ], 'Subsets:' = '', out[5:6, ])
## bolding rownames
rownames(out) <- sprintf('<b>%s</b>', rownames(out))
## table column headers (with line breaks (<br />))
cgroup <- c('', 'R + C<br />(n = ***)', 'R + S<br />(n = ***)')
# zzz <- `rownames<-`(out, NULL)
library(htmlTable)
htmlTable(out, rowlabel = 'Adjustment<sup>†</sup>',
ctable = TRUE, align = 'ccccc',
## number of columns that each cgroup label spans:
n.cgroup = c(1, 2, 2), cgroup = cgroup,
## insert two table spanning sections:
tspanner = c('',''), # no labels
n.tspanner = c(4, 3), # number of rows to span (must sum to nrow(out))
# css.tspanner.sep = "border-bottom: 1px dotted grey;",
caption = "Table 1: Hazard ratios and <i>p</i> values of two models and
something something.",
tfoot = '<font size=1><sup>†</sup>Some note.</font>')
Gives me this
Ran into problems (headaches) with the dotted line. suggest just using a solid

You could use package ReporteRs. There are output examples and corresponding R code here.
You have control over table borders, fonts, paragraphs, etc.

Related

Flextable ignores cell width arguments in R

I have a dataframe in R that I have converted to a Flextable. It looks okay, but I need to manually set the column widths. I've tried to accomplish this several ways and so far have not been successful. What I find especially odd is that when I run dim(myflextable) to look at the dimensions, the returned values are what I've set them as but the Flextable itself does not have those dimensions. Any insight would be appreciated.
dataframe + libraries
library(dplyr)
library(flextable)
library(officer)
extractionWS <- structure(list(Sample = c(12740L, 13231L, 13232L, 13233L, 13234L),
Full.name = c("Method Negative Control In Vitro Extraction 600 uL RLT-TCEP 23",
"G-A12-T5_7H9tw_co2_0-05_p0-8_b0-8_48h_tube49",
"G-A12-T4_7H9tw_co2_0-05_p0-8_b0-8_h0-1_96h_tube90",
"G-A13-T3_7H9tw_co2_0-05_untx_192h_tube71",
"G-A12-T5_7H9tw_co2_0-05_p0-8_b0-8_opc0-00195_48h_tube77"),
Providing.lab.key = c(NA, "VOS22_00349",
"VOS22_00290",
"VOS22_00675",
"VOS22_00377"),
kitshelf = c("", "", "", "", ""),
kitbox = c(8, 8, 8, 8, 8),
kitpos = c("A1", "A2", "A3", "A4", "A5"),
extractdate = c("", "", "", "", ""),
concentration = c("", "", "", "", ""),
rnashelf = c("", "", "", "", ""),
rnabox = c("", "", "", "", ""),
rnapos = c("", "", "", "", ""),
comment = c("", "", "", "", "")),
class = "data.frame", row.names = c(NA, -5L))
extractionWS <- extractionWS %>%
setNames(c("WL Number", 'Full Name', "Providing Lab Key",
"Kit Shelf", "Kit Box", "Kit Position",
"Extraction Date", "RNA Conc. (ng/ul)",
"Extracted RNA Shelf", "Extracted RNA Box","Extracted RNA Position", "Comment"))
flextable format attempt
#Create flextable
worksheet <- flextable(extractionWS)
#font style
worksheet <- bold(worksheet, bold = TRUE, part="header")
worksheet <- align(worksheet, align = "center", part = "all")
worksheet <- colformat_num(worksheet, big.mark="")
#border
border.outer = fp_border(color="black", width=2.5)
border.horizontal = fp_border(color="black", width=1.5)
border.vertical = fp_border(color="black", width=1.5)
worksheet <- border_outer(worksheet, border=border.outer, part="all")
worksheet <- border_inner_h(worksheet, part="all", border = border.horizontal)
worksheet <- border_inner_v(worksheet, part="all", border = border.vertical)
#Set fontsize
worksheet <- fontsize(worksheet, size = 12, part = "body")
worksheet <- fontsize(worksheet, j = 2, size = 8, part = "body")
#dimensions
worksheet <- width(worksheet, 12, width = 6)
dim(worksheet) output - indicates I successfully changed the column width:
$widths
WL.num Full.name Providing.lab.key kitshelf kitbox
0.75 0.75 0.75 0.75 0.75
kitpos extractdate concentration rnashelf rnabox
0.75 0.75 0.75 0.75 0.75
rnapos comment Kit Position
0.75 6.00 0.75
But this is not reflected in the table:
Sorry if I'm missing something obvious, I've spent a lot of time on this simple thing and gone over the documentation but haven't been able to find a solution.

Is there a package to create an rmarkdown table with separate sections with headers mid-table? (preferred pdf output)

I'm creating a document with rmarkdown, ultimately for pdf output.
I'd like to make a table that has multiple sections with subheadings (title, abstract, introduction etc.) such as the table below
I've made the following so far, but I'd like to have the vertical lines present apart from the heading rows("Title", "Abstract" etc):
{r prch}
pc = structure(list(`Section/topic` = c("\\textbf{Title}", "Title",
"\\textbf{Abstract}", "Structured summary"), `Item No` = c("",
"1", "", "2"), `Checklist item` = c("", "Identify the report as a systematic review, meta-analysis, or both",
"", "Provide a structured summary including, as applicable, background, objectives, data sources, study eligibility criteria, participants, interventions, "
), `Reported on page No` = c("", "", "", "")), row.names = c(NA,
-4L), class = c("tbl_df", "tbl", "data.frame"))
pc%>%
kbl(longtable = T, escape = F, booktabs = T)%>%
column_spec(1, width = "8em")%>%
column_spec(3, width = "20em")%>%
column_spec(4, width = "6em")%>%
kable_styling(latex_options = c("repeat"))
Here's a huxtable-based solution. (My package.)
library(huxtable)
ht <- tribble_hux(
~ "Section/topic", ~ "Item no", ~ "Checklist item", ~ "Reported on Page No",
"Title" , "" , "" , "",
"Title" , "1" , "Identify..." , "",
"Abstract" , "" , "" , "",
"Structured summary", "2" , "Provide..." , ""
# et cetera...
)
# using the pipe from 4.1.0...
ht |>
set_header_rows(c(2, 4), TRUE) |>
merge_across(c(2, 4), everywhere) |>
style_header_rows(bold = TRUE) |>
set_all_borders(brdr(0.4, "solid", "grey70")) |>
set_background_color("grey97") |>
set_background_color(1, 1:3, "grey90") |>
set_col_width(c(0.2, 0.05, 0.55, 0.2)) |>
set_font("cmss") |>
quick_pdf()

Indentation when line break in group_rows() command - kableExtra package in R markdown

I'm using the kableExtra package to output a table to PDF in R markdown.
I use the command group_rows() to group some rows of my table together.
The text in some rows of my first column is too long for the column width, so it is broken into two lines. However, there is no indentation of the second line. Is there a way to either indent also the second line or remove the indentation overall?
Increasing the column width so the text won't be spread over two lines is unfortunately no option since I have way more columns in my real table.
This is a subset of my data frame:
data <- structure(list(`Control variables` = c("GDP growth", "GDP per capita",
"Top income tax rate", "Right-wing executive"), Treated = structure(c("2.29",
"21,523.57", "0.70", "0.62"), class = "AsIs"), top10_synthetic = structure(c("3.37", "19,939.72", "0.68", "0.63"), class = "AsIs"), top10_mean = structure(c("2.95", "30,242.60", "0.64", "0.43"), class = "AsIs")), .Names = c("Control variables", "Treated", "top10_synthetic", "top10_mean"), row.names = c(NA, 4L), class = "data.frame")
This is the code I am using:
```{r}
kable(data, "latex", caption = "table 1", booktabs = T, col.names = c("Control variables", "Treated", "Synthetic", "Mean")) %>%
add_header_above(c("", "", "Top 10%" = 2)) %>%
group_rows("UK", 1, 2) %>%
group_rows("Japan", 3, 4, latex_gap_space = "0.8cm") %>%
footnote(general = "xxx") %>%
kable_styling(latex_options = c("HOLD_position", "scale_down")) %>%
column_spec(1, width = "3cm")
```
This is how the .pdf output looks like. As you can see, e.g. the text "top income tax rate" is split into two lines and I would like the second line to be indented just like the first line.
Thank you for any tips!
If you just run the chunk in the R console, you'll see this LaTeX output:
\begin{table}[H]
\caption{\label{tab:}table 1}
\centering
\resizebox{\linewidth}{!}{
\begin{tabular}[t]{>{\raggedright\arraybackslash}p{3cm}lll}
\toprule
\multicolumn{1}{c}{} & \multicolumn{1}{c}{} & \multicolumn{2}{c}{Top 10\%} \\
\cmidrule(l{2pt}r{2pt}){3-4}
Control variables & Treated & Synthetic & Mean\\
\midrule
\addlinespace[0.3em]
\multicolumn{4}{l}{\textbf{UK}}\\
\hspace{1em}GDP growth & 2.29 & 3.37 & 2.95\\
\hspace{1em}GDP per capita & 21,523.57 & 19,939.72 & 30,242.60\\
\addlinespace[0.8cm]
\multicolumn{4}{l}{\textbf{Japan}}\\
\hspace{1em}Top income tax rate & 0.70 & 0.68 & 0.64\\
\hspace{1em}Right-wing executive & 0.62 & 0.63 & 0.43\\
\bottomrule
\multicolumn{4}{l}{\textit{Note: }}\\
\multicolumn{4}{l}{xxx}\\
\end{tabular}}
\end{table}
As you can see, kableExtra isn't putting in a line break in that title, LaTeX is doing it. This means you need a LaTeX fix for the problem. Maybe someone else knows an easier one, but the best I could find is the following: wrap the long row title in a minipage environment, and fiddle with the spacing to look better.
Since this is kind of messy, I'd write an R function to do it:
inMinipage <- function(x, width)
paste0("\\begin{minipage}[t]{",
width,
"}\\raggedright\\setstretch{0.8}",
x,
"\\vspace{1.2ex}\\end{minipage}")
This needs to be called on the data being put into the table, and kable needs to be told not to escape those backslashes (using escape = FALSE). In addition, the \setstretch command comes from the setspace LaTeX package. So overall your sample document would look like this:
---
output:
pdf_document:
extra_dependencies: setspace
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(kableExtra)
library(knitr)
```
```{r}
inMinipage <- function(x, width)
paste0("\\begin{minipage}[t]{",
width,
"}\\raggedright\\setstretch{0.8}",
x,
"\\end{minipage}")
data <- structure(list(`Control variables` = c("GDP growth", "GDP per capita", "Top income tax rate", "Right-wing executive"), Treated = structure(c("2.29",
"21,523.57", "0.70", "0.62"), class = "AsIs"), top10_synthetic = structure(c("3.37", "19,939.72", "0.68", "0.63"), class = "AsIs"), top10_mean = structure(c("2.95", "30,242.60", "0.64", "0.43"), class = "AsIs")), .Names = c("Control variables", "Treated", "top10_synthetic", "top10_mean"), row.names = c(NA, 4L), class = "data.frame")
data[[1]] <- inMinipage(data[[1]], "2.5cm")
kable(data, "latex", caption = "table 1", booktabs = T, col.names = c("Control variables", "Treated", "Synthetic", "Mean"), escape = FALSE) %>%
add_header_above(c("", "", "Top 10%" = 2)) %>%
group_rows("UK", 1, 2) %>%
group_rows("Japan", 3, 4, latex_gap_space = "0.8cm") %>%
footnote(general = "xxx") %>%
kable_styling(latex_options = c("HOLD_position", "scale_down")) %>%
column_spec(1, width = "3cm")
```
With that code I see this:
The spacing isn't quite right, but it's getting close. I hope this helps.

Table in r with multiple sub rows and write to pdf

Is it possible to generate a table in R with multiple rows correspondng to a single row? And write the resultant table to a pdf. The sample table is as below.
Is it possible to join two seperate tables in the way showed in the image.
Sample code for the two tables are given below
tab1="Test Description
1 test1 description
2 test2 description"
table1 <-read.table(text = tab1,header = TRUE)
tab21="Cause Probability Feedback
1 cause1 .5 positive
2 Cause2 .2 negative
3 Cause3 .1 negative
4 Cause4 .2 negative"
table2 <-read.table(text = tab21,header = TRUE)
tab22="Cause Probability Feedback
1 cause1 .7 positive
2 Cause2 .2 negative
3 Cause3 .1 negative"
table3 <-read.table(text = tab22,header = TRUE)
It is a little bit tricky, but I'd take advantage of the fact that cells with NAs are printed as empty by the print.xtable-function. The cells are not truly 'merged', but it looks like it when the contents are aligned to the top.
Basically the steps are:
Generate a suitable data.frame in R
Print this as a .tex compatible table using print.xtable from the package 'xtable'
Use Sweave/knitr/etc to generate a suitable .tex
tools::texi2pdf will then convert your .tex to a suitable .pdf
Here are the files, you need to only source the RunSweave.R in your R terminal (and make sure you have LaTeX installed along with the required packages, i.e. 'xtable and have the files in a single folder; this was run in Windows).
File StackExampleCode.R:
# StackExampleCode.R
library(xtable)
# A work-around by setting rows in the multi-row to NA after the initial top-justified line
header <- data.frame(test = "Tests", det = "Details", cause = "Cause", prob = "Probability", fb = "Feedback")
# Filling the fields for these is something you'd probably want to do in R in a more sophisticated manner
test1 <- data.frame(
test = c("Test 1", NA, NA, NA, NA),
det = c("Description", NA, NA, NA, NA),
cause = c("Cause 1", NA, paste("Cause", 2:4)),
prob = c(".5", NA, ".2", ".1", ".2"),
fb = c("positive", NA, "negative", "negative", "negative")
)
test2 <- data.frame(
test = c("Test 2", NA, NA, NA),
det = c("Description", NA, NA, NA),
cause = c(paste("Cause", 1:3), NA),
prob = c(".7", ".1", ".2", NA),
fb = c("positive", "negative", "negative", NA)
)
# Bind it all together, you probably want something similar if it's automatic data you're generating
tab <- rbind(header, test1, test2)
File StackExampleRnw.Rnw:
% StackExampleRnw.Rnw
% Note the different comment char, writing .tex here
\documentclass{article}
\begin{document}
<<echo=FALSE, results=tex>>=
# Printing the table
print(
xtable(tab,
align = "|l|l|l|l|l|l|" # Create the desired vertical lines and text alignments ala LaTeX; left align with vertical lines in-between each column)
),
add.to.row = list( # Add horizontal lines to correct spots, should be adjusted according to the desired data
pos = list(-1, 1, 6, nrow(tab)),
command = c("\\hline \n", "\\hline \n", "\\hline \n", "\\hline \n") # Horizontal lines and a neater formatting of output using a linechange
),
include.rownames = FALSE, # Don't include the rownames (which would be just numbers)
include.colnames = FALSE, # Don't include the rownames, these were already included as if it was an ordinary table row
hline.after = NULL # Suppress the empty horizontal line that is intended for an automated caption
)
#
\end{document}
File RunSweave.R:
# RunSweave.R
# Run the code
source("StackExampleCode.R")
# Bundle R code with LaTeX
Sweave("StackExampleRnw.Rnw")
# .tex -> .pdf
tools::texi2pdf("StackExampleRnw.tex")
Here's what it looks like for me in StackExampleRnw.pdf:
Alternatively, you can directly access the table in .tex in the file StackExampleRnw.tex and do some additional formatting if you're comfortable with it. Above doesn't require any additional tinkering in .tex, but you need to make sure you put the horizontal lines and NAs to correct places.
If you're not comfortable with .tex, the print.xtable-function has plenty of parameters available for further formatting. If the partial horizontal lines are really important for you in the three columns to the right, I'd probably split this into two tables and then just glue them together horizontally and have the right one with a horizontal line in each row.
I would have liked to accomplish this in pixiedust by merging some cells, but it appears I have a flaw in pixiedust that doesn't allow for vertical borders on merged rows. The workaround uses Teemu's approach of setting the cells we don't wish to view to NA and directing them to be printed as empty characters.
library(dplyr)
library(pixiedust)
table2$Test <- "test1"
table3$Test <- "test2"
bind_rows(
right_join(table1, table2),
right_join(table1, table3)
) %>%
mutate(Description = as.character(Description)) %>%
group_by(Test) %>%
mutate(Description = ifelse(duplicated(Description), NA, Description)) %>%
ungroup() %>%
mutate(Test = ifelse(duplicated(Test), NA, Test))%>%
dust(float = FALSE) %>%
sprinkle(cols = 1:2,
rows = c(4, 7),
border = "bottom") %>%
sprinkle(cols = 1:2,
rows = 1,
border = "top") %>%
sprinkle(cols = 1:2,
border = "left",
na.string = "") %>%
medley_all_borders(cols = 3:5) %>%
medley_all_borders(part = "head") %>%
sprinkle_print_method("latex")
A full, working RMD file would be:
---
title: "Untitled"
output: pdf_document
header-includes:
- \usepackage{amssymb}
- \usepackage{arydshln}
- \usepackage{caption}
- \usepackage{graphicx}
- \usepackage{hhline}
- \usepackage{longtable}
- \usepackage{multirow}
- \usepackage[dvipsnames,table]{xcolor}
---
```{r, echo = FALSE, message = FALSE, warning = FALSE}
library(dplyr)
library(pixiedust)
tab1="Test Description
1 test1 description
2 test2 description"
table1 <-read.table(text = tab1,header = TRUE)
tab21="Cause Probability Feedback
1 cause1 .5 positive
2 Cause2 .2 negative
3 Cause3 .1 negative
4 Cause4 .2 negative"
table2 <-read.table(text = tab21,header = TRUE)
tab22="Cause Probability Feedback
1 cause1 .7 positive
2 Cause2 .2 negative
3 Cause3 .1 negative"
table3 <-read.table(text = tab22,header = TRUE)
```
```{r, echo = FALSE, message = FALSE, warning = FALSE}
table2$Test <- "test1"
table3$Test <- "test2"
bind_rows(
right_join(table1, table2),
right_join(table1, table3)
) %>%
mutate(Description = as.character(Description)) %>%
group_by(Test) %>%
mutate(Description = ifelse(duplicated(Description), NA, Description)) %>%
ungroup() %>%
mutate(Test = ifelse(duplicated(Test), NA, Test))%>%
dust(float = FALSE) %>%
sprinkle(cols = 1:2,
rows = c(4, 7),
border = "bottom") %>%
sprinkle(cols = 1:2,
rows = 1,
border = "top") %>%
sprinkle(cols = 1:2,
border = "left",
na.string = "") %>%
medley_all_borders(cols = 3:5) %>%
medley_all_borders(part = "head")
```

multivariate k-means cluster

I'm trying to do a multivariate k-means cluster plot in r. I have 3 variables, and 10 columns of data, plus the context (like species for Iris) so 11 variables. And my x is PeruReady, obviously
Following a tutorial online I got this far:
PeruReady.km <- kmeans(PeruReady[, -1], 3, iter.max=1000)
tbl <- table(PeruReady[, 1], PeruReady.km$cluster)
PeruReady.dist <- dist(PeruReady[, -1])
PeruReady.mds <- cmdscale(PeruReady.dist)
c.chars <- c("*", "o", "+")[as.integer(PeruReady$Context)]
a.cols <- rainbow(3)[PeruReady$cluster]
plot(PeruReady.mds, col=a.cols, pch=c.chars, xlab="X", ylab="Y")
But my plot is coming up completely empty, what am I doing wrong?
With a small data set (demand.sm), your code worked just fine. Have you normalized all your numeric columns?
dput(demand.sm)
structure(list(Demand = c("rify la", "p quasi", "rify LD", "ventive",
"ekeeper", " de min", " risk g", " approv", "uest te", "", "al trai",
"cation", "ely inv", "rge tim", "get of ", "vey pro", "ent ONA",
"ble sel", "cipline", "tus rep", "ced-ran"), normalized = structure(c(-1.15780226157481,
-0.319393727330983, -1.15780226157481, -1.15780226157481, -0.319393727330983,
-0.319393727330983, -0.319393727330983, -0.319393727330983, 0.519014806912847,
0.519014806912847, 0.519014806912847, -0.738597994452898, -0.738597994452898,
2.19583187540051, 2.19583187540051, -1.15780226157481, -0.319393727330983,
-0.319393727330983, 0.519014806912847, 1.35742334115668, 0.519014806912847
), .Dim = c(21L, 1L), "`scaled:center`" = 3.76190476190476, "`scaled:scale`" = 2.38547190100328)), .Names = c("Demand",
"normalized"), row.names = c(NA, -21L), class = "data.frame")
clusters <- kmeans(demand.sm[ , "normalized"], 5)
demand.dist <- dist(demand.sm[ , "normalized"])
demand.mds <- cmdscale(demand.dist) # multidimensional scaling of data matrix, aka principal coordinates analysis
c.chars <- c("*", "o", "+")[as.integer(clusters$Context)]
a.cols <- rainbow(3)[clusters$cluster]
plot(demand.mds, col=a.cols, pch=c.chars, xlab="X", ylab="Y")

Resources