I'm making a heatmap in R using ggplot2 and I want to change the size of my tiles because the text in my heatmap doesn't fit in the cells. Below is my data and attempted plots.
library("ggplot2")
s = sprintf("dataset number %s", 1:9)
vars = sprintf("many many words here, here and here %s", 1:6)
data = data.frame(s = rep(s, 6), stringsAsFactors = FALSE)
data$variable = rep(vars, rep.int(9, 6))
data$variable = as.factor(data$variable)
data$value = rep.int(-1000, 54)
data$font = "plain"
for(v in (unique(data$s))) {
ids = which(data$s %in% "dataset number 1")
vals = data[ids, ]
row = rownames(vals[vals$value %in% max(vals$value, na.rm = TRUE), ])
data[row, ]$font = "bold"
}
I'm making a heatmap like this
title = "Heatmap"
cbbPalette = list(grey = "#999999", black = "#000000", orange = "#E69F00", sky = "#56B4E9", green = "#009E73", yellow = "#F0E442", blue = "#0072B2", darko = "#D55E00",
pink = "#CC79A7")
pdf(sprintf("./heatmap.pdf"))
heatmap = ggplot(data = data, aes(x = variable, y = s, fill = value)) +
geom_tile(color = "black") +
scale_fill_gradient2(low = cbbPalette$pink, high = cbbPalette$green, mid = cbbPalette$grey,
midpoint = 0, limit = c(-100,100), space = "Lab",
name=title) +
scale_x_discrete(limits = levels(data$variable)) +
geom_vline(xintercept = 6 - 0.5, color = "white", size = 1) +
geom_vline(xintercept = 2 + 0.5, color = "white", size = 1) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, vjust = 1,
size = 16, hjust = 1), legend.title = element_text(size = 18),
axis.text.y = element_text(size = 16)) +
coord_fixed()
#add numbers to cells
heatmap = heatmap + geom_text(aes(x = variable, y = s, label = value, fontface = font), color = cbbPalette$black, size = 3) +
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.major = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
legend.justification = c(0.5, 0),
legend.direction = "horizontal",
legend.position = "top") +
guides(fill = guide_colorbar(barwidth = 7, barheight = 1,
title.position = "top", title.hjust = 0.5))
# Print the heatmap
print(heatmap)
dev.off()
And I get the following result -- heatmap
Other SO posts suggested to change width and height within geom_tile, but I get the following result:
heatmap = ggplot(data = data, aes(x = variable, y = s, fill = value)) +
geom_tile(color = "black", aes(width = 2L)) + ...
wrong_heatmap
I also tried changing height in geom_tile as well as coord_fixed(ratio = 1L) but without any success.
Also, I know that I can simply change the size of the text and numbers will fit, but I need to keep the font size the same. I can also shorten the labels but assume this is not an option.
I would appreciate any help with this.
Related
I have a 100% stacked bar chart that displays 3 types of variable. I've set a example db so I could create a graph more easily.
I've already adjust the chart with the colors and information I need. But I'm not being able to independently position the labels. Here's the current code and output.
Code:
(empilhado<-ggplot(dfm, aes(y = Year, x = abs(value), fill = variable)) +
scale_x_continuous(sec.axis = sec_axis(trans = ~.*1, name="Trab."), expand=expansion(mult=c(0,0.05)))+
geom_col(data = rotulo, aes(y = Year, x=abs(trabalho), fill=NULL), width = .7, colour="black", lwd=0.1, position = "fill", orientation = "y") +
geom_label(data = rotulo, aes(y= Year, x = abs(trabalho), fill=NULL, label=paste(format(round(trabalho, digits=0), nsmall=0, decimal.mark=",", big.mark="."),
format(round(aprovado, digits=0), nsmall=0, decimal.mark=",", big.mark="."))
), color="black", size=4, position = position_fill(vjust=1.06)) +
geom_col(width = .7, colour="black", lwd=0.1, position = "fill", orientation = "y") +
geom_text(aes(label=format(round(value, digits=0), nsmall=0, decimal.mark=",", big.mark=".")),
size=4, color="white", position = position_fill(vjust=0.5)) +
theme(panel.grid.major = element_line(colour = "gray90",size=0.75), panel.grid.minor = element_line(colour = "gray90",size=0.75),
legend.position="top", axis.text.x = element_blank(), axis.ticks.x = element_blank(),
axis.title.x = element_blank(), panel.background = element_blank())+
scale_fill_manual(values = c("#000000","tomato","blue"))
Output:
How is it now? Position_fill(vjust=0.5), so all the labels are centered inside its respective bar.
What I want? To be able to set the position of the 'Marionete' label on the left(like a vjust=0 would do), keep the 'Pedido' label as is (in the center of the 'Pedido' stacked bar) and place the 'Fatura' label on the right (like a vjust=1 would do).
Thanks in advance!
One option to achieve your desired result would be to compute/set the positions for each label and the horizontal alignment manually instead of making use of position="fill":
Making use of some random mock data:
library(ggplot2)
library(dplyr)
dfm <- dfm %>%
group_by(Year) %>%
arrange(desc(variable)) %>%
mutate(
pct = value / sum(value),
x_label = case_when(
variable == "Marionete" ~ 0,
variable == "Pedido" ~ .5 * (cumsum(pct) + lag(cumsum(pct))),
TRUE ~ 1
),
hjust = case_when(
variable == "Marionete" ~ 0,
variable == "Pedido" ~ .5,
TRUE ~ 1
)
)
ggplot(dfm, aes(y = Year, x = abs(value), fill = variable)) +
scale_x_continuous(sec.axis = sec_axis(trans = ~ . * 1, name = "Trab."), expand = expansion(mult = c(0, 0.05))) +
geom_col(width = .7, colour = "black", lwd = 0.1, position = "fill", orientation = "y") +
geom_text(aes(x = x_label, label = format(round(value, digits = 0), nsmall = 0, decimal.mark = ",", big.mark = "."), hjust = hjust),
size = 4, color = "white"
) +
theme(
panel.grid.major = element_line(colour = "gray90", size = 0.75), panel.grid.minor = element_line(colour = "gray90", size = 0.75),
legend.position = "top", axis.text.x = element_blank(), axis.ticks.x = element_blank(),
axis.title.x = element_blank(), panel.background = element_blank()
) +
scale_fill_manual(values = c("#000000", "tomato", "blue"))
DATA
set.seed(123)
dfm <- data.frame(
Year = rep(c(2006:2016), each = 3),
value = sample(1:100, 3 * 11, replace = TRUE),
variable = c("Fatura", "Pedido", "Marionete")
)
dfm$variable <- factor(dfm$variable, levels = c("Fatura", "Pedido", "Marionete"))
dfm$Year <- factor(dfm$Year)
I'm making a heatmap in R using ggplot2 and I want to dynamically change the value of midpoint for scale_fill_gradient2. I want the midpoint for every row to be the maximum of v1 and v2.
Here's the original plot and data:
library(ggplot2)
set.seed(1L)
s = sprintf("d%s", 1:9)
vars = sprintf("v%s", 1:6)
data = data.frame(s = rep(s, 6), stringsAsFactors = FALSE)
data$variable = rep(vars, rep.int(9, 6))
data$variable = as.factor(data$variable)
data$value = round(runif(54, min=-100, max=100), 1)
pdf(save)
heatmap = ggplot(data = data, aes(x = variable, y = s, fill = value)) +
geom_tile(color = "black", aes(width = 1)) +
scale_fill_gradient2(low = cbbPalette$pink, high = cbbPalette$green, mid = cbbPalette$grey,
midpoint = 0, space = "Lab",
name = title) +
scale_color_discrete("exps", data$variable) +
theme_minimal() +
theme(axis.text.x = element_text(vjust = 1,
size = title.size), legend.title = element_blank(),
axis.text.y = element_text(size = title.size),
strip.text.x = element_text(size = title.size)) +
coord_fixed()
#add numbers to cells
heatmap = heatmap + geom_text(aes(x = variable, y = s, label = value), color = cbbPalette$black, size = 3) +
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.major = element_blank(),
panel.border = element_blank(),
panel.background = element_blank(),
axis.ticks = element_blank(),
legend.justification = c(0.5, 0),
legend.direction = "horizontal",
legend.position = "top") +
guides(fill = guide_colorbar(barwidth = 7, barheight = 1,
title.position = "top", title.hjust = 0.5))
# Print the heatmap
print(heatmap)
dev.off()
I tried to change midpoint by taking max of v1 and v2 but that affects all rows instead each row separately.
scale_fill_gradient2(low = cbbPalette$pink, high = cbbPalette$green, mid = cbbPalette$grey,
midpoint = data[data$variable == "v1", "value"], space = "Lab",
name = title)
Scales don't really work that way, as they map a range of values to a set of colours. Consequentially, a particular colour means a particular value for the whole plot. My best advice would be to pre-normalise the data by subtracting the max of v1/v2. See example in code below (there were a few variables in your example but not in the shared code which I've subsituted).
library(ggplot2)
library(tidyverse)
set.seed(1L)
s = sprintf("d%s", 1:9)
vars = sprintf("v%s", 1:6)
data = data.frame(s = rep(s, 6), stringsAsFactors = FALSE)
data$variable = rep(vars, rep.int(9, 6))
data$variable = as.factor(data$variable)
data$value = round(runif(54, min=-100, max=100), 1)
new_data <- data %>% group_by(s) %>%
mutate(value = value - max(value[variable %in% c("v1", "v2")]))
ggplot(data = new_data, aes(x = variable, y = s, fill = value)) +
geom_tile(color = "black", aes(width = 1)) +
scale_fill_gradient2(low = "pink", high = "green", mid = "grey",
midpoint = 0, space = "Lab",
name = "title") +
scale_color_discrete("exps", data$variable) +
theme_minimal() +
coord_fixed()
This question already has answers here:
Remove 'a' from legend when using aesthetics and geom_text
(6 answers)
Closed 3 years ago.
How can I change the filling of each key in the legend to match the labels?
If I do it in geom_label_repel using show.legend = TRUE it doesn't look very good and it puts a letter "a" in place of dots.
Yellow is for injured players, blue for owned players, green for free players and red for hobbits players.
Here's the code used for the plot:
ggplot(fim, aes(Price, Average,
label = Player,
colour = color,
fill = color,
#alpha = ih,
group = Position
)) +
geom_smooth(method = "lm", se = FALSE, color = "lightblue", show.legend = FALSE) +
geom_point(aes(fill = factor(color))) + #
geom_label_repel(size = 3.25,
family = "Bahnschrift",
#fontface = 'bold',
label.size = NA,
segment.alpha = 0.5,
alpha = 0.9,
show.legend = FALSE,
#label.padding = unit(.22, 'lines'),
#hjust = 0,
#vjust = 0,
#label.r = 0,
box.padding = unit(0.20, "lines"),
point.padding = unit(0.20, "lines"),
#force = 4
) +
#nudge_y = 0.005,
#nudge_x = 0) +
scale_x_continuous(labels=function(y) format(y, big.mark = ".", scientific = FALSE)) +
ggtitle("Price and Average Points in LaLiga Fantasy",
paste("Top", nrow(fim), pos, "by market value with at least", minapps, "appearances, excluding Messi & Benzema")) +
labs(y="Average Points (Sofascore Rating System)",
x = "Price (Market Value in Euros)",
caption = "Sources: Biwenger, Jornada Perfecta plot by Weldata") +
scale_color_manual(values = c("Hobbits" = WT,
"Free" = WT,
"Injured" = BK,
"Owned" = WT)) +
scale_fill_manual(values = c("Hobbits" = cl,
"Free" = MF,
"Injured" = GK,
"Owned" = DF)) +
scale_alpha(0.1) +
dark_theme_gray() +
theme(plot.title = element_text(family = "Bahnschrift",
face = "bold",
size = 18,
colour = YL),
plot.background = element_rect(fill = BK),
panel.background = element_blank(),
panel.grid.major = element_line(color = "grey30", size = 0.2),
panel.grid.minor = element_line(color = "grey30", size = 0.2),
legend.title = element_blank(),
#legend.background = element_blank(),
axis.ticks = element_line(colour = "grey30"),
axis.title = element_text(family = "Bahnschrift", size = 14, colour = WT),
axis.text = element_text(size = 12, colour = "grey80", face = 'bold'),
legend.position = c(0.9, 0.2), #legend.position = "none",
plot.tag = element_text(),
plot.caption = element_text(color = YL, face = "italic")
)
You can use show.legend=F in geom_label_repel
library(ggrepel)
set.seed(42)
dat <- subset(mtcars, wt > 2.75 & wt < 3.45)
dat$car <- rownames(dat)
# your problem:
p <- ggplot(dat, aes(wt, mpg, label = car)) +
geom_point(aes(color=car))+
geom_label_repel(aes( fill=car)) +
labs(title = "geom_text_repel()")
p
#Answer:
p <- ggplot(dat, aes(wt, mpg, label = car)) +
geom_point(aes(color=car))+
geom_label_repel(aes( fill=car), show.legend = F) +
labs(title = "geom_text_repel()")
p
I have produced some nice plots with the plotLearnerPrediction function of the MLR package. I was able to make some adjustments to the returned ggplot (see my code below). But I am not sure how to make the last adjustment. Namely, I want to change the coloring of the data points based on labels (groups in example plot).
My last plot (with black data points)
Another produced plot (overlapping data points)
This is the last version of my code (normally part of a for loop):
plot <- plotLearnerPrediction(learner = learner_name, task = tasks[[i]], cv = 0,
pointsize = 1.5, gridsize = 500) +
ggtitle(trimws(sprintf("Predictions %s %s", meta$name[i], meta$nr[i])),
subtitle = sprintf("DR = %s, ML = %s, CV = LOO, ACC = %.2f", meta$type[i],
toupper(strsplit(learner_name, "classif.")[[1]][2]), acc[[i]])) +
xlab(sprintf("%s 1", lab)) +
ylab(sprintf("%s 2", lab)) +
scale_fill_manual(values = colors) +
theme(plot.title = element_text(size = 18, face = "bold"),
plot.subtitle = element_text(size = 12, face = "bold", colour = "grey40"),
axis.text.x = element_text(vjust = 0.5, hjust = 1),
axis.text = element_text(size = 14, face = "bold"),
axis.title.x = element_text(vjust = 0.5),
axis.title = element_text(size = 16, face = "bold"),
#panel.grid.minor = element_line(colour = "grey80"),
axis.line.x = element_line(color = "black", size = 1),
axis.line.y = element_line(color = "black", size = 1),
panel.grid.major = element_line(colour = "grey80"),
panel.background = element_rect(fill = "white"),
legend.justification = "top",
legend.margin = margin(l = 0),
legend.title = element_blank(),
legend.text = element_text(size = 14))
Below is a part of the source code of the plotLearnerPrediction function. I want to overrule geom_point(colour = "black"). Adding simply geom_point(colour = "pink") to my code will not color data points, but the whole plot. Is there a solution to overrule that code with a vector of colors? Possibly a change in the aes() is also needed to change colors based on groups.
else if (taskdim == 2L) {
p = ggplot(mapping = aes_string(x = x1n, y = x2n))
p = p + geom_tile(data = grid, mapping = aes_string(fill = target))
p = p + scale_fill_gradient2(low = bg.cols[1L], mid = bg.cols[2L],
high = bg.cols[3L], space = "Lab")
p = p + geom_point(data = data, mapping = aes_string(x = x1n,
y = x2n, colour = target), size = pointsize)
p = p + geom_point(data = data, mapping = aes_string(x = x1n,
y = x2n), size = pointsize, colour = "black",
shape = 1)
p = p + scale_colour_gradient2(low = bg.cols[1L],
mid = bg.cols[2L], high = bg.cols[3L], space = "Lab")
p = p + guides(colour = FALSE)
}
You can always hack into gg objects. The following works for ggplot2 2.2.1 and adds a manual alpha value to all geom_point layers.
library(mlr)
library(ggplot2)
g = plotLearnerPrediction(makeLearner("classif.qda"), iris.task)
ids.geom.point = which(sapply(g$layers, function(z) class(z$geom)[[1]]) == "GeomPoint")
for(i in ids.geom.point) {
g$layers[[i]]$aes_params$alpha = 0.1
}
g
The plotLearnerPrediction() function returns the ggplot plot object, which allows for some level of customization without having to modify the source code. In your particular case, you can use scale_fill_manual() to set custom fill colors:
library(mlr)
g = plotLearnerPrediction(makeLearner("classif.randomForest"), iris.task)
g + scale_fill_manual(values = c("yellow", "orange", "red"))
I am having trouble printing a plot from ggplot to plotly, and maintaining a good text position.
Data example:
library(ggplot2)
library(plotly)
library(dplyr)
library(reshape2)
#mock data
df1 <- data.frame(
Gruppering2 = factor(c("Erhverv Erhverv Salg","Erhverv Erhverv Salg","Erhverv Erhverv Salg")),
periode = factor(c("Denne maaned","Denne uge", "I gaard")),
Answer_rate = c(0.01,0.4,0.7),
SVL = c(0.40,0.43,0.67),
over_180 = c(0.5,0.7,0.3)
)
#color
plotCol <- c( rgb(44,121,91, maxColorValue = 255), rgb(139,0,0, maxColorValue = 255),rgb(0,0,139, maxColorValue = 255))
#plot code
dfpct <- melt(df1[,c(2,3,4,5)], id.vars = "periode",
measure.vars = c( "Answer_rate","SVL", "over_180"),
variable.name = "P", value.name = "value")
dfpct <- na.omit(dfpct)
pct <- ggplot(dfpct, aes(x = periode, y = value, fill = P, group = P, width = 0.6)) +
geom_bar(stat = "identity", position="dodge", colour = "black", width = 0.7, show.legend = FALSE) +
labs(x = NULL, y = "Calls") +
#ggtitle("Forecast Error") +
theme_bw() +
theme(panel.grid.major = element_blank(),
plot.title = element_text(size = rel(1.2), face = "bold", vjust = 1.5),
axis.title = element_text(face = "bold"),
axis.text = element_text(),
legend.position = "bottom",
legend.direction = "vertical",
legend.key.width = unit(2, "lines"),
legend.key.height = unit(0.5, "lines"),
legend.title = element_blank()) +
geom_text(aes(label=paste(value*100,"%",sep="")), position = position_dodge(width=0.6), vjust = -0.5 ) +
scale_fill_manual(values = plotCol)
pct # the is perfectly located above
ggplotly(pct, textposition = 'top center') # text crosses over the bars
As you can see - the ggplot works excellent - however when I convert to plotly, the text is moved. I've tried playing around with various settings in both ggplot and plotly, but no luck yet.
Looks like vjust is not recognized but maybe on the roadmap. From GitHub:
# convert ggplot2::element_text() to plotly annotation
make_label <- function(txt = "", x, y, el = ggplot2::element_text(), ...) {
if (is_blank(el) || is.null(txt) || nchar(txt) == 0 || length(txt) == 0) {
return(NULL)
}
angle <- el$angle %||% 0
list(list(
text = txt,
x = x,
y = y,
showarrow = FALSE,
# TODO: hjust/vjust?
ax = 0,
ay = 0,
font = text2font(el),
xref = "paper",
yref = "paper",
textangle = -angle,
...
))
}
Easiest approach might be to assign the y value in geom_text, but you'll lose some scaling in the height.
pct <- ggplot(dfpct, aes(x = periode, y = value, fill = P, group = P, width = 0.6)) +
geom_bar(stat = "identity", position="dodge", colour = "black", width = 0.7, show.legend = FALSE) +
labs(x = NULL, y = "Calls") +
theme_bw() +
theme(panel.grid.major = element_blank(),
plot.title = element_text(size = rel(1.2), face = "bold", vjust = 1.5),
axis.title = element_text(face = "bold"),
axis.text = element_text(),
legend.position = "bottom",
legend.direction = "vertical",
legend.key.width = unit(2, "lines"),
legend.key.height = unit(0.5, "lines"),
legend.title = element_blank()) +
geom_text(aes(label=paste(value*100,"%",sep=""), y = value+0.01), position = position_dodge(width = 0.6)) +
scale_fill_manual(values = plotCol)
ggplotly(pct)
Alternatively, if you know the dimensions of the final output, you could edit the components of a plotly_build object:
gg <- plotly_build(pct)
gg$data[[4]]$y <- gg$data[[4]]$y+0.006
gg$data[[5]]$y <- gg$data[[5]]$y+0.006
gg$data[[6]]$y <- gg$data[[6]]$y+0.006
I had the same issue, I solved it by adding a value to the y axis, but in order to avoid the scaling issue, I added a percentage of the minimum. You can adjust it depending upon your data itself. I hope it helps:
geom_text(aes(label=paste(value*100,"%",sep=""), y = value+0.1*min(value), position = position_dodge(width = 0.6))