Guest User

Untitled

a guest
Nov 23rd, 2017
96
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 6.10 KB | None | 0 0
  1. manhattanPlus <- function (x, chr = "CHR", bp = "BP", p = "P", snp = "SNP",
  2. col = c("gray10", "gray60"), chrlabs = NULL,
  3. suggestiveline = -log10(1e-05),
  4. genomewideline = -log10(5e-08), highlight = NULL,
  5. logp = TRUE, annotatePval = NULL, annotateTop = TRUE,
  6. otherColors = rev(viridis::viridis(3)[1:2]),
  7. otherDataColName = FALSE, otherCatName = FALSE,
  8. ...)
  9. {
  10. CHR = BP = P = index = NULL
  11. if (!(chr %in% names(x)))
  12. stop(paste("Column", chr, "not found!"))
  13. if (!(bp %in% names(x)))
  14. stop(paste("Column", bp, "not found!"))
  15. if (!(p %in% names(x)))
  16. stop(paste("Column", p, "not found!"))
  17. if (! identical(otherDataColName, FALSE) & !(otherDataColName %in% names(x)))
  18. stop(paste("Column", otherDataColName, "not found! If you don't want to use it, set it to FALSE, as default."))
  19. if (! identical(otherCatName, FALSE) & !(otherCatName %in% names(x)))
  20. stop(paste("Column", otherCatName, "not found! If you don't want to use it, set it to FALSE, as default."))
  21. if (!(snp %in% names(x)))
  22. warning(paste("No SNP column found. OK unless you're trying to highlight."))
  23. if (!is.numeric(x[[chr]]))
  24. stop(paste(chr, "column should be numeric. Do you have 'X', 'Y', 'MT', etc? If so change to numbers and try again."))
  25. if (!is.numeric(x[[bp]]))
  26. stop(paste(bp, "column should be numeric."))
  27. if (!is.numeric(x[[p]]))
  28. stop(paste(p, "column should be numeric."))
  29. d = data.frame(CHR = x[[chr]], BP = x[[bp]], P = x[[p]])
  30. if (! identical(otherDataColName, FALSE) & (otherDataColName %in% names(x)))
  31. d$score = x[[otherDataColName]]
  32. if (! identical(otherCatName, FALSE) & (otherCatName %in% names(x)))
  33. d$cat = x[[otherCatName]]
  34. if (!is.null(x[[snp]]))
  35. d = transform(d, SNP = x[[snp]])
  36. d <- subset(d, (is.numeric(CHR) & is.numeric(BP) & is.numeric(P)))
  37. d <- d[order(d$CHR, d$BP), ]
  38. if (logp) {
  39. d$logp <- -log10(d$P)
  40. } else {
  41. d$logp <- d$P
  42. }
  43. d$pos = NA
  44. d$index = NA
  45. ind = 0
  46. for (i in unique(d$CHR)) {
  47. ind = ind + 1
  48. d[d$CHR == i, ]$index = ind
  49. }
  50. nchr = length(unique(d$CHR))
  51. if (nchr == 1) {
  52. d$pos = d$BP
  53. ticks = floor(length(d$pos))/2 + 1
  54. xlabel = paste("Chromosome", unique(d$CHR), "position")
  55. labs = ticks
  56. } else {
  57. lastbase = 0
  58. ticks = NULL
  59. for (i in unique(d$index)) {
  60. if (i == 1) {
  61. d[d$index == i, ]$pos = d[d$index == i, ]$BP
  62. }
  63. else {
  64. lastbase = lastbase + tail(subset(d, index ==
  65. i - 1)$BP, 1)
  66. d[d$index == i, ]$pos = d[d$index == i, ]$BP +
  67. lastbase
  68. }
  69. ticks = c(ticks, (min(d[d$index == i, ]$pos) + max(d[d$index ==
  70. i, ]$pos))/2 + 1)
  71. }
  72. xlabel = "Chromosome"
  73. labs <- unique(d$CHR)
  74. }
  75. xmax = ceiling(max(d$pos) * 1.03)
  76. xmin = floor(max(d$pos) * -0.03)
  77. dotargs <- list(...)
  78. if (! identical(otherDataColName, FALSE)){
  79. e <- d[! is.na(d$score),]
  80. def_args <- list(xaxt = "n", yaxt = "n", bty = "n", xaxs = "i", yaxs = "i",
  81. las = 1, xlim = c(xmin, xmax),
  82. ylim = c(0, ceiling(max(e$score))), xlab = "",
  83. ylab = "")
  84. do.call("plot", c(NA, dotargs, def_args[!names(def_args) %in%
  85. names(dotargs)]))
  86. rect(xleft = e$pos-1, ybottom = 0, xright = e$pos+1,ytop = e$score,
  87. col = otherColors[e$cat], border = otherColors[e$cat], ...)
  88. axis(4, col = otherColors[1], col.axis = otherColors[1], las = 2)
  89. mtext("Importance score", side = 4, line = 2, cex = 0.7)
  90. legend("topright", legend = unique(e$cat), fill = rev(otherColors),
  91. bg = "transparent")
  92. }
  93. def_args <- list(xaxt = "n", bty = "n", xaxs = "i", yaxs = "i",
  94. las = 1, pch = 20, xlim = c(xmin, xmax),
  95. ylim = c(0, ceiling(max(d$logp))), xlab = xlabel,
  96. ylab = expression(-log[10](italic(p))))
  97. par(new=TRUE)
  98. do.call("plot", c(NA, dotargs, def_args[!names(def_args) %in%
  99. names(dotargs)]))
  100. if (!is.null(chrlabs)) {
  101. if (is.character(chrlabs)) {
  102. if (length(chrlabs) == length(labs)) {
  103. labs <- chrlabs
  104. }
  105. else {
  106. warning("You're trying to specify chromosome labels but the number of labels != number of chromosomes.")
  107. }
  108. }
  109. else {
  110. warning("If you're trying to specify chromosome labels, chrlabs must be a character vector")
  111. }
  112. }
  113. if (nchr == 1) {
  114. axis(1, ...)
  115. } else {
  116. axis(1, at = ticks, labels = labs, ...)
  117. }
  118. col = rep(col, max(d$CHR))
  119. if (nchr == 1) {
  120. with(d, points(pos, logp, pch = 20, col = col[1], ...))
  121. } else {
  122. icol = 1
  123. for (i in unique(d$index)) {
  124. with(d[d$index == unique(d$index)[i], ], points(pos,
  125. logp, col = col[icol], pch = 20, ...))
  126. icol = icol + 1
  127. }
  128. }
  129. if (suggestiveline)
  130. abline(h = suggestiveline, col = "blue")
  131. if (genomewideline)
  132. abline(h = genomewideline, col = "red")
  133. if (!is.null(highlight)) {
  134. if (any(!(highlight %in% d$SNP)))
  135. warning("You're trying to highlight SNPs that don't exist in your results.")
  136. d.highlight = d[which(d$SNP %in% highlight), ]
  137. with(d.highlight, points(pos, logp, col = "green3", pch = 20,
  138. ...))
  139. }
  140. if (!is.null(annotatePval)) {
  141. topHits = subset(d, P <= annotatePval)
  142. par(xpd = TRUE)
  143. if (annotateTop == FALSE) {
  144. with(subset(d, P <= annotatePval), textxy(pos, -log10(P),
  145. offset = 0.625, labs = topHits$SNP, cex = 0.45),
  146. ...)
  147. } else {
  148. topHits <- topHits[order(topHits$P), ]
  149. topSNPs <- NULL
  150. for (i in unique(topHits$CHR)) {
  151. chrSNPs <- topHits[topHits$CHR == i, ]
  152. topSNPs <- rbind(topSNPs, chrSNPs[1, ])
  153. }
  154. textxy(topSNPs$pos, -log10(topSNPs$P), offset = 0.625,
  155. labs = topSNPs$SNP, cex = 0.5, ...)
  156. }
  157. }
  158. par(xpd = FALSE)
  159. }
Add Comment
Please, Sign In to add comment