Related
Is there a way for hiding those arrows that point to the same chord diagram sector? Meaning that the chord diagram shows only migration to other continents but includes a non-arrowed area which represents intra-continent migration.
These arrows should be deleted or hided
Code
The code is taken from here: https://www.data-to-viz.com/graph/chord.html
# Libraries
library(tidyverse)
library(viridis)
library(patchwork)
library(hrbrthemes)
library(circlize)
library(chorddiag) #devtools::install_github("mattflor/chorddiag")
# Load dataset from github
data <- read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/13_AdjacencyDirectedWeighted.csv", header=TRUE)
# short names
colnames(data) <- c("Africa", "East Asia", "Europe", "Latin Ame.", "North Ame.", "Oceania", "South Asia", "South East Asia", "Soviet Union", "West.Asia")
rownames(data) <- colnames(data)
# I need a long format
data_long <- data %>%
rownames_to_column %>%
gather(key = 'key', value = 'value', -rowname)
# parameters
circos.clear()
circos.par(start.degree = 90, gap.degree = 4, track.margin = c(-0.1, 0.1), points.overflow.warning = FALSE)
par(mar = rep(0, 4))
# color palette
mycolor <- viridis(10, alpha = 1, begin = 0, end = 1, option = "D")
mycolor <- mycolor[sample(1:10)]
# Base plot
chordDiagram(
x = data_long,
grid.col = mycolor,
transparency = 0.25,
directional = 1,
direction.type = c("arrows", "diffHeight"),
diffHeight = -0.04,
annotationTrack = "grid",
annotationTrackHeight = c(0.05, 0.1),
link.arr.type = "big.arrow",
link.sort = TRUE,
link.largest.ontop = TRUE)
# Add text and axis
circos.trackPlotRegion(
track.index = 1,
bg.border = NA,
panel.fun = function(x, y) {
xlim = get.cell.meta.data("xlim")
sector.index = get.cell.meta.data("sector.index")
# Add names to the sector.
circos.text(
x = mean(xlim),
y = 3.2,
labels = sector.index,
facing = "bending",
cex = 0.8
)
# Add graduation on axis
circos.axis(
h = "top",
major.at = seq(from = 0, to = xlim[2], by = ifelse(test = xlim[2]>10, yes = 2, no = 1)),
minor.ticks = 1,
major.tick.percentage = 0.5,
labels.niceFacing = FALSE)
}
)
edit: added a note that axes widths should remain the same
Something along these lines should work:
# Libraries
library(tidyverse)
library(viridis)
library(patchwork)
library(hrbrthemes)
library(circlize)
library(chorddiag) #devtools::install_github("mattflor/chorddiag")
# Load dataset from github
data <- read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/13_AdjacencyDirectedWeighted.csv", header=TRUE)
# short names
colnames(data) <- c("Africa", "East Asia", "Europe", "Latin Ame.", "North Ame.", "Oceania", "South Asia", "South East Asia", "Soviet Union", "West.Asia")
rownames(data) <- colnames(data)
# I need a long format
data_long <- data %>%
rownames_to_column %>%
gather(key = 'key', value = 'value', -rowname)
# parameters
circos.clear()
circos.par(start.degree = 90, gap.degree = 4, track.margin = c(-0.1, 0.1), points.overflow.warning = FALSE)
par(mar = rep(0, 4))
# color palette
mycolor <- viridis(10, alpha = 1, begin = 0, end = 1, option = "D")
mycolor <- mycolor[sample(1:10)]
# new code
mat <- as.matrix(data)
col_mat <- matrix("a", 10, 10)
for(i in 1:10){
col_mat[i, ] <- mycolor[i]
}
diag(col_mat) = "#00000000"
# Base plot
chordDiagram(
x = mat,
grid.col = mycolor,
col = col_mat,
transparency = 0.25,
directional = 1,
direction.type = c("arrows", "diffHeight"),
diffHeight = -0.04,
annotationTrack = "grid",
annotationTrackHeight = c(0.05, 0.1),
link.arr.type = "big.arrow",
link.sort = TRUE,
link.largest.ontop = TRUE)
# Add text and axis
circos.trackPlotRegion(
track.index = 1,
bg.border = NA,
panel.fun = function(x, y) {
xlim = get.cell.meta.data("xlim")
sector.index = get.cell.meta.data("sector.index")
# Add names to the sector.
circos.text(
x = mean(xlim),
y = 3.2,
labels = sector.index,
facing = "bending",
cex = 0.8
)
# Add graduation on axis
circos.axis(
h = "top",
major.at = seq(from = 0, to = xlim[2], by = ifelse(test = xlim[2]>10, yes = 2, no = 1)),
minor.ticks = 1,
major.tick.percentage = 0.5,
labels.niceFacing = FALSE)
}
)
I'm trying to use show_modal_spinner to to display a text message while the model runs to generate outputs, I'm using PLS-PM in single obsereveEvent function but the showModal popup flashes for a second and disappears while the observe event function is still running, I'm getting all the results from this event but the Modal spinner vanishes as soon as I click the run button. Below is the observe event function I'm using. Please help in in debugging this code.
#------------------PLSPM Analysis Function------------------------
observeEvent({input$actionButton_PLSPM_analysis}, {
show_modal_spinner(
spin = "cube-grid",
color = "firebrick",
text = "Please wait..."
)
PLSPM_result_data_sym <- reactive({
readData(exps=input$PLSPM_ProtocolSelection, crop=input$PLSPM_CropSelection, country=input$PLSPM_CountrySelection, sym = input$PLSPM_TreatmentSelection)
})
PLSPM_Model_Analysis <- reactive({run_PLSPM_Analysis(PLSPM_result_data_sym(), input$PLSPM_CropSelection)})
PLSPM_summary <- reactive({(PLSPM_Model_Analysis()$summary)})
PLSPM_inner_model <- reactive({innerplot(PLSPM_Model_Analysis()$model, colpos = "#6890c4BB", colneg = "#f9675dBB",
box.prop = 0.55, box.size = 0.08, box.cex = 1,
box.col = "gray95", lcol = "black", box.lwd = 2,
txt.col = "black", shadow.size = 0, curve = 0,
lwd = 3, arr.pos = 0.5, arr.width = 0.2, arr.lwd = 3,
cex.txt = 0.9)})
PLSPM_Weight_plot <- reactive({outerplot(PLSPM_Model_Analysis()$model, colpos = "#6890c4BB", colneg = "#f9675dBB",
box.prop = 0.55, box.size = 0.08, box.cex = 1,
box.col = "gray95", lcol = "black", box.lwd = 2,
txt.col = "black", shadow.size = 0, curve = 0,
lwd = 3, arr.pos = 0.5, arr.width = 0.2, arr.lwd = 3,
cex.txt = 0.9)})
PLSPM_Loading_plot <- reactive({outerplot(PLSPM_Model_Analysis()$model, colpos = "#6890c4BB", colneg = "#f9675dBB",
box.prop = 0.55, box.size = 0.08, box.cex = 1,
box.col = "gray95", lcol = "black", box.lwd = 2,
txt.col = "black", shadow.size = 0, curve = 0,
lwd = 3, arr.pos = 0.5, arr.width = 0.2, arr.lwd = 3,
cex.txt = 0.9)})
mydf_inner_model <- reactive({as.data.frame(PLSPM_summary()$inner_model$pyield)})
mydf_outer_model <- reactive({as.data.frame(PLSPM_summary()$outer_model)})
output$data_table_inner_model <- renderDataTable({
datatable(mydf_inner_model(),options = list(
scrollX = TRUE))
})
output$data_table_outer_model <- renderDataTable({
datatable(mydf_outer_model(),options = list(
scrollX = TRUE))
})
output$plot_PLSPM_inner_model <- renderPlot({
(PLSPM_inner_model())
})
output$plot_PLSPM_Weight_plot <- renderPlot({
(PLSPM_Weight_plot())
})
output$plot_PLSPM_Loading_plot <- renderPlot({
(PLSPM_Loading_plot())
})
remove_modal_spinner()
})
That's because you define reactive inside an observeEvent. When you use PLSPM_result_data_sym <- reactive(...) it does not do the calculation, it is simply registered to be done later (when you call PLSPM_result_data_sym()). Instead you can use reactiveValues like this (and put the output outside the observeEvent too):
function(input, output, session) {
rv <- reactiveValues()
observeEvent({
input$actionButton_PLSPM_analysis
}, {
show_modal_spinner(spin = "cube-grid",
color = "firebrick",
text = "Please wait...")
rv$PLSPM_result_data_sym <- readData(
exps = input$PLSPM_ProtocolSelection,
crop = input$PLSPM_CropSelection,
country = input$PLSPM_CountrySelection,
sym = input$PLSPM_TreatmentSelection
)
rv$PLSPM_Model_Analysis <-run_PLSPM_Analysis(rv$PLSPM_result_data_sym, input$PLSPM_CropSelection)
rv$PLSPM_summary <- rv$PLSPM_Model_Analysis$summary
rv$PLSPM_inner_model <- innerplot(
rv$PLSPM_Model_Analysis$model,
colpos = "#6890c4BB",
colneg = "#f9675dBB",
box.prop = 0.55,
box.size = 0.08,
box.cex = 1,
box.col = "gray95",
lcol = "black",
box.lwd = 2,
txt.col = "black",
shadow.size = 0,
curve = 0,
lwd = 3,
arr.pos = 0.5,
arr.width = 0.2,
arr.lwd = 3,
cex.txt = 0.9
)
rv$PLSPM_Weight_plot <-
outerplot(
rv$PLSPM_Model_Analysis$model,
colpos = "#6890c4BB",
colneg = "#f9675dBB",
box.prop = 0.55,
box.size = 0.08,
box.cex = 1,
box.col = "gray95",
lcol = "black",
box.lwd = 2,
txt.col = "black",
shadow.size = 0,
curve = 0,
lwd = 3,
arr.pos = 0.5,
arr.width = 0.2,
arr.lwd = 3,
cex.txt = 0.9
)
rv$PLSPM_Loading_plot <-
outerplot(
rv$PLSPM_Model_Analysis$model,
colpos = "#6890c4BB",
colneg = "#f9675dBB",
box.prop = 0.55,
box.size = 0.08,
box.cex = 1,
box.col = "gray95",
lcol = "black",
box.lwd = 2,
txt.col = "black",
shadow.size = 0,
curve = 0,
lwd = 3,
arr.pos = 0.5,
arr.width = 0.2,
arr.lwd = 3,
cex.txt = 0.9
)
rv$mydf_inner_model <- as.data.frame(rv$PLSPM_summary$inner_model$pyield)
rv$mydf_outer_model <- as.data.frame(rv$PLSPM_summary$outer_model)
remove_modal_spinner()
})
output$data_table_inner_model <- renderDataTable({
datatable(rv$mydf_inner_model, options = list(scrollX = TRUE))
})
output$data_table_outer_model <- renderDataTable({
datatable(rv$mydf_outer_model, options = list(scrollX = TRUE))
})
output$plot_PLSPM_inner_model <- renderPlot({
rv$PLSPM_inner_model
})
output$plot_PLSPM_Weight_plot <- renderPlot({
rv$PLSPM_Weight_plot
})
output$plot_PLSPM_Loading_plot <- renderPlot({
rv$PLSPM_Loading_plot
})
}
You have not used session = shiny::getDefaultReactiveDomain() argument in both remove_modal_spinner() and show_modal_spinner(). Try this
observeEvent({input$actionButton_PLSPM_analysis}, {
show_modal_spinner(
spin = "cube-grid",
color = "firebrick",
text = "Please wait...",
session = shiny::getDefaultReactiveDomain()
)
## other computations here
remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
})
I'm trying to recreate this plot that I made with the old (pre 0.10-0) version of xts. Here's some example data:
library(xts) # Run using xts_0.9-7
set.seed(190)
modelo_1 <- arima.sim(n = 252*8,list(ar = c(.99999),sd = sqrt(0.5)))
set.seed(256)
modelo_2 <- arima.sim(n = 252*8,list(ar = c(.9999),sd = sqrt(0.75)))
d1 <- as.Date("2008-01-01")
series_1 <- xts(modelo_1, seq(d1, by = "days", along.with = modelo_1))
series_2 <- xts(modelo_2, seq(d1, by = "days", along.with = modelo_2))
The code below uses the old version to create the graph I want.
par(mar = c(5, 4, 4, 4))
plot(series_1, las = 1, main = "", mar = c(5, 2, 2, 5))
par(new = TRUE)
plot(series_2, col = 2, axes = FALSE, main = "Two Series")
axis(4, las = 1)
lnames <- c("Series 1 (left)", "Series 2 (right)")
legend("top", legend = lnames, lty = 1, cex = 0.85, col = c(1, 2), bty = "n")
How can I create this plot with the new version of plot.xts()? Here's what I've tried, but both series use the same axis.
plot(cbind(series_1, series_2))
lnames <- c("Series 1", "Series 2")
addLegend("bottom", legend.names = lnames, ncol = 2, lty = 1, lwd = 1, cex = 1)
The old way of doing this is not working anymore, because of this issue.
plot(series_1, las = 1, yaxis.right = FALSE,yaxis.same = FALSE)
par(new = TRUE)
plot(series_2, col = 2, bty = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
axis(4, las = 1)
lnames <- c("Series 1", "Series 2")
legend("topleft", legend = lnames, col = 1:2, lty = 1, cex = 0.85)
I don't speak English very well so forgive me.
Below is the code with the change so that it plots as it was before.
note that the only change was to put the index as x in the plot function. Same index for both plot() functions
library(xts) # Run using xts_0.9-7
set.seed(190)
modelo_1 <- arima.sim(n = 252*8,list(ar = c(.99999),sd = sqrt(0.5)))
set.seed(256)
modelo_2 <- arima.sim(n = 252*8,list(ar = c(.9999),sd = sqrt(0.75)))
d1 <- as.Date("2008-01-01")
series_1 <- xts(modelo_1, seq(d1, by = "days", along.with = modelo_1))
series_2 <- xts(modelo_2, seq(d1, by = "days", along.with = modelo_2))
#O código abaixo usa a versão antiga para criar o gráfico que eu quero.
plot.new()
par(mar = c(5, 4, 4, 4))
plot(index(series_1),series_1, las = 1, main = "",
type = 'l', mar = c(5, 2, 2, 5))
par(new = TRUE)
plot(index(series_1),series_2, col = 2, axes = FALSE,
type = 'l', main = "Two Series")
axis(4, las = 1)
lnames <- c("Series 1 (left)", "Series 2 (right)")
legend("top", legend = lnames, lty = 1, cex = 0.85, col = c(1, 2), bty = "n")
I need to remove the lower control limit and center line (and their labels) from my control chart.
Here's the code:
# install.packages('qcc')
library(qcc)
nonconforming <- c(3, 4, 6, 5, 2, 8, 9, 4, 2, 6, 4, 8, 0, 7, 20, 6, 1, 5, 7)
samplesize <- rep(50, 19)
control <- qcc(nonconforming, type = "p", samplesize, plot = "FALSE")
warn.limits <- limits.p(control$center, control$std.dev, control$sizes, 2)
par(mar = c(5, 3, 1, 3), bg = "blue")
plot(control, restore.par = FALSE, title = "P Chart for Medical Insurance Claims",
xlab = "Day", ylab = "Proportion Defective")
abline(h = warn.limits, lty = 3, col = "blue")
v2 <- c("LWL", "UWL") # the labels for warn.limits
mtext(side = 4, text = v2, at = warn.limits, col = "blue", las = 2)
This approach seems more like a "hack" than an answer and it throws a warning:
control$center <- NULL
control$limits <- NULL
plot(control, add.stats = FALSE)
Not a QC expert by any means but would this work for you? Looking at the qcc function it seems to control what needs to be plotted, so what i've done here is manipulate the limits of the LCL and CENTRE lines. I then changed the plot function to plot between some y limits which does not cover the -1 value. The description unfortunately reflects the manipulated limit values of -1.
control$limits[1] <- -1
control$center <- -1
plot(control, restore.par = FALSE, title = "P Chart for Medical Insurance Claims",
xlab = "Day", ylab = "Proportion Defective", ylim=c(0.0,0.4))
The following function will do the required chart, and you don't need to change your control object, neither to know the control's limits. Load the function, then just call:
plot.qcc2(control, restore.par = FALSE, title = "P Chart for Medical Insurance Claims", + xlab = "Day", ylab = "Proportion Defective")
Function:
#Function plotting only UCL:
plot.qcc2 <- function (x, add.stats = TRUE, chart.all = TRUE, label.limits = c( "UCL"), title, xlab, ylab, ylim, axes.las = 0, digits = getOption("digits"),
restore.par = TRUE, ...)
{
object <- x
if ((missing(object)) | (!inherits(object, "qcc")))
stop("an object of class `qcc' is required")
type <- object$type
std.dev <- object$std.dev
data.name <- object$data.name
center <- object$center
stats <- object$statistics
limits <- object$limits
lcl <- limits[, 1]
ucl <- limits[, 2]
newstats <- object$newstats
newdata.name <- object$newdata.name
violations <- object$violations
if (chart.all) {
statistics <- c(stats, newstats)
indices <- 1:length(statistics)
}
else {
if (is.null(newstats)) {
statistics <- stats
indices <- 1:length(statistics)
}
else {
statistics <- newstats
indices <- seq(length(stats) + 1, length(stats) +
length(newstats))
}
}
if (missing(title)) {
if (is.null(newstats))
main.title <- paste(type, "Chart\nfor", data.name)
else if (chart.all)
main.title <- paste(type, "Chart\nfor", data.name,
"and", newdata.name)
else main.title <- paste(type, "Chart\nfor", newdata.name)
}
else main.title <- paste(title)
oldpar <- par(bg = qcc.options("bg.margin"), cex = qcc.options("cex"),
mar = if (add.stats)
pmax(par("mar"), c(8.5, 0, 0, 0))
else par("mar"), no.readonly = TRUE)
if (restore.par)
on.exit(par(oldpar))
plot(indices, statistics, type = "n", ylim = if (!missing(ylim))
ylim
else range(statistics, limits, center), ylab = if (missing(ylab))
"Group summary statistics"
else ylab, xlab = if (missing(xlab))
"Group"
else xlab, axes = FALSE, main = main.title)
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4],
col = qcc.options("bg.figure"))
axis(1, at = indices, las = axes.las, labels = if (is.null(names(statistics)))
as.character(indices)
else names(statistics))
axis(2, las = axes.las)
box()
lines(indices, statistics, type = "b", pch = 20)
if (length(center) == 1)
alpha <- 1
else lines(indices, c(center, center[length(center)]), type = "s")
if (length(lcl) == 1) {
abline(h = ucl, lty = 2)
}
else {
lines(indices, ucl[indices], type = "s", lty = 2)
}
mtext(label.limits, side = 4, at = c(rev(ucl)[1],rev(ucl)[1]),
las = 1, line = 0.1, col = gray(0.3))
if (is.null(qcc.options("violating.runs")))
stop(".qcc.options$violating.runs undefined. See help(qcc.options).")
if (length(violations$violating.runs)) {
v <- violations$violating.runs
if (!chart.all & !is.null(newstats)) {
v <- v - length(stats)
v <- v[v > 0]
}
points(indices[v], statistics[v], col = qcc.options("violating.runs")$col,
pch = qcc.options("violating.runs")$pch)
}
if (is.null(qcc.options("beyond.limits")))
stop(".qcc.options$beyond.limits undefined. See help(qcc.options).")
if (length(violations$beyond.limits)) {
v <- violations$beyond.limits
if (!chart.all & !is.null(newstats)) {
v <- v - length(stats)
v <- v[v > 0]
}
points(indices[v], statistics[v], col = qcc.options("beyond.limits")$col,
pch = qcc.options("beyond.limits")$pch)
}
if (chart.all & (!is.null(newstats))) {
len.obj.stats <- length(object$statistics)
len.new.stats <- length(statistics) - len.obj.stats
abline(v = len.obj.stats + 0.5, lty = 3)
mtext(paste("Calibration data in", data.name), at = len.obj.stats/2,
adj = 0.5, cex = 0.8)
mtext(paste("New data in", object$newdata.name), at = len.obj.stats +
len.new.stats/2, adj = 0.5, cex = 0.8)
}
if (add.stats) {
plt <- par()$plt
usr <- par()$usr
px <- diff(usr[1:2])/diff(plt[1:2])
xfig <- c(usr[1] - px * plt[1], usr[2] + px * (1 - plt[2]))
at.col <- xfig[1] + diff(xfig[1:2]) * c(0.1, 0.4, 0.65)
mtext(paste("Number of groups = ", length(statistics),
sep = ""), side = 1, line = 5, adj = 0, at = at.col[1],
font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
center <- object$center
if (length(center) == 1) {
mtext(paste("Center = ", signif(center[1], digits),
sep = ""), side = 1, line = 6, adj = 0, at = at.col[1],
font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
}
else {
mtext("Center is variable", side = 1, line = 6, adj = 0,
at = at.col[1], qcc.options("font.stats"), cex = qcc.options("cex.stats"))
}
mtext(paste("StdDev = ", signif(std.dev, digits), sep = ""),
side = 1, line = 7, adj = 0, at = at.col[1], font = qcc.options("font.stats"),
cex = qcc.options("cex.stats"))
if (length(unique(lcl)) == 1)
alpha <- 0
#mtext(paste("LCL = ", signif(lcl[1], digits), sep = ""),
# side = 1, line = 6, adj = 0, at = at.col[2],
# font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
else mtext("LCL is variable", side = 1, line = 6, adj = 0,
at = at.col[2], font = qcc.options("font.stats"),
cex = qcc.options("cex.stats"))
if (length(unique(ucl)) == 1)
mtext(paste("UCL = ", signif(ucl[1], digits), sep = ""),
side = 1, line = 7, adj = 0, at = at.col[2],
font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
else mtext("UCL is variable", side = 1, line = 7, adj = 0,
at = at.col[2], font = qcc.options("font.stats"),
cex = qcc.options("cex.stats"))
if (!is.null(violations)) {
mtext(paste("Number beyond limits =", length(unique(violations$beyond.limits))),
side = 1, line = 6, adj = 0, at = at.col[3],
font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
mtext(paste("Number violating runs =", length(unique(violations$violating.runs))),
side = 1, line = 7, adj = 0, at = at.col[3],
font = qcc.options("font.stats"), cex = qcc.options("cex.stats"))
}
}
invisible()
}
When creating a table using tableGrob or grid.table.
Is there way to align the text inside the table? First column to the left, and the other columns to the right? Rather than the default "center".
Thank you!
something like this: where I want column "a" alligned to the left.
a <- c("one","two","thirty five")
b <- c(1, 2, 3)
c <- c(4, 5, 6)
data <- data.frame(a,b,c)
windows()
grid.table(
data,
gpar.coretext=gpar(fontsize = 12),
gpar.coltext = gpar(fontsize = 12),
gpar.rowtext = gpar(fontsize = 12),
gpar.corefill =
gpar(fill = "green", alpha = 0.5, col = NA),
h.even.alpha = 0.5,
equal.width = FALSE,
show.rownames = FALSE,
show.vlines = TRUE,
padding.h = unit(15, "mm"),
padding.v = unit(8, "mm")
)
With gridExtra v>=2.0.0, the parameters are now controlled via nested lists (themes),
library(gridExtra)
library(grid)
n=5
d <- data.frame(x=rnorm(n),y=rnorm(n),z=sample(letters[1:2],n,replace=T))
m <- format(d, digits = 1, scientific=F,big.mark = ",")
mytheme <- ttheme_default(core = list(fg_params = list(hjust=0, x=0.1,
fontsize=8)),
colhead = list(fg_params = list(fontsize=9,
fontface="bold"))
)
g1 <- tableGrob(m, theme = mytheme, rows=NULL)
grid.newpage()
grid.draw(g1)
Is this what you are looking for? There is a core.just parameter of the format() call.
require("gridExtra")
n=5
df<- data.frame(x=rnorm(n),y=rnorm(n),z=sample(letters[1:2],n,replace=T))
g1<-tableGrob(
format(df, digits = 1,
scientific=F,big.mark = ","),
core.just="left",
#core.just="right",
#col.just="right",
gpar.coretext=gpar(fontsize=8),
gpar.coltext=gpar(fontsize=9, fontface='bold'),
show.rownames = F,
h.even.alpha = 0,
gpar.rowtext = gpar(col="black", cex=0.7,
equal.width = TRUE,
show.vlines = TRUE,
show.hlines = TRUE,
separator="grey")
)
grid.draw(g1)
To set a "transparent" background, use the ttheme_minimal with hjust to set text alignment.
theme_1 <- ttheme_minimal(core = list(fg_params = list(hjust = 0,
x = 0.1,
fontsize = 9)),
colhead = list(fg_params = list(fontsize = 12,
fontface = "bold")))
You can then apply the theme to the tableGrob like this:
gridExtra::tableGrob(df_tbl, theme = theme_1, rows=NULL)