Limiting the number of decimals on a correlation matrix - r

I have created the attached correlation matrix in R.
How can I limit the number of decimals to 0.01? I have tried to use "accuracy:0.01" next to value but it doesn't change anything.
Thanks!
My code is below:
library("reshape2")
melted_cormat <- melt(cormat)
head(melted_cormat)
get_lower_tri<-function(cormat){
cormat[upper.tri(cormat)] <- NA
return(cormat)
}
# Get upper triangle of the correlation matrix
get_upper_tri <- function(cormat){
cormat[lower.tri(cormat)]<- NA
return(cormat)
}
reorder_cormat <- function(cormat){
# Use correlation between variables as distance
dd <- as.dist((1-cormat)/2)
hc <- hclust(dd)
cormat <-cormat[hc$order, hc$order]
}
cormat <- reorder_cormat(cormat) # Reorder the correlation matrix
upper_tri <- get_upper_tri(cormat)
# Melt the correlation matrix
melted_cormat <- melt(upper_tri, na.rm = TRUE)
# Create a ggheatmap
ggheatmap <- ggplot(melted_cormat, aes(Var2, Var1, fill = value))+
geom_tile(color = "white")+
scale_fill_gradient2(low = "blue", high = "red", mid = "white",
midpoint = 0, limit = c(-1,1), space = "Lab",
name="Pearson\nCorrelation") +
theme_minimal()+ # minimal theme
theme(axis.text.x = element_text(angle = 45, vjust = 1,
size = 12, hjust = 1))+
coord_fixed()
# Print the heatmap
print(ggheatmap)
ggheatmap +
geom_text(aes(Var2, Var1, label = value), color = "black", size = 2) +
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(1, 0),
legend.position = c(0.6, 0.7),
legend.direction = "horizontal")+
guides(fill = guide_colorbar(barwidth = 7, barheight = 1,
title.position = "top", title.hjust = 0.5))

Related

Plot only upper triangle of the matrix using ggplot2

I have a matrix that I already cut into the upper triangle:
eSim <- c(1,1,-1,-1,1,1,-1,-1,-1,-1,1,1,-1,-1,1,1)
dim(eSim) <- c(4,4)
rownames(eSim)=c("PosLong\n1200", "PosLong\n1800", "Neglong\n1200", "Neglong\n1800")
colnames(eSim)=c("PosLong\n1200", "PosLong\n1800", "Neglong\n1200", "Neglong\n1800")
# Get upper triangle of the correlation matrix
get_upper_tri <- function(cormat){
cormat[lower.tri(cormat)]<- NA
return(cormat)
}
eSim_upper <- get_upper_tri(eSim)
melted_eSim_upper <- melt(eSim_upper, na.rm = TRUE)
And this is my code for plotting this matrix
ggplot(data = melted_eSim_upper, aes(Var2, Var1, fill = as.factor(value)))+
geom_tile(color = "black", size=0.8)+
scale_fill_manual(values=c("#8DD3C7", "#FB8072"))+
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, vjust = 1,
size = 12, hjust = 1))+
theme(axis.text.y = element_text(angle = 45, vjust = 1,
size = 12, hjust = 1))+
coord_fixed()+
theme(axis.title.x = element_blank(),
axis.title.y = element_blank())+
theme(panel.background = element_blank(),
panel.grid.major = element_blank(),
panel.border = element_blank())+
theme(axis.text.y = element_text(margin = margin(t = 0, r = 0, b = 0, l = 50)))
The outcome:
I have several questions to acheive my final goal:
Is there a way to rotate this plot diagnoally? Something like this:
Is there a way to move the y axis text further away to the matrix?
Yes, use limits = rev in a discrete scale.
Yes, but the more convenient thing to do is to use guide = guide_axis(angle = 45) instead of micromanaging the theme settings.
library(ggplot2)
eSim <- c(1,1,-1,-1,1,1,-1,-1,-1,-1,1,1,-1,-1,1,1)
dim(eSim) <- c(4,4)
rownames(eSim)=c("PosLong\n1200", "PosLong\n1800", "Neglong\n1200", "Neglong\n1800")
colnames(eSim)=c("PosLong\n1200", "PosLong\n1800", "Neglong\n1200", "Neglong\n1800")
# Get upper triangle of the correlation matrix
get_upper_tri <- function(cormat){
cormat[lower.tri(cormat)]<- NA
return(cormat)
}
eSim_upper <- get_upper_tri(eSim)
melted_eSim_upper <- reshape2::melt(eSim_upper, na.rm = TRUE)
ggplot(data = melted_eSim_upper, aes(Var2, Var1, fill = as.factor(value)))+
geom_tile(color = "black", size=0.8)+
scale_fill_manual(values=c("#8DD3C7", "#FB8072"))+
scale_y_discrete(limits = rev, guide = guide_axis(angle = 45)) +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, vjust = 1,
size = 12, hjust = 1))+
theme(axis.text.y = element_text(size = 12))+
coord_fixed()+
labs(x = NULL, y = NULL) +
theme(panel.background = element_blank(),
panel.grid.major = element_blank(),
panel.border = element_blank())
Created on 2022-09-19 by the reprex package (v2.0.1)

