Different point shapes with ggplot2 in R - ggplot2

I want to show my points as shape 1 (center point) and shape 2 (all other points) and after than add a legend of these two shapes.
My codes are below
dd <- read.table(text="
dates NB
15.05.2018 41
8.06.2018 81
20.06.2018 51
02.07.2018 0
14.07.2018 -1
7.08.2018 49
19.08.2018 112
12.09.2018 32
17.12.2018 -4", header=T, stringsAsFactors=FALSE)
dd$dates <- as.Date(dd$dates, "%d.%m.%Y")
library(ggplot2)
center <- subset(dd, dates=="2018-07-02")
ggplot(dd, aes(dates, NB, xend = center$dates, yend = center$NB)) +
geom_segment(color="black") +
geom_point(shape=1, fill="blue", color="black", size=2) +
ylim(-100,150) +
ylab("Normal Baseline [m]") +
xlab("") +
theme_linedraw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
) +
scale_x_date(breaks = dd$dates)
This is the result i expect to achieve:
How can I do? Thank you.

I would think about this by adding a column to your data.frame so you can use it as an aesthetic in the ggplot call. Something like this:
library(ggplot2)
dd <- read.table(text="
dates NB
15.05.2018 41
8.06.2018 81
20.06.2018 51
02.07.2018 0
14.07.2018 -1
7.08.2018 49
19.08.2018 112
12.09.2018 32
17.12.2018 -4", header=T, stringsAsFactors=FALSE)
dd$dates <- as.Date(dd$dates, "%d.%m.%Y")
#Add point as a column to dd so you can add it as an aesthetic
dd$point <- ifelse(dd$dates == "2018-07-02", "Center Point", "Other Points")
ggplot(dd, aes(dates, NB, colour = point, shape = point)) +
geom_segment(aes(xend = dd[point == "Center Point","dates"],
yend = dd[point == "Center Point","NB"]),
colour = "black") +
geom_point() +
ylim(-100,150) +
ylab("Normal Baseline [m]") +
xlab("") +
scale_colour_manual("", values = c("Center Point" = "red", "Other Points" = "black")) +
scale_shape_manual("", values = c("Center Point" = 1, "Other Points" = 2)) +
theme_linedraw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.position = c(.8, .8)) +
scale_x_date(breaks = dd$dates)
Created on 2020-05-04 by the reprex package (v0.3.0)

Related

Mismatch when using ggplot2 with a geom_point conditional fill

