I am attempting to create a table which has citations built into the table. Here is a visual of what I am trying to achieve.
As far as I know you can only add footnotes in rowvars or colvars in kableExtra (love that package).
# Create a dataframe called df
Component <- c('N2','P3')
Latency <- c('150 to 200ms', '625 to 800ms')
Location <- c('FCz, Fz, Cz', 'Pz, Oz')
df <- data.frame(Component, Latency, Location)
Below is my attempt after reading through kableExtra's Git page
# Trying some code taken from the kableExtra guide
row.names(df) <- df$Component
df[1] <- NULL
dt_footnote <- df
names(dt_footnote)[1] <- paste0(names(dt_footnote)[2],
footnote_marker_symbol(1))
row.names(dt_footnote)[2] <- paste0(row.names(dt_footnote)[2],
footnote_marker_alphabet(1))
kable(dt_footnote, align = "c",
# Remember this escape = F
escape = F, "latex", longtable = T, booktabs = T, caption = "My Table Name") %>%
kable_styling(full_width = F) %>%
footnote(alphabet = "Jones, 2013",
symbol = "Footnote Symbol 1; ",
footnote_as_chunk = T)
But this code only works on the headers. The ultimate goal would be if I could use a BibTex reference such as #JonesFunctionalMixedEffectModels2013 such that the final part of the code would look like
footnote(alphabet = #davidsonFunctionalMixedEffectModels2009,
symbol = "Footnote Symbol 1; ", footnote_as_chunk = T)
Anyone have any ideas?
Thanks
What I did at the end was to generate a temporary table with pander, then copy the references' number manually to my kable
pander(
df,
caption = "Temporal",
style = "simple",
justify = "left")
Related
Hi I am having issues regarding a foreach loop where in every iteration I estimate a regression on a subset of the data with a different list of controls on several outcomes. The problem is that for some outcomes in some countries I only have missing values and therefore the regression function returns an error message. I would like to be able to run the loop, get the output with NAs or a string saying "Error" for example instead of the coefficient table. I tried several things but they don't quite work with the .combine = rbind option and if I use .combine = c I get a very messy output. Thanks in advance for any help.
reg <- function(y, d, c){
if (missing(c))
feols(as.formula(paste0(y, "~ 0 + treatment")), data = d)
else {
feols(as.formula(paste0(y, "~ 0 + treatment + ", c)), data = d)
}
}
# Here we set up the parallelization to run the code on the server
n.cores <- 9 #parallel::detectCores() - 1
#create the cluster
my.cluster <- parallel::makeCluster(
n.cores,
type = "PSOCK"
)
# print(my.cluster)
#register it to be used by %dopar%
doParallel::registerDoParallel(cl = my.cluster)
# #check if it is registered (optional)
# foreach::getDoParRegistered()
# #how many workers are available? (optional)
# foreach::getDoParWorkers()
# Here is the cycle to parallel regress each outcome on the global treatment
# variable for each RCT with strata control
tables <- foreach(
n = 1:9, .combine = rbind, .packages = c('data.table', 'fixest'),
.errorhandling = "pass"
) %dopar% {
dt_target <- dt[country == n]
c <- controls[n]
est <- lapply(outcomes, function(x) reg(y = x, d = dt_target, c))
table <- etable(est, drop = "!treatment", cluster = "uid", fitstat = "n")
table
}
I have a question regarding tableGrob/grid.table from the gridExtra package. Is there a way to customize different colors for each column? So far and in this stackoverflow link, I have only found how to customize for different rows or cell specific.
Much obliged for any suggestion if possible!
you can pass a vector of colours (fills) for each individual cell,
fills <- rep(blues9, each=nrow(iris[1:4, 1:3]))
tt <- ttheme_default(core=list(bg_params=list(fill=fills)))
grid.table(iris[1:4, 1:3], theme=tt)
grid.table column color/fill: This example is gradient fill for a single column.
library(grid)
library(gridExtra)
library(scales)
library(dplyr)
# build a vector color/fill choice for the first two columns
blkz <- rep(c("NA", "NA"), times = c(4,4)) #NA is for transparent
# generate continuous color scales based off a vector of colors from https://themockup.blog/posts/2020-05-16-gt-a-grammer-of-tables/
red_color_generator <- scales::col_numeric(c("red", "white"), domain = NULL)
redz2 <-red_color_generator(seq(10, 60, by = 10))[1:4] #%>% scales::show_col()
# cmobine the two vectors
blkz_redz <- c(blkz, redz2)
tt <- ttheme_default(core=list(bg_params=list(fill= blkz_redz, col = "gray56")))
dev.off()
grid.table(iris[1:4, 1:3], theme=tt)
#~~~~~~
To make the color fill conditioned on the value in the variable. Follow this steps.
#conditional color mapper function
clrize <-
function(df, x) {
df %>%
mutate(cc =
ifelse(x == 1.3, "#FFB299",
ifelse(x == 1.4, "#FF8969",
ifelse(x == 1.5, "#FF5B3A",
"#FF0000"))))
}
#map this to the column build a vector
dt <- iris[1:4,1:3] %>% as.data.frame()
# apply color based on the value on petal.length variable
clrize(dt, dt$Petal.Length) -> redz3
# cmobine the two vectors
blkz_redz <- c(blkz, redz3$cc) # cc is var added inside the function
tt <- ttheme_default(core=list(bg_params=list(fill= blkz_redz, col = "gray56")))
dev.off()
grid.table(iris[1:4, 1:3], theme=tt)
I making an R Leaflet Map and I have 2 legend. how to combine them?
thanks
Understanding the structure of your map (str(mapObject))object in R can be a helpful starting point. This can be useful for making "aftermarket" edits to legends.
I tried this as a solution to your problem:
# Concatenate the vectors that define each set of colors and their corresponding values:
require(spData)
require(leaflet)
require(sf)
# loading shapes of countries from the package spData
data(world)
world <- st_read(system.file("shapes/world.gpkg", package="spData"))
africa <- world[world$continent == "Africa",]
asia <- world[world$continent == "Asia", ]
asiaPal <- colorNumeric("Reds", domain = asia$pop)
africaPal <- colorNumeric("Blues", domain = africa$pop)
map <- leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addPolygons(data = asia,
color = ~asiaPal(asia$pop)) %>%
addPolygons(data = africa,
color = ~africaPal(africa$pop)) %>%
addLegend("bottomright", pal = asiaPal, values = asia$pop, title = "Asian Population") %>%
addLegend("bottomright", pal = africaPal, values = africa$pop, title = "African Population")
# Colors
map$x$calls[[5]]$args[[1]]$colors <-
c(map$x$calls[[5]]$args[[1]]$colors, map$x$calls[[4]]$args[[1]]$colors)
# Labels
map$x$calls[[5]]$args[[1]]$labels <-
c(map$x$calls[[5]]$args[[1]]$labels, map$x$calls[[4]]$args[[1]]$labels)
# Get rid of Old Legend:
map$x$calls[[4]] <- NULL
where your legends result from elements 4 & 5 of map$x$calls.
This doesnt work very nicely. I suspect it's because these list elements are not the end result, and the elements of the map object are provided to javascript/html when rendering the map. That said, I dont know if it's easily possible to do what you are trying to achieve, without poking around in the actual HTML that results.
I've been trying to name an R data frame columns with greek letters in order to call kable and get a latex output table with header names as these greek letters.
The result is that kable does not recognise column names as the way latex greek letters are written, or the arguments are not passing to the function in the correct format.
A <- t(as.data.frame(seq(1:4)))
colnames(A) <- c("$\\\\alpha$", "$\\\\beta$", "$\\\\delta$", "$\\\\gamma$")
A %>%
kable(.,"latex", escape = F, booktabs = T, linesep = "", align = "c")
Is there a way to do this propperly?
The best solution I,ve found so far is set column names of the data frame to NULL, and write the table headers form the knit options as follows:
A <- t(as.data.frame(seq(1:4)))
colnames(A) <- NULL
A %>%
kable(., "latex", escape = F, booktabs = T, linesep = "", align = "c") %>%
add_header_above(c("$\\\\alpha$", "$\\\\beta$", "$\\\\delta$", "$\\\\gamma$"))
But this way is quite messy and lacks of automation.
Finally I tried the following and it doesn't work too.
A <- t(as.data.frame(seq(1:4)))
A %>%
kable(., "latex", escape = F, booktabs = T, linesep = "", align = "c", col.names = c("$\alpha$", "$\beta$", "$\delta$", "$\gamma$"))
Thanks a lot.
PD: Here is the link to the issue on rmarkdown GitHub
Following code:
library(text2vec)
text8_file = "text8"
if (!file.exists(text8_file)) {
download.file("http://mattmahoney.net/dc/text8.zip", "text8.zip")
unzip ("text8.zip", files = "text8")
}
wiki = readLines(text8_file, n = 1, warn = FALSE)
# Create iterator over tokens
tokens <- space_tokenizer(wiki)
# Create vocabulary. Terms will be unigrams (simple words).
it = itoken(tokens, progressbar = FALSE)
vocab <- create_vocabulary(it)
vocab <- prune_vocabulary(vocab, term_count_min = 5L)
# Use our filtered vocabulary
vectorizer <- vocab_vectorizer(vocab)
# use window of 5 for context words
tcm <- create_tcm(it, vectorizer, skip_grams_window = 5L)
RcppParallel::setThreadOptions(numThreads = 4)
glove_model = GloVe$new(word_vectors_size = 50, vocabulary = vocab, x_max = 10, learning_rate = .25)
word_vectors_main = glove_model$fit_transform(tcm, n_iter = 20)
word_vectors_context = glove_model$components
word_vectors = word_vectors_main + t(word_vectors_context)
causes error:
qlst <- prepare_analogy_questions("questions-words.txt", rownames(word_vectors))
> Error in (function (fmt, ...) :
invalid format '%d'; use format %s for character objects
File questions-words.txt from word2vec sources https://github.com/nicholas-leonard/word2vec/blob/master/questions-words.txt
This was a small bug in information message formatting (after introduction of futille.logger). Just fixed it and pushed to github.
You can install updated version of the package with devtools::install_github("dselivanov/text2vec"