R ggplot viridis change the color gradient - r

Hello I am plotting scatter plot using R ggplot for coloring using virdis, I wanted split the color legend to get more contrast between ranges currently legend having 1000,2000,3000,4000 In between this split this to get more color currently my code looking as below
library(dplyr)
library(ggplot2)
library("viridis")
df <- tibble(gene = sample.int(5000),aceth = rnorm(5000),acvitd = rnorm(5000))
df$log_mean=log(df$gene)
p=ggplot(df, aes(aceth, acvitd))+
geom_point(aes(color =gene)) +
theme(legend.position = "top")+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))
p=p+ theme(legend.position = "top") +
scale_color_viridis(option = "A",
name = "mean",
guide = guide_colourbar(direction = "horizontal",
barheight = unit(4, units = "mm"),
barwidth = unit(100, units = "mm"),
draw.ulim = F,
title.hjust = 0.5,
label.hjust = 0.5, title.position = "top"))
How I wanted my graph look like
can anyone suggest me


Perhaps you're looking for scale_colour_vridis_b to bin your colours?
df <- tibble(gene = sample.int(5000),aceth = rnorm(5000),acvitd = rnorm(5000))
df$log_mean=log(df$gene)
p=ggplot(df, aes(aceth, acvitd))+
geom_point(aes(color = - (aceth + acvitd))) +
theme(legend.position = "top")+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"))
p+ theme(legend.position = "top") +
scale_colour_viridis_b(option = "A", values = 0:10 /10, breaks = 0:5 - 2.5)

Related

Multi-row x-axis with separator inside using ggplot

How can I implement histogram with such complex x-axis?
First x-axis row is the week start, second - week end.
Data for tests in csv: https://gofile.io/d/FrhLZh.
What I managed to
hist_data %>%
ggplot(aes(x = week, y = count)) +
geom_col(fill = "#5B879E", width = 0.9, size = 0.7) +
labs(title = "", x = "", y = "") +
theme_bw() + theme_minimal() + theme(legend.position="none")+
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(vjust = 0.5, size = 8, family = "Inter", colour = "#ffffff"),
axis.line.x = element_blank(),
axis.title.x = element_blank(),
plot.background = element_rect(fill = "#3A464F"),
plot.margin=unit(c(0,0.25,0.5,0), "cm"))+
scale_x_discrete(expand=c(0,0), labels = format(as.Date(hist_data$week_start), "%d-%m"), position = "bottom") +
scale_y_continuous()

Thanks to teunbrand and his ggh4x package, solution:
hist_data %>%
ggplot(aes(x = week, y = count)) +
geom_col(fill = "#5B879E", width = 0.8, size = 0.7)+
labs(title = "", x = "", y = "") +
theme_bw() + theme_minimal() + theme(legend.position="none")+
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(vjust = 0.5, size = 8, lineheight = 0.8, family = "Inter", colour = "#ffffff"),
axis.line.x = element_blank(),
axis.title.x = element_blank(),
ggh4x.axis.nestline.x = element_line(size = 0.5, colour = "#5B879E", lineend = "square"),
plot.background = element_rect(fill = "#3A464F"),
plot.margin=unit(c(1,0.5,1,0.5), "cm"))+
scale_x_discrete(expand=c(0,0),
labels = paste0(format(as.Date(sort(hist_data$week_start)), "%d.%m"),
"\n", "nonsense", "\n",
format(as.Date(sort(hist_data$week_end)), "%d.%m")), position = "bottom") +
scale_y_continuous() +
guides(x = guide_axis_nested(delim = "nonsense"))

