I have the following function:
gg.barplots <- function(inp, order, xlab.strg, ylab.strg) {
require(RColorBrewer)
require(ggplot2)
require(reshape2)
arg <- c(expression(hat(p)[M]), expression(hat(p)[C]))
p <- order
col <- c(colorRampPalette(brewer.pal(9,'Blues')[2:9])(p+2),
colorRampPalette(brewer.pal(9,'Oranges')[2:9])(p+2))
lab <- c(0:p, paste(">",p,sep=""))
freq.mat <- data.frame(labels = lab, inp)
names(freq.mat) <- c("x", "Magnitude-only", "Complex-valued")
freq.mat$x <- factor(freq.mat$x, levels = c(levels(freq.mat$x)[-1],levels(freq.mat$x)[1]))
## force the orders to be as we want them to appear, using the factor function with levels specified.
freq.df <- melt(data = freq.mat, id.vars = 1, measure.vars = 2:3)
fill.vars <- paste(rep(names(freq.mat)[-1], times = p), rep(freq.mat$x, each = 2), sep = ":")
fill.vars <- factor(fill.vars, levels = fill.vars)
freq.df <- data.frame(fill.vars, freq.df[rep(c(0,p+2), times = p + 2) + rep(1:(p + 2), each = 2), ])
ggplot(data=freq.df, aes(x = x, y = value, fill = fill.vars)) +
geom_bar(stat="identity", position=position_dodge(), colour = "black") +
scale_fill_manual(values = col[rep(c(0,p+2), times = p + 2) + rep(1:(p + 2), each = 2)]) +
theme_bw() +
xlab(arg) +
ylab(ylab.strg) +
xlab(xlab.strg) +
ylab(ylab.strg)
}
which gives me the following (two dodged barplots) as in the following example:
dput(out.AR2$AR.rate)
structure(c(0.25178, 0.06735, 0.64564, 0.03523, 0.04396, 0.0027,
0.90415, 0.04919), .Dim = c(4L, 2L), .Dimnames = list(c("0",
"1", "2", ">2"), NULL))
and calling the function:
gg.barplots(inp = out.AR2$AR.rate, order = 2, xlab.strg = "AR order", ylab.strg = "Proportions")
which results in the following figure:
Now I feel that (even ignoring the inherent ugliness of the current legend in this plot), the whole legend is not necessary. I think it is enought to have only the colors (say the mid-valye of the Oranges scale and the mid-value of the Blues scale) should be enough to represent the important parts of the plot. The remainder (AR orders in the legend) are already there in the figure.
My question: is how do I make a legend which has only these two colors (and the words Complex-value and Magnitude-only) associated with them? I have tried several things and I am a bit lost, sorry.
Your function is a little messy - you could probably split it into two functions, one to clean and one to plot.
Anyways, the easiest way to get what you want is to use the breaks argument to scale_fill_manual. This allows you to choose only those levels you want in the legend:
gg.barplots <- function(inp, order, xlab.strg, ylab.strg) {
require(RColorBrewer)
require(ggplot2)
require(reshape2)
arg <- c(expression(hat(p)[M]), expression(hat(p)[C]))
p <- order
col <- c(colorRampPalette(brewer.pal(9,'Blues')[2:9])(p+2),
colorRampPalette(brewer.pal(9,'Oranges')[2:9])(p+2))
lab <- c(0:p, paste(">",p,sep=""))
freq.mat <- data.frame(labels = lab, inp)
names(freq.mat) <- c("x", "Magnitude-only", "Complex-valued")
freq.mat$x <- factor(freq.mat$x, levels = c(levels(freq.mat$x)[-1],levels(freq.mat$x)[1]))
## force the orders to be as we want them to appear, using the factor function with levels specified.
freq.df <- melt(data = freq.mat, id.vars = 1, measure.vars = 2:3)
fill.vars <- paste(rep(names(freq.mat)[-1], times = p), rep(freq.mat$x, each = 2), sep = ":")
fill.vars <- factor(fill.vars, levels = fill.vars)
freq.df <- data.frame(fill.vars, freq.df[rep(c(0,p+2), times = p + 2) + rep(1:(p + 2), each = 2), ])
ggplot(data=freq.df, aes(x = x, y = value, fill = fill.vars)) +
geom_bar(stat="identity", position=position_dodge(), colour = "black") +
scale_fill_manual(values = col[rep(c(0,p+2), times = p + 2) + rep(1:(p + 2), each = 2)], breaks = c("Magnitude-only:2", "Complex-valued:2")) +
theme_bw() +
xlab(arg) +
ylab(ylab.strg) +
xlab(xlab.strg) +
ylab(ylab.strg)
}
Related
This question already has answers here:
Alternating color of individual dashes in a geom_line
(4 answers)
Closed 8 months ago.
I was wondering if it is possible to create a multicolored dashed line in ggplot.
Basically I have a plot displaying savings based on two packages.
A orange line with savings based on package A
A green line with savings based on package B
I also have a third line and I would like that one to be dashed alterenating between orange and green. Is that something that somebody has been able to do?
Here is an example:
library(tidyverse)
S <- seq(0, 5, by = 0.05)
a <- S ^ 2
b <- S
a_b = a + b #This data should have the dashed multicolor line, since it is the sum of the other two lines.
S <- data.frame(S)
temp <- cbind(S, a, b, a_b)
temp <- gather(temp, variable, value, -S)
desiredOrder <- c("a", "b", "a_b")
temp$variable <- factor(temp$variable, levels = desiredOrder)
temp <- temp[order(temp$variable),]
p <- ggplot(temp, aes(x = S, y = value, colour = variable)) +
theme_minimal() +
geom_line(size = 1) +
scale_color_manual(name = "Legend", values = c("orange", "green", "#0085bd"),
breaks = c("a", "b", "a_b"))
p
I basically want to have a multicolored (dashed or dotted) line for "c"
This is, to my best knowledge, currently only possible via creation of new segments for each alternate color. This is fiddly.
Below I've tried a largely programmatic approach in which you can define the size of the repeating segment (based on your x unit). The positioning of y values is slightly convoluted and it will also result in slightly irregular segment lengths when dealing with different slopes. I also haven't tested it on many data, either. But I guess it's a good start :)
For the legend, I'm taking the same approach, by creating a fake legend and stitching it onto the other plot. The challenges here include:
positioning of legend elements relative to the plot
relative distance between the legend elements
update
For a much neater way to create those segments and a Stat implementation see this thread
library(tidyverse)
library(patchwork)
S <- seq(0, 5, by = 0.05)
a <- S^2
b <- S
a_b <- a + b
df <- data.frame(x = S, a, b, a_b) %>%
pivot_longer(-x, names_to = "variable", values_to = "value")
## a function to create modifiable cuts in order to get segments.
## this looks convoluted - and it is! there are a few if/else statements.
## Why? The assigment of new y to x values depends on how many original values
## you have.
## There might be more direct ways to get there
alt_colors <- function(df, x, y, seg_length, my_cols) {
x <- df[[x]]
y <- df[[y]]
## create new x for each tiny segment
length_seg <- seg_length / length(my_cols)
new_x <- seq(min(x, na.rm = TRUE), x[length(x)], length_seg)
## now we need to interpolate y values for each new x
## This is different depending on how many x and new x you have
if (length(new_x) < length(x)) {
ind_int <- findInterval(new_x, x)
new_y <- sapply(seq_along(ind_int), function(i) {
if (y[ind_int[i]] == y[ind_int[length(ind_int)]]) {
y[ind_int[i]]
} else {
seq_y <- seq(y[ind_int[i]], y[ind_int[i] + 1], length.out = length(my_cols))
head(seq_y, -1)
}
})
} else {
ind_int <- findInterval(new_x, x)
rle_int <- rle(ind_int)
new_y <- sapply(rle_int$values, function(i) {
if (y[i] == y[max(rle_int$values)]) {
y[i]
} else {
seq_y <- seq(y[i], y[i + 1], length.out = rle_int$lengths[i] + 1)
head(seq_y, -1)
}
})
}
## THis is also a bit painful and might cause other bugs that I haven't
## discovered yet.
if (length(unlist(new_y)) < length(new_x)) {
newdat <- data.frame(
x = new_x,
y = rep_len(unlist(new_y), length.out = length(new_x))
)
} else {
newdat <- data.frame(x = new_x, y = unlist(new_y))
}
newdat <- newdat %>%
mutate(xend = lead(x), yend = lead(y)) %>%
drop_na(xend)
newdat$color <- my_cols
newdat
}
## the below is just a demonstration of how the function would work
## using different segment widths
df_alt1 <-
df %>%
filter(variable == "a_b") %>%
alt_colors("x", "value", 1, c("orange", "green"))
df_alt.5 <-
df %>%
filter(variable == "a_b") %>%
alt_colors("x", "value", .5, c("orange", "green"))
df_ab <-
df %>%
filter(variable != "a_b") %>%
# for the identity mapping
mutate(color = ifelse(variable == "a", "green", "orange"))
## create data frame for the legend, also using the alt_colors function as per above
## the amount of x is a bit of trial and error, this is just a quick hack
## this is a trick to center the legend more or less relative to the main plot
y_leg <- ceiling(mean(range(df$value, na.rm = TRUE)))
dist_y <- 2
df_legend <-
data.frame(
variable = rep(unique(df$variable), each = 2),
x = 1:2,
y = rep(seq(y_leg - dist_y, y_leg + dist_y, by = dist_y), each = 2)
)
df_leg_onecol <-
df_legend %>%
filter(variable != "a_b") %>%
mutate(color = ifelse(variable == "a", "green", "orange"))
df_leg_alt <-
df_legend %>%
filter(variable == "a_b") %>%
alt_colors("x", "y", .5, c("orange", "green"))
## I am mapping the colors globally using identity mapping (see scale_identity).
p1 <-
ggplot(mapping = aes(x, value, colour = color)) +
theme_minimal() +
geom_line(data = df_ab, size = 1) +
geom_segment(data = df_alt1, aes(y = y, xend = xend, yend = yend), size = 1) +
scale_color_identity() +
ggtitle("alternating every 1 unit")
p.5 <-
ggplot(mapping = aes(x, value, colour = color)) +
theme_minimal() +
geom_line(data = df_ab, size = 1) +
geom_segment(data = df_alt.5, aes(y = y, xend = xend, yend = yend), size = 1) +
scale_color_identity() +
ggtitle("alternating every .5 unit")
p_leg <-
ggplot(mapping = aes(x, y, colour = color)) +
theme_void() +
geom_line(data = df_leg_onecol, size = 1) +
geom_segment(data = df_leg_alt, aes(xend = xend, yend = yend), size = 1) +
scale_color_identity() +
annotate(
geom = "text", y = unique(df_legend$y), label = unique(df_legend$variable),
x = max(df_legend$x + 1), hjust = 0
)
## set y limits to the range of the main plot
## in order to make the labels visible you need to adjust the plot margin and
## turn clipping off
p1 + p.5 +
(p_leg + coord_cartesian(ylim = range(df$value), clip = "off") +
theme(plot.margin = margin(r = 20, unit = "pt"))) +
plot_layout(widths = c(1, 1, .2))
Created on 2022-01-18 by the reprex package (v2.0.1)
(Copied this over from Alternating color of individual dashes in a geom_line)
Here's a ggplot hack that is simple, but works for two colors only. It results in two lines being overlayed, one a solid line, the other a dashed line.
library(dplyr)
library(ggplot2)
library(reshape2)
# Create df
x_value <- 1:10
group1 <- c(0,1,2,3,4,5,6,7,8,9)
group2 <- c(0,2,4,6,8,10,12,14,16,18)
dat <- data.frame(x_value, group1, group2) %>%
mutate(group2_2 = group2) %>% # Duplicate the column that you want to be alternating colors
melt(id.vars = "x_value", variable.name = "group", value.name ="y_value") # Long format
# Put in your selected order
dat$group <- factor(dat$group, levels=c("group1", "group2", "group2_2"))
# Plot
ggplot(dat, aes(x=x_value, y=y_value)) +
geom_line(aes(color=group, linetype=group), size=1) +
scale_color_manual(values=c("black", "red", "black")) +
scale_linetype_manual(values=c("solid", "solid", "dashed"))
Unfortunately the legend still needs to be edited by hand. Here's the example plot.
I would like to create a graph that has superscripts on the axis instead of displaying unformatted numbers using ggplot2. I know that there are a lot of answers which change the axis label, but not the axis text. I am not trying to change the label of the graph, but the text on the axis.
Example:
x<-c('2^-5','2^-3','2^-1','2^1','2^2','2^3','2^5','2^7','2^9','2^11','2^13')
y<-c('2^-5','2^-3','2^-1','2^1','2^2','2^3','2^5','2^7','2^9','2^11','2^13')
df<-data.frame(x,y)
p<-ggplot()+
geom_point(data=df,aes(x=x,y=y),size=4)
p
So I would like the x-axis to display the same numbers but without the carrot.
EDIT:
A purely base approach:
df %>%
mutate_all(as.character)->new_df
res<-unlist(Map(function(x) eval(parse(text=x)),new_df$x))#replace with y for y
to_use<-unlist(lapply(res,as.expression))
split_text<-strsplit(gsub("\\^"," ",names(to_use))," ")
join_1<-as.numeric(sapply(split_text,"[[",1)) #tidyr::separate might help, less robust for numeric(I think)
join_2<-as.numeric(sapply(split_text,"[[",2))
to_use_1<-sapply(seq_along(join_1),function(x) parse(text=paste(join_1[x],"^",
join_2[x])))
The above can be reduced to less step, I posted the stepwise approach I took. The result for only x, the same can be done for y:
new_df %>%
ggplot()+
geom_point(aes(x=x,y=y),size=4)+
scale_x_discrete(breaks=df$x,labels=to_use_1)#replace with y and scale_y_discrete for y
Plot:
Original and erroneous answer:
I have deviated from standard tidyverse practice by using $, you can replace it with . and it might work although in this case it's not really important since the focus is on labels.:
library(dplyr)
df %>%
mutate(new_x=gsub("\\^"," ",x),
new_y=gsub("\\^"," ",y))->new_df
new_df %>%
ggplot()+
geom_point(aes(x=x,y=y),size=4)+
scale_x_discrete(breaks=x,labels=new_df$new_x)+
scale_y_discrete(breaks=y,labels=new_df$new_y)
This can be done with functions scale_x_log2 and scale_y_log2 that can be found in GitHub package jrnoldmisc.
First, install the package.
devtools::install_github("jrnold/rubbish")
Then, coerce the variables to numeric. I wil work with a copy of the original dataframe.
df1 <- df
df1[] <- lapply(df1, function(x){
x <- as.character(x)
sapply(x, function(.x)eval(parse(text = .x)))
})
Now, graph it.
library(jrnoldmisc)
library(ggplot2)
library(MASS)
library(scales)
a <- ggplot(df1, aes(x = x, y = y, size = 4)) +
geom_point(show.legend = FALSE) +
scale_x_log2(limits = c(0.01, NA),
labels = trans_format("log2", math_format(2^.x)),
breaks = trans_breaks("log2", function(x) 2^x, n = 10)) +
scale_y_log2(limits = c(0.01, NA),
labels = trans_format("log2", math_format(2^.x)),
breaks = trans_breaks("log2", function(x) 2^x, n = 10))
a + annotation_logticks(base = 2)
Edit.
Following the discussion in the comments, here are the two other ways that were seen to give different axis labels.
Axis labels every tick mark. Set limits = c(1.01, NA) and function argument n = 11, an odd number.
Axis labels on odd number exponents. Keep limits = c(0.01, NA), change to function(x) 2^(x - 1), n = 11.
Just the instructions, no plots.
The first.
a <- ggplot(df1, aes(x = x, y = y, size = 4)) +
geom_point(show.legend = FALSE) +
scale_x_log2(limits = c(1.01, NA),
labels = trans_format("log2", math_format(2^.x)),
breaks = trans_breaks("log2", function(x) 2^(x), n = 11)) +
scale_y_log2(limits = c(1.01, NA),
labels = trans_format("log2", math_format(2^.x)),
breaks = trans_breaks("log2", function(x) 2^(x), n = 11))
a + annotation_logticks(base = 2)
And the second.
a <- ggplot(df1, aes(x = x, y = y, size = 4)) +
geom_point(show.legend = FALSE) +
scale_x_log2(limits = c(0.01, NA),
labels = trans_format("log2", math_format(2^.x)),
breaks = trans_breaks("log2", function(x) 2^(x - 1), n = 11)) +
scale_y_log2(limits = c(0.01, NA),
labels = trans_format("log2", math_format(2^.x)),
breaks = trans_breaks("log2", function(x) 2^(x - 1), n = 11))
a + annotation_logticks(base = 2)
You can provide a function to the labels argument of the scale_x_*** and scale_y_*** functions to generate labels with superscripts (or other formatting). See examples below.
library(jrnoldmisc)
library(ggplot2)
df<-data.frame(x=2^seq(-5,5,2),
y=2^seq(-5,5,2))
ggplot(df) +
geom_point(aes(x=x,y=y),size=2) +
scale_x_log2(breaks=2^seq(-5,5,2),
labels=function(x) parse(text=paste("2^",round(log2(x),2))))
ggplot(df) +
geom_point(aes(x=x,y=y),size=2) +
scale_x_continuous(breaks=c(2^-5, 2^seq(1,5,2)),
labels=function(x) parse(text=paste("2^",round(log2(x),2))))
ggplot(df) +
geom_point(aes(x=x,y=y),size=2) +
scale_x_log10(breaks=10^seq(-1,1,1),
labels=function(x) parse(text=paste("10^",round(log10(x),2))))
This sets up my data frame
means<- list()
means[[1]] <- matrix(c(5,4,6,7,8,8,2,3,4), nrow=3, ncol=3)
means[[2]] <- matrix(c(11,7,5,7,8,8,4,3,10), nrow=3, ncol=3)
ses <- list ( )
ses[[1]] <- matrix(c(0.5,0.4,0.6,0.7,0.8,0.8,0.2,0.3,0.4), nrow=3, ncol=3)
ses[[2]] <- matrix(c(0.11,0.7,0.5,0.7,0.8,0.8,0.4,0.3,0.10),nrow=3, ncol=3)
names(means)<- c("nameone", "nametwo")
colnames(means[[1]])<- c("1", "2", "3")
colnames(means[[2]])<- c("1", "2", "3")
rownames(means[[1]])<- c("a", "b", "c")
rownames(means[[2]])<- c("a", "b", "c")
This is the code to create the graphs which I've done. Basically I'd like a short form way to achieve the same thing it's just too messy and too much typing, maybe a way to avoid the nested looping etc?
dev.off()
par(mfrow=c(1,2))
for (j in 1:2){
means1 <- means[[j]]
ses1 <- ses[[j]]
if (j == 1) title <- "A" else
title <- "B"
for (i in 1:3){
plot(means1[i,], ylim = c(2, 15), xlim = c(0, 4), xlab = "factor1", ylab = "DV", xaxt = "n", col=i, pch=i, main = title)
axis(1, at=1:3, labels=c("1","2","3"))
add.bars(means1[i,], ses1[i,], col = i)
par(new=TRUE)
}
if (j == 1)
legend (2.5, 14, names(means1[,1]), pch = 1:3, col = 1:3)
}
It's hard to tell exactly what you were going for but you could avoid the nested loops by converting to data.frames and using ggplot2.
Before making the conversion I would make sure means and ses have the same names:
ses <- Map(function(m, s) {
dimnames(s) <- dimnames(m)
return(s)
}, means, ses)
Then use functions from the reshape2 and plyr packages (both of which are provided by ggplot2) to convert and combine the two matrix lists:
library(ggplot2)
library(reshape2)
library(plyr)
means.df <- melt(means, value.name = "mean")
ses.df <- melt(ses, value.name = "se")
plot.df <- join(means.df, ses.df)
ggplot(plot.df, aes(factor(Var2), mean)) +
geom_bar(stat = "identity") +
geom_errorbar(aes(ymax = mean + se, ymin = mean - se)) +
facet_grid(L1 ~ Var1) +
xlab("Factor") + ylab("DV")
Alternatively you could use colors to differentiate the lettered variables:
ggplot(plot.df, aes(factor(Var2), mean, fill = Var1)) +
geom_bar(stat = "identity", position = "dodge") +
geom_errorbar(aes(ymax = mean + se, ymin = mean - se), position = "dodge") +
facet_grid(L1 ~ .) +
xlab("Factor") + ylab("DV")
It's common to put stars on barplots or boxplots to show the level of significance (p-value) of one or between two groups, below are several examples:
The number of stars are defined by p-value, for example one can put 3 stars for p-value < 0.001, two stars for p-value < 0.01, and so on (although this changes from one article to the other).
And my questions: How to generate similar charts? The methods that automatically put stars based on significance level are more than welcome.
I know that this is an old question and the answer by Jens Tierling already provides one solution for the problem. But I recently created a ggplot-extension that simplifies the whole process of adding significance bars: ggsignif
Instead of tediously adding the geom_line and geom_text to your plot you just add a single layer geom_signif:
library(ggplot2)
library(ggsignif)
ggplot(iris, aes(x=Species, y=Sepal.Length)) +
geom_boxplot() +
geom_signif(comparisons = list(c("versicolor", "virginica")),
map_signif_level=TRUE)
To create a more advanced plot similar to the one shown by Jens Tierling, you can do:
dat <- data.frame(Group = c("S1", "S1", "S2", "S2"),
Sub = c("A", "B", "A", "B"),
Value = c(3,5,7,8))
ggplot(dat, aes(Group, Value)) +
geom_bar(aes(fill = Sub), stat="identity", position="dodge", width=.5) +
geom_signif(stat="identity",
data=data.frame(x=c(0.875, 1.875), xend=c(1.125, 2.125),
y=c(5.8, 8.5), annotation=c("**", "NS")),
aes(x=x,xend=xend, y=y, yend=y, annotation=annotation)) +
geom_signif(comparisons=list(c("S1", "S2")), annotations="***",
y_position = 9.3, tip_length = 0, vjust=0.4) +
scale_fill_manual(values = c("grey80", "grey20"))
Full documentation of the package is available at CRAN.
Please find my attempt below.
First, I created some dummy data and a barplot which can be modified as we wish.
windows(4,4)
dat <- data.frame(Group = c("S1", "S1", "S2", "S2"),
Sub = c("A", "B", "A", "B"),
Value = c(3,5,7,8))
## Define base plot
p <-
ggplot(dat, aes(Group, Value)) +
theme_bw() + theme(panel.grid = element_blank()) +
coord_cartesian(ylim = c(0, 15)) +
scale_fill_manual(values = c("grey80", "grey20")) +
geom_bar(aes(fill = Sub), stat="identity", position="dodge", width=.5)
Adding asterisks above a column is easy, as baptiste already mentioned. Just create a data.frame with the coordinates.
label.df <- data.frame(Group = c("S1", "S2"),
Value = c(6, 9))
p + geom_text(data = label.df, label = "***")
To add the arcs that indicate a subgroup comparison, I computed parametric coordinates of a half circle and added them connected with geom_line. Asterisks need new coordinates, too.
label.df <- data.frame(Group = c(1,1,1, 2,2,2),
Value = c(6.5,6.8,7.1, 9.5,9.8,10.1))
# Define arc coordinates
r <- 0.15
t <- seq(0, 180, by = 1) * pi / 180
x <- r * cos(t)
y <- r*5 * sin(t)
arc.df <- data.frame(Group = x, Value = y)
p2 <-
p + geom_text(data = label.df, label = "*") +
geom_line(data = arc.df, aes(Group+1, Value+5.5), lty = 2) +
geom_line(data = arc.df, aes(Group+2, Value+8.5), lty = 2)
Lastly, to indicate comparison between groups, I built a larger circle and flattened it at the top.
r <- .5
x <- r * cos(t)
y <- r*4 * sin(t)
y[20:162] <- y[20] # Flattens the arc
arc.df <- data.frame(Group = x, Value = y)
p2 + geom_line(data = arc.df, aes(Group+1.5, Value+11), lty = 2) +
geom_text(x = 1.5, y = 12, label = "***")
There is also an extension of the ggsignif package called ggpubr that is more powerful when it comes to multi-group comparisons. It builds on top of ggsignif, but also handles anova and kruskal-wallis as well as pairwise comparisons against the gobal mean.
Example:
library(ggpubr)
my_comparisons = list( c("0.5", "1"), c("1", "2"), c("0.5", "2") )
ggboxplot(ToothGrowth, x = "dose", y = "len",
color = "dose", palette = "jco")+
stat_compare_means(comparisons = my_comparisons, label.y = c(29, 35, 40))+
stat_compare_means(label.y = 45)
I found this one is useful.
library(ggplot2)
library(ggpval)
data("PlantGrowth")
plt <- ggplot(PlantGrowth, aes(group, weight)) +
geom_boxplot()
add_pval(plt, pairs = list(c(1, 3)), test='wilcox.test')
Made my own function:
ts_test <- function(dataL,x,y,method="t.test",idCol=NULL,paired=F,label = "p.signif",p.adjust.method="none",alternative = c("two.sided", "less", "greater"),...) {
options(scipen = 999)
annoList <- list()
setDT(dataL)
if(paired) {
allSubs <- dataL[,.SD,.SDcols=idCol] %>% na.omit %>% unique
dataL <- dataL[,merge(.SD,allSubs,by=idCol,all=T),by=x] #idCol!!!
}
if(method =="t.test") {
dataA <- eval(parse(text=paste0(
"dataL[,.(",as.name(y),"=mean(get(y),na.rm=T),sd=sd(get(y),na.rm=T)),by=x] %>% setDF"
)))
res<-pairwise.t.test(x=dataL[[y]], g=dataL[[x]], p.adjust.method = p.adjust.method,
pool.sd = !paired, paired = paired,
alternative = alternative, ...)
}
if(method =="wilcox.test") {
dataA <- eval(parse(text=paste0(
"dataL[,.(",as.name(y),"=median(get(y),na.rm=T),sd=IQR(get(y),na.rm=T,type=6)),by=x] %>% setDF"
)))
res<-pairwise.wilcox.test(x=dataL[[y]], g=dataL[[x]], p.adjust.method = p.adjust.method,
paired = paired, ...)
}
#Output the groups
res$p.value %>% dimnames %>% {paste(.[[2]],.[[1]],sep="_")} %>% cat("Groups ",.)
#Make annotations ready
annoList[["label"]] <- res$p.value %>% diag %>% round(5)
if(!is.null(label)) {
if(label == "p.signif"){
annoList[["label"]] %<>% cut(.,breaks = c(-0.1, 0.0001, 0.001, 0.01, 0.05, 1),
labels = c("****", "***", "**", "*", "ns")) %>% as.character
}
}
annoList[["x"]] <- dataA[[x]] %>% {diff(.)/2 + .[-length(.)]}
annoList[["y"]] <- {dataA[[y]] + dataA[["sd"]]} %>% {pmax(lag(.), .)} %>% na.omit
#Make plot
coli="#0099ff";sizei=1.3
p <-ggplot(dataA, aes(x=get(x), y=get(y))) +
geom_errorbar(aes(ymin=len-sd, ymax=len+sd),width=.1,color=coli,size=sizei) +
geom_line(color=coli,size=sizei) + geom_point(color=coli,size=sizei) +
scale_color_brewer(palette="Paired") + theme_minimal() +
xlab(x) + ylab(y) + ggtitle("title","subtitle")
#Annotate significances
p <-p + annotate("text", x = annoList[["x"]], y = annoList[["y"]], label = annoList[["label"]])
return(p)
}
Data and call:
library(ggplot2);library(data.table);library(magrittr);
df_long <- rbind(ToothGrowth[,-2],data.frame(len=40:50,dose=3.0))
df_long$ID <- data.table::rowid(df_long$dose)
ts_test(dataL=df_long,x="dose",y="len",idCol="ID",method="wilcox.test",paired=T)
Result:
I have a dataframe a with three columns :
GeneName, Index1, Index2
I draw a scatterplot like this
ggplot(a, aes(log10(Index1+1), Index2)) +geom_point(alpha=1/5)
Then I want to color a point whose GeneName is "G1" and add a text box near that point, what might be the easiest way to do it?
You could create a subset containing just that point and then add it to the plot:
# create the subset
g1 <- subset(a, GeneName == "G1")
# plot the data
ggplot(a, aes(log10(Index1+1), Index2)) + geom_point(alpha=1/5) + # this is the base plot
geom_point(data=g1, colour="red") + # this adds a red point
geom_text(data=g1, label="G1", vjust=1) # this adds a label for the red point
NOTE: Since everyone keeps up-voting this question, I thought I would make it easier to read.
Something like this should work. You may need to mess around with the x and y arguments to geom_text().
library(ggplot2)
highlight.gene <- "G1"
set.seed(23456)
a <- data.frame(GeneName = paste("G", 1:10, sep = ""),
Index1 = runif(10, 100, 200),
Index2 = runif(10, 100, 150))
a$highlight <- ifelse(a$GeneName == highlight.gene, "highlight", "normal")
textdf <- a[a$GeneName == highlight.gene, ]
mycolours <- c("highlight" = "red", "normal" = "grey50")
a
textdf
ggplot(data = a, aes(x = Index1, y = Index2)) +
geom_point(size = 3, aes(colour = highlight)) +
scale_color_manual("Status", values = mycolours) +
geom_text(data = textdf, aes(x = Index1 * 1.05, y = Index2, label = "my label")) +
theme(legend.position = "none") +
theme()