I am trying to have a white fill, for models where the p.fdr variable is <0.05.
However, the code I have written, is not modifying the correct point (the blue estimate should have a white fill not the pink estimate, as pictured below).
Example code:
conf.low <- sort(runif(6, min = 0, max = 1))
conf.high <- sort(runif(6, min = conf.low[1], max = 1))
estimate <- (conf.low + conf.high) / 2
forestplot <- data.frame(
outcome = c("mean_ssrt_0","mean_ssrt_0", "strp_scr_mnrt_congr", "strp_scr_mnrt_congr", "nihtbx_picvocab_theta_0","nihtbx_picvocab_theta_0"),
measure = c("Stop-Signal Task", "Stop-Signal Task","Emotional Word-Emotional Face Stroop", "Emotional Word-Emotional Face Stroop","NIH Toolbox® Cognition Battery", "NIH Toolbox® Cognition Battery" ),
a_model = c("1", "2", "1", "2", "1", "2"),
conf.low = conf.low,
conf.high = conf.high,
estimate = estimate,
p.fdr = runif(6, min = 0.05 / 1.3, max = 0.1))
forestplot$outcome <- factor(forestplot$outcome, levels=c('mean_ssrt_0', 'strp_scr_mnrt_congr', 'nihtbx_picvocab_theta_0'),
labels=c("Mean SSRT", "RT", "PVT \n (Theta)"))
forestplot$measure <- factor(forestplot$measure, levels=c('Stop-Signal Task',
'Emotional Word-Emotional Face Stroop',
'NIH Toolbox® Cognition Battery'))
forestplot$a_model <- factor(forestplot$a_model , levels=c("1","2"))
forestplot <- forestplot %>% arrange(measure, outcome,a_model, estimate, conf.low, conf.high)
plots <- forestplot %>%
split(.$measure) %>%
map2(.,names(.), ~ggplot(.x, aes(x = outcome, y =estimate, ymin =conf.low, ymax = conf.high,fill = as.factor(measure))) +
geom_pointrange(aes(color=a_model, shape = a_model), size=0.5, position=position_dodge2(width=0.5, reverse = TRUE), show.legend = F)+ # add group
geom_point(aes(shape = a_model), size=1.5, alpha = ifelse(.x$p.fdr < 0.05, 1, 0), position=position_dodge2(width=0.5, reverse = TRUE), show.legend = F, color="white") +
geom_hline(yintercept = 0, linetype = 'dashed', col = 'black') +
scale_y_continuous(limits = c(-0.1, 1))+
coord_flip() +
xlab('')+
ylab(expression(atop("Est. mean change (in SD units with 95% CI)", paste("per 1 SD increase in gPFS"^"lowDA"))))+
ggtitle(.y)+
theme_minimal(base_size = 11)+
guides(fill = "none") +
scale_color_manual(labels = c("Model 1", "Model 2"), values = c("#00B8E7", "#F8766D")) +
labs(color="Model")+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title.position = "plot",
plot.title = element_text(size = 10,face="bold"), text = element_text(size = 10)))
plot <-plot_grid(plots$`Stop-Signal Task`+ ggtitle(bquote(bold(~ "Stop-Signal Task" ~ '')))+ theme(legend.position = "none", axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_blank(),axis.line.y = element_line(color="black", size = 0.5)),
plots$`Emotional Word-Emotional Face Stroop` + ggtitle(bquote(bold(~ 'Stroop - EWEFS' ~ ''))) + theme(legend.position = "none", axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_blank(),axis.line.y = element_line(color="black", size = 0.5)),
plots$`NIH Toolbox® Cognition Battery` + ggtitle(bquote(bold(~ "NIH Toolbox\U00AE" ~ ''))) + theme(legend.position = "none", axis.ticks.x = element_line(color="black", size = 0.5), axis.line.x = element_line(color="black", size = 0.5),axis.line.y = element_line(color="black", size = 0.5)),
ncol = 1, nrow=3, rel_heights = c(1,1,1), align = 'v') # add 1 col and then the number of rows = to number of plots
plot
I have tried arranging the ordering the original dataframe but, it doesn't solve the problem.
forestplot <- forestplot %>% arrange(measure, outcome, a_model, estimate, conf.low, conf.high)
Is it okay if instead of white fill, it's just transparent? You can control that through the shape argument. It also simplifies the code a little bit. This is how you would modify your plots object:
plots <- forestplot %>%
mutate(
shape = if_else(a_model == 1 & p.fdr < 0.05, "hollow_circle",
if_else(a_model == 1 & p.fdr >= 0.05, "filled_circle",
if_else(a_model == 2 & p.fdr < 0.05, "hollow_triangle", "filled_triangle")))
) %>%
split(.$measure) %>%
map2(.,names(.), ~ggplot(.x, aes(x = outcome, y = estimate, ymin = conf.low, ymax = conf.high, shape = shape, color = a_model)) +
geom_pointrange(size = 0.5, position = position_dodge2(width = 0.5, reverse = TRUE), show.legend = F) + # add group
geom_hline(yintercept = 0, linetype = 'dashed', col = 'black') +
scale_y_continuous(limits = c(-0.1, 1)) +
scale_shape_manual(values = c("filled_circle" = 16, "hollow_triangle" = 2, "hollow_circle" = 1, "filled_triangle" = 17)) +
coord_flip() +
xlab('')+
ylab(expression(atop("Est. mean change (in SD units with 95% CI)", paste("per 1 SD increase in gPFS"^"lowDA"))))+
ggtitle(.y)+
theme_minimal(base_size = 11)+
guides(fill = "none") +
scale_color_manual(values = c("1" = "#00B8E7", "2" = "#F8766D")) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title.position = "plot",
plot.title = element_text(size = 10,face="bold"), text = element_text(size = 10)))

