Add an image to a table-like output in R - r

I have a simple data structure: cases are countries and for each country I have a couple of numeric variables. Like so:
dat <- data.frame(country = c("Belgium", "Germany", "Holland", "Ireland"), Var1 = 1:4, Var2 = 11:14)
print(dat, row.names = FALSE)
country Var1 Var2
Belgium 1 11
Germany 2 12
Holland 3 13
Ireland 4 14
The table needs to be formatted still, with headings in bold, and rows colored in grey or white, alternatingly.
Now, what I want is to add two additional columns, in between "country" and "Var1". The first new column is called "flag" and should contain the country's flag. The second new column is called "flagged" and contains an image of a red flag is the country scores very bad on a particular human rights issue, an orange flag if it scores mediocre and nothing elsewise.
How can I create an object that prints that way in R? How to combine images with data in such a layout?
(eventually this will part of a larger document created with knitr)

If you are using knitr with the rmarkdown package, it is pretty easy -- just use the Markdown syntax ![]() to include images, e.g.
---
title: "Flags"
author: "Yihui Xie"
date: "2014/08/03"
output: html_document
---
```{r results='asis'}
dat <- data.frame(
country = c('Canada', 'United Kindom'),
abbr = c('ca', 'gb'),
var1 = c(1, 2),
var2 = rnorm(2)
)
dat$flag <- sprintf('![](http://flagpedia.net/data/flags/mini/%s.png)', dat$abbr)
library(knitr)
kable(dat)
```
If you need LaTeX/PDF output, you have to download these images by yourself. Here is an example:
---
title: "Flags"
author: "Yihui Xie"
date: "2014/08/03"
output: html_document
---
```{r}
dat <- data.frame(
country = c('Canada', 'United Kindom'),
abbr = c('ca', 'gb'),
var1 = c(1, 2),
var2 = rnorm(2)
)
dat$file <- paste0(dat$abbr, '.png')
dat$link <- paste0('http://flagpedia.net/data/flags/mini/', dat$file)
dat$flag <- sprintf('![](%s)', dat$file)
for (i in seq_len(nrow(dat))) {
if (!file.exists(dat$file[i])) xfun::download_file(dat$link[i])
}
knitr::kable(dat[, -c(5, 6)])
```

With this experimental fork of gtable, you can do,
require(gtable)
dat <- data.frame(country = c("Belgium", "Germany", "Holland", "Ireland"), Var1 = 1:4, Var2 = 11:14)
g <- gtable_table(dat)
library(png)
# pirate-land flag for illustration
img <- readPNG(system.file("img", "Rlogo.png", package="png"), native = FALSE)
imgRgb <- rgb(img[,,1],img[,,2],img[,,3])
dim(imgRgb) <- dim(img)[1:2]
flags <- replicate(nrow(g), rasterGrob(imgRgb), simplify = FALSE)
g <- gtable_add_cols(g, unit(1,"cm"), 0)
g <- gtable_add_grob(g, flags, t = seq_len(nrow(g)), l=1, r=1, z=1)
grid.newpage()
grid.draw(g)
formatting options described here

The question was asked with pdf as the output, here is an answer using knitr, and something more appropriate than just \includegraphics
The trick is to use the adjustbox package in latex, with the following arguments:
the height (later used as the argument to the R function get_picture_code) is the height of the picture.
the valign argument (which default here to valign=m), will perform vertical adjustment according to the text,
the margin here defined as 1ex surrounding the picture allows to separate the flags.
So we just use this function
get_picture_code <- function(path,height,col=NULL)
{
paste0("\\adjustimage{height=",height,",valign=m,margin*=1ex}{",path,"}")
}
To get a vector of images added to the table.
Finally we use xtable with argument sanitize.text.function = identity to print the tex code :
\documentclass{article}
\usepackage{adjustbox}
\begin{document}
<<load_libraries, echo = FALSE, eval = TRUE, results ="hide">>=
library(knitr)
library(xtable)
#
<<include_images, echo = FALSE, eval = TRUE, results ="hide">>=
get_picture_code <- function(path,height,col=NULL){
paste0("\\adjustimage{height=",height,",valign=m,margin*=1ex}{",path,"}")
}
#
<<test, echo = FALSE, eval = TRUE, results ="hide">>=
dat <- data.frame(country = c("Belgium", "Germany", "Holland", "Ireland"),
Var1 = 1:4, Var2 = 11:14)
mypath <- paste0("images/",dat$country,".png")
dat$flag <- get_picture_code(path=mypath,height="0.8cm")
dat$test <-NA
dat$test[2:3] <-get_picture_code(path="images/orange_flag",height="0.6cm")
print(xtable(dat,
align = c("l","l","l","l","c","c"),
caption = "Example with flags"),
sanitize.text.function = identity,
file="table_with_images.tex")
#
\input{table_with_images.tex}
\end{document}
The adjustbox documentation contains many other options, including background colors, trim, horizonal alignment which will allow you to do some very fine adjustment of the position of the images...
There is also a nice example of the use of this package in TeX-Latex stackexchange

