Remove_Column from a kable table which will be output as latex/pdf - r-markdown

I am trying to remove two columns from the below table however when knitted as a pdf from markdown I get the below error. I am unsure if this just isn't possible or if there is a work around.
ERROR:
Error in remove_column(., 4:5) :
Removing columns was not implemented for latex kables yet
Calls: ... kable_classic -> kable_light -> kable_styling -> remove_column
Execution halted
OverCortTab <- bind_rows(AlexOverCortTab$table_body,OptOverCortTab$table_body)%>%
mutate(Predictor=str_replace(Predictor,"TAS_Tot","Alexithymia"),
Predictor=str_replace(Predictor,"OPT_Tot","Optimism"))%>%
mutate(Fit=str_replace(Fit,"95%","95\\\\%"),
Fit=str_replace(Fit,"R2","R$2$"),
Fit=lead(Fit,n=2))%>%
filter(Predictor !=""|Fit !="")%>%
kable(caption = "Table 1: Hair Cortisol and Personality",
booktabs=TRUE,
col.names = c("Predictor","$\\beta$","$\\beta$ 95\\% CI","$\\beta$","$\\beta$ 95\\% CI","sr2","sr2 95\\% CI","r","Fit"),
escape=FALSE) %>%
remove_column(4:5)%>%
kable_classic(font_size=12)%>%
footnote(general=c("A Significant $\\beta$-weight indicates the semi-partial correlation is also significant.","$\\beta$ represents unstandardised regression weights.","sr2 represents the semi-partial correlation squared.","Square brackets are used to enclose the lower and upper limits of the confidence interval.","* indicates p < .05", "** indicates p < .01"),escape=FALSE) %>%
group_rows("Alexithymia",1,2,hline_before=TRUE,hline_after=TRUE,underline=TRUE)%>%
group_rows("Optimism",3,4,hline_before=TRUE,hline_after=TRUE,underline=TRUE) ```

Instead of removing the column inside the kbl function, you could try removing it before.
This could work, by piping select:
OverCortTab <- bind_rows(AlexOverCortTab$table_body,OptOverCortTab$table_body)%>%
mutate(Predictor=str_replace(Predictor,"TAS_Tot","Alexithymia"),
Predictor=str_replace(Predictor,"OPT_Tot","Optimism"))%>%
mutate(Fit=str_replace(Fit,"95%","95\\\\%"),
Fit=str_replace(Fit,"R2","R$2$"),
Fit=lead(Fit,n=2))%>%
filter(Predictor !=""|Fit !="")%>%
select(-c(4:5))%>%
kable(caption = "Table 1: Hair Cortisol and Personality",
booktabs=TRUE,
col.names = c("Predictor","$\\beta$","$\\beta$ 95\\% CI","$\\beta$","$\\beta$ 95\\% CI","sr2","sr2 95\\% CI","r","Fit"),
escape=FALSE) %>%
kable_classic(font_size=12)%>%
footnote(general=c("A Significant $\\beta$-weight indicates the semi-partial correlation is also significant.","$\\beta$ represents unstandardised regression weights.","sr2 represents the semi-partial correlation squared.","Square brackets are used to enclose the lower and upper limits of the confidence interval.","* indicates p < .05", "** indicates p < .01"),escape=FALSE) %>%
group_rows("Alexithymia",1,2,hline_before=TRUE,hline_after=TRUE,underline=TRUE)%>%
group_rows("Optimism",3,4,hline_before=TRUE,hline_after=TRUE,underline=TRUE)

Related

How to knit out table codes into table in R markdown

I am a basic-level learner of R. I am having a problem knitting out tables with a code my professor designed for the students. The code for table designs is set as below. I put this in my R markdown as below.
```{r, results="hide", message=FALSE, warning = FALSE, error = FALSE}
## my style latex summary of regression
jhp_report <- function(...){
output <- capture.output(stargazer(..., omit.stat=c("f", "ser")))
# The first three lines are the ones we want to remove...
output <- output[4:length(output)]
# cat out the results - this is essentially just what stargazer does too
cat(paste(output, collapse = "\n"), "\n")
}
```
After this, I tried printing this out with knitr.
```{r, message=FALSE, warning = FALSE, error = FALSE}
set.seed(1973)
N <- 100
x <- runif(N, 6, 20)
D <- rbinom(N, 1, .5)
t <- 1 + 0.5*x - .4*D + rnorm(N)
df.lm <- data.frame(y = y, x =x, D =D)
df.lm$D <- factor(df.lm$D, labels = c('Male', 'Female'))
##REGRESSION
reg.parallel <- lm(y ~ x + D, data = df.lm)
jhp_report(reg.parallel, title = "Result", label = "tab:D", dep.var.labels = "$y$")
```
As a result, instead of a table, it keeps on showing only the pure codes. I would like to know how I have to set up R markdown for it to print out the table instead of the codes. This is how the result looks like when I knit it.
I expected that there must be some setup options to print the table out. But I couldn't find the right one. Also, my assignment for class requires students to use this code. I did find other options like knitr::kable but I would like to use the given code for this assignment.
Thank you in advance!

How to remove specific number of events in a tbl_regression (gtsummary package)

I'm using tbl_regression from the gtsummary package to show the results of cox proportional hazards models. Due to circumstances regarding sensitive personal information, I am not allowed to show strata with a number of observations less than 5. I can, however, still show the estimates, CIs etc. for those strata, but not how many persons have had the event if the number is less than 5. In these number of events strata with less than 5 observations, I would like to insert just a line to indicate this.
From what I have read, the modify_table_body function is perhaps the correct function to achieve this. However, I cannot manage to find out how to use it correctly. Is there any way to define that the regression table should not show N_event less than 5 but still show HRs, CIs, person years ect. for those given stratas?
Below is my preliminary code in which I thought maybe should be followed by "%>% modify_table_body()".
Thank you in advance for your help!
Best,
Mathilde
cox_cat_cns2 <- coxph(Surv(TTD_year, Dod_status) ~ Highest_Edu_Household + Diag_year + Age_household_mom_num + Age_household_dad_num + Country_origin_household, data = data_cox_cat_cns)
cox_cat_cns_adj_table <- tbl_regression(cox_cat_cns2,
label = c(Highest_Edu_Household ~ "Highest parental education",
Diag_year ~ "Year of diagnosis",
Age_household_mom_num ~ "Mother's age at diagnosis",
Age_household_dad_num ~ "Father's age at diagnosis",
Country_origin_household ~ "Parents' country of origin"),
exponentiate = TRUE) %>%
add_nevent(location = "level") %>%
bold_labels() %>%
italicize_levels() %>%
modify_table_styling(
columns = estimate,
rows = reference_row %in% TRUE,
missing_symbol = "Ref.") %>%
modify_footnote(everything() ~ NA, abbreviation = TRUE) %>%
modify_table_styling(
column = p.value,
hide = TRUE) %>%
modify_header(
label = "",
stat_nevent = "**Events (N)**",
exposure ~ "**Person years**")
You can 1. define a new function to "style" the number of events that collapses any counts less than 5 as "<5", then 2. use that function to style the column in the resulting table. Example below!
library(gtsummary)
#> #Uighur
library(survival)
library(dplyr)
style_number5 <- function(x, ...) {
ifelse(
x < 5,
paste0("<", style_number(5, ...)),
style_number(x, ...)
)
}
style_number5(4:6)
#> [1] "<5" "5" "6"
tbl <-
trial %>%
slice(1:45) %>%
coxph(Surv(ttdeath, death) ~ stage, data = .) %>%
tbl_regression(exponentiate = TRUE) %>%
add_nevent(location = "level") %>%
modify_fmt_fun(stat_nevent ~ style_number5)
Created on 2022-04-21 by the reprex package (v2.0.1)

Knitting Rmarkdown to have AIC round to one's place while rounding regression coefficients and SE to tenth's place

I use the following function in the setup of Rmarkdown to make it so that in knitting everything rounds to two decimal places, but how can I alter the code to create a conditional such that for AIC (x>1000, for instance) it will round to the one's place?
Thanks!
Minimal reproducible example using mtcars data set. Looking at the effect of car weight on mpg with a random factor of cylinder. Make sure to knit everything below in Rmarkdown...if you just use the code in R, it will round the AIC.
---
output:
pdf_document: default
---
```{r echo = FALSE, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(scientific=FALSE)
scientific=FALSE
# knitr::clean_cache()
options(digits=3)
library(tidyverse)
library(lme4)
inline_hook <- function (x) {
if (is.numeric(x)) {
# ifelse does a vectorized comparison
# If integer, print without decimal; otherwise print two places
res <- ifelse(x == round(x),
sprintf("%d", x),
sprintf("%.3f", x)
)
paste(res, collapse = ", ")
}
}
knitr::knit_hooks$set(inline = inline_hook)
mpg <- lmer(mpg~wt + (1|cyl), mtcars, na.action = 'na.exclude', control = lmerControl(optimizer = "nloptwrap", calc.derivs = FALSE), REML = FALSE)
AIC(logLik(mpg))
coef(summary(mpg))[2]
```
AIC = `r AIC(logLik(mpg))`
Effect size = `r coef(summary(mpg))[2]`

Shiny - dygraphs: Show all error-bar values in legend

I am using dygraphs for R and I opened the following issue on GitHub the other day, however, I have not yet received an answer. Therefore, I am hoping someone in here will be able to answer my question.
I want to know if it is possible to show all the values of the prediction interval in the legend, i.e. , lower, actual, upper, without having them as three separate plain dySeries? I like the look of the shading that the upper/lower bars bring, but I would also like to be able to hover over a point and see all the values for that particular point, not just the middle one. If such a function does not exists, is there an easy workaround, maybe with fillGraph = TRUE or something?
library(dygraphs)
hw <- HoltWinters(ldeaths)
p <- predict(hw, n.ahead = 72, prediction.interval = TRUE)
dygraph(p, main = "Predicted Lung Deaths (UK)") %>%
dySeries(c("lwr", "fit", "upr"), label = "Deaths")
The preceding code is the example from the web page, which is similar to my problem. I simply want to see the lwr and upr values in the legend when hovering.
So I found a workaround for anybody looking for something similar.
library(dygraphs)
hw <- HoltWinters(ldeaths)
p <- predict(hw, n.ahead = 72, prediction.interval = TRUE)
max <- p[,2]
min <- p[,3]
p <- ts.union(p, max, min)
dygraph(p, main = "Predicted Lung Deaths (UK)") %>%
dySeries(c("p.lwr", "p.fit", "p.upr"), label = "Deaths") %>%
dySeries("max", label = "Max", pointSize = 0.01, strokeWidth = 0.001) %>%
dySeries("min", label = "Max", pointSize = 0.01, strokeWidth = 0.001)
Obviously, this can be modified to suit your needs (e.g. color of the points etc.) The main idea in this method is simply to create two new columns containing the same information that is used in the bands, and then to make the lines to these too small to see.

Need to extract 4 spaces of text before the occurrence of a word that appears in a column in a df, and may occur several times per row

I need to extract text (4 characters) before the occurrence of the word "exception" per row in a column of my dataframe. For example, see two lines of my data below:
MPSA: Original Version (01/16/2015); FMV Exception: Original Version (04/11/2014); MM Exception: 08.19.15 (08/19/2015)
MPSA: Original Version (02/10/2015); FMV Exception: Original Version (12/18/2014); MEI FMV: V3 (12/18/2014); MEI FMV: updated (11/18/2014); Meeting Material exception: Original Version (04/21/2014);
As you can see, "exception" occurrs more than one time per line, is sometimes capitalized and sometimes not, and has different text before. I need to extract the "FMV", "MM", and "ial" that come before in each case. The goal is to extract as a version of the following (comma separating would be fine but not needed):
"FMVMM"
"FMVial"
I am planning on making all text lower case for simplicity, but I cannot find a regex to extract the 4 characters of text I need after that. Any recommendations?
You basically need strsplit, substr and nchar:
t1 <- "1.MPSA: Original Version (01/16/2015); FMV Exception: Original Version (04/11/2014); MM Exception: 08.19.15 (08/19/2015)"
t2 <- "2.MPSA: Original Version (02/10/2015); FMV Exception: Original Version (12/18/2014); MEI FMV: V3 (12/18/2014); MEI FMV: updated (11/18/2014); Meeting Material exception: Original Version (04/21/2014); "
f <- function(x){
tmp <- strsplit(x, "[Ee]xception")[[1]]
ret <- array(dim = length(tmp) - 1)
for(i in 1:length(ret)){
ret[i] <- substr(tmp[i], start = nchar(tmp[i]) - 3, stop = nchar(tmp[i]))
}
return(paste(ret, collapse = ","))
}
f(t1) #gives "FMV , MM "
f(t2) #gives "FMV ,ial "
Avoiding the loop would be better but for now, this should work.
Edit by Qaswed: Improved the function (shorter and does not need tolower any more).
Edit by TigeronFire:
#Qaswed, thank you for your guidance - the answer, however, poses another problem. t1 and t2 are only two lines on a dataframe 10000 rows long. I attempted to add the column logic to the function you built a few different ways, but I always received the error message:
"Error in strsplit(BOSSMWF_practice$Documents, "[Ee]xception") : non-character argument"
I tried the following with reference to dataframe column BOSSMWF_practice$Documents:
f <- function(x){
tmp <- strsplit(BOSSMWF_practice$Documents, "[Ee]xception")[[1]]
ret <- array(dim = length(tmp) - 1)
for(i in 1:length(ret)){
ret[i] <- substr(tmp[i], start = nchar(tmp[i]) - 3, stop = nchar(tmp[i]))
}
return(paste(ret, collapse = ","))
}
AND:
f <- function(x){
BOSSMWF_practice$tmp <- strsplit(BOSSMWF_practice$Documents, "[Ee]xception")[[1]]
BOSSMWF_practice$ret <- array(dim = length(BOSSMWF_practice$tmp) - 1)
for(i in 1:length(BOSSMWF_practice$ret)){
BOSSMWF_practice$ret[i] <- substr(BOSSMWF_practice$tmp[i], start = nchar(BOSSMWF_practice$tmp[i]) - 3, stop = nchar(BOSSMWF_practice$tmp[i]))
}
return(paste(ret, collapse = ","))
}
I attempted to run the function on my applicable column using both function setups
BOSSMWF_practice$Funct <- f(BOSSMWF_practice$Documents)
But I always received the above error message. Can you take your advice one step further and indicate how to apply this to a dataframe and place the results in a new column?
Edit by Qaswed:
#TigeronFire you should have added a comment to my answer or editing your question, but not editing my question. To your comment:
#if your dataset looks something like this:
df <- data.frame(variable_name = c(t1, t2))
#...use
apply(df, 1, FUN = f)
#note: there was an error in f. You need strsplit(x, ...) and not strsplit(t1, ...).