Start ggplot continuous axis with a squiggly line break? [duplicate]

I have a dataframe (dat) with two columns 1) Month and 2) Value. I would like to highlight that the x-axis is not continuous in my boxplot by interrupting the x-axis with two angled lines on the x-axis that are empty between the angled lines.
Example Data and Boxplot
library(ggplot2)
set.seed(321)
dat <- data.frame(matrix(ncol = 2, nrow = 18))
x <- c("Month", "Value")
colnames(dat) <- x
dat$Month <- rep(c(1,2,3,10,11,12),3)
dat$Value <- rnorm(18,20,2)
ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_bw() +
theme(panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "black"),
axis.text.y = element_text(size = 14, color = "black"))
The ideal figure would look something like below. How can I make this discontinuous axis in ggplot?
You could make use of the extended axis guides in the ggh4x package. Alas, you won't easily be able to create the "separators" without a hack similar to the one suggested by user Zhiqiang Wang
guide_axis_truncated accepts vectors to define lower and upper trunks. This also works for units, by the way, then you have to pass the vector inside the unit function (e.g., trunc_lower = unit(c(0,.45), "npc") !
library(ggplot2)
library(ggh4x)
set.seed(321)
dat <- data.frame(matrix(ncol = 2, nrow = 18))
x <- c("Month", "Value")
colnames(dat) <- x
dat$Month <- rep(c(1,2,3,10,11,12),3)
dat$Value <- rnorm(18,20,2)
# this is to make it slightly more programmatic
x1end <- 3.45
x2start <- 3.55
p <-
ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_classic() +
theme(axis.line = element_line(colour = "black"))
p +
guides(x = guide_axis_truncated(
trunc_lower = c(-Inf, x2start),
trunc_upper = c(x1end, Inf)
))
Created on 2021-11-01 by the reprex package (v2.0.1)
The below is taking user Zhiqiang Wang's hack a step further. You will see I am using simple trigonometry to calculate the segment coordinates. in order to make the angle actually look as it is defined in the function, you would need to set coord_equal.
# a simple function to help make the segments
add_separators <- function(x, y = 0, angle = 45, length = .1){
add_y <- length * sin(angle * pi/180)
add_x <- length * cos(angle * pi/180)
## making the list for your segments
myseg <- list(x = x - add_x, xend = x + add_x,
y = rep(y - add_y, length(x)), yend = rep(y + add_y, length(x)))
## this function returns an annotate layer with your segment coordinates
annotate("segment",
x = myseg$x, xend = myseg$xend,
y = myseg$y, yend = myseg$yend)
}
# you will need to set limits for correct positioning of your separators
# I chose 0.05 because this is the expand factor by default
y_sep <- min(dat$Value) -0.05*(min(dat$Value))
p +
guides(x = guide_axis_truncated(
trunc_lower = c(-Inf, x2start),
trunc_upper = c(x1end, Inf)
)) +
add_separators(x = c(x1end, x2start), y = y_sep, angle = 70) +
# you need to set expand to 0
scale_y_continuous(expand = c(0,0)) +
## to make the angle look like specified, you would need to use coord_equal()
coord_cartesian(clip = "off", ylim = c(y_sep, NA))
I think it is possible to get what you want. It may take some work.
Here is your graph:
library(ggplot2)
set.seed(321)
dat <- data.frame(matrix(ncol = 2, nrow = 18))
x <- c("Month", "Value")
colnames(dat) <- x
dat$Month <- rep(c(1,2,3,10,11,12),3)
dat$Value <- rnorm(18,20,2)
p <- ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_bw() +
theme(panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "black"),
axis.text.y = element_text(size = 14, color = "black"))
Here is my effort:
p + annotate("segment", x = c(3.3, 3.5), xend = c(3.6, 3.8), y = c(14, 14), yend = c(15, 15))+
coord_cartesian(clip = "off", ylim = c(15, 25))
Get something like this:
If you want to go further, it may take several tries to get it right:
p + annotate("segment", x = c(3.3, 3.5), xend = c(3.6, 3.8), y = c(14, 14), yend = c(15, 15))+
annotate("segment", x = c(0, 3.65), xend = c(3.45, 7), y = c(14.55, 14.55), yend = c(14.55, 14.55)) +
coord_cartesian(clip = "off", ylim = c(15, 25)) +
theme_classic()+
theme(axis.line.x = element_blank())
Just replace axis with two new lines. This is a rough idea, it may take some time to make it perfect.
You could use facet_wrap. If you assign the first 3 months to one group, and the other months to another, then you can produce two plots that are side by side and use a single y axis.
It's not exactly what you want, but it will show the data effectively, and highlights the fact that the x axis is not continuous.
dat$group[dat$Month %in% c("1", "2", "3")] <- 1
dat$group[dat$Month %in% c("10", "11", "12")] <- 2
ggplot(data = dat, aes(x = factor(Month), y = Value)) +
geom_boxplot() +
labs(x = "Month") +
theme_bw() +
theme(panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "black"),
axis.text.y = element_text(size = 14, color = "black")) +
facet_wrap(~group, scales = "free_x")
* Differences in the plot are likely due to using different versions of R where the set.seed gives different result

