need your help for a little problem, I'm using R Sweave to generate dynamic report, and the code is :
industryTable<-data.frame("Industry" = INDUSTRY.DATA[1:15,]$industryname,
"Freq" = INDUSTRY.DATA[1:15,]$Freq,
"Perc" = INDUSTRY.DATA[1:15,]$Perc,
"Industry" = INDUSTRY.DATA[16:30,]$industryname,
"Freq" = INDUSTRY.DATA[16:30,]$Freq,
"Perc" = INDUSTRY.DATA[16:30,]$Perc)
names(industryTable)<-c("Industry", "Freq","Perc","Industry", "Freq","Perc")
add.to.row <- list(pos = list(nrow(industryTable)), command = NULL)
comm <- paste0("\\hline \n \\multicolumn{",dim(industryTable)[2],"}{l}",
"{\\scriptsize{Matching-Method:Pscore, Base-Year:0,Matching-Interval:0.9-1.10,Log:T,Trim:F}} \n")
add.to.row$command <-comm
print(xtable(industryTable,caption = "Distribution of Privatization Across Manufacturing", label = "table:industry",align = c("c","p{4.5cm}","c","c","|p{4.5cm}","c","c"),digits = c(0,0,0,2,0,0,2)),caption.placement="top", include.rownames = FALSE,add.to.row = add.to.row,hline.after=c(-1, 0))
I need to put and note at the bottom of the table, what I' currently doing is using the add.to.row
add.to.row <- list(pos = list(nrow(industryTable)), command = NULL)
comm <- paste0("\\hline \n \\multicolumn{",dim(industryTable)[2],"}{l}",
"{\\scriptsize{Matching-Method:Pscore, Base-Year:0,Matching-Interval:0.9-1.10,Log:T,Trim:F}} \n")
it works fine, however, I have 7 tables in each 32 versions of data combination need exactly the same note format like the one here, the table content and format are different, but for the 7 tables of a given data combination, the table note is exactly the same,which is "Matching-Method:Pscore, Base-Year:0,Matching-Interval:0.9-1.10,Log:T,Trim:F", is there a convenient way of achieving this without of copy paste, cause it's tedious and dangerous.
Why not just create a function?
make_table <- function(industryTable) {
l = list(pos = list(nrow(industryTable)), command = NULL)
comm <- paste0("\\hline \n \\multicolumn{",dim(industryTable)[2],"}{l}",
"{\\scriptsize{Matching-Method:Pscore, Base-Year:0,Matching-Interval:0.9-1.10,Log:T,Trim:F}} \n")
l$command <-comm
xtable(industryTable,
caption = "Distribution of Privatization Across Manufacturing",
label = "table:industry",align = c("c","p{4.5cm}","c","c","|p{4.5cm}","c","c"),digits = c(0,0,0,2,0,0,2)),
caption.placement="top",
include.rownames = FALSE,
add.to.row = l, hline.after=c(-1, 0)
}
So
print(make_table(industryTable))
Related
I use kableExtra for producing several tables and I'd like to use a function instead of repeating all the code. But with my limited knowledge of R, I am not able to.
Below is a simplified example (so simple it doesn't show why I want to collapse all the code into a function). First code without any added convenience function.
library(kableExtra)
library(glue)
library(tidyverse)
data <- mtcars[1:10, ] |> select(mpg, cyl, am, carb)
# KableExtra, without added convenience function
kbl(data, booktabs = T, linesep = "", digits = 2,
caption = "Ordinary kbl()") |>
add_header_above(c(" ", "Engine" = 2 , "Other" = 2))
)
Trying to make the same, now with a function where different calls can use different arguments for caption and added headers. The caption part works fine, it's the added headers I'm struggling with.
# Call kableExtra with a function
print_kable <- function(df, caption, header) {
kbl(data, booktabs = T, linesep = "", digits = 2,
# Caption works fine
caption = caption) |>
# I'm unable to develop code that uses a string argument here
add_header_above(c(header)) # 1 col instead of 5
# add_header_above(c({header})) # Same here
# add_header_above(c({{header}})) # and here
# add_header_above(c("{header}")) # and here
# add_header_above(c("{{header}}")) # and here
# add_header_above(c(glue({header}))) # and here
# add_header_above(c(paste(header))) # and here
}
Kable should print with the code below
print_kable(mtcars, caption = "kbl() called with a function",
header = ' " ", "Engine" = 2 , "Other" = 2 ')
Here is a related question:
How to evaluate a glue expression in a nested function?
Placing the function c() in the function call rather than in the function itself works fine. Is this what you're looking for?
print_kable <- function(df, caption, header) {
kbl(data, booktabs = T, linesep = "", digits = 2,
caption = caption) |>
add_header_above(header)
}
print_kable(mtcars, caption = "kbl() called with a function",
header = c(" ", "Engine" = 2 , "Other" = 2))
I want to print stargazer table using kable.
When I am running the code in markdown, I get the stargazer table but with multiple lines with the sign | between those lines before the table.
I also get a warning message at the beginning:
Warning in kable_markdown(x = structure(c("", "<table style=\"text-
align:center\"><caption><strong>Crude models: OR for mRS at discharge >3
with 95% CI</strong></caption>", : The table should have a header (column
names)
my output looks like this:
This is my code for the table (with some changes):
mod.example1 <- glm(bad_outcome~x1+x2+x3+x4, family = "binomial", data = dat0)
mod.example2 <- glm(bad_outcome~x1+x2+x3+x4, family = "binomial", data = dat1)
CI.list <- list(exp(confint(mod.example1)),exp(confint(mod.example2)))
my.stg <- stargazer(
title = "my models: OR for bad outcome",
mod.example1
mod.example2,
type="html",
digits = 2,
t.auto = FALSE,
model.numbers = F,
keep.stat = "n",
report = c("vc*sp"),
omit = "Constant",
star.cutoffs = c(0.05,0.01,0.001),
no.space = FALSE,
single.row = F,
dep.var.labels = c("***bad outcome***"),
covariate.labels = c("x1","x2","x3","x4"),
column.labels = c("-**dat0**-", "-**dat1**-"),
ci= T,
ci.custom = CI.list,
apply.coef=exp)
and in a new chunk:
kable(my.stg)
The table is printed but only after the multiple lines / rectangles.
I also ran the code from other computers and then the problem did not happen.
What could cause this?
Update : after a lot of research, i recognized that the problem occurred only after updating my R version from 3.4.0 to 3.4.1.
After updating to the new version, it also made me update knitr package from 1.16 to 1.17 and only that version gives the mentioned error.
So, i downgraded knitr from 1.17 to 1.16 and that solved the problem.
You do not need to use kable() function for generating stargrazer tables in markdown. Just add {r results='asis'} to the beginning of the chunk which includes stargrazer().
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
```
I need help determining how I can use the input for the function below as an input for another r file.
Hotel <- function(hotel) {
require(data.table)
dat <- read.csv("demo.csv", header = TRUE)
dat$Date <- as.Date(paste0(format(strptime(as.character(dat$Date),
"%m/%d/%y"),
"%Y/%m"),"/1"))
library(data.table)
table <- setDT(dat)[, list(Revenue = sum(Revenues),
Hours = sum(Hours),
Index = mean(Index)),
by = list(Hotel, Date)]
answer <- na.omit(table[table$Hotel == hotel, ])
if (nrow(answer) == 0) {
stop("invalid hotel")
}
return(answer)
}
I would input Hotel("Hotel Name")
Here's the other R file using the Hotel name I inputted above.
#Reads the dataframe from the Hotel Function
star <- (Hotel("Hotel Name"))
#Calculates the Revpolu and Index
Revpolu <- star$Revenue / star$Hours
Index <- star$Index
png(filename = "~/Desktop/result.png", width = 480, height= 480)
plot(Index, Revpolu, main = "Hotel Name", col = "green", pch = 20)
testing <- cor.test(Index, Revpolu)
write.table(testing[["p.value"]], file = "output.csv", sep = ";", row.names = FALSE, col.names = FALSE)
dev.off()
I would like for this part to become automated instead of having to copy and paste from the first file an input and then storing it as a variable. Or if it's easier, then make all of this just one function.
Also instead of having to input one Hotel name for the function. Is it possible to make the first file read all the hotel names if they are identified as row names in the .csv file and have that input read in the second file?
Since your example is not reproducible and your code has some bugs (using the column "Rooms" which is not produced by your function), I can't give you a tested answer, but here's how you can structure your code to produce the statistics you want for all hotels without having to copy and paste hotel names:
library(data.table)
# Use fread instead of read.csv, it's faster
dat <- fread("demo.csv", header = TRUE)
dat[, Date := as.Date(paste0(format(strptime(as.character(Date), "%m/%d/%y"), "%Y/%m"),"/1"))
table <- dat[, list(
Revenue = sum(Revenues),
Hours = sum(Hours),
Index = mean(Index)
), by = list(Hotel, Date)]
# You might want to consider using na.rm=TRUE in cor.test instead of
# using na.omit, but I kept it here to keep the result similar.
answer <- na.omit(table)
# Calculate Revpolu inside the data.table
table[, Revpolu := Revenue / Hours]
# You can compute a p-value for all hotels using a group by
testing <- table[, list(p.value = cor.test(Index, Revpolu)[["p.value"]]), by=Hotel]
write.table(testing, file = "output.csv", sep = ";", row.names = FALSE, col.names = FALSE)
# You can get individual plots for each hotel with a for loop
hotels <- unique(table$Hotel)
for (h in hotels) {
png(filename = "~/Desktop/result.png", width = 480, height= 480)
plot(table[Hotel == h, Index], table[Hotel == h, Revpolu], main = h, col = "green", pch = 20)
dev.off()
}
I am using knitr and xtable to automate my reporting procedure. I want to highlight a few rows of a table and have a horizontal line right above each row highlighted. The .Rnw file I am using reads as below:
\usepackage{colortbl, xcolor}
\usepackage{longtable}
\begin{document}
<<do_table, results = "asis">>=
library(xtable)
mydf <- data.frame(id = 1:10, var1 = rnorm(10), var2 = runif(10))
print(xtable(mydf), add.to.row = list(pos = list(0,2), command = rep("\\rowcolor[gray]{0.75}",2)),hline.after=c(0,2))
#
\end{document}
This works just fine, however, the table I am working with should be a longtable, if I adjust the last line of code to
print(xtable(mydf), add.to.row = list(pos = list(0,2), command = rep("\\rowcolor[gray]{0.75}",2)),hline.after=c(0,2),tabular.environment="longtable",floating=FALSE)
the output is quite ugly, and the rows are not highlighted as expected. Anyone might know an answer to this question?
thanks,
David
Sorry, slightly offtopic, but demonstrating a markdown-only solution for highlighting cells/rows easily:
> mydf <- data.frame(id = 1:10, var1 = rnorm(10), var2 = runif(10))
> library(pander)
> emphasize.strong.rows(c(1, 3))
> pander(mydf)
---------------------------
id var1 var2
----- ---------- ----------
**1** **0.7194** **0.6199**
2 0.8094 0.1392
**3** **-1.254** **0.5308**
4 0.4505 0.8235
5 -0.3779 0.7534
6 -0.3518 0.3055
7 1.759 0.5366
8 0.9822 0.9938
9 1.549 0.3589
10 -1.077 0.5153
---------------------------
That can be converted to LaTeX or pdf directly.
You are on the right track, but I am a bit confused: do you want the selected rows highlighted by hline and rowcolor? In my experience, rowcolor alone looks better, so I will assume that in my answer below (but you could easily use both, just append the \\hline command).
As a bonus, all code below assumes you use the LaTeX booktabs package, which gives correctly weighted rules (unlike hline). To be honest, I always work with booktabs, and I couldn't bother to adjust the code to use hline -- but if you prefer hline, replace all \toprule, \midrule and \bottomrule macros with \hline.
You seem to have missed that LaTeX longtables require a special header, and we need to supply that too as an element to the command vector of the add.to.row list (this may be the reason your typeset table looks bad).
longtable.xheader <-
paste("\\caption{Set your table caption.}",
"\\label{tab:setyourlabel}\\\\ ",
"\\toprule ",
attr(xtable(mydf), "names")[1],
paste(" &", attr(xtable(mydf), "names")[2:length(attr(xtable(mydf), "names"))], collapse = ""),
"\\\\\\midrule ",
"\\endfirsthead ",
paste0("\\multicolumn{", ncol(xtable(mydf)), "}{c}{{\\tablename\\ \\thetable{} -- continued from previous page}}\\\\ "),
"\\toprule ",
attr(xtable(mydf), "names")[1],
paste("&", attr(xtable(mydf), "names")[2:length(attr(xtable(mydf), "names"))], collapse = ""),
"\\\\\\midrule ",
"\\endhead ",
"\\midrule ",
paste0("\\multicolumn{", as.character(ncol(xtable(mydf))), "}{r}{{Continued on next page}}\\\\ "),
"\\bottomrule \\endfoot ",
"\\bottomrule \\endlastfoot ",
collapse = "")
With that taken care of, go ahead and print the xtable:
print(xtable(mydf),
floating = FALSE, % since longtable never floats
hline.after = NULL, % hline off since I use booktabs
add.to.row = list(pos = list(-1,
c(0, 2),
nrow(xtable(mydf))),
command = c(longtable.xheader,
"\\rowcolor[gray]{0.75}\n",
"%")), % comments out a spurious \hline by xtable
include.rownames = FALSE, % depends on your preference
include.colnames = FALSE, % depends on your preference
type = "latex",
tabular.environment = "longtable",
% xtable tries to escape TeX special chars, can be annoying sometimes
sanitize.text.function = function(x){x},
% not all dashes are meant to be math negative sign, set according to your data
math.style.negative = FALSE)
I hope my use of booktabs in the answer did not confuse you too much.
Keep knitting!
You might have more luck posting this on a latex forum. You should note that xcolor/longtable are not compatible: http://www.ukern.de/tex/xcolor.html.