You can add multiple layers of geom_text and geom_segment. Adjust the relative y positions of these layers using a scaling factor.
plotscale <- max(hist_data$count)/50
library(ggplot2)
ggplot(data = hist_data,
aes(x = week_start + floor(week_end-week_start)/2, y = count)) +
geom_col(fill = "#5B879E", width = 4) +
geom_text(aes(y = -6 * plotscale ,
label = format(week_start, "%m-%d")),
color = "#ffffff")+
geom_segment(aes(x = week_start, xend = week_end,
y = -10 * plotscale, yend = -10 * plotscale),
color = "#5B879E", size = 1.5)+
geom_text(aes(y = -14 * plotscale,
label = format(week_end, "%m-%d")),
color = "#ffffff")+
theme_minimal() +
theme(
panel.grid = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
plot.background = element_rect(fill = "#3A464F"))+
scale_x_date(expand=c(0,0), date_breaks = "1 week",
labels = NULL)
Consider using ggh4x package for more complex nested x axes.
Raw Data
hist_data <- read.table(text='"","week","count","week_start","week_end"
"1","1",21.5823972708382,2021-01-04,2021-01-10
"2","2",36.122556304552,2021-01-11,2021-01-17
"3","3",34.2809483156697,2021-01-18,2021-01-24
"4","4",25.8546925450454,2021-01-25,2021-01-31
"5","5",29.0309819292706,2021-02-01,2021-02-07
"6","6",33.1503608888827,2021-02-08,2021-02-14
"7","7",27.0490347440184,2021-02-15,2021-02-21
"8","8",30.3031289757874,2021-02-22,2021-02-28
"9","50",32.2876434072602,2020-12-07,2020-12-13
"10","51",33.1939593686481,2020-12-14,2020-12-20
"11","52",26.6853246329896,2020-12-21,2020-12-27
"12","53",23.0715199391151,2020-12-28,2021-01-03', header = TRUE, sep = ",")
hist_data$week_start <- as.Date(hist_data$week_start)
hist_data$week_end <- as.Date(hist_data$week_end)

Removing ticks from scale_fill_gradientn colorbar

I've the following code I'm working with:
colVec = c(heat.colors(100), "#828282")
colVec = rev(colVec)
remove_axes <- theme(
axis.text = element_blank(),
axis.line = element_blank(),
axis.ticks = element_blank(),
panel.border = element_blank(),
panel.grid = element_blank(),
axis.title = element_blank()
)
maineMap <- me_base +
geom_polygon(data = graphData, aes(fill = infProp), color = "white") +
geom_polygon(color = "black", fill = NA) +
theme_bw() +
remove_axes
breakVec = seq(0,1,by=0.01)
labelVec = rep("",length(breakVec))
labelVec[1] = 0
labelVec[length(labelVec)] = 1
labelVec[floor(length(labelVec)/2)] = 0.5
countyMap <- maineMap +
scale_fill_gradientn(colours = colVec,
breaks = breakVec,
limits = c(0, 1),
labels = labelVec)
countyMap
Which produces the following image:
My question is how do I remove all the tick bars on the color bar, and only place them at the points 0, 0.5, and 1? Additionally, can I make the colorbar appear differently, such as thicker or in a different format?

Increase the radius of the Circle in ggplot2

I've had trouble increasing the radius of the circle on a map. I've tried the scale_size_continuous with maximum size up to 1000, but the circle size remained the same after all.
My code is in the following:
states <- map_data("state")
gg1 <- ggplot(data=states) +
geom_polygon(data=states, aes(x=long,y=lat,group=group),
fill = "orange", color = "white") +
coord_fixed(ratio = 1.3)+
geom_circle(data = origCity, aes(x0 = Long, y0 = Lat, r = Percent),
fill = "black", color = "black", alpha = 0.5, show.legend = FALSE) +
scale_size_continuous(range = c(20, 5))+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank())+
theme(axis.ticks.x = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_blank())+
theme(axis.ticks.y = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank())
print(gg1)
Any suggestions are greatly appreciated!

Specific Barplot in R ggplot

Hello I will try for a last time,
I am doing my best to draw a barplot like the following Figure:
However it seems impossible with R.
Any idea?
Thanks in advance,
Peter
Attached the code I used.
groupe2<-rep(c(rep("P",4),rep("I",4)),2)
groupe<-rep(c("PPP","PPI","PIP","PII","IPP","IPI","IIP","III"),2)
OR_A<-c(1.00,0.86,0.88,0.90,0.77,0.68,0.77,0.70)
ICinf_A<-c(NA,0.70,0.72,0.76,0.60,0.50,0.61,0.61)
ICsup_A<-c(NA,1.06,1.07,1.06,1.00,0.92,0.96,0.81)
OR_B<-c(1.00,0.97,1.01,0.81,0.73,0.69,0.61,0.58)
ICinf_B<-c(NA,0.78,0.77,0.62,0.61,0.57,0.50,0.52)
ICsup_B<-c(NA,1.20,1.28,1.05,0.81,0.82,0.71,0.65)
OR_C<-c(1.00,1.03,0.86,0.65,0.68,0.58,0.47,0.37)
ICinf_C<-c(NA,0.84,0.67,0.50,0.59,0.49,0.40,0.33)
ICsup_C<-c(NA,1.27,1.10,0.86,0.78,0.69,0.56,0.41)
Cohort<-c(rep(" PC",8), rep("RIC",8))#, rep("RIC",8))
OR<-c(OR_A,OR_B)#,OR_C)
ICinf<-c(ICinf_A,ICinf_B)#,ICinf_C)
ICsup<-c(ICsup_A,ICsup_B)#,ICsup_C)
rm(dataOR)
dataOR<-data.frame(OR,groupe,Cohort,groupe2,ICinf,ICsup)
names(dataOR)
dataOR[, "groupe"] <- factor(dataOR[, "groupe"] ,
levels = c("PPP","PPI","PIP","PII","IPP","IPI","IIP","III"))
##########
library(ggdag)
ggplot(dataOR, aes(fill=outcome, y=OR, x=groupe)) +
geom_bar(position="dodge", stat="identity", color = "gray95", size = 0.25) +
# scale_fill_brewer(palette="Blues")+
scale_fill_manual(values = RColorBrewer::brewer.pal(5, "Blues")[3:5]) +
geom_errorbar(aes(ymin=ICinf, ymax=ICsup), width=.4, position=position_dodge(.9))+
geom_hline(yintercept=1) +
geom_point(position = position_dodge(0.9), size = 0.5, show.legend = F) +
scale_y_continuous(expand = expand_scale(mult = c(0, 0.05))) +
facet_wrap(~groupe, nrow = 1, scales = "free_x") +
labs(fill = NULL) +
theme(legend.position = "top",
legend.key.height = unit(0.2, "cm"),
legend.background = element_rect(color = "black", size = 0.4),
axis.line = element_line(color = "black"),
axis.text.x = element_blank(),
axis.ticks = element_blank(),
panel.grid.major.x = element_blank(),
axis.title = element_text(face = "bold"))