Using a ggplot raster basemap with draw_plot and ggdraw seems to result in a blurred pdf

I need to produce a high resolution (1200dpi) image for a journal. However, using cowplot::draw_plot to overlay some insets seems to lower the resolution of the basemap (see resolution of "basemap_test.pdf" vs "cowplot_test.pdf"). There is a similar question here:
The draw_image() function from cowplot results in blurred pdfs
but that one is to do with bringing in outside images; this seems more straightforward, working with a ggplot object in the R environment. Is there a way I can stop the basemap blurring?
snip from basemap pdf
snip from ggdraw pdf
Sorry for the length of the reprex - wanted it as close as possible to my plot
if (!require(pacman)) install.packages('pacman')
library(pacman)
pacman::p_load(tidyverse,cowplot,raster,sf,maptools,fasterize)
eckIV = st_crs("ESRI:54012")
data("wrld_simpl")
wrld = st_as_sf(wrld_simpl) %>%
st_transform(eckIV)
#inset a
a_lims <- c(-9266960,-7503720,4725508,5796774)
a_sf <- st_bbox(extent(a_lims)) %>% st_as_sfc %>% st_sf
#inset b
b_lims <- c(-5203519,-3440279,-3705917,-2634651)
b_sf <- st_bbox(extent(b_lims)) %>% st_as_sfc %>% st_sf
#inset c
c_lims <- c(-43965.2,1719274.8,5759670.1,6830936.1)
c_sf <- st_bbox(extent(c_lims)) %>% st_as_sfc %>% st_sf
#inset d
d_lims <- c(9213988,10977228,3481996,4553262)
d_sf <- st_bbox(extent(d_lims)) %>% st_as_sfc %>% st_sf
insetBoxes <- rbind(a_sf,b_sf,c_sf,d_sf) %>%
st_set_crs(eckIV)
#dummy raster data
rst = raster(ext=extent(wrld),res=30000,crs=eckIV$proj4string)
values(rst) <- runif(n=ncell(rst),0,1)
rst = mask(rst,fasterize(wrld,rst))
rst_df = as.data.frame(rst, xy=TRUE)
#basemap
map <- ggplot() +
geom_sf(data=wrld, col=NA) +
geom_raster(data = rst_df, aes(fill = layer, x = x, y = y)) +
geom_sf(data=insetBoxes, fill=NA, size=0.5) +
scale_fill_gradientn(colours=terrain.colors(100),na.value = "transparent") +
theme_void() +
theme(legend.position = "none")
#insets
theme_inset <- theme_void() +
theme(legend.position="none",
panel.border = element_rect(colour = "black", fill = NA))
inset1 <- ggplot() +
geom_sf(data=wrld, col=NA) +
geom_raster(data = rst_df, aes(fill = layer, x = x, y = y)) +
scale_fill_gradientn(colours=terrain.colors(100),na.value = "transparent") +
geom_sf(data=wrld, fill=NA, size=0.1) +
theme_inset +
coord_sf(xlim = c(c_lims[[1]], c_lims[[2]]),
ylim = c(c_lims[[3]], c_lims[[4]]),
expand = FALSE)
inset2 <- ggplot() +
geom_sf(data=wrld, col=NA) +
geom_raster(data = rst_df, aes(fill = layer, x = x, y = y)) +
scale_fill_gradientn(colours=terrain.colors(100),na.value = "transparent") +
geom_sf(data=wrld, fill=NA, size=0.1) +
theme_inset +
coord_sf(xlim = c(d_lims[[1]], d_lims[[2]]),
ylim = c(d_lims[[3]], d_lims[[4]]),
expand = FALSE)
inset3 <- ggplot() +
geom_sf(data=wrld, col=NA) +
geom_raster(data = rst_df, aes(fill = layer, x = x, y = y)) +
scale_fill_gradientn(colours=terrain.colors(100),na.value = "transparent") +
geom_sf(data=wrld, fill=NA, size=0.1) +
theme_inset +
coord_sf(xlim = c(a_lims[[1]], a_lims[[2]]),
ylim = c(a_lims[[3]], a_lims[[4]]),
expand = FALSE)
inset4 <- ggplot() +
geom_sf(data=wrld, col=NA) +
geom_raster(data = rst_df, aes(fill = layer, x = x, y = y)) +
scale_fill_gradientn(colours=terrain.colors(100),na.value = "transparent") +
geom_sf(data=wrld, fill=NA, size=0.1) +
theme_inset +
coord_sf(xlim = c(b_lims[[1]], b_lims[[2]]),
ylim = c(b_lims[[3]], b_lims[[4]]),
expand = FALSE)
#combine
world_map = map %>%
cowplot::ggdraw() +
cowplot::draw_plot(inset1 + theme(plot.background = element_rect(fill = "white", colour = NA)),
width = 0.25,
height = 0.25,
x = 0.75,
y = 0.7) +
cowplot::draw_plot(inset2 + theme(plot.background = element_rect(fill = "white", colour = NA)),
width = 0.25,
height = 0.25,
x = 0.75,
y = 0.4) +
cowplot::draw_plot(inset3 + theme(plot.background = element_rect(fill = "white", colour = NA)),
width = 0.25,
height = 0.25,
x = 0,
y = 0.7) +
cowplot::draw_plot(inset4 + theme(plot.background = element_rect(fill = "white", colour = NA)),
width = 0.25,
height = 0.25,
x = 0,
y = 0.4)
rtn.plot = cowplot::plot_grid(world_map,world_map,ncol=1, labels = letters[1:2])
ggsave(plot=rtn.plot,
filename="cowplot_test.pdf",
width=22,height=18,unit="cm",device="pdf", dpi=1200)
ggsave(plot=map,
filename="basemap_test.pdf",
width=22,height=18,unit="cm",device="pdf", dpi=1200)

