我目前在 R 中作業以創建條形圖。我被要求在每個條形圖上添加 p 值。我找到了如何使用 package 來做到這一點{ggpval}。我現在的問題是我無法更改它的字體大小。使用的函式是add_pval()，它有一個調整字體大小的選項，稱為textsize。但是，它不起作用。我可以更改 的值textsize，但沒有任何反應。任何的想法？請在下面找到一個可重現的示例。
# Create a dataframe
df <- data.frame(A = runif(5),
B = runif(5),
G = c("Group1", "Group2", "Group3", "Group4", "Group5"))
# Melt the dataframe to be used for ggplot2
df_melt <- reshape2::melt(df, id.vars = "G")
# Create a list of p-values
pvalues <- list("p < 0.001", "p < 0.001", "'p = 0.123'", "'p = 0.813'", "'p = 0.043'")
# Create the plot
library(ggplot2)
library(ggpval)
bar_plot <- ggplot(data = df_melt, aes(x = variable, y = value, fill = variable)) geom_bar(stat = "identity", position = "dodge")
facet_grid(.~G)
theme_bw()
scale_y_continuous(labels = scales::percent_format(), limits = c(0, 1.05))
# Add p-values
add_pval(bar_plot, pairs = list(c(1, 2)), annotation = pvalues, textsize = 5)
系統資訊
R version 4.1.1 (2021-08-10)
R Studio Version: 1.4.1717
OS: Ubuntu 20.04.3 LTS
Platform: x86_64-pc-linux-gnu (64-bit)
Package ggplot2: version 3.3.5
Package ggpval：版本 0.2.4
uj5u.com熱心網友回復：
該add_pvalue功能有錯誤；textsize未在代碼中使用。
您可以在下面找到一個修改版本，稱為my_add_pvalue（請參閱我添加的代碼的最后幾行size=textsize）。
my_add_pval <- function (ggplot_obj, pairs = NULL, test = "wilcox.test", heights = NULL,
barheight = NULL, textsize = 5, pval_text_adj = NULL, annotation = NULL,
log = FALSE, pval_star = FALSE, plotly = FALSE, fold_change = FALSE,
parse_text = NULL, response = "infer", ...)
{
if (is.null(pairs)) {
total_groups <- length(unique(ggplot_obj$data[[ggpval:::get_in_parenthesis(as.character(ggplot_obj$mapping[1]))]]))
if (total_groups == 2) {
pairs <- list(c(1, 2))
}
else {
pairs <- lapply(2:total_groups, function(x) c(1,
x))
}
}
if (is.null(parse_text)) {
if (is.null(annotation)) {
parse_text <- TRUE
}
else {
parse_text <- FALSE
}
}
facet <- NULL
n_facet <- 1
ggplot_obj$data <- data.table(ggplot_obj$data)
if (class(ggplot_obj$facet)[1] != "FacetNull") {
if (class(ggplot_obj$facet)[1] == "FacetGrid") {
facet <- c(names(ggplot_obj$facet$params$cols), names(ggplot_obj$facet$params$rows))
}
else {
facet <- names(ggplot_obj$facet$params$facets)
}
if (length(facet) > 1) {
facet_ <- NULL
ggplot_obj$data[, `:=`(facet_, paste0(get(facet[1]),
get(facet[2])))]
comb <- expand.grid(levels(as.factor(ggplot_obj$data[,
get(facet[1])])), levels(as.factor(ggplot_obj$data[,
get(facet[2])])))
facet_level <- paste0(comb[, 1], comb[, 2])
facet <- "facet_"
}
else {
facet_level <- levels(as.factor(ggplot_obj$data[,
get(facet)]))
}
n_facet <- length(unique(ggplot_obj$data[, get(facet)]))
}
if (!is.null(heights)) {
if (length(pairs) != length(heights)) {
pairs <- rep_len(heights, length(pairs))
}
}
ggplot_obj$data$group__ <- ggplot_obj$data[, get(ggpval:::get_in_parenthesis(as.character(ggplot_obj$mapping[1])))]
ggplot_obj$data$group__ <- factor(ggplot_obj$data$group__)
if (response == "infer") {
response_ <- ggpval:::infer_response(ggplot_obj)
}
else {
response_ <- response
}
ggplot_obj$data$response <- ggplot_obj$data[, get(response_)]
y_range <- layer_scales(ggplot_obj)$y$range$range
if (is.null(barheight)) {
barheight <- (y_range[2] - y_range[1])/20
}
if (is.null(heights)) {
heights <- y_range[2] barheight
heights <- rep(heights, length = length(pairs))
}
if (length(barheight) != length(pairs)) {
barheight <- rep(barheight, length = length(pairs))
}
if (is.null(pval_text_adj)) {
pval_text_adj <- barheight * 0.5
}
if (length(pval_text_adj) != length(pairs)) {
pval_text_adj <- rep(pval_text_adj, length = length(pairs))
}
if (!is.null(annotation)) {
if ((length(annotation) != length(pairs)) && length(annotation) !=
n_facet) {
annotation <- rep(annotation, length = length(pairs))
}
if (is.list(annotation)) {
if (length(annotation[[1]]) != length(pairs)) {
annotation <- lapply(annotation, function(a) rep(a,
length = length(pairs)))
}
}
annotation <- data.frame(annotation)
}
if (log) {
barheight <- exp(log(heights) barheight) - heights
pval_text_adj <- exp(log(heights) pval_text_adj) -
heights
}
V1 <- aes <- annotate <- geom_line <- group__ <- response <- labs <- NULL
for (i in seq(length(pairs))) {
if (length(unique(pairs[[1]])) != 2) {
stop("Each vector in pairs must have two different groups to compare, e.g. c(1,2) to compare first and second box.")
}
test_groups <- levels(ggplot_obj$data$group__)[pairs[[i]]]
data_2_test <- ggplot_obj$data[ggplot_obj$data$group__ %in%
test_groups, ]
if (!is.null(facet)) {
pval <- data_2_test[, lapply(.SD, function(i) get(test)(response ~
as.character(group__), ...)$p.value), by = facet,
.SDcols = c("response", "group__")]
pval <- pval[, `:=`(facet, factor(get(facet), levels = facet_level))][order(facet),
group__]
}
else {
pval <- get(test)(data = data_2_test, response ~
group__, ...)$p.value
if (fold_change) {
fc <- data_2_test[, median(response), by = group__][order(group__)][,
.SD[1]/.SD[2], .SDcols = "V1"][, V1]
fc <- paste0("FC=", round(fc, digits = 2))
pval <- paste(pval, fc)
}
}
if (pval_star & is.null(annotation)) {
pval <- pvars2star(pval)
annotation <- t(t(pval))
}
height <- heights[i]
df_path <- data.frame(group__ = rep(pairs[[i]], each = 2),
response = c(height, height barheight[i], height
barheight[i], height))
ggplot_obj <- ggplot_obj geom_line(data = df_path,
aes(x = group__, y = response), inherit.aes = F)
if (is.null(annotation)) {
labels <- sapply(pval, function(i) format_pval(i,
plotly))
}
else {
labels <- unlist(annotation[i, ])
}
if (is.null(facet)) {
anno <- data.table(x = (pairs[[i]][1] pairs[[i]][2])/2,
y = height barheight[i] pval_text_adj[i],
labs = labels)
}
else {
anno <- data.table(x = rep((pairs[[i]][1] pairs[[i]][2])/2,
n_facet), y = rep(height barheight[i] pval_text_adj[i],
n_facet), labs = labels, facet = facet_level)
setnames(anno, "facet", eval(facet))
}
labs <- geom_text <- x <- y <- NULL
# Added here: size=textsize
ggplot_obj <- ggplot_obj geom_text(data = anno, aes(x = x,
y = y, label = labs), size=textsize, parse = !pval_star & !plotly,
inherit.aes = FALSE)
}
ggplot_obj
}
嘗試使用：
my_add_pval(bar_plot, pairs = list(c(1, 2)), annotation = pvalues, textsize = 10)
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/416784.html
標籤：