Add legend to ggplot object (why two legends?)

I created a ggplot2 object:
a <- replicate(8,rnorm(100))
colnames(a) <- letters[1:8]
b < -melt(a,id.vars=1:1)
colnames(b) <- c("c","variable","value")
ggplot(b,aes(x = c,y = value, colour = variable, linetype = variable)) +
geom_line()+
geom_point(aes(shape = factor(variable)), size = 1.7) +
scale_x_continuous(limits = c(-1, 1),
breaks = seq(-1, 1, 0.1),
expand=c(0.01, 0.01)) +
scale_y_continuous(limits = c(-1, 1),
breaks = seq(-1, 1, 0.1),
expand = c(0.01, 0.01))+
theme_bw(base_size = 12, base_family = "Helvetica") +
theme(axis.text=element_text(size = 10),
axis.title=element_text(size = 10),
text = element_text(size = 10),
axis.line = element_line(size = 0.25),
axis.ticks=element_line(size = 0.25),
panel.grid.major = element_blank(),
#panel.grid.minor = element_blank(),
panel.border = element_rect(colour = "black", fill = NA, size = 0.5),
panel.background = element_blank(),
legend.position = "top" ,
legend.direction = "vertical",
legend.title = element_blank(),
legend.text = element_text(size = 13),
legend.background = element_blank(),
legend.key = element_blank()) +
labs(x = '', y = '', title = "") +
theme(plot.title = element_text(size=10)) +
theme(strip.text.x = element_text(size = 8,color="black"),
strip.background = element_blank()) +
theme(strip.text.x = element_text(size = 8, colour = "black"))
My problem is the following:
when I create the legend, there is a separate legend for the colors and a separate one for the points.
How can I create a single legend for each of the 8 variables?

Let me minimise your code and focus on the legend issue. This is what you have now.
ggplot(b,aes(x = c, y = value, colour = variable, linetype = variable)) +
geom_line() +
geom_point(aes(shape = factor(variable)),size=1.7)
Your data frame, b has variable as factor. You use this in two ways here; variable and factor(variable). You can simply use variable for shape in geom_point; make all variable identical.
ggplot(b,aes(x = c, y = value, colour = variable, linetype = variable)) +
geom_line()+
geom_point(aes(shape = variable),size = 1.7)
I saw some warning messages related to colours and other things. You may want to take care of them. But, for legend, this is one way to go.

Take from the ideas on this page: http://www.cookbook-r.com/Graphs/Legends_(ggplot2)/#modifying-the-text-of-legend-titles-and-labels
I edited your code to make the data visible (you had problems with your x-axis limits. Note the final three lines. These commands tell ggplot to create only one legend.
a<-replicate(6,rnorm(100))
colnames(a)<-letters[1:6]
b<-melt(a,id.vars=1:1)
colnames(b)<-c("c","variable","value")
ggplot(b,aes(x=c,y=value,colour=variable,linetype=variable)) +
geom_line() + geom_point(aes(shape=factor(variable)),size=1.7)+
scale_x_continuous(limits=c(0,100))+
scale_y_continuous(limits=c(-2,2),breaks=seq(-2,2,0.1),expand=c(0.01,0.01))+
theme_bw(base_size=12, base_family="Helvetica") +
theme(axis.text=element_text(size=10),
axis.title=element_text(size=10),
text = element_text(size=10),
axis.line = element_line(size=0.25),
axis.ticks=element_line(size=0.25),
panel.grid.major = element_blank(),
#panel.grid.minor = element_blank(),
panel.border = element_rect(colour="black",fill=NA,size=0.5),
panel.background = element_blank(),
legend.position="top" ,
legend.direction="vertical",
legend.title=element_blank(),
legend.text=element_text(size=13),
legend.background=element_blank(),
legend.key=element_blank())+
labs(x='', y='',title="")+
theme(plot.title=element_text(size=10))+
theme(strip.text.x = element_text(size = 8,color="black"),strip.background=element_blank())+
theme(strip.text.x = element_text(size = 8,color="black"))+
scale_colour_discrete(name ="Factor")+
scale_linetype_discrete(name ="Factor") +
scale_shape_discrete(name ="Factor")

Resources