├── Figure ├── 1.jpg ├── 10.jpg ├── 11.jpg ├── 2-3.jpg ├── 2-5.jpg ├── 2.jpg ├── 2_2.jpg ├── 2_4.jpg ├── 2_6.jpg ├── 2_6_1.jpg ├── 2_6_2.jpg ├── 3.jpg ├── 4.jpg ├── 4_1.jpg ├── 4_2.jpg ├── 5.jpg ├── 5_new.jpg ├── 5_new_multi_xaxis.jpg ├── 6.jpg ├── 7.jpg ├── 8.jpg ├── 9.jpg ├── PN.jpg ├── PN_1.jpg ├── illumilla_60K.jpg ├── illumilla_60K_Qc.jpg └── issue1.svg ├── R └── CMplot.r ├── README.md └── User Manual for CMplot.pdf /Figure/1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/1.jpg -------------------------------------------------------------------------------- /Figure/10.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/10.jpg -------------------------------------------------------------------------------- /Figure/11.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/11.jpg -------------------------------------------------------------------------------- /Figure/2-3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/2-3.jpg -------------------------------------------------------------------------------- /Figure/2-5.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/2-5.jpg -------------------------------------------------------------------------------- /Figure/2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/2.jpg -------------------------------------------------------------------------------- /Figure/2_2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/2_2.jpg -------------------------------------------------------------------------------- /Figure/2_4.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/2_4.jpg -------------------------------------------------------------------------------- /Figure/2_6.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/2_6.jpg -------------------------------------------------------------------------------- /Figure/2_6_1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/2_6_1.jpg -------------------------------------------------------------------------------- /Figure/2_6_2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/2_6_2.jpg -------------------------------------------------------------------------------- /Figure/3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/3.jpg -------------------------------------------------------------------------------- /Figure/4.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/4.jpg -------------------------------------------------------------------------------- /Figure/4_1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/4_1.jpg -------------------------------------------------------------------------------- /Figure/4_2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/4_2.jpg -------------------------------------------------------------------------------- /Figure/5.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/5.jpg -------------------------------------------------------------------------------- /Figure/5_new.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/5_new.jpg -------------------------------------------------------------------------------- /Figure/5_new_multi_xaxis.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/5_new_multi_xaxis.jpg -------------------------------------------------------------------------------- /Figure/6.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/6.jpg -------------------------------------------------------------------------------- /Figure/7.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/7.jpg -------------------------------------------------------------------------------- /Figure/8.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/8.jpg -------------------------------------------------------------------------------- /Figure/9.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/9.jpg -------------------------------------------------------------------------------- /Figure/PN.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/PN.jpg -------------------------------------------------------------------------------- /Figure/PN_1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/PN_1.jpg -------------------------------------------------------------------------------- /Figure/illumilla_60K.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/illumilla_60K.jpg -------------------------------------------------------------------------------- /Figure/illumilla_60K_Qc.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/Figure/illumilla_60K_Qc.jpg -------------------------------------------------------------------------------- /Figure/issue1.svg: -------------------------------------------------------------------------------- 1 | 2 | 16 | 18 | 19 | 21 | image/svg+xml 22 | 24 | 25 | 26 | 27 | 29 | 49 | 53 | 58 | 62 | 63 | 65 | 71 | 72 | 75 | 79 | 83 | 87 | 88 | 89 | -------------------------------------------------------------------------------- /R/CMplot.r: -------------------------------------------------------------------------------- 1 | CMplot <- function( 2 | Pmap, 3 | col=c("#4197d8", "#f8c120", "#413496", "#495226", "#d60b6f", "#e66519", "#d581b7", "#83d3ad", "#7c162c", "#26755d"), 4 | bin.size=1e6, 5 | bin.breaks=NULL, 6 | LOG10=TRUE, 7 | pch=19, 8 | type="p", 9 | band=1, 10 | H=1.5, 11 | ylim=NULL, 12 | axis.cex=1, 13 | axis.lwd=1.5, 14 | lab.cex=1.5, 15 | lab.font=2, 16 | plot.type=c("m","c","q","d"), 17 | multracks=FALSE, 18 | multracks.xaxis=FALSE, 19 | multraits=FALSE, 20 | points.alpha=100L, 21 | r=0.3, 22 | cex=c(0.5,1,1), 23 | outward=FALSE, 24 | ylab=expression(-log[10](italic(p))), 25 | ylab.pos=3, 26 | xticks.pos=1, 27 | mar=c(3,6,3,3), 28 | mar.between=0, 29 | threshold=NULL, 30 | threshold.col="red", 31 | threshold.lwd=1, 32 | threshold.lty=2, 33 | amplify= TRUE, 34 | signal.cex=1.5, 35 | signal.pch=19, 36 | signal.col=NULL, 37 | signal.line=2, 38 | highlight=NULL, 39 | highlight.cex=1, 40 | highlight.pch=19, 41 | highlight.type="p", 42 | highlight.col="red", 43 | highlight.text=NULL, 44 | highlight.text.col="black", 45 | highlight.text.cex=1, 46 | highlight.text.font=3, 47 | chr.labels=NULL, 48 | chr.border=FALSE, 49 | chr.labels.angle=0, 50 | chr.den.col="black", 51 | chr.pos.max=FALSE, 52 | cir.band=1, 53 | cir.chr=TRUE, 54 | cir.chr.h=1.5, 55 | cir.axis=TRUE, 56 | cir.axis.col="black", 57 | cir.axis.grid=TRUE, 58 | conf.int=TRUE, 59 | conf.int.col=NULL, 60 | file.output=TRUE, 61 | file.name=NULL, 62 | file=c("jpg","pdf","tiff","png"), 63 | dpi=300, 64 | height=NULL, 65 | width=NULL, 66 | main=NULL, 67 | main.cex=1.5, 68 | main.font=2, 69 | legend.ncol=NULL, 70 | legend.cex=1, 71 | legend.pos=c("left","middle","right","none"), 72 | box=FALSE, 73 | verbose=TRUE 74 | ) 75 | { 76 | 77 | #plot a circle with a radius of r 78 | circle.plot <- function(myr,type="l",x=NULL,lty=1,lwd=1,col="black",add=TRUE,n.point=1000) 79 | { 80 | curve(sqrt(myr^2-x^2),xlim=c(-myr,myr),n=n.point,ylim=c(-myr,myr),type=type,lty=lty,col=col,lwd=lwd,add=add) 81 | curve(-sqrt(myr^2-x^2),xlim=c(-myr,myr),n=n.point,ylim=c(-myr,myr),type=type,lty=lty,col=col,lwd=lwd,add=TRUE) 82 | } 83 | 84 | highlight_text <- function( 85 | x, 86 | y, 87 | words=NULL, 88 | point.cex=1, 89 | text.cex=1, 90 | pch=19, 91 | type = "p", 92 | point.col = "red", 93 | text.col = "black", 94 | text.font=3, 95 | xlim=c(-Inf, Inf), 96 | ylim=c(-Inf, Inf) 97 | ) 98 | { 99 | overlap <- function(x1, y1, sw1, sh1, boxes) { 100 | if (length(boxes) == 0) return(FALSE) 101 | for (i in c(1:length(boxes))) { 102 | bnds <- boxes[[i]] 103 | x2 <- bnds[1] 104 | y2 <- bnds[2] 105 | sw2 <- bnds[3] 106 | sh2 <- bnds[4] 107 | 108 | if (x1 < x2) 109 | overlap <- x1 + sw1 > x2 110 | else 111 | overlap <- x2 + sw2 > x1 112 | 113 | if (y1 < y2) 114 | overlap <- overlap && (y1 + sh1 > y2) 115 | else 116 | overlap <- overlap && (y2 + sh2 > y1) 117 | 118 | if (overlap) { 119 | return(TRUE) 120 | } 121 | } 122 | return(FALSE) 123 | } 124 | 125 | layout <- function(x, y, words, cex=1, xlim=c(-Inf, Inf), ylim=c(-Inf, Inf)) { 126 | sdx <- sd(x, na.rm=TRUE) 127 | sdy <- sd(y, na.rm=TRUE) 128 | if (sdx == 0) sdx <- 1 129 | if (sdy == 0) sdy <- 1 130 | boxes <- list() 131 | for(i in 1:length(words)){ 132 | wid <- strwidth(words[i], cex=cex[i]) 133 | ht <- strheight(words[i], cex=cex[i]) 134 | if(i <= (length(words) / 2)){ 135 | boxes[[length(boxes) + 1]] <- c(x[i]-0.5*wid, y[i]-0.5*ht, wid, ht) 136 | }else{ 137 | xupdt <- xrot <- x[i] 138 | yupdt <- yrot <- y[i] 139 | r <- 0 140 | theta <- runif(1, 0, 2 * pi) 141 | ht <- 1.5 * ht 142 | isOverlaped <- TRUE 143 | while(isOverlaped){ 144 | if( 145 | !overlap(xupdt-0.5*wid, yupdt-0.5*ht, wid, ht, boxes) && 146 | (xupdt-0.5*wid) > xlim[1] && 147 | (yupdt-0.5*ht) > ylim[1] && 148 | (xupdt+0.5*wid) < xlim[2] && 149 | (yupdt+0.5*ht) < ylim[2] 150 | ){ 151 | boxes[[length(boxes) + 1]] <- c(xupdt-0.5*wid, yupdt-0.5*ht, wid, ht) 152 | isOverlaped <- FALSE 153 | }else{ 154 | theta <- theta + 0.1 155 | r <- r + 0.001 / (2 * base::pi) 156 | xupdt <- xrot + 0.1 * sdx * r * cos(theta) 157 | yupdt <- yrot + sdy * r * sin(theta) 158 | } 159 | } 160 | } 161 | } 162 | result <- do.call(rbind, boxes) 163 | colnames(result) <- c("x", "y", "width", "ht") 164 | rownames(result) <- words 165 | result 166 | } 167 | 168 | if(!is.null(words)){ 169 | if(length(x) != length(words)) stop("length of highlighted labels is not equal to the highlighted SNPs.") 170 | indx <- order(y, decreasing=TRUE) 171 | x <- x[indx] 172 | y <- y[indx] 173 | words <- words[indx] 174 | if(length(point.cex)!=1){if(length(point.cex)==length(x)){point.cex=point.cex[indx]}else{stop("unequal length of 'cex' for highlighted points.")}}else{point.cex=rep(point.cex,length(x))} 175 | if(length(pch)!=1){if(length(pch)==length(x)){pch=pch[indx]}else{stop("unequal length of 'pch' for highlighted points.")}}else{pch=rep(pch,length(x))} 176 | if(length(point.col)!=1){if(length(point.col)==length(x)){point.col=point.col[indx]}else{stop("unequal length of 'col' for highlighted points.")}}else{point.col=rep(point.col,length(x))} 177 | if(length(text.col)!=1){if(length(text.col)==length(x)){text.col=text.col[indx]}else{stop("unequal length of 'col' for highlighted text.")}}else{text.col=rep(text.col,length(x))} 178 | if(length(text.cex)!=1){if(length(text.cex)==length(x)){text.cex=text.cex[indx]}else{stop("unequal length of 'cex' for highlighted text.")}}else{text.cex=rep(text.cex,length(x))} 179 | 180 | words_ety <- words[words == "" | is.na(words)] 181 | if(length(words_ety)){ 182 | logical_idx <- words == "" | is.na(words) 183 | if(type=="h"){ 184 | points(x[logical_idx],y[logical_idx],pch=pch[logical_idx],type="h",col=point.col[logical_idx], lwd=point.cex[logical_idx]+1) 185 | points(x[logical_idx],y[logical_idx],pch=pch[logical_idx],type="p",col=point.col[logical_idx], cex=point.cex[logical_idx]) 186 | }else if(type=="l"){ 187 | segments(x[logical_idx], ylim[1], x[logical_idx], ylim[2], col=point.col[logical_idx], lwd=point.cex[logical_idx], lty=2) 188 | }else{ 189 | points(x[logical_idx],y[logical_idx],pch=pch[logical_idx],type="p",col=point.col[logical_idx],cex=point.cex[logical_idx]) 190 | } 191 | words <- words[!logical_idx] 192 | x <- x[!logical_idx] 193 | y <- y[!logical_idx] 194 | point.cex <- point.cex[!logical_idx] 195 | pch <- pch[!logical_idx] 196 | point.col <- point.col[!logical_idx] 197 | text.col <- text.col[!logical_idx] 198 | text.cex <- text.cex[!logical_idx] 199 | } 200 | 201 | x1 <- x 202 | y1 <- y 203 | xadj <- sample(c(1.5, 0, -0.5), size=length(x), rep=TRUE) 204 | # xadj <- rep(c(1.5, 0, -0.5), length=max(3, length(x))) 205 | # xadj <- sort(xadj)[1:length(x)] 206 | # xadj[order(x)] <- xadj 207 | yadj <- rep(c(1.5, 0, -0.5), length=max(3, length(x))) 208 | yadj <- sort(yadj)[1:length(x)] 209 | for(i in 1:length(x)){ 210 | if(xadj[i] == 0){ 211 | if(yadj[i] == -0.5){ 212 | if((y[i] + 2*strheight(words[i],cex=text.cex)) > max(ylim)){ 213 | y[i] = y[i] - 1.5*strheight(words[i],cex=text.cex) 214 | }else{ 215 | y[i] = y[i] + 1.5*strheight(words[i],cex=text.cex) 216 | } 217 | } 218 | if(yadj[i] == 1.5) y[i] = y[i] - 1.5*strheight(words[i],cex=text.cex) 219 | }else{ 220 | if(yadj[i] == -0.5){ 221 | if((y[i] + 1.5*strheight(words[i],cex=text.cex)) > max(ylim)){ 222 | y[i] = y[i] - strheight(words[i],cex=text.cex) 223 | }else{ 224 | y[i] = y[i] + strheight(words[i],cex=text.cex) 225 | } 226 | } 227 | if(yadj[i] == -0.5) y[i] = y[i] + strheight(words[i],cex=text.cex) 228 | if(yadj[i] == 1.5) y[i] = y[i] - strheight(words[i],cex=text.cex) 229 | } 230 | if(xadj[i] == 1.5){ 231 | if((x[i] - 1.2*strwidth(words[i],cex=text.cex)) < min(xlim)){ 232 | x[i] = x[i] + 0.6*strwidth(words[i],cex=text.cex) 233 | }else{ 234 | x[i] = x[i] - 0.6*strwidth(words[i],cex=text.cex) 235 | } 236 | } 237 | if(xadj[i] == -0.5){ 238 | if((x[i] + 1.2*strwidth(words[i],cex=text.cex)) > max(xlim)){ 239 | x[i] = x[i] - 0.6*strwidth(words[i],cex=text.cex) 240 | }else{ 241 | x[i] = x[i] + 0.6*strwidth(words[i],cex=text.cex) 242 | } 243 | } 244 | } 245 | 246 | x <- c(x1,x) 247 | y <- c(y1,y) 248 | words <- c(rep("OO", length(words)), as.character(words)) 249 | lay <- layout(x=x,y=y,words=words,cex=c(rep(text.cex[1],length(x1)),text.cex),xlim=xlim,ylim=ylim) 250 | n <- length(x1) 251 | indd <- (n+1):length(x) 252 | for(i in indd){ 253 | xl <- lay[i,1] 254 | yl <- lay[i,2] 255 | w <- lay[i,3] 256 | h <- lay[i,4] 257 | nx <- xl + 0.5 * w 258 | ny <- yl + 0.5 * h 259 | if((nx + 0.5 * strwidth(words[i],cex=text.cex[i-n])) < x1[i-n]){ 260 | nx=nx + 0.5 * strwidth(words[i],cex=text.cex[i-n]) 261 | }else if((nx - 0.5 * strwidth(words[i],cex=text.cex[i-n])) > x1[i-n]){ 262 | nx=nx - 0.5 * strwidth(words[i],cex=text.cex[i-n]) 263 | } 264 | if((ny + strheight(words[i],cex=text.cex[i-n])) < y1[i-n]){ 265 | ny=ny + 0.5 * strheight(words[i],cex=text.cex[i-n]) 266 | }else if((ny - strheight(words[i],cex=text.cex[i-n])) > y1[i-n]){ 267 | ny=ny - 0.5 * strheight(words[i],cex=text.cex[i-n]) 268 | } 269 | # arrows(x1[i-n], y1[i-n], nx, ny, length=.08, angle=15, code=2, col="grey", lwd=2) 270 | segments(x1[i-n], y1[i-n], nx, ny, col="black", lwd=text.cex[i-n]) 271 | } 272 | if(type=="h"){ 273 | points(x1,y1,pch=pch,type="h",col=point.col, lwd=point.cex+1) 274 | points(x1,y1,pch=pch,type="p",col=point.col, cex=point.cex) 275 | }else if(type=="l"){ 276 | segments(x1, ylim[1], x1, ylim[2], col=point.col, lwd=point.cex, lty=2) 277 | # points(x1,y1,pch=pch,type="p",col=point.col, cex=point.cex) 278 | }else{ 279 | points(x1,y1,pch=pch,type=type,col=point.col,cex=point.cex) 280 | } 281 | text(lay[indd,1]+0.5*lay[indd,3],lay[indd,2]+0.5*lay[indd,4],words[indd],xpd=TRUE,cex=text.cex,col=text.col,font=text.font) 282 | }else{ 283 | if(type=="h"){ 284 | points(x,y,pch=pch,type="h",col=point.col, lwd=point.cex+1) 285 | points(x,y,pch=pch,type="p",col=point.col, cex=point.cex) 286 | }else if(type=="l"){ 287 | segments(x, ylim[1], x, ylim[2], col=point.col, lwd=point.cex, lty=2) 288 | # points(x,y,pch=pch,type="p",col=point.col, cex=point.cex) 289 | }else{ 290 | points(x,y,pch=pch,type=type,col=point.col,cex=point.cex) 291 | } 292 | } 293 | } 294 | 295 | max_ylim <- function(x){ 296 | if(x == 0) return(x) 297 | if(abs(x) >= 1){ 298 | return(ceiling(x)) 299 | }else{ 300 | if(x < 0){ 301 | digit <- 10^(-ceiling(-log10(abs(x)))) 302 | return(-(floor(abs(x) / digit - 1) * digit)) 303 | }else{ 304 | digit <- 10^(-ceiling(-log10(x))) 305 | return((floor(x / digit + 1) * digit)) 306 | } 307 | } 308 | } 309 | 310 | min_ylim <- function(x){ 311 | if(x == 0) return(x) 312 | if(abs(x) >= 1){ 313 | return(floor(x)) 314 | }else{ 315 | if(x < 0){ 316 | digit <- 10^(-ceiling(-log10(abs(x)))) 317 | return(-(floor(abs(x) / digit + 1) * digit)) 318 | }else{ 319 | digit <- 10^(-ceiling(-log10(x))) 320 | return((floor(x / digit - 1) * digit)) 321 | } 322 | } 323 | } 324 | 325 | min_no_na <- function(x){ 326 | return(min(x, na.rm=TRUE)) 327 | } 328 | 329 | max_no_na <- function(x){ 330 | return(max(x, na.rm=TRUE)) 331 | } 332 | 333 | # created by Haohao Zhang 334 | filter.points <- function(x, y, w, h, dpi, scale=1) { 335 | x <- ceiling((x - min(x, na.rm=TRUE)) / (max(x, na.rm=TRUE) - min(x, na.rm=TRUE)) * w * dpi / scale) 336 | y <- ceiling((y - min(y, na.rm=TRUE)) / (max(y, na.rm=TRUE) - min(y, na.rm=TRUE)) * h * dpi / scale) 337 | index <- !duplicated(cbind(x, y)) 338 | } 339 | 340 | DensityPlot <- function( 341 | chr, 342 | pos, 343 | chr.orig.labels, 344 | col=c("darkgreen", "yellow", "red"), 345 | main=NULL, 346 | main.cex=1.2, 347 | main.font=2, 348 | chr.labels=NULL, 349 | chr.pos.max=FALSE, 350 | bin=1e6, 351 | bin.breaks=NULL, 352 | band=3, 353 | width=5, 354 | legend.cex=1, 355 | legend.y.intersp=1, 356 | legend.x.intersp=1, 357 | xticks.pos=1, 358 | plot=TRUE, 359 | dpi=NULL, 360 | wh=NULL, 361 | ht=NULL 362 | ) 363 | { 364 | legend.min <- 1 365 | legend.max <- NULL 366 | if(is.null(legend.cex)) legend.cex = 1 367 | if(!is.null(bin.breaks)){ 368 | bin.breaks <- sort(bin.breaks) 369 | if(sum(bin.breaks < 0)) stop("breaks should not contain a negative value.") 370 | if(bin.breaks[1]){ 371 | legend.min <- bin.breaks[1] 372 | }else{ 373 | bin.breaks <- bin.breaks[-1] 374 | } 375 | legend.max <- bin.breaks[length(bin.breaks)] 376 | } 377 | if(is.null(col) | length(col) == 1){col=c("darkgreen", "yellow", "red")} 378 | max.chr <- max(chr) 379 | chr.num <- unique(chr) 380 | chorm.maxlen <- max(pos) 381 | bp <- ifelse(chorm.maxlen < 1e3, 1, ifelse(chorm.maxlen < 1e6, 1e3, 1e6)) 382 | bp_label <- ifelse(bp == 1, "bp", ifelse(bp == 1e3, "Kb", "Mb")) 383 | if(is.null(main)) main <- paste("The number of SNPs within ", bin / bp, bp_label, " window size", sep="") 384 | if(plot) plot(NULL, xlim=c(0, chorm.maxlen + chorm.maxlen/10), ylim=c(0, length(chr.num) * band + band), main=main, cex.main=main.cex, font.main=main.font, axes=FALSE, xlab="", ylab="", xaxs="i", yaxs="i") 385 | pos.x <- list() 386 | chr.pos.max.v <- NULL 387 | col.index <- list() 388 | maxbin.num <- NULL 389 | windinfo <- list() 390 | for(i in 1 : length(chr.num)){ 391 | pos.x[[i]] <- pos[chr == chr.num[i]] 392 | maxposindx <- which.max(pos.x[[i]]) 393 | max.pos <- pos.x[[i]][maxposindx] 394 | chr.pos.max.v <- c(chr.pos.max.v, max.pos) 395 | cut.breaks <- seq(0, max.pos, bin) 396 | cut.len <- length(cut.breaks) 397 | if(cut.breaks[length(cut.breaks)] < max.pos) cut.breaks <- c(cut.breaks, cut.breaks[length(cut.breaks)] + bin) 398 | if(chr.pos.max){ 399 | pos.x[[i]] <- pos.x[[i]][-maxposindx] 400 | } 401 | if(cut.len <= 1){ 402 | maxbin.num <- c(maxbin.num, length(pos.x[[i]])) 403 | col.index[[i]] <- rep(length(pos.x[[i]]), length(pos.x[[i]])) 404 | names(col.index[[i]]) <- 1 405 | }else{ 406 | cut.r <- cut(pos.x[[i]], cut.breaks, labels=FALSE) 407 | eachbin.num <- table(cut.r) 408 | maxbin.num <- c(maxbin.num, max(eachbin.num)) 409 | col.index[[i]] <- rep(eachbin.num, eachbin.num) 410 | } 411 | if(plot){ 412 | windinfo <- c(windinfo, tapply(pos.x[[i]], as.numeric(names(col.index[[i]])), function(x){ 413 | return(c(ifelse(!is.null(chr.labels), chr.labels[i], chr.orig.labels[i]), 414 | min(x),max(x),length(x)))}) 415 | ) 416 | } 417 | } 418 | if(plot){ 419 | windinfo <- as.data.frame(do.call(rbind, windinfo)) 420 | colnames(windinfo) <- c("Chr", "Start", "End", "Num") 421 | rownames(windinfo) <- NULL 422 | for(i in 2:ncol(windinfo)){windinfo[, i]<-as.numeric(windinfo[, i])} 423 | } 424 | Maxbin.num <- max(maxbin.num) 425 | maxbin.num <- Maxbin.num 426 | if(!is.null(legend.max)){ 427 | maxbin.num <- legend.max 428 | } 429 | if(Maxbin.num < legend.min) stop("the maximum number of markers in windows is smaller than the lower boundary of breaks.") 430 | col=colorRampPalette(col)(maxbin.num - legend.min + 1) 431 | col.seg=NULL 432 | for(i in 1 : length(chr.num)){ 433 | if(plot){ 434 | polygon(c(0, 0, chr.pos.max.v[i], chr.pos.max.v[i]), 435 | c(-width/5 - band * (i - length(chr.num) - 1), width/5 - band * (i - length(chr.num) - 1), 436 | width/5 - band * (i - length(chr.num) - 1), -width/5 - band * (i - length(chr.num) - 1)), col="grey95", border="grey95") 437 | rect(xleft=0, ybottom = -width/5 - band * (i - length(chr.num) - 1), xright=chr.pos.max.v[i], ytop=width/5 - band * (i - length(chr.num) - 1), border="grey80") 438 | } 439 | if(!is.null(legend.max)){ 440 | if(legend.max < Maxbin.num){ 441 | col.index[[i]][col.index[[i]] > legend.max] <- legend.max 442 | } 443 | } 444 | col.index[[i]][col.index[[i]] < legend.min] <- legend.min 445 | if(!plot) col.seg <- c(col.seg, col[col.index[[i]] - legend.min + 1]) 446 | if(!is.null(ht) && !is.null(wh) && !is.null(dpi)){ 447 | is_visable <- filter.points(pos.x[[i]], -width/5 - band * (i - length(chr.num) - 1), wh * (max(pos.x[[i]])/chorm.maxlen), ht, dpi=dpi) 448 | if(plot) segments(pos.x[[i]][is_visable], -width/5 - band * (i - length(chr.num) - 1), pos.x[[i]][is_visable], width/5 - band * (i - length(chr.num) - 1), 449 | col=col[col.index[[i]][is_visable] - legend.min + 1], lwd=1) 450 | }else{ 451 | if(plot) segments(pos.x[[i]], -width/5 - band * (i - length(chr.num) - 1), pos.x[[i]], width/5 - band * (i - length(chr.num) - 1), 452 | col=col[col.index[[i]] - legend.min + 1], lwd=1) 453 | } 454 | } 455 | 456 | chr.num <- rev(chr.orig.labels) 457 | if(plot){ 458 | if(!is.null(chr.labels)){ 459 | mtext(at=seq(band, length(chr.num) * band, band), text=chr.labels, side=2, las=2, font=1, cex=axis.cex*0.6, line=0.2, xpd=TRUE) 460 | }else{ 461 | if(max.chr == 0) mtext(at=seq(band, length(chr.num) * band, band), text=chr.num, side=2, las=2, font=1, cex=axis.cex*0.6, line=0.2, xpd=TRUE) 462 | if(max.chr != 0) mtext(at=seq(band, length(chr.num) * band, band), text=paste("Chr", chr.num, sep=""), side=2, las=2, font=1, cex=axis.cex*0.6, line=0.2, xpd=TRUE) 463 | } 464 | } 465 | if(plot){ 466 | xticks=seq(0, chorm.maxlen / bp, length=10) 467 | 468 | if(round(xticks[2]) <= 10){ 469 | xticks=seq(0, chorm.maxlen / bp, round(xticks[2], 1)) 470 | }else{ 471 | xticks=seq(0, chorm.maxlen / bp, round(xticks[2])) 472 | } 473 | 474 | if((chorm.maxlen/bp - max(xticks)) > 0.5*xticks[2]){ 475 | xticks=c(xticks, round(chorm.maxlen / bp)) 476 | } 477 | axis(3, mgp=c(3,xticks.pos,0), at=xticks*bp, labels=paste(xticks, bp_label, sep=""), font=1, cex.axis=axis.cex*0.8, tck=0.01, lwd=axis.lwd, padj=1.2) 478 | axis(3, at=c(0, chorm.maxlen), labels=c("",""), tcl=0, lwd=axis.lwd) 479 | } 480 | 481 | if(is.null(bin.breaks)){ 482 | legend.len <- 10 483 | if(maxbin.num <= legend.len) legend.len <- maxbin.num 484 | legend.y <- round(seq(0, maxbin.num, length=legend.len + 1)) 485 | legend.y <- unique(legend.y) 486 | len <- ifelse(length(legend.y)==1, 1, legend.y[2]) 487 | legend.y <- seq(legend.y[2], maxbin.num, len) 488 | }else{ 489 | legend.y <- bin.breaks 490 | } 491 | 492 | if(!is.null(bin.breaks)){ 493 | if(legend.max < Maxbin.num){ 494 | legend.y[length(legend.y)] <- paste(">=", maxbin.num, sep="") 495 | legend.y.col <- c(legend.y[c(-length(legend.y))], maxbin.num) 496 | }else{ 497 | legend.y.col <- legend.y 498 | } 499 | }else{ 500 | legend.y.col <- legend.y 501 | } 502 | if(legend.min != 1){ 503 | legend.y[1] <- paste("<=", legend.min, sep="") 504 | } 505 | legend.y <- c("0", legend.y) 506 | legend.y.col <- as.numeric(legend.y.col) 507 | legend.col <- c("grey95", col[legend.y.col - legend.min + 1]) 508 | if(plot){ 509 | legend(x=(chorm.maxlen + chorm.maxlen/50), y=(-width/2.5 + band), title="", legend=legend.y, pch=15, pt.cex=legend.cex*3, col=legend.col, 510 | cex=legend.cex, bty="n", y.intersp=legend.y.intersp, x.intersp=legend.x.intersp, yjust=0, xjust=0, xpd=TRUE) 511 | return(windinfo) 512 | }else{ 513 | return(list(den.col=col.seg, legend.col=legend.col, legend.y=legend.y)) 514 | } 515 | } 516 | 517 | if(!all(plot.type %in% c("c","m","q","d"))) stop("unknown 'plot.type'.") 518 | legend.pos <- match.arg(legend.pos) 519 | file <- match.arg(file) 520 | trait <- colnames(Pmap)[-c(1:3)] 521 | if(length(trait) == 0) trait <- paste("Trait", 1:(ncol(Pmap)-3), sep="") 522 | taxa <- paste(trait, collapse="_") 523 | 524 | if(length(points.alpha) != 1L) stop("invalid 'points.alpha': must be 'TRUE', 'FALSE' or an integer between 0 and 255") 525 | if(is.logical(points.alpha)) points.alpha <- ifelse(points.alpha, formals()$points.alpha, 255L) 526 | if(!is.integer(points.alpha)){ 527 | if(is.numeric(points.alpha) && points.alpha == as.integer(points.alpha)) points.alpha <- as.integer(points.alpha) 528 | else stop("invalid 'points.alpha': must an integer between") 529 | } 530 | if(!is.integer(points.alpha)) stop("invalid 'points.alpha': must an integer between") 531 | if(points.alpha < 0L || points.alpha > 255L) stop("out-of range 'points.alpha': must be between 0 and 255") 532 | 533 | #get the number of traits 534 | R=ncol(Pmap)-3 535 | 536 | #remove illegal SNPs 537 | suppressWarnings(Pmap <- Pmap[Pmap[, 2] != "0", ]) 538 | Pmap <- as.matrix(Pmap) 539 | Pmap <- Pmap[!is.na(Pmap[, 2]), ] 540 | suppressWarnings(Pmap <- Pmap[!is.na(as.numeric(Pmap[, 3])), ]) 541 | 542 | #replace the non-euchromosome 543 | suppressWarnings(numeric.chr <- as.numeric(Pmap[, 2])) 544 | suppressWarnings(max.chr <- max(numeric.chr, na.rm=TRUE)) 545 | if(is.infinite(max.chr)) max.chr <- 0 546 | suppressWarnings(map.xy.index <- which(!numeric.chr %in% c(0:max.chr))) 547 | if(length(map.xy.index) != 0){ 548 | chr.xy <- unique(Pmap[map.xy.index, 2]) 549 | for(i in 1:length(chr.xy)){ 550 | Pmap[Pmap[, 2] == chr.xy[i], 2] <- max.chr + i 551 | } 552 | } 553 | SNP_id <- Pmap[,1] 554 | 555 | #delete the column of SNPs names 556 | Pmap <- Pmap[, -1] 557 | Pmap <- apply(Pmap, 2, as.numeric) 558 | order_index <- order(Pmap[, 1], Pmap[,2]) 559 | 560 | #order the GWAS results by chromosome and position 561 | Pmap <- Pmap[order_index, ] 562 | SNP_id <- SNP_id[order_index] 563 | 564 | chr <- unique(Pmap[,1]) 565 | chr.ori <- chr 566 | if(length(map.xy.index) != 0){ 567 | for(i in 1:length(chr.xy)){ 568 | chr.ori[chr.ori == max.chr + i] <- chr.xy[i] 569 | } 570 | } 571 | 572 | #SNP-Density plot 573 | wind_snp_num <- NULL 574 | if("d" %in% plot.type){ 575 | if(verbose) cat(" Marker density plotting.\n") 576 | if(file.output){ 577 | ht=ifelse(is.null(height), 6, height) 578 | wh=ifelse(is.null(width), 9, width) 579 | if(file=="jpg") jpeg(paste("Marker_Density.",ifelse(is.null(file.name),taxa,file.name[1]),".jpg",sep=""), width=wh*dpi,height=ht*dpi,res=dpi,quality=100) 580 | if(file=="pdf") pdf(paste("Marker_Density.",ifelse(is.null(file.name),taxa,file.name[1]),".pdf",sep=""), width=wh,height=ht) 581 | if(file=="tiff") tiff(paste("Marker_Density.",ifelse(is.null(file.name),taxa,file.name[1]),".tiff",sep=""), width=wh*dpi,height=ht*dpi,res=dpi) 582 | if(file=="png") png(paste("Marker_Density.",ifelse(is.null(file.name),taxa,file.name[1]),".png",sep=""), width=wh*dpi,height=ht*dpi,res=dpi,bg=NA) 583 | # par(xpd=TRUE) 584 | par(mar=c(mar[1]-2, mar[2]-1, mar[3]+1, mar[4])) 585 | }else{ 586 | ht=ifelse(is.null(height), 6, height) 587 | wh=ifelse(is.null(width), 9, width) 588 | if(is.null(dev.list())) dev.new(width=wh,height=ht) 589 | # par(xpd=TRUE) 590 | } 591 | wind_snp_num <- DensityPlot(Pmap[, 1], Pmap[, 2], chr.ori, chr.pos.max=chr.pos.max, dpi=dpi, wh=wh, ht=ht, chr.labels=chr.labels, col=chr.den.col, bin=bin.size, bin.breaks=bin.breaks, main=main[1], main.cex=main.cex, main.font=main.font, legend.cex=legend.cex, xticks.pos=xticks.pos) 592 | if(file.output) dev.off() 593 | } 594 | 595 | if(length(plot.type) > 1 | (!"d" %in% plot.type)){ 596 | 597 | #scale and adjust the parameters 598 | cir.chr.h <- cir.chr.h/5 599 | cir.band <- cir.band/5 600 | if(!is.null(threshold)){ 601 | if(!is.list(threshold)){ 602 | thresholdlist <- list() 603 | for(i in 1:R){ 604 | thresholdlist[[i]] <- threshold 605 | } 606 | threshold <- thresholdlist 607 | } 608 | 609 | if(LOG10){ 610 | if(sum(unlist(threshold) <= 0) != 0) stop("threshold must be greater than 0.") 611 | } 612 | 613 | threshold.col <- rep(threshold.col, max(sapply(threshold, length))) 614 | threshold.lwd <- rep(threshold.lwd, max(sapply(threshold, length))) 615 | threshold.lty <- rep(threshold.lty, max(sapply(threshold, length))) 616 | signal.col <- rep(signal.col, max(sapply(threshold, length))) 617 | signal.pch <- rep(signal.pch, max(sapply(threshold, length))) 618 | signal.cex <- rep(signal.cex, max(sapply(threshold, length))) 619 | } 620 | if(length(cex)!=3) cex <- rep(cex,3) 621 | 622 | if(!is.null(ylim)){ 623 | if(!is.list(ylim)){ 624 | if(R > 1) cat(" (warning: all phenotypes will use the same ylim.)\n") 625 | if(length(ylim)!=2) stop("ylim for each phenotype should be assigned two values.") 626 | if(ylim[2] <= ylim[1]) stop("second value should be larger than the first in ylim.") 627 | ylimlist <- list() 628 | for(i in 1:R){ 629 | ylimlist[[i]] <- ylim 630 | } 631 | ylim <- ylimlist 632 | }else{ 633 | if(length(ylim)!=R) stop("length of list of ylim should equal to the number of phenotype.") 634 | for(i in 1:R){ 635 | if(length(ylim[[i]])!=2) stop("ylim for each phenotype should be assigned two values.") 636 | if(ylim[[i]][2] <= ylim[[i]][1]) stop("second value should be larger than the first in ylim.") 637 | } 638 | } 639 | } 640 | 641 | if(!is.null(conf.int.col)) conf.int.col <- rep(conf.int.col, R) 642 | if(!is.null(main)) main <- rep(main, R) 643 | if(length(mar) != 4) stop("length of 'mar' shoud equal to 4.") 644 | if(chr.labels.angle > 90 | chr.labels.angle < -90) stop("'chr.labels.angle' should be > -90 and < 90.") 645 | pch=rep(pch, R) 646 | 647 | if(!is.null(highlight)){ 648 | highlight_index <- list() 649 | highlight_col <- list() 650 | if(is.list(highlight.col)){ 651 | if(length(highlight.col) != R){stop("length of 'highlight.col' not equals to the number of traits.")} 652 | highlight_col=highlight.col 653 | } 654 | if(!is.list(highlight)){ 655 | highlight <- list(highlight) 656 | for(i in 1:R){highlight[[i]] = highlight[[1]]} 657 | }else{ 658 | if(length(highlight) != R){stop("length of 'highlight' not equals to the number of traits.")} 659 | } 660 | length(highlight_index) <- length(highlight) 661 | for(i in 1:length(highlight)){ 662 | if(sum(!is.na(highlight[[i]])) == 0 | length(highlight[[i]]) == 0){ 663 | highlight_index[[i]] <- NA 664 | highlight_col[[i]] <- NA 665 | }else{ 666 | highlight[[i]] <- highlight[[i]][!is.na(highlight[[i]])] 667 | highlight_index[[i]] <- match(as.character(as.matrix(highlight[[i]])), SNP_id) 668 | if(all(is.na(highlight_index[[i]]))) stop("No shared SNPs between Pmap and highlight!") 669 | highlight_index[[i]] <- na.omit(highlight_index[[i]]) 670 | if(!is.null(highlight.col) && !is.list(highlight.col)) highlight_col[[i]] <- highlight.col 671 | } 672 | } 673 | } 674 | 675 | if(!is.null(highlight.text)){ 676 | if(!is.list(highlight.text)){ 677 | highlight.text <- list(highlight.text) 678 | for(i in 1:R){highlight.text[[i]] = highlight.text[[1]]} 679 | }else{ 680 | if(length(highlight.text) != R){stop("length of 'highlight.text' not equals to the number of traits.")} 681 | } 682 | } 683 | 684 | pvalueT <- as.matrix(Pmap[,-c(1:2)]) 685 | pvalue.pos <- Pmap[, 2] 686 | pvalue.pos.list <- tapply(pvalue.pos, Pmap[, 1], list) 687 | 688 | #scale the space parameter between chromosomes 689 | if(!missing(band)){ 690 | band <- floor(band*(sum(sapply(pvalue.pos.list, max)) - min(unlist(pvalue.pos.list)))/100) 691 | }else{ 692 | band <- floor((sum(sapply(pvalue.pos.list, max)) - min(unlist(pvalue.pos.list)))/100) 693 | } 694 | if(band==0) band=100 695 | 696 | if(LOG10){ 697 | if(sum(pvalueT <= 0, na.rm=TRUE) != 0 || sum(pvalueT > 1, na.rm=TRUE) != 0) stop("p values should be at range of (0, 1).") 698 | pvalueT[pvalueT <= 0] <- NA 699 | pvalueT[pvalueT > 1] <- NA 700 | } 701 | Pmap[,-c(1:2)] <- pvalueT 702 | 703 | #set the colors for the plot 704 | if(is.vector(col)){ 705 | col <- matrix(col,R,length(col),byrow=TRUE) 706 | } 707 | if(is.matrix(col)){ 708 | #try to transform the colors into matrix for all traits 709 | col <- matrix(as.vector(t(col)),R,dim(col)[2],byrow=TRUE) 710 | } 711 | 712 | Num <- as.numeric(table(Pmap[,1])) 713 | Nchr <- length(Num) 714 | N <- NULL 715 | 716 | #set the colors for each traits 717 | for(i in 1:R){ 718 | colx <- col[i,] 719 | colx <- colx[!is.na(colx)] 720 | N[i] <- ceiling(Nchr/length(colx)) 721 | } 722 | 723 | #insert the space into chromosomes and return the midpoint of each chromosome 724 | ticks <- NULL 725 | chr.border.pos <- NULL 726 | pvalue.posN <- NULL 727 | #pvalue <- pvalueT[,j] 728 | if(Nchr == 1){ 729 | bp <- ifelse((max_no_na(pvalue.pos.list[[1]]) - min_no_na(pvalue.pos.list[[1]])) > 1000000, 1000000, 1000) 730 | bp_lab <- ifelse(bp == 1000000, " (Mb)", " (Kb)") 731 | pvalue.posN <- pvalue.pos.list[[1]] + band 732 | ticks <- seq(min_no_na(pvalue.pos.list[[1]]), max_no_na(pvalue.pos.list[[1]]), length=10) 733 | ticks <- seq(round(min_no_na(pvalue.pos.list[[1]]) / bp), round(max_no_na(pvalue.pos.list[[1]]) / bp), round((ticks[2]-ticks[1])/bp) + 0.5) 734 | if(!round(max_no_na(pvalue.pos.list[[1]]) / bp) %in% ticks){ 735 | if(round(max_no_na(pvalue.pos.list[[1]]) / bp) - ticks[length(ticks)] > 0.5 * ticks[2]) 736 | ticks <- c(ticks, round(max_no_na(pvalue.pos.list[[1]]) / bp)) 737 | } 738 | ticks <- ticks[-1] 739 | chr.labels <- ticks 740 | ticks <- ticks * bp + band 741 | chr.border <- FALSE 742 | }else{ 743 | for(i in 0:(Nchr-1)){ 744 | if (i==0){ 745 | #pvalue <- append(pvalue,rep(Inf,band),after=0) 746 | pvalue.posN <- pvalue.pos.list[[i+1]] + band 747 | ticks[i+1] <- floor((max_no_na(pvalue.posN)+min_no_na(pvalue.pos.list[[i+1]])+band)/2) 748 | chr.border.pos[i+1] <- max_no_na(pvalue.posN) + 0.5 * band 749 | }else{ 750 | #pvalue <- append(pvalue,rep(Inf,band),after=sum(Num[1:i])+i*band) 751 | pvalue.posN <- c(pvalue.posN, max_no_na(pvalue.posN) + band + pvalue.pos.list[[i+1]]) 752 | ticks[i+1] <- max_no_na(pvalue.posN)-floor(max_no_na(pvalue.pos.list[[i+1]])/2) 753 | chr.border.pos[i+1] <- max_no_na(pvalue.posN) + 0.5 * band 754 | } 755 | } 756 | chr.border.pos=chr.border.pos[-length(chr.border.pos)] 757 | } 758 | 759 | if(!is.null(chr.labels) & Nchr != 1){ 760 | chr.labels <- as.character(chr.labels) 761 | if(length(chr.labels) != Nchr) stop("length of 'chr.labels' should equal to the number of chromosomes.") 762 | ticks.logi <- rep(TRUE, length(ticks)) 763 | for(ti in 1:Nchr){ 764 | if(is.na(chr.labels[ti])) ticks.logi[ti] <- FALSE 765 | } 766 | if(!all(ticks.logi)){ 767 | chr.labels <- chr.labels[ticks.logi] 768 | ticks <- ticks[ticks.logi] 769 | } 770 | } 771 | 772 | pvalue.posN.list <- tapply(pvalue.posN, Pmap[, 1], list) 773 | 774 | #merge the pvalues of traits by column 775 | if(LOG10){ 776 | logpvalueT <- -log10(pvalueT) 777 | }else{ 778 | logpvalueT <- pvalueT 779 | } 780 | 781 | add <- list() 782 | for(i in 1:R){ 783 | colx <- col[i,] 784 | colx <- colx[!is.na(colx)] 785 | add[[i]] <- c(Num,rep(0,N[i]*length(colx)-Nchr)) 786 | } 787 | 788 | circleMin <- (min_no_na(pvalue.posN) - band - 1) 789 | TotalN <- max_no_na(pvalue.posN)-circleMin 790 | 791 | if(length(chr.den.col) > 1){ 792 | cir.density=TRUE 793 | den.fold <- 20 794 | density.list <- DensityPlot(Pmap[, 1], Pmap[, 2], chr.ori, chr.pos.max=FALSE, col=chr.den.col, plot=FALSE, bin=bin.size, bin.breaks=bin.breaks) 795 | }else{ 796 | cir.density=FALSE 797 | } 798 | } 799 | 800 | #plot circle Manhattan 801 | if("c" %in% plot.type){ 802 | 803 | signal.line.index <- NULL 804 | if(!is.null(threshold)){ 805 | if(!is.null(signal.line)){ 806 | for(l in 1:R){ 807 | if(!is.null(threshold[[l]])){ 808 | if(LOG10){ 809 | signal.line.index <- c(signal.line.index,which(pvalueT[,l] < min_no_na(threshold[[l]]))) 810 | }else{ 811 | signal.line.index <- c(signal.line.index,which(pvalueT[,l] > max_no_na(threshold[[l]]))) 812 | } 813 | } 814 | } 815 | signal.line.index <- unique(signal.line.index) 816 | } 817 | signal.line.index <- pvalue.posN[signal.line.index] 818 | } 819 | 820 | if(file.output){ 821 | ht=ifelse(is.null(height), 10, height) 822 | wh=ifelse(is.null(width), 10, width) 823 | if(file=="jpg") jpeg(paste("Cir_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".jpg",sep=""), width=wh*dpi,height=ht*dpi,res=dpi,quality=100) 824 | if(file=="pdf") pdf(paste("Cir_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".pdf",sep=""), width=wh,height=ht) 825 | if(file=="tiff") tiff(paste("Cir_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".tiff",sep=""), width=wh*dpi,height=ht*dpi,res=dpi) 826 | if(file=="png") png(paste("Cir_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".png",sep=""), width=wh*dpi,height=ht*dpi,res=dpi,bg=NA) 827 | par(pty="s", xpd=TRUE, mar=c(1,1,1,1)) 828 | } 829 | if(!file.output){ 830 | ht=ifelse(is.null(height), 10, height) 831 | wh=ifelse(is.null(width), 10, width) 832 | if(is.null(dev.list())) dev.new(width=wh, height=ht) 833 | par(pty="s", xpd=TRUE) 834 | } 835 | RR <- r+H*R+cir.band*R 836 | if(cir.density){ 837 | plot(NULL,xlim=c(1.05*(-RR-4*cir.chr.h),1.1*(RR+4*cir.chr.h)),ylim=c(1.05*(-RR-4*cir.chr.h),1.1*(RR+4*cir.chr.h)),axes=FALSE,xlab="",ylab="") 838 | }else{ 839 | plot(NULL,xlim=c(1.05*(-RR-4*cir.chr.h),1.05*(RR+4*cir.chr.h)),ylim=c(1.05*(-RR-4*cir.chr.h),1.05*(RR+4*cir.chr.h)),axes=FALSE,xlab="",ylab="") 840 | } 841 | if(!is.null(signal.line)){ 842 | if(!is.null(signal.line.index)){ 843 | X1chr <- (RR)*sin(2*base::pi*(signal.line.index-round(band/2)-circleMin)/TotalN) 844 | Y1chr <- (RR)*cos(2*base::pi*(signal.line.index-round(band/2)-circleMin)/TotalN) 845 | X2chr <- (r)*sin(2*base::pi*(signal.line.index-round(band/2)-circleMin)/TotalN) 846 | Y2chr <- (r)*cos(2*base::pi*(signal.line.index-round(band/2)-circleMin)/TotalN) 847 | segments(X1chr,Y1chr,X2chr,Y2chr,lty=2,lwd=signal.line,col="grey") 848 | } 849 | } 850 | for(i in 1:R){ 851 | 852 | #get the colors for each trait 853 | colx <- col[i,] 854 | colx <- colx[!is.na(colx)] 855 | 856 | if(verbose) cat(paste(" Circular Manhattan plotting ",trait[i],".\n",sep="")) 857 | pvalue <- pvalueT[,i] 858 | logpvalue <- logpvalueT[,i] 859 | if(is.null(ylim)){ 860 | if(LOG10){ 861 | Max <- max_ylim(-log10(min_no_na(pvalue))) 862 | Min <- min_ylim(-log10(max_no_na(pvalue))) 863 | }else{ 864 | Max <- max_ylim(max_no_na(pvalue)) 865 | #if(abs(Max)<=1) Max <- max_no_na(pvalue) 866 | Min <- min_ylim(min_no_na(pvalue)) 867 | #if(abs(Min)<=1) Min <- min_no_na(pvalue) 868 | } 869 | }else{ 870 | Max <- ylim[[i]][2] 871 | Min <- ylim[[i]][1] 872 | } 873 | Cpvalue <- (H*(logpvalue-Min))/(Max-Min) 874 | ylimIndx <- logpvalue >= Min & logpvalue <= Max 875 | if(outward==TRUE){ 876 | if(cir.chr==TRUE & i == 1){ 877 | 878 | #plot the boundary which represents the chromosomes 879 | polygon.num <- 1000 880 | for(k in 1:length(chr)){ 881 | if(k==1){ 882 | polygon.index <- seq(round(band/2)+1,-round(band/2)-circleMin+max_no_na(pvalue.posN.list[[1]]), length=polygon.num) 883 | #change the axis from right angle into circle format 884 | X1chr=(RR)*sin(2*base::pi*(polygon.index)/TotalN) 885 | Y1chr=(RR)*cos(2*base::pi*(polygon.index)/TotalN) 886 | X2chr=(RR+cir.chr.h)*sin(2*base::pi*(polygon.index)/TotalN) 887 | Y2chr=(RR+cir.chr.h)*cos(2*base::pi*(polygon.index)/TotalN) 888 | if(is.null(chr.den.col)){ 889 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col=rep(colx,ceiling(length(chr)/length(colx)))[k],border=rep(colx,ceiling(length(chr)/length(colx)))[k]) 890 | }else{ 891 | if(cir.density){ 892 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col="grey",border="grey") 893 | }else{ 894 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col=chr.den.col,border=chr.den.col) 895 | } 896 | } 897 | }else{ 898 | polygon.index <- seq(1+round(band/2)+max_no_na(pvalue.posN.list[[k-1]])-circleMin,-round(band/2)-circleMin+max_no_na(pvalue.posN.list[[k]]), length=polygon.num) 899 | X1chr=(RR)*sin(2*base::pi*(polygon.index)/TotalN) 900 | Y1chr=(RR)*cos(2*base::pi*(polygon.index)/TotalN) 901 | X2chr=(RR+cir.chr.h)*sin(2*base::pi*(polygon.index)/TotalN) 902 | Y2chr=(RR+cir.chr.h)*cos(2*base::pi*(polygon.index)/TotalN) 903 | if(is.null(chr.den.col)){ 904 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col=rep(colx,ceiling(length(chr)/length(colx)))[k],border=rep(colx,ceiling(length(chr)/length(colx)))[k]) 905 | }else{ 906 | if(cir.density){ 907 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col="grey",border="grey") 908 | }else{ 909 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col=chr.den.col,border=chr.den.col) 910 | } 911 | } 912 | } 913 | } 914 | 915 | if(cir.density){ 916 | 917 | if(file.output){ 918 | is_visable <- filter.points((RR+cir.chr.h)*sin(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN), (RR+cir.chr.h)*cos(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN), wh, ht, dpi=dpi) 919 | }else{ 920 | is_visable <- rep(TRUE, length(pvalue.posN)) 921 | } 922 | segments( 923 | (RR)*sin(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN)[is_visable], 924 | (RR)*cos(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN)[is_visable], 925 | (RR+cir.chr.h)*sin(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN)[is_visable], 926 | (RR+cir.chr.h)*cos(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN)[is_visable], 927 | col=density.list$den.col[is_visable], lwd=0.5 928 | ) 929 | legend( 930 | x=RR+4*cir.chr.h, 931 | y=(RR+4*cir.chr.h)/2, 932 | title="", legend=density.list$legend.y, pch=15, pt.cex=3, col=density.list$legend.col, 933 | cex=legend.cex, bty="n", 934 | y.intersp=1, 935 | x.intersp=1, 936 | yjust=0.3, xjust=0, xpd=TRUE 937 | ) 938 | 939 | } 940 | 941 | # XLine=(RR+cir.chr.h)*sin(2*base::pi*(1:TotalN)/TotalN) 942 | # YLine=(RR+cir.chr.h)*cos(2*base::pi*(1:TotalN)/TotalN) 943 | # lines(XLine,YLine,lwd=1.5) 944 | if(cir.density){ 945 | circle.plot(myr=RR+cir.chr.h,lwd=1.5,add=TRUE,col='grey') 946 | circle.plot(myr=RR,lwd=1.5,add=TRUE,col='grey') 947 | }else{ 948 | circle.plot(myr=RR+cir.chr.h,lwd=1.5,add=TRUE) 949 | circle.plot(myr=RR,lwd=1.5,add=TRUE) 950 | } 951 | 952 | } 953 | 954 | X=(Cpvalue[ylimIndx]+r+H*(i-1)+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[ylimIndx]-round(band/2)-circleMin)/TotalN) 955 | Y=(Cpvalue[ylimIndx]+r+H*(i-1)+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[ylimIndx]-round(band/2)-circleMin)/TotalN) 956 | if(file.output){ 957 | is_visable <- filter.points(X, Y, wh, ht, dpi=dpi) 958 | }else{ 959 | is_visable <- rep(TRUE, length(X)) 960 | } 961 | 962 | if(cir.axis && cir.axis.grid){ 963 | circle.plot(myr=r+H*(i-1)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 964 | circle.plot(myr=r+H*(i-0.75)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 965 | circle.plot(myr=r+H*(i-0.5)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 966 | circle.plot(myr=r+H*(i-0.25)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 967 | circle.plot(myr=r+H*(i-0)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 968 | } 969 | 970 | points(X[is_visable],Y[is_visable],pch=19,cex=cex[1],col=rep(rep(colx,N[i]),add[[i]])[ylimIndx][is_visable]) 971 | 972 | #plot the legend for each trait 973 | if(cir.axis==TRUE){ 974 | #try to get the number after radix point 975 | if((Max-Min) > 1) { 976 | round.n=2 977 | }else{ 978 | if(Max == 1){ 979 | round.n=1 980 | }else{ 981 | round.n=nchar(as.character(10^(-ceiling(-log10(Max)))))-1 982 | } 983 | } 984 | segments(0,r+H*(i-1)+cir.band*(i-1),0,r+H*i+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 985 | segments(0,r+H*(i-1)+cir.band*(i-1),H/20,r+H*(i-1)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 986 | segments(0,r+H*(i-0.75)+cir.band*(i-1),H/20,r+H*(i-0.75)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 987 | segments(0,r+H*(i-0.5)+cir.band*(i-1),H/20,r+H*(i-0.5)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 988 | segments(0,r+H*(i-0.25)+cir.band*(i-1),H/20,r+H*(i-0.25)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 989 | segments(0,r+H*(i-0)+cir.band*(i-1),H/20,r+H*(i-0)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 990 | 991 | lab=seq(round(Min+(Max-Min)*0,round.n), round(Min+(Max-Min)*1,round.n), length=5) 992 | text(-H/20,r+H*(i-0.94)+cir.band*(i-1),lab[1],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 993 | text(-H/20,r+H*(i-0.75)+cir.band*(i-1),lab[2],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 994 | text(-H/20,r+H*(i-0.5)+cir.band*(i-1),lab[3],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 995 | text(-H/20,r+H*(i-0.25)+cir.band*(i-1),lab[4],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 996 | text(-H/20,r+H*(i-0.06)+cir.band*(i-1),lab[5],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 997 | } 998 | 999 | if(!is.null(threshold[[i]])){ 1000 | if(sum(threshold[[i]]!=0)==length(threshold[[i]])){ 1001 | for(thr in 1:length(threshold[[i]])){ 1002 | significantline1=ifelse(LOG10, H*(-log10(threshold[[i]][thr])-Min)/(Max-Min), H*(threshold[[i]][thr]-Min)/(Max-Min)) 1003 | #s1X=(significantline1+r+H*(i-1)+cir.band*(i-1))*sin(2*base::pi*(0:TotalN)/TotalN) 1004 | #s1Y=(significantline1+r+H*(i-1)+cir.band*(i-1))*cos(2*base::pi*(0:TotalN)/TotalN) 1005 | if(significantline1=significantline1) 1027 | HX1=(Cpvalue[p_amp.index]+r+H*(i-1)+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1028 | HY1=(Cpvalue[p_amp.index]+r+H*(i-1)+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1029 | 1030 | #cover the points that exceed the threshold with the color "white" 1031 | points(HX1,HY1,pch=19,cex=cex[1],col="white") 1032 | 1033 | for(ll in 1:length(threshold[[i]])){ 1034 | if(ll == 1){ 1035 | if(LOG10){ 1036 | significantline1=H*(-log10(threshold[[i]][ll])-Min)/(Max-Min) 1037 | }else{ 1038 | significantline1=H*(threshold[[i]][ll]-Min)/(Max-Min) 1039 | } 1040 | p_amp.index <- which(Cpvalue>=significantline1) 1041 | HX1=(Cpvalue[p_amp.index]+r+H*(i-1)+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1042 | HY1=(Cpvalue[p_amp.index]+r+H*(i-1)+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1043 | }else{ 1044 | if(LOG10){ 1045 | significantline0=H*(-log10(threshold[[i]][ll-1])-Min)/(Max-Min) 1046 | significantline1=H*(-log10(threshold[[i]][ll])-Min)/(Max-Min) 1047 | }else{ 1048 | significantline0=H*(threshold[[i]][ll-1]-Min)/(Max-Min) 1049 | significantline1=H*(threshold[[i]][ll]-Min)/(Max-Min) 1050 | } 1051 | p_amp.index <- which(Cpvalue>=significantline1 & Cpvalue < significantline0) 1052 | HX1=(Cpvalue[p_amp.index]+r+H*(i-1)+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1053 | HY1=(Cpvalue[p_amp.index]+r+H*(i-1)+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1054 | } 1055 | 1056 | if(is.null(signal.col)){ 1057 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll],col=rep(rep(colx,N[i]),add[[i]])[p_amp.index]) 1058 | }else{ 1059 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll],col=signal.col[ll]) 1060 | } 1061 | } 1062 | } 1063 | } 1064 | } 1065 | 1066 | if(!is.null(highlight)){ 1067 | HX1=(Cpvalue[highlight_index[[i]]]+r+H*(i-1)+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[highlight_index[[i]]]-round(band/2)-circleMin)/TotalN) 1068 | HY1=(Cpvalue[highlight_index[[i]]]+r+H*(i-1)+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[highlight_index[[i]]]-round(band/2)-circleMin)/TotalN) 1069 | points(HX1,HY1[highlight_index[[i]]],pch=19,cex=cex[1],col="white") 1070 | if(is.null(highlight.col)){ 1071 | points(HX1,HY1,pch=highlight.pch,cex=highlight.cex,col=rep(rep(colx,N[i]),add[[i]])[highlight_index[[i]]]) 1072 | }else{ 1073 | points(HX1,HY1,pch=highlight.pch,cex=highlight.cex,col=highlight_col[[i]]) 1074 | } 1075 | } 1076 | 1077 | if(cir.chr==TRUE){ 1078 | ticks1=(RR+1.5*cir.chr.h)*sin(2*base::pi*(ticks-round(band/2)-circleMin)/TotalN) 1079 | ticks2=(RR+1.5*cir.chr.h)*cos(2*base::pi*(ticks-round(band/2)-circleMin)/TotalN) 1080 | if(is.null(chr.labels)){ 1081 | for(t in 1:length(ticks)){ 1082 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1083 | text(ticks1[t],ticks2[t],chr.ori[t],srt=angle,font=lab.font,cex=lab.cex-0.5, adj=c(0.5, 0)) 1084 | } 1085 | }else{ 1086 | if(Nchr == 1){ 1087 | for(t in 1:length(ticks)){ 1088 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1089 | text(ticks1[t],ticks2[t],paste(chr.labels[t], bp_lab, sep=""),srt=angle, adj=c(0.5, 0),font=lab.font,cex=lab.cex-0.5) 1090 | } 1091 | }else{ 1092 | for(t in 1:length(ticks)){ 1093 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1094 | text(ticks1[t],ticks2[t],chr.labels[t],srt=angle,font=lab.font,cex=lab.cex-0.5, adj=c(0.5, 0)) 1095 | } 1096 | } 1097 | } 1098 | }else{ 1099 | ticks1=1.01*RR*sin(2*base::pi*(ticks-round(band/2)-circleMin)/TotalN) 1100 | ticks2=1.01*RR*cos(2*base::pi*(ticks-round(band/2)-circleMin)/TotalN) 1101 | # ticks1=(0.9*r)*sin(2*base::pi*(ticks-round(band/2))/TotalN) 1102 | # ticks2=(0.9*r)*cos(2*base::pi*(ticks-round(band/2))/TotalN) 1103 | if(is.null(chr.labels)){ 1104 | for(t in 1:length(ticks)){ 1105 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1106 | text(ticks1[t],ticks2[t],chr.ori[t],srt=angle,font=lab.font,cex=lab.cex-0.5,adj=c(0.5, 0)) 1107 | } 1108 | }else{ 1109 | if(Nchr == 1){ 1110 | for(t in 1:length(ticks)){ 1111 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1112 | text(ticks1[t],ticks2[t],paste(chr.labels[t], bp_lab, sep=""),srt=angle,font=lab.font,cex=lab.cex-0.5,adj=c(0.5, 0)) 1113 | } 1114 | }else{ 1115 | for(t in 1:length(ticks)){ 1116 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1117 | text(ticks1[t],ticks2[t],chr.labels[t],srt=angle,font=lab.font,cex=lab.cex-0.5,adj=c(0.5, 0)) 1118 | } 1119 | } 1120 | } 1121 | } 1122 | } 1123 | if(outward==FALSE){ 1124 | if(cir.chr==TRUE & i == 1){ 1125 | # XLine=(2*cir.band+RR+cir.chr.h)*sin(2*base::pi*(1:TotalN)/TotalN) 1126 | # YLine=(2*cir.band+RR+cir.chr.h)*cos(2*base::pi*(1:TotalN)/TotalN) 1127 | # lines(XLine,YLine,lwd=1.5) 1128 | 1129 | polygon.num <- 1000 1130 | for(k in 1:length(chr)){ 1131 | if(k==1){ 1132 | polygon.index <- seq(round(band/2)+1,-round(band/2)-circleMin+max_no_na(pvalue.posN.list[[1]]), length=polygon.num) 1133 | X1chr=(RR)*sin(2*base::pi*(polygon.index)/TotalN) 1134 | Y1chr=(RR)*cos(2*base::pi*(polygon.index)/TotalN) 1135 | X2chr=(RR+cir.chr.h)*sin(2*base::pi*(polygon.index)/TotalN) 1136 | Y2chr=(RR+cir.chr.h)*cos(2*base::pi*(polygon.index)/TotalN) 1137 | if(is.null(chr.den.col)){ 1138 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col=rep(colx,ceiling(length(chr)/length(colx)))[k],border=rep(colx,ceiling(length(chr)/length(colx)))[k]) 1139 | }else{ 1140 | if(cir.density){ 1141 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col="grey",border="grey") 1142 | }else{ 1143 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col=chr.den.col,border=chr.den.col) 1144 | } 1145 | } 1146 | }else{ 1147 | polygon.index <- seq(1+round(band/2)+max_no_na(pvalue.posN.list[[k-1]])-circleMin,-round(band/2)-circleMin+max_no_na(pvalue.posN.list[[k]]), length=polygon.num) 1148 | X1chr=(RR)*sin(2*base::pi*(polygon.index)/TotalN) 1149 | Y1chr=(RR)*cos(2*base::pi*(polygon.index)/TotalN) 1150 | X2chr=(RR+cir.chr.h)*sin(2*base::pi*(polygon.index)/TotalN) 1151 | Y2chr=(RR+cir.chr.h)*cos(2*base::pi*(polygon.index)/TotalN) 1152 | if(is.null(chr.den.col)){ 1153 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col=rep(colx,ceiling(length(chr)/length(colx)))[k],border=rep(colx,ceiling(length(chr)/length(colx)))[k]) 1154 | }else{ 1155 | if(cir.density){ 1156 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col="grey",border="grey") 1157 | }else{ 1158 | polygon(c(rev(X1chr),X2chr),c(rev(Y1chr),Y2chr),col=chr.den.col,border=chr.den.col) 1159 | } 1160 | } 1161 | } 1162 | } 1163 | if(cir.density){ 1164 | 1165 | if(file.output){ 1166 | is_visable <- filter.points((RR+cir.chr.h)*sin(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN), (RR+cir.chr.h)*cos(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN), wh, ht, dpi=dpi) 1167 | }else{ 1168 | is_visable <- rep(TRUE, length(pvalue.posN)) 1169 | } 1170 | segments( 1171 | (RR)*sin(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN)[is_visable], 1172 | (RR)*cos(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN)[is_visable], 1173 | (RR+cir.chr.h)*sin(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN)[is_visable], 1174 | (RR+cir.chr.h)*cos(2*base::pi*(pvalue.posN-round(band/2)-circleMin)/TotalN)[is_visable], 1175 | col=density.list$den.col[is_visable], lwd=0.5 1176 | ) 1177 | legend( 1178 | x=RR+4*cir.chr.h, 1179 | y=(RR+4*cir.chr.h)/2, 1180 | title="", legend=density.list$legend.y, pch=15, pt.cex=3, col=density.list$legend.col, 1181 | cex=legend.cex, bty="n", 1182 | y.intersp=1, 1183 | x.intersp=1, 1184 | yjust=0.3, xjust=0, xpd=TRUE 1185 | ) 1186 | 1187 | } 1188 | 1189 | if(cir.density){ 1190 | circle.plot(myr=RR+cir.chr.h,lwd=1.5,add=TRUE,col='grey') 1191 | circle.plot(myr=RR,lwd=1.5,add=TRUE,col='grey') 1192 | }else{ 1193 | circle.plot(myr=RR+cir.chr.h,lwd=1.5,add=TRUE) 1194 | circle.plot(myr=RR,lwd=1.5,add=TRUE) 1195 | } 1196 | 1197 | } 1198 | 1199 | X=(-Cpvalue[ylimIndx]+r+H*i+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[ylimIndx]-round(band/2)-circleMin)/TotalN) 1200 | Y=(-Cpvalue[ylimIndx]+r+H*i+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[ylimIndx]-round(band/2)-circleMin)/TotalN) 1201 | if(file.output){ 1202 | is_visable <- filter.points(X, Y, wh, ht, dpi=dpi) 1203 | }else{ 1204 | is_visable <- rep(TRUE, length(X)) 1205 | } 1206 | 1207 | if(cir.axis && cir.axis.grid){ 1208 | circle.plot(myr=r+H*(i-1)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 1209 | circle.plot(myr=r+H*(i-0.75)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 1210 | circle.plot(myr=r+H*(i-0.5)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 1211 | circle.plot(myr=r+H*(i-0.25)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 1212 | circle.plot(myr=r+H*(i-0)+cir.band*(i-1),lwd=0.5,add=TRUE,col='grey') 1213 | } 1214 | 1215 | points(X[is_visable],Y[is_visable],pch=19,cex=cex[1],col=rep(rep(colx,N[i]),add[[i]])[ylimIndx][is_visable]) 1216 | 1217 | if(cir.axis==TRUE){ 1218 | 1219 | #try to get the number after radix point 1220 | if((Max-Min)<=1) { 1221 | if(Max == 1){ 1222 | round.n=1 1223 | }else{ 1224 | round.n=nchar(as.character(10^(-ceiling(-log10(Max)))))-1 1225 | } 1226 | }else{ 1227 | round.n=2 1228 | } 1229 | segments(0,r+H*(i-1)+cir.band*(i-1),0,r+H*i+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 1230 | segments(0,r+H*(i-1)+cir.band*(i-1),H/20,r+H*(i-1)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 1231 | segments(0,r+H*(i-0.75)+cir.band*(i-1),H/20,r+H*(i-0.75)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 1232 | segments(0,r+H*(i-0.5)+cir.band*(i-1),H/20,r+H*(i-0.5)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 1233 | segments(0,r+H*(i-0.25)+cir.band*(i-1),H/20,r+H*(i-0.25)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 1234 | segments(0,r+H*(i-0)+cir.band*(i-1),H/20,r+H*(i-0)+cir.band*(i-1),col=cir.axis.col,lwd=axis.lwd) 1235 | 1236 | lab=seq(round(Min+(Max-Min)*0,round.n), round(Min+(Max-Min)*1,round.n), length=5) 1237 | text(-H/20,r+H*(i-0.06)+cir.band*(i-1),lab[1],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 1238 | text(-H/20,r+H*(i-0.25)+cir.band*(i-1),lab[2],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 1239 | text(-H/20,r+H*(i-0.5)+cir.band*(i-1),lab[3],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 1240 | text(-H/20,r+H*(i-0.75)+cir.band*(i-1),lab[4],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 1241 | text(-H/20,r+H*(i-0.94)+cir.band*(i-1),lab[5],adj=1,col=cir.axis.col,cex=axis.cex*0.5,font=lab.font) 1242 | } 1243 | 1244 | if(!is.null(threshold[[i]])){ 1245 | if(sum(threshold[[i]]!=0)==length(threshold[[i]])){ 1246 | 1247 | for(thr in 1:length(threshold[[i]])){ 1248 | significantline1=ifelse(LOG10, H*(-log10(threshold[[i]][thr])-Min)/(Max-Min), H*(threshold[[i]][thr]-Min)/(Max-Min)) 1249 | #s1X=(significantline1+r+H*(i-1)+cir.band*(i-1))*sin(2*pi*(0:TotalN)/TotalN) 1250 | #s1Y=(significantline1+r+H*(i-1)+cir.band*(i-1))*cos(2*pi*(0:TotalN)/TotalN) 1251 | if(significantline1=significantline1) 1267 | HX1=(-Cpvalue[p_amp.index]+r+H*i+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1268 | HY1=(-Cpvalue[p_amp.index]+r+H*i+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1269 | 1270 | #cover the points that exceed the threshold with the color "white" 1271 | points(HX1,HY1,pch=19,cex=cex[1],col="white") 1272 | 1273 | for(ll in 1:length(threshold[[i]])){ 1274 | if(ll == 1){ 1275 | if(LOG10){ 1276 | significantline1=H*(-log10(threshold[[i]][ll])-Min)/(Max-Min) 1277 | }else{ 1278 | significantline1=H*(threshold[[i]][ll]-Min)/(Max-Min) 1279 | } 1280 | p_amp.index <- which(Cpvalue>=significantline1) 1281 | HX1=(-Cpvalue[p_amp.index]+r+H*i+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1282 | HY1=(-Cpvalue[p_amp.index]+r+H*i+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1283 | }else{ 1284 | if(LOG10){ 1285 | significantline0=H*(-log10(threshold[[i]][ll-1])-Min)/(Max-Min) 1286 | significantline1=H*(-log10(threshold[[i]][ll])-Min)/(Max-Min) 1287 | }else{ 1288 | significantline0=H*(threshold[[i]][ll-1]-Min)/(Max-Min) 1289 | significantline1=H*(threshold[[i]][ll]-Min)/(Max-Min) 1290 | } 1291 | p_amp.index <- which(Cpvalue>=significantline1 & Cpvalue < significantline0) 1292 | HX1=(-Cpvalue[p_amp.index]+r+H*i+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1293 | HY1=(-Cpvalue[p_amp.index]+r+H*i+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[p_amp.index]-round(band/2)-circleMin)/TotalN) 1294 | 1295 | } 1296 | 1297 | if(is.null(signal.col)){ 1298 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll],col=rep(rep(colx,N[i]),add[[i]])[p_amp.index]) 1299 | }else{ 1300 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll],col=signal.col[ll]) 1301 | } 1302 | } 1303 | } 1304 | } 1305 | } 1306 | 1307 | if(!is.null(highlight)){ 1308 | HX1=(-Cpvalue[highlight_index[[i]]]+r+H*i+cir.band*(i-1))*sin(2*base::pi*(pvalue.posN[highlight_index[[i]]]-round(band/2)-circleMin)/TotalN) 1309 | HY1=(-Cpvalue[highlight_index[[i]]]+r+H*i+cir.band*(i-1))*cos(2*base::pi*(pvalue.posN[highlight_index[[i]]]-round(band/2)-circleMin)/TotalN) 1310 | points(HX1,HY1,pch=19,cex=cex[1],col="white") 1311 | if(is.null(highlight.col)){ 1312 | points(HX1,HY1,pch=highlight.pch,cex=highlight.cex,col=rep(rep(colx,N[i]),add[[i]])[highlight_index[[i]]]) 1313 | }else{ 1314 | points(HX1,HY1,pch=highlight.pch,cex=highlight.cex,col=highlight_col[[i]]) 1315 | } 1316 | } 1317 | 1318 | if(cir.chr==TRUE){ 1319 | ticks1=(RR+1.5*cir.chr.h)*sin(2*base::pi*(ticks-round(band/2)-circleMin)/TotalN) 1320 | ticks2=(RR+1.5*cir.chr.h)*cos(2*base::pi*(ticks-round(band/2)-circleMin)/TotalN) 1321 | if(is.null(chr.labels)){ 1322 | for(t in 1:length(ticks)){ 1323 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1324 | text(ticks1[t],ticks2[t],chr.ori[t],srt=angle,font=lab.font,cex=lab.cex-0.5,adj=c(0.5, 0)) 1325 | } 1326 | }else{ 1327 | if(Nchr == 1){ 1328 | for(t in 1:length(ticks)){ 1329 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1330 | text(ticks1[t],ticks2[t],paste(chr.labels[t], bp_lab,sep=""),srt=angle,font=lab.font,cex=lab.cex-0.5,adj=c(0.5, 0)) 1331 | } 1332 | }else{ 1333 | for(t in 1:length(ticks)){ 1334 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1335 | text(ticks1[t],ticks2[t],chr.labels[t],srt=angle,font=lab.font,cex=lab.cex-0.5,adj=c(0.5, 0)) 1336 | } 1337 | } 1338 | } 1339 | }else{ 1340 | ticks1=1.01*RR*sin(2*base::pi*(ticks-round(band/2)-circleMin)/TotalN) 1341 | ticks2=1.01*RR*cos(2*base::pi*(ticks-round(band/2)-circleMin)/TotalN) 1342 | # ticks1=RR*sin(2*base::pi*(ticks-round(band/2))/TotalN) 1343 | # ticks2=RR*cos(2*base::pi*(ticks-round(band/2))/TotalN) 1344 | if(is.null(chr.labels)){ 1345 | for(t in 1:length(ticks)){ 1346 | 1347 | #adjust the angle of labels of circle plot 1348 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1349 | text(ticks1[t],ticks2[t],chr.ori[t],srt=angle,font=lab.font,cex=lab.cex-0.5,adj=c(0.5, 0)) 1350 | } 1351 | }else{ 1352 | if(Nchr == 1){ 1353 | for(t in 1:length(ticks)){ 1354 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1355 | text(ticks1[t],ticks2[t],paste(chr.labels[t], bp_lab,sep=""),srt=angle,font=lab.font,cex=lab.cex-0.5,adj=c(0.5, 0)) 1356 | } 1357 | }else{ 1358 | for(t in 1:length(ticks)){ 1359 | angle=360*(1-(ticks-round(band/2)-circleMin)[t]/TotalN) 1360 | text(ticks1[t],ticks2[t],chr.labels[t],srt=angle,font=lab.font,cex=lab.cex-0.5,adj=c(0.5, 0)) 1361 | } 1362 | } 1363 | } 1364 | } 1365 | } 1366 | } 1367 | if(file.output) dev.off() 1368 | #print("Circular-Manhattan has been finished!",quote=F) 1369 | } 1370 | 1371 | if("m" %in% plot.type){ 1372 | 1373 | is_visable <- list() 1374 | for(i in 1:R){ 1375 | if(file.output){ 1376 | ht=ifelse(is.null(height), 6, height) 1377 | wh=ifelse(is.null(width), 14, width) 1378 | is_visable[[i]] <- filter.points(pvalue.posN, logpvalueT[,i], wh, ht, dpi=dpi) 1379 | }else{ 1380 | is_visable[[i]] <- rep(TRUE, nrow(logpvalueT)) 1381 | } 1382 | } 1383 | 1384 | if(multracks | multraits){ 1385 | if(R < 2) stop("need more than one trait.") 1386 | if(multracks){ 1387 | if(file.output){ 1388 | ht=ifelse(is.null(height), 6, height) 1389 | wh=ifelse(is.null(width), 14, width) 1390 | if(file=="jpg") jpeg(paste("Multi-tracks_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".jpg",sep=""), width=wh*dpi,height=ht*dpi*R,res=dpi,quality=100) 1391 | if(file=="pdf") pdf(paste("Multi-tracks_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".pdf",sep=""), width=wh,height=ht*R) 1392 | if(file=="tiff") tiff(paste("Multi-tracks_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".tiff",sep=""), width=wh*dpi,height=ht*dpi*R,res=dpi) 1393 | if(file=="png") png(paste("Multi-tracks_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".png",sep=""), width=wh*dpi,height=ht*dpi*R,res=dpi,bg=NA) 1394 | par(mfcol=c(R,1), xaxs="i") 1395 | } 1396 | if(!file.output){ 1397 | ht=ifelse(is.null(height), 6, height) 1398 | wh=ifelse(is.null(width), 14, width) 1399 | if(is.null(dev.list())) dev.new(width=wh, height=ht) 1400 | # par(xpd=TRUE) 1401 | } 1402 | for(i in 1:R){ 1403 | # Add room for x axis, if there are multiple 1404 | btwn_adj=if(multracks.xaxis) 2 else 0 1405 | if(i == 1) par(mar=c(mar.between + btwn_adj, mar[2]+1, mar[3], 0)) 1406 | if(i == R) par(mar=c(mar[1]+1, mar[2]+1, 0, 0)) 1407 | if(i != 1 & i != R) par(mar=c(mar.between + btwn_adj, mar[2]+1, 0, 0)) 1408 | if(verbose) cat(paste(" Multi-tracks Manhattan plotting ",trait[i],".\n",sep="")) 1409 | colx=col[i,] 1410 | colx=colx[!is.na(colx)] 1411 | pvalue=pvalueT[,i] 1412 | logpvalue=logpvalueT[,i] 1413 | if(is.null(ylim)){ 1414 | if(!is.null(threshold[[i]])){ 1415 | # if(sum(threshold!=0)==length(threshold)){ 1416 | if(LOG10){ 1417 | Max=max_ylim(max_no_na(c((-log10(min_no_na(pvalue))),-log10(min_no_na(threshold[[i]]))))) 1418 | Min <- min_ylim(min_no_na(c((-log10(max_no_na(pvalue))),-log10(max_no_na(threshold[[i]]))))) 1419 | }else{ 1420 | Max=max_ylim(max_no_na(c((max_no_na(pvalue)),max_no_na(threshold[[i]])))) 1421 | #if(abs(Max)<=1) Max=max_no_na(c(max_no_na(pvalue),max_no_na(threshold))) 1422 | Min<-min_ylim(min_no_na(c((min_no_na(pvalue)),min_no_na(threshold[[i]])))) 1423 | #if(abs(Min)<=1) Min=min_no_na(min_no_na(pvalue),min_no_na(threshold)) 1424 | } 1425 | }else{ 1426 | if(LOG10){ 1427 | Max=max_ylim((-log10(min_no_na(pvalue)))) 1428 | Min<-min_ylim((-log10(max_no_na(pvalue)))) 1429 | }else{ 1430 | Max=max_ylim((max_no_na(pvalue))) 1431 | #if(abs(Max)<=1) Max=max_no_na(max_no_na(pvalue)) 1432 | Min=min_ylim((min_no_na(pvalue))) 1433 | #if(abs(Min)<=1) Min=min_no_na(min_no_na(pvalue)) 1434 | # }else{ 1435 | # Max=max_no_na(ceiling(max_no_na(pvalue))) 1436 | # } 1437 | } 1438 | } 1439 | if((Max-Min)<=1){ 1440 | plot(pvalue.posN[is_visable[[i]]],logpvalue[is_visable[[i]]],pch=pch,type=type,lwd=cex[2]*(R/2)+1,cex=cex[2]*(R/2),col=rep(rep(colx,N[i]),add[[i]])[is_visable[[i]]],xlim=c(min_no_na(pvalue.posN)-band,max_no_na(pvalue.posN)+band),ylim=c(Min,Max),ann=FALSE, 1441 | cex.axis=axis.cex*(R/2),font=lab.font,axes=FALSE,yaxs="r") 1442 | }else{ 1443 | plot(pvalue.posN[is_visable[[i]]],logpvalue[is_visable[[i]]],pch=pch,type=type,lwd=cex[2]*(R/2)+1,cex=cex[2]*(R/2),col=rep(rep(colx,N[i]),add[[i]])[is_visable[[i]]],xlim=c(min_no_na(pvalue.posN)-band,max_no_na(pvalue.posN)+band),ylim=c(Min,Max),ann=FALSE, 1444 | cex.axis=axis.cex*(R/2),font=lab.font,axes=FALSE,yaxs="r") 1445 | } 1446 | mtext(side=2, text=ylab, line=ylab.pos, cex=lab.cex*(R/2), font=lab.font, xpd=TRUE) 1447 | }else{ 1448 | Max <- max_no_na(ylim[[i]]) 1449 | Min <- min_no_na(ylim[[i]]) 1450 | plot(pvalue.posN[logpvalue>=min_no_na(ylim[[i]]) & is_visable[[i]]],logpvalue[logpvalue>=min_no_na(ylim[[i]]) & is_visable[[i]]],pch=pch,type=type,lwd=cex[2]*(R/2)+1,cex=cex[2]*(R/2),col=rep(rep(colx,N[i]),add[[i]])[logpvalue>=min_no_na(ylim[[i]]) & is_visable[[i]]],xlim=c(min_no_na(pvalue.posN)-band,max_no_na(pvalue.posN)+band),ylim=ylim[[i]],ann=FALSE, 1451 | cex.axis=axis.cex*(R/2),font=lab.font,axes=FALSE,yaxs="r") 1452 | mtext(side=2, text=ylab, line=ylab.pos, cex=lab.cex*(R/2), font=lab.font, xpd=TRUE) 1453 | } 1454 | 1455 | if(chr.border){ 1456 | for(b in 1:length(chr.border.pos)){ 1457 | segments(chr.border.pos[b], Min, chr.border.pos[b], Max, col="grey45", lwd=axis.lwd, lty=2) 1458 | } 1459 | } 1460 | 1461 | #add the names of traits on plot 1462 | if(legend.pos=="left"){ 1463 | text(min_no_na(pvalue.posN),Max,labels=trait[i],adj=c(-0.2, 1.2),font=4,cex=legend.cex*(R/2),xpd=TRUE) 1464 | }else if(legend.pos=="middle"){ 1465 | text((max_no_na(pvalue.posN)+min_no_na(pvalue.posN))/2,Max,labels=trait[i],adj=c(0.5, 1.2),font=4,cex=legend.cex*(R/2),xpd=TRUE) 1466 | }else if(legend.pos=="right"){ 1467 | text(max_no_na(pvalue.posN),Max,labels=trait[i],adj=c(1.2, 1.2),font=4,cex=legend.cex*(R/2),xpd=TRUE) 1468 | } 1469 | 1470 | if(i == R || multracks.xaxis){ 1471 | if(chr.labels.angle == 0){ 1472 | if(is.null(chr.labels)){ 1473 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd*(R/2),cex.axis=axis.cex*(R/2),font=lab.font,labels=c("Chr",chr.ori),padj=1) 1474 | }else{ 1475 | if(Nchr == 1){ 1476 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd*(R/2), cex.axis=axis.cex*(R/2),font=lab.font,labels=c(paste("Chr.", unique(Pmap[,1]), bp_lab, sep=""),chr.labels)) 1477 | }else{ 1478 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd*(R/2), cex.axis=axis.cex*(R/2),font=lab.font,labels=c("Chr",chr.labels)) 1479 | } 1480 | } 1481 | }else{ 1482 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd*(R/2),labels=FALSE) 1483 | if(is.null(chr.labels)){ 1484 | text(c(min_no_na(pvalue.posN)-band,ticks), par("usr")[3]*2-ifelse(cir.density, Min-(Max-Min)/den.fold, Min), cex=axis.cex*(R/2), font=lab.font, labels=c("Chr",chr.ori), srt=chr.labels.angle, xpd=TRUE,adj=c(ifelse(chr.labels.angle < 0, 0, ifelse(chr.labels.angle == 0, 0.5, 1)), ifelse(chr.labels.angle == 0, 0.5, ifelse(abs(chr.labels.angle) > 45, 0.5, 1)))) 1485 | # axis(1, at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd,cex.axis=axis.cex*(R/2),font=lab.font,labels=c("Chr",chr.ori),padj=1) 1486 | }else{ 1487 | if(Nchr == 1){ 1488 | # axis(1, at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd*(R/2), cex.axis=axis.cex*(R/2),font=lab.font,labels=c(paste("Chr.", unique(Pmap[,1]), bp_lab, sep=""),chr.labels)) 1489 | text(c(min_no_na(pvalue.posN)-band,ticks), par("usr")[3]*2-ifelse(cir.density, Min-(Max-Min)/den.fold, Min), cex=axis.cex*(R/2), font=lab.font, labels=c(paste("Chr.", unique(Pmap[,1]), bp_lab, sep=""),chr.labels), srt=chr.labels.angle, xpd=TRUE,adj=c(ifelse(chr.labels.angle < 0, 0, ifelse(chr.labels.angle == 0, 0.5, 1)), ifelse(chr.labels.angle == 0, 0.5, ifelse(abs(chr.labels.angle) > 45, 0.5, 1)))) 1490 | }else{ 1491 | # axis(1, at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd*(R/2), cex.axis=axis.cex*(R/2),font=lab.font,labels=c("Chr",chr.labels)) 1492 | text(c(min_no_na(pvalue.posN)-band,ticks), par("usr")[3]*2-ifelse(cir.density, Min-(Max-Min)/den.fold, Min), cex=axis.cex*(R/2), font=lab.font, labels=c("Chr",chr.labels), srt=chr.labels.angle, xpd=TRUE,adj=c(ifelse(chr.labels.angle < 0, 0, ifelse(chr.labels.angle == 0, 0.5, 1)), ifelse(chr.labels.angle == 0, 0.5, ifelse(abs(chr.labels.angle) > 45, 0.5, 1)))) 1493 | } 1494 | } 1495 | } 1496 | axis(1, mgp=c(3,xticks.pos,0), at=c(ticks[length(ticks)], max_no_na(pvalue.posN)), labels=c("",""), tcl=0, lwd=axis.lwd*(R/2)) 1497 | } 1498 | #if(i==1) mtext("Manhattan plot",side=3,padj=-1,font=lab.font,cex=xn) 1499 | if(is.null(ylim)){ 1500 | if((Max-Min)>1){ 1501 | axis(2, las=1,lwd=axis.lwd*(R/2),cex.axis=axis.cex*(R/2),font=lab.font) 1502 | axis(2, at=c((Min), Max), labels=c("",""), tcl=0, lwd=axis.lwd*(R/2)) 1503 | }else{ 1504 | axis(2,las=1,lwd=axis.lwd*(R/2),cex.axis=axis.cex*(R/2),font=lab.font) 1505 | axis(2, at=c((Min), Max), labels=c("",""), tcl=0, lwd=axis.lwd*(R/2)) 1506 | } 1507 | }else{ 1508 | axis(2, las=1,lwd=axis.lwd*(R/2),cex.axis=axis.cex*(R/2),font=lab.font) 1509 | axis(2, at=c((Min), Max), labels=c("",""), tcl=0, lwd=axis.lwd*(R/2)) 1510 | } 1511 | if(!is.null(threshold[[i]])){ 1512 | for(thr in 1:length(threshold[[i]])){ 1513 | h <- ifelse(LOG10, -log10(threshold[[i]][thr]), threshold[[i]][thr]) 1514 | segments(0, h, max_no_na(pvalue.posN), h, col=threshold.col[thr],lwd=threshold.lwd[thr],lty=threshold.lty[thr]) 1515 | } 1516 | if(amplify==TRUE){ 1517 | if(LOG10){ 1518 | threshold[[i]] <- sort(threshold[[i]]) 1519 | sgline1=-log10(max_no_na(threshold[[i]])) 1520 | }else{ 1521 | threshold[[i]] <- sort(threshold[[i]], decreasing=TRUE) 1522 | sgline1=min_no_na(threshold[[i]]) 1523 | } 1524 | sgindex=which(logpvalue>=sgline1) 1525 | HY1=logpvalue[sgindex] 1526 | HX1=pvalue.posN[sgindex] 1527 | 1528 | #cover the points that exceed the threshold with the color "white" 1529 | points(HX1,HY1,pch=pch,cex=cex[2]*R,col="white") 1530 | 1531 | for(ll in 1:length(threshold[[i]])){ 1532 | if(ll == 1){ 1533 | if(LOG10){ 1534 | sgline1=-log10(threshold[[i]][ll]) 1535 | }else{ 1536 | sgline1=threshold[[i]][ll] 1537 | } 1538 | sgindex=which(logpvalue>=sgline1) 1539 | HY1=logpvalue[sgindex] 1540 | HX1=pvalue.posN[sgindex] 1541 | }else{ 1542 | if(LOG10){ 1543 | sgline0=-log10(threshold[[i]][ll-1]) 1544 | sgline1=-log10(threshold[[i]][ll]) 1545 | }else{ 1546 | sgline0=threshold[[i]][ll-1] 1547 | sgline1=threshold[[i]][ll] 1548 | } 1549 | sgindex=which(logpvalue>=sgline1 & logpvalue < sgline0) 1550 | HY1=logpvalue[sgindex] 1551 | HX1=pvalue.posN[sgindex] 1552 | } 1553 | 1554 | if(is.null(signal.col)){ 1555 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll]*R,col=rep(rep(colx,N[i]),add[[i]])[sgindex]) 1556 | }else{ 1557 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll]*R,col=signal.col[ll]) 1558 | } 1559 | } 1560 | } 1561 | } 1562 | 1563 | if(!is.null(highlight)){ 1564 | # points(x=pvalue.posN[highlight_index[[i]]],y=logpvalue[highlight_index[[i]]],pch=pch,cex=cex[2]*R,col="white") 1565 | if(!is.na(highlight_index[[i]][1])){ 1566 | if(is.null(highlight.col)){ 1567 | highlight_text(x=pvalue.posN[highlight_index[[i]]],y=logpvalue[highlight_index[[i]]],xlim=c(min_no_na(pvalue.posN)-band,max_no_na(pvalue.posN)),ylim=c(Min,Max),words=highlight.text[[i]],point.cex=highlight.cex*R,text.cex=highlight.text.cex*R/2, pch=highlight.pch,type=highlight.type,point.col=rep(rep(colx,N[i]),add[[i]])[highlight_index[[i]]],text.col=highlight.text.col,text.font=highlight.text.font) 1568 | }else{ 1569 | highlight_text(x=pvalue.posN[highlight_index[[i]]],y=logpvalue[highlight_index[[i]]],xlim=c(min_no_na(pvalue.posN)-band,max_no_na(pvalue.posN)),ylim=c(Min,Max),words=highlight.text[[i]],point.cex=highlight.cex*R,text.cex=highlight.text.cex*R/2, pch=highlight.pch,type=highlight.type,point.col=highlight_col[[i]],text.col=highlight.text.col,text.font=highlight.text.font) 1570 | } 1571 | } 1572 | } 1573 | if(!is.null(main) & R == 1) title(main=main[1], cex.main=main.cex, font.main= main.font) 1574 | if(box) box(lwd=axis.lwd) 1575 | #if(!is.null(threshold) & !is.null(signal.line)) abline(v=pvalue.posN[which(pvalueT[,i] < min_no_na(threshold))],col="grey",lty=2,lwd=signal.line) 1576 | } 1577 | if(file.output) dev.off() 1578 | } 1579 | if(multraits){ 1580 | if(file.output){ 1581 | ht=ifelse(is.null(height), 6, height) 1582 | wh=ifelse(is.null(width), 14, width) 1583 | if(file=="jpg") jpeg(paste("Multi-traits_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".jpg",sep=""), width=wh*dpi,height=ht*dpi,res=dpi,quality=100) 1584 | if(file=="pdf") pdf(paste("Multi-traits_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".pdf",sep=""), width=wh,height=ht) 1585 | if(file=="tiff") tiff(paste("Multi-traits_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".tiff",sep=""), width=wh*dpi,height=ht*dpi,res=dpi) 1586 | if(file=="png") png(paste("Multi-traits_Manhtn.",ifelse(is.null(file.name),taxa,file.name[1]),".png",sep=""), width=wh*dpi,height=ht*dpi,res=dpi,bg=NA) 1587 | if(!is.null(legend.ncol) && legend.pos=="middle"){ 1588 | mar[3] = mar[3] + ceiling(length(trait) / legend.ncol) 1589 | } 1590 | par(mar=mar,xaxs="i",yaxs="r") 1591 | } 1592 | if(!file.output){ 1593 | ht=ifelse(is.null(height), 6, height) 1594 | wh=ifelse(is.null(width), 14, width) 1595 | if(is.null(dev.list())) dev.new(width=wh, height=ht) 1596 | # par(xpd=TRUE) 1597 | } 1598 | 1599 | pvalue <- as.vector(Pmap[,3:(R+2)]) 1600 | if(is.null(ylim)){ 1601 | if(!is.null(threshold)){ 1602 | if(LOG10){ 1603 | Max=max_ylim(max_no_na(c((-log10(min_no_na(pvalue))),-log10(min_no_na(unlist(threshold)))))) 1604 | Min<-min_ylim(min_no_na(c((-log10(max_no_na(pvalue))),-log10(max_no_na(unlist(threshold)))))) 1605 | }else{ 1606 | Max=max_ylim(max_no_na(c((max_no_na(pvalue)),max_no_na(unlist(threshold))))) 1607 | # if(abs(Max)<=1) Max=max_no_na(c(max_no_na(pvalue),max_no_na(threshold))) 1608 | Min <- min_ylim(min_no_na(c((min_no_na(pvalue)),min_no_na(unlist(threshold))))) 1609 | # if(abs(Min)<=1) Min=min_no_na(c(min_no_na(pvalue),min_no_na(threshold))) 1610 | } 1611 | }else{ 1612 | if(LOG10){ 1613 | Max=max_ylim((-log10(min_no_na(pvalue)))) 1614 | Min=min_ylim((-log10(max_no_na(pvalue)))) 1615 | }else{ 1616 | Max=max_ylim((max_no_na(pvalue))) 1617 | # if(abs(Max)<=1) Max=max_no_na(max_no_na(pvalue)) 1618 | Min<- min_ylim((min_no_na(pvalue))) 1619 | # if(abs(Min)<=1) Min=min_no_na(min_no_na(pvalue)) 1620 | # }else{ 1621 | # Max=max_no_na(ceiling(max_no_na(pvalue))) 1622 | } 1623 | } 1624 | if((Max-Min)<=1){ 1625 | if(cir.density){ 1626 | plot(NULL,xlim=c(min_no_na(pvalue.posN)-band,band+1.05*max_no_na(pvalue.posN)),ylim=c(Min-(Max-Min)/den.fold, Max),ann=FALSE, 1627 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1628 | }else{ 1629 | plot(NULL,xlim=c(min_no_na(pvalue.posN)-band,band+max_no_na(pvalue.posN)),ylim=c(Min,Max),ann=FALSE, 1630 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1631 | } 1632 | }else{ 1633 | if(cir.density){ 1634 | plot(NULL,xlim=c(min_no_na(pvalue.posN)-band,band+1.05*max_no_na(pvalue.posN)),ylim=c(Min-(Max-Min)/den.fold,Max),ann=FALSE, 1635 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1636 | }else{ 1637 | plot(NULL,xlim=c(min_no_na(pvalue.posN)-band,band+max_no_na(pvalue.posN)),ylim=c(Min,Max),ann=FALSE, 1638 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1639 | } 1640 | } 1641 | mtext(side=2, text=ylab, line=ylab.pos, cex=lab.cex, font=lab.font, xpd=TRUE) 1642 | }else{ 1643 | Max <- max_no_na(unlist(ylim)) 1644 | Min <- min_no_na(unlist(ylim)) 1645 | if(cir.density){ 1646 | plot(NULL,xlim=c(min_no_na(pvalue.posN)-band,band+1.05*max_no_na(pvalue.posN)),ylim=c(Min-Max/den.fold,Max),ann=FALSE, 1647 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1648 | }else{ 1649 | plot(NULL,xlim=c(min_no_na(pvalue.posN)-band,band+max_no_na(pvalue.posN)),ylim=c(Min, Max),ann=FALSE, 1650 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1651 | } 1652 | mtext(side=2, text=ylab, line=ylab.pos, cex=lab.cex, font=lab.font, xpd=TRUE) 1653 | } 1654 | 1655 | # Max1 <- Max 1656 | # Min1 <- Min 1657 | # if(abs(Max) <= 1) Max <- round(Max, ceiling(-log10(abs(Max)))) 1658 | # if(abs(Min) <= 1) Min <- round(Min, ceiling(-log10(abs(Min)))) 1659 | if(length(unique(col)) == 1 && is.null(signal.col)) stop("'signal.col' is NULL.") 1660 | if(length(unique(col)) == 1 && amplify == FALSE) stop("'amplify' is FALSE.") 1661 | legend_col <- t(col)[1:R] 1662 | if(length(unique(col)) == 1) legend_col <- rep(signal.col, R)[1:R] 1663 | if(legend.pos=="middle"){ 1664 | if(is.null(legend.ncol)){ 1665 | legend((max_no_na(pvalue.posN)+min_no_na(pvalue.posN))*0.5,Max,trait,col=legend_col,pch=pch,text.font=6,cex=legend.cex,box.col=NA,horiz=TRUE,xjust=0.5,yjust=0,xpd=TRUE) 1666 | }else{ 1667 | legend((max_no_na(pvalue.posN)+min_no_na(pvalue.posN))*0.5,Max,trait,col=legend_col,pch=pch,text.font=6,cex=legend.cex,box.col=NA,horiz=FALSE,ncol=legend.ncol,xjust=0.5,yjust=0,xpd=TRUE) 1668 | } 1669 | }else if(legend.pos=="left" || legend.pos=="right"){ 1670 | if(is.null(legend.ncol)){ 1671 | legend(ifelse(legend.pos=="left","topleft","topright"),trait,col=legend_col,pch=pch,text.font=6,cex=legend.cex,box.col=NA,horiz=FALSE,xpd=TRUE) 1672 | }else{ 1673 | legend(ifelse(legend.pos=="left","topleft","topright"),trait,col=legend_col,pch=pch,text.font=6,cex=legend.cex,box.col=NA,horiz=FALSE,ncol=legend.ncol,xpd=TRUE) 1674 | } 1675 | } 1676 | 1677 | if(chr.labels.angle == 0){ 1678 | if(is.null(chr.labels)){ 1679 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks),lwd=axis.lwd,cex.axis=axis.cex,font=lab.font,labels=c("Chr",chr.ori)) 1680 | }else{ 1681 | if(Nchr == 1){ 1682 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd, cex.axis=axis.cex,font=lab.font,labels=c(paste("Chr.", unique(Pmap[,1]), bp_lab, sep=""),chr.labels)) 1683 | }else{ 1684 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd, cex.axis=axis.cex,font=lab.font,labels=c("Chr",chr.labels)) 1685 | } 1686 | } 1687 | }else{ 1688 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd,labels=FALSE) 1689 | if(is.null(chr.labels)){ 1690 | text(c(min_no_na(pvalue.posN)-band,ticks), par("usr")[3]*2-ifelse(cir.density, Min-(Max-Min)/den.fold, Min), cex=axis.cex, font=lab.font, labels=c("Chr",chr.ori), srt=chr.labels.angle, xpd=TRUE,adj=c(ifelse(chr.labels.angle < 0, 0, ifelse(chr.labels.angle == 0, 0.5, 1)), ifelse(chr.labels.angle == 0, 0.5, ifelse(abs(chr.labels.angle) > 45, 0.5, 1)))) 1691 | # axis(1, at=c(min_no_na(pvalue.posN)-band,ticks),lwd=axis.lwd,cex.axis=axis.cex,font=lab.font,labels=c("Chr",chr.ori)) 1692 | }else{ 1693 | if(Nchr == 1){ 1694 | text(c(min_no_na(pvalue.posN)-band,ticks), par("usr")[3]*2-ifelse(cir.density, Min-(Max-Min)/den.fold, Min), cex=axis.cex, font=lab.font, labels=c(paste("Chr.", unique(Pmap[,1]), bp_lab, sep=""),chr.labels), srt=chr.labels.angle, xpd=TRUE,adj=c(ifelse(chr.labels.angle < 0, 0, ifelse(chr.labels.angle == 0, 0.5, 1)), ifelse(chr.labels.angle == 0, 0.5, ifelse(abs(chr.labels.angle) > 45, 0.5, 1)))) 1695 | # axis(1, at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd, cex.axis=axis.cex,font=lab.font,labels=c(paste("Chr.", unique(Pmap[,1]), bp_lab, sep=""),chr.labels)) 1696 | }else{ 1697 | text(c(min_no_na(pvalue.posN)-band,ticks), par("usr")[3]*2-ifelse(cir.density, Min-(Max-Min)/den.fold, Min), cex=axis.cex, font=lab.font, labels=c("Chr",chr.labels), srt=chr.labels.angle, xpd=TRUE,adj=c(ifelse(chr.labels.angle < 0, 0, ifelse(chr.labels.angle == 0, 0.5, 1)), ifelse(chr.labels.angle == 0, 0.5, ifelse(abs(chr.labels.angle) > 45, 0.5, 1)))) 1698 | # axis(1, at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd, cex.axis=axis.cex,font=lab.font,labels=c("Chr",chr.labels)) 1699 | } 1700 | } 1701 | } 1702 | axis(1, mgp=c(3,xticks.pos,0), at=c(ticks[length(ticks)], max_no_na(pvalue.posN)), labels=c("",""), tcl=0, lwd=axis.lwd) 1703 | if(is.null(ylim)){ 1704 | if((Max-Min)>1){ 1705 | #print(seq(0,(Max+1),ceiling((Max+1)/10))) 1706 | axis(2,las=1,lwd=axis.lwd,cex.axis=axis.cex,font=lab.font) 1707 | axis(2, at=c(Min, Max), labels=c("",""), tcl=0, lwd=axis.lwd) 1708 | legend.y <- Max 1709 | }else{ 1710 | axis(2,las=1,lwd=axis.lwd,cex.axis=axis.cex,font=lab.font) 1711 | axis(2, at=c(Min, Max), labels=c("",""), tcl=0, lwd=axis.lwd) 1712 | legend.y <- Max 1713 | } 1714 | }else{ 1715 | axis(2, las=1,lwd=axis.lwd,cex.axis=axis.cex,font=lab.font) 1716 | axis(2, at=c(Min, Max), labels=c("",""), tcl=0, lwd=axis.lwd) 1717 | legend.y <- Max 1718 | } 1719 | if(chr.border){ 1720 | for(b in 1:length(chr.border.pos)){ 1721 | segments(chr.border.pos[b], Min, chr.border.pos[b], Max, col="grey45", lwd=axis.lwd, lty=2) 1722 | } 1723 | } 1724 | 1725 | if(length(unique(col)) != 1){ 1726 | sam.index <- list() 1727 | trait_max_n <- 0 1728 | trait_max <- 0 1729 | for(l in 1:R){ 1730 | sam.index[[l]] <- c(1:nrow(Pmap))[is_visable[[l]] & !is.na(logpvalueT[,l])] 1731 | if(length(sam.index[[l]]) >= trait_max_n){ 1732 | trait_max_n=length(sam.index[[l]]) 1733 | trait_max=l 1734 | } 1735 | } 1736 | 1737 | #change the sample number according to Pmap 1738 | #sam.num <- ceiling(nrow(Pmap)/100) 1739 | sam.num <- 1000 1740 | cat_bar <- seq(1, 100, 1) 1741 | trait_n <- sapply(sam.index, length) 1742 | trait_sams <- ceiling(trait_n / sam.num) 1743 | trait_max_sams <- max(trait_sams) 1744 | trait_1st_sam <- trait_max_sams - trait_sams + 1 1745 | trait_full_sams <- floor(trait_n / sam.num) 1746 | trait_1st_full_sam <- trait_max_sams - trait_full_sams + 1 1747 | for(sam in 1:trait_max_sams) { 1748 | for(i in 1:R){ 1749 | if(sam < trait_1st_sam[i]){ 1750 | # nothing 1751 | }else{ 1752 | if(sam < trait_1st_full_sam[i]){ 1753 | plot.index <- sample(sam.index[[i]], trait_n[i] %% sam.num, replace=FALSE) 1754 | }else{ 1755 | plot.index <- sample(sam.index[[i]], sam.num, replace=FALSE) 1756 | } 1757 | sam.index[[i]] <- sam.index[[i]][-which(sam.index[[i]] %in% plot.index)] 1758 | logpvalue=logpvalueT[plot.index,i] 1759 | if(!is.null(ylim)){indexx <- logpvalue>=min_no_na(ylim[[i]])}else{indexx <- 1:length(logpvalue)} 1760 | points(pvalue.posN[plot.index][indexx],logpvalue[indexx],pch=pch[i],type=type,lwd=cex[2]+1,cex=cex[2],col=rgb(t(col2rgb(t(col)[i])), alpha=points.alpha, maxColorValue=255)) 1761 | } 1762 | } 1763 | if(verbose){ 1764 | progress <- round((nrow(Pmap) - length(sam.index[[trait_max]])) * 100 / nrow(Pmap)) 1765 | if(progress %in% cat_bar){ 1766 | cat(" Multi-traits Rectangular plotting ... (finished ", progress, "%)\r", sep="") 1767 | cat_bar <- cat_bar[cat_bar != progress] 1768 | if(progress == 100) cat("\n") 1769 | } 1770 | } 1771 | } 1772 | }else{ 1773 | for(i in 1:R){ 1774 | logpvalue=logpvalueT[,i] 1775 | if(!is.null(ylim)){indexx <- logpvalue>=min_no_na(ylim[[i]])}else{indexx <- 1:length(logpvalue)} 1776 | points(pvalue.posN[indexx],logpvalue[indexx],pch=pch[i],type=type,lwd=cex[2]+1,cex=cex[2],col=rgb(t(col2rgb(t(col)[i])), alpha=points.alpha, maxColorValue=255)) 1777 | } 1778 | } 1779 | if(!is.null(threshold)){ 1780 | for(thr in 1:length(threshold[[i]])){ 1781 | h <- ifelse(LOG10, -log10(threshold[[i]][thr]), threshold[[i]][thr]) 1782 | segments(0, h, max_no_na(pvalue.posN), h, col=threshold.col[thr],lwd=threshold.lwd[thr],lty=threshold.lty[thr]) 1783 | } 1784 | if(amplify==TRUE){ 1785 | if(length(unique(col)) != 1){ 1786 | for(i in 1:R){ 1787 | logpvalue=logpvalueT[, i] 1788 | for(ll in 1:length(threshold[[i]])){ 1789 | if(ll == 1){ 1790 | if(LOG10){ 1791 | sgline1=-log10(threshold[[i]][ll]) 1792 | }else{ 1793 | sgline1=threshold[[i]][ll] 1794 | } 1795 | sgindex=which(logpvalue>=sgline1) 1796 | HY1=logpvalue[sgindex] 1797 | HX1=pvalue.posN[sgindex] 1798 | }else{ 1799 | if(LOG10){ 1800 | sgline0=-log10(threshold[[i]][ll-1]) 1801 | sgline1=-log10(threshold[[i]][ll]) 1802 | }else{ 1803 | sgline0=threshold[[i]][ll-1] 1804 | sgline1=threshold[[i]][ll] 1805 | } 1806 | sgindex=which(logpvalue>=sgline1 & logpvalue < sgline0) 1807 | HY1=logpvalue[sgindex] 1808 | HX1=pvalue.posN[sgindex] 1809 | } 1810 | points(HX1,HY1,pch=pch[i],cex=cex[2],col="white") 1811 | if(is.null(signal.col)){ 1812 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll],col=rgb(t(col2rgb(t(col)[i])), alpha=points.alpha, maxColorValue=255)) 1813 | }else{ 1814 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll],col=rgb(t(col2rgb(signal.col[ll])), alpha=points.alpha, maxColorValue=255)) 1815 | } 1816 | 1817 | } 1818 | } 1819 | }else{ 1820 | for(i in 1:R){ 1821 | logpvalue=logpvalueT[, i] 1822 | if(LOG10){ 1823 | sgindex = which(logpvalue > -log10(min(unlist(threshold)))) 1824 | }else{ 1825 | sgindex = which(logpvalue > max(unlist(threshold))) 1826 | } 1827 | HY1=logpvalue[sgindex] 1828 | HX1=pvalue.posN[sgindex] 1829 | points(HX1,HY1,pch=pch[i],cex=cex[2],col="white") 1830 | points(HX1,HY1,pch=rep(signal.pch, R)[i],cex=rep(signal.cex, R)[i],col=rgb(t(col2rgb(rep(signal.col, R)[i])), alpha=points.alpha, maxColorValue=255)) 1831 | } 1832 | } 1833 | } 1834 | } 1835 | 1836 | if(is.null(ylim)){ymin <- Min}else{ymin <- min_no_na(unlist(ylim))} 1837 | if(cir.density){ 1838 | for(yll in 1:length(pvalue.posN.list)){ 1839 | polygon(c(min_no_na(pvalue.posN.list[[yll]]), min_no_na(pvalue.posN.list[[yll]]), max_no_na(pvalue.posN.list[[yll]]), max_no_na(pvalue.posN.list[[yll]])), 1840 | c(ymin-0.5*(Max-Min)/den.fold, ymin-1.5*(Max-Min)/den.fold, 1841 | ymin-1.5*(Max-Min)/den.fold, ymin-0.5*(Max-Min)/den.fold), 1842 | col="grey", border="grey") 1843 | } 1844 | is_visable_den <- filter.points(pvalue.posN, ymin-0.5*(Max-Min)/den.fold, wh, ht, dpi=dpi) 1845 | segments( 1846 | pvalue.posN[is_visable_den], 1847 | ymin-0.5*(Max-Min)/den.fold, 1848 | pvalue.posN[is_visable_den], 1849 | ymin-1.5*(Max-Min)/den.fold, 1850 | col=density.list$den.col[is_visable_den], lwd=0.5 1851 | ) 1852 | legend( 1853 | x=max_no_na(pvalue.posN)+band, 1854 | y=legend.y, 1855 | title="", legend=density.list$legend.y, pch=15, pt.cex=2.5, col=density.list$legend.col, 1856 | cex=legend.cex*0.8, bty="n", 1857 | y.intersp=1, 1858 | x.intersp=1, 1859 | yjust=0.9, xjust=0, xpd=TRUE 1860 | ) 1861 | } 1862 | if(!is.null(main)) title(main=main[1], cex.main=main.cex, font.main= main.font) 1863 | if(box) box(lwd=axis.lwd) 1864 | if(file.output) dev.off() 1865 | } 1866 | }else{ 1867 | #print("Starting Rectangular-Manhattan plot!",quote=F) 1868 | if(!is.null(file.name) && length(file.name) != R) stop(paste("please provide a vector containing file names of all", R, "traits.")) 1869 | for(i in 1:R){ 1870 | colx=col[i,] 1871 | colx=colx[!is.na(colx)] 1872 | if(verbose) cat(paste(" Rectangular Manhattan plotting ",trait[i],".\n",sep="")) 1873 | if(file.output){ 1874 | ht=ifelse(is.null(height), 6, height) 1875 | wh=ifelse(is.null(width), 14, width) 1876 | if(file=="jpg") jpeg(paste("Rect_Manhtn.",ifelse(is.null(file.name),trait[i],file.name[i]),".jpg",sep=""), width=wh*dpi,height=ht*dpi,res=dpi,quality=100) 1877 | if(file=="pdf") pdf(paste("Rect_Manhtn.",ifelse(is.null(file.name),trait[i],file.name[i]),".pdf",sep=""), width=wh,height=ht) 1878 | if(file=="tiff") tiff(paste("Rect_Manhtn.",ifelse(is.null(file.name),trait[i],file.name[i]),".tiff",sep=""), width=wh*dpi,height=ht*dpi,res=dpi) 1879 | if(file=="png") png(paste("Rect_Manhtn.",ifelse(is.null(file.name),trait[i],file.name[i]),".png",sep=""), width=wh*dpi,height=ht*dpi,res=dpi,bg=NA) 1880 | par(mar=mar,xaxs="i",yaxs="r") 1881 | } 1882 | if(!file.output){ 1883 | ht=ifelse(is.null(height), 6, height) 1884 | wh=ifelse(is.null(width), 14, width) 1885 | if(is.null(dev.list())) dev.new(width=wh, height=ht) 1886 | # par(xpd=TRUE) 1887 | } 1888 | 1889 | pvalue=pvalueT[,i] 1890 | logpvalue=logpvalueT[,i] 1891 | if(is.null(ylim)){ 1892 | if(!is.null(threshold[[i]])){ 1893 | if(sum(threshold[[i]]!=0)==length(threshold[[i]])){ 1894 | if(LOG10 == TRUE){ 1895 | Max=max_ylim(max_no_na(c((-log10(min_no_na(pvalue))),(-log10(min_no_na(threshold[[i]])))))) 1896 | Min <- min_ylim(min_no_na(c(-log10((max_no_na(pvalue))),-log10(max_no_na(threshold[[i]]))))) 1897 | }else{ 1898 | Max=max_ylim(max_no_na(c((max_no_na(pvalue)),max_no_na(threshold[[i]])))) 1899 | #if(abs(Max)<=1) Max=max_no_na(c(max_no_na(pvalue),max_no_na(threshold))) 1900 | Min <- min_ylim(min_no_na(c((min_no_na(pvalue)),min_no_na(threshold[[i]])))) 1901 | #if(abs(Min)<=1) Min=min_no_na(c(min_no_na(pvalue),min_no_na(threshold))) 1902 | } 1903 | }else{ 1904 | if(LOG10){ 1905 | Max=max_ylim(-log10(min_no_na(pvalue))) 1906 | Min<-min_ylim(-log10(max_no_na(pvalue))) 1907 | }else{ 1908 | Max=max_ylim(max_no_na(pvalue)) 1909 | #if(abs(Max)<=1) Max=max_no_na(c(max_no_na(pvalue))) 1910 | Min<-min_ylim(min_no_na(pvalue)) 1911 | #if(abs(Min)<=1) Min=min_no_na(pvalue) 1912 | # }else{ 1913 | # Max=max_no_na(ceiling(max_no_na(pvalue))) 1914 | # } 1915 | } 1916 | } 1917 | }else{ 1918 | if(LOG10){ 1919 | Max=max_ylim(-log10(min_no_na(pvalue))) 1920 | Min<-min_ylim(-log10(max_no_na(pvalue))) 1921 | }else{ 1922 | Max=max_ylim(max_no_na(pvalue)) 1923 | #if(abs(Max)<=1) Max=max_no_na(c(max_no_na(pvalue))) 1924 | Min<-min_ylim(min_no_na(pvalue)) 1925 | #if(abs(Min)<=1) Min=min_no_na(pvalue) 1926 | # }else{ 1927 | # Max=max_no_na(ceiling(max_no_na(pvalue))) 1928 | # } 1929 | } 1930 | } 1931 | if((Max-Min)<=1){ 1932 | if(cir.density){ 1933 | plot(pvalue.posN[is_visable[[i]]],logpvalue[is_visable[[i]]],pch=pch,type=type,lwd=cex[2]+1,cex=cex[2],col=rep(rep(colx,N[i]),add[[i]])[is_visable[[i]]],xlim=c(min_no_na(pvalue.posN)-band,band+1.05*max_no_na(pvalue.posN)),ylim=c(Min-(Max-Min)/den.fold, Max),ann=FALSE, 1934 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1935 | }else{ 1936 | plot(pvalue.posN[is_visable[[i]]],logpvalue[is_visable[[i]]],pch=pch,type=type,lwd=cex[2]+1,cex=cex[2],col=rep(rep(colx,N[i]),add[[i]])[is_visable[[i]]],xlim=c(min_no_na(pvalue.posN)-band,band+max_no_na(pvalue.posN)),ylim=c(Min,Max),ann=FALSE, 1937 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1938 | } 1939 | }else{ 1940 | if(cir.density){ 1941 | plot(pvalue.posN[is_visable[[i]]],logpvalue[is_visable[[i]]],pch=pch,type=type,lwd=cex[2]+1,cex=cex[2],col=rep(rep(colx,N[i]),add[[i]])[is_visable[[i]]],xlim=c(min_no_na(pvalue.posN)-band,band+1.05*max_no_na(pvalue.posN)),ylim=c(Min-(Max-Min)/den.fold,Max),ann=FALSE, 1942 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1943 | }else{ 1944 | plot(pvalue.posN[is_visable[[i]]],logpvalue[is_visable[[i]]],pch=pch,type=type,lwd=cex[2]+1,cex=cex[2],col=rep(rep(colx,N[i]),add[[i]])[is_visable[[i]]],xlim=c(min_no_na(pvalue.posN)-band,band+max_no_na(pvalue.posN)),ylim=c(Min,Max),ann=FALSE, 1945 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1946 | } 1947 | } 1948 | mtext(side=2, text=ylab, line=ylab.pos, cex=lab.cex, font=lab.font, xpd=TRUE) 1949 | }else{ 1950 | Max <- max_no_na(ylim[[i]]) 1951 | Min <- min_no_na(ylim[[i]]) 1952 | if(cir.density){ 1953 | plot(pvalue.posN[logpvalue>=min_no_na(ylim[[i]]) & is_visable[[i]]],logpvalue[logpvalue>=min_no_na(ylim[[i]]) & is_visable[[i]]],pch=pch,type=type,lwd=cex[2]+1,cex=cex[2],col=rep(rep(colx,N[i]),add[[i]])[logpvalue>=min_no_na(ylim[[i]]) & is_visable[[i]]],xlim=c(min_no_na(pvalue.posN)-band,band+1.05*max_no_na(pvalue.posN)),ylim=c(min_no_na(ylim[[i]])-(Max-Min)/den.fold, max_no_na(ylim[[i]])),ann=FALSE, 1954 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1955 | }else{ 1956 | plot(pvalue.posN[logpvalue>=min_no_na(ylim[[i]]) & is_visable[[i]]],logpvalue[logpvalue>=min_no_na(ylim[[i]]) & is_visable[[i]]],pch=pch,type=type,lwd=cex[2]+1,cex=cex[2],col=rep(rep(colx,N[i]),add[[i]])[logpvalue>=min_no_na(ylim[[i]]) & is_visable[[i]]],xlim=c(min_no_na(pvalue.posN)-band,band+max_no_na(pvalue.posN)),ylim=ylim[[i]],ann=FALSE, 1957 | cex.axis=axis.cex,font=lab.font,axes=FALSE) 1958 | } 1959 | mtext(side=2, text=ylab, line=ylab.pos, cex=lab.cex, font=lab.font, xpd=TRUE) 1960 | } 1961 | # Max1 <- Max 1962 | # Min1 <- Min 1963 | # if(abs(Max) <= 1) Max <- round(Max, ceiling(-log10(abs(Max)))) 1964 | # if(abs(Min) <= 1) Min <- round(Min, ceiling(-log10(abs(Min)))) 1965 | if(chr.border){ 1966 | for(b in 1:length(chr.border.pos)){ 1967 | segments(chr.border.pos[b], Min, chr.border.pos[b], Max, col="grey45", lwd=axis.lwd, lty=2) 1968 | } 1969 | } 1970 | 1971 | if(chr.labels.angle == 0){ 1972 | if(!is.null(chr.labels)){ 1973 | if(Nchr == 1){ 1974 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd, cex.axis=axis.cex,font=lab.font,labels=c(paste("Chr.", unique(Pmap[,1]), bp_lab, sep=""),chr.labels)) 1975 | }else{ 1976 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd, cex.axis=axis.cex,font=lab.font,labels=c("Chr",chr.labels)) 1977 | #axis(1, at=c(ticks[length(ticks)], max_no_na(pvalue.posN)), labels=c("",""), tcl=0, lwd=axis.lwd) 1978 | } 1979 | }else{ 1980 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd, cex.axis=axis.cex,font=lab.font,labels=c("Chr",chr.ori)) 1981 | #axis(1, at=c(ticks[length(ticks)], max_no_na(pvalue.posN)), labels=c("",""), tcl=0, lwd=axis.lwd) 1982 | } 1983 | }else{ 1984 | axis(1, mgp=c(3,xticks.pos,0), at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd,labels=FALSE) 1985 | if(!is.null(chr.labels)){ 1986 | if(Nchr == 1){ 1987 | text(c(min_no_na(pvalue.posN)-band,ticks), par("usr")[3]*2-ifelse(cir.density, Min-(Max-Min)/den.fold, Min), cex=axis.cex, font=lab.font, labels=c(paste("Chr.", unique(Pmap[,1]), bp_lab, sep=""),chr.labels), srt=chr.labels.angle, xpd=TRUE,adj=c(ifelse(chr.labels.angle < 0, 0, ifelse(chr.labels.angle == 0, 0.5, 1)), ifelse(chr.labels.angle == 0, 0.5, ifelse(abs(chr.labels.angle) > 45, 0.5, 1)))) 1988 | }else{ 1989 | # axis(1, at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd, cex.axis=axis.cex,font=2,labels=) 1990 | #axis(1, at=c(ticks[length(ticks)], max_no_na(pvalue.posN)), labels=c("",""), tcl=0, lwd=axis.lwd) 1991 | text(c(min_no_na(pvalue.posN)-band,ticks), par("usr")[3]*2-ifelse(cir.density, Min-(Max-Min)/den.fold, Min), cex=axis.cex, font=lab.font, labels=c("Chr",chr.labels), srt=chr.labels.angle, xpd=TRUE,adj=c(ifelse(chr.labels.angle < 0, 0, ifelse(chr.labels.angle == 0, 0.5, 1)), ifelse(chr.labels.angle == 0, 0.5, ifelse(abs(chr.labels.angle) > 45, 0.5, 1)))) 1992 | } 1993 | }else{ 1994 | # axis(1, at=c(min_no_na(pvalue.posN)-band,ticks), lwd=axis.lwd, cex.axis=axis.cex,font=2,labels=c("Chr",chr.ori)) 1995 | #axis(1, at=c(ticks[length(ticks)], max_no_na(pvalue.posN)), labels=c("",""), tcl=0, lwd=axis.lwd) 1996 | text(c(min_no_na(pvalue.posN)-band,ticks), par("usr")[3]*2-ifelse(cir.density, Min-(Max-Min)/den.fold, Min), cex=axis.cex, font=lab.font, labels=c("Chr",chr.ori), srt=chr.labels.angle, xpd=TRUE,adj=c(ifelse(chr.labels.angle < 0, 0, ifelse(chr.labels.angle == 0, 0.5, 1)), ifelse(chr.labels.angle == 0, 0.5, ifelse(abs(chr.labels.angle) > 45, 0.5, 1)))) 1997 | } 1998 | } 1999 | axis(1, mgp=c(3,xticks.pos,0), at=c(ticks[length(ticks)], max_no_na(pvalue.posN)), labels=c("",""), tcl=0, lwd=axis.lwd) 2000 | if(is.null(ylim)){ 2001 | if((Max-Min)>1){ 2002 | axis(2, las=1, lwd=axis.lwd,cex.axis=axis.cex,font=lab.font) 2003 | axis(2, at=c(Min, Max), labels=c("",""), tcl=0, lwd=axis.lwd) 2004 | legend.y <- Max 2005 | }else{ 2006 | axis(2, las=1,lwd=axis.lwd,cex.axis=axis.cex,font=lab.font) 2007 | axis(2, at=c(Min, Max), labels=c("",""), tcl=0, lwd=axis.lwd) 2008 | legend.y <- Max 2009 | } 2010 | }else{ 2011 | axis(2, las=1,lwd=axis.lwd,cex.axis=axis.cex,font=lab.font) 2012 | axis(2, at=c(Min, Max), labels=c("",""), tcl=0, lwd=axis.lwd) 2013 | legend.y <- tail(ylim[[i]][2], 1) 2014 | } 2015 | if(!is.null(threshold[[i]])){ 2016 | for(thr in 1:length(threshold[[i]])){ 2017 | h <- ifelse(LOG10, -log10(threshold[[i]][thr]), threshold[[i]][thr]) 2018 | # print(h) 2019 | # print(threshold.col[thr]) 2020 | # print(threshold.lty[thr]) 2021 | # print(threshold.lwd[thr]) 2022 | segments(0, h, max_no_na(pvalue.posN), h,col=threshold.col[thr],lty=threshold.lty[thr],lwd=threshold.lwd[thr]) 2023 | } 2024 | if(amplify == TRUE){ 2025 | if(LOG10){ 2026 | threshold[[i]] <- sort(threshold[[i]]) 2027 | sgline1=-log10(max_no_na(threshold[[i]])) 2028 | }else{ 2029 | threshold[[i]] <- sort(threshold[[i]], decreasing=TRUE) 2030 | sgline1=min_no_na(threshold[[i]]) 2031 | } 2032 | 2033 | sgindex=which(logpvalue>=sgline1) 2034 | HY1=logpvalue[sgindex] 2035 | HX1=pvalue.posN[sgindex] 2036 | 2037 | #cover the points that exceed the threshold with the color "white" 2038 | points(HX1,HY1,pch=pch,cex=cex[2],col="white") 2039 | 2040 | for(ll in 1:length(threshold[[i]])){ 2041 | if(ll == 1){ 2042 | if(LOG10){ 2043 | sgline1=-log10(threshold[[i]][ll]) 2044 | }else{ 2045 | sgline1=threshold[[i]][ll] 2046 | } 2047 | sgindex=which(logpvalue>=sgline1) 2048 | HY1=logpvalue[sgindex] 2049 | HX1=pvalue.posN[sgindex] 2050 | }else{ 2051 | if(LOG10){ 2052 | sgline0=-log10(threshold[[i]][ll-1]) 2053 | sgline1=-log10(threshold[[i]][ll]) 2054 | }else{ 2055 | sgline0=threshold[[i]][ll-1] 2056 | sgline1=threshold[[i]][ll] 2057 | } 2058 | sgindex=which(logpvalue>=sgline1 & logpvalue < sgline0) 2059 | HY1=logpvalue[sgindex] 2060 | HX1=pvalue.posN[sgindex] 2061 | } 2062 | 2063 | if(is.null(signal.col)){ 2064 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll],col=rep(rep(colx,N[i]),add[[i]])[sgindex]) 2065 | }else{ 2066 | points(HX1,HY1,pch=signal.pch[ll],cex=signal.cex[ll],col=signal.col[ll]) 2067 | } 2068 | 2069 | } 2070 | } 2071 | 2072 | } 2073 | 2074 | if(!is.null(highlight)){ 2075 | # points(x=pvalue.posN[highlight_index[[i]]],y=logpvalue[highlight_index[[i]]],pch=pch,cex=cex[2],col="white") 2076 | if(!is.na(highlight_index[[i]][1])){ 2077 | if(is.null(highlight.col)){ 2078 | highlight_text(x=pvalue.posN[highlight_index[[i]]],y=logpvalue[highlight_index[[i]]],xlim=c(min_no_na(pvalue.posN)-band,max_no_na(pvalue.posN)),ylim=c(Min,Max),words=highlight.text[[i]],point.cex=highlight.cex,text.cex=highlight.text.cex, pch=highlight.pch,type=highlight.type,point.col=rep(rep(colx,N[i]),add[[i]])[highlight_index[[i]]],text.col=highlight.text.col,text.font=highlight.text.font) 2079 | }else{ 2080 | highlight_text(x=pvalue.posN[highlight_index[[i]]],y=logpvalue[highlight_index[[i]]],xlim=c(min_no_na(pvalue.posN)-band,max_no_na(pvalue.posN)),ylim=c(Min,Max),words=highlight.text[[i]],point.cex=highlight.cex,text.cex=highlight.text.cex, pch=highlight.pch,type=highlight.type,point.col=highlight_col[[i]],text.col=highlight.text.col,text.font=highlight.text.font) 2081 | } 2082 | } 2083 | } 2084 | 2085 | #if(!is.null(threshold) & !is.null(signal.line)) abline(v=pvalue.posN[which(pvalueT[,i] < min_no_na(threshold))],col="grey",lty=2,lwd=signal.line) 2086 | 2087 | if(is.null(ylim)){ymin <- Min}else{ymin <- min_no_na(ylim[[i]])} 2088 | if(cir.density){ 2089 | for(yll in 1:length(pvalue.posN.list)){ 2090 | polygon(c(min_no_na(pvalue.posN.list[[yll]]), min_no_na(pvalue.posN.list[[yll]]), max_no_na(pvalue.posN.list[[yll]]), max_no_na(pvalue.posN.list[[yll]])), 2091 | c(ymin-0.5*(Max-Min)/den.fold, ymin-1.5*(Max-Min)/den.fold, 2092 | ymin-1.5*(Max-Min)/den.fold, ymin-0.5*(Max-Min)/den.fold), 2093 | col="grey", border="grey", xpd=TRUE) 2094 | } 2095 | is_visable_den <- filter.points(pvalue.posN, ymin-0.5*(Max-Min)/den.fold, wh, ht, dpi=dpi) 2096 | segments( 2097 | pvalue.posN[is_visable_den], 2098 | ymin-0.5*(Max-Min)/den.fold, 2099 | pvalue.posN[is_visable_den], 2100 | ymin-1.5*(Max-Min)/den.fold, 2101 | col=density.list$den.col[is_visable_den], lwd=0.5,xpd=TRUE 2102 | ) 2103 | legend( 2104 | x=max_no_na(pvalue.posN)+band, 2105 | y=legend.y, 2106 | title="", legend=density.list$legend.y, pch=15, pt.cex=2.5, col=density.list$legend.col, 2107 | cex=legend.cex*0.8, bty="n", 2108 | y.intersp=1, 2109 | x.intersp=1, 2110 | yjust=0.9, xjust=0, xpd=TRUE 2111 | ) 2112 | 2113 | } 2114 | if(!is.null(main)) title(main=main[i], cex.main=main.cex, font.main= main.font) 2115 | if(box) box(lwd=axis.lwd) 2116 | if(file.output) dev.off() 2117 | } 2118 | } 2119 | } 2120 | 2121 | if("q" %in% plot.type){ 2122 | 2123 | signal.col <- rep(signal.col,R) 2124 | signal.pch <- rep(signal.pch,R) 2125 | signal.cex <- rep(signal.cex*1.1,R) 2126 | 2127 | if(multracks | multraits){ 2128 | if(R < 2) stop("need more than one trait.") 2129 | if(multracks){ 2130 | if(file.output){ 2131 | ht=ifelse(is.null(height), 5.5, height) 2132 | wh=ifelse(is.null(width), 3.5, width) 2133 | if(file=="jpg") jpeg(paste("Multi-tracks_QQplot.",ifelse(is.null(file.name),taxa,file.name[1]),".jpg",sep=""), width=R*wh*dpi,height=ht*dpi,res=dpi,quality=100) 2134 | if(file=="pdf") pdf(paste("Multi-tracks_QQplot.",ifelse(is.null(file.name),taxa,file.name[1]),".pdf",sep=""), width=R*wh,height=ht) 2135 | if(file=="tiff") tiff(paste("Multi-tracks_QQplot.",ifelse(is.null(file.name),taxa,file.name[1]),".tiff",sep=""), width=R*wh*dpi,height=ht*dpi,res=dpi) 2136 | if(file=="png") png(paste("Multi-tracks_QQplot.",ifelse(is.null(file.name),taxa,file.name[1]),".png",sep=""), width=R*wh*dpi,height=ht*dpi,res=dpi,bg=NA) 2137 | par(mfcol=c(1,R),xpd=TRUE) 2138 | }else{ 2139 | ht=ifelse(is.null(height), 5.5, height) 2140 | wh=ifelse(is.null(width), 3.5, width) 2141 | if(is.null(dev.list())) dev.new(width=wh*R, height=ht) 2142 | par(xpd=TRUE) 2143 | } 2144 | for(i in 1:R){ 2145 | if(i == 1) par(mar=c(mar[2], mar[2], mar[3], 0)) 2146 | if(i == R) par(mar=c(mar[2], 1.5, mar[3], mar[4])) 2147 | if(i != 1 & i != R) par(mar=c(mar[2], 1.5, mar[3], 0)) 2148 | if(verbose) cat(paste(" Multi-tracks Q-Q plotting ",trait[i],".\n",sep="")) 2149 | P.values=as.numeric(Pmap[,i+2]) 2150 | P.values=P.values[!is.na(P.values)] 2151 | if(LOG10){ 2152 | P.values=P.values[P.values>0] 2153 | P.values=P.values[P.values<1] 2154 | N=length(P.values) 2155 | P.values=P.values[order(P.values)] 2156 | }else{ 2157 | N=length(P.values) 2158 | P.values=P.values[order(P.values,decreasing=TRUE)] 2159 | } 2160 | p_value_quantiles=(1:length(P.values))/(length(P.values)+1) 2161 | log.Quantiles <- -log10(p_value_quantiles) 2162 | if(LOG10){ 2163 | log.P.values <- -log10(P.values) 2164 | }else{ 2165 | log.P.values <- P.values 2166 | } 2167 | 2168 | #calculate the confidence interval of QQ-plot 2169 | if(conf.int){ 2170 | N1=length(log.Quantiles) 2171 | c95 <- rep(NA,N1) 2172 | c05 <- rep(NA,N1) 2173 | for(j in 1:N1){ 2174 | xi=ceiling((10^-log.Quantiles[j])*N) 2175 | if(xi==0)xi=1 2176 | c95[j] <- qbeta(0.95,xi,N-xi+1) 2177 | c05[j] <- qbeta(0.05,xi,N-xi+1) 2178 | } 2179 | index=length(c95):1 2180 | }else{ 2181 | c05 <- 1 2182 | c95 <- 1 2183 | } 2184 | 2185 | YlimMax <- max_no_na(c(floor(max_no_na(c(max_no_na(-log10(c05)), max_no_na(-log10(c95))))+1), floor(max_no_na(log.P.values)+1))) 2186 | if(is.null(ylim)){ 2187 | plot(NULL, xlim=c(0,floor(max_no_na(log.Quantiles)+1)), axes=FALSE, cex.axis=axis.cex, cex.lab=lab.cex,ylim=c(0,YlimMax),xlab ="", ylab="") 2188 | }else{ 2189 | plot(NULL, xlim=c(0,floor(max_no_na(log.Quantiles)+1)), axes=FALSE, cex.axis=axis.cex, cex.lab=lab.cex,ylim=c(0,max(ylim[[i]])),xlab ="", ylab="") 2190 | } 2191 | axis(1, mgp=c(3,xticks.pos,0), at=seq(0,floor(max_no_na(log.Quantiles)+1),ceiling((max_no_na(log.Quantiles)+1)/10)), lwd=axis.lwd,labels=seq(0,floor(max_no_na(log.Quantiles)+1),ceiling((max_no_na(log.Quantiles)+1)/10)), cex.axis=axis.cex) 2192 | axis(2, las=1, lwd=axis.lwd,cex.axis=axis.cex) 2193 | axis(2, at=c(0, ifelse(is.null(ylim), YlimMax, max(ylim[[i]]))), labels=c("",""), tcl=0, lwd=axis.lwd) 2194 | 2195 | #plot the confidence interval of QQ-plot 2196 | if(conf.int){ 2197 | if(is.null(conf.int.col)){ 2198 | polygon(c(log.Quantiles[index],log.Quantiles),c(-log10(c05)[index],-log10(c95)),col=rgb(t(col2rgb(t(col)[i])), alpha=points.alpha, maxColorValue=255),border=rgb(t(col2rgb(t(col)[i])), alpha=points.alpha, maxColorValue=255)) 2199 | }else{ 2200 | polygon(c(log.Quantiles[index],log.Quantiles),c(-log10(c05)[index],-log10(c95)),col=rgb(t(col2rgb(conf.int.col[i])), alpha=points.alpha, maxColorValue=255),border=rgb(t(col2rgb(conf.int.col[i])), alpha=points.alpha, maxColorValue=255)) 2201 | } 2202 | } 2203 | if(!is.null(threshold.col)){par(xpd=FALSE); abline(a=0, b=1,lwd=threshold.lty[1], lty=threshold.lty[1], col=threshold.col[1]); par(xpd=TRUE)} 2204 | is_visable <- filter.points(log.Quantiles, log.P.values, wh, ht, dpi=dpi) 2205 | if(!is.null(threshold[[i]])){ 2206 | # if(sum(threshold!=0)==length(threshold)){ 2207 | thre.line=-log10(min_no_na(threshold[[i]])) 2208 | if(amplify==TRUE){ 2209 | thre.index <- log.P.values 0])))) 2287 | plot(NULL, xlim=c(0,floor(max_no_na(log.Quantiles.max_no_na)+1)), axes=FALSE, xlab="", ylab="", cex.axis=axis.cex, cex.lab=lab.cex,ylim=c(0, floor(YlimMax+1)), main = "QQplot", cex.main=main.cex, font.main=main.font) 2288 | }else{ 2289 | plot(NULL, xlim=c(0,floor(max_no_na(log.Quantiles.max_no_na)+1)), axes=FALSE, xlab="", ylab="", cex.axis=axis.cex, cex.lab=lab.cex,ylim=c(0, max(unlist(ylim))),main = "QQplot", cex.main=main.cex, font.main=main.font) 2290 | } 2291 | legend("topleft",trait,col=rgb(t(col2rgb(t(col)[1:R])), alpha=points.alpha, maxColorValue=255),pch=19,cex=legend.cex,text.font=6,box.col=NA, xpd=TRUE) 2292 | axis(1, mgp=c(3,xticks.pos,0), at=seq(0,floor(max_no_na(log.Quantiles.max_no_na)+1),ceiling((max_no_na(log.Quantiles.max_no_na)+1)/10)), lwd=axis.lwd,labels=seq(0,floor(max_no_na(log.Quantiles.max_no_na)+1),ceiling((max_no_na(log.Quantiles.max_no_na)+1)/10)), cex.axis=axis.cex) 2293 | axis(2, las=1,lwd=axis.lwd,cex.axis=axis.cex) 2294 | axis(2, at=c(0, ifelse(is.null(ylim), YlimMax, max(unlist(ylim)))), labels=c("",""), tcl=0, lwd=axis.lwd) 2295 | 2296 | mtext(side=1, text=expression(Expected~~-log[10](italic(p))), line=ylab.pos+1, cex=lab.cex, font=lab.font, xpd=TRUE) 2297 | mtext(side=2, text=expression(Observed~~-log[10](italic(p))), line=ylab.pos, cex=lab.cex, font=lab.font, xpd=TRUE) 2298 | 2299 | for(i in 1:R){ 2300 | if(verbose) cat(paste(" Multi-traits Q-Q plotting ",trait[i],".\n",sep="")) 2301 | P.values=as.numeric(Pmap[,i+2]) 2302 | P.values=P.values[!is.na(P.values)] 2303 | if(LOG10){ 2304 | P.values=P.values[P.values>0] 2305 | P.values=P.values[P.values<1] 2306 | N=length(P.values) 2307 | P.values=P.values[order(P.values)] 2308 | }else{ 2309 | N=length(P.values) 2310 | P.values=P.values[order(P.values,decreasing=TRUE)] 2311 | } 2312 | p_value_quantiles=(1:length(P.values))/(length(P.values)+1) 2313 | log.Quantiles <- -log10(p_value_quantiles) 2314 | if(LOG10){ 2315 | log.P.values <- -log10(P.values) 2316 | }else{ 2317 | log.P.values <- P.values 2318 | } 2319 | 2320 | #calculate the confidence interval of QQ-plot 2321 | if(conf.int){ 2322 | N1=length(log.Quantiles) 2323 | c95 <- rep(NA,N1) 2324 | c05 <- rep(NA,N1) 2325 | for(j in 1:N1){ 2326 | xi=ceiling((10^-log.Quantiles[j])*N) 2327 | if(xi==0)xi=1 2328 | c95[j] <- qbeta(0.95,xi,N-xi+1) 2329 | c05[j] <- qbeta(0.05,xi,N-xi+1) 2330 | } 2331 | index=length(c95):1 2332 | }else{ 2333 | c05 <- 1 2334 | c95 <- 1 2335 | } 2336 | 2337 | # plot the confidence interval of QQ-plot 2338 | if(conf.int){ 2339 | if(is.null(conf.int.col)){ 2340 | polygon(c(log.Quantiles[index],log.Quantiles),c(-log10(c05)[index],-log10(c95)),col=rgb(t(col2rgb(t(col)[i])), alpha=points.alpha, maxColorValue=255),border=rgb(t(col2rgb(t(col)[i])), alpha=points.alpha, maxColorValue=255)) 2341 | }else{ 2342 | polygon(c(log.Quantiles[index],log.Quantiles),c(-log10(c05)[index],-log10(c95)),col=rgb(t(col2rgb(conf.int.col[i])), alpha=points.alpha, maxColorValue=255),border=rgb(t(col2rgb(conf.int.col[i])), alpha=points.alpha, maxColorValue=255)) 2343 | } 2344 | } 2345 | 2346 | if((i == R) & !is.null(threshold.col)){par(xpd=FALSE); abline(a=0, b=1,lwd=threshold.lty[1], lty=threshold.lty[1], col=threshold.col[1]); par(xpd=TRUE)} 2347 | # points(log.Quantiles, log.P.values, col=t(col)[i],pch=19,cex=cex[3]) 2348 | is_visable <- filter.points(log.Quantiles, log.P.values, wh, ht, dpi=dpi) 2349 | if(!is.null(threshold[[i]])){ 2350 | # if(sum(threshold!=0)==length(threshold)){ 2351 | thre.line=-log10(min_no_na(threshold[[i]])) 2352 | if(amplify==TRUE){ 2353 | thre.index <- log.P.values0] 2403 | P.values=P.values[P.values<1] 2404 | N=length(P.values) 2405 | P.values=P.values[order(P.values)] 2406 | }else{ 2407 | N=length(P.values) 2408 | P.values=P.values[order(P.values,decreasing=TRUE)] 2409 | } 2410 | p_value_quantiles=(1:length(P.values))/(length(P.values)+1) 2411 | log.Quantiles <- -log10(p_value_quantiles) 2412 | if(LOG10){ 2413 | log.P.values <- -log10(P.values) 2414 | }else{ 2415 | log.P.values <- P.values 2416 | } 2417 | 2418 | #calculate the confidence interval of QQ-plot 2419 | if(conf.int){ 2420 | N1=length(log.Quantiles) 2421 | c95 <- rep(NA,N1) 2422 | c05 <- rep(NA,N1) 2423 | for(j in 1:N1){ 2424 | xi=ceiling((10^-log.Quantiles[j])*N) 2425 | if(xi==0)xi=1 2426 | c95[j] <- qbeta(0.95,xi,N-xi+1) 2427 | c05[j] <- qbeta(0.05,xi,N-xi+1) 2428 | } 2429 | index=length(c95):1 2430 | }else{ 2431 | c05 <- 1 2432 | c95 <- 1 2433 | } 2434 | if(is.null(ylim)){ 2435 | YlimMax <- max_no_na(c(floor(max_no_na(c(max_no_na(-log10(c05)), max_no_na(-log10(c95))))+1), floor(max_no_na(log.P.values)+1))) 2436 | plot(NULL, xlim=c(0,floor(max_no_na(log.Quantiles)+1)), axes=FALSE, cex.axis=axis.cex, cex.lab=lab.cex,ylim=c(0,YlimMax),xlab="",ylab="") 2437 | }else{ 2438 | plot(NULL, xlim=c(0,floor(max_no_na(log.Quantiles)+1)), axes=FALSE, cex.axis=axis.cex, cex.lab=lab.cex,ylim=c(0,max(ylim[[i]])),xlab="",ylab="") 2439 | } 2440 | axis(1, mgp=c(3,xticks.pos,0),at=seq(0,floor(max_no_na(log.Quantiles)+1),ceiling((max_no_na(log.Quantiles)+1)/10)), lwd=axis.lwd,labels=seq(0,floor(max_no_na(log.Quantiles)+1),ceiling((max_no_na(log.Quantiles)+1)/10)), cex.axis=axis.cex) 2441 | axis(2, las=1,lwd=axis.lwd,cex.axis=axis.cex) 2442 | axis(2, at=c(0, ifelse(is.null(ylim), YlimMax, max(ylim[[i]]))), labels=c("",""), tcl=0, lwd=axis.lwd) 2443 | 2444 | mtext(side=1, text=expression(Expected~~-log[10](italic(p))), line=ylab.pos+1, cex=lab.cex, font=lab.font, xpd=TRUE) 2445 | mtext(side=2, text=expression(Observed~~-log[10](italic(p))), line=ylab.pos, cex=lab.cex, font=lab.font, xpd=TRUE) 2446 | 2447 | #plot the confidence interval of QQ-plot 2448 | if(conf.int){ 2449 | if(is.null(conf.int.col)){ 2450 | polygon(c(log.Quantiles[index],log.Quantiles),c(-log10(c05)[index],-log10(c95)),col=rgb(t(col2rgb(t(col)[i])), alpha=points.alpha, maxColorValue=255),border=rgb(t(col2rgb(t(col)[i])), alpha=points.alpha, maxColorValue=255)) 2451 | }else{ 2452 | polygon(c(log.Quantiles[index],log.Quantiles),c(-log10(c05)[index],-log10(c95)),col=rgb(t(col2rgb(conf.int.col[i])), alpha=points.alpha, maxColorValue=255),border=rgb(t(col2rgb(conf.int.col[i])), alpha=points.alpha, maxColorValue=255)) 2453 | } 2454 | } 2455 | 2456 | if(!is.null(threshold.col)){par(xpd=FALSE); abline(a=0, b=1,lwd=threshold.lty[1], lty=threshold.lty[1], col=threshold.col[1]); par(xpd=TRUE)} 2457 | # points(log.Quantiles, log.P.values, col=t(col)[i],pch=19,cex=cex[3]) 2458 | is_visable <- filter.points(log.Quantiles, log.P.values, wh, ht, dpi=dpi) 2459 | if(!is.null(threshold[[i]])){ 2460 | # if(sum(threshold!=0)==length(threshold)){ 2461 | thre.line=-log10(min_no_na(threshold[[i]])) 2462 | if(amplify==TRUE){ 2463 | thre.index <- log.P.values 3 | 4 | ## A high-quality drawing tool designed for Manhattan plot of genomic analysis 5 | 6 | ### :toolbox: Relevant software tools for genetic analyses and genomic breeding 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 |
📫 HIBLUP: Versatile and easy-to-use GS toolbox.🍀 SIMER: data simulation for life science and breeding.
🚴‍♂️ KAML: Advanced GS method for complex traits.🏔️ IAnimal: an omics knowledgebase for animals.
🏊 hibayes: A Bayesian-based GWAS and GS tool.📮 rMVP: Efficient and easy-to-use GWAS tool.
21 | 22 | ### Installation 23 | 24 | **CMplot** is available on CRAN, so it can be installed with the following R code: 25 | 26 | ```r 27 | > install.packages("CMplot") 28 | > library("CMplot") 29 | 30 | # if you want to use the latest version on GitHub: 31 | > source("https://raw.githubusercontent.com/YinLiLin/CMplot/master/R/CMplot.r") 32 | ``` 33 | 34 | --- 35 | 36 | There are two example datasets attached in **CMplot**, users can export and view the details by following R code: 37 | 38 | ```r 39 | > data(pig60K) #calculated p-values by MLM 40 | > data(cattle50K) #calculated SNP effects by rrblup 41 | > head(pig60K) 42 | 43 | SNP Chromosome Position trait1 trait2 trait3 44 | 1 ALGA0000009 1 52297 0.7738187 0.51194318 0.51194318 45 | 2 ALGA0000014 1 79763 0.7738187 0.51194318 0.51194318 46 | 3 ALGA0000021 1 209568 0.7583016 0.98405289 0.98405289 47 | 4 ALGA0000022 1 292758 0.7200305 0.48887140 0.48887140 48 | 5 ALGA0000046 1 747831 0.9736840 0.22096836 0.22096836 49 | 6 ALGA0000047 1 761957 0.9174565 0.05753712 0.05753712 50 | 51 | > head(cattle50K) 52 | 53 | SNP chr pos Somatic cell score Milk yield Fat percentage 54 | 1 SNP1 1 59082 0.000244361 0.000484255 0.001379210 55 | 2 SNP2 1 118164 0.000532272 0.000039800 0.000598951 56 | 3 SNP3 1 177246 0.001633058 0.000311645 0.000279427 57 | 4 SNP4 1 236328 0.001412865 0.000909370 0.001040161 58 | 5 SNP5 1 295410 0.000090700 0.002202973 0.000351394 59 | 6 SNP6 1 354493 0.000110681 0.000342628 0.000105792 60 | 61 | ``` 62 | As the example datasets, the first three columns are names, chromosome, position of SNPs respectively, the rest of columns are the pvalues of GWAS or effects of GS/GP for traits, the number of traits is unlimited. 63 | Note: if plotting SNP_Density, only the first three columns are needed. 64 | 65 | Now **CMplot** could handle not only Genome-wide association study results, but also SNP effects, Fst, tajima's D and so on. 66 | 67 | --- 68 | 69 | Total 50~ parameters are available in **CMplot**, typing ```?CMplot``` can get the detail function of all parameters. 70 | 71 | --- 72 | ### Citation 73 | CMplot has been integrated into our developed GWAS package ```rMVP```, please cite the following paper:
74 | Yin, L. et al. [rMVP: A Memory-efficient, Visualization-enhanced, and Parallel-accelerated tool for Genome-Wide Association Study](https://doi.org/10.1016/j.gpb.2020.10.007), ***Genomics, Proteomics & Bioinformatics*** (2021), doi: 10.1016/j.gpb.2020.10.007.
75 | 76 | --- 77 | ### SNP-density plot 78 | 79 | ```r 80 | > CMplot(pig60K,plot.type="d",bin.size=1e6,chr.den.col=c("darkgreen", "yellow", "red"),file="jpg",file.name=NULL,dpi=300, 81 | main="illumilla_60K",file.output=TRUE,verbose=TRUE,width=9,height=6) 82 | # set the window size: bin.size=1e6 83 | # set the legend breaks by: bin.breaks=seq(min, max, step), e.g., bin.breaks=seq(0, 50, 10), the windows out of the breaks will be plotted in the same color as min or max. 84 | # get the detailed information of all windows: "windinfo <- CMplot(pig60K, plot.type="d", ...)" 85 | # file: the format of the output file, if file="png", CMplot will output a transparent background file 86 | # file.name: specify the output file name, the default is corresponding column name when setting file.name=NULL 87 | # chr.labels: change the chromosome names 88 | # main: change the title of the plots 89 | # NOTE: to show the full length of each chromosome, users can manually add every chromosome with one SNP, whose 90 | # position equals to the length of corresponding chromosome, then specify the parameter: CMplot(..., chr.pos.max=TRUE). 91 | ``` 92 | 93 |

94 | 95 | 96 | 97 |

98 | 99 | --- 100 | 101 | ### Circular-Manhattan plot 102 | 103 | #### (1) Genome-wide association study(GWAS) 104 | 105 | ```r 106 | > CMplot(pig60K,type="p",plot.type="c",chr.labels=paste("Chr",c(1:18,"X","Y"),sep=""),r=0.4,cir.axis=TRUE, 107 | outward=FALSE,cir.axis.col="black",cir.chr.h=1.3,chr.den.col="black",file="jpg", 108 | file.name=NULL,dpi=300,file.output=TRUE,verbose=TRUE,width=10,height=10) 109 | # to remove the grid line in circles, add parameter cir.axis.grid=FALSE 110 | # file.name: specify the output file name, the default is corresponding column name 111 | ``` 112 |

113 | 114 | 115 | 116 |

117 | 118 | ```r 119 | > CMplot(pig60K,type="p",plot.type="c",r=0.4,col=c("grey30","grey60"),chr.labels=paste("Chr",c(1:18,"X","Y"),sep=""), 120 | threshold=c(1e-6,1e-4),cir.chr.h=1.5,amplify=TRUE,threshold.lty=c(1,2),threshold.col=c("red", 121 | "blue"),signal.line=1,signal.col=c("red","green"),chr.den.col=c("darkgreen","yellow","red"), 122 | bin.size=1e6,outward=FALSE,file="jpg",file.name=NULL,dpi=300,file.output=TRUE,verbose=TRUE,width=10,height=10) 123 | 124 | #Note: 125 | 1. if signal.line=NULL, the lines that crosse circles won't be added. 126 | 2. if the length of parameter 'chr.den.col' is not equal to 1, SNP density that counts 127 | the number of SNP within given size('bin.size') will be plotted around the circle. 128 | ``` 129 | 130 |

131 | 132 | 133 | 134 |

135 | 136 | 137 | #### (2) Genomic Selection/Prediction(GS/GP) 138 | 139 | ```r 140 | > CMplot(cattle50K,type="p",plot.type="c",LOG10=FALSE,outward=TRUE,col=matrix(c("#4DAF4A",NA,NA,"dodgerblue4", 141 | "deepskyblue",NA,"dodgerblue1", "olivedrab3", "darkgoldenrod1"), nrow=3, byrow=TRUE), 142 | chr.labels=paste("Chr",c(1:29),sep=""),threshold=NULL,r=1.2,cir.chr.h=1.5,axis.cex=1, 143 | cir.band=1,file="jpg", file.name=NULL,dpi=300,chr.den.col="black",file.output=TRUE,verbose=TRUE, 144 | width=10,height=10) 145 | 146 | # parameter 'col' can be either vector or matrix, if a matrix, each trait can be plotted in different colors. 147 | # file.name: specify the output file name, the default is corresponding column name when setting ' file.name=NULL ' 148 | ``` 149 | 150 |

151 | 152 | 153 | 154 |

155 | 156 | --- 157 | 158 | ### Rectangular-Manhattan plot 159 | 160 | #### Genome-wide association study(GWAS) 161 | 162 | ```r 163 | > CMplot(pig60K,type="p",plot.type="m",LOG10=TRUE,threshold=NULL,file="jpg",file.name=NULL,dpi=300, 164 | file.output=TRUE,verbose=TRUE,width=14,height=6,chr.labels.angle=45) 165 | # 'chr.labels.angle': adjust the angle of labels of x-axis (-90 < chr.labels.angle < 90). 166 | # file.name: specify the output file name, the default is corresponding column name when setting ' file.name=NULL '. 167 | ``` 168 | 169 |

170 | 171 | 172 | 173 |

174 | 175 | #### Amplify signals on pch, cex and col 176 | 177 | ```r 178 | > CMplot(pig60K, plot.type="m", col=c("grey30","grey60"), LOG10=TRUE, ylim=c(2,12), threshold=c(1e-6,1e-4), 179 | threshold.lty=c(1,2), threshold.lwd=c(1,1), threshold.col=c("black","grey"), amplify=TRUE, 180 | chr.den.col=NULL, signal.col=c("red","green"), signal.cex=c(1.5,1.5),signal.pch=c(19,19), 181 | file="jpg",file.name=NULL,dpi=300,file.output=TRUE,verbose=TRUE,width=14,height=6) 182 | 183 | #Note: if the ylim is setted, then CMplot will only plot the points among this interval, 184 | # ylim can be vector or list, if it is a list, different traits can be assigned with 185 | # different range at y-axis. 186 | # 'threshold' can be set for different traits, for example: threshold=list(c(1e-6,1e-4), NULL, 1e-5), 187 | # each list contains a vector of thresholds for each trait, NULL means no threshold for corresponding trait. 188 | ``` 189 | 190 |

191 | 192 | 193 | 194 |

195 | 196 | #### Attach chromosome density on the bottom of Manhattan plot 197 | 198 | ```r 199 | > CMplot(pig60K, plot.type="m", LOG10=TRUE, ylim=NULL, threshold=c(1e-6,1e-4),threshold.lty=c(1,2), 200 | threshold.lwd=c(1,1), threshold.col=c("black","grey"), amplify=TRUE,bin.size=1e6, 201 | chr.den.col=c("darkgreen", "yellow", "red"),signal.col=c("red","green"),signal.cex=c(1.5,1.5), 202 | signal.pch=c(19,19),file="jpg",file.name=NULL,dpi=300,file.output=TRUE,verbose=TRUE, 203 | width=14,height=6) 204 | 205 | # Note: if the length of parameter 'chr.den.col' is bigger than 1, SNP density that counts 206 | # the number of SNP within given size('bin.size') will be plotted. 207 | # file.name: specify the output file name, the default is corresponding column name when setting file.name=NULL 208 | ``` 209 | 210 |

211 |

212 | 213 | 214 | 215 | 216 | #### Highlight a group of SNPs on pch, cex, type, and col 217 | 218 | ```r 219 | > signal <- pig60K$Position[which.min(pig60K$trait2)] 220 | > SNPs <- pig60K$SNP[pig60K$Chromosome==13 & 221 | pig60K$Position<(signal+1000000)&pig60K$Position>(signal-1000000)] 222 | > CMplot(pig60K, plot.type="m",LOG10=TRUE,col=c("grey30","grey60"),highlight=SNPs, 223 | highlight.col="green",highlight.cex=1,highlight.pch=19,file="jpg",file.name=NULL, 224 | chr.border=TRUE,dpi=300,file.output=TRUE,verbose=TRUE,width=14,height=6) 225 | # Note: 226 | # 'highlight' could be vector or list, if it is a vector, all traits will use the same highlighted SNPs index, 227 | # if it is a list, the length of the list should equal to the number of traits. 228 | # highlight.col, highlight.cex, highlight.pch can be value or vector, if its length equals to the length of highlighted SNPs, 229 | # each SNPs have its special colour, size and shape. 230 | ``` 231 | 232 |

233 |

234 | 235 | 236 | 237 | 238 | ```r 239 | > SNPs <- pig60K[pig60K$trait2 < 1e-4, 1] 240 | > CMplot(pig60K,type="h",plot.type="m",LOG10=TRUE,highlight=SNPs,highlight.type="p", 241 | highlight.col=NULL,highlight.cex=1.2,highlight.pch=19,file="jpg",file.name=NULL, 242 | dpi=300,file.output=TRUE,verbose=TRUE,width=14,height=6,band=0.6) 243 | ``` 244 | 245 |

246 |

247 | 248 | 249 | 250 | 251 | ```r 252 | > SNPs <- pig60K[pig60K$trait2 < 1e-4, 1] 253 | > CMplot(pig60K,type="p",plot.type="m",LOG10=TRUE,highlight=SNPs,highlight.type="h", 254 | col=c("grey30","grey60"),highlight.col="darkgreen",highlight.cex=1.2,highlight.pch=19, 255 | file="jpg",dpi=300,file.output=TRUE,verbose=TRUE,width=14,height=6) 256 | ``` 257 | 258 |

259 |

260 | 261 | 262 | 263 | 264 | ```r 265 | > SNPs <- pig60K[ 266 | pig60K$trait1 < 1e-4 | 267 | pig60K$trait2 < 1e-4 | 268 | pig60K$trait3 < 1e-4, 1] 269 | > CMplot(pig60K,type="p",plot.type="m",LOG10=TRUE,highlight=SNPs,highlight.type="l", 270 | threshold=1e-4,threshold.col="black",threshold.lty=1,col=c("grey60","#4197d8"), 271 | signal.cex=1.2, signal.col="red", highlight.col="grey",highlight.cex=0.7, 272 | file="jpg",dpi=300,file.output=TRUE,verbose=TRUE,multracks=TRUE) 273 | 274 | ``` 275 | 276 |

277 |

278 | 279 | 280 | 281 | 282 | #### Visualize only one chromosome 283 | 284 | ```r 285 | > CMplot(pig60K[pig60K$Chromosome==13, ], plot.type="m",LOG10=TRUE,col=c("grey60"),highlight=SNPs, 286 | highlight.col="green",highlight.cex=1,highlight.pch=19,file="jpg",file.name=NULL, 287 | threshold=c(1e-6,1e-4),threshold.lty=c(1,2),threshold.lwd=c(1,2), width=9,height=6, 288 | threshold.col=c("red","blue"),amplify=FALSE,dpi=300,file.output=TRUE,verbose=TRUE) 289 | ``` 290 | 291 |

292 |

293 | 294 | 295 | 296 | 297 | #### add genes or SNP names around the highlighted SNPs 298 | 299 | ```r 300 | > SNPs <- pig60K[pig60K[,5] < (0.05 / nrow(pig60K)), 1] 301 | > genes <- paste("GENE", 1:length(SNPs), sep="_") 302 | > set.seed(666666) 303 | > CMplot(pig60K[,c(1:3,5)], plot.type="m",LOG10=TRUE,col=c("grey30","grey60"),highlight=SNPs, 304 | highlight.col=rep(c("green","blue"),length=length(SNPs)),highlight.cex=1, highlight.text=genes, 305 | highlight.text.col=rep("red",length(SNPs)),threshold=0.05/nrow(pig60K),threshold.lty=2, 306 | amplify=FALSE,file="jpg",file.name=NULL,dpi=300,file.output=TRUE,verbose=TRUE,width=14,height=6) 307 | # Note: 308 | # 'highlight', 'highlight.text' could be vector or list, if it is a vector, all traits will 309 | # use the same highlighted SNPs index and text, if it is a list, the length of the list should equal to the number of traits. 310 | # the order of 'highlight.text' must be consistent with 'highlight' 311 | # highlight.text.cex: value or vecter, control the size of added text 312 | # highlight.text.font: value or vecter, control the font of added text 313 | ``` 314 | 315 |

316 |

317 | 318 | 319 | 320 | 321 | #### Genomic Selection/Prediction(GS/GP) or other none p-values 322 | 323 | ```r 324 | > CMplot(cattle50K, plot.type="m", band=0.5, LOG10=FALSE, ylab="SNP effect",threshold=0.015, 325 | threshold.lty=2, threshold.lwd=1, threshold.col="red", amplify=TRUE, width=14,height=6, 326 | signal.col=NULL, chr.den.col=NULL, file="jpg",file.name=NULL,dpi=300,file.output=TRUE, 327 | verbose=TRUE,cex=0.8) 328 | #Note: if signal.col=NULL, the significant SNPs will be plotted with original colors. 329 | ``` 330 | 331 |

332 | 333 | 334 | 335 |

336 | 337 | ```r 338 | > cattle50K[,4:ncol(cattle50K)] <- apply(cattle50K[,4:ncol(cattle50K)], 2, 339 | function(x) x*sample(c(1,-1), length(x), rep=TRUE)) 340 | > CMplot(cattle50K, type="h",plot.type="m", band=0.5, LOG10=FALSE, ylab="SNP effect",ylim=c(-0.02,0.02), 341 | threshold.lty=2, threshold.lwd=1, threshold.col="red", amplify=FALSE,cex=0.6, 342 | chr.den.col=NULL, file="jpg",file.name=NULL,dpi=300,file.output=TRUE,verbose=TRUE) 343 | #Note: Positive and negative values are acceptable. 344 | ``` 345 | 346 |

347 | 348 | 349 | 350 |

351 | 352 | ### Multiple tracks Rectangular-Manhattan plot 353 | 354 | ```r 355 | > SNPs <- list( 356 | pig60K$SNP[pig60K$trait1<1e-6], 357 | pig60K$SNP[pig60K$trait2<1e-6], 358 | pig60K$SNP[pig60K$trait3<1e-6] 359 | ) 360 | > CMplot(pig60K, plot.type="m",multracks=TRUE,threshold=c(1e-6,1e-4),threshold.lty=c(1,2), 361 | threshold.lwd=c(1,1), threshold.col=c("black","grey"), amplify=TRUE, signal.col= 362 | c("red","green"), signal.cex=1, file="jpg",file.name=NULL,dpi=300,file.output=TRUE, 363 | verbose=TRUE, highlight=SNPs, highlight.text=SNPs, highlight.text.cex=1.4) 364 | #Note: if you are not supposed to change the color of signal, 365 | # please set signal.col=NULL and highlight.col=NULL. 366 | ``` 367 | 368 |

369 | 370 | 371 | 372 |

373 | 374 | ### Multiple traits Rectangular-Manhattan plot 375 | ```r 376 | > CMplot(pig60K, plot.type="m",multraits=TRUE,threshold=c(1e-6,1e-4),threshold.lty=c(1,2), 377 | threshold.lwd=c(1,1), threshold.col=c("black","grey"), amplify=TRUE,bin.size=1e6, 378 | chr.den.col=c("darkgreen", "yellow", "red"), signal.col=c("red","green"), 379 | signal.cex=1, file="jpg",file.name=NULL,dpi=300,file.output=TRUE,verbose=TRUE, 380 | points.alpha=100,legend.ncol=1, legend.pos="left") 381 | ``` 382 | 383 |

384 | 385 | 386 | 387 |

388 | 389 | ```r 390 | >CMplot(pig60K, plot.type="m",col="grey",multraits=TRUE,threshold=1e-4,threshold.lty=1, 391 | threshold.lwd=c(1,1), threshold.col=c("black","grey"),amplify=TRUE, 392 | chr.den.col=NULL, signal.col=c("red","green","blue"),signal.cex=1, 393 | file="jpg",file.name=NULL,dpi=300,file.output=TRUE,verbose=TRUE, 394 | points.alpha=225,legend.ncol=3, legend.pos="middle") 395 | # note: length of 'col' should be equal to 1 for this case. 396 | ``` 397 | 398 |

399 | 400 | 401 | 402 | --- 403 | 404 | ### Q-Q plot 405 | 406 | ```r 407 | > CMplot(pig60K,plot.type="q",box=FALSE,file="jpg",file.name=NULL,dpi=300, 408 | conf.int=TRUE,conf.int.col=NULL,threshold.col="red",threshold.lty=2, 409 | file.output=TRUE,verbose=TRUE,width=5,height=5) 410 | ``` 411 | 412 |

413 | 414 | 415 | 416 |

417 | 418 | ### Multiple tracks Q-Q plot 419 | 420 | ```r 421 | > pig60K$trait1[sample(1:nrow(pig60K), round(nrow(pig60K)*0.80))] <- NA 422 | > pig60K$trait2[sample(1:nrow(pig60K), round(nrow(pig60K)*0.25))] <- NA 423 | > CMplot(pig60K,plot.type="q",col=c("dodgerblue1", "olivedrab3", "darkgoldenrod1"),multracks=TRUE, 424 | threshold=1e-6,ylab.pos=2,signal.pch=c(19,6,4),signal.cex=1.2,signal.col="red", 425 | conf.int=TRUE,box=FALSE,axis.cex=2,file="jpg",file.name=NULL,dpi=300,file.output=TRUE, 426 | verbose=TRUE,ylim=c(0,8),width=5,height=5) 427 | ``` 428 | 429 |

430 | 431 | 432 | 433 |

434 | 435 | ### Multiple traits Q-Q plot 436 | 437 | ```r 438 | > CMplot(pig60K,plot.type="q",col=c("dodgerblue1", "olivedrab3", "darkgoldenrod1"),multraits=TRUE, 439 | threshold=1e-6,ylab.pos=2,signal.pch=c(19,6,4),signal.cex=1.2,signal.col="red", 440 | conf.int=TRUE,box=FALSE,axis.cex=1,file="jpg",file.name=NULL,dpi=300,file.output=TRUE, 441 | verbose=TRUE,ylim=c(0,8),width=5,height=5) 442 | ``` 443 | 444 |

445 | 446 | 447 | 448 |

449 | 450 | --- 451 | 452 | ### Contact 453 | Questions, suggestions, and bug reports are welcome and appreciated. 454 | - **Author:** Lilin Yin 455 | - **Contact:** ylilin@163.com 456 | - **QQ group:** 166305848 457 | - **Institution:** [*Huazhong agricultural university*](http://www.hzau.edu.cn/en/HOME.htm) 458 | -------------------------------------------------------------------------------- /User Manual for CMplot.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YinLiLin/CMplot/a8084aa1bc63d0a366300e61f3be3b79263a6de4/User Manual for CMplot.pdf --------------------------------------------------------------------------------