Related

R-markdown to create multiple word file parametrised from excel tab

I have a table in Excel that looks like this:
Country
X
Y
US
01
A
UK
02
B
FR
03
C
Using R (I imported the excel using "readxl" package) and Rmarkdown, I would like to create, for each country, a word file showing only the X and Y values related to that country. So for example, the word file generated for the US would have "US" as title, and simply a table showing:
X
Y
01
A
Can anybody help? Many thanks in advance!
Create a rmarkdown document:
---
title: "`r Country`"
output: word_document
---
```{r results='asis', echo=FALSE}
knitr::kable(df_xy, row.names = FALSE)
```
In a separate .R file set up a loop to render the rmarkdown files with required data.
In your use case just substitute df1 with the output from readxl::read_xlsx().
df1 <- data.frame(Country = rep(c("US", "UK", "FR"), each = 3),
X = rep(c("01", "02", "03"), each = 3),
Y = LETTERS[1:9])
for (Country in unique(df1$Country)) {
df_xy <- df1[df1$Country == Country, c("X", "Y")]
rmarkdown::render(
'country_xy.Rmd',
output_file = paste0(Country, '.docx')
)
}
You should end up with, in this case, three files:
FR.docx
UK.docx
US.docx
Which results in a WORD file as so:
A really useful resource for rmarkdown is: https://bookdown.org/yihui/rmarkdown-cookbook/rmarkdown-render.html

Scientific formats, subscripts and superscripts in RMarkdown table (docx output)

