본문 바로가기

R관련/Rfunction

Hexbin scatter plot

728x90
반응형

#' scatterPlot_with_Cor.test
#'
#' This function is to draw and perform correlation test
#' Input vector should be presorted.
#' @param x(default=NULL) : Input vector for x-axis
#' @param y(default=NULL) : Input vector for y-axis
#' @param xlab(default=NULL) : Label of x-axis
#' @param ylab(default=NULL) : Label of y-axis
#' @param title(default=NULL) : title
#' @param cex.lab(default=1) : Size of label
#' @param cex.axis(default=1) : Size of axis
#' @param cex.main(default=1) : Size of title
#' @param cor.method(default='spear') : Correlation test method('pearson','spear')
#' @param pch(default=19) : Point style can be vector
#' @param cex(default=1) : Point size can be vector
#' @param col(default='black') : Point color can be vector
#' @param legend.param : legend parameter list\cr
#' @param heaxin (default=F) : Whether increase drawing efficiency by binning.
#' @param ylim(default=NULL) : y axis range
#' @param xlim(default=NULL) : x axis range
#' its structure is list(poistion='topright',fill=NULL,pch=NULL,legend = NULL,ncol=NULL)
#' @keywords cor.test, plot
#' @export
#' @examples
#' x=rnorm(10);y=rnorm(10)
#' scatterPlot(x=x,y=y,xlab='x-axis',ylab='y-axis',pch=19)
#' scatterPlot(x=x,y=y,xlab='x-axis',ylab='y-axis',pch=c(1:10))
#' scatterPlot(x=x,y=y,xlab='x-axis',ylab='y-axis',pch=c(1:10),title='hi',
#' legend.param=list(position='topright',fill=c('red','blue'),pch=c(1,2),legend=c('hello','hi'),ncol=1))
#x=as.numeric(x1);y=as.numeric(y1);xlabel=xlab;ylabel=ylab;pch=19;col=colors;cex=1;cex.lab=cex.axis=cex.main=1;title=NULL
scatterPlot=function(x=NULL,y=NULL,xlabel=NULL,ylabel=NULL,title=NULL,
cex.lab=1,cex.axis=1,cex.main=1,ylim=NULL,xlim=NULL,
pch=19,cex=1,col='black',cor.method='spear',
legend.param=list(poistion='topright',fill=NULL,pch=NULL,
legend = NULL,ncol=1),
hexbin=F){
check.n.install.lib(lib.name=c('hexbin','farver'),lib.type = rep('cran',2))
# Calculate coefficients
# Calculate correlation coefficient and p.value
pv=cor.test(x,y,method=cor.method)
rho=format(c(pv$estimate,pv$p.value),nsmall=3,digits=1)
cor.m=toupper(cor.method)
cor.display=paste0(cor.m,' cor=',rho[1],' ',cor.m,' p.value=',rho[2])
# Drawing part
if(hexbin){
title2=paste0(title,'\n',cor.display)
gp=hexbin.plot(x=x,y=y,xlabel=xlabel,ylabel=ylabel,title=title2)
print(gp)
}else{
plot(x,y,xlab=xlabel,ylab=ylabel,ylim=ylim,xlim,xlim,
main=title,pch=pch,cex=cex,cex.lab=cex.lab,
cex.axis=cex.axis,cex.main=cex.main,col=col)
abline(lm(y~x),col='red',lty=2,lwd=5)
mtext(side=3,adj=1,paste0(cor.m,' cor=',rho[1],' ',cor.m,' p.value=',rho[2]))
# Add legend
if(!is.null(legend.param$legend)){
legend(x=legend.param$position,col = legend.param$fill,legend = legend.param$legend,ncol = legend.param$ncol,
pch = legend.param$pch)
}
}
return(list('Cor'=rho[1],'P.value'=rho[2],'Test.method'=cor.method))
}


hexbin.plot=function(x,y,xlabel=NULL,ylabel=NULL,title=NULL){
check.n.install.lib(lib.type = c('cran','cran'),
lib.name = c('ggplot2','hexbin'))
library(ggplot2);library(hexbin)
df=data.frame('x'=x,'y'=y)
fitlm=lm(y~x,data=df)
df$predlm=predict(fitlm)
gp=ggplot(df, aes(x=x, y=y) ) +
geom_hex(bins = 50) +
scale_fill_continuous(type = "viridis") +
theme_bw() +
geom_line(aes(y=predlm),size=2,color='red',lty=2) +
labs(x=xlabel,y=ylabel) +
ggtitle(title)
return(gp)
}

728x90
반응형

'R관련 > Rfunction' 카테고리의 다른 글

survival analysis function  (0) 2019.03.21
GSEA Enrichment Score calculation  (0) 2019.02.27
scanning ks-test  (0) 2018.03.02
domain_annotation  (0) 2017.07.21
IC50, drc  (0) 2017.07.21