Change histogram bar percentage label in R ggplot

I have made a histogram in R using the following code:
(I have tried generating a reprex. Try the code reprex here
progressiveNumber = c(1:50)
c = c(-0.22037439, -0.21536365, -0.34203720, 0.04501624, -0.13141665, -1.28155157, -0.08394700, -0.08484768, -0.12577287, 0.30402612, -0.40578251,
0.00000000, -0.16849942, -0.04212114, 0.12577287, 0.57366312, -0.84766743, -1.03909659, -0.21536365, -0.46263648, -0.48181028, -0.38887381,
-0.38571106, -0.38571106, -0.26220026, 0.73227348, -0.38887381, -0.96590662, -0.29931065, 0.04272655, 0.04182587, -0.38571106, -0.13141665,
-0.34614726, -0.49063020, -0.08484768, 0.05249378, 0.08484768, -0.74591104, 0.46263648, -0.42081062, 0.00000000, 0.08394700, -0.38571106,
-0.34203720, -0.04212114, -0.79517364, 0.25429442, -0.30402612, -0.08365173)
library(tidyverse)
# DEFINING BREAKS AND CUT A VECTOR INTO BINS
# set up cut-off values
breaks <- c(-1.2816,-0.3881,-0.2154, 0.0000, 0.3 ,0.7323)
# specify interval/bin labels
tags <- c("[-1.2 / -0.3]","[-0.3 / -0.2]", "[-0.2 / 0]", "[0 / 0.3]","[0.3 / 0.7]")
# bucketing values into bins
group_tags <- cut(c,
breaks=breaks,
include.lowest=TRUE,
right=FALSE,
labels=tags)
# inspect bins
summary(group_tags)
# c_groups <- factor(group_tags,levels = labels, ordered = TRUE) # this line doesn't work for some reason
#tiff("percentageBinsC.tiff", units="in", width=5, height=5, res=300,)
p2 = ggplot(data = as_tibble(group_tags), mapping = aes(x=value)) +
geom_bar(fill="deepskyblue1",color="white",alpha=0.7, ) +
stat_count(geom="text", aes(label=sprintf("%.2f",..count../length(group_tags))), vjust=-0.5) +
labs(y = 'Count', x='C') +
theme(text = element_text(size=20), axis.line.x = element_line(color = "black", size = 1),
axis.line.y = element_line(color = "black", size = 1), axis.text.x = element_text(angle = 35, hjust = 1, vjust = 1),
panel.background = element_blank(), panel.border = element_blank(),
panel.grid.minor = element_blank(),panel.grid.major = element_blank())
p2
#dev.off()
Result
I would like to change the label on the bars (not the x-axis label but the ones that are right on top of each bar) from, e.g., 0.26 to 26%, 22% and so on.
How can I do that?
You can use percent_format from scales, first we define a function to do the conversion, and the rounding up you did with sprintf:
convert2perc = scales::percent_format(accuracy = 2)
You can test it:
convert2perc(0.107)
[1] "10%"
Then use it in the plotting:
p2 = ggplot(data = as_tibble(group_tags), mapping = aes(x=value)) +
geom_bar(fill="deepskyblue1",color="white",alpha=0.7, ) +
stat_count(geom="text", aes(label=convert2perc(..count../length(group_tags))), vjust=-0.5) +
labs(y = 'Count', x='C') +
theme(text = element_text(size=20), axis.line.x = element_line(color = "black", size = 1),
axis.line.y = element_line(color = "black", size = 1), axis.text.x = element_text(angle = 35, hjust = 1, vjust = 1),
panel.background = element_blank(), panel.border = element_blank(),
panel.grid.minor = element_blank(),panel.grid.major = element_blank())

Customize correlation plot r

Hi I want to customize the plot to something like this:
-I want to have some straight line inside the plot and want to change the legend to something in the left side rather than the normal legend in right side. Also add some texts beside the variables (categorize). I have tried ggcorrplot, ggcorr, corrplot, ggplot to make this, but still can't find the solution. Anyone can help? Thanks.
Sample plot-How to make it?
ggcorr(data = NULL, cor_matrix = corr, nbreaks = 4, hjust = 1, size = 3,
color = "grey60", layout.exp = 1, legend.size = 8, name= "R", palette = "RdYlGn") +
labs(title = "Corr") +
theme(plot.title = element_text(size = 13)) +
theme(plot.title = element_text(size = 14, color="grey40"))
I found an example code on http://www.sthda.com/english/wiki/ggplot2-quick-correlation-matrix-heatmap-r-software-and-data-visualization hope you can be inspired:
library(reshape2)
library(ggplot2)
mydata <- mtcars[,c(1,3,4,5,6,7)]
cormat <- round(cor(mydata),2) # got correlation matrix
# Get lower triangle of the correlation matrix, we use upper for what you wanted
get_lower_tri<-function(cormat){
cormat[upper.tri(cormat)] <- NA
return(cormat)
}
# Get upper triangle of the correlation matrix
get_upper_tri <- function(cormat){
cormat[lower.tri(cormat)]<- NA
return(cormat)
}
upper_tri <- get_upper_tri(cormat)
melted_cormat <- melt(upper_tri, na.rm = TRUE)
ggheatmap <- ggplot(data = melted_cormat, aes(Var2, Var1, fill = value))+
geom_tile(color = "white")+
scale_fill_gradient2(low = "blue", high = "red", mid = "white",
midpoint = 0, limit = c(-1,1), space = "Lab",
name="Pearson\nCorrelation") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, vjust = 1,
size = 12, hjust = 1))+
coord_fixed()
ggheatmap +
theme(legend.justification = c(1, 0),
legend.position = c(0.3, 0.5))+
guides(fill = guide_colorbar(title.position = "top", title.hjust = 0.5))
themes()can help you to change the position and direction of legend.
finally you got:
mydata <- mtcars[,c(1,3,4,5,6,7)]
cormat <- round(cor(mydata),2)
cormat[lower.tri(cormat, diag = T)]<- 100
cormat <- melt(cormat, na.rm =F)
cormat[is.na(cormat)] <- 10
cormat[cormat$value != 100 ,] ->cormat
cormat$value[cormat$value == 10 ] <- NA
cormat$value[cormat$value >= 0.5 ] <- 1
cormat$value[cormat$value <= -0.5 ] <- -1
cormat$value[cormat$value > -0.5 & cormat$value < 0.5 ] <- 0
# Create a ggcorrx
dev.new(width=15, height=15)
gcorx <- ggplot(cormat, aes(Var2, Var1, fill = value, colour=""))+
geom_tile(color = "grey60")+
scale_fill_gradient2(breaks=c(-1,-0.5,0.5,1),low = "red", high = "green", mid =
"yellow", midpoint = 0, limit = c(-1,1), space = "Lab", name="Not ?? OK", na.value="black") +
theme_minimal()+ # minimal theme
theme(axis.text.x = element_text(angle = 50, vjust = 1,
size = 8, hjust = 1))+
theme(axis.text.y = element_text(vjust = 1,
size = 8, hjust = 1))+
scale_y_discrete(position = "right")+
scale_x_discrete()+
coord_fixed()+
ggtitle("MT CARS")+
geom_segment(aes(x=1.5,xend=5.5,y=2.5,yend=2.5), color="black", size=2)+
geom_segment(aes(x=1.5,xend=1.5,y=0.5,yend=2.5), color="black", size=2)+
annotate("text", x=0.7, y=2.5, label= "Part 1", size = 3, color="black",angle = 50,
fontface = "bold")+
annotate("text", x=2, y=4, label="Part 2", size = 3, color="black",angle = 50,
fontface = "bold")
gcorx +
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(),
plot.title = element_text(color="black", size=12, face="bold", hjust = 0.5),
legend.justification = c(1, 0),
legend.position = c(0.3, 0.7),
legend.direction = "horizontal",
legend.title = element_text(size=9, face= "italic"))+
guides(fill = guide_colorbar(barwidth = 8, barheight = 1,title.position = "top",
title.hjust = 0.5))
Result:
But I still don't know to move label to diagonal. Anyone?

