After some R computations I obtained a matrix that looks like that:
matrix <- cbind(c(00,01,02),c("some text","random stuff","special characters'"), c("0.12%","\\cellcolor{red!25}3.67%","1.61%"))
I am trying to export it to latex as follow:
file.name <- "file.name"
file.caption <- "file.caption"
print(xtable(matrix, align = c("l","r","r","r"),
label = paste("tab:", file.name, sep = "", collapse = NULL),
caption = file.caption),
type = "latex",
size="\\normalsize",
caption.placement = "top",
# file = paste("graphs/", file.name, ".tex", sep = "", collapse = NULL),
floating = FALSE,
tabular.environment = "longtable",
sanitize.text.function = function(x) x)
If I do not sanitize it, the pdf displays "\cellcolor{red!25}" (and obviously, I would prefer to have the cell colored). If I sanitize I can not typset the file.tex because of the "%".
I tried sanitize.text.function = function(x) x and sanitize.text.function = identity... without success.
Any idea?
Related
I've been trying to automate the results of some df table in latex using the glue and stargazer packages, but I haven't had any results (what I want is for the meaning "^{*}" to appear next to each value as it is in the table) to use then RMarkdown.
What I want to get:
My current ugly and error-prone fix:
library(dplyr)
library(glue)
library(stargazer)
X1 = c(4.70e1, 4.72e1, 4.76e1, 2.73e20)
X2 = c(4.67e1, 4.69e1, 4.77e1, 2.05e20)
tab.out = data.frame(X1, X2)
tab.out$max<-apply(tab.out, 1, max)
one = "1"
n.tab = tab.out %>%
mutate(test1 = if_else(tab.out$X2 < tab.out$max,
glue("\\textsuperscript{*} is $<<one>>$.", .open = "<<", .close = ">>"), #It doesn't work with ^{*}
glue("")))
Note: one was just to test the collapse because I tried glue_data as well as glue_collapse and it didn't work.
On the other hand, assuming the collapse works, how would I do to debug the latex code right? Because I tried with stargazer, xtable and textreg but in each of the functions it doesn't recognize "\, }, ^{*}".
n.tab = n.tab[c(1,2,4)]
stargazer(n.tab, summary = F, header = F)
What I got ?
I achieved this using the paste0 function as mentioned here and on the recommendation of #stefan but now I would like to automate the same function for n-columns
library(dplyr)
col.nam = c("AIC(n)", "HQ(n)", "SC(n)", "FPE(n)")
tab.out = data.frame(col.nam, X1, X2)
n.tab = tab.out %>%
mutate(test1 = if_else(tab.out$X1 < tab.out$X2,
paste0(X1,"$^{*}$"),
paste0(X1)),
test2 = if_else(tab.out$X2 < tab.out$X1,
paste0(X2,"\\textsuperscript{*}"),
paste0(X2)))%>%
select(col.nam, test1, test2)
colnames(n.tab) = c("Parámetros", "Lag 1", "Lag 2")
print(xtable::xtable(n.tab,
header = F,
caption = "asdasdasdasd",
label="table:tb1",
caption.placement = "top",
align="llcc"),
hline.after = c(-1,0),
include.rownames=FALSE,
include.colnames = TRUE,
add.to.row = list(pos = list(nrow(n.tab)),
command = paste("\\hline \n",
"\\multicolumn{3}{l}{\\footnotesize{$^{*}$Indica el orden de retraso seleccionado}} \\\\",
"\\multicolumn{3}{l}{\\footnotesize{\\textit{Elaboración: Los autores}}}",
sep = "")), comment=FALSE,
sanitize.text.function = function(x){x})
I have 3 dataframes say df1, df2, df3 and I want to send it in an email as 3 separate tables with some space between them.
I am able to currently send 1 dataframe as table with below code
library("mailR")
df1 <- read.csv('Adhoc/temp.csv')
final1 <- print(xtable(df1,caption = "Report"), type = "html", include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes","border=1"))
date_of_report<- Sys.Date() - 1
send.mail(from = "no-reply#abc.com",
to = c('xyz.pqr#abc.com'
),
subject = paste('Report', date_of_report, sep=' '),
body = final1,
html = TRUE,
smtp = list(host.name = "aspmx.l.google.com", port = 25),
authenticate = FALSE,
send = TRUE,
debug=TRUE)
I wanted some help so that I can send all the dataframes in one email itself. Currently I send 3 such emails.
Suggested untested Solution: paste multiple pre-formatted tables:
final1 <- print(xtable(df1,caption = "Report"), type = "html", include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes","border=1"))
final2 <- print(xtable(df2,caption = "Report2"), type = "html", include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes","border=1"))
final3 <- print(xtable(df3,caption = "Report3"), type = "html", include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes","border=1"))
final <- paste(final1, final2, final3, sep="\n")
date_of_report<- Sys.Date() - 1
send.mail(from = "no-reply#abc.com",
to = c('xyz.pqr#abc.com'
),
subject = paste('Report', date_of_report, sep=' '),
body = final,
html = TRUE,
smtp = list(host.name = "aspmx.l.google.com", port = 25),
authenticate = FALSE,
send = TRUE,
debug=TRUE)
I think it makes a lot of sense to define a function, here. And then there are a couple of things I would change up for future extensibility.
library(xtable) # This is required for the xtable function and print method
library(mailR)
# Read the data.frames into a list. This makes it easier to add/remove tables later
dfs <- list(
`Report 1` = data.frame(letter = LETTERS[seq_len(5L)],
number = seq_len(5L),
stringsAsFactors = FALSE
),
`Report 2` = data.frame(letter = letters[6L + seq_len(5L)],
number = 6L + seq_len(5L),
stringsAsFactors = FALSE
),
`Report 3` = data.frame(letter = LETTERS[20L:16L],
number = 20L:16L,
stringsAsFactors = FALSE)
)
Now we need to define the function that will format one of our tables. I'm just calling it make_xtable, and I'm giving it two arguments, the first is a data.frame, and the second is a string that will be used as the caption.
make_xtable <- function(df, caption) {
print(
xtable(df, caption = caption),
type = "html",
include.rownames = FALSE,
caption.placement = getOption("xtable.caption.placement", "top"),
html.table.attributes = getOption("xtable.html.table.attributes", "border=1"),
print.results = FALSE # This suppresses the results from printing to the console
)
}
So far we've loaded in our data, and we've defined a process for creating the tables from a given data.frame and caption string, but we still need to actually run each of our tables through the process. Here is where putting our data.frames into a list will come in handy. The family of apply functions will help us run the function on every element of our list, and then paste0 will let us combine the resulting character vector into a character object of length 1.
email_body <-
paste0(
mapply(
make_xtable,
dfs, # The list of data.frames containing our data
names(dfs) # Names attribute of the list of data.frames
),
collapse = "<br \>" # Concatenate using an HTML newline as a separator
)
Then use email_body as the argument body in the send.mail function.
I do multiple regression by group with a loop. I extract only 1 coefficient to which I attach stars according to this coef p-value.
Her is an example of my code:
for(i in 1:length(list)) {
# Equation
coef <- summary(lm(formula = var1 ~ var2 + var3 + var4,
data = subset(data.df, origin==var2[i])
),
)
# extraction
est <- coef$coefficients[2,1]
p <- coef$coefficients[2,4]
# Define notions for significance levels; spacing is important.
mystars <- ifelse(p < .001, "***",
ifelse(p < .01 , "** ",
ifelse(p < .05 , "* ",
" ")))
# past stars after estimate - put it in the matrix
est.mat[1,i] <- paste(sprintf('%.2f',est), mystars, sep = "", collapse = NULL)
# drop useless objects
rm(coef, est, t, p)
}
This works perfectly. Once done, I transfer my matrix est.mat into latex as follow:
print(xtable(est.mat, align = c("l","r","r","r","r","r","r"),
label = paste("tab:", file.name, sep = "", collapse = NULL),
caption = file.caption),
type = "latex",
size="\\normalsize",
caption.placement = "top",
file = paste("graphs/", file.name, ".tex", sep = "", collapse = NULL)
)
It works perfectly as well. The only problem is that, once printed in PDF the empty space after the stars defined in "mystar" are considered "un-existant" and therefore the coefficient numbers are not aligned, as illustrated below.
My question is then: How can I protect this space in "mystar" ?
One way to do this is to use "phantom" stars, which take up the same space as a star, but display nothing. I believe this modification of your code will do it:
mystars <- ifelse(p < .001, "***",
ifelse(p < .01 , "**\\phantom{*}",
ifelse(p < .05 , "*\\phantom{**}",
"\\phantom{***}")))
This will always leave space for three stars, so you might want to make it a little fancier by looking at the whole column first, and choosing how many phantom stars to add based on the most stars in the column. I'll leave that to you.
Edited to add: As described in Using xtable with R and Latex, math mode in column names?, print.xtable will escape the LaTeX macro, so it will display in the resulting PDF. But you can tell it not to, using argument sanitize.text.function:
print(xtable(est.mat, align = c("l","r","r","r","r","r","r"),
label = paste("tab:", file.name, sep = "", collapse = NULL),
caption = file.caption),
type = "latex",
size="\\normalsize",
caption.placement = "top",
file = paste("graphs/", file.name, ".tex", sep = "", collapse = NULL),
sanitize.text.function = function(x) x
)
This assumes that all of the table entries are legal LaTeX. If they are not, you may need a more complicated sanitization.
I am using the RAM package.
The function I use is very simple for diversity index, adding up a column in my metadata ;
outname <-OTU.diversity(data=OTUtables, meta=metatables)
(Arguments: data a list of OTU tables.
meta the metadata to append the outputs)
I am looping it but I get this error:
please provide otu tables as list; see ?RAM.input.formatting
So I go to that help menu and read this:
one data set:
data=list(data=otu)
multiple data sets:
data=list(data1=otu1, data2=otu2, data3=otu3)
here is my code:
i <- 1
for(i in 1:nrow(metadataMasterTax)){
temp <- read.table(paste(metadataMasterTax$DataAnFilePath[i], metadataMasterTax$meta[i], sep = ""),
sep = "\t", header = TRUE, dec = ".", comment.char = "", quote = "", stringsAsFactors = TRUE,
as.is = TRUE)
temp2 <- temp
temp2$row.names <- NULL #to unactivate numbers generated in the margin
trans <- read.table(paste(metadataMasterTax$taxPath[i], metadataMasterTax$taxName[i], sep = ""),
sep = "\t", header = TRUE, dec = ".", comment.char = "", quote = "", stringsAsFactors = TRUE,
as.is = TRUE, check.names = FALSE)
trans2 <- trans
trans2$row.names <- NULL #to unactivate numbers generated in the margin
data=list(data=trans2[i])
temp2[i] <- OTU.diversity(data=trans2[i], meta=temp2[i])
# Error in OTU.diversity(trans2, temp2) :
# please provide otu tables as list; see ?RAM.input.formatting
# is.list(trans2)
# [1] TRUE
# is.list(data)
# [1] TRUE
temp$taxonomy <- temp2$taxonomy
write.table(temp, file=paste(pathDataAn, "diversityDir/", metadataMasterTax$ShortName[i], ".meta.div.tsv", sep = ""),
append = FALSE,
sep = "\t",
row.names = FALSE)
}
Can anyone help me please....
thanks a lot
Because the main problem appears to be getting the OTU.diversity function to work, I focus on this issue. The code snippet below runs OTU.diversity without any problems, using the Google sheets data provided by OP.
library(gsheet)
library(RAM)
for (i in 1:2) {
# Meta data
temp <- as.data.frame(gsheet2tbl("https://drive.google.com/open?id=1hF47MbYZ1MG6RzGW-fF6tbMT3z4AxbGN5sAOxL4E8xM"))
temp$row.names <- NULL
# OTU
trans <- as.data.frame(gsheet2tbl("https://drive.google.com/open?id=1gOaEjDcs58T8v1GA-OKhnUsyRDU8Jxt2lQZuPWo6XWU"))
trans$row.names <- NULL
rownames(temp) <- colnames(trans)[-ncol(trans)]
temp2 <- OTU.diversity(data = list(data = trans), meta = temp)
write.table(temp2,
file = paste0("file", i, ".meta.div.tsv"), # replace
append = FALSE,
sep = "\t",
row.names = FALSE)
}
Replace for (i in 1:2) with for(i in 1:nrow(metadataMasterTax)), as.data.frame(gsheet2tbl(...)) with read.table(...), and the file argument in write.table with the appropriate string.
Following is the function to get help on R functions. See below:
help_console <-
function (topic, format = c("text", "html", "latex", "Rd"), lines = NULL,
before = NULL, after = NULL)
{
format = match.arg(format)
if (!is.character(topic))
topic <- deparse(substitute(topic))
helpfile = utils:::.getHelpFile(help(topic))
hs <- capture.output(switch(format, text = tools:::Rd2txt(helpfile),
html = tools:::Rd2HTML(helpfile), latex = tools:::Rd2latex(helpfile),
Rd = tools:::prepare_Rd(helpfile)))
if (!is.null(lines))
hs <- hs[lines]
hs <- c(before, hs, after)
cat(hs, sep = "\n")
invisible(hs)
}
help_console(topic="lm", format = "text", lines=1)
Fitting Linear Models
Now I want to redefine this function to get help on R function from given package. Here is my MWE
help_console2 <-
function (topic, pkg, format = c("text", "html", "latex", "Rd"), lines = NULL,
before = NULL, after = NULL)
{
format = match.arg(format)
if (!is.character(topic))
topic <- deparse(substitute(topic))
if (!is.character(pkg))
topic <- deparse(substitute(pkg))
helpfile = utils:::.getHelpFile(help(pkg, topic))
hs <- capture.output(switch(format, text = tools:::Rd2txt(helpfile),
html = tools:::Rd2HTML(helpfile), latex = tools:::Rd2latex(helpfile),
Rd = tools:::prepare_Rd(helpfile)))
if (!is.null(lines))
hs <- hs[lines]
hs <- c(before, hs, after)
cat(hs, sep = "\n")
invisible(hs)
}
help_console2(topic="lm", pkg="stats", format = "text", lines=1)
Error in find.package(if (is.null(package)) loadedNamespaces() else package, :
there is no package called ‘topic’
This function is throwing error.
You have the wrong argument order and need to outsmart non-standard evaluation:
help_console2 <-
function (topic, pkg, format = c("text", "html", "latex", "Rd"), lines = NULL,
before = NULL, after = NULL)
{
format = match.arg(format)
if (!is.character(topic))
topic <- deparse(substitute(topic))
if (!is.character(pkg))
topic <- deparse(substitute(pkg))
helpfile = utils:::.getHelpFile(do.call(help, list(topic=topic, package=pkg)))
hs <- capture.output(switch(format, text = tools:::Rd2txt(helpfile),
html = tools:::Rd2HTML(helpfile), latex = tools:::Rd2latex(helpfile),
Rd = tools:::prepare_Rd(helpfile)))
if (!is.null(lines))
hs <- hs[lines]
hs <- c(before, hs, after)
cat(hs, sep = "\n")
invisible(hs)
}
help_console2(topic="lm", pkg="stats", format = "text", lines=1)
#Fitting Linear Models