I made a graph like this:
library(reshape2)
library(ggplot2)
m <- matrix(1:64 - 32, 8)
rownames(m) <- colnames(m) <-
c(paste0("a", 1:3), paste0("b", 1:2), paste0("c", 1:3))
d <- melt(m)
gg <- ggplot(d) +
geom_tile(aes(x = Var1, y = Var2, fill = value)) +
scale_fill_gradient2()
How can I programmatically draw boxes around the "a", "b", and "c" groups?
The matrix m will always be square. colnames(m) and rownames(m) will always be the same. Therefore the boxes will be cover the entire grid and will never overlap. The group sizes will vary, in general.
I'm also not married to ggplot2. I'm open to a solution in base graphics with image if it's not fussier than the ggplot2/grid version.
I got as far as
d$group <- substr(d$Var1, 1, 1)
before I realized I had no clue how to proceed.
What I have:
What I want:
Or geom_segment
library('reshape2')
library('ggplot2')
m <- matrix(1:64 - 32, 8)
rownames(m) <- colnames(m) <-
c(paste0("a", 1:3), paste0("b", 1:2), paste0("c", 1:3))
gg <- ggplot(melt(m)) +
geom_tile(aes(x = Var1, y = Var2, fill = value)) +
scale_fill_gradient2()
tt <- table(gsub('\\d+', '', colnames(m)))
ll <- unname(c(0, cumsum(tt)) + .5)
gg + geom_segment(aes(x = ll, xend = ll, y = head(ll, 1), yend = tail(ll, 1))) +
geom_segment(aes(y = ll, yend = ll, x = head(ll, 1), xend = tail(ll, 1)))
This may be considered cheating, but very easy:
# Depending on your data you may be able to generate `d2` directly
# here we need to re-order a bit
d2 <- transform(
d, V1 = substr(Var1, 1, 1),
V2=factor(substr(Var2, 1, 1), levels=letters[3:1])
)
ggplot(d2) +
geom_tile(aes(x = Var1, y = Var2, fill = value)) +
scale_fill_gradient2() +
facet_grid(V2 ~ V1, scales="free", space="free")
i.e. something like this:
xmin <- c(0.5,3.5,5.5)
xmax <- c(3.5,5.5,8.5)
ymin <- c(0.5,3.5,5.5)
ymax <- c(3.5,5.5,8.5)
box1 <- data.frame(xmin = rep(xmin,times = 3),
xmax = rep(xmax,each = 3),
ymin = rep(ymin,times = 3),
ymax = rep(ymax,each = 3))
ggplot(melt(m)) +
geom_tile(aes(x = Var1, y = Var2, fill = value)) +
geom_rect(data = box1,aes(xmin = xmin,xmax = xmax,ymin = ymin,ymax= ymax),
fill = NA,color = "black") +
scale_fill_gradient2()
Another option would be to simply use geom_hline and geom_vline, although you might have a hard time removing the little bits that extend past the edges of the colored rectangles.
Related
I plotted a matrix using geom_tile. Then, I would like to add the track colors below the x-axis. I ran the following code from the similar topic answer (ggplot Adding Tracking Colors Below X-Axis), but it shows the error "Discrete value supplied to continuous scale".
sp <- c("sp1","sp1","sp1","sp2","sp2","sp2","sp3","sp3","sp3","sp4","sp4","sp4","sp5","sp5","sp5")
category <- c("a","b","c","a","b","c","a","b","c","a","b","c","a","b","c")
count <- c(1,2,1,1,4,2,3,1,3,1,4,5,2,5,1)
habitat <- c("A","A","A","B","B","B","C","C","C","A","A","A","B","B","B")
d <- data.frame(cbind(sp, category, count, habitat))
dm <- d %>%
select(sp, category, count)%>%
tidyr::pivot_wider(names_from = "sp", values_from = "count")%>%
replace(is.na(.),0)
dm <- as.matrix(dm[, -1]) # -1 to omit categories from matrix
clust <- hclust(dist(t(dm)), method = "single")
dmc <- data.frame(x = factor(d$sp), colour = factor(d$habitat))
my_fill <- scale_fill_gradient(low="grey90", high="red",
breaks=c(0,5,10,15,20, 25, 30),
rescale=function(x, ...) scales::rescale(x, from=c(0, 30)),
limits=c(0,30))
ggplot(d, aes(category, sp))+
geom_tile(aes(fill = as.numeric(count)))+
my_fill +
scale_y_discrete(limits = colnames(dm)[clust$order])+
geom_tile(data=dmc, aes(x = x, y = 1, fill = colour))
Here is one potential solution:
library(tidyverse)
library(ggpubr)
sp <- c("sp1","sp1","sp1","sp2","sp2","sp2","sp3","sp3","sp3","sp4","sp4","sp4","sp5","sp5","sp5")
category <- c("a","b","c","a","b","c","a","b","c","a","b","c","a","b","c")
count <- c(1,2,1,1,4,2,3,1,3,1,4,5,2,5,1)
habitat <- c("A","A","A","B","B","B","C","C","C","D","D","D","E","E","E")
d <- data.frame(cbind(sp, category, count, habitat))
dm <- d %>%
select(sp, category, count)%>%
tidyr::pivot_wider(names_from = "sp", values_from = "count")%>% #clusterで並び替え
replace(is.na(.),0)
dm <- as.matrix(dm[, -1]) # -1 to omit categories from matrix
clust <- hclust(dist(t(dm)), method = "single")
dmc <- data.frame(x = factor(d$sp), colour = factor(d$sp))
my_fill <- scale_fill_gradient(low="grey90", high="red",
breaks=c(0,5,10,15,20, 25, 30),
rescale=function(x, ...) scales::rescale(x, from=c(0, 30)),
limits=c(0,30))
plot1 <- ggplot(d, aes(category, sp))+
geom_tile(aes(fill = as.numeric(count)))+
my_fill +
scale_y_discrete(limits = colnames(dm)[clust$order]) +
theme(legend.position = "right")
plot2 <- ggplot(dmc) +
geom_tile(aes(x = 1, y = x, fill = colour)) +
theme_void() +
scale_fill_manual(values = viridis::viridis(5)) +
theme(legend.position = "none")
ggarrange(plot2, plot1, nrow = 1, widths = c(0.25, 10), align = "hv")
I want to add a line on the top and bottom of my plots (bottom line below the x label and axis) created using ggplot2. So far I have added a rectangle around the plot, but I do not want the lines on the sides.
x <- 1:10
y <- rnorm(10,mean = x)
df <- data.frame(x,y)
library(ggplot2)
ggplot(data = df, mapping = aes(x,y)) + geom_point() +
theme(plot.background = element_rect(size = 1, color = 'blue'))
I hope you guys have a solution.
Will something similar to this work?
x <- 1:10
y <- rnorm(10,mean = x)
df <- data.frame(x,y)
ggplot(data = df, mapping = aes(x,y)) + geom_point() +
annotate(geom = 'segment',
y = Inf,
yend = Inf,
x = -Inf,
xend = Inf,
size = 2) +
theme(axis.line.x = element_line(size = 1))
Not a perfect, but working solution. You have to plot huge "-" (size = 1000) outside plot area. This solution is not perfect as you have to manually adjust position of "-" on the y-axis.
df <- data.frame(x = 1:10, y = 1:10)
library(ggplot2)
ggplot(df, aes(x, y)) +
geom_point() +
# Y position adjusted manually
geom_text(aes(5, 2.9, label = "-"), color = "blue", size = 1000) +
# Y position adjusted manually
geom_text(aes(5, 21.2, label = "-"), color = "blue", size = 1000) +
# Plot outside plot area
coord_cartesian(ylim = c(0, 10), clip = "off")
I am not completely happy with the solution as I don't fully grasp
how to change the size of the lines
why they are not perfectly aligned with top and bottom when using patchwork::wrap_plots()
why it does not show the top line using ggpubr::ggarrange() or cowplot::plot_grid()
but based on this code, I suggest the following solution:
library(ggplot2)
df <- data.frame(x = 1:5, y = 1:5)
p <- ggplot(data = df) + aes(x, y) + geom_point()
top_line <- grid::grobTree(grid::linesGrob(x = grid::unit(c(0, 1), "npc"), y = grid::unit(1, "npc")))
bot_line <- grid::grobTree(grid::linesGrob(x = grid::unit(c(0, 1), "npc"), y = grid::unit(0, "npc")))
patchwork::wrap_plots(top_line, p, bot_line,
ncol = 1, nrow = 3,
heights = c(0, 1, 0))
ggpubr::ggarrange(top_line, p, bot_line,
ncol = 1, nrow = 3,
heights = c(0, 1, 0))
cowplot::plot_grid(top_line, p, bot_line,
ncol = 1, nrow = 3,
rel_heights = c(0, 1, 0))
Created on 2022-08-25 with reprex v2.0.2
I have searched and searched, but I cant seem to find an elegant way of doing this!
I have a dataset Data consisting of Data$x (dates) and Data$y (numbers from 0 to 1)
I want to plot them in a bar-chart:
ggplot(Data) + geom_bar(aes(x = x, y = y, fill = y, stat = "identity")) +
scale_fill_gradient2(low = "red", high = "green", mid = "yellow", midpoint = 0.90)
The result looks like this
However, I wanted to give each bar a gradient in the vertical direction ranging from 0 (red) to y (greener depending on y). Is there any way of doing this smoothly?
I have tried to see if I could impose a picture on the graph as a hack, but I can't impose it on the bars only except in a super super ugly way.
Another, not very pretty, hack using geom_segment. The x start and end positions (x and xend) are hardcoded (- 0.4; + 0.4), so is the size. These numbers needs to be adjusted depending on the number of x values and range of y.
# some toy data
d <- data.frame(x = 1:3, y = 1:3)
# interpolate values from zero to y and create corresponding number of x values
vals <- lapply(d$y, function(y) seq(0, y, by = 0.01))
y <- unlist(vals)
mid <- rep(d$x, lengths(vals))
d2 <- data.frame(x = mid - 0.4,
xend = mid + 0.4,
y = y,
yend = y)
ggplot(data = d2, aes(x = x, xend = xend, y = y, yend = yend, color = y)) +
geom_segment(size = 2) +
scale_color_gradient2(low = "red", mid = "yellow", high = "green",
midpoint = max(d2$y)/2)
A somewhat related question which may give you some other ideas: How to make gradient color filled timeseries plot in R
Doesn't exist as far as I know, but you can manipulate your data to produce it.
library(ggplot2)
df = data.frame(x=c(1:10),y=runif(10))
prepGradient <- function(x,y,spacing=max(y)/100){
stopifnot(length(x)==length(y))
df <- data.frame(x=x,y=y)
newDf = data.frame(x=NULL,y=NULL,z=NULL)
for (r in 1:nrow(df)){
n <- floor(df[r,"y"]/spacing)
for (s in c(1:n)){
tmp <- data.frame(x=df[r,"x"],y=spacing,z=s*spacing)
newDf <- rbind(newDf,tmp)
}
tmp <- data.frame(x=df[r,"x"],y=df[r,"y"]%%spacing,z=df[r,"y"])
newDf <- rbind(newDf,tmp)
}
return(newDf)
}
df2 <- prepGradient(df$x,df$y)
ggplot(df2,aes(x=x,y=y,fill=z)) +
geom_bar(stat="identity") +
scale_fill_gradient2(low="red", high="green", mid="yellow",midpoint=median(df$y))+
ggtitle('Vertical Gradient Example') +
theme_minimal()
Found a less hacky way to do this when answering Change ggplot bar chart fill colors
library(tidyverse)
df <- data.frame(value = c(20, 50, 90),
group = c(1, 2, 3))
df_expanded <- df %>%
rowwise() %>%
summarise(group = group,
value = list(0:value)) %>%
unnest(cols = value)
df_expanded %>%
ggplot() +
geom_tile(aes(
x = group,
y = value,
fill = value,
width = 0.9
)) +
coord_flip() +
scale_fill_viridis_c(option = "C") +
theme(legend.position = "none")
Because this did not explicitly ask for divergent / multi-hue scales (in the title), here a simple hack for a single-hue gradient. This is very much the approach like suggested for a gradient fill under a curve as seen here
library(ggplot2)
d <- data.frame(x = 1:3, y = 1:3)
n_grad <- 1000
grad_df <- data.frame(yintercept = seq(0, 3, len = 200),
alpha = seq(0.3, 0, len = 200))
ggplot(d ) +
geom_col(aes(x, y), fill = "darkblue") +
geom_hline(data = grad_df, aes(yintercept = yintercept, alpha = alpha),
size = 1, colour = "white", show.legend = FALSE) +
## white background looks nicer then
theme_minimal()
I used alphahull package to delineate dots on a map.
I plot the contours with a geom_segment.
My question is : how to fill the delineation given by the segment with a color ?
Here is a reproducible example :
set.seed(2)
dat <- data.frame(x = rnorm(20, 10, 5), y = rnorm(20, 20, 5), z = c(rep(1, 6), rep(2, 4)))
library(ggplot2)
library(alphahull)
alpha <- 100
alphashape1 <- ashape(dat[which(dat$z==1), c("x", "y")], alpha = alpha)
alphashape2 <- ashape(dat[which(dat$z==2), c("x", "y")], alpha = alpha)
map <- ggplot(dat, aes(x = x, y = y)) +
geom_point(data = dat, aes(x = x, y = y, colour = as.factor(dat$z))) +
geom_segment(data = data.frame(alphashape1$edges), aes(x = x1, y = y1, xend = x2, yend = y2, colour = levels(as.factor(dat$z))[1])) +
geom_segment(data = data.frame(alphashape2$edges), aes(x = x1, y = y1, xend = x2, yend = y2, colour = levels(as.factor(dat$z))[2]))
map
I believe this works w/o the need for graph ops:
fortify.ashape <- function(ashape_res) {
xdf <- data.frame(ashape_res$edges)
xdf <- do.call(
rbind,
lapply(1:nrow(xdf), function(i) {
rbind(
data.frame(x=xdf$x1[i], y=xdf$y1[i]),
data.frame(x=xdf$x2[i], y=xdf$y2[i])
)
})
)
xdf <- xdf[order(-1 * atan2(
xdf$y - mean(range(xdf$y)),
xdf$x - mean(range(xdf$x)))), c("x", "y")]
xdf <- rbind.data.frame(xdf[nrow(xdf),], xdf[1:(nrow(xdf)-1),])
xdf
}
alphashape1 <- ashape(dat[which(dat$z == 1), c("x", "y")], alpha = 15)
alphashape2 <- ashape(dat[which(dat$z == 2), c("x", "y")], alpha = 15)
ggplot() +
geom_point(data = dat, aes(x = x, y = y, colour = as.factor(dat$z))) +
geom_polygon(data=alphashape1, aes(x, y), fill="red", alpha=2/3) +
geom_polygon(data=alphashape2, aes(x, y), fill="blue", alpha=2/3)
This is because the ashape function only returns segments, not in any order.
The only way I found to reconstruct the order was by using the node information to form a graph and then find the shortest path along that graph.
A detailed example is here: https://rpubs.com/geospacedman/alphasimple - the code needs wrapping into a single function, which should be fairly easy to do. Once you have that order sorted, geom_polygon will draw it with filled shading in ggplot2.
Based on Spacedman's answer, I ordered separately the two sets of points and came up with this solution.
It could be optimized with a function that does it for each group automatically.
set.seed(2)
dat <- data.frame(x = rnorm(20, 10, 5), y = rnorm(20, 20, 5), z = c(rep(1, 6), rep(2, 4)))
library(ggplot2)
library(alphahull)
alpha <- 100
alphashape1 <- ashape(dat[which(dat$z==1), c("x", "y")], alpha = alpha)
alphashape2 <- ashape(dat[which(dat$z==2), c("x", "y")], alpha = alpha)
map <- ggplot(dat, aes(x = x, y = y)) +
geom_point(data = dat, aes(x = x, y = y, colour = as.factor(dat$z))) +
geom_segment(data = data.frame(alphashape1$edges), aes(x = x1, y = y1, xend = x2, yend = y2, colour = levels(as.factor(dat$z))[1])) +
geom_segment(data = data.frame(alphashape2$edges), aes(x = x1, y = y1, xend = x2, yend = y2, colour = levels(as.factor(dat$z))[2]))
map
alpha <- 15 # transparency argument
# First contour
alphashape1 <- ashape(dat[which(dat$z == 1), c("x", "y")], alpha = alpha)
alphashape1_ind <- alphashape1$edges[, c("ind1", "ind2")]
class(alphashape1_ind) = "character"
alphashape1_graph <- graph.edgelist(alphashape1_ind, directed = FALSE)
cut_graph1 <- alphashape1_graph - E(alphashape1_graph)[1] # Cut the first edge
ends1 <- names(which(degree(cut_graph1) == 1)) # Get two nodes with degree = 1
path1 <- get.shortest.paths(cut_graph1, ends1[1], ends1[2])$vpath[[1]]
path_nodes1 <- as.numeric(V(alphashape1_graph)[path1]$name)
# Second contour
alphashape2 <- ashape(dat[which(dat$z == 2), c("x", "y")], alpha = alpha)
alphashape2_ind <- alphashape2$edges[, c("ind1", "ind2")]
class(alphashape2_ind) = "character"
alphashape2_graph <- graph.edgelist(alphashape2_ind, directed = FALSE)
cut_graph2 <- alphashape2_graph - E(alphashape2_graph)[1] # Cut the first edge
ends2 <- names(which(degree(cut_graph2) == 1)) # Get two nodes with degree = 1
path2 <- get.shortest.paths(cut_graph2, ends2[1], ends2[2])$vpath[[1]]
path_nodes2 <- as.numeric(V(alphashape2_graph)[path2]$name)
# Updating of previous plot (see question)
map +
geom_polygon(data = dat[which(dat$z == 1), c("x", "y")][path_nodes1, ], aes(x = x, y = y),
fill = "red", colour = "red", size = 0.5, alpha = 0.3) +
geom_polygon(data = dat[which(dat$z == 2), c("x", "y")][path_nodes2, ],
aes(x = x, y = y), colour = "blue", fill = "blue", size = 0.5, alpha = 0.3)
I have a plot from the following script.
require(ggplot2)
df.shape <- data.frame(
AX = runif(10),
AY = runif(10),
BX = runif(10, 2, 3),
BY = runif(10, 2, 3)
)
p <- ggplot(df.shape)
p <- p + geom_point(aes(x = AX, y = AY, shape = 15)) +
geom_point(aes(x = BX, y = BY, shape = 19)) +
scale_shape_identity() +
guides(shape = guide_legend(override.aes = list(shape = 15, shape = 19)) )
print(p)
This doesn't produce a legend, describing which shape is "A" and which shape is "B". Note that the squares and circles may be close to one another, so I can't generally define the variable based on location. How do I display a "shape" legend?
I would reshape my data in the long format using reshape:
dt <- reshape(df.shape ,direction='long', varying=list(c(1, 3), c(2, 4)),
,v.names = c('X','Y'), times = c('A','B'))
Then I plot it simply like this
ggplot(dt) +
geom_point(aes(x = X, y = Y, shape = time),size=5) +
scale_shape_manual(values=c(15,19))