In ggplot2 correlogram how to make diagonal label and customize the legend

Hi this is actually follow up question from my previous question here:
Customize correlation plot r
So I still can not move the label to diagonal side and change the colour scale to discrete scale like below (sample):
And here my code so far:
mydata <- mtcars[,c(1,3,4,5,6,7)]
cormat <- round(cor(mydata),2)
cormat[lower.tri(cormat, diag = T)]<- 100
cormat <- melt(cormat, na.rm =F)
cormat[is.na(cormat)] <- 10
cormat[cormat$value != 100 ,] ->cormat
cormat$value[cormat$value == 10 ] <- NA
cormat$value[cormat$value >= 0.5 ] <- 1
cormat$value[cormat$value <= -0.5 ] <- -1
cormat$value[cormat$value > -0.5 & cormat$value < 0.5 ] <- 0
# Create a ggcorrx
dev.new(width=15, height=15)
gcorx <- ggplot(cormat, aes(Var2, Var1, fill = value, colour=""))+
geom_tile(color = "grey60")+
scale_fill_gradient2(breaks=c(-1,-0.5,0.5,1),low = "red", high = "green", mid =
"yellow", midpoint = 0, limit = c(-1,1), space = "Lab", name="Not ?? OK", na.value="black") +
theme_minimal()+ # minimal theme
theme(axis.text.x = element_text(angle = 50, vjust = 1,
size = 8, hjust = 1))+
theme(axis.text.y = element_text(vjust = 1,
size = 8, hjust = 1))+
scale_y_discrete(position = "right")+
scale_x_discrete()+
coord_fixed()+
ggtitle("MT CARS")+
geom_segment(aes(x=1.5,xend=5.5,y=2.5,yend=2.5), color="black", size=2)+
geom_segment(aes(x=1.5,xend=1.5,y=0.5,yend=2.5), color="black", size=2)+
annotate("text", x=0.7, y=2.5, label= "Part 1", size = 3, color="black",angle = 50,
fontface = "bold")+
annotate("text", x=2, y=4, label="Part 2", size = 3, color="black",angle = 50,
fontface = "bold")
gcorx +
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(),
plot.title = element_text(color="black", size=12, face="bold", hjust = 0.5),
legend.justification = c(1, 0),
legend.position = c(0.3, 0.7),
legend.direction = "horizontal",
legend.title = element_text(size=9, face= "italic"))+
guides(fill = guide_colorbar(barwidth = 8, barheight = 1,title.position = "top",
title.hjust = 0.5))
I can help with the colour scale...
cols <- c("-1" = "red", "0" = "yellow", "1" = "green")
ggplot(cormat, aes(Var2, Var1, fill = value, colour=""))+
geom_tile(aes(fill = factor(value)))+
scale_fill_manual(values = cols)
You can use the function cut to make some new variable, and then change the cols, based on the values from cut, to get 4 instead of 3
https://ggplot2.tidyverse.org/reference/scale_manual.html
As for axis text, you could try turning off the y axis and adding in annotations to the plot instead.
https://ggplot2.tidyverse.org/reference/annotate.html
http://www.sthda.com/english/wiki/ggplot2-axis-ticks-a-guide-to-customize-tick-marks-and-labels