Let's say I have the following rmd:
---
title: "Table won't work"
author: "Exhausted student"
date: "2022/01/28"
output:
bookdown::word_document2
---
```{r table, echo=F, warning=F, message=F}
library(tidyverse)
a <- tibble(
constants = c("c", "NA", "h", "e", "H2O"),
values = c(2.998e8, 6.022e23, 6.626e-34, -1.602e-19, 18.02)
)
knitr::kable(a, digits = 35)
```
which produces this table in Word.
The Problem
I need the scientific format to use superscripts and multiply sign (i.e. 2.998 × 108), and some cells requires subscript (e.g. NA and H2O).
The final table should look like this. How can I do that?
What I've tried/would never try
huxtable package and its markdown() function: I managed to format some contents as H~2~O, then enable markdown across table by huxtable(a) %>% `markdown<-`(TRUE). Which did not recognize the syntax, and apparently would not work in forseeable future according to the author.
flextable and as_sub(): Produces right format. I pass the lables to flextable::compose(), where the labels were something like as_paragraph(list_values = list("H", as_sub("2"), "O"). The code is obviously too lengthy; plus i have to manipulate cells one-by-one. Technically still doable, but I do have tables with 100+ cells needed formatting.
Output first, format in Word later: Again, needed manipulation one-by-one. Would be an option if it would work everything out automatically.
Convincing the school bureaucrats to accept html/pdf/latex as output: this is forever an impossible option.
Format outside word then export formatted table as image: strictly forbidden in the reports.
Edit: the table works now! Great thanks to Maël's answer, but please check my own findings to see my final result:
You can use tildes (~) to put in subscript and carets (^) for superscripts; and use sprintf to get the expected digit format:
---
title: "Table won't work"
author: "Exhausted student"
date: "2022/01/28"
output:
bookdown::word_document2
---
```{r table, echo=F, warning=F, message=F}
library(tidyverse)
expSup <- function(x, digits=3) {
sprintf(paste0("%05.", digits, "f x 10^%d^"), x/10^floor(log10(abs(x))), floor(log10(abs(x))))
}
a <- tibble(
constants = c("c", "N~A~", "h", "e", "H~2~0"),
values = expSup(c(2.998e8, 6.022e-23, 6.626e-34, -1.602e-19, 18.02))
)
knitr::kable(a)
```
An option that probably falls in the no-go zone for this open issue:
Create a html document,
Insert html tags for subscripts,
Open the html file (not the viewer),
ctrl+c, then ctrl+v in your word file.
---
output: html_document
---
```{r table, echo=F, warning=F, message=F}
library(tidyverse)
library(gt)
a <- tibble(
constants = c("c", "N<sub>A</sub>", "h","e","H<sub>2</sub>O"),
values = c(2.998e8, 6.022e23, 6.626e-34, -1.602e-19, 18.02)
)
a %>%
mutate(constants = map(constants, html)) %>%
gt() %>%
fmt_scientific(values)
The expSup() function in Maël's answer converted the scientific formats into markdown format. For my script, I modified the function a little:
exp_sup <- function(x, digits = 3) {
sprintf(paste0("%05.", digits, "f $\\times$ 10^%d^"), x / 10^floor(log10(abs(x))), floor(log10(abs(x))))
}
I changed "f x 10^%d^" to "f $\\times$ 10^%d^", so that it displays proper multiply symbol (×).
Using the format in flextable
The format works great in Kable. However, a large portion of my workflow requires flextable to make caption/cross reference/publication style/etc. Unfortunately, although the expSup function automatically formats scientific notations into markdowns, it cannot make markdown syntax work in flextable.
However, ftExtra::colformat_md() can. Hence, by combining the modified exp_sup() function with ftExtra, I was finally able to produce an academic-looking table:
Below is the code for my final output; if you are also trying to produce reproducible academic reports with lots of tables in Word format, hope this helps!
---
title: "The tables work!"
author: "Satisfied Student"
date: "2022/01/28"
output:
bookdown::word_document2:
reference_docx: styleRef.docx
---
```{r setup, include = F}
library(easypackages)
packages(
"tidyverse",
"flextable", # This works best for my workflow
"ftExtra", # For markdown formatting work in flextable
"officer" # You can customize appearance/format/etc. of caption *prefixes*
)
knitr::opts_chunk$set(
warning = FALSE,
message = FALSE,
echo = FALSE,
# Make the table caption format definable in reference_docx styles
tab.cap.style = "Table Caption",
# Make "Table 1:" prefixes not bold
tab.cap.fp_text = fp_text_lite(bold = FALSE)
# The tab.cap settings MUST be in a separate chunk from tables
)
# Converts scientific format to markdown
exp_sup <- function(x, digits = 3) {
sprintf(paste0("%05.", digits, "f $\\times$ 10^%d^"), x / 10^floor(log10(abs(x))), floor(log10(abs(x))))
}
# The $\\times$ makes proper multiply symbols
```
```{r table}
a <- tibble(
constants = c("c", "N~A~", "h", "e", "H~2~O"),
values = c(2.998e8, 6.022e23, 6.626e-34, -1.602e-19, 18.02)
)
a %>%
mutate(values = exp_sup(values)) %>%
flextable() %>%
set_caption(
caption = "(ref:foo)", # Produces formatted caption text
style = "Table Caption"
) %>%
colformat_md() %>% # Subscript/superscript works in flextable now!
theme_booktabs() %>% # The 3-part-table used in academics
align(align = "center", part = "all") %>% #Align everything to center
set_table_properties(layout = "autofit") # Comfortable width/height every cell
```
(ref:foo) A scientifically formatted `flextable` with ^superscripts^ and ~subscripts~
Your code should look like this:
```
{r table, echo=F, warning=F, message=F}
library(tidyverse)
a <- tibble(
constants = c("c", "NA", "h", "e", "$H_2O$"),
values = c("$2.998 * {10^{8}}$", "$6.022 * {10^{-23}}$", "$6.626 * {10^{-34}}$", "$-1.602 * {10 ^{-19}}$", "$1.802 * {10^{1}}$")
)
knitr::kable(format = "html", a, digits = 35)
```
Which will give you the output like this:

merge columns every other row using Sweave/R/Latex

I am writing a conference abstract booklet using R/Sweave. I have already made the program booklet for printing that contains the id, author, title only.
Now I want to modify it to include the abstract (not for print). But abstracts are lengthy. My thought is to take the cell with the abstract info, and have it display below the row with the author info - expanded across the full width of the page.
ID--author--------title--------------------------------
abstract-----------------------------------------------
So every other row has only one column spanning the width of the entire table.
Is there a way to add multicolmn{x} to every other row?
If a solution can't be figured out, advice for how to print full abstracts in a nice way would be welcome. (Something other than "just use landscape" or "adjust column widths")
Also, it doesn't have to be PDF. I could switch to markdown/html - and make it look closer to real conference program schedules that have full abstracts on them. Again, one I figure out how to print a table where every other row has only one column that is the width of the entire table.
If you want to try - Here is a complete MWE for what I have working now. Note that it uses the R package lipsum which has to be installed via devtools/github.
\documentclass{article}
\usepackage{booktabs, multicol, array}
\usepackage[margin=0.75in]{geometry}
%%%%%%%%%%% Let tables to span entire page
\newcolumntype{L}[1]{>{\raggedright\let\newline\\\arraybackslash\hspace{0pt}}m{#1}}
<<echo=FALSE, warning=FALSE, message=FALSE>>=
# devtools::install_github("coolbutuseless/lipsum")
library(lipsum)
library(xtable)
knitr::opts_chunk$set(echo = FALSE, warning=FALSE, message=FALSE)
options(xtable.comment = FALSE)
tblalign <- "lL{0.5cm}|L{4cm}L{6cm}L{8cm}"
# fake data setup
dat <- data.frame(ID = c(1:3), author = substr(lipsum[1:3], 1, 40),
title = substr(lipsum[4:6], 1, 100),
abstract = lipsum[7:9])
names(dat)=c("\\multicolumn{1}{c}{\\textbf{\\large{ID}}}",
"\\multicolumn{1}{c}{\\textbf{\\large{Author List}}}",
"\\multicolumn{1}{c}{\\textbf{\\large{Title}}}",
"\\multicolumn{1}{c}{\\textbf{\\large{Abstract}}}")
#
\begin{document}
<<results='asis'>>=
print(
xtable(x = dat
, align = tblalign)
, table.placement = "H"
, sanitize.colnames.function=function(x){x}
, include.rownames = FALSE
, include.colnames = TRUE
, size = "small"
, floating = FALSE
, hline.after = c(0,1:nrow(dat))
)
#
\end{document}
Split data from abstract manually
out <- dat[,-4]
ab.list <- dat$abstract
then add.to.row
, add.to.row = list(pos = as.list(1:nrow(out)),
command = paste0("\\multicolumn{3}{L{15cm}}{\\textbf{Abstract: }", ab.list, "} \\\\"))
One approach using my package huxtable. I couldn't install lipsum for some reason, so just hacked it. This is in a .Rmd file with output pdf_document.
```{r, results = 'asis'}
lipsum <- rep(do.call(paste, list(rep('blah ', 100), collapse = '')), 10)
dat <- data.frame(ID = c(1:3), author = substr(lipsum[1:3], 1, 40),
title = substr(lipsum[4:6], 1, 100),
abstract = lipsum[7:9], stringsAsFactors = FALSE)
library(huxtable)
# shape data
datmat <- matrix(NA_character_, nrow(dat) * 2, 3)
datmat[seq(1, nrow(datmat), 2), ] <- as.matrix(dat[, c('ID', 'author', 'title')])
datmat[seq(2, nrow(datmat), 2), 1] <- dat$abstract
# print as PDF
ht <- as_huxtable(datmat)
colspan(ht)[seq(2, nrow(ht), 2), 1] <- 3
wrap(ht) <- TRUE
col_width(ht) <- c(.2, .2, .6)
number_format(ht) <- 0
ht
```

How to rotate a table left margin name with knitr and xtable?

I'm trying to get the results of the table command nicely printed on a pdf by using knitr and xtable.
As a toy example let's say I want to get the table created with
table(c(2,5,5,5,5,7,7,7,7,NA),c(1,5,2,2,2,2,7,7,NA,NA))
I would like to get something like this:
As you can see var1 is rotated 90 degrees counterclockwise.
How can I get it?
Similar results, with less or more lines are OK too.
I've being trying different methods I've found.
I've created this Rnw file,
\documentclass{article}
\usepackage{booktabs}
\usepackage{rotating}
\begin{document}
<<r table, results='asis', echo=FALSE>>=
library(knitr)
library(xtable)
var1 <- c(2,5,5,5,5,7,7,7,7,NA)
var2 <- c(1,5,2,2,2,2,7,7,NA,NA)
print(xtable(table(var1,var2)))
print.xtableFtable(xtableFtable(ftable(var1,var2),
method = "row.compact"))
print.xtableFtable(xtableFtable(ftable(var1,var2),
method = "row.compact"), rotate.rownames = TRUE)
print.xtable(xtable(table(var1,var2)), include.rownames=T,include.colnames=T)
#
\end{document}
You can see below the result of the three methods I've tried.
I can't get the expected result.
Any solution with other common package or kable it's OK too.
I guess it could be done with \rotatebox{90} but I don't know how to force xtable to use it nor how to tell xtable to place the left title on the left instead of just being on the top-right.
Here's one possibility. Disclaimer: I am the package author.
library(huxtable)
var1 <- c(2,5,5,5,5,7,7,7,7,NA)
var2 <- c(1,5,2,2,2,2,7,7,NA,NA)
tbl <- table(var1 = var1, var2 = var2)
ht <- as_hux(tbl)
ht <- cbind(rep('', 4), ht)
ht[2,1] <- 'var1'
ht <- rbind(rep('', 6), ht)
ht[2,2] <- '' # get rid of "rownames"
ht[1,3] <- 'var2'
colspan(ht)[1,3] <- 4
rowspan(ht)[3, 1] <- 3
rotation(ht)[3, 1] <- 90
right_border(ht)[,2] <- 1
bottom_border(ht)[5, -1] <- 1
bottom_border(ht)[2, -1] <- 1
ht
When used in an rmarkdown PDF document, this produces:

Knitting an HTML file wont publish the inference command

I am currently doing a R course and I struggle with knitting an HTML file.
All the code works fine within RStudio. The file also knits properly, however it wont plot an output for the last command, when I run the inference. I added the code.
Any input is much appreciated.
Thanks
Markus
Firstly, we filter for the religions and the year of interest:
```{r filter}
gss2012 = gss %>%
filter(year =="2012")
gssCatPro2012 = gss2012 %>%
filter(relig=="Catholic" | relig=="Protestant")
```
Now we create a first histogram of both religions to get a first idea of the distributions:
{r plot both rel}
ggplot(data=gssCatPro2012, aes(x=childs))+geom_histogram()
Calculate ratio and represent in pie chart:
{r ratio}
gssCatPro2012 %>%
summarise(Catholicratio = sum(relig =="Catholic")/n())
percent <- c(32.64,67.36)
lbls <- c("Catholics", "Protestants")
pct <- round(percent/sum(percent)*100)
lbls <- paste(lbls, pct)
lbls <- paste(lbls,"%", sep="")
pie(percent, labels=lbls, col=rainbow(length(lbls)), main="Pie chart Catholics/Protestants")
Split data between religions:
{r split}
gssCat2012 = gssCatPro2012 %>%
filter(relig=="Catholic")
gssPro2012 = gssCatPro2012 %>%
filter(relig=="Protestant")
Plot first distribution of Catholics, then Protestants:
{r plot per religion}
ggplot(data=gssCat2012, aes(x=childs))+geom_histogram()
ggplot(data=gssPro2012, aes(x=childs))+geom_histogram()
Check if any NAs to clean:
{r NA}
anyNA(gssCatPro2012$childs)
completeFun <- function(data, desiredCols) {
completeVec <- complete.cases(data[, desiredCols])
return(data[completeVec, ])
}
gssCatPro2012=completeFun(gssCatPro2012,"childs")
anyNA(gssCatPro2012$childs)
Calculate means for both religions:
{r metrics}
gssCatPro2012 %>%
group_by(relig) %>%
summarise(mean_kids=mean(childs), med_kids=median(childs), sd_kids=sd(childs),n=n())
Inference
We are going to create a new variable in order to overwrite the content of the old variable relig:
{create new variable}
gssCatPro2012new <- gssCatPro2012 %>%
mutate(relignew = ifelse(relig == "Catholic", "Catholic", "Protestant"))
Now, we can run the inference function and see whether we can reject the 0 Hypothesis or not:
{hypothesis test}
inference(y = childs, x = relignew, data = gssCatPro2012new, statistic = "mean", type = "ht", null = 0, alternative = "twosided", method = "theoretical")
Modify the chunk names to use underscores instead of spaces and make sure each chunk begins with a leading "r".
For example:
{r create_new_variable}
instead of:
{create new variable}

Resources