Difficulty in arranging plots

I have total 7 plots.
Six of them are line charts which are to be aligned and arranged one below each other such that there is no space between them - to make one composite plot.
Here is the data and ggplot2 code and I am using the same line chart 6 times just to explain my problem
x<- 1:10
y<- rnorm(10)
data <- data.frame(x,y)
library(ggplot2)
k<- ggplot(data, aes(x= x, y= y)) + geom_line() + theme(panel.background=element_blank()) + theme(aspect.ratio = 0.15) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), axis.line.x = element_line(colour = "black", size= 0.5), axis.line.y = element_line(colour = "black", size= 0.5), axis.ticks.y = element_line(colour = "black", size= 0.5), axis.ticks.x = element_blank()) + xlab(label = "")+ ylab(label = "") + scale_x_continuous(label= NULL) +theme(plot.margin = unit(c(-0.25, 2, -0.25, 2), "cm"))
k
Seventh is scatter plot with regression line
a<- 1:10
a
b<- 11:20
b
data1 <- data.frame(a,b)
data1
library(ggplot2)
k3<-ggplot(data1, aes(x=a, y=b))+ geom_point(shape=1, fill ="black", alpha= 1, color= "black", size=3) + geom_smooth(method = lm, size = 0.5, linetype ="dotted", fill ="black", color= "black", alpha = 0.3)
k3
k3<- k3 + expand_limits(x = c(0.5, 10.5), y = c(10.5,20.5)) + scale_x_continuous(expand = c(0, 0), breaks = c(2,4, 6, 8, 10)) + scale_y_continuous(expand = c(0, 0),breaks = c(10, 12, 14, 16, 18, 20))
k3
k3 <- k3 + theme(panel.background=element_blank())+ theme(aspect.ratio = 1) + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(), axis.line.x = element_line(colour = "black"), axis.line.y = element_line(colour = "black", size= 0.5), axis.ticks.y = element_line(colour = "black", size= 0.5), axis.ticks.x = element_line(colour = "black", size= 0.5))
k3
k3<- k3 + scale_x_reverse(expand = c(0, 0))
k3
#Flip axes
k3<- k3 + coord_flip()
k3<- k3 + theme(plot.margin = unit(c(0, 0, 0, 0), "cm"))
k3
I want to arrange (1) composite plot (on left) and (2) scatter plot (on right)side by side. So I tried arranging that way using (1) ggarrange() [in ggpubr] and (2) plot_grid()[in cowplot], but I couldn't.
Could anybody help? Thankyou!
I want the layout to look like this
I really hope, that I've understand you correctly. To be honest your code is a mess, so I was using a default iris dataset.
The hint is to use plot_grid twice:
library(ggplot2)
library(cowplot)
k <- iris %>%
ggplot(aes(x = Sepal.Length, y = Petal.Length)) +
geom_line() +
labs(x = "", y = "") +
theme_classic() +
theme(axis.ticks.x = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
k3 <- iris %>%
ggplot(aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
labs(x = "", y = "") +
theme_classic()
grid1 <- cowplot::plot_grid(
k, k, k, k, k, k,
ncol = 1,
align = "hv"
)
cowplot::plot_grid(grid1, k3,
align = "hv",
rel_widths = c(1.5, 1), # you can control the relative width and height
nrow = 1)
Found solution! Got desired result with package 'patchwork' in combination with some changes in plot margins.
Here is the code and result
library(ggplot2)
iris
# Line charts
k <- ggplot(iris, aes(x = Sepal.Length, y = Petal.Length)) +
geom_line() +
labs(x = "", y = "") +
theme_classic() +
theme(axis.ticks.x = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank()) +
theme(plot.margin = unit(c(-0.25,-3,-0.25,0), "cm")) +
theme(aspect.ratio = 0.15)
# Line chart (k4) with y-axis label
k4 <- ggplot(iris, aes(x = Sepal.Length, y = Petal.Length)) +
geom_line() +
labs(x = "", y = "") +
theme_classic() +
theme(axis.ticks.x = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank()) +
theme(axis.title.y = element_text(
vjust = 2,
color = "black",
size = 10,
face = "bold"
))+
theme(plot.margin = unit(c(-0.25,-3,-0.25,0), "cm"))+
theme(aspect.ratio = 0.15)
# scatter plot
sc <-ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
labs(x = "", y = "") +
theme_classic()+
theme(plot.margin = unit(c(0,0,0,-0.5), "cm"))+
theme(aspect.ratio = 0.7)
sc
library(patchwork)
p<- (k/k/k/k4/k/k)| sc
p

R ggplot2: adding custom text to legend and value counts on sides of the heat map

My input data looks like:
COMPANY DOMAIN REVIEW PROGRESS
Company A Service Good +
Company A Response Good +
Company A Delay Very Good
Company A Cost Poor -
Company B Service Poor -
Company B Delay Average
Company B Cost Good +
Company C Service Very Poor +
Company C Cost Average
I produced a heat map in which I add some text (value of the "PROGRESS" variable - i.e. plus or minus sign).
Here is my code:
require("ggplot2")
graph <- read.table("input.tab", header=T, sep="\t")
ggplot(data=graph, aes(x=COMPANY, y=DOMAIN, group=REVIEW, fill=REVIEW)) +
geom_tile() +
geom_text(aes(x=COMPANY, y=DOMAIN, label=PROGRESS)) +
scale_x_discrete(expand = c(0, 0)) +
scale_y_discrete(expand = c(0, 0)) +
geom_vline(xintercept=seq(1.5, length(graph$COMPANY)+0.5)) +
geom_hline(yintercept=seq(1.5, length(graph$DOMAIN)+0.5)) +
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_blank(),
axis.ticks = element_blank(),
panel.background = element_blank(),
plot.background = element_blank(),
axis.title=element_blank(),
axis.text.x = element_text(angle=45, size=12, hjust=1)
)
However I am struggling adding (see figure modified manually below):
(1) the following "PROGRESS" legend as part of the color code already listed:
+ Better
- Worse
(2) the count of data available on each row between the right side of the plot and the legend
(3) the count of data available on each column on top of the plot
Any advice?
Here's my proposed solution, I added comments in the code for you to understand what I did. There is probably a better way of generating the grid, though. Hope it helps.
graph <- read_csv(
"COMPANY ,DOMAIN ,REVIEW ,PROGRESS
Company A ,Service ,Good ,+
Company A ,Response ,Good ,+
Company A ,Delay ,Very Good ,
Company A ,Cost ,Poor ,-
Company B ,Service ,Poor ,-
Company B ,Delay ,Average ,
Company B ,Cost ,Good ,+
Company C ,Service ,Very Poor ,+
Company C ,Cost ,Average ,")
ggplot() +
# moved aesthetics and data to each geom,
# if you keep them in the ggplot call,
# you have to specify `inherit.aes = FALSE` in the rest of the geoms
geom_tile(data = graph,
aes(x = COMPANY,
y = DOMAIN,
fill = REVIEW)) +
# changed from `geom_text` to `geom_point` with custom shapes
geom_point(data = graph,
aes(x = COMPANY,
y = DOMAIN,
shape = factor(PROGRESS, labels = c("Worse", "Better"))),
size = 3) +
# custom shape scale
scale_shape_manual(name = "", values = c("-", "+")) +
# calculate marginal totals "on the fly"
# top total
geom_text(data = summarize(group_by(graph, COMPANY),
av_data = length(!is.na(PROGRESS))),
aes(x = COMPANY,
y = length(unique(graph$DOMAIN)) + 0.7,
label = av_data)) +
# right total
geom_text(data = summarize(group_by(graph, DOMAIN),
av_data = length(!is.na(PROGRESS))),
aes(x = length(unique(graph$COMPANY)) + 0.7,
y = DOMAIN, label = av_data)) +
# expand the plotting area to accomodate for the marginal totals
scale_x_discrete(expand = c(0, 0.8)) +
scale_y_discrete(expand = c(0, 0.8)) +
# changed to `geom_segment` to generate the grid, otherwise grid extends
# beyond the heatmap
# horizontal lines
geom_segment(aes(y = rep(0.5, 1 + length(unique(graph$COMPANY))),
yend = rep(length(unique(graph$DOMAIN)) + 0.5,
1 + length(unique(graph$COMPANY))),
x = seq(0.5, 1 + length(unique(graph$COMPANY))),
xend = seq(0.5, 1 + length(unique(graph$COMPANY))))) +
# vertical lines
geom_segment(aes(x = rep(0.5, 1 + length(unique(graph$DOMAIN))),
xend = rep(length(unique(graph$COMPANY)) + 0.5,
1 + length(unique(graph$DOMAIN))),
y = seq(0.5, 1 + length(unique(graph$DOMAIN))),
yend = seq(0.5, 1 + length(unique(graph$DOMAIN))))) +
# custom legend order
guides(fill = guide_legend(order = 1),
shape = guide_legend(order = 2)) +
# theme tweaks
theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_blank(),
axis.ticks = element_blank(),
panel.background = element_blank(),
plot.background = element_blank(),
axis.title = element_blank(),
axis.text.x = element_text(angle = 45,
size = 12,
hjust = 1,
# move text up 20 pt
margin = margin(-20,0,0,0, "pt")),
# move text right 20 pt
axis.text.y = element_text(margin = margin(0,-20,0,0, "pt"))
)