How to make a complex heatmap using ggplot2?

I tried to plot a complex heatmap using ggplot2 with the cancer somatic mutation.
The data is here, and here is the code:
library(reshape2)
library(ggplot2)
library(scales)
library(gridExtra)
library(ggdendro)
library(zoo)
library(plyr)
#data process
mm8<-read.csv("mm8.csv",header=TRUE)
rownames(mm8)<-mm8$X
mm8<-mm8[,-2]
mm8[1:4,2:5]
#cluster from http://stackoverflow.com/questions/21474388/colorize-clusters-in-dendogram-with-ggplot2
df<-t(mm8)
df<-df[-1,]
cut <- 4 # Number of clusters
hc <- hclust(dist(df), "ave") # heirarchal clustering
dendr <- dendro_data(hc, type = "rectangle")
clust <- cutree(hc, k = cut) # find 'cut' clusters
clust.df <- data.frame(label = names(clust), cluster = clust)
# Split dendrogram into upper grey section and lower coloured section
height <- unique(dendr$segments$y)[order(unique(dendr$segments$y), decreasing = TRUE)]
cut.height <- mean(c(height[cut], height[cut-1]))
dendr$segments$line <- ifelse(dendr$segments$y == dendr$segments$yend &
dendr$segments$y > cut.height, 1, 2)
dendr$segments$line <- ifelse(dendr$segments$yend > cut.height, 1, dendr$segments$line)
# Number the clusters
dendr$segments$cluster <- c(-1, diff(dendr$segments$line))
change <- which(dendr$segments$cluster == 1)
for (i in 1:cut) dendr$segments$cluster[change[i]] = i + 1
dendr$segments$cluster <- ifelse(dendr$segments$line == 1, 1,
ifelse(dendr$segments$cluster == 0, NA, dendr$segments$cluster))
dendr$segments$cluster <- na.locf(dendr$segments$cluster)
# Consistent numbering between segment$cluster and label$cluster
clust.df$label <- factor(clust.df$label, levels = levels(dendr$labels$label))
clust.df <- arrange(clust.df, label)
clust.df$cluster <- factor((clust.df$cluster), levels = unique(clust.df$cluster), labels = (1:cut) + 1)
dendr[["labels"]] <- merge(dendr[["labels"]], clust.df, by = "label")
# Positions for cluster labels
n.rle <- rle(dendr$segments$cluster)
N <- cumsum(n.rle$lengths)
N <- N[seq(1, length(N), 2)] + 1
N.df <- dendr$segments[N, ]
N.df$cluster <- N.df$cluster - 1
# Plot the dendrogram
# Plot the dendrogram
p3<-ggplot() +
geom_segment(data = segment(dendr),
aes(x=x, y=y, xend=xend, yend=yend, size=factor(line), colour=factor(cluster)),
lineend = "square", show_guide = FALSE) +
scale_colour_manual(values = c("grey60", rainbow(cut))) +
scale_size_manual(values = c(.1, 1)) +
labs(x = NULL, y = NULL) +
theme(axis.line.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank(),
panel.background = element_blank(),
panel.grid = element_blank()) +
guides(fill = FALSE)+
theme(axis.ticks.x = element_blank(),
axis.text.x = element_blank(),
axis.title.x = element_blank(),
plot.background = element_blank())
#priparing a bar???
p4<-ggplot(clust.df,aes(x=label,y=1,fill=cluster))+geom_raster()+
theme(axis.line.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank(),
panel.background = element_blank(),
panel.grid = element_blank()) +
guides(fill = FALSE)+
theme(axis.ticks.x = element_blank(),
axis.text.x = element_blank(),
axis.title.x = element_blank(),
plot.background = element_blank())
#data for ggplot2 geom_raster
data.m = melt(mm8)
colnames(data.m)<-c("Var1", "Var2", "value")
head(data.m)
#plotting
p1 <- ggplot(data.m, aes(Var2, Var1)) + geom_raster(aes(fill = value),colour ="white")
p1<-p1 + theme(axis.ticks = element_blank(), axis.text = element_blank(),axis.title=element_blank(),plot.background = element_blank())
p2<-ggplot(data.m,aes(Var1,value*(-1)))+geom_bar(data.m, aes(fill=Var2),position="stack",stat="identity")+coord_flip()
p2<-ggplot(data.m,aes(Var1,value*(-1)))+geom_bar(data.m, aes(fill=Var2),position="stack",stat="identity")+coord_flip()+guides(fill = FALSE)+theme(axis.ticks.x = element_blank(), axis.text.x = element_blank(),axis.title.x = element_blank(),plot.background = element_blank())
#plotting 4 panels on a page
vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y)
#open graphic device
win.graph(width=860/72, height=450/72,pointsize = 12)
#plotting
grid.newpage()
pushViewport(viewport(layout = grid.layout(24, 50))) # 1 rows, 8 columns
#plotting
print(p2, vp = vplayout(5:24, 1:10))
print(p1, vp = vplayout(5:24, 10:50),newpage=FALSE)
print(p3, vp = vplayout(1:3, 9:47),newpage=FALSE)
print(p4, vp = vplayout(3:5, 10:46),newpage=FALSE)
#save
savePlot(filename="complex", type="emf")
dev.off()
And I got the picture like this:
1) How to automatically align P1,p3 and P4? For a sample on X, its features on p1, p3 and p4 are align automatically ?
2) Any good ideas to control the space between pancels? for example, reducing the space between p1 and p2, or p1 and p4.
3) How to reorder the samples on X-axis according to the cluster results? And how to control the order on X-axis for p1,p3,and p4 simultaneously?

Resources