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.
Related
I have recently become familiar with the rstatix package. Below is an example code using functions from this package.
library(tidyverse)
library(rstatix)
library(ggpubr)
set.seed(1111)
n=100
df = tibble(
x1 = rnorm(n, 0, 1.1),
x2 = rnorm(n, 0.2, .1),
x3 = rnorm(n, -.2, .2),
x4 = rnorm(n, 0, 2),
) %>% pivot_longer(x1:x4)
df
pwc = df %>%
pairwise_t_test(value~name, paired = TRUE,
p.adjust.method = "bonferroni") %>%
add_xy_position(x = "name") %>%
mutate(name=group1,
lab = paste(p, " - ", p.adj.signif))
res.test = df %>% anova_test(value~name)
df %>% ggplot(aes(name, value))+
geom_boxplot(alpha=0.6)+
stat_pvalue_manual(pwc, step.increase=0.05, label = "lab")+
labs(title = get_test_label(res.test, detailed = TRUE),
subtitle = get_pwc_label(pwc))
However, I noticed that functions like get_test_label or get_pwc_label do not return text, but commands to prepare the text.
For example, calling get_test_label(res.test, detailed = TRUE) gives this:
paste("Anova, ", italic("F"), "(3,396)", " = ",
"5.26, ", italic("p"), " = ", "0.001",
paste(", ", eta["g"]^2, " = ", 0.04), "")
In turn, calling get_pwc_label(pwc) will result in:
paste("pwc: ", bold(c(t_test = "T test")), "; p.adjust: ",
bold("Bonferroni"))
Now my question, basically two questions.
What could be the reason these functions do not return text but commands?
How to make your own function that returns similar commands.
R's graphics devices use the syntax defined in ?plotmath to distinguish between literal and formatted text. A basic feature of this syntax is that strings define literal text while functions define operations on text, such as juxtaposition and formatting (changing fonts, adding diacritics, getting whitespace right in mathematical formulae, etc.). What you are seeing, then, are unevaluated compositions of functions and strings defining formatted text. These are typically called plotmath expressions.
I could provide you with a basic example showing how different expressions translate to graphical output, but there is an excellent demo built into R: just run demo("plotmath") in an interactive R session and follow the prompts.
Functions that you can use to create expressions like the ones you are seeing include quote, substitute, bquote, and str2lang. You would probably use one of these to format, e.g., a plot title. Here is how I would use each function to generate the expression paste("Michaelis constant: ", italic("K")["M"], " = ", 0.015).
quote(
paste("Michaelis constant: ", italic("K")["M"], " = ", 0.015)
)
substitute(
paste("Michaelis constant: ", italic(sym)[sub], " = ", val),
list(sym = "K", sub = "M", val = 0.015)
)
sym <- "K"
sub <- "M"
val <- 0.015
bquote(
paste("Michaelis constant: ", italic(.(sym))[.(sub)], " = ", .(val))
)
str2lang(
'paste("Michaelis constant: ", italic("K")["M"], " = ", 0.015)'
)
The differences are subtle, so it could be worth browsing each function's help page and running the examples there.
Functions that you can use to create expression vectors include expression and str2expression. You would use one of these to format one or more labels at once, e.g., when defining axis tick labels. Here is how I would use each function to format labels for ticks at increasing powers of 10:
expression(10^0, 10^1, 10^2, 10^3, 10^4, 10^5)
str2expression(paste0(10, "^", 0:5))
Finally, here is a fun plot putting everything together:
plot.new()
plot.window(c(0, 1), c(1, 100000), log = "y")
box()
title(main = quote(paste("Michaelis constant: ", italic("K")["M"], " = ", 0.015)))
axis(side = 2, at = 10^(0:5), labels = str2expression(paste0(10, "^", 0:5)), las = 1)
text(x = seq(0, 1, by = 0.2), y = 10^(0:5), labels = str2expression(sprintf('%s("%s")', c("plain", "bold", "italic", "bolditalic", "symbol", "underline"), month.abb[1:6])))
For even more examples, take a look at ?plotmath.
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 am wanting to apply different color shading to a table based on different value sets. I am creating this table in Rmarkdown using kableExtra. I want values between 0 and <.10 to be left alone. Values >=.10 and <.20 to be shaded yellow. and values >=.20 to be shaded red.
df
name category 1 categry 2 category a category b
ab .01 .45 .19 .09
410 .12 .01 .05 .66
NW 5th .25 .22 .01 .16
This is what I have been making my existing table with:
library(knitr)
library(dplyr)
kable(df, caption = "warning values", digits = 2, format = "latex",
booktabs = T)%>%
kable_styling(latex_options = c("striped"))%>%
landscape()%>%
row_spec(0, angle = 45)
I'm not sure how to use the mutate and cel_spec functions to apply to the entire table. The table columns and row names change dynamically with every report fyi.
EDIT: Martin's answer works great. Until I tried to clean up my numbers. My actual input file has more digits, like Martin's answer. It also has file and row names that include an underscore. (That caused issues when using this answer, but I found a workaround.)
#replace any "_" with escaped "\\_" for magrittR/latex compatability
names(df) <- gsub(x = names(df), pattern = "\\_", replacement =
"\\\\_")
df$name <- gsub('\\_', '\\\\_', df$name)
#format numbers
df <- format(df, digits=0, nsmall=3, scientific = FALSE)
The replacement works fine, its the number formatting that breaks the answer. Everything still executes just fine, but I lose the colorized table.
Thoughts?
Here is way to do this. Notice that I used the compund assignment operator from magrittr.
---
title: test
output: pdf_document
---
```{r, echo = F, warning = F, message = F}
library(knitr)
library(dplyr)
library(kableExtra)
library(magrittr)
df <- data.frame(A = runif(4, 0, 1), B = runif(4, 0, 1), row.names = letters[1:4])
paint <- function(x) { # our painting function
ifelse(x < 0.1, "white", ifelse(x < 0.2, "yellow", "red"))
}
df %<>%. # compound assignment operator
mutate_if(is.numeric, function(x) { # conditional mutation, if the column type is numeric
cell_spec(x, background = paint(x), format = "latex")
})
kable(df, caption = "warning values", digits = 2, format = "latex",
booktabs = T, escape = F) %>%
landscape()%>%
row_spec(0, angle = 45)
```
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?
I'm using textplot() from the gplots package to write definitions that are then displayed next to other plots using par(mfrow=c(3,2)).
I want to change a single word in the character string to bold face (Usually the word being defined). Is there a metacharacter that will let me do this inside of the " "? Or another solution for picking out words and giving them bold attributes without assigning that to the whole string?
It's similar to this question, but I wasn't able to use the same technique in textplot():
text() R-function - how to change the font of a single word?
text(0.5,0.5, expression(paste(bold("bold")," not bold")))
Here's my code without a bolded term. Pretend "Definition" is desired to be bold face:
blurb<-strwrap("Definition: This is my text blurb",
width=60)
textplot(blurb, halign="left", valign="top", cex = 1, family="serif")
I've been playing with breaking the string apart and searching for a function that will assign bold face to the "Definition" portion, font=2, and then pasting the string back together, but I'm stumped. I can't find a function to use:
blurb1<-"Definition" ##How to change to bold face??
blurb2<-"This is my text blurb"
blurb<-paste0(blurb1,blurb2)
EDIT: The predominant barrier to using other solutions is that for my page layout, text() isn't entirely viable. I'm hoping to find a solution to editing the string either inside of textplot() or in a way that can be passed to textplot().
I'm creating something of a "Report Card" that will plot user data and provide a paragraph of explanation beside the plot. Different values would trigger a different textplot(). I like textplot() because it's easily placed with par(mfrow=c(4,2)), carving out a seperate space without overlapping other plots. I just can't seem to work text() in without a lot of play in the positioning.
You need to use bquote().
Here is a simple function which takes a text string and splits it and returns the appropriate expression for your bold plotting needs. I am sure you can adapt this as you see fit.
# Pass the function a string and a character to split on
# The splitting is greedy (i.e. it will split on all matches so make sure you are splitting on a unqiue character such as ":" in your example)
tsplit <- function( string , split ){
require( stringr )
blurb <- paste( string )
blurbs <- strsplit( blurb , paste(split) )
annot <- bquote( paste( bold( .( blurbs[[1]][1] ) ) , .(split) , .(blurbs[[1]][2]) , sep = "" ) )
return( annot )
}
#And the function in action...
j <- tsplit( "Define: This is my blurb" , ":" )
textplot( paste( " " ) ) #Get new plot
text(0.5 , 0.5 , j ) #paste the text
I hope this helps. The function assumes that there is only one unique character to split the string on and that you want the first word in bold and the rest of the string in normal format.
Cheers
EDIT
Sorry I realised in the question you said you couldn't use text for placement because it is problematic. A quick check of the available methods of textplot (showMethods(textplot)) and the source of the apporopriate method for plotting characters (getAnywhere(textplot.character)) shows that textplot does infact use a call to text to annotate the plot with your text object. Most of the code is concerned with taking out the heavy lifting of where you want the text. You can make a couple of simple adjustments to textplot.character() to create a custom function to do what you wanted. You can copy and paste this into R and it should work as per the example at the bottom.
tplot.cust <- function ( object , split , halign = c("center", "left", "right"), valign = c("center",
"top", "bottom"), cex, fixed.width = TRUE, cspace = 1, lspace = 1,
mar = c(0, 0, 3, 0) + 0.1, tab.width = 8, ...)
{
# extra code to split text according to 'split' argument and make text before the split bold.
require(stringr)
blurb <- paste( object )
blurbs <- strsplit( blurb , paste(split) )
annot <- bquote( paste( bold( .( blurbs[[1]][1] ) ) , .(split) , .(blurbs[[1]][2]) , sep = "" ) )
object <- paste(object, collapse = "\n", sep = "")
object <- gplots:::replaceTabs(object, width = tab.width) #you need to add gplots::: to this line because replaceTabs is a function that is not exported from the gplots namespace
halign = match.arg(halign)
valign = match.arg(valign)
plot.new()
opar <- par()[c("mar", "xpd", "cex", "family")]
on.exit(par(opar))
par(mar = mar, xpd = FALSE)
if (fixed.width)
par(family = "mono")
plot.window(xlim = c(0, 1), ylim = c(0, 1), log = "", asp = NA)
slist <- unlist(lapply(object, function(x) strsplit(x, "\n")))
slist <- lapply(slist, function(x) unlist(strsplit(x, "")))
slen <- sapply(slist, length)
slines <- length(slist)
if (missing(cex)) {
lastloop <- FALSE
cex <- 1
}
else lastloop <- TRUE
for (i in 1:20) {
oldcex <- cex
cwidth <- max(sapply(unlist(slist), strwidth, cex = cex)) *
cspace
cheight <- max(sapply(unlist(slist), strheight, cex = cex)) *
(lspace + 0.5)
width <- strwidth(object, cex = cex)
height <- strheight(object, cex = cex)
if (lastloop)
break
cex <- cex/max(width, height)
if (abs(oldcex - cex) < 0.001) {
lastloop <- TRUE
}
}
if (halign == "left")
xpos <- 0
else if (halign == "center")
xpos <- 0 + (1 - width)/2
else xpos <- 0 + (1 - width)
if (valign == "top")
ypos <- 1
else if (valign == "center")
ypos <- 1 - (1 - height)/2
else ypos <- 1 - (1 - height)
text(x = xpos, y = ypos, labels = annot , adj = c(0, 1),
cex = cex, ...) #add the newly created annot expression here
par(opar)
invisible(cex)
}
We can then use tplot.cust like so...
blurb <- "Define: This is my blurb"
tplot.cust(blurb, ":" , halign="left", valign="top", cex = 1, family="serif")
Hopefully this is what you want??