├── vignettes ├── .gitignore ├── plotly.png ├── recomb.png └── eqtl_overlay.png ├── .gitattributes ├── data └── SLE_gwas_sub.rdata ├── CRAN-SUBMISSION ├── .Rbuildignore ├── cran-comments.md ├── R ├── SLE_gwas_sub.R ├── set_layers.R ├── gg_addgenes.R ├── link_eqtl.R ├── line_plot.R ├── multi_layout.R ├── quick_peak.R ├── locus_plotly.R ├── link_LD.R ├── link_recomb.R ├── overlay_plot.R ├── locus_ggplot.R ├── gg_genetracks.R ├── eqtl_plot.R ├── locus_plot.R ├── genetracks_grob.R ├── genetrack_ly.R ├── genetracks.R ├── scatter_plot.R ├── scatter_plotly.R ├── locus.R └── gg_scatter.R ├── inst └── CITATION ├── man ├── SLE_gwas_sub.Rd ├── set_layers.Rd ├── gg_addgenes.Rd ├── line_plot.Rd ├── overlay_plot.Rd ├── link_eqtl.Rd ├── quick_peak.Rd ├── eqtl_plot.Rd ├── link_recomb.Rd ├── multi_layout.Rd ├── link_LD.Rd ├── genetracks_grob.Rd ├── scatter_plotly.Rd ├── genetrack_ly.Rd ├── locus_plotly.Rd ├── locus_ggplot.Rd ├── gg_genetracks.Rd ├── genetracks.Rd ├── gg_scatter.Rd ├── scatter_plot.Rd ├── locus_plot.Rd └── locus.Rd ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── README.md └── NEWS.md /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /vignettes/plotly.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/myles-lewis/locuszoomr/HEAD/vignettes/plotly.png -------------------------------------------------------------------------------- /vignettes/recomb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/myles-lewis/locuszoomr/HEAD/vignettes/recomb.png -------------------------------------------------------------------------------- /data/SLE_gwas_sub.rdata: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/myles-lewis/locuszoomr/HEAD/data/SLE_gwas_sub.rdata -------------------------------------------------------------------------------- /vignettes/eqtl_overlay.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/myles-lewis/locuszoomr/HEAD/vignettes/eqtl_overlay.png -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 0.3.8 2 | Date: 2025-03-03 14:04:26 UTC 3 | SHA: 0cf0a1bb667367f938d1aaead7f5c45884c88f96 4 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^locuszoomr\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^cran-comments\.md$ 5 | ^CRAN-RELEASE$ 6 | 7 | ^CRAN-SUBMISSION$ 8 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | 0 errors | 0 warnings | 0 note 4 | 5 | This release includes: 6 | * Fixed CRAN checks NOTE by removing %||% for back compatibility. 7 | * Fixed handling of tibbles. 8 | * Improved the vignette. -------------------------------------------------------------------------------- /R/SLE_gwas_sub.R: -------------------------------------------------------------------------------- 1 | #' SLE GWAS data subset 2 | #' 3 | #' Dataset of SNPs at 3 gene loci (UBE2L3, STAT4, IRF5) from GWAS on SLE 4 | #' (Bentham et al, 2015, Nature Genetics 47(12):1457-64, PMID: 26502338). 5 | #' 6 | #' @format Data frame with 1990 rows and 11 variables 7 | #' @source \url{https://www.ebi.ac.uk/gwas/studies/GCST003156} 8 | #' @usage data(SLE_gwas_sub) 9 | "SLE_gwas_sub" 10 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry( 2 | bibtype = "Article", 3 | title = "locuszoomr: an R package for visualising publication-ready regional gene locus plots", 4 | author = c(person(c("Myles", "J."), "Lewis"), 5 | person("Susan", "Wang")), 6 | journal = "Bioinformatics Advances", 7 | year = "2025", 8 | volume = "", 9 | number = "", 10 | pages = "vbaf006", 11 | doi = "10.1093/bioadv/vbaf006" 12 | ) 13 | -------------------------------------------------------------------------------- /man/SLE_gwas_sub.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SLE_gwas_sub.R 3 | \docType{data} 4 | \name{SLE_gwas_sub} 5 | \alias{SLE_gwas_sub} 6 | \title{SLE GWAS data subset} 7 | \format{ 8 | Data frame with 1990 rows and 11 variables 9 | } 10 | \source{ 11 | \url{https://www.ebi.ac.uk/gwas/studies/GCST003156} 12 | } 13 | \usage{ 14 | data(SLE_gwas_sub) 15 | } 16 | \description{ 17 | Dataset of SNPs at 3 gene loci (UBE2L3, STAT4, IRF5) from GWAS on SLE 18 | (Bentham et al, 2015, Nature Genetics 47(12):1457-64, PMID: 26502338). 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .DS_Store? 3 | 4 | # History files 5 | .Rhistory 6 | .Rapp.history 7 | 8 | # Session Data files 9 | .RData 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.pdf 25 | 26 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 27 | .httr-oauth 28 | 29 | # knitr and R markdown default cache directories 30 | /*_cache/ 31 | /cache/ 32 | 33 | # Temporary files created by R markdown 34 | *.utf8.md 35 | *.knit.md 36 | 37 | # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html 38 | rsconnect/ 39 | inst/doc 40 | .Rproj.user 41 | -------------------------------------------------------------------------------- /man/set_layers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/set_layers.R 3 | \name{set_layers} 4 | \alias{set_layers} 5 | \title{Set up a column of multiple plots} 6 | \usage{ 7 | set_layers(n = 1, heights = c(rep(3, n), 2), rev = FALSE) 8 | } 9 | \arguments{ 10 | \item{n}{Number of plots (not including gene tracks on bottom)} 11 | 12 | \item{heights}{Vector of length \code{nrow + 1} specifying height for plots with 13 | a gene track on the bottom} 14 | 15 | \item{rev}{Logical whether to reverse plotting order and plot from bottom to 16 | top} 17 | } 18 | \value{ 19 | Sets \code{\link[=layout]{layout()}} to enable multiple plots aligned in a column. The 20 | gene track is assumed to be positioned on the bottom. Returns \code{par()} 21 | invisibly so that layout can be reset to default at the end of plotting. 22 | } 23 | \description{ 24 | Uses \code{\link[=layout]{layout()}} to set up multiple locus plots aligned in a column. 25 | } 26 | \seealso{ 27 | \code{\link[=layout]{layout()}} 28 | } 29 | -------------------------------------------------------------------------------- /R/set_layers.R: -------------------------------------------------------------------------------- 1 | 2 | #' Set up a column of multiple plots 3 | #' 4 | #' Uses [layout()] to set up multiple locus plots aligned in a column. 5 | #' 6 | #' @param n Number of plots (not including gene tracks on bottom) 7 | #' @param heights Vector of length `nrow + 1` specifying height for plots with 8 | #' a gene track on the bottom 9 | #' @param rev Logical whether to reverse plotting order and plot from bottom to 10 | #' top 11 | #' @return Sets [layout()] to enable multiple plots aligned in a column. The 12 | #' gene track is assumed to be positioned on the bottom. Returns `par()` 13 | #' invisibly so that layout can be reset to default at the end of plotting. 14 | #' @seealso [layout()] 15 | #' @export 16 | 17 | set_layers <- function(n = 1, 18 | heights = c(rep(3, n), 2), 19 | rev = FALSE) { 20 | op <- par(no.readonly = TRUE) 21 | s <- if (rev) rev(seq_len(n +1)) else seq_len(n +1) 22 | mat <- matrix(s) 23 | graphics::layout(mat, heights = heights) 24 | invisible(op) 25 | } 26 | -------------------------------------------------------------------------------- /man/gg_addgenes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gg_addgenes.R 3 | \name{gg_addgenes} 4 | \alias{gg_addgenes} 5 | \title{Add gene tracks to a ggplot2 plot} 6 | \usage{ 7 | gg_addgenes(p, loc, heights = c(3, 2), ...) 8 | } 9 | \arguments{ 10 | \item{p}{ggplot2 plot object. This can be generated by \code{\link[=gg_scatter]{gg_scatter()}} and 11 | then modified.} 12 | 13 | \item{loc}{Object of class 'locus' to use for plot. See \code{\link[=locus]{locus()}}.} 14 | 15 | \item{heights}{Vector specifying ratio of heights of upper plot and lower 16 | gene track.} 17 | 18 | \item{...}{Additional arguments passed to \code{\link[=gg_genetracks]{gg_genetracks()}} to control 19 | colours of gene tracks etc.} 20 | } 21 | \value{ 22 | A ggplot2 plotting object. 23 | } 24 | \description{ 25 | Adds gene tracks to an existing ggplot2 plot. 26 | } 27 | \examples{ 28 | if(require(EnsDb.Hsapiens.v75)) { 29 | data(SLE_gwas_sub) 30 | loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 31 | ens_db = "EnsDb.Hsapiens.v75") 32 | p <- gg_scatter(loc) 33 | gg_addgenes(p, loc) 34 | } 35 | } 36 | \seealso{ 37 | \code{\link[=gg_scatter]{gg_scatter()}} \code{\link[=gg_genetracks]{gg_genetracks()}} 38 | } 39 | -------------------------------------------------------------------------------- /man/line_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/line_plot.R 3 | \name{line_plot} 4 | \alias{line_plot} 5 | \title{Locus line plot} 6 | \usage{ 7 | line_plot( 8 | loc, 9 | pcutoff = 5e-08, 10 | xlab = NULL, 11 | ylab = expression("-log"[10] ~ "P"), 12 | cex.axis = 1, 13 | xticks = FALSE, 14 | border = FALSE, 15 | align = TRUE, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{loc}{Object of class 'locus' to use for plot. See \link{locus}.} 21 | 22 | \item{pcutoff}{Cut-off for p value significance. Defaults to p = 5e-08. Set 23 | to \code{NULL} to disable.} 24 | 25 | \item{xlab}{x axis title.} 26 | 27 | \item{ylab}{y axis title.} 28 | 29 | \item{cex.axis}{Specifies font size for axis numbering.} 30 | 31 | \item{xticks}{Logical whether x axis numbers and axis title are plotted.} 32 | 33 | \item{border}{Logical whether a bounding box is plotted around upper and 34 | lower plots.} 35 | 36 | \item{align}{Logical whether set \code{\link[=par]{par()}} to align the plot.} 37 | 38 | \item{...}{Other arguments passed to \code{\link[=plot]{plot()}} for the scatter plot.} 39 | } 40 | \value{ 41 | No return value. Produces a scatter plot using base graphics. 42 | } 43 | \description{ 44 | Produces a line plot from a 'locus' class object. Intended for use with 45 | \code{\link[=set_layers]{set_layers()}}. 46 | } 47 | \seealso{ 48 | \code{\link[=locus]{locus()}} \code{\link[=set_layers]{set_layers()}} \code{\link[=scatter_plot]{scatter_plot()}} 49 | } 50 | -------------------------------------------------------------------------------- /R/gg_addgenes.R: -------------------------------------------------------------------------------- 1 | 2 | #' Add gene tracks to a ggplot2 plot 3 | #' 4 | #' Adds gene tracks to an existing ggplot2 plot. 5 | #' 6 | #' @param p ggplot2 plot object. This can be generated by [gg_scatter()] and 7 | #' then modified. 8 | #' @param loc Object of class 'locus' to use for plot. See [locus()]. 9 | #' @param heights Vector specifying ratio of heights of upper plot and lower 10 | #' gene track. 11 | #' @param ... Additional arguments passed to [gg_genetracks()] to control 12 | #' colours of gene tracks etc. 13 | #' @return A ggplot2 plotting object. 14 | #' @seealso [gg_scatter()] [gg_genetracks()] 15 | #' @examples 16 | #' if(require(EnsDb.Hsapiens.v75)) { 17 | #' data(SLE_gwas_sub) 18 | #' loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 19 | #' ens_db = "EnsDb.Hsapiens.v75") 20 | #' p <- gg_scatter(loc) 21 | #' gg_addgenes(p, loc) 22 | #' } 23 | #' @importFrom ggplot2 layer_scales 24 | #' @importFrom cowplot plot_grid 25 | #' @export 26 | 27 | gg_addgenes <- function(p, loc, 28 | heights = c(3, 2), 29 | ...) { 30 | # check x axis range 31 | xl <- layer_scales(p)$x$get_limits() * 1e6 32 | if (!identical(as.numeric(loc$xrange), xl)) { 33 | message("Plot x axis limits and locus range differ: check correct locus?") 34 | message("x axis limits: ", xl[1], " to ", xl[2]) 35 | message("locus range: ", loc$xrange[1], " to ", loc$xrange[2]) 36 | } 37 | g <- gg_genetracks(loc, ...) 38 | 39 | plot_grid(p, g, nrow = 2, rel_heights = heights, align = "v") 40 | } 41 | -------------------------------------------------------------------------------- /man/overlay_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/overlay_plot.R 3 | \name{overlay_plot} 4 | \alias{overlay_plot} 5 | \title{Plot overlaying eQTL and GWAS data} 6 | \usage{ 7 | overlay_plot( 8 | loc, 9 | base_col = "black", 10 | alpha = 0.5, 11 | scheme = "RdYlBu", 12 | tissue = "Whole Blood", 13 | eqtl_gene = loc$gene, 14 | legend_pos = "topright", 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{loc}{Object of class 'locus' to use for plot. See \code{\link[=locus]{locus()}}.} 20 | 21 | \item{base_col}{Colour of points for SNPs which do not have eQTLs.} 22 | 23 | \item{alpha}{Alpha opacity for non-eQTL points} 24 | 25 | \item{scheme}{Character string specifying palette for effect size showing 26 | up/downregulation eQTL using \link[grDevices:palettes]{grDevices::hcl.colors}. Alternatively a 27 | vector of 6 colours.} 28 | 29 | \item{tissue}{GTex tissue in which eQTL has been measured} 30 | 31 | \item{eqtl_gene}{Gene showing eQTL effect} 32 | 33 | \item{legend_pos}{Character value specifying legend position. See \code{\link[=legend]{legend()}}.} 34 | 35 | \item{...}{Other arguments passed to \code{\link[=locus_plot]{locus_plot()}} for the locus plot.} 36 | } 37 | \value{ 38 | No return value. Produces a plot using base graphics. 39 | } 40 | \description{ 41 | Experimental plotting function for overlaying eQTL data from GTEx on top of 42 | GWAS results. y axis shows the -log10 p-value for the GWAS result. 43 | Significant eQTL for the specified gene are overlaid using colours and 44 | symbols. 45 | } 46 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: locuszoomr 2 | Title: Gene Locus Plot with Gene Annotations 3 | Version: 0.3.8 4 | Authors@R: 5 | c(person(given = "Myles",family = "Lewis", 6 | role = c("aut", "cre"), 7 | email = "myles.lewis@qmul.ac.uk", 8 | comment = c(ORCID = "0000-0001-9365-5345"))) 9 | BugReports: https://github.com/myles-lewis/locuszoomr/issues 10 | URL: https://github.com/myles-lewis/locuszoomr 11 | Description: Publication-ready regional gene locus plots similar to those produced by the web interface 'LocusZoom' , but running locally in R. Genetic or genomic data with gene annotation tracks are plotted via R base graphics, 'ggplot2' or 'plotly', allowing flexibility and easy customisation including laying out multiple locus plots on the same page. It uses the 'LDlink' API to query linkage disequilibrium data from the 1000 Genomes Project and can overlay this on plots . 12 | Language: en-gb 13 | License: GPL (>= 3) 14 | Encoding: UTF-8 15 | Depends: R (>= 3.5) 16 | biocViews: 17 | Imports: 18 | AnnotationFilter, 19 | BiocGenerics, 20 | cowplot, 21 | dplyr, 22 | ensembldb, 23 | GenomeInfoDb, 24 | GenomicRanges, 25 | gggrid, 26 | ggplot2, 27 | ggrepel, 28 | graphics, 29 | grDevices, 30 | grid, 31 | IRanges, 32 | LDlinkR, 33 | memoise, 34 | plotly, 35 | rlang, 36 | rtracklayer, 37 | zoo 38 | Roxygen: list(markdown = TRUE) 39 | RoxygenNote: 7.3.2 40 | Suggests: 41 | AnnotationHub, 42 | EnsDb.Hsapiens.v75, 43 | knitr, 44 | rmarkdown 45 | VignetteBuilder: knitr 46 | -------------------------------------------------------------------------------- /man/link_eqtl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/link_eqtl.R 3 | \name{link_eqtl} 4 | \alias{link_eqtl} 5 | \title{Obtain GTEx eQTL data via LDlinkR} 6 | \usage{ 7 | link_eqtl(loc, pop = "CEU", r2d = "r2", token = "", ...) 8 | } 9 | \arguments{ 10 | \item{loc}{Object of class 'locus' generated by \code{\link[=locus]{locus()}}} 11 | 12 | \item{pop}{A 1000 Genomes Project population, (e.g. YRI or CEU), multiple 13 | allowed, default = "CEU". Passed to \code{LDlinkR::LDexpress()}.} 14 | 15 | \item{r2d}{Either "r2" for LD r^2 or "d" for LD D', default = "r2". Passed 16 | to \code{LDlinkR::LDexpress()}.} 17 | 18 | \item{token}{Personal access token for accessing 1000 Genomes LD data via 19 | LDlink API. See \code{LDlinkR} package documentation.} 20 | 21 | \item{...}{Optional arguments such as \code{genome_build} which are passed on to 22 | \code{LDlinkR::LDexpress()}} 23 | } 24 | \value{ 25 | Returns an object of class 'locus' with an extra list element 'LDexp' 26 | containing a dataframe of information obtained via \code{LDexpress()}. 27 | } 28 | \description{ 29 | Adds eQTL (expression quantitative trait loci) information from GTEx 30 | (https://gtexportal.org/) to a 'locus' class object. It queries LDlink 31 | (https://ldlink.nci.nih.gov/) via the \code{LDlinkR} package to retrieve GTEx eQTL 32 | information on a reference SNP. 33 | } 34 | \details{ 35 | The additional eQTL information obtained from LDlink web server can be 36 | displayed using \code{\link[=eqtl_plot]{eqtl_plot()}} which generates a scatter plot with gene tracks 37 | similar to a locus plot, or with \code{\link[=overlay_plot]{overlay_plot()}} which tries to overlay the 38 | EQTL analysis over the original locus results (e.g. GWAS). 39 | } 40 | \seealso{ 41 | \code{\link[=locus]{locus()}} \code{\link[=eqtl_plot]{eqtl_plot()}} \code{\link[=overlay_plot]{overlay_plot()}} 42 | } 43 | -------------------------------------------------------------------------------- /man/quick_peak.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/quick_peak.R 3 | \name{quick_peak} 4 | \alias{quick_peak} 5 | \title{Fast peak finder in GWAS data} 6 | \usage{ 7 | quick_peak( 8 | data, 9 | npeaks = NA, 10 | p_cutoff = 5e-08, 11 | span = 1e+06, 12 | min_points = 2, 13 | chrom = NULL, 14 | pos = NULL, 15 | p = NULL 16 | ) 17 | } 18 | \arguments{ 19 | \item{data}{GWAS dataset (data.frame or data.table)} 20 | 21 | \item{npeaks}{Number of peaks to find. If set to \code{NA}, algorithm finds all 22 | distinct peaks separated from one another by region size specified by 23 | \code{span}.} 24 | 25 | \item{p_cutoff}{Specifies cut-off for p-value significance above which 26 | p-values are ignored.} 27 | 28 | \item{span}{Minimum genomic distance between peaks (default 1 Mb)} 29 | 30 | \item{min_points}{Minimum number of p-value significant points which must lie 31 | within the span of a peak. This removes peaks with single or only a few low 32 | p-value SNPs. To disable set \code{min_points} to 1 or less.} 33 | 34 | \item{chrom}{Determines which column in \code{data} contains chromosome 35 | information. If \code{NULL} tries to autodetect the column.} 36 | 37 | \item{pos}{Determines which column in \code{data} contains position information. 38 | If \code{NULL} tries to autodetect the column.} 39 | 40 | \item{p}{Determines which column in \code{data} contains SNP p-values. If \code{NULL} 41 | tries to autodetect the column.} 42 | } 43 | \value{ 44 | Vector of row indices 45 | } 46 | \description{ 47 | Simple but fast function for finding peaks in genome-wide association study 48 | (GWAS) data based on setting a minimum distance between peaks. 49 | } 50 | \details{ 51 | This function is designed for speed. SNP p-values are filtered to only those 52 | which are significant as specified by \code{p_cutoff}. Each peak is identified as 53 | the SNP with the lowest p-value and then SNPs in proximity to each peak 54 | within the distance specified by \code{span} are removed. Regions such as the HLA 55 | whose peaks may well be broader than \code{span} may produce multiple entries. 56 | } 57 | -------------------------------------------------------------------------------- /man/eqtl_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/eqtl_plot.R 3 | \name{eqtl_plot} 4 | \alias{eqtl_plot} 5 | \title{Locus eQTL plot} 6 | \usage{ 7 | eqtl_plot( 8 | loc, 9 | tissue = "Whole Blood", 10 | eqtl_gene = loc$gene, 11 | scheme = "RdYlBu", 12 | col = NA, 13 | pcutoff = NULL, 14 | xlab = NULL, 15 | ylab = expression("-log"[10] ~ "P"), 16 | cex.axis = 0.9, 17 | xticks = TRUE, 18 | border = FALSE, 19 | add = FALSE, 20 | align = TRUE, 21 | legend_pos = "topright", 22 | ... 23 | ) 24 | } 25 | \arguments{ 26 | \item{loc}{Object of class 'locus' to use for plot. See \link{locus}.} 27 | 28 | \item{tissue}{GTex tissue in which eQTL has been measured} 29 | 30 | \item{eqtl_gene}{Gene showing eQTL effect} 31 | 32 | \item{scheme}{Character string specifying palette for effect size showing 33 | up/downregulation eQTL using \link[grDevices:palettes]{grDevices::hcl.colors}. Alternatively a 34 | vector of 6 colours.} 35 | 36 | \item{col}{Outline point colour. \code{NA} for no outlines.} 37 | 38 | \item{pcutoff}{Cut-off for p value significance. Defaults to p = 5e-08. Set 39 | to \code{NULL} to disable.} 40 | 41 | \item{xlab}{x axis title.} 42 | 43 | \item{ylab}{y axis title.} 44 | 45 | \item{cex.axis}{Specifies font size for axis numbering.} 46 | 47 | \item{xticks}{Logical whether x axis numbers and axis title are plotted.} 48 | 49 | \item{border}{Logical whether a bounding box is plotted around upper and 50 | lower plots.} 51 | 52 | \item{add}{Logical whether to add points to an existing plot or generate a 53 | new plot.} 54 | 55 | \item{align}{Logical whether set \code{\link[=par]{par()}} to align the plot.} 56 | 57 | \item{legend_pos}{Character value specifying legend position. See \code{\link[=legend]{legend()}}.} 58 | 59 | \item{...}{Other arguments passed to \code{\link[=plot]{plot()}} for the scatter plot.} 60 | } 61 | \value{ 62 | No return value. Produces a scatter plot using base graphics. 63 | } 64 | \description{ 65 | Produces a plot of eQTL data embedded in a 'locus' class object. Intended for 66 | use with \code{\link[=set_layers]{set_layers()}}. 67 | } 68 | \seealso{ 69 | \code{\link[=locus]{locus()}} \code{\link[=set_layers]{set_layers()}} \code{\link[=scatter_plot]{scatter_plot()}} 70 | } 71 | -------------------------------------------------------------------------------- /man/link_recomb.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/link_recomb.R 3 | \name{link_recomb} 4 | \alias{link_recomb} 5 | \title{Query UCSC for Recombination data} 6 | \usage{ 7 | link_recomb(loc, genome = loc$genome, table = NULL, recomb = NULL) 8 | } 9 | \arguments{ 10 | \item{loc}{Object of class 'locus' generated by \code{\link[=locus]{locus()}}} 11 | 12 | \item{genome}{Either \code{"hg38"} or \code{"hg19"}} 13 | 14 | \item{table}{Optional character value specifying which recombination table to 15 | use.} 16 | 17 | \item{recomb}{Optional \code{GRanges} class object of recombination data.} 18 | } 19 | \value{ 20 | A list object of class 'locus'. Recombination data is added as list 21 | element \code{recomb}. 22 | } 23 | \description{ 24 | Adds recombination data to a 'locus' object by querying UCSC genome browser. 25 | } 26 | \details{ 27 | Uses the \code{rtracklayer} package to query UCSC genome browser for recombination 28 | rate data. 29 | 30 | Possible options for \code{table} for hg19 are \code{"hapMapRelease24YRIRecombMap"}, 31 | \code{"hapMapRelease24CEURecombMap"}, \code{"hapMapRelease24CombinedRecombMap"} (the 32 | default). The only option for \code{table} for hg38 is \code{"recomb1000GAvg"} (the 33 | default). 34 | 35 | If you are doing many queries, it may be much faster to download the entire 36 | recombination track data (around 30 MB for hg38) from the Recombination Rate 37 | Tracks page at 38 | \href{https://genome.ucsc.edu/cgi-bin/hgTrackUi?g=recombRate2}{UCSC genome browser}. 39 | The link to the hg38 download folder is 40 | \url{http://hgdownload.soe.ucsc.edu/gbdb/hg38/recombRate/} and for hg19 is 41 | \url{http://hgdownload.soe.ucsc.edu/gbdb/hg19/decode/}. These .bw files can be 42 | converted to useable \code{GRanges} objects using \code{rtracklayer::import.bw()} (see 43 | the vignette). 44 | 45 | Sometimes \code{rtracklayer} generates intermittent API errors or warnings: try 46 | calling \code{link_recomb()} again. If warnings persist restart your R session. 47 | Errors are handled gracefully using \code{try()} to allow users to wrap 48 | \code{link_recomb()} in a loop without quitting halfway. Error messages are still 49 | shown. Successful API calls are cached using \code{memoise} to reduce API 50 | requests. 51 | } 52 | -------------------------------------------------------------------------------- /R/link_eqtl.R: -------------------------------------------------------------------------------- 1 | 2 | #' Obtain GTEx eQTL data via LDlinkR 3 | #' 4 | #' Adds eQTL (expression quantitative trait loci) information from GTEx 5 | #' (https://gtexportal.org/) to a 'locus' class object. It queries LDlink 6 | #' (https://ldlink.nci.nih.gov/) via the `LDlinkR` package to retrieve GTEx eQTL 7 | #' information on a reference SNP. 8 | #' 9 | #' @param loc Object of class 'locus' generated by [locus()] 10 | #' @param pop A 1000 Genomes Project population, (e.g. YRI or CEU), multiple 11 | #' allowed, default = "CEU". Passed to `LDlinkR::LDexpress()`. 12 | #' @param r2d Either "r2" for LD r^2 or "d" for LD D', default = "r2". Passed 13 | #' to `LDlinkR::LDexpress()`. 14 | #' @param token Personal access token for accessing 1000 Genomes LD data via 15 | #' LDlink API. See `LDlinkR` package documentation. 16 | #' @param ... Optional arguments such as `genome_build` which are passed on to 17 | #' `LDlinkR::LDexpress()` 18 | #' @return Returns an object of class 'locus' with an extra list element 'LDexp' 19 | #' containing a dataframe of information obtained via `LDexpress()`. 20 | #' @details 21 | #' The additional eQTL information obtained from LDlink web server can be 22 | #' displayed using [eqtl_plot()] which generates a scatter plot with gene tracks 23 | #' similar to a locus plot, or with [overlay_plot()] which tries to overlay the 24 | #' EQTL analysis over the original locus results (e.g. GWAS). 25 | #' 26 | #' @seealso [locus()] [eqtl_plot()] [overlay_plot()] 27 | #' @export 28 | 29 | link_eqtl <- function(loc, 30 | pop = "CEU", 31 | r2d = "r2", 32 | token = "", ...) { 33 | if (!inherits(loc, "locus")) stop("Not a locus object") 34 | if (!requireNamespace("LDlinkR", quietly = TRUE)) { 35 | stop("Package 'LDlinkR' must be installed to use this feature", 36 | call. = FALSE) 37 | } 38 | labs <- loc$labs 39 | index_snp <- loc$index_snp 40 | 41 | if (token == "") stop("token is missing") 42 | LDexp <- mem_LDexpress(snps = index_snp, pop = pop, r2d = r2d, 43 | token = token, ...) 44 | for (i in c("R2", "D'", "Effect_Size", "P_value")) { 45 | LDexp[, i] <- as.numeric(LDexp[, i]) 46 | } 47 | LDexp$Effect_Allele <- gsub("=.*", "", LDexp$Effect_Allele_Freq) 48 | loc$LDexp <- LDexp 49 | 50 | loc 51 | } 52 | 53 | mem_LDexpress <- memoise(LDlinkR::LDexpress) 54 | -------------------------------------------------------------------------------- /man/multi_layout.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/multi_layout.R 3 | \name{multi_layout} 4 | \alias{multi_layout} 5 | \title{Layout multiple locus plots} 6 | \usage{ 7 | multi_layout( 8 | plots, 9 | nrow = 1, 10 | ncol = 1, 11 | heights = c(3, 2), 12 | legend_pos = "topleft", 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{plots}{Either an 'expression' to be evaluated which is a series of 18 | calls to \code{\link[=locus_plot]{locus_plot()}} or similar plotting functions, or a list of 'locus' 19 | class objects which are plotted in sequence.} 20 | 21 | \item{nrow}{Number of rows of plots} 22 | 23 | \item{ncol}{Number of columns of plots} 24 | 25 | \item{heights}{Vector of length 2 specifying height for plot and gene tracks} 26 | 27 | \item{legend_pos}{A keyword either "topleft" or "topright" or \code{NULL} to hide 28 | the legend. Not invoked if \code{plots} is an expression. The legend is only 29 | shown on one plot on each page.} 30 | 31 | \item{...}{Optional arguments passed to \code{\link[=locus_plot]{locus_plot()}} if \code{plots} contains a 32 | list} 33 | } 34 | \value{ 35 | No return value. 36 | } 37 | \description{ 38 | Produces pages with multiple locus plots on. 39 | } 40 | \examples{ 41 | if(require(EnsDb.Hsapiens.v75)) { 42 | 43 | data(SLE_gwas_sub) 44 | genes <- c("STAT4", "UBE2L3", "IRF5") 45 | loclist <- lapply(genes, locus, 46 | data = SLE_gwas_sub, 47 | ens_db = "EnsDb.Hsapiens.v75", 48 | LD = "r2") 49 | ## produce 3 locus plots, one on each page 50 | multi_layout(loclist) 51 | 52 | ## place 3 locus plots in a row on a single page 53 | multi_layout(loclist, ncol = 3) 54 | 55 | ## full control 56 | loc <- locus(SLE_gwas_sub, gene = 'STAT4', flank = 1e5, LD = "r2", 57 | ens_db = "EnsDb.Hsapiens.v75") 58 | loc2 <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 59 | ens_db = "EnsDb.Hsapiens.v75") 60 | loc3 <- locus(SLE_gwas_sub, gene = 'UBE2L3', LD = "r2", 61 | ens_db = "EnsDb.Hsapiens.v75") 62 | multi_layout(ncol = 3, 63 | plots = { 64 | locus_plot(loc, use_layout = FALSE, legend_pos = 'topleft') 65 | locus_plot(loc2, use_layout = FALSE, legend_pos = NULL) 66 | locus_plot(loc3, use_layout = FALSE, legend_pos = NULL) 67 | }) 68 | 69 | } 70 | } 71 | \seealso{ 72 | \code{\link[=locus_plot]{locus_plot()}} 73 | } 74 | -------------------------------------------------------------------------------- /man/link_LD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/link_LD.R 3 | \name{link_LD} 4 | \alias{link_LD} 5 | \title{Obtain LD at a locus from LDlink} 6 | \usage{ 7 | link_LD( 8 | loc, 9 | pop = "CEU", 10 | r2d = "r2", 11 | token = "", 12 | method = c("proxy", "matrix"), 13 | genome_build = loc$genome, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{loc}{Object of class 'locus' generated by \code{\link[=locus]{locus()}}} 19 | 20 | \item{pop}{A 1000 Genomes Project population, (e.g. YRI or CEU), multiple 21 | allowed, default = "CEU". Passed to \code{LDlinkR::LDmatrix()}.} 22 | 23 | \item{r2d}{Either "r2" for LD r^2 or "d" for LD D', default = "r2". Passed 24 | to \code{LDlinkR::LDmatrix()} or \code{LDproxy()}.} 25 | 26 | \item{token}{Personal access token for accessing 1000 Genomes LD data via 27 | LDlink API. See \code{LDlinkR} package documentation.} 28 | 29 | \item{method}{Either \code{"proxy"} or \code{"matrix"}. Controls whether to use 30 | \code{LDproxy()} or \code{LDmatrix()} to obtain LD data.} 31 | 32 | \item{genome_build}{Choose between one of the three options: 'grch37' for 33 | genome build GRCh37 (hg19), 'grch38' for GRCh38 (hg38), or 34 | 'grch38_high_coverage' for GRCh38 High Coverage (hg38) 1000 Genome Project 35 | data sets. Default is GRCh37 (hg19).} 36 | 37 | \item{...}{Optional arguments which are passed on to \code{LDlinkR::LDmatrix()} or 38 | \code{LDlinkR::LDproxy()}} 39 | } 40 | \value{ 41 | Returns a list object of class 'locus'. LD information is added as a 42 | column \code{ld} in list element \code{data}. 43 | } 44 | \description{ 45 | Adds LD information to a 'locus' class object. It queries LDlink 46 | (https://ldlink.nci.nih.gov/) via the \code{LDlinkR} package to retrieve linkage 47 | disequilibrium (LD) information on a reference SNP. 48 | } 49 | \details{ 50 | The argument \code{method} controls which LDlinkR function is used to retrieve LD 51 | data. \code{LDmatrix()} is slower but usually more complete for small queries 52 | (<1000 SNPs). However, it has a limit of 1000 SNPs which can be queried. 53 | \code{LDproxy()} is faster but data on some SNPs may be absent. 54 | 55 | Note, SNPs have to be correctly formatted as required by LDlinkR, either as 56 | rsID (works with either method) or chromosome coordinate e.g. "chr7:24966446" 57 | (works with LDproxy only). Default genome build is \code{grch37}, see \code{LDproxy()} 58 | or \code{LDmatrix()}. 59 | } 60 | \seealso{ 61 | \code{\link[=locus]{locus()}} 62 | } 63 | -------------------------------------------------------------------------------- /R/line_plot.R: -------------------------------------------------------------------------------- 1 | 2 | #' Locus line plot 3 | #' 4 | #' Produces a line plot from a 'locus' class object. Intended for use with 5 | #' [set_layers()]. 6 | #' 7 | #' @param loc Object of class 'locus' to use for plot. See [locus]. 8 | #' @param pcutoff Cut-off for p value significance. Defaults to p = 5e-08. Set 9 | #' to `NULL` to disable. 10 | #' @param xlab x axis title. 11 | #' @param ylab y axis title. 12 | #' @param cex.axis Specifies font size for axis numbering. 13 | #' @param xticks Logical whether x axis numbers and axis title are plotted. 14 | #' @param border Logical whether a bounding box is plotted around upper and 15 | #' lower plots. 16 | #' @param align Logical whether set [par()] to align the plot. 17 | #' @param ... Other arguments passed to [plot()] for the scatter plot. 18 | #' @return No return value. Produces a scatter plot using base graphics. 19 | #' @seealso [locus()] [set_layers()] [scatter_plot()] 20 | #' @export 21 | #' 22 | line_plot <- function(loc, 23 | pcutoff = 5e-08, 24 | xlab = NULL, 25 | ylab = expression("-log"[10] ~ "P"), 26 | cex.axis = 1, 27 | xticks = FALSE, 28 | border = FALSE, 29 | align = TRUE, ...) { 30 | if (!inherits(loc, "locus")) stop("Object of class 'locus' required") 31 | if (is.null(loc$data)) stop("No data points, only gene tracks") 32 | data <- loc$data 33 | if (is.null(xlab)) xlab <- paste("Chromosome", loc$seqname, "(Mb)") 34 | 35 | # line plot 36 | if (align) { 37 | op <- par(mar = c(ifelse(xticks, 3, 0.1), 3.5, 2, 1.5)) 38 | on.exit(par(op)) 39 | } 40 | 41 | if (!is.null(pcutoff)) { 42 | abl <- quote(abline(h = -log10(pcutoff), col = 'darkgrey', lty = 2)) 43 | } else abl <- NULL 44 | 45 | new.args <- list(...) 46 | plot.args <- list(x = data[, loc$pos], y = data$logP, 47 | type = "l", 48 | las = 1, font.main = 1, 49 | xlim = loc$xrange, 50 | xlab = if (xticks) xlab else "", 51 | ylab = ylab, 52 | bty = if (border) 'o' else 'l', 53 | cex.axis = cex.axis, 54 | xaxt = 'n', 55 | tcl = -0.3, 56 | mgp = c(1.7, 0.5, 0), 57 | panel.first = abl) 58 | if (length(new.args)) plot.args[names(new.args)] <- new.args 59 | do.call("plot", plot.args) 60 | 61 | if (xticks) { 62 | axis(1, at = axTicks(1), labels = axTicks(1) / 1e6, cex.axis = cex.axis, 63 | mgp = c(1.7, 0.4, 0), tcl = -0.3) 64 | } else if (!border) { 65 | axis(1, at = axTicks(1), labels = FALSE, tcl = -0.3) 66 | } 67 | } 68 | -------------------------------------------------------------------------------- /man/genetracks_grob.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/genetracks_grob.R 3 | \name{genetracks_grob} 4 | \alias{genetracks_grob} 5 | \title{Create gene tracks grob} 6 | \usage{ 7 | genetracks_grob( 8 | locus, 9 | filter_gene_name = NULL, 10 | filter_gene_biotype = NULL, 11 | border = FALSE, 12 | cex.text = 0.7, 13 | gene_col = ifelse(showExons, "blue4", "skyblue"), 14 | exon_col = "blue4", 15 | exon_border = "blue4", 16 | showExons = TRUE, 17 | maxrows = NULL, 18 | text_pos = "top", 19 | italics = FALSE, 20 | highlight = NULL, 21 | highlight_col = "red", 22 | blanks = c("fill", "hide") 23 | ) 24 | } 25 | \arguments{ 26 | \item{locus}{Object of class 'locus' generated by \code{\link[=locus]{locus()}}.} 27 | 28 | \item{filter_gene_name}{Vector of gene names to display.} 29 | 30 | \item{filter_gene_biotype}{Vector of gene biotypes to be filtered. Use 31 | \code{\link[ensembldb:EnsDb-class]{ensembldb::listGenebiotypes()}} to display possible biotypes. For example, 32 | \code{ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)}} 33 | 34 | \item{border}{Logical whether a bounding box is plotted.} 35 | 36 | \item{cex.text}{Font size for gene text.} 37 | 38 | \item{gene_col}{Colour for gene lines.} 39 | 40 | \item{exon_col}{Fill colour for exons.} 41 | 42 | \item{exon_border}{Border line colour outlining exons (or genes if 43 | \code{showExons} is \code{FALSE}). Set to \code{NA} for no border.} 44 | 45 | \item{showExons}{Logical whether to show exons or simply show whole gene as a 46 | rectangle. If \code{showExons = FALSE} colours are specified by \code{exon_border} 47 | for rectangle border and \code{gene_col} for the fill colour.} 48 | 49 | \item{maxrows}{Specifies maximum number of rows to display in gene 50 | annotation panel.} 51 | 52 | \item{text_pos}{Character value of either 'top' or 'left' specifying 53 | placement of gene name labels.} 54 | 55 | \item{italics}{Logical whether gene text is in italics.} 56 | 57 | \item{highlight}{Vector of genes to highlight.} 58 | 59 | \item{highlight_col}{Single colour or vector of colours for highlighted 60 | genes.} 61 | 62 | \item{blanks}{Controls handling of genes with blank names: \code{"fill"} replaces 63 | blank gene symbols with ensembl gene ids. \code{"hide"} hides genes which are 64 | missing gene symbols.} 65 | } 66 | \value{ 67 | A grob object. 68 | } 69 | \description{ 70 | Plot gene annotation tracks from \code{ensembldb} data using the grid package to 71 | create a grob. 72 | } 73 | \details{ 74 | This function is called by \code{\link[=gg_genetracks]{gg_genetracks()}}. It can be used to 75 | generate a grob of the gene annotation tracks on their own. 76 | } 77 | \examples{ 78 | if(require(EnsDb.Hsapiens.v75)) { 79 | data(SLE_gwas_sub) 80 | loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 81 | ens_db = "EnsDb.Hsapiens.v75") 82 | g <- genetracks_grob(loc) 83 | grid::grid.newpage() 84 | grid::grid.draw(g) 85 | } 86 | } 87 | -------------------------------------------------------------------------------- /man/scatter_plotly.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scatter_plotly.R 3 | \name{scatter_plotly} 4 | \alias{scatter_plotly} 5 | \title{Locus scatter plotly} 6 | \usage{ 7 | scatter_plotly( 8 | loc, 9 | index_snp = loc$index_snp, 10 | pcutoff = 5e-08, 11 | scheme = c("grey", "dodgerblue", "red"), 12 | xlab = NULL, 13 | ylab = NULL, 14 | yzero = (loc$yvar == "logP"), 15 | showLD = TRUE, 16 | LD_scheme = c("grey", "royalblue", "cyan2", "green3", "orange", "red", "purple"), 17 | marker_outline = "black", 18 | marker_size = 7, 19 | recomb_col = "blue", 20 | eqtl_gene = NULL, 21 | beta = NULL, 22 | add_hover = NULL, 23 | showlegend = TRUE, 24 | height = NULL, 25 | webGL = TRUE 26 | ) 27 | } 28 | \arguments{ 29 | \item{loc}{Object of class 'locus' to use for plot. See \link{locus}.} 30 | 31 | \item{index_snp}{Specifies index SNP or a vector of SNPs to be shown in a 32 | different colour and symbol. Defaults to the SNP with the lowest p-value. 33 | Set to \code{NULL} to not show this.} 34 | 35 | \item{pcutoff}{Cut-off for p value significance. Defaults to p = 5e-08. Set 36 | to \code{NULL} to disable.} 37 | 38 | \item{scheme}{Vector of 3 colours if LD is not shown: 1st = normal points, 39 | 2nd = colour for significant points, 3rd = index SNP(s).} 40 | 41 | \item{xlab}{x axis title.} 42 | 43 | \item{ylab}{y axis title.} 44 | 45 | \item{yzero}{Logical whether to force y axis limit to include y=0.} 46 | 47 | \item{showLD}{Logical whether to show LD with colours} 48 | 49 | \item{LD_scheme}{Vector of colours for plotting LD. The first colour is for 50 | SNPs which lack LD information. The next 5 colours are for r^2 or D' LD 51 | results ranging from 0 to 1 in intervals of 0.2. The final colour is for 52 | the index SNP.} 53 | 54 | \item{marker_outline}{Specifies colour for outlining points.} 55 | 56 | \item{marker_size}{Value for size of markers in plotly units.} 57 | 58 | \item{recomb_col}{Colour for recombination rate line if recombination rate 59 | data is present. Set to \code{NA} to hide the line. See \code{\link[=link_recomb]{link_recomb()}} to add 60 | recombination rate data.} 61 | 62 | \item{eqtl_gene}{Column name in \code{loc$data} for eQTL genes.} 63 | 64 | \item{beta}{Optional column name for beta coefficient to display upward 65 | triangles for positive beta and downward triangles for negative beta 66 | (significant SNPs only).} 67 | 68 | \item{add_hover}{Optional vector of column names in \code{loc$data} to add to the 69 | plotly hover text for scatter points.} 70 | 71 | \item{showlegend}{Logical whether to show a legend for the scatter points.} 72 | 73 | \item{height}{Height in pixels (optional, defaults to automatic sizing).} 74 | 75 | \item{webGL}{Logical whether to use webGL or SVG for scatter plot.} 76 | } 77 | \value{ 78 | A \code{plotly} scatter plot. 79 | } 80 | \description{ 81 | Produces a scatter plot from a 'locus' class object using plotly. 82 | } 83 | \seealso{ 84 | \code{\link[=locus]{locus()}} \code{\link[=locus_plotly]{locus_plotly()}} 85 | } 86 | -------------------------------------------------------------------------------- /R/multi_layout.R: -------------------------------------------------------------------------------- 1 | 2 | #' Layout multiple locus plots 3 | #' 4 | #' Produces pages with multiple locus plots on. 5 | #' 6 | #' @param plots Either an 'expression' to be evaluated which is a series of 7 | #' calls to [locus_plot()] or similar plotting functions, or a list of 'locus' 8 | #' class objects which are plotted in sequence. 9 | #' @param nrow Number of rows of plots 10 | #' @param ncol Number of columns of plots 11 | #' @param heights Vector of length 2 specifying height for plot and gene tracks 12 | #' @param legend_pos A keyword either "topleft" or "topright" or `NULL` to hide 13 | #' the legend. Not invoked if `plots` is an expression. The legend is only 14 | #' shown on one plot on each page. 15 | #' @param ... Optional arguments passed to [locus_plot()] if `plots` contains a 16 | #' list 17 | #' @return No return value. 18 | #' @seealso [locus_plot()] 19 | #' @examples 20 | #' if(require(EnsDb.Hsapiens.v75)) { 21 | #' 22 | #' data(SLE_gwas_sub) 23 | #' genes <- c("STAT4", "UBE2L3", "IRF5") 24 | #' loclist <- lapply(genes, locus, 25 | #' data = SLE_gwas_sub, 26 | #' ens_db = "EnsDb.Hsapiens.v75", 27 | #' LD = "r2") 28 | #' ## produce 3 locus plots, one on each page 29 | #' multi_layout(loclist) 30 | #' 31 | #' ## place 3 locus plots in a row on a single page 32 | #' multi_layout(loclist, ncol = 3) 33 | #' 34 | #' ## full control 35 | #' loc <- locus(SLE_gwas_sub, gene = 'STAT4', flank = 1e5, LD = "r2", 36 | #' ens_db = "EnsDb.Hsapiens.v75") 37 | #' loc2 <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 38 | #' ens_db = "EnsDb.Hsapiens.v75") 39 | #' loc3 <- locus(SLE_gwas_sub, gene = 'UBE2L3', LD = "r2", 40 | #' ens_db = "EnsDb.Hsapiens.v75") 41 | #' multi_layout(ncol = 3, 42 | #' plots = { 43 | #' locus_plot(loc, use_layout = FALSE, legend_pos = 'topleft') 44 | #' locus_plot(loc2, use_layout = FALSE, legend_pos = NULL) 45 | #' locus_plot(loc3, use_layout = FALSE, legend_pos = NULL) 46 | #' }) 47 | #' 48 | #' } 49 | #' @export 50 | 51 | multi_layout <- function(plots, 52 | nrow = 1, ncol = 1, heights = c(3, 2), 53 | legend_pos = "topleft", 54 | ...) { 55 | op <- par(no.readonly = TRUE) 56 | xr <- seq_len(ncol) * 2 57 | x2 <- c(xr, xr-1) 58 | x3 <- rep(x2, nrow) + (rep(seq_len(nrow), each = length(x2)) -1) * length(x2) 59 | mat <- matrix(x3, nrow = nrow * 2, ncol = ncol, byrow = TRUE) 60 | graphics::layout(mat, heights = rep(heights, nrow)) 61 | on.exit(par(op)) 62 | if (is.list(plots)) { 63 | npage <- nrow * ncol 64 | lpos <- if (!is.null(legend_pos) && legend_pos == "topleft") {1 65 | } else if (nrow == 1) 0 else ncol 66 | lapply(seq_along(plots), function(i) { 67 | leg <- NULL 68 | if (i %% npage == lpos) leg <- legend_pos 69 | locus_plot(plots[[i]], use_layout = FALSE, legend_pos = leg, ...) 70 | }) 71 | } else plots 72 | invisible() 73 | } 74 | -------------------------------------------------------------------------------- /man/genetrack_ly.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/genetrack_ly.R 3 | \name{genetrack_ly} 4 | \alias{genetrack_ly} 5 | \title{Gene tracks using 'plotly'} 6 | \usage{ 7 | genetrack_ly( 8 | locus, 9 | filter_gene_name = NULL, 10 | filter_gene_biotype = NULL, 11 | cex.text = 0.7, 12 | italics = FALSE, 13 | gene_col = ifelse(showExons, "blue4", "skyblue"), 14 | exon_col = "blue4", 15 | exon_border = "blue4", 16 | showExons = TRUE, 17 | maxrows = 8, 18 | width = 600, 19 | xlab = NULL, 20 | blanks = c("fill", "hide", "show"), 21 | height = NULL, 22 | plot = TRUE 23 | ) 24 | } 25 | \arguments{ 26 | \item{locus}{Object of class 'locus' generated by \code{\link[=locus]{locus()}}.} 27 | 28 | \item{filter_gene_name}{Vector of gene names to display.} 29 | 30 | \item{filter_gene_biotype}{Vector of gene biotypes to be filtered. Use 31 | \code{\link[ensembldb:EnsDb-class]{ensembldb::listGenebiotypes()}} to display possible biotypes. For example, 32 | \code{ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)}} 33 | 34 | \item{cex.text}{Font size for gene text.} 35 | 36 | \item{italics}{Logical whether gene text is in italics.} 37 | 38 | \item{gene_col}{Colour for gene lines.} 39 | 40 | \item{exon_col}{Fill colour for exons.} 41 | 42 | \item{exon_border}{Border line colour outlining exons (or genes if 43 | \code{showExons} is \code{FALSE}). Set to \code{NA} for no border.} 44 | 45 | \item{showExons}{Logical whether to show exons or simply show whole gene as a 46 | rectangle. If \code{showExons = FALSE} colours are specified by \code{exon_border} 47 | for rectangle border and \code{gene_col} for the fill colour.} 48 | 49 | \item{maxrows}{Specifies maximum number of rows to display in gene 50 | annotation panel.} 51 | 52 | \item{width}{Width of plotly plot in pixels which is purely used to prevent 53 | overlapping text for gene names.} 54 | 55 | \item{xlab}{Title for x axis. Defaults to chromosome \code{seqname} specified 56 | in \code{locus}.} 57 | 58 | \item{blanks}{Controls handling of genes with blank names: \code{"fill"} replaces 59 | blank gene symbols with ensembl gene ids. \code{"hide"} completely hides genes 60 | which are missing gene symbols. \code{"show"} shows gene lines but no label 61 | (hovertext is still available).} 62 | 63 | \item{height}{Height in pixels (optional, defaults to automatic sizing).} 64 | 65 | \item{plot}{Logical whether to produce plotly object or return plot 66 | coordinates.} 67 | } 68 | \value{ 69 | Either a 'plotly' plotting object showing gene tracks, or if 70 | \code{plot = FALSE} a list containing \code{TX}, a dataframe of coordinates for 71 | gene transcripts, and \code{EX}, a dataframe of coordinates for exons. 72 | } 73 | \description{ 74 | Plot gene annotation tracks from \code{ensembldb} data using \code{plotly}. 75 | } 76 | \details{ 77 | This function can used to plot gene annotation tracks on their own. 78 | } 79 | \examples{ 80 | if(require(EnsDb.Hsapiens.v75)) { 81 | data(SLE_gwas_sub) 82 | loc <- locus(SLE_gwas_sub, gene = 'UBE2L3', flank = 1e5, 83 | ens_db = "EnsDb.Hsapiens.v75") 84 | genetrack_ly(loc) 85 | } 86 | } 87 | -------------------------------------------------------------------------------- /R/quick_peak.R: -------------------------------------------------------------------------------- 1 | 2 | #' Fast peak finder in GWAS data 3 | #' 4 | #' Simple but fast function for finding peaks in genome-wide association study 5 | #' (GWAS) data based on setting a minimum distance between peaks. 6 | #' 7 | #' @param data GWAS dataset (data.frame or data.table) 8 | #' @param npeaks Number of peaks to find. If set to `NA`, algorithm finds all 9 | #' distinct peaks separated from one another by region size specified by 10 | #' `span`. 11 | #' @param p_cutoff Specifies cut-off for p-value significance above which 12 | #' p-values are ignored. 13 | #' @param span Minimum genomic distance between peaks (default 1 Mb) 14 | #' @param min_points Minimum number of p-value significant points which must lie 15 | #' within the span of a peak. This removes peaks with single or only a few low 16 | #' p-value SNPs. To disable set `min_points` to 1 or less. 17 | #' @param chrom Determines which column in `data` contains chromosome 18 | #' information. If `NULL` tries to autodetect the column. 19 | #' @param pos Determines which column in `data` contains position information. 20 | #' If `NULL` tries to autodetect the column. 21 | #' @param p Determines which column in `data` contains SNP p-values. If `NULL` 22 | #' tries to autodetect the column. 23 | #' @details 24 | #' This function is designed for speed. SNP p-values are filtered to only those 25 | #' which are significant as specified by `p_cutoff`. Each peak is identified as 26 | #' the SNP with the lowest p-value and then SNPs in proximity to each peak 27 | #' within the distance specified by `span` are removed. Regions such as the HLA 28 | #' whose peaks may well be broader than `span` may produce multiple entries. 29 | #' @returns Vector of row indices 30 | #' @export 31 | 32 | quick_peak <- function(data, npeaks = NA, p_cutoff = 5e-08, span = 1e6, 33 | min_points = 2, 34 | chrom = NULL, pos = NULL, p = NULL) { 35 | start <- Sys.time() 36 | # autodetect column headings 37 | dc <- detect_cols(data, chrom, pos, p) 38 | chrom <- dc$chrom 39 | pos <- dc$pos 40 | p <- dc$p 41 | 42 | if (is.na(npeaks)) npeaks <- Inf 43 | 44 | i <- 2 45 | index <- order(data[, p]) 46 | index <- index[data[index, p] < p_cutoff] 47 | pks <- index[1] 48 | del <- which(abs(data[pks, pos] - data[index, pos]) <= span & 49 | data[pks, chrom] == data[index, chrom])[-1] 50 | if (length(del) > 0) index <- index[-del] 51 | while (length(pks) < npeaks & i <= length(index)) { 52 | if (all(abs(data[index[i], pos] - data[pks, pos]) > span | 53 | data[index[i], chrom] != data[pks, chrom])) { 54 | del <- which(abs(data[index[i], pos] - data[index, pos]) <= span & 55 | data[index[i], chrom] == data[index, chrom]) 56 | if (length(del) >= min_points) { 57 | pks <- c(pks, index[i]) 58 | del <- del[-1] 59 | if (length(del) > 0) index <- index[-del] 60 | } 61 | } 62 | i <- i + 1 63 | } 64 | end <- Sys.time() 65 | message(length(pks), " peaks found (", format(end - start, digits = 3), ")") 66 | if (!is.infinite(npeaks) & length(pks) < npeaks) 67 | message("lower p_cutoff to find more peaks") 68 | pks 69 | } 70 | -------------------------------------------------------------------------------- /man/locus_plotly.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/locus_plotly.R 3 | \name{locus_plotly} 4 | \alias{locus_plotly} 5 | \title{Locus plotly} 6 | \usage{ 7 | locus_plotly( 8 | loc, 9 | heights = c(0.6, 0.4), 10 | filter_gene_name = NULL, 11 | filter_gene_biotype = NULL, 12 | cex.text = 0.7, 13 | italics = FALSE, 14 | gene_col = ifelse(showExons, "blue4", "skyblue"), 15 | exon_col = "blue4", 16 | exon_border = "blue4", 17 | showExons = TRUE, 18 | maxrows = 8, 19 | width = 600, 20 | xlab = NULL, 21 | blanks = "show", 22 | ... 23 | ) 24 | } 25 | \arguments{ 26 | \item{loc}{Object of class 'locus' to use for plot. See \code{\link[=locus]{locus()}}.} 27 | 28 | \item{heights}{Vector controlling relative height of each panel on 0-1 scale. 29 | Alternatively a vector of length 2 of height in pixels passed to 30 | \code{scatter_plotly()} and \code{genetrack_ly()}.} 31 | 32 | \item{filter_gene_name}{Vector of gene names to display.} 33 | 34 | \item{filter_gene_biotype}{Vector of gene biotypes to be filtered. Use 35 | \code{\link[ensembldb:EnsDb-class]{ensembldb::listGenebiotypes()}} to display possible biotypes. For example, 36 | \code{ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)}} 37 | 38 | \item{cex.text}{Font size for gene text.} 39 | 40 | \item{italics}{Logical whether gene text is in italics.} 41 | 42 | \item{gene_col}{Colour for gene lines.} 43 | 44 | \item{exon_col}{Fill colour for exons.} 45 | 46 | \item{exon_border}{Border line colour outlining exons (or genes if 47 | \code{showExons} is \code{FALSE}). Set to \code{NA} for no border.} 48 | 49 | \item{showExons}{Logical whether to show exons or simply show whole gene as a 50 | rectangle. If \code{showExons = FALSE} colours are specified by \code{exon_border} 51 | for rectangle border and \code{gene_col} for the fill colour.} 52 | 53 | \item{maxrows}{Specifies maximum number of rows to display in gene 54 | annotation panel.} 55 | 56 | \item{width}{Width of plotly plot in pixels which is purely used to prevent 57 | overlapping text for gene names.} 58 | 59 | \item{xlab}{Title for x axis. Defaults to chromosome \code{seqname} specified 60 | in \code{locus}.} 61 | 62 | \item{blanks}{Controls handling of genes with blank names: \code{"fill"} replaces 63 | blank gene symbols with ensembl gene ids. \code{"hide"} completely hides genes 64 | which are missing gene symbols. \code{"show"} shows gene lines but no label 65 | (hovertext is still available).} 66 | 67 | \item{...}{Optional arguments passed to \code{\link[=scatter_plotly]{scatter_plotly()}} to control the 68 | scatter plot.} 69 | } 70 | \value{ 71 | A 'plotly' plotting object showing a scatter plot above gene tracks. 72 | } 73 | \description{ 74 | Genomic locus plot similar to locuszoom, using plotly. 75 | } 76 | \details{ 77 | This is an R/plotly version of locuszoom for exploring regional Manhattan 78 | plots of gene loci. Use \code{\link[=locus]{locus()}} first to generate an object of class 79 | 'locus' for plotting. This references a selected Ensembl database for 80 | annotating genes and exons. Hover over the points or gene tracks to reveal 81 | more information. 82 | } 83 | \examples{ 84 | if(require(EnsDb.Hsapiens.v75)) { 85 | data(SLE_gwas_sub) 86 | loc <- locus(SLE_gwas_sub, gene = "IRF5", flank = c(7e4, 2e5), LD = "r2", 87 | ens_db = "EnsDb.Hsapiens.v75") 88 | locus_plotly(loc) 89 | } 90 | } 91 | \seealso{ 92 | \code{\link[=locus]{locus()}} \code{\link[=genetrack_ly]{genetrack_ly()}} \code{\link[=scatter_plotly]{scatter_plotly()}} 93 | } 94 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(summary,locus) 4 | export(eqtl_plot) 5 | export(genetrack_ly) 6 | export(genetracks) 7 | export(genetracks_grob) 8 | export(gg_addgenes) 9 | export(gg_genetracks) 10 | export(gg_scatter) 11 | export(line_plot) 12 | export(link_LD) 13 | export(link_eqtl) 14 | export(link_recomb) 15 | export(locus) 16 | export(locus_ggplot) 17 | export(locus_plot) 18 | export(locus_plotly) 19 | export(multi_layout) 20 | export(overlay_plot) 21 | export(quick_peak) 22 | export(scatter_plot) 23 | export(scatter_plotly) 24 | export(set_layers) 25 | importFrom(AnnotationFilter,AnnotationFilterList) 26 | importFrom(AnnotationFilter,ExonEndFilter) 27 | importFrom(AnnotationFilter,ExonStartFilter) 28 | importFrom(AnnotationFilter,GeneIdFilter) 29 | importFrom(AnnotationFilter,GeneNameFilter) 30 | importFrom(AnnotationFilter,SeqNameFilter) 31 | importFrom(AnnotationFilter,TxEndFilter) 32 | importFrom(AnnotationFilter,TxStartFilter) 33 | importFrom(BiocGenerics,end) 34 | importFrom(BiocGenerics,start) 35 | importFrom(GenomeInfoDb,"genome<-") 36 | importFrom(GenomeInfoDb,genome) 37 | importFrom(GenomeInfoDb,seqlengths) 38 | importFrom(GenomeInfoDb,seqnames) 39 | importFrom(GenomicRanges,GRanges) 40 | importFrom(IRanges,IRanges) 41 | importFrom(LDlinkR,LDexpress) 42 | importFrom(LDlinkR,LDmatrix) 43 | importFrom(LDlinkR,LDproxy) 44 | importFrom(cowplot,plot_grid) 45 | importFrom(dplyr,bind_rows) 46 | importFrom(ensembldb,ensemblVersion) 47 | importFrom(ensembldb,exons) 48 | importFrom(ensembldb,genes) 49 | importFrom(ensembldb,organism) 50 | importFrom(gggrid,grid_panel) 51 | importFrom(ggplot2,aes) 52 | importFrom(ggplot2,element_blank) 53 | importFrom(ggplot2,element_rect) 54 | importFrom(ggplot2,element_text) 55 | importFrom(ggplot2,geom_hline) 56 | importFrom(ggplot2,geom_line) 57 | importFrom(ggplot2,geom_point) 58 | importFrom(ggplot2,ggplot) 59 | importFrom(ggplot2,guide_legend) 60 | importFrom(ggplot2,guides) 61 | importFrom(ggplot2,labs) 62 | importFrom(ggplot2,layer_scales) 63 | importFrom(ggplot2,scale_color_manual) 64 | importFrom(ggplot2,scale_fill_manual) 65 | importFrom(ggplot2,scale_shape_manual) 66 | importFrom(ggplot2,scale_y_continuous) 67 | importFrom(ggplot2,sec_axis) 68 | importFrom(ggplot2,theme) 69 | importFrom(ggplot2,theme_classic) 70 | importFrom(ggplot2,unit) 71 | importFrom(ggplot2,xlab) 72 | importFrom(ggplot2,xlim) 73 | importFrom(ggplot2,ylim) 74 | importFrom(ggrepel,geom_text_repel) 75 | importFrom(grDevices,adjustcolor) 76 | importFrom(grDevices,col2rgb) 77 | importFrom(grDevices,hcl.colors) 78 | importFrom(grDevices,rainbow) 79 | importFrom(grDevices,rgb) 80 | importFrom(graphics,axTicks) 81 | importFrom(graphics,axis) 82 | importFrom(graphics,legend) 83 | importFrom(graphics,lines) 84 | importFrom(graphics,mtext) 85 | importFrom(graphics,par) 86 | importFrom(graphics,plot.new) 87 | importFrom(graphics,points) 88 | importFrom(graphics,rect) 89 | importFrom(graphics,strwidth) 90 | importFrom(graphics,text) 91 | importFrom(grid,gList) 92 | importFrom(grid,gTree) 93 | importFrom(grid,gpar) 94 | importFrom(grid,polylineGrob) 95 | importFrom(grid,rectGrob) 96 | importFrom(grid,textGrob) 97 | importFrom(grid,viewport) 98 | importFrom(grid,xaxisGrob) 99 | importFrom(memoise,drop_cache) 100 | importFrom(memoise,memoise) 101 | importFrom(plotly,"%>%") 102 | importFrom(plotly,add_segments) 103 | importFrom(plotly,add_text) 104 | importFrom(plotly,add_trace) 105 | importFrom(plotly,plot_ly) 106 | importFrom(plotly,plotly_build) 107 | importFrom(plotly,plotly_empty) 108 | importFrom(rlang,.data) 109 | importFrom(rtracklayer,browserSession) 110 | importFrom(rtracklayer,getTable) 111 | importFrom(rtracklayer,ucscTableQuery) 112 | importFrom(stats,relevel) 113 | importFrom(zoo,na.approx) 114 | -------------------------------------------------------------------------------- /man/locus_ggplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/locus_ggplot.R 3 | \name{locus_ggplot} 4 | \alias{locus_ggplot} 5 | \title{Locus plot using ggplot2} 6 | \usage{ 7 | locus_ggplot( 8 | loc, 9 | heights = c(3, 2), 10 | filter_gene_name = NULL, 11 | filter_gene_biotype = NULL, 12 | border = FALSE, 13 | cex.axis = 1, 14 | cex.lab = 1, 15 | cex.text = 0.7, 16 | gene_col = ifelse(showExons, "blue4", "skyblue"), 17 | exon_col = "blue4", 18 | exon_border = "blue4", 19 | showExons = TRUE, 20 | maxrows = 12, 21 | text_pos = "top", 22 | italics = FALSE, 23 | xticks = "top", 24 | xlab = NULL, 25 | highlight = NULL, 26 | highlight_col = "red", 27 | blanks = "fill", 28 | ... 29 | ) 30 | } 31 | \arguments{ 32 | \item{loc}{Object of class 'locus' to use for plot. See \code{\link[=locus]{locus()}}.} 33 | 34 | \item{heights}{Vector supplying the ratio of top to bottom plot.} 35 | 36 | \item{filter_gene_name}{Vector of gene names to display.} 37 | 38 | \item{filter_gene_biotype}{Vector of gene biotypes to be filtered. Use 39 | \code{\link[ensembldb:EnsDb-class]{ensembldb::listGenebiotypes()}} to display possible biotypes. For example, 40 | \code{ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)}} 41 | 42 | \item{border}{Logical whether a bounding box is plotted.} 43 | 44 | \item{cex.axis}{Specifies font size for axis numbering.} 45 | 46 | \item{cex.lab}{Specifies font size for axis titles.} 47 | 48 | \item{cex.text}{Font size for gene text.} 49 | 50 | \item{gene_col}{Colour for gene lines.} 51 | 52 | \item{exon_col}{Fill colour for exons.} 53 | 54 | \item{exon_border}{Border line colour outlining exons (or genes if 55 | \code{showExons} is \code{FALSE}). Set to \code{NA} for no border.} 56 | 57 | \item{showExons}{Logical whether to show exons or simply show whole gene as a 58 | rectangle. If \code{showExons = FALSE} colours are specified by \code{exon_border} 59 | for rectangle border and \code{gene_col} for the fill colour.} 60 | 61 | \item{maxrows}{Specifies maximum number of rows to display in gene annotation 62 | panel.} 63 | 64 | \item{text_pos}{Character value of either 'top' or 'left' specifying 65 | placement of gene name labels.} 66 | 67 | \item{italics}{Logical whether gene text is in italics.} 68 | 69 | \item{xticks}{Logical whether x axis ticks and numbers are plotted.} 70 | 71 | \item{xlab}{Title for x axis. Defaults to chromosome \code{seqname} specified in 72 | \code{locus}.} 73 | 74 | \item{highlight}{Vector of genes to highlight.} 75 | 76 | \item{highlight_col}{Single colour or vector of colours for highlighted 77 | genes.} 78 | 79 | \item{blanks}{Controls handling of genes with blank names: \code{"fill"} replaces 80 | blank gene symbols with ensembl gene ids. \code{"hide"} hides genes which are 81 | missing gene symbols.} 82 | 83 | \item{...}{Additional arguments passed to \code{\link[=gg_scatter]{gg_scatter()}} to control 84 | the scatter plot, e.g. \code{pcutoff}, \code{scheme}, \code{recomb_offset} etc.} 85 | } 86 | \value{ 87 | Returns a ggplot2 plot containing a scatter plot with genetracks 88 | underneath. 89 | } 90 | \description{ 91 | Genomic locus plot similar to locuszoom. 92 | } 93 | \details{ 94 | Arguments to control plotting of the gene tracks are passed onto 95 | \code{\link[=gg_genetracks]{gg_genetracks()}} and for the scatter plot are passed via \code{...} to 96 | \code{\link[=gg_scatter]{gg_scatter()}}. See the documentation for each of these functions for 97 | details. 98 | } 99 | \examples{ 100 | if(require(EnsDb.Hsapiens.v75)) { 101 | data(SLE_gwas_sub) 102 | loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 103 | ens_db = "EnsDb.Hsapiens.v75") 104 | locus_ggplot(loc) 105 | } 106 | } 107 | \seealso{ 108 | \code{\link[=gg_scatter]{gg_scatter()}} \code{\link[=gg_genetracks]{gg_genetracks()}} 109 | } 110 | -------------------------------------------------------------------------------- /R/locus_plotly.R: -------------------------------------------------------------------------------- 1 | 2 | #' Locus plotly 3 | #' 4 | #' Genomic locus plot similar to locuszoom, using plotly. 5 | #' 6 | #' @details 7 | #' This is an R/plotly version of locuszoom for exploring regional Manhattan 8 | #' plots of gene loci. Use [locus()] first to generate an object of class 9 | #' 'locus' for plotting. This references a selected Ensembl database for 10 | #' annotating genes and exons. Hover over the points or gene tracks to reveal 11 | #' more information. 12 | #' 13 | #' @param loc Object of class 'locus' to use for plot. See [locus()]. 14 | #' @param heights Vector controlling relative height of each panel on 0-1 scale. 15 | #' Alternatively a vector of length 2 of height in pixels passed to 16 | #' `scatter_plotly()` and `genetrack_ly()`. 17 | #' @param filter_gene_name Vector of gene names to display. 18 | #' @param filter_gene_biotype Vector of gene biotypes to be filtered. Use 19 | #' [ensembldb::listGenebiotypes()] to display possible biotypes. For example, 20 | #' `ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)` 21 | #' @param cex.text Font size for gene text. 22 | #' @param italics Logical whether gene text is in italics. 23 | #' @param gene_col Colour for gene lines. 24 | #' @param exon_col Fill colour for exons. 25 | #' @param exon_border Border line colour outlining exons (or genes if 26 | #' `showExons` is `FALSE`). Set to `NA` for no border. 27 | #' @param showExons Logical whether to show exons or simply show whole gene as a 28 | #' rectangle. If `showExons = FALSE` colours are specified by `exon_border` 29 | #' for rectangle border and `gene_col` for the fill colour. 30 | #' @param maxrows Specifies maximum number of rows to display in gene 31 | #' annotation panel. 32 | #' @param width Width of plotly plot in pixels which is purely used to prevent 33 | #' overlapping text for gene names. 34 | #' @param xlab Title for x axis. Defaults to chromosome `seqname` specified 35 | #' in `locus`. 36 | #' @param blanks Controls handling of genes with blank names: `"fill"` replaces 37 | #' blank gene symbols with ensembl gene ids. `"hide"` completely hides genes 38 | #' which are missing gene symbols. `"show"` shows gene lines but no label 39 | #' (hovertext is still available). 40 | #' @param ... Optional arguments passed to [scatter_plotly()] to control the 41 | #' scatter plot. 42 | #' @returns A 'plotly' plotting object showing a scatter plot above gene tracks. 43 | #' @seealso [locus()] [genetrack_ly()] [scatter_plotly()] 44 | #' @examples 45 | #' if(require(EnsDb.Hsapiens.v75)) { 46 | #' data(SLE_gwas_sub) 47 | #' loc <- locus(SLE_gwas_sub, gene = "IRF5", flank = c(7e4, 2e5), LD = "r2", 48 | #' ens_db = "EnsDb.Hsapiens.v75") 49 | #' locus_plotly(loc) 50 | #' } 51 | #' @export 52 | 53 | locus_plotly <- function(loc, heights = c(0.6, 0.4), 54 | filter_gene_name = NULL, 55 | filter_gene_biotype = NULL, 56 | cex.text = 0.7, 57 | italics = FALSE, 58 | gene_col = ifelse(showExons, 'blue4', 'skyblue'), 59 | exon_col = 'blue4', 60 | exon_border = 'blue4', 61 | showExons = TRUE, 62 | maxrows = 8, 63 | width = 600, 64 | xlab = NULL, 65 | blanks = "show", 66 | ...) { 67 | pheights <- NULL 68 | if (any(heights > 1)) { 69 | pheights <- heights 70 | pheights[2] <- sum(heights) 71 | heights <- heights / sum(heights) 72 | } 73 | 74 | g <- genetrack_ly(loc, filter_gene_name, filter_gene_biotype, cex.text, 75 | italics, gene_col, exon_col, exon_border, showExons, 76 | maxrows, width, xlab, blanks, height = pheights[2]) 77 | p <- scatter_plotly(loc, xlab = xlab, height = pheights[1], ...) 78 | 79 | plotly::subplot(p, g, shareX = TRUE, nrows = 2, heights = heights, 80 | titleY = TRUE, margin = 0) 81 | } 82 | -------------------------------------------------------------------------------- /man/gg_genetracks.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gg_genetracks.R 3 | \name{gg_genetracks} 4 | \alias{gg_genetracks} 5 | \title{Plot gene tracks} 6 | \usage{ 7 | gg_genetracks( 8 | loc, 9 | filter_gene_name = NULL, 10 | filter_gene_biotype = NULL, 11 | border = FALSE, 12 | cex.axis = 1, 13 | cex.lab = 1, 14 | cex.text = 0.7, 15 | gene_col = ifelse(showExons, "blue4", "skyblue"), 16 | exon_col = "blue4", 17 | exon_border = "blue4", 18 | showExons = TRUE, 19 | maxrows = NULL, 20 | text_pos = "top", 21 | italics = FALSE, 22 | xticks = TRUE, 23 | xlab = NULL, 24 | highlight = NULL, 25 | highlight_col = "red", 26 | blanks = c("fill", "hide") 27 | ) 28 | } 29 | \arguments{ 30 | \item{loc}{Object of class 'locus' generated by \code{\link[=locus]{locus()}}.} 31 | 32 | \item{filter_gene_name}{Vector of gene names to display.} 33 | 34 | \item{filter_gene_biotype}{Vector of gene biotypes to be filtered. Use 35 | \code{\link[ensembldb:EnsDb-class]{ensembldb::listGenebiotypes()}} to display possible biotypes. For example, 36 | \code{ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)}} 37 | 38 | \item{border}{Logical whether a bounding box is plotted.} 39 | 40 | \item{cex.axis}{Specifies font size for axis numbering.} 41 | 42 | \item{cex.lab}{Specifies font size for axis titles.} 43 | 44 | \item{cex.text}{Font size for gene text.} 45 | 46 | \item{gene_col}{Colour for gene lines.} 47 | 48 | \item{exon_col}{Fill colour for exons.} 49 | 50 | \item{exon_border}{Border line colour outlining exons (or genes if 51 | \code{showExons} is \code{FALSE}). Set to \code{NA} for no border.} 52 | 53 | \item{showExons}{Logical whether to show exons or simply show whole gene as a 54 | rectangle. If \code{showExons = FALSE} colours are specified by \code{exon_border} 55 | for rectangle border and \code{gene_col} for the fill colour.} 56 | 57 | \item{maxrows}{Specifies maximum number of rows to display in gene annotation 58 | panel.} 59 | 60 | \item{text_pos}{Character value of either 'top' or 'left' specifying 61 | placement of gene name labels.} 62 | 63 | \item{italics}{Logical whether gene text is in italics.} 64 | 65 | \item{xticks}{Logical whether x axis ticks and numbers are plotted.} 66 | 67 | \item{xlab}{Title for x axis. Defaults to chromosome \code{seqname} specified in 68 | \code{locus}.} 69 | 70 | \item{highlight}{Vector of genes to highlight.} 71 | 72 | \item{highlight_col}{Single colour or vector of colours for highlighted 73 | genes.} 74 | 75 | \item{blanks}{Controls handling of genes with blank names: \code{"fill"} replaces 76 | blank gene symbols with ensembl gene ids. \code{"hide"} hides genes which are 77 | missing gene symbols.} 78 | } 79 | \value{ 80 | A ggplot2 object. 81 | } 82 | \description{ 83 | Plot gene annotation tracks from \code{ensembldb} data using ggplot2 and grid. 84 | } 85 | \details{ 86 | This function is called by \code{\link[=locus_ggplot]{locus_ggplot()}}, and in turn it calls 87 | \code{\link[=genetracks_grob]{genetracks_grob()}}. It can be used to plot the gene annotation tracks on 88 | their own as a ggplot2 object. 89 | 90 | \code{gene_col}, \code{exon_col} and \code{exon_border} set colours for all genes, while 91 | \code{highlight} and \code{highlight_col} can optionally be used together to highlight 92 | specific genes of interest. For full control over every single gene, users 93 | can add columns \code{gene_col}, \code{exon_col} and \code{exon_border} to the \code{TX} object 94 | within the 'locus' object. Columns added to \code{TX} override their equivalent 95 | arguments. 96 | } 97 | \examples{ 98 | if(require(EnsDb.Hsapiens.v75)) { 99 | data(SLE_gwas_sub) 100 | loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 101 | ens_db = "EnsDb.Hsapiens.v75") 102 | gg_genetracks(loc) 103 | } 104 | } 105 | \seealso{ 106 | \code{\link[=locus_ggplot]{locus_ggplot()}} \code{\link[=genetracks_grob]{genetracks_grob()}} 107 | } 108 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # locuszoomr 2 | 3 | 4 | [![CRAN status](https://www.r-pkg.org/badges/version/locuszoomr)](https://CRAN.R-project.org/package=locuszoomr) 5 | [![Downloads](https://cranlogs.r-pkg.org/badges/locuszoomr)](https://CRAN.R-project.org/package=locuszoomr) 6 | 7 | 8 | This is a pure R implementation of locuszoom for plotting genetic data at 9 | genomic loci accompanied by gene annotations. Plots can be produced in base 10 | graphics, ggplot2 or plotly. Plots can be stacked or laid out with multiple 11 | plots per page, or the gene track can be plotted separately and added to your 12 | own plots. 13 | 14 | The LDlink API can be queried to obtain linkage disequilibrium data from 1000 15 | Genomes. Recombination rate can also be shown by querying UCSC genome browser. 16 | 17 | See the detailed vignette for code examples. 18 | 19 | # Installation 20 | 21 | Bioconductor package `ensembldb` and an Ensembl database installed either as a 22 | package or accessed through Bioconductor package `AnnotationHub` are required 23 | before installation. 24 | 25 | ``` 26 | if (!requireNamespace("BiocManager", quietly = TRUE)) 27 | install.packages("BiocManager") 28 | BiocManager::install("ensembldb") 29 | BiocManager::install("EnsDb.Hsapiens.v75") 30 | ``` 31 | 32 | Install from CRAN 33 | ``` 34 | install.packages("locuszoomr") 35 | ``` 36 | 37 | Install from Github 38 | ``` 39 | devtools::install_github("myles-lewis/locuszoomr") 40 | ``` 41 | 42 | `locuszoomr` can leverage the `LDlinkR` package to query the 1000 Genomes 43 | Project for linkage disequilibrium (LD) across SNPs. In order to make use of 44 | this API function you will need a personal access token, available from the 45 | [LDlink website](https://ldlink.nih.gov/?tab=apiaccess). 46 | 47 | We recommend that users who want to add recombination rate lines to multiple 48 | plots download the recombination rate track from UCSC and use it as described in 49 | the 'Add recombination rate' section in the vignette. 50 | 51 | # Example locus plot 52 | 53 | ``` 54 | # Locus plot using SLE GWAS data from Bentham et al 2015 55 | # Using subset of data embedded in the package 56 | library(locuszoomr) 57 | data(SLE_gwas_sub) 58 | 59 | library(EnsDb.Hsapiens.v75) 60 | loc <- locus(gene = 'UBE2L3', SLE_gwas_sub, flank = 1e5, 61 | ens_db = "EnsDb.Hsapiens.v75") 62 | summary(loc) 63 | locus_plot(loc) 64 | 65 | # Or FTP download the full summary statistics from 66 | # https://www.ebi.ac.uk/gwas/studies/GCST003156 67 | library(data.table) 68 | SLE_gwas <- fread('../bentham_2015_26502338_sle_efo0002690_1_gwas.sumstats.tsv') 69 | 70 | loc <- locus(gene = 'UBE2L3', SLE_gwas, flank = 1e5, 71 | ens_db = "EnsDb.Hsapiens.v75") 72 | locus_plot(loc) 73 | ``` 74 | 75 | # Example layered plot shown in the paper 76 | 77 | ``` 78 | library(locuszoomr) 79 | library(EnsDb.Hsapiens.v75) 80 | 81 | data(SLE_gwas_sub) 82 | loc <- locus(data = SLE_gwas_sub, gene = 'IRF5', flank = c(1e5, 2e5), 83 | ens_db = "EnsDb.Hsapiens.v75") 84 | 85 | # add recombination rate 86 | loc <- link_recomb(loc, genome = "hg19") 87 | 88 | # add LD and eQTL data 89 | # users must obtain an API token from https://ldlink.nih.gov/?tab=apiaccess 90 | loc <- link_LD(loc, token = "your_API_token") 91 | loc <- link_eqtl(loc, token = "your_API_token") 92 | 93 | # set up layered plot with 2 plots & a gene track 94 | pdf("locuszoomr_demo.pdf", width = 4.5, height = 7) 95 | oldpar <- set_layers(2) 96 | scatter_plot(loc, xticks = FALSE, labels = c("index", "rs113708239"), 97 | label_x = c(-4, 4)) 98 | eqtl_plot(loc, xlab = "") 99 | genetracks(loc, highlight = "IRF5") 100 | par(oldpar) 101 | dev.off() 102 | ``` 103 | 104 | # Citation 105 | 106 | If you use this package please cite as: 107 | 108 | Lewis MJ, Wang S. (2025) locuszoomr: an R package for visualising 109 | publication-ready regional gene locus plots. *Bioinformatics Advances* 2025; 110 | vbaf006, [doi:10.1093/bioadv/vbaf006](https://doi.org/10.1093/bioadv/vbaf006) 111 | -------------------------------------------------------------------------------- /R/link_LD.R: -------------------------------------------------------------------------------- 1 | 2 | #' Obtain LD at a locus from LDlink 3 | #' 4 | #' Adds LD information to a 'locus' class object. It queries LDlink 5 | #' (https://ldlink.nci.nih.gov/) via the `LDlinkR` package to retrieve linkage 6 | #' disequilibrium (LD) information on a reference SNP. 7 | #' 8 | #' @param loc Object of class 'locus' generated by [locus()] 9 | #' @param pop A 1000 Genomes Project population, (e.g. YRI or CEU), multiple 10 | #' allowed, default = "CEU". Passed to `LDlinkR::LDmatrix()`. 11 | #' @param r2d Either "r2" for LD r^2 or "d" for LD D', default = "r2". Passed 12 | #' to `LDlinkR::LDmatrix()` or `LDproxy()`. 13 | #' @param token Personal access token for accessing 1000 Genomes LD data via 14 | #' LDlink API. See `LDlinkR` package documentation. 15 | #' @param method Either `"proxy"` or `"matrix"`. Controls whether to use 16 | #' `LDproxy()` or `LDmatrix()` to obtain LD data. 17 | #' @param genome_build Choose between one of the three options: 'grch37' for 18 | #' genome build GRCh37 (hg19), 'grch38' for GRCh38 (hg38), or 19 | #' 'grch38_high_coverage' for GRCh38 High Coverage (hg38) 1000 Genome Project 20 | #' data sets. Default is GRCh37 (hg19). 21 | #' @param ... Optional arguments which are passed on to `LDlinkR::LDmatrix()` or 22 | #' `LDlinkR::LDproxy()` 23 | #' @return Returns a list object of class 'locus'. LD information is added as a 24 | #' column `ld` in list element `data`. 25 | #' @seealso [locus()] 26 | #' @details 27 | #' The argument `method` controls which LDlinkR function is used to retrieve LD 28 | #' data. `LDmatrix()` is slower but usually more complete for small queries 29 | #' (<1000 SNPs). However, it has a limit of 1000 SNPs which can be queried. 30 | #' `LDproxy()` is faster but data on some SNPs may be absent. 31 | #' 32 | #' Note, SNPs have to be correctly formatted as required by LDlinkR, either as 33 | #' rsID (works with either method) or chromosome coordinate e.g. "chr7:24966446" 34 | #' (works with LDproxy only). Default genome build is `grch37`, see `LDproxy()` 35 | #' or `LDmatrix()`. 36 | #' 37 | #' @importFrom LDlinkR LDmatrix LDexpress LDproxy 38 | #' @export 39 | 40 | link_LD <- function(loc, 41 | pop = "CEU", 42 | r2d = "r2", 43 | token = "", 44 | method = c("proxy", "matrix"), 45 | genome_build = loc$genome, ...) { 46 | if (!inherits(loc, "locus")) stop("Not a locus object") 47 | if (!requireNamespace("LDlinkR", quietly = TRUE)) { 48 | stop("Package 'LDlinkR' must be installed to use this feature", 49 | call. = FALSE) 50 | } 51 | if (token == "") stop("token is missing") 52 | 53 | start <- Sys.time() 54 | labs <- loc$labs 55 | index_snp <- loc$index_snp 56 | snp_col <- if (grepl("rs", index_snp)) "RS_Number" else "Coord" 57 | rslist <- loc$data[, labs] 58 | if (length(rslist) > 1000) { 59 | rslist <- rslist[order(loc$data$logP, decreasing = TRUE)] 60 | rslist <- unique(c(index_snp, rslist))[seq_len(1000)] 61 | } 62 | method <- match.arg(method) 63 | genome_build <- tolower(genome_build) 64 | if (!grepl(loc$genome, genome_build, ignore.case = TRUE)) { 65 | warning("mismatched genome build") 66 | } 67 | if (method == "proxy") { 68 | ldp <- try(mem_LDproxy(index_snp, pop = pop, r2d = r2d, token = token, 69 | genome_build = genome_build, ...)) 70 | if (!inherits(ldp, "try-error")) { 71 | loc$data$ld <- ldp[match(loc$data[, labs], ldp[, snp_col]), "R2"] 72 | } 73 | } else { 74 | message("Obtaining LD on ", length(rslist), " SNPs. ", appendLF = FALSE) 75 | ldm <- mem_LDmatrix(rslist, pop = pop, r2d = r2d, token = token, 76 | genome_build = genome_build, ...) 77 | if (index_snp %in% colnames(ldm)) { 78 | ld <- ldm[, index_snp] 79 | loc$data$ld <- ld[match(loc$data[, labs], ldm$RS_number)] 80 | } else message("Index SNP not found in LDlink data") 81 | } 82 | end <- Sys.time() 83 | m <- sum(!is.na(loc$data$ld)) 84 | message("Matched ", m, " SNPs (", format(end - start, digits = 3),")") 85 | 86 | loc 87 | } 88 | 89 | 90 | # use memoise to reduce calls to LDlink API 91 | mem_LDmatrix <- memoise(LDlinkR::LDmatrix) 92 | 93 | mem_LDproxy <- memoise(LDlinkR::LDproxy) 94 | 95 | -------------------------------------------------------------------------------- /R/link_recomb.R: -------------------------------------------------------------------------------- 1 | 2 | #' Query UCSC for Recombination data 3 | #' 4 | #' Adds recombination data to a 'locus' object by querying UCSC genome browser. 5 | #' 6 | #' @param loc Object of class 'locus' generated by [locus()] 7 | #' @param genome Either `"hg38"` or `"hg19"` 8 | #' @param table Optional character value specifying which recombination table to 9 | #' use. 10 | #' @param recomb Optional `GRanges` class object of recombination data. 11 | #' @details 12 | #' Uses the `rtracklayer` package to query UCSC genome browser for recombination 13 | #' rate data. 14 | #' 15 | #' Possible options for `table` for hg19 are `"hapMapRelease24YRIRecombMap"`, 16 | #' `"hapMapRelease24CEURecombMap"`, `"hapMapRelease24CombinedRecombMap"` (the 17 | #' default). The only option for `table` for hg38 is `"recomb1000GAvg"` (the 18 | #' default). 19 | #' 20 | #' If you are doing many queries, it may be much faster to download the entire 21 | #' recombination track data (around 30 MB for hg38) from the Recombination Rate 22 | #' Tracks page at 23 | #' [UCSC genome browser](https://genome.ucsc.edu/cgi-bin/hgTrackUi?g=recombRate2). 24 | #' The link to the hg38 download folder is 25 | #' and for hg19 is 26 | #' . These .bw files can be 27 | #' converted to useable `GRanges` objects using `rtracklayer::import.bw()` (see 28 | #' the vignette). 29 | #' 30 | #' Sometimes `rtracklayer` generates intermittent API errors or warnings: try 31 | #' calling `link_recomb()` again. If warnings persist restart your R session. 32 | #' Errors are handled gracefully using `try()` to allow users to wrap 33 | #' `link_recomb()` in a loop without quitting halfway. Error messages are still 34 | #' shown. Successful API calls are cached using `memoise` to reduce API 35 | #' requests. 36 | #' 37 | #' @returns A list object of class 'locus'. Recombination data is added as list 38 | #' element `recomb`. 39 | #' @importFrom GenomeInfoDb genome<- seqnames 40 | #' @importFrom GenomicRanges GRanges 41 | #' @importFrom IRanges IRanges 42 | #' @importFrom rtracklayer browserSession ucscTableQuery getTable 43 | #' @importFrom memoise drop_cache 44 | #' @export 45 | #' 46 | link_recomb <- function(loc, 47 | genome = loc$genome, 48 | table = NULL, 49 | recomb = NULL) { 50 | if (!inherits(loc, "locus")) stop("Not a locus object") 51 | if (!is.null(recomb)) { 52 | if (!inherits(recomb, "GRanges")) { 53 | warning("`recomb` is not a 'GRanges' class object") 54 | } 55 | seqname <- loc$seqname 56 | if (!grepl("chr", seqname)) seqname <- paste0("chr", seqname) 57 | rec <- recomb[seqnames(recomb) == seqname, ] 58 | rec <- rec[end(rec) > loc$xrange[1] & start(rec) < loc$xrange[2], ] 59 | rec <- as.data.frame(rec)[, c("start", "end", "score")] 60 | colnames(rec)[3] <- "value" 61 | loc$recomb <- rec 62 | return(loc) 63 | } 64 | genome <- switch(genome, "GRCh37" = "hg19", "GRCh38" = "hg38", genome) 65 | loc_genome <- switch(loc$genome, "GRCh37" = "hg19", "GRCh38" = "hg38", 66 | loc$genome) 67 | if (loc_genome != genome) warning("mismatched genome build") 68 | loc$recomb <- get_recomb(genome, loc$xrange, loc$seqname, table) 69 | loc 70 | } 71 | 72 | 73 | query_recomb <- function(gen, xrange, seqname, table = NULL) { 74 | if (is.null(table)) { 75 | table <- if (gen == "hg38") {"recomb1000GAvg" 76 | } else if (gen == "hg19") "hapMapRelease24CombinedRecombMap" 77 | } 78 | if (!grepl("chr", seqname)) seqname <- paste0("chr", seqname) 79 | gr <- GRanges(ranges = IRanges(start = xrange[1], end = xrange[2]), 80 | seqnames = seqname) 81 | message("Retrieving recombination data from UCSC") 82 | session <- browserSession("UCSC") 83 | genome(session) <- gen 84 | query <- ucscTableQuery(session, table = table, range = gr) 85 | gtab <- try(getTable(query)) 86 | if (inherits(gtab, "try-error")) return(NULL) 87 | gtab 88 | } 89 | 90 | # use memoise to reduce calls to UCSC API 91 | mem_query_recomb <- memoise(query_recomb) 92 | 93 | # drop memoise cache if error occurs 94 | get_recomb <- function(gen, xrange, seqname, table = NULL) { 95 | ret <- mem_query_recomb(gen, xrange, seqname, table) 96 | if (is.null(ret)) drop_cache(mem_query_recomb)(gen, xrange, seqname, table) 97 | ret 98 | } 99 | -------------------------------------------------------------------------------- /man/genetracks.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/genetracks.R 3 | \name{genetracks} 4 | \alias{genetracks} 5 | \title{Plot gene tracks} 6 | \usage{ 7 | genetracks( 8 | locus, 9 | filter_gene_name = NULL, 10 | filter_gene_biotype = NULL, 11 | border = FALSE, 12 | cex.axis = 0.9, 13 | cex.lab = 1, 14 | cex.text = 0.7, 15 | gene_col = ifelse(showExons, "blue4", "skyblue"), 16 | exon_col = "blue4", 17 | exon_border = "blue4", 18 | showExons = TRUE, 19 | maxrows = NULL, 20 | text_pos = "top", 21 | italics = FALSE, 22 | xticks = TRUE, 23 | xlab = NULL, 24 | highlight = NULL, 25 | highlight_col = "red", 26 | blanks = c("fill", "hide"), 27 | showRecomb = TRUE, 28 | align = TRUE 29 | ) 30 | } 31 | \arguments{ 32 | \item{locus}{Object of class 'locus' generated by \code{\link[=locus]{locus()}}.} 33 | 34 | \item{filter_gene_name}{Vector of gene names to display.} 35 | 36 | \item{filter_gene_biotype}{Vector of gene biotypes to be filtered. Use 37 | \code{\link[ensembldb:EnsDb-class]{ensembldb::listGenebiotypes()}} to display possible biotypes. For example, 38 | \code{ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)}} 39 | 40 | \item{border}{Logical whether a bounding box is plotted.} 41 | 42 | \item{cex.axis}{Specifies font size for axis numbering.} 43 | 44 | \item{cex.lab}{Specifies font size for axis titles.} 45 | 46 | \item{cex.text}{Font size for gene text.} 47 | 48 | \item{gene_col}{Colour for gene lines.} 49 | 50 | \item{exon_col}{Fill colour for exons.} 51 | 52 | \item{exon_border}{Border line colour outlining exons (or genes if 53 | \code{showExons} is \code{FALSE}). Set to \code{NA} for no border.} 54 | 55 | \item{showExons}{Logical whether to show exons or simply show whole gene as a 56 | rectangle. If \code{showExons = FALSE} colours are specified by \code{exon_border} 57 | for rectangle border and \code{gene_col} for the fill colour.} 58 | 59 | \item{maxrows}{Specifies maximum number of rows to display in gene 60 | annotation panel.} 61 | 62 | \item{text_pos}{Character value of either 'top' or 'left' specifying 63 | placement of gene name labels.} 64 | 65 | \item{italics}{Logical whether gene text is in italics.} 66 | 67 | \item{xticks}{Logical whether x axis ticks and numbers are plotted.} 68 | 69 | \item{xlab}{Title for x axis. Defaults to chromosome \code{seqname} specified 70 | in \code{locus}.} 71 | 72 | \item{highlight}{Vector of genes to highlight.} 73 | 74 | \item{highlight_col}{Single colour or vector of colours for highlighted 75 | genes.} 76 | 77 | \item{blanks}{Controls handling of genes with blank names: \code{"fill"} replaces 78 | blank gene symbols with ensembl gene ids. \code{"hide"} hides genes which are 79 | missing gene symbols.} 80 | 81 | \item{showRecomb}{Logical controls alignment of right margin if 82 | recombination data present.} 83 | 84 | \item{align}{Logical whether to set \code{\link[=par]{par()}} to align the plot.} 85 | } 86 | \value{ 87 | No return value. 88 | } 89 | \description{ 90 | Plot gene annotation tracks from \code{ensembldb} data. 91 | } 92 | \details{ 93 | This function is called by \code{\link[=locus_plot]{locus_plot()}}. It can be used to plot the gene 94 | annotation tracks on their own. It uses base graphics, so \code{\link[=layout]{layout()}} can be 95 | used to position adjacent plots above or below. 96 | 97 | \code{gene_col}, \code{exon_col} and \code{exon_border} set colours for all genes, while 98 | \code{highlight} and \code{highlight_col} can optionally be used together to highlight 99 | specific genes of interest. For full control over every single gene, users 100 | can add columns \code{gene_col}, \code{exon_col} and \code{exon_border} to the \code{TX} object 101 | within the 'locus' object. Columns added to \code{TX} override their equivalent 102 | arguments. 103 | } 104 | \examples{ 105 | if(require(EnsDb.Hsapiens.v75)) { 106 | data(SLE_gwas_sub) 107 | loc <- locus(SLE_gwas_sub, gene = 'UBE2L3', flank = 1e5, 108 | ens_db = "EnsDb.Hsapiens.v75") 109 | genetracks(loc) 110 | 111 | ## Limit the number of tracks 112 | genetracks(loc, maxrows = 4) 113 | 114 | ## Filter by gene biotype 115 | genetracks(loc, filter_gene_biotype = 'protein_coding') 116 | 117 | ## Customise colours 118 | genetracks(loc, gene_col = 'grey', exon_col = 'orange', 119 | exon_border = 'darkgrey') 120 | } 121 | } 122 | -------------------------------------------------------------------------------- /R/overlay_plot.R: -------------------------------------------------------------------------------- 1 | 2 | #' Plot overlaying eQTL and GWAS data 3 | #' 4 | #' Experimental plotting function for overlaying eQTL data from GTEx on top of 5 | #' GWAS results. y axis shows the -log10 p-value for the GWAS result. 6 | #' Significant eQTL for the specified gene are overlaid using colours and 7 | #' symbols. 8 | #' 9 | #' @param loc Object of class 'locus' to use for plot. See [locus()]. 10 | #' @param base_col Colour of points for SNPs which do not have eQTLs. 11 | #' @param alpha Alpha opacity for non-eQTL points 12 | #' @param scheme Character string specifying palette for effect size showing 13 | #' up/downregulation eQTL using [grDevices::hcl.colors]. Alternatively a 14 | #' vector of 6 colours. 15 | #' @param tissue GTex tissue in which eQTL has been measured 16 | #' @param eqtl_gene Gene showing eQTL effect 17 | #' @param legend_pos Character value specifying legend position. See [legend()]. 18 | #' @param ... Other arguments passed to [locus_plot()] for the locus plot. 19 | #' @return No return value. Produces a plot using base graphics. 20 | #' 21 | #' @importFrom grDevices adjustcolor hcl.colors 22 | #' @export 23 | 24 | overlay_plot <- function(loc, 25 | base_col = 'black', 26 | alpha = 0.5, 27 | scheme = "RdYlBu", 28 | tissue = "Whole Blood", 29 | eqtl_gene = loc$gene, 30 | legend_pos = "topright", 31 | ...) { 32 | if (!inherits(loc, "locus")) stop("Object of class 'locus' required") 33 | if (!"LDexp" %in% names(loc)) stop("Missing eQTL data") 34 | if (is.null(eqtl_gene)) stop("eqtl_gene not specified") 35 | 36 | loc$data$bg <- adjustcolor(base_col, alpha.f = alpha) 37 | loc$data$pch <- 21 38 | # loc$data$col <- NA 39 | 40 | LDX <- loc$LDexp[loc$LDexp$Tissue == tissue & loc$LDexp$Gene_Symbol == eqtl_gene, ] 41 | # match by rsid 42 | ind <- match(loc$data[, loc$labs], LDX$RS_ID) 43 | message(sum(!is.na(ind)), "/", nrow(LDX), " matched eQTL SNPs (total ", 44 | nrow(loc$data), ")") 45 | 46 | if (all(is.na(ind))) { 47 | message("No significant eQTL") 48 | } else { 49 | loc$data$eqtl_effect <- NA 50 | loc$data$eqtl_effect <- LDX$Effect_Size[ind] 51 | loc$data$eqtl_p <- LDX$P_value[ind] 52 | loc$data$eqtl_effect_allele <- LDX$Effect_Allele[ind] 53 | # gwas allele and eqtl effect allele are the same 54 | mismatch <- which(loc$data$eqtl_effect_allele != loc$data$effect_allele) 55 | which_rev <- loc$data$other_allele[mismatch] == loc$data$eqtl_effect_allele[mismatch] 56 | rev_effect <- mismatch[which_rev] 57 | mismatch <- mismatch[!which_rev] 58 | loc$data$eqtl_effect[rev_effect] <- -loc$data$eqtl_effect[rev_effect] 59 | loc$data$eqtl_effect[mismatch] <- NA 60 | if (length(scheme) == 1) { 61 | scheme <- hcl.colors(9, scheme)[-c(4:6)] 62 | } 63 | up_cols <- rev(scheme[1:3]) 64 | down_cols <- scheme[4:6] 65 | ecol <- cut(abs(loc$data$eqtl_effect), breaks = 3) 66 | eqind <- !is.na(loc$data$eqtl_effect) 67 | eqdown <- eqind & sign(loc$data$eqtl_effect) == -1 68 | equp <- eqind & sign(loc$data$eqtl_effect) == 1 69 | loc$data$bg[equp] <- up_cols[ecol[equp]] 70 | loc$data$bg[eqdown] <- down_cols[ecol[eqdown]] 71 | loc$data$pch[eqind] <- 24.5 - sign(loc$data$eqtl_effect[eqind]) / 2 72 | # loc$data$col[eqind] <- "black" 73 | loc$data <- loc$data[order(loc$data$pch), ] 74 | pcex <- rep_len(0.9, nrow(loc$data)) 75 | pcex[loc$data$pch != 21] <- 1.1 76 | labs <- levels(ecol) 77 | cutlev <- cbind(lower = as.numeric( sub("\\((.+),.*", "\\1", labs) ), 78 | upper = as.numeric( sub("[^,]*,([^]]*)\\]", "\\1", labs) )) 79 | cutlev <- signif(cutlev, 2) 80 | } 81 | 82 | if (!is.null(legend_pos)) { 83 | legtext <- c(rev(paste(cutlev[,1], cutlev[,2], sep=" : ")), 84 | paste(-cutlev[,2], -cutlev[,1], sep=" : ")) 85 | legendFUN <- substitute(legend(lpos, 86 | legend = legtext, 87 | pch = rep(c(24, 25), each=3), 88 | pt.bg = cols, col = NA, 89 | title = "eQTL effect", 90 | bty = "n", cex = 0.85, pt.cex = 1, 91 | y.intersp = 0.96), 92 | list(lpos = legend_pos, legtext = legtext, 93 | cols = c(rev(up_cols), down_cols))) 94 | } else legendFUN <- NULL 95 | 96 | locus_plot(loc, cex = pcex, col = NA, showLD = FALSE, 97 | panel.last = legendFUN, ...) 98 | } 99 | -------------------------------------------------------------------------------- /R/locus_ggplot.R: -------------------------------------------------------------------------------- 1 | 2 | #' Locus plot using ggplot2 3 | #' 4 | #' Genomic locus plot similar to locuszoom. 5 | #' 6 | #' Arguments to control plotting of the gene tracks are passed onto 7 | #' [gg_genetracks()] and for the scatter plot are passed via `...` to 8 | #' [gg_scatter()]. See the documentation for each of these functions for 9 | #' details. 10 | #' 11 | #' @param loc Object of class 'locus' to use for plot. See [locus()]. 12 | #' @param heights Vector supplying the ratio of top to bottom plot. 13 | #' @param filter_gene_name Vector of gene names to display. 14 | #' @param filter_gene_biotype Vector of gene biotypes to be filtered. Use 15 | #' [ensembldb::listGenebiotypes()] to display possible biotypes. For example, 16 | #' `ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)` 17 | #' @param border Logical whether a bounding box is plotted. 18 | #' @param cex.axis Specifies font size for axis numbering. 19 | #' @param cex.lab Specifies font size for axis titles. 20 | #' @param cex.text Font size for gene text. 21 | #' @param gene_col Colour for gene lines. 22 | #' @param exon_col Fill colour for exons. 23 | #' @param exon_border Border line colour outlining exons (or genes if 24 | #' `showExons` is `FALSE`). Set to `NA` for no border. 25 | #' @param showExons Logical whether to show exons or simply show whole gene as a 26 | #' rectangle. If `showExons = FALSE` colours are specified by `exon_border` 27 | #' for rectangle border and `gene_col` for the fill colour. 28 | #' @param maxrows Specifies maximum number of rows to display in gene annotation 29 | #' panel. 30 | #' @param text_pos Character value of either 'top' or 'left' specifying 31 | #' placement of gene name labels. 32 | #' @param italics Logical whether gene text is in italics. 33 | #' @param xticks Logical whether x axis ticks and numbers are plotted. 34 | #' @param xlab Title for x axis. Defaults to chromosome `seqname` specified in 35 | #' `locus`. 36 | #' @param highlight Vector of genes to highlight. 37 | #' @param highlight_col Single colour or vector of colours for highlighted 38 | #' genes. 39 | #' @param blanks Controls handling of genes with blank names: `"fill"` replaces 40 | #' blank gene symbols with ensembl gene ids. `"hide"` hides genes which are 41 | #' missing gene symbols. 42 | #' @param ... Additional arguments passed to [gg_scatter()] to control 43 | #' the scatter plot, e.g. `pcutoff`, `scheme`, `recomb_offset` etc. 44 | #' @return Returns a ggplot2 plot containing a scatter plot with genetracks 45 | #' underneath. 46 | #' @seealso [gg_scatter()] [gg_genetracks()] 47 | #' @examples 48 | #' if(require(EnsDb.Hsapiens.v75)) { 49 | #' data(SLE_gwas_sub) 50 | #' loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 51 | #' ens_db = "EnsDb.Hsapiens.v75") 52 | #' locus_ggplot(loc) 53 | #' } 54 | #' @importFrom cowplot plot_grid 55 | #' @export 56 | 57 | locus_ggplot <- function(loc, heights = c(3, 2), 58 | filter_gene_name = NULL, 59 | filter_gene_biotype = NULL, 60 | border = FALSE, 61 | cex.axis = 1, 62 | cex.lab = 1, 63 | cex.text = 0.7, 64 | gene_col = ifelse(showExons, 'blue4', 'skyblue'), 65 | exon_col = 'blue4', 66 | exon_border = 'blue4', 67 | showExons = TRUE, 68 | maxrows = 12, 69 | text_pos = 'top', 70 | italics = FALSE, 71 | xticks = "top", 72 | xlab = NULL, 73 | highlight = NULL, 74 | highlight_col = "red", 75 | blanks = "fill", 76 | ...) { 77 | if (!inherits(loc, "locus")) stop("Object of class 'locus' required") 78 | if (is.null(loc$data)) stop("No SNPs/data points") 79 | p <- gg_scatter(loc, 80 | cex.axis = cex.axis, 81 | cex.lab = cex.lab, 82 | xlab = xlab, 83 | xticks = (xticks == "top"), 84 | border = border, ...) 85 | g <- gg_genetracks(loc, 86 | filter_gene_name, filter_gene_biotype, 87 | border, 88 | cex.axis, cex.lab, cex.text, 89 | gene_col, exon_col, exon_border, 90 | showExons, 91 | maxrows, text_pos, italics, 92 | xticks = (xticks != "top"), xlab, 93 | highlight, highlight_col, 94 | blanks) 95 | 96 | plot_grid(p, g, nrow = 2, rel_heights = heights, align = "v") 97 | } 98 | -------------------------------------------------------------------------------- /man/gg_scatter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gg_scatter.R 3 | \name{gg_scatter} 4 | \alias{gg_scatter} 5 | \title{Locus scatter plot using ggplot2} 6 | \usage{ 7 | gg_scatter( 8 | loc, 9 | index_snp = loc$index_snp, 10 | pcutoff = 5e-08, 11 | scheme = c("grey", "dodgerblue", "red"), 12 | size = 2, 13 | cex.axis = 1, 14 | cex.lab = 1, 15 | xlab = NULL, 16 | ylab = NULL, 17 | ylim = NULL, 18 | ylim2 = c(0, 100), 19 | yzero = (loc$yvar == "logP"), 20 | xticks = TRUE, 21 | border = FALSE, 22 | showLD = TRUE, 23 | LD_scheme = c("grey", "royalblue", "cyan2", "green3", "orange", "red", "purple"), 24 | recomb_col = "blue", 25 | recomb_offset = 0, 26 | legend_pos = "topleft", 27 | labels = NULL, 28 | eqtl_gene = NULL, 29 | beta = NULL, 30 | shape = NULL, 31 | shape_values = c(21, 24, 25), 32 | ... 33 | ) 34 | } 35 | \arguments{ 36 | \item{loc}{Object of class 'locus' to use for plot. See \link{locus}.} 37 | 38 | \item{index_snp}{Specifies index SNP to be shown in a different colour and 39 | symbol. Defaults to the SNP with the lowest p-value. Set to \code{NULL} to not 40 | show this.} 41 | 42 | \item{pcutoff}{Cut-off for p value significance. Defaults to p = 5e-08. Set 43 | to \code{NULL} to disable.} 44 | 45 | \item{scheme}{Vector of 3 colours if LD is not shown: 1st = normal points, 46 | 2nd = colour for significant points, 3rd = index SNP.} 47 | 48 | \item{size}{Specifies size for points.} 49 | 50 | \item{cex.axis}{Specifies font size for axis numbering.} 51 | 52 | \item{cex.lab}{Specifies font size for axis titles.} 53 | 54 | \item{xlab}{x axis title.} 55 | 56 | \item{ylab}{y axis title.} 57 | 58 | \item{ylim}{y axis limits (y1, y2).} 59 | 60 | \item{ylim2}{Secondary y axis limits for recombination line.} 61 | 62 | \item{yzero}{Logical whether to force y axis limit to include y=0.} 63 | 64 | \item{xticks}{Logical whether x axis numbers and axis title are plotted.} 65 | 66 | \item{border}{Logical whether a bounding box is plotted around the plot.} 67 | 68 | \item{showLD}{Logical whether to show LD with colours} 69 | 70 | \item{LD_scheme}{Vector of colours for plotting LD. The first colour is for SNPs 71 | which lack LD information. The next 5 colours are for r2 or D' LD results 72 | ranging from 0 to 1 in intervals of 0.2. The final colour is for the index 73 | SNP.} 74 | 75 | \item{recomb_col}{Colour for recombination rate line if recombination rate 76 | data is present. Set to NA to hide the line. See \code{\link[=link_recomb]{link_recomb()}} to add 77 | recombination rate data.} 78 | 79 | \item{recomb_offset}{Offset from 0-1 which shifts the scatter plot up and 80 | recombination line plot down. Recommended value 0.1.} 81 | 82 | \item{legend_pos}{Position of legend. Set to \code{NULL} to hide legend.} 83 | 84 | \item{labels}{Character vector of SNP or genomic feature IDs to label. The 85 | value "index" selects the highest point or index SNP as defined when 86 | \code{\link[=locus]{locus()}} is called. Set to \code{NULL} to remove all labels.} 87 | 88 | \item{eqtl_gene}{Optional column name in \code{loc$data} for colouring eQTL genes.} 89 | 90 | \item{beta}{Optional column name for beta coefficient to display upward 91 | triangles for positive beta and downward triangles for negative beta 92 | (significant SNPs only).} 93 | 94 | \item{shape}{Optional column name in \code{loc$data} for controlling shapes. 95 | \code{beta} and \code{shape} cannot both be set. This column is expected to be a factor.} 96 | 97 | \item{shape_values}{Vector of shape values which match levels of the column 98 | specified by \code{shape}. This vector is passed to 99 | \code{ggplot2::scale_shape_manual()} as the argument \code{values}. See \code{\link[=points]{points()}} 100 | for a list of shapes and the numbers they map to.} 101 | 102 | \item{...}{Optional arguments passed to \code{geom_text_repel()} to configure 103 | label drawing.} 104 | } 105 | \value{ 106 | Returns a ggplot2 plot. 107 | } 108 | \description{ 109 | Produces a scatter plot from a 'locus' class object (without gene tracks). 110 | } 111 | \details{ 112 | If recombination rate data is included in the locus object following a call 113 | to \code{\link[=link_recomb]{link_recomb()}}, this is plotted as an additional line with a secondary y 114 | axis. In the base graphics version the line is placed under the scatter 115 | points, but this is not possible with ggplot2 as the secondary y axis data 116 | must be plotted on top of the primary scatter point data. 117 | } 118 | \examples{ 119 | if(require(EnsDb.Hsapiens.v75)) { 120 | data(SLE_gwas_sub) 121 | loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 122 | ens_db = "EnsDb.Hsapiens.v75") 123 | gg_scatter(loc) 124 | } 125 | } 126 | \seealso{ 127 | \code{\link[=locus]{locus()}} \code{\link[=gg_addgenes]{gg_addgenes()}} 128 | } 129 | -------------------------------------------------------------------------------- /man/scatter_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scatter_plot.R 3 | \name{scatter_plot} 4 | \alias{scatter_plot} 5 | \title{Locus scatter plot} 6 | \usage{ 7 | scatter_plot( 8 | loc, 9 | index_snp = loc$index_snp, 10 | pcutoff = 5e-08, 11 | scheme = c("grey", "dodgerblue", "red"), 12 | cex = 1, 13 | cex.axis = 0.9, 14 | cex.lab = 1, 15 | xlab = NULL, 16 | ylab = NULL, 17 | ylim = NULL, 18 | ylim2 = c(0, 100), 19 | yzero = (loc$yvar == "logP"), 20 | xticks = TRUE, 21 | border = FALSE, 22 | showLD = TRUE, 23 | LD_scheme = c("grey", "royalblue", "cyan2", "green3", "orange", "red", "purple"), 24 | recomb_col = "blue", 25 | recomb_offset = 0, 26 | legend_pos = "topleft", 27 | labels = NULL, 28 | label_x = 4, 29 | label_y = 4, 30 | eqtl_gene = NULL, 31 | beta = NULL, 32 | add = FALSE, 33 | align = TRUE, 34 | ... 35 | ) 36 | } 37 | \arguments{ 38 | \item{loc}{Object of class 'locus' to use for plot. See \link{locus}.} 39 | 40 | \item{index_snp}{Specifies index SNP or a vector of SNPs to be shown in a 41 | different colour and symbol. Defaults to the SNP with the lowest p-value. 42 | Set to \code{NULL} to not show this.} 43 | 44 | \item{pcutoff}{Cut-off for p value significance. Defaults to p = 5e-08. Set 45 | to \code{NULL} to disable.} 46 | 47 | \item{scheme}{Vector of 3 colours if LD is not shown: 1st = normal points, 48 | 2nd = colour for significant points, 3rd = index SNP(s).} 49 | 50 | \item{cex}{Specifies size for points.} 51 | 52 | \item{cex.axis}{Specifies font size for axis numbering.} 53 | 54 | \item{cex.lab}{Specifies font size for axis titles.} 55 | 56 | \item{xlab}{x axis title.} 57 | 58 | \item{ylab}{y axis title.} 59 | 60 | \item{ylim}{y axis limits (y1, y2).} 61 | 62 | \item{ylim2}{Secondary y axis limits for recombination line, if present.} 63 | 64 | \item{yzero}{Logical whether to force y axis limit to include y=0.} 65 | 66 | \item{xticks}{Logical whether x axis numbers and axis title are plotted.} 67 | 68 | \item{border}{Logical whether a bounding box is plotted around upper and 69 | lower plots.} 70 | 71 | \item{showLD}{Logical whether to show LD with colours} 72 | 73 | \item{LD_scheme}{Vector of colours for plotting LD. The first colour is for 74 | SNPs which lack LD information. The next 5 colours are for r2 or D' LD 75 | results ranging from 0 to 1 in intervals of 0.2. The final colour is for 76 | the index SNP.} 77 | 78 | \item{recomb_col}{Colour for recombination rate line if recombination rate 79 | data is present. Set to \code{NA} to hide the line. See \code{\link[=link_recomb]{link_recomb()}} to add 80 | recombination rate data.} 81 | 82 | \item{recomb_offset}{Offset from 0-1 which shifts the scatter plot up and 83 | recombination line plot down. Recommended value 0.1.} 84 | 85 | \item{legend_pos}{Position of legend. See \code{\link[=legend]{legend()}}. Set to \code{NULL} to hide 86 | legend.} 87 | 88 | \item{labels}{Character vector of SNP or genomic feature IDs to label. The 89 | value "index" selects the highest point or index SNP as defined when 90 | \code{\link[=locus]{locus()}} is called. Set to \code{NULL} to remove all labels.} 91 | 92 | \item{label_x}{Value or vector for position of label as percentage of x axis 93 | scale.} 94 | 95 | \item{label_y}{Value or vector for position of label as percentage of y axis 96 | scale.} 97 | 98 | \item{eqtl_gene}{Column name in \code{loc$data} for colouring eQTL genes.} 99 | 100 | \item{beta}{Optional column name for beta coefficient to display upward 101 | triangles for positive beta and downward triangles for negative beta 102 | (significant SNPs only).} 103 | 104 | \item{add}{Logical whether to add points to an existing plot or generate a 105 | new plot.} 106 | 107 | \item{align}{Logical whether to set \code{\link[=par]{par()}} to align the plot.} 108 | 109 | \item{...}{Other arguments passed to \code{\link[=plot]{plot()}} to control the scatter plot 110 | e.g. \code{main}, \code{ylim} etc.} 111 | } 112 | \value{ 113 | No return value. Produces a scatter plot using base graphics. 114 | } 115 | \description{ 116 | Produces a base graphics scatter plot from a 'locus' class object. This 117 | function is called by \code{\link[=locus_plot]{locus_plot()}} to generate the scatter plot portion. 118 | Can be used manually with \code{\link[=set_layers]{set_layers()}}. 119 | } 120 | \details{ 121 | Advanced users familiar with base graphics can customise every single point 122 | on the scatter plot, by adding columns named \code{bg}, \code{col}, \code{pch} or \code{cex} 123 | directly to the dataframe stored in \verb{$data} element of the 'locus' object. 124 | Setting these will overrule any default settings. These columns refer to 125 | their respective base graphics arguments, see \code{\link[graphics:points]{graphics::points()}}. 126 | } 127 | \seealso{ 128 | \code{\link[=locus]{locus()}} \code{\link[=set_layers]{set_layers()}} 129 | } 130 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | News 2 | ===== 3 | 4 | # locuszoomr 0.3.8 5 | ###### 26/02/2025 6 | * Fixed handling of tibbles. 7 | 8 | # locuszoomr 0.3.7 9 | ###### 05/02/2025 10 | 11 | ### New features 12 | * Added `recomb_offset` argument to enable y offset to shift scatter points up 13 | slightly away from the recombination line to reduce the overlap. Works with both 14 | `locus_plot()` and `locus_ggplot()`. 15 | * Added `ylim` and `ylim2` arguments to `scatter_plot()` and `gg_scatter()` to 16 | make it easier to set y axis and secondary y axis (recombination line) limits in 17 | `locus_plot()` and `locus_ggplot()`. 18 | 19 | ### Important change 20 | * Changed the order of `data` and `gene` arguments in `locus()` since most users 21 | specify the data object first. 22 | 23 | ### Fixes 24 | * Fixed `ylim` issue affecting secondary y axis with recombination line. 25 | 26 | # locuszoomr 0.3.6 27 | ###### 09/01/2025 28 | * Add option to show gene names in italics. 29 | * Added citation. 30 | 31 | # locuszoomr 0.3.5 32 | ###### 15/09/2024 33 | * Fixed vignette issues causing CRAN check errors. 34 | 35 | # locuszoomr 0.3.4 36 | ###### 06/09/2024 37 | 38 | ### New features 39 | * Added full support for point shapes in `gg_scatter()`. 40 | 41 | ### Fixes 42 | * Fix for alignment of `eqtl_plot()` with locus plots with recombination rate. 43 | * Bugfix for recombination rate axis title font size. 44 | * Bugfix beta symbols in `gg_scatter()`. 45 | * Fixes to legends in `gg_scatter()`. 46 | 47 | # locuszoomr 0.3.2 48 | ###### 18/08/2024 49 | 50 | * Fix for SNPs with chromosome coordinate format in `link_LD()` (only works with 51 | `LDproxy` method). 52 | * Fix for non-human ensembl databases e.g. mouse in `locus()`. 53 | * Record ensembl version, organism and genome in locus objects. 54 | * Bugfix: give an error message if gene is not found in ensembl database in 55 | `locus()`. 56 | 57 | # locuszoomr 0.3.1 58 | ###### 28/06/2024 59 | 60 | * Add toggle for using webGL in `scatter_plotly()`. 61 | * Add height control in plotly functions. 62 | 63 | # locuszoomr 0.3.0 64 | ###### 16/04/2024 65 | 66 | * Allow `index_snp` to be a vector to highlight more than 1 SNP per region 67 | (suggested by Luke Pilling). 68 | * Altered default colour scheme. 69 | * Multiple improvements to plotly version. 70 | * Added option to use the much faster `LDproxy` in `link_LD()`. This is now the 71 | default option. 72 | * Added support for plotting loci with eQTL data to show multiple genes in 73 | different colours. 74 | * Added ability to overlay up/down pointing triangles to show sign of beta 75 | coefficient for significant SNPs. 76 | * Added highlighting of selected genes with individual colours in the gene 77 | tracks in `locus_plot()`, `locus_ggplot()`, `genetracks()` and 78 | `gg_genetracks()`. 79 | * Enable use of downloadable recombination rate track files from UCSC in 80 | `link_recomb()`, which is much faster when plotting multiple loci. 81 | 82 | # locuszoomr 0.2.1 83 | ###### 17/02/2024 84 | 85 | * Added labels to `locus_ggplot()` and `gg_scatter()` (thanks to Tom Willis). 86 | * Improved error handling in `link_recomb()` 87 | * Ensure index SNP is plotted on top in `locus_plot()` and `locus_ggplot()`. 88 | * In `scatter_plot()` arguments `chromCol` and `sigCol` are replaced by `scheme` 89 | which now allows setting of the index SNP colour. 90 | 91 | # locuszoomr 0.2.0 92 | ###### 21/12/2023 93 | 94 | ### New features 95 | * Improved ggplot2 gene track plotting via `gg_genetracks()` to enable easy 96 | layering of several ggplot2 plots above a row of gene tracks (thanks to nickhir 97 | for the suggestion). 98 | * For those that only want the gene tracks for their own plots, this is now 99 | easier by simply not specifying `data` (or setting it to `NULL`) when calling 100 | `locus()`. 101 | * Added function `quick_peak()` for quickly finding peaks in GWAS datasets. 102 | * Added function `link_recomb()` for retrieving recombination data from UCSC. 103 | * Recombination rate is shown on a secondary y axis by `locus_plot()` and 104 | `locus_ggplot()`. 105 | * Added `...` to `link_LD()` and `link_eqtl()` to allow passing of additional 106 | arguments such as `genome_build` to `LDlinkR` queries. 107 | 108 | ### Changes 109 | * Argument `LDtoken` in `link_LD()` and `link_eqtl()` has been renamed `token` 110 | to be consistent with `LDlinkR`. 111 | 112 | ### Bugfixes 113 | * Fixed bug when plotting LD with absent levels in `locus_ggplot()` and 114 | `locus_plotly()`. 115 | * Fixed plots with no gene tracks (thanks to Tom Willis). 116 | * Genes with missing gene symbols now display the ensembl gene ID. 117 | 118 | # locuszoomr 0.1.3 119 | ###### 03/11/2023 120 | 121 | * Added arrows to the gene tracks in `locus_plotly()` 122 | * Fixed bug relating `yzero` argument in scatter plots 123 | * Improved labelling 124 | * Fixed CRAN ERROR relating to package EnsDb.Hsapiens.v75 in Suggests 125 | 126 | # locuszoomr 0.1.2 127 | ###### 02/11/2023 128 | 129 | * This is the initial build of locuszoomr 130 | -------------------------------------------------------------------------------- /man/locus_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/locus_plot.R 3 | \name{locus_plot} 4 | \alias{locus_plot} 5 | \title{Locus plot} 6 | \usage{ 7 | locus_plot( 8 | loc, 9 | filter_gene_name = NULL, 10 | filter_gene_biotype = NULL, 11 | xlab = NULL, 12 | cex = 1, 13 | cex.axis = 0.9, 14 | cex.lab = 1, 15 | cex.text = 0.7, 16 | use_layout = TRUE, 17 | heights = c(3, 2), 18 | showExons = TRUE, 19 | maxrows = 7, 20 | xticks = "bottom", 21 | border = FALSE, 22 | gene_col = ifelse(showExons, "blue4", "skyblue"), 23 | exon_col = "blue4", 24 | exon_border = "blue4", 25 | text_pos = "top", 26 | italics = FALSE, 27 | highlight = NULL, 28 | highlight_col = "red", 29 | blanks = "fill", 30 | recomb_col = "blue", 31 | ... 32 | ) 33 | } 34 | \arguments{ 35 | \item{loc}{Object of class 'locus' to use for plot. See \code{\link[=locus]{locus()}}.} 36 | 37 | \item{filter_gene_name}{Vector of gene names to display.} 38 | 39 | \item{filter_gene_biotype}{Vector of gene biotypes to be filtered. Use 40 | \code{\link[ensembldb:EnsDb-class]{ensembldb::listGenebiotypes()}} to display possible biotypes. For example, 41 | \code{ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)}} 42 | 43 | \item{xlab}{x axis title.} 44 | 45 | \item{cex}{Specifies size for points.} 46 | 47 | \item{cex.axis}{Specifies font size for axis numbering.} 48 | 49 | \item{cex.lab}{Specifies font size for axis titles.} 50 | 51 | \item{cex.text}{Font size for gene text.} 52 | 53 | \item{use_layout}{Logical whether \code{graphics::layout} is called. Default 54 | \code{TRUE} is for a standard single plot. Set to \code{FALSE} if a more complex 55 | layout with multiple plots is required e.g. using \code{\link[=multi_layout]{multi_layout()}}.} 56 | 57 | \item{heights}{Ratio of top to bottom plot. See \link{layout}.} 58 | 59 | \item{showExons}{Logical whether to show exons or simply show whole gene as a 60 | rectangle} 61 | 62 | \item{maxrows}{Specifies maximum number of rows to display in gene 63 | annotation panel.} 64 | 65 | \item{xticks}{Character value of either 'top' or 'bottom' specifying 66 | whether x axis ticks and numbers are plotted on top or bottom plot window.} 67 | 68 | \item{border}{Logical whether a bounding box is plotted around upper and 69 | lower plots.} 70 | 71 | \item{gene_col}{Colour for gene lines.} 72 | 73 | \item{exon_col}{Fill colour for exons.} 74 | 75 | \item{exon_border}{Border line colour outlining exons (or genes if 76 | \code{showExons} is \code{FALSE}). Set to \code{NA} for no border.} 77 | 78 | \item{text_pos}{Character value of either 'top' or 'left' specifying 79 | placement of gene name labels.} 80 | 81 | \item{italics}{Logical whether gene text is in italics.} 82 | 83 | \item{highlight}{Vector of genes to highlight.} 84 | 85 | \item{highlight_col}{Single colour or vector of colours for highlighted 86 | genes.} 87 | 88 | \item{blanks}{Controls handling of genes with blank names: \code{"fill"} replaces 89 | blank gene symbols with ensembl gene ids. \code{"hide"} hides genes which are 90 | missing gene symbols.} 91 | 92 | \item{recomb_col}{Colour for recombination rate line if recombination rate 93 | data is present. Set to \code{NA} to hide the line. See \code{\link[=link_recomb]{link_recomb()}} to add 94 | recombination rate data.} 95 | 96 | \item{...}{Other arguments passed to \code{\link[=scatter_plot]{scatter_plot()}} e.g. \code{index_snp}, 97 | \code{pcutoff}, \code{scheme}, \code{recomb_offset}, etc, and arguments for \code{\link[=plot]{plot()}} e.g. 98 | \code{ylab}, \code{main}, etc to control the scatter plot.} 99 | } 100 | \value{ 101 | No return value. 102 | } 103 | \description{ 104 | Genomic locus plot similar to locuszoom. 105 | } 106 | \details{ 107 | This is an R version of locuszoom for generating publication ready Manhattan 108 | plots of gene loci. It references Ensembl databases for annotating genes 109 | and exons. Use \code{\link[=locus]{locus()}} first to generate an object of class 'locus' for 110 | plotting. LDlink web server can be queried using function \code{\link[=link_LD]{link_LD()}} to 111 | retrieve linkage disequilibrium (LD) information on the index SNP. 112 | 113 | Arguments to control plotting of the gene tracks are passed onto 114 | \code{\link[=genetracks]{genetracks()}} and for the scatter plot are passed via \code{...} to 115 | \code{\link[=scatter_plot]{scatter_plot()}}. See the documentation for each of these functions for 116 | details. 117 | } 118 | \examples{ 119 | if(require(EnsDb.Hsapiens.v75)) { 120 | data(SLE_gwas_sub) 121 | loc <- locus(SLE_gwas_sub, gene = 'UBE2L3', flank = 1e5, 122 | ens_db = "EnsDb.Hsapiens.v75") 123 | locus_plot(loc) 124 | 125 | ## Use embedded LD information in column `r2` 126 | loc2 <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 127 | ens_db = "EnsDb.Hsapiens.v75") 128 | ## Add label for index SNP 129 | locus_plot(loc2, labels = "index") 130 | } 131 | } 132 | \seealso{ 133 | \code{\link[=locus]{locus()}} \code{\link[=scatter_plot]{scatter_plot()}} \code{\link[=genetracks]{genetracks()}} 134 | } 135 | -------------------------------------------------------------------------------- /R/gg_genetracks.R: -------------------------------------------------------------------------------- 1 | 2 | #' Plot gene tracks 3 | #' 4 | #' Plot gene annotation tracks from `ensembldb` data using ggplot2 and grid. 5 | #' 6 | #' @param loc Object of class 'locus' generated by [locus()]. 7 | #' @param filter_gene_name Vector of gene names to display. 8 | #' @param filter_gene_biotype Vector of gene biotypes to be filtered. Use 9 | #' [ensembldb::listGenebiotypes()] to display possible biotypes. For example, 10 | #' `ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)` 11 | #' @param border Logical whether a bounding box is plotted. 12 | #' @param cex.axis Specifies font size for axis numbering. 13 | #' @param cex.lab Specifies font size for axis titles. 14 | #' @param cex.text Font size for gene text. 15 | #' @param gene_col Colour for gene lines. 16 | #' @param exon_col Fill colour for exons. 17 | #' @param exon_border Border line colour outlining exons (or genes if 18 | #' `showExons` is `FALSE`). Set to `NA` for no border. 19 | #' @param showExons Logical whether to show exons or simply show whole gene as a 20 | #' rectangle. If `showExons = FALSE` colours are specified by `exon_border` 21 | #' for rectangle border and `gene_col` for the fill colour. 22 | #' @param maxrows Specifies maximum number of rows to display in gene annotation 23 | #' panel. 24 | #' @param text_pos Character value of either 'top' or 'left' specifying 25 | #' placement of gene name labels. 26 | #' @param italics Logical whether gene text is in italics. 27 | #' @param xticks Logical whether x axis ticks and numbers are plotted. 28 | #' @param xlab Title for x axis. Defaults to chromosome `seqname` specified in 29 | #' `locus`. 30 | #' @param highlight Vector of genes to highlight. 31 | #' @param highlight_col Single colour or vector of colours for highlighted 32 | #' genes. 33 | #' @param blanks Controls handling of genes with blank names: `"fill"` replaces 34 | #' blank gene symbols with ensembl gene ids. `"hide"` hides genes which are 35 | #' missing gene symbols. 36 | #' @details 37 | #' This function is called by [locus_ggplot()], and in turn it calls 38 | #' [genetracks_grob()]. It can be used to plot the gene annotation tracks on 39 | #' their own as a ggplot2 object. 40 | #' 41 | #' `gene_col`, `exon_col` and `exon_border` set colours for all genes, while 42 | #' `highlight` and `highlight_col` can optionally be used together to highlight 43 | #' specific genes of interest. For full control over every single gene, users 44 | #' can add columns `gene_col`, `exon_col` and `exon_border` to the `TX` object 45 | #' within the 'locus' object. Columns added to `TX` override their equivalent 46 | #' arguments. 47 | #' @seealso [locus_ggplot()] [genetracks_grob()] 48 | #' @return A ggplot2 object. 49 | #' @examples 50 | #' if(require(EnsDb.Hsapiens.v75)) { 51 | #' data(SLE_gwas_sub) 52 | #' loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 53 | #' ens_db = "EnsDb.Hsapiens.v75") 54 | #' gg_genetracks(loc) 55 | #' } 56 | #' @importFrom ggplot2 xlab 57 | #' @importFrom gggrid grid_panel 58 | #' @export 59 | 60 | gg_genetracks <- function(loc, 61 | filter_gene_name = NULL, 62 | filter_gene_biotype = NULL, 63 | border = FALSE, 64 | cex.axis = 1, 65 | cex.lab = 1, 66 | cex.text = 0.7, 67 | gene_col = ifelse(showExons, 'blue4', 'skyblue'), 68 | exon_col = 'blue4', 69 | exon_border = 'blue4', 70 | showExons = TRUE, 71 | maxrows = NULL, 72 | text_pos = 'top', 73 | italics = FALSE, 74 | xticks = TRUE, 75 | xlab = NULL, 76 | highlight = NULL, 77 | highlight_col = "red", 78 | blanks = c("fill", "hide")) { 79 | if (!inherits(loc, "locus")) stop("Object of class 'locus' required") 80 | blanks <- match.arg(blanks) 81 | g <- genetracks_grob(loc, 82 | filter_gene_name, 83 | filter_gene_biotype, 84 | border, 85 | cex.text, 86 | gene_col, 87 | exon_col, 88 | exon_border, 89 | showExons, 90 | maxrows, 91 | text_pos, 92 | italics, 93 | highlight, highlight_col, 94 | blanks) 95 | if (is.null(xlab) & xticks) xlab <- paste("Chromosome", loc$seqname, "(Mb)") 96 | 97 | g2 <- ggplot(data.frame(x = NA), 98 | aes(xmin = loc$xrange[1] / 1e6, xmax = loc$xrange[2] / 1e6)) + 99 | (if (!is.null(g)) gggrid::grid_panel(g)) + 100 | xlab(xlab) + 101 | theme_classic() + 102 | theme(axis.text = element_text(colour = "black", size = 10 * cex.axis), 103 | axis.title = element_text(size = 10 * cex.lab), 104 | axis.line.y = element_blank()) 105 | if (!xticks) { 106 | g2 <- g2 + 107 | theme(axis.line.x = element_blank(), 108 | axis.ticks.x = element_blank(), 109 | axis.text.x = element_blank()) 110 | } 111 | g2 112 | } 113 | 114 | -------------------------------------------------------------------------------- /man/locus.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/locus.R 3 | \name{locus} 4 | \alias{locus} 5 | \title{Create locus object for plotting} 6 | \usage{ 7 | locus( 8 | data = NULL, 9 | gene = NULL, 10 | xrange = NULL, 11 | seqname = NULL, 12 | flank = NULL, 13 | fix_window = NULL, 14 | ens_db, 15 | chrom = NULL, 16 | pos = NULL, 17 | p = NULL, 18 | yvar = NULL, 19 | labs = NULL, 20 | index_snp = NULL, 21 | LD = NULL, 22 | std_filter = TRUE 23 | ) 24 | } 25 | \arguments{ 26 | \item{data}{Dataset (data.frame or data.table) to use for plot. We recommend 27 | that tibbles are converted to a normal data.frame. If unspecified or 28 | \code{NULL}, gene track information alone is returned.} 29 | 30 | \item{gene}{Optional character value specifying which gene to view. Either 31 | \code{gene}, or \code{xrange} plus \code{seqname}, or \code{index_snp} must be specified.} 32 | 33 | \item{xrange}{Optional vector of genomic position range for the x axis.} 34 | 35 | \item{seqname}{Optional, specifies which chromosome to plot.} 36 | 37 | \item{flank}{Single value or vector with 2 values for how much flanking 38 | region left and right of the gene to show. Defaults to 100kb.} 39 | 40 | \item{fix_window}{Optional alternative to \code{flank}, which allows users to 41 | specify a fixed genomic window centred on the specified gene. Both \code{flank} 42 | and \code{fix_window} cannot be specified simultaneously.} 43 | 44 | \item{ens_db}{Either a character string which specifies which Ensembl 45 | database package (version 86 and earlier for Homo sapiens) to query for 46 | gene and exon positions (see \code{ensembldb} Bioconductor package). Or an 47 | \code{ensembldb} object which can be obtained from the AnnotationHub database. 48 | See the vignette and the \code{AnnotationHub} Bioconductor package for how to 49 | create this object.} 50 | 51 | \item{chrom}{Determines which column in \code{data} contains chromosome 52 | information. If \code{NULL} tries to autodetect the column.} 53 | 54 | \item{pos}{Determines which column in \code{data} contains position information. 55 | If \code{NULL} tries to autodetect the column.} 56 | 57 | \item{p}{Determines which column in \code{data} contains SNP p-values. 58 | If \code{NULL} tries to autodetect the column.} 59 | 60 | \item{yvar}{Specifies column in \code{data} for plotting on the y axis as an 61 | alternative to specifying p-values. Both \code{p} and \code{yvar} cannot be specified 62 | simultaneously.} 63 | 64 | \item{labs}{Determines which column in \code{data} contains SNP rs IDs. 65 | If \code{NULL} tries to autodetect the column.} 66 | 67 | \item{index_snp}{Specifies the index SNP. If not specified, the SNP with the 68 | lowest P value is selected. Can be used to specify locus region instead of 69 | specifying \code{gene}, or \code{seqname} and \code{xrange}.} 70 | 71 | \item{LD}{Optional character value to specify which column in \code{data} contains 72 | LD information.} 73 | 74 | \item{std_filter}{Logical, whether standard filters on chromosomes 1-22, X & 75 | Y, and filtering of genes to only those whose transcript ids start with 76 | "ENS" are applied. For users with novel genome assemblies, this probably 77 | needs to be set to \code{FALSE}.} 78 | } 79 | \value{ 80 | Returns a list object of class 'locus' ready for plotting, 81 | containing: 82 | \item{seqname}{chromosome value} 83 | \item{xrange}{vector of genomic position range} 84 | \item{gene}{gene name} 85 | \item{ens_db}{Ensembl or AnnotationHub database} 86 | \item{ens_version}{Ensembl database version} 87 | \item{organism}{Ensembl database organism} 88 | \item{genome}{Ensembl data genome build} 89 | \item{chrom}{column name in \code{data} containing chromosome information} 90 | \item{pos}{column name in \code{data} containing position} 91 | \item{p}{column name in \code{data} containing p-value} 92 | \item{yvar}{column name in \code{data} to be plotted on y axis as alternative to 93 | \code{p}} 94 | \item{labs}{column name in \code{data} containing SNP IDs} 95 | \item{index_snp}{id of the most significant SNP} 96 | \item{data}{the subset of GWAS data to be plotted} 97 | \item{TX}{dataframe of transcript annotations} 98 | \item{EX}{\code{GRanges} object of exon annotations} 99 | If \code{data} is \code{NULL} when \code{locus()} is called then gene track information 100 | alone is returned. 101 | } 102 | \description{ 103 | Creates object of class 'locus' for genomic locus plot similar to 104 | \code{locuszoom}. 105 | } 106 | \details{ 107 | This is an R version of \code{locuszoom} (http://locuszoom.org) for generating 108 | publication ready Manhattan plots of gene loci. It references Ensembl 109 | databases using the \code{ensembldb} Bioconductor package framework for annotating 110 | genes and exons in the locus. 111 | } 112 | \examples{ 113 | ## Bioconductor package EnsDb.Hsapiens.v75 is needed for these examples 114 | if(require(EnsDb.Hsapiens.v75)) { 115 | data(SLE_gwas_sub) 116 | loc <- locus(SLE_gwas_sub, gene = 'UBE2L3', flank = 1e5, 117 | ens_db = "EnsDb.Hsapiens.v75") 118 | summary(loc) 119 | locus_plot(loc) 120 | loc2 <- locus(SLE_gwas_sub, gene = 'STAT4', flank = 1e5, 121 | ens_db = "EnsDb.Hsapiens.v75") 122 | locus_plot(loc2) 123 | } 124 | } 125 | \seealso{ 126 | \code{\link[=locus_plot]{locus_plot()}} \code{\link[=locus_ggplot]{locus_ggplot()}} \code{\link[=locus_plotly]{locus_plotly()}} 127 | } 128 | -------------------------------------------------------------------------------- /R/eqtl_plot.R: -------------------------------------------------------------------------------- 1 | 2 | #' Locus eQTL plot 3 | #' 4 | #' Produces a plot of eQTL data embedded in a 'locus' class object. Intended for 5 | #' use with [set_layers()]. 6 | #' 7 | #' @param loc Object of class 'locus' to use for plot. See [locus]. 8 | #' @param tissue GTex tissue in which eQTL has been measured 9 | #' @param eqtl_gene Gene showing eQTL effect 10 | #' @param scheme Character string specifying palette for effect size showing 11 | #' up/downregulation eQTL using [grDevices::hcl.colors]. Alternatively a 12 | #' vector of 6 colours. 13 | #' @param col Outline point colour. `NA` for no outlines. 14 | #' @param pcutoff Cut-off for p value significance. Defaults to p = 5e-08. Set 15 | #' to `NULL` to disable. 16 | #' @param xlab x axis title. 17 | #' @param ylab y axis title. 18 | #' @param cex.axis Specifies font size for axis numbering. 19 | #' @param xticks Logical whether x axis numbers and axis title are plotted. 20 | #' @param border Logical whether a bounding box is plotted around upper and 21 | #' lower plots. 22 | #' @param add Logical whether to add points to an existing plot or generate a 23 | #' new plot. 24 | #' @param align Logical whether set [par()] to align the plot. 25 | #' @param legend_pos Character value specifying legend position. See [legend()]. 26 | #' @param ... Other arguments passed to [plot()] for the scatter plot. 27 | #' @return No return value. Produces a scatter plot using base graphics. 28 | #' @seealso [locus()] [set_layers()] [scatter_plot()] 29 | #' @importFrom graphics points 30 | #' @export 31 | #' 32 | eqtl_plot <- function(loc, 33 | tissue = "Whole Blood", 34 | eqtl_gene = loc$gene, 35 | scheme = "RdYlBu", 36 | col = NA, 37 | pcutoff = NULL, 38 | xlab = NULL, 39 | ylab = expression("-log"[10] ~ "P"), 40 | cex.axis = 0.9, 41 | xticks = TRUE, 42 | border = FALSE, 43 | add = FALSE, 44 | align = TRUE, 45 | legend_pos = "topright", ...) { 46 | if (!inherits(loc, "locus")) stop("Object of class 'locus' required") 47 | 48 | if (!"LDexp" %in% names(loc)) stop("Contains no eQTL data") 49 | data <- loc$LDexp 50 | data <- data[data$Tissue == tissue & data$Gene_Symbol == eqtl_gene, ] 51 | if (nrow(data) == 0) stop("No data") 52 | 53 | data$pos <- gsub(".*:", "", data$Position_grch37) # remove up to ':' 54 | data$pos <- as.numeric(data$pos) 55 | data$logP <- -log10(data$P_value) 56 | 57 | # fix effect allele not being minor allele 58 | data$Effect_Allele_Freq <- gsub(".*=", "", data$Effect_Allele_Freq) 59 | data$Effect_Allele_Freq <- as.numeric(data$Effect_Allele_Freq) 60 | swap <- !is.na(data$Effect_Allele_Freq) & data$Effect_Allele_Freq > 0.5 61 | data$Effect_Size[swap] <- -data$Effect_Size[swap] 62 | data$pch <- -sign(data$Effect_Size) / 2 + 24.5 63 | equp <- sign(data$Effect_Size) == 1 64 | if (is.character(scheme)) { 65 | scheme <- hcl.colors(9, scheme)[-c(4:6)] 66 | } 67 | up_cols <- rev(scheme[1:3]) 68 | down_cols <- scheme[4:6] 69 | ecol <- cut(abs(data$Effect_Size), breaks = 3) 70 | data$bg[equp] <- up_cols[ecol[equp]] 71 | data$bg[!equp] <- down_cols[ecol[!equp]] 72 | labs <- levels(ecol) 73 | cutlev <- cbind(lower = as.numeric( sub("\\((.+),.*", "\\1", labs) ), 74 | upper = as.numeric( sub("[^,]*,([^]]*)\\]", "\\1", labs) )) 75 | cutlev <- signif(cutlev, 2) 76 | 77 | if (is.null(xlab)) xlab <- paste("Chromosome", loc$seqname, "(Mb)") 78 | 79 | # scatter plot 80 | recomb <- !is.null(loc$recomb) 81 | if (align) { 82 | op <- par(mar = c(ifelse(xticks, 3, 0.1), 3.5, 2, 83 | ifelse(recomb, 3.5, 1.5))) 84 | on.exit(par(op)) 85 | } 86 | 87 | if (!is.null(pcutoff)) { 88 | abl <- quote(abline(h = -log10(pcutoff), col = 'darkgrey', lty = 2)) 89 | } else abl <- NULL 90 | 91 | new.args <- list(...) 92 | if (add) { 93 | plot.args <- list(x = data$pos, y = data$logP, 94 | pch = data$pch, bg = data$bg, col = col) 95 | if (length(new.args)) plot.args[names(new.args)] <- new.args 96 | do.call("points", plot.args) 97 | return() 98 | } 99 | plot.args <- list(x = data$pos, y = data$logP, 100 | pch = data$pch, bg = data$bg, col = col, 101 | las = 1, font.main = 1, 102 | xlim = loc$xrange, 103 | ylim = c(0, max(data$logP, na.rm = TRUE)), 104 | xlab = if (xticks) xlab else "", 105 | ylab = ylab, 106 | bty = if (border) 'o' else 'l', 107 | cex.axis = cex.axis, 108 | xaxt = 'n', 109 | tcl = -0.3, 110 | mgp = c(1.7, 0.5, 0), 111 | panel.first = abl) 112 | if (length(new.args)) plot.args[names(new.args)] <- new.args 113 | do.call("plot", plot.args) 114 | 115 | if (xticks) { 116 | axis(1, at = axTicks(1), labels = axTicks(1) / 1e6, cex.axis = cex.axis, 117 | mgp = c(1.7, 0.4, 0), tcl = -0.3) 118 | } else if (!border) { 119 | axis(1, at = axTicks(1), labels = FALSE, tcl = -0.3) 120 | } 121 | if (!is.null(legend_pos)) { 122 | legtext <- c(rev(paste(cutlev[,1], cutlev[,2], sep=" : ")), 123 | paste(-cutlev[,2], -cutlev[,1], sep=" : ")) 124 | legend(legend_pos, legend = legtext, pch = rep(c(24, 25), each=3), 125 | col = col, pt.bg = c(rev(up_cols), down_cols), 126 | title = "eQTL effect", 127 | bty = "n", cex = 0.85, pt.cex = 1, y.intersp = 0.96) 128 | } 129 | } 130 | -------------------------------------------------------------------------------- /R/locus_plot.R: -------------------------------------------------------------------------------- 1 | 2 | #' Locus plot 3 | #' 4 | #' Genomic locus plot similar to locuszoom. 5 | #' 6 | #' @details 7 | #' This is an R version of locuszoom for generating publication ready Manhattan 8 | #' plots of gene loci. It references Ensembl databases for annotating genes 9 | #' and exons. Use [locus()] first to generate an object of class 'locus' for 10 | #' plotting. LDlink web server can be queried using function [link_LD()] to 11 | #' retrieve linkage disequilibrium (LD) information on the index SNP. 12 | #' 13 | #' Arguments to control plotting of the gene tracks are passed onto 14 | #' [genetracks()] and for the scatter plot are passed via `...` to 15 | #' [scatter_plot()]. See the documentation for each of these functions for 16 | #' details. 17 | #' 18 | #' @param loc Object of class 'locus' to use for plot. See [locus()]. 19 | #' @param filter_gene_name Vector of gene names to display. 20 | #' @param filter_gene_biotype Vector of gene biotypes to be filtered. Use 21 | #' [ensembldb::listGenebiotypes()] to display possible biotypes. For example, 22 | #' `ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)` 23 | #' @param xlab x axis title. 24 | #' @param cex Specifies size for points. 25 | #' @param cex.axis Specifies font size for axis numbering. 26 | #' @param cex.lab Specifies font size for axis titles. 27 | #' @param cex.text Font size for gene text. 28 | #' @param use_layout Logical whether `graphics::layout` is called. Default 29 | #' `TRUE` is for a standard single plot. Set to `FALSE` if a more complex 30 | #' layout with multiple plots is required e.g. using [multi_layout()]. 31 | #' @param heights Ratio of top to bottom plot. See [layout]. 32 | #' @param showExons Logical whether to show exons or simply show whole gene as a 33 | #' rectangle 34 | #' @param maxrows Specifies maximum number of rows to display in gene 35 | #' annotation panel. 36 | #' @param xticks Character value of either 'top' or 'bottom' specifying 37 | #' whether x axis ticks and numbers are plotted on top or bottom plot window. 38 | #' @param border Logical whether a bounding box is plotted around upper and 39 | #' lower plots. 40 | #' @param gene_col Colour for gene lines. 41 | #' @param exon_col Fill colour for exons. 42 | #' @param exon_border Border line colour outlining exons (or genes if 43 | #' `showExons` is `FALSE`). Set to `NA` for no border. 44 | #' @param text_pos Character value of either 'top' or 'left' specifying 45 | #' placement of gene name labels. 46 | #' @param italics Logical whether gene text is in italics. 47 | #' @param highlight Vector of genes to highlight. 48 | #' @param highlight_col Single colour or vector of colours for highlighted 49 | #' genes. 50 | #' @param blanks Controls handling of genes with blank names: `"fill"` replaces 51 | #' blank gene symbols with ensembl gene ids. `"hide"` hides genes which are 52 | #' missing gene symbols. 53 | #' @param recomb_col Colour for recombination rate line if recombination rate 54 | #' data is present. Set to `NA` to hide the line. See [link_recomb()] to add 55 | #' recombination rate data. 56 | #' @param ... Other arguments passed to [scatter_plot()] e.g. `index_snp`, 57 | #' `pcutoff`, `scheme`, `recomb_offset`, etc, and arguments for [plot()] e.g. 58 | #' `ylab`, `main`, etc to control the scatter plot. 59 | #' @return No return value. 60 | #' @seealso [locus()] [scatter_plot()] [genetracks()] 61 | #' @examples 62 | #' if(require(EnsDb.Hsapiens.v75)) { 63 | #' data(SLE_gwas_sub) 64 | #' loc <- locus(SLE_gwas_sub, gene = 'UBE2L3', flank = 1e5, 65 | #' ens_db = "EnsDb.Hsapiens.v75") 66 | #' locus_plot(loc) 67 | #' 68 | #' ## Use embedded LD information in column `r2` 69 | #' loc2 <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 70 | #' ens_db = "EnsDb.Hsapiens.v75") 71 | #' ## Add label for index SNP 72 | #' locus_plot(loc2, labels = "index") 73 | #' } 74 | #' @export 75 | 76 | locus_plot <- function(loc, 77 | filter_gene_name = NULL, 78 | filter_gene_biotype = NULL, 79 | xlab = NULL, 80 | cex = 1, 81 | cex.axis = 0.9, 82 | cex.lab = 1, 83 | cex.text = 0.7, 84 | use_layout = TRUE, 85 | heights = c(3, 2), 86 | showExons = TRUE, 87 | maxrows = 7, 88 | xticks = 'bottom', 89 | border = FALSE, 90 | gene_col = ifelse(showExons, 'blue4', 'skyblue'), 91 | exon_col = 'blue4', 92 | exon_border = 'blue4', 93 | text_pos = 'top', 94 | italics = FALSE, 95 | highlight = NULL, 96 | highlight_col = "red", 97 | blanks = 'fill', 98 | recomb_col = "blue", ...) { 99 | if (!inherits(loc, "locus")) stop("Object of class 'locus' required") 100 | if (is.null(loc$data)) stop("No SNPs/data points") 101 | 102 | if (use_layout) { 103 | op0 <- set_layers(1, heights, rev = TRUE) 104 | on.exit(par(op0), add = TRUE) 105 | } 106 | 107 | # lower panel gene tracks at locus 108 | genetracks(loc, filter_gene_name, filter_gene_biotype, 109 | border, cex.axis, cex.lab, cex.text, gene_col, exon_col, exon_border, 110 | showExons, maxrows, text_pos, italics, 111 | xticks = (xticks == 'bottom'), 112 | xlab = if (xticks == 'bottom') xlab else "", 113 | highlight = highlight, highlight_col = highlight_col, 114 | blanks = blanks, showRecomb = !is.na(recomb_col)) 115 | 116 | # upper panel plot points 117 | scatter_plot(loc, xticks = (xticks == 'top'), 118 | border = border, xlab = xlab, 119 | cex = cex, cex.axis = cex.axis, cex.lab = cex.lab, 120 | recomb_col = recomb_col, ...) 121 | } 122 | -------------------------------------------------------------------------------- /R/genetracks_grob.R: -------------------------------------------------------------------------------- 1 | 2 | #' Create gene tracks grob 3 | #' 4 | #' Plot gene annotation tracks from `ensembldb` data using the grid package to 5 | #' create a grob. 6 | #' 7 | #' @details This function is called by [gg_genetracks()]. It can be used to 8 | #' generate a grob of the gene annotation tracks on their own. 9 | #' @param locus Object of class 'locus' generated by [locus()]. 10 | #' @param filter_gene_name Vector of gene names to display. 11 | #' @param filter_gene_biotype Vector of gene biotypes to be filtered. Use 12 | #' [ensembldb::listGenebiotypes()] to display possible biotypes. For example, 13 | #' `ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)` 14 | #' @param cex.text Font size for gene text. 15 | #' @param showExons Logical whether to show exons or simply show whole gene as a 16 | #' rectangle. If `showExons = FALSE` colours are specified by `exon_border` 17 | #' for rectangle border and `gene_col` for the fill colour. 18 | #' @param maxrows Specifies maximum number of rows to display in gene 19 | #' annotation panel. 20 | #' @param border Logical whether a bounding box is plotted. 21 | #' @param gene_col Colour for gene lines. 22 | #' @param exon_col Fill colour for exons. 23 | #' @param exon_border Border line colour outlining exons (or genes if 24 | #' `showExons` is `FALSE`). Set to `NA` for no border. 25 | #' @param text_pos Character value of either 'top' or 'left' specifying 26 | #' placement of gene name labels. 27 | #' @param italics Logical whether gene text is in italics. 28 | #' @param highlight Vector of genes to highlight. 29 | #' @param highlight_col Single colour or vector of colours for highlighted 30 | #' genes. 31 | #' @param blanks Controls handling of genes with blank names: `"fill"` replaces 32 | #' blank gene symbols with ensembl gene ids. `"hide"` hides genes which are 33 | #' missing gene symbols. 34 | #' @return A grob object. 35 | #' @examples 36 | #' if(require(EnsDb.Hsapiens.v75)) { 37 | #' data(SLE_gwas_sub) 38 | #' loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 39 | #' ens_db = "EnsDb.Hsapiens.v75") 40 | #' g <- genetracks_grob(loc) 41 | #' grid::grid.newpage() 42 | #' grid::grid.draw(g) 43 | #' } 44 | #' @importFrom grid viewport rectGrob textGrob xaxisGrob gList gTree gpar 45 | #' polylineGrob 46 | #' @export 47 | 48 | genetracks_grob <- function(locus, 49 | filter_gene_name = NULL, 50 | filter_gene_biotype = NULL, 51 | border = FALSE, 52 | cex.text = 0.7, 53 | gene_col = ifelse(showExons, 'blue4', 'skyblue'), 54 | exon_col = 'blue4', 55 | exon_border = 'blue4', 56 | showExons = TRUE, 57 | maxrows = NULL, 58 | text_pos = 'top', 59 | italics = FALSE, 60 | highlight = NULL, 61 | highlight_col = "red", 62 | blanks = c("fill", "hide")) { 63 | if (!inherits(locus, "locus")) stop("Object of class 'locus' required") 64 | blanks <- match.arg(blanks) 65 | TX <- locus$TX 66 | EX <- locus$EX 67 | xrange <- locus$xrange 68 | if (!is.null(filter_gene_name)) { 69 | TX <- TX[TX$gene_name %in% filter_gene_name, ] 70 | } 71 | if (!is.null(filter_gene_biotype)) { 72 | TX <- TX[TX$gene_biotype %in% filter_gene_biotype, ] 73 | } 74 | if (nrow(TX) == 0) { 75 | message('No genes to plot') 76 | return(invisible(NULL)) 77 | } 78 | 79 | TX <- gene_colours(TX, gene_col, exon_col, exon_border, showExons, 80 | highlight, highlight_col) 81 | 82 | TX <- mapRow(TX, xlim = xrange, cex.text = cex.text, text_pos = text_pos, 83 | blanks = blanks) 84 | maxrows <- if (is.null(maxrows)) max(TX$row) else min(c(max(TX$row), maxrows)) 85 | if (max(TX$row) > maxrows) message(max(TX$row), " tracks needed to show all genes") 86 | TX <- TX[TX$row <= maxrows, ] 87 | 88 | ylim <- c(-maxrows - 0.3, -0.3) 89 | xrange <- xrange / 1e6 90 | TX$start <- TX$start / 1e6 91 | TX$end <- TX$end / 1e6 92 | TX[, c("mean", "tmin", "tmax", "min", "max")] <- TX[, c("mean", "tmin", "tmax", "min", "max")] / 1e6 93 | exheight <- switch(text_pos, "top" = 0.15, "left" = 0.3) 94 | 95 | gt <- gTree( 96 | childrenvp = genetrack.vp(xrange, ylim), 97 | children = gList( 98 | if (border) rectGrob(gp = gpar(lwd = 1.5), vp = "genetrack"), 99 | exonGrob(TX, EX, showExons, exheight), 100 | genetextGrob(text_pos, TX, xrange, cex.text, italics)), 101 | gp = gpar() 102 | ) 103 | 104 | gt 105 | } 106 | 107 | 108 | genetrack.vp <- function(xrange, ylim) { 109 | viewport(name = "genetrack", 110 | x = unit(0, "lines"), 111 | y = unit(0, "lines"), 112 | width = unit(1, "npc"), 113 | height = unit(1, "npc") - unit(0, "lines"), 114 | just = c("left", "bottom"), 115 | xscale = xrange + c(-0.04, 0.04) * diff(xrange), 116 | yscale = ylim) 117 | } 118 | 119 | 120 | exonGrob <- function(TX, EX, showExons, exheight) { 121 | if (showExons) { 122 | LX <- unlist(t(TX[, c('start', 'end')])) 123 | LY <- cbind(-TX[, 'row'], -TX[, 'row']) 124 | LY <- unlist(t(LY)) 125 | line_id <- rep(seq_len(nrow(TX)), each = 2) 126 | 127 | EXset <- lapply(seq_len(nrow(TX)), function(i) { 128 | e <- EX[EX$gene_id == TX$gene_id[i], ] 129 | exstart <- start(e) / 1e6 130 | exwidth <- end(e) / 1e6 - exstart 131 | data.frame(x = exstart, 132 | y = -TX[i, 'row'] - exheight, 133 | width = exwidth, 134 | height = 2 * exheight, 135 | exon_col = TX$exon_col[i], 136 | exon_border = TX$exon_border[i]) 137 | }) 138 | EXset <- do.call("rbind", EXset) 139 | 140 | gList( 141 | polylineGrob(unit(LX, "native"), 142 | unit(LY, "native"), 143 | id = line_id, 144 | gp = gpar(col = TX$gene_col, lwd = 1.5, lineend = "butt"), 145 | vp = "genetrack"), 146 | rectGrob(x = unit(EXset[, "x"], "native"), 147 | y = unit(EXset[, "y"], "native"), 148 | width = unit(EXset[, "width"], "native"), 149 | height = unit(EXset[, "height"], "native"), 150 | just = c("left", "bottom"), 151 | gp = gpar(fill = EXset$exon_col, col = EXset$exon_border, 152 | lwd = 0.5, lineend = "square", linejoin = "mitre"), 153 | vp = "genetrack") 154 | ) 155 | } else { 156 | # without exons 157 | rectGrob(x = unit(TX$start, "native"), 158 | y = unit(-TX[, 'row'] - exheight, "native"), 159 | width = unit(TX$end - TX$start, "native"), 160 | height = unit(exheight*2, "native"), 161 | just = c("left", "bottom"), 162 | gp = gpar(fill = TX$gene_col, col = TX$exon_border, 163 | lineend = "square", linejoin = "mitre"), 164 | vp = "genetrack") 165 | } 166 | } 167 | 168 | 169 | genetextGrob <- function(text_pos, TX, xrange, cex.text, italics) { 170 | if (text_pos == "top") { 171 | tfilter <- which(TX$tmin > (xrange[1] - diff(xrange) * 0.04) & 172 | (TX$tmax < xrange[2] + diff(xrange) * 0.04)) 173 | tg <- lapply(tfilter, function(i) { 174 | textGrob(label = bquote_gene(TX$gene_name[i], TX$strand[i], italics), 175 | x = unit(TX$mean[i], "native"), 176 | y = unit(-TX$row[i] + 0.45, "native"), 177 | gp = gpar(cex = cex.text), vp = "genetrack") 178 | }) 179 | } else if (text_pos == "left") { 180 | tfilter <- which(TX$tmin > xrange[1]) 181 | tg <- lapply(tfilter, function(i) { 182 | textGrob(label = bquote_gene(TX$gene_name[i], TX$strand[i], italics), 183 | x = unit(pmax(TX$start[i], 184 | xrange[1] - diff(xrange) * 0.04) - diff(xrange) * 0.01, 185 | "native"), 186 | y = unit(-TX$row[i], "native"), 187 | just = "right", 188 | gp = gpar(cex = cex.text), vp = "genetrack") 189 | }) 190 | } 191 | do.call(gList, tg) 192 | } 193 | 194 | -------------------------------------------------------------------------------- /R/genetrack_ly.R: -------------------------------------------------------------------------------- 1 | #' Gene tracks using 'plotly' 2 | #' 3 | #' Plot gene annotation tracks from `ensembldb` data using `plotly`. 4 | #' 5 | #' @details This function can used to plot gene annotation tracks on their own. 6 | #' @param locus Object of class 'locus' generated by [locus()]. 7 | #' @param filter_gene_name Vector of gene names to display. 8 | #' @param filter_gene_biotype Vector of gene biotypes to be filtered. Use 9 | #' [ensembldb::listGenebiotypes()] to display possible biotypes. For example, 10 | #' `ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)` 11 | #' @param cex.text Font size for gene text. 12 | #' @param italics Logical whether gene text is in italics. 13 | #' @param gene_col Colour for gene lines. 14 | #' @param exon_col Fill colour for exons. 15 | #' @param exon_border Border line colour outlining exons (or genes if 16 | #' `showExons` is `FALSE`). Set to `NA` for no border. 17 | #' @param showExons Logical whether to show exons or simply show whole gene as a 18 | #' rectangle. If `showExons = FALSE` colours are specified by `exon_border` 19 | #' for rectangle border and `gene_col` for the fill colour. 20 | #' @param maxrows Specifies maximum number of rows to display in gene 21 | #' annotation panel. 22 | #' @param width Width of plotly plot in pixels which is purely used to prevent 23 | #' overlapping text for gene names. 24 | #' @param xlab Title for x axis. Defaults to chromosome `seqname` specified 25 | #' in `locus`. 26 | #' @param blanks Controls handling of genes with blank names: `"fill"` replaces 27 | #' blank gene symbols with ensembl gene ids. `"hide"` completely hides genes 28 | #' which are missing gene symbols. `"show"` shows gene lines but no label 29 | #' (hovertext is still available). 30 | #' @param height Height in pixels (optional, defaults to automatic sizing). 31 | #' @param plot Logical whether to produce plotly object or return plot 32 | #' coordinates. 33 | #' @return Either a 'plotly' plotting object showing gene tracks, or if 34 | #' `plot = FALSE` a list containing `TX`, a dataframe of coordinates for 35 | #' gene transcripts, and `EX`, a dataframe of coordinates for exons. 36 | #' @examples 37 | #' if(require(EnsDb.Hsapiens.v75)) { 38 | #' data(SLE_gwas_sub) 39 | #' loc <- locus(SLE_gwas_sub, gene = 'UBE2L3', flank = 1e5, 40 | #' ens_db = "EnsDb.Hsapiens.v75") 41 | #' genetrack_ly(loc) 42 | #' } 43 | #' @importFrom plotly plot_ly plotly_empty add_segments add_text %>% 44 | #' @export 45 | 46 | genetrack_ly <- function(locus, 47 | filter_gene_name = NULL, 48 | filter_gene_biotype = NULL, 49 | cex.text = 0.7, 50 | italics = FALSE, 51 | gene_col = ifelse(showExons, 'blue4', 'skyblue'), 52 | exon_col = 'blue4', 53 | exon_border = 'blue4', 54 | showExons = TRUE, 55 | maxrows = 8, 56 | width = 600, 57 | xlab = NULL, 58 | blanks = c("fill", "hide", "show"), 59 | height = NULL, 60 | plot = TRUE) { 61 | if (!inherits(locus, "locus")) stop("Object of class 'locus' required") 62 | blanks <- match.arg(blanks) 63 | TX <- locus$TX 64 | EX <- as.data.frame(locus$EX) 65 | xrange <- locus$xrange 66 | if (!is.null(filter_gene_name)) { 67 | TX <- TX[TX$gene_name %in% filter_gene_name, ] 68 | } 69 | if (!is.null(filter_gene_biotype)) { 70 | TX <- TX[TX$gene_biotype %in% filter_gene_biotype, ] 71 | } 72 | xlim <- xrange / 1e6 73 | xext <- diff(xlim) * 0.01 74 | xlim <- xlim + c(-xext, xext) 75 | if (is.null(xlab)) xlab <- paste("Chromosome", locus$seqname, "(Mb)") 76 | if (nrow(TX) == 0 & plot) { 77 | message('No genes to plot') 78 | # blank gene tracks 79 | p <- plot_ly(data.frame(NA), mode = "markers", type = "scatter", 80 | source = "plotly_locus") %>% 81 | plotly::layout(xaxis = list(title = xlab, showgrid = FALSE, showline = TRUE, 82 | color = 'black', ticklen = 5, 83 | range = as.list(xlim)), 84 | yaxis = list(title = "", showgrid = FALSE, zeroline = FALSE, 85 | showticklabels = FALSE)) %>% 86 | plotly::config(displaylogo = FALSE) 87 | return(p) 88 | } 89 | 90 | cex.width <- cex.text * par("pin")[1] * 80 / (width - 250) 91 | TX <- mapRow(TX, xlim = xrange, cex.text = cex.width, blanks = blanks) 92 | maxrows <- if (is.null(maxrows)) max(TX$row) else min(c(max(TX$row), maxrows)) 93 | if (max(TX$row) > maxrows) message(max(TX$row), " tracks needed to show all genes") 94 | TX <- TX[TX$row <= maxrows, ] 95 | EX <- EX[EX$gene_id %in% TX$gene_id, ] 96 | 97 | gene_col <- col2hex(gene_col) 98 | exon_col <- col2hex(exon_col) 99 | exon_border <- col2hex(exon_border) 100 | EX$row <- TX$row[match(EX$gene_id, TX$gene_id)] 101 | 102 | EX[, c('start', 'end')] <- EX[, c('start', 'end')] / 1e6 103 | TX$tx <- rowMeans(TX[, c('start', 'end')]) 104 | TX$ty <- -TX$row + 0.35 105 | TX[, c('start', 'end', 'tx')] <- TX[, c('start', 'end', 'tx')] / 1e6 106 | 107 | tfilter <- TX$tmin > (xrange[1] - diff(xrange) * 0.005) & 108 | (TX$tmax < xrange[2] + diff(xrange) * 0.005) & 109 | TX$gene_name != "" 110 | pos <- TX$strand == "+" 111 | TX$gene_name2 <- if (italics) paste0("", TX$gene_name, "") else TX$gene_name 112 | TX$gene_name2[pos] <- paste0(TX$gene_name2[pos], "→") 113 | TX$gene_name2[!pos] <- paste0("←", TX$gene_name2[!pos]) 114 | TX$gene_name2[!tfilter] <- NA 115 | 116 | if (!plot) return(list(TX = TX, EX = EX)) 117 | 118 | if (showExons) { 119 | shapes <- lapply(seq_len(nrow(EX)), function(i) { 120 | list(type = "rect", fillcolor = exon_col, line = list(color = exon_border, 121 | width = 0.5), 122 | x0 = EX$start[i], x1 = EX$end[i], xref = "x", 123 | y0 = -EX$row[i] - 0.15, y1 = -EX$row[i] + 0.15, yref = "y") 124 | }) 125 | } else { 126 | shapes <- lapply(seq_len(nrow(TX)), function(i) { 127 | list(type = "rect", fillcolor = gene_col, line = list(color = exon_border, 128 | width = 1), 129 | x0 = TX$start[i], x1 = TX$end[i], xref = "x", 130 | y0 = -TX$row[i] - 0.15, y1 = -TX$row[i] + 0.15, yref = "y") 131 | }) 132 | } 133 | 134 | ok <- !is.na(TX$gene_name2) 135 | hovertext <- paste0(TX$gene_name, 136 | TX$fullname, 137 | "
Gene ID: ", TX$gene_id, 138 | "
Biotype: ", TX$gene_biotype, 139 | "
Start: ", TX$start * 1e6, 140 | "
End: ", TX$end * 1e6) 141 | plot_ly(TX, source = "plotly_locus", height = height) %>% 142 | add_segments(x = ~start, y = ~-row, 143 | xend = ~end, yend = ~-row, 144 | color = I(gene_col), 145 | text = hovertext, hoverinfo = 'text', 146 | showlegend = FALSE) %>% 147 | add_text(x = TX$tx[ok], y = TX$ty[ok], text = TX$gene_name2[ok], 148 | textfont = list(size = 14 * cex.text), 149 | showlegend = FALSE, hoverinfo = 'none') %>% 150 | plotly::layout(shapes = shapes, 151 | xaxis = list(title = xlab, showgrid = FALSE, showline = TRUE, 152 | zeroline = FALSE, 153 | color = 'black', ticklen = 5, 154 | range = as.list(xlim)), 155 | yaxis = list(title = "", showgrid = FALSE, zeroline = FALSE, 156 | fixedrange = TRUE, 157 | showticklabels = FALSE), 158 | showlegend = TRUE, dragmode = "pan") %>% 159 | plotly::config(displaylogo = FALSE, 160 | modeBarButtonsToRemove = c("select2d", "lasso2d", 161 | "autoScale2d", "resetScale2d", 162 | "hoverClosest", "hoverCompare")) 163 | } 164 | 165 | 166 | #' @importFrom grDevices col2rgb rgb 167 | 168 | col2hex <- function(cname) { 169 | colMat <- col2rgb(cname) 170 | rgb(red = colMat[1, ]/255, green = colMat[2, ]/255, blue = colMat[3, ]/255) 171 | } 172 | -------------------------------------------------------------------------------- /R/genetracks.R: -------------------------------------------------------------------------------- 1 | 2 | #' Plot gene tracks 3 | #' 4 | #' Plot gene annotation tracks from `ensembldb` data. 5 | #' 6 | #' @param locus Object of class 'locus' generated by [locus()]. 7 | #' @param filter_gene_name Vector of gene names to display. 8 | #' @param filter_gene_biotype Vector of gene biotypes to be filtered. Use 9 | #' [ensembldb::listGenebiotypes()] to display possible biotypes. For example, 10 | #' `ensembldb::listGenebiotypes(EnsDb.Hsapiens.v75)` 11 | #' @param cex.axis Specifies font size for axis numbering. 12 | #' @param cex.lab Specifies font size for axis titles. 13 | #' @param cex.text Font size for gene text. 14 | #' @param showExons Logical whether to show exons or simply show whole gene as a 15 | #' rectangle. If `showExons = FALSE` colours are specified by `exon_border` 16 | #' for rectangle border and `gene_col` for the fill colour. 17 | #' @param maxrows Specifies maximum number of rows to display in gene 18 | #' annotation panel. 19 | #' @param xticks Logical whether x axis ticks and numbers are plotted. 20 | #' @param xlab Title for x axis. Defaults to chromosome `seqname` specified 21 | #' in `locus`. 22 | #' @param border Logical whether a bounding box is plotted. 23 | #' @param gene_col Colour for gene lines. 24 | #' @param exon_col Fill colour for exons. 25 | #' @param exon_border Border line colour outlining exons (or genes if 26 | #' `showExons` is `FALSE`). Set to `NA` for no border. 27 | #' @param text_pos Character value of either 'top' or 'left' specifying 28 | #' placement of gene name labels. 29 | #' @param italics Logical whether gene text is in italics. 30 | #' @param highlight Vector of genes to highlight. 31 | #' @param highlight_col Single colour or vector of colours for highlighted 32 | #' genes. 33 | #' @param blanks Controls handling of genes with blank names: `"fill"` replaces 34 | #' blank gene symbols with ensembl gene ids. `"hide"` hides genes which are 35 | #' missing gene symbols. 36 | #' @param showRecomb Logical controls alignment of right margin if 37 | #' recombination data present. 38 | #' @param align Logical whether to set [par()] to align the plot. 39 | #' @details 40 | #' This function is called by [locus_plot()]. It can be used to plot the gene 41 | #' annotation tracks on their own. It uses base graphics, so [layout()] can be 42 | #' used to position adjacent plots above or below. 43 | #' 44 | #' `gene_col`, `exon_col` and `exon_border` set colours for all genes, while 45 | #' `highlight` and `highlight_col` can optionally be used together to highlight 46 | #' specific genes of interest. For full control over every single gene, users 47 | #' can add columns `gene_col`, `exon_col` and `exon_border` to the `TX` object 48 | #' within the 'locus' object. Columns added to `TX` override their equivalent 49 | #' arguments. 50 | #' 51 | #' @return No return value. 52 | #' @examples 53 | #' if(require(EnsDb.Hsapiens.v75)) { 54 | #' data(SLE_gwas_sub) 55 | #' loc <- locus(SLE_gwas_sub, gene = 'UBE2L3', flank = 1e5, 56 | #' ens_db = "EnsDb.Hsapiens.v75") 57 | #' genetracks(loc) 58 | #' 59 | #' ## Limit the number of tracks 60 | #' genetracks(loc, maxrows = 4) 61 | #' 62 | #' ## Filter by gene biotype 63 | #' genetracks(loc, filter_gene_biotype = 'protein_coding') 64 | #' 65 | #' ## Customise colours 66 | #' genetracks(loc, gene_col = 'grey', exon_col = 'orange', 67 | #' exon_border = 'darkgrey') 68 | #' } 69 | #' @importFrom BiocGenerics start end 70 | #' @importFrom graphics axTicks axis lines rect text plot.new strwidth 71 | #' @export 72 | 73 | genetracks <- function(locus, 74 | filter_gene_name = NULL, 75 | filter_gene_biotype = NULL, 76 | border = FALSE, 77 | cex.axis = 0.9, 78 | cex.lab = 1, 79 | cex.text = 0.7, 80 | gene_col = ifelse(showExons, 'blue4', 'skyblue'), 81 | exon_col = 'blue4', 82 | exon_border = 'blue4', 83 | showExons = TRUE, 84 | maxrows = NULL, 85 | text_pos = 'top', 86 | italics = FALSE, 87 | xticks = TRUE, 88 | xlab = NULL, 89 | highlight = NULL, 90 | highlight_col = "red", 91 | blanks = c("fill", "hide"), 92 | showRecomb = TRUE, 93 | align = TRUE) { 94 | if (!inherits(locus, "locus")) stop("Object of class 'locus' required") 95 | blanks <- match.arg(blanks) 96 | TX <- locus$TX 97 | EX <- locus$EX 98 | xrange <- locus$xrange 99 | if (!is.null(filter_gene_name)) { 100 | TX <- TX[TX$gene_name %in% filter_gene_name, ] 101 | } 102 | if (!is.null(filter_gene_biotype)) { 103 | TX <- TX[TX$gene_biotype %in% filter_gene_biotype, ] 104 | } 105 | if (is.null(xlab)) xlab <- paste("Chromosome", locus$seqname, "(Mb)") 106 | 107 | recomb <- !is.null(locus$recomb) & showRecomb 108 | if (align) { 109 | op <- par(mar = c(ifelse(xticks, 3.5, 1), 3.5, 0.25, 110 | ifelse(recomb, 3.5, 1.5))) 111 | on.exit(par(op)) 112 | } 113 | 114 | if (nrow(TX) != 0) { 115 | TX <- gene_colours(TX, gene_col, exon_col, exon_border, showExons, 116 | highlight, highlight_col) 117 | TX <- mapRow(TX, xlim = xrange, cex.text = cex.text, text_pos = text_pos, 118 | blanks = blanks) 119 | maxrows <- if (is.null(maxrows)) max(TX$row) else min(c(max(TX$row), maxrows)) 120 | if (max(TX$row) > maxrows) message(max(TX$row), " tracks needed to show all genes") 121 | TX <- TX[TX$row <= maxrows, ] 122 | } else maxrows <- 1 123 | 124 | plot(NA, xlim = xrange, 125 | ylim = c(-maxrows - 0.3, -0.3), 126 | bty = if (border) 'o' else 'n', 127 | yaxt = 'n', xaxt = 'n', 128 | xlab = if (xticks) xlab else "", 129 | ylab = "", 130 | cex.lab = cex.lab, 131 | font.main = 1, 132 | mgp = c(1.7, 0.4, 0)) 133 | if (xticks) { 134 | xd <- diff(xrange) * 0.04 135 | axis(1, at = xrange + c(-xd, xd), labels = FALSE, lwd.ticks = 0) # extend line 136 | axis(1, at = axTicks(1), labels = axTicks(1) / 1e6, cex.axis = cex.axis, 137 | lwd = 0, lwd.ticks = 1, 138 | tcl = -0.3, mgp = c(1.7, 0.4, 0)) 139 | } 140 | if (nrow(TX) == 0) { 141 | message("No genes to plot") 142 | return(invisible(NULL)) 143 | } 144 | 145 | exheight <- switch(text_pos, "top" = 0.15, "left" = 0.3) 146 | if (showExons) { 147 | for (i in seq_len(nrow(TX))) { 148 | lines(TX[i, c('start', 'end')], rep(-TX[i, 'row'], 2), 149 | col = TX$gene_col[i], lwd = 1.5, lend = 1) 150 | e <- EX[EX$gene_id == TX$gene_id[i], ] 151 | exstart <- start(e) 152 | exend <- end(e) 153 | rect(exstart, -TX[i, 'row'] - exheight, exend, -TX[i, 'row'] + exheight, 154 | col = TX$exon_col[i], border = TX$exon_border[i], 155 | lwd = 0.5, lend = 2, ljoin = 1) 156 | } 157 | } else { 158 | # without exons 159 | rect(TX[, 'start'], -TX[, 'row'] - exheight, 160 | TX[, 'end'], -TX[, 'row'] + exheight, 161 | col = TX$gene_col, lwd = 1, lend = 2, ljoin = 1, border = exon_border) 162 | } 163 | 164 | font <- if (italics) 3 else NULL 165 | if (text_pos == "top") { 166 | tfilter <- which(TX$tmin > (xrange[1] - diff(xrange) * 0.04) & 167 | (TX$tmax < xrange[2] + diff(xrange) * 0.04)) 168 | for (i in tfilter) { 169 | text(TX$mean[i], -TX[i, 'row'] + 0.45, 170 | labels = bquote_gene(TX$gene_name[i], TX$strand[i], italics), 171 | cex = cex.text, xpd = NA) 172 | } 173 | } else if (text_pos == "left") { 174 | tfilter <- if (border) { 175 | which(TX$tmin > xrange[1]) 176 | } else seq_len(nrow(TX)) 177 | for (i in tfilter) { 178 | text(max(c(TX$start[i], xrange[1] - diff(xrange) * 0.04)), -TX[i, 'row'], 179 | labels = bquote_gene(TX$gene_name[i], TX$strand[i], italics), 180 | cex = cex.text, pos = 2, xpd = NA) 181 | } 182 | } 183 | 184 | } 185 | 186 | bquote_gene <- function(gene, strand, italics) { 187 | if (strand == "+") { 188 | if (!italics) {bquote(.(gene) * symbol("\256")) 189 | } else bquote(italic(.(gene)) * symbol("\256")) 190 | } else { 191 | if (!italics) {bquote(symbol("\254") * .(gene)) 192 | } else bquote(symbol("\254") * italic(.(gene))) 193 | } 194 | } 195 | 196 | # map genes into rows without overlap 197 | mapRow <- function(TX, gap = diff(xlim) * 0.02, cex.text = 0.7, 198 | xlim = range(TX[, c('start', 'end')]), 199 | text_pos = 'top', blanks = "fill") { 200 | blank <- TX$gene_name == "" 201 | if (any(blank)) { 202 | if (blanks == "fill") { 203 | TX$gene_name[blank] <- TX$gene_id[blank] 204 | } else if (blanks == "hide") { 205 | TX <- TX[!blank, ] 206 | } 207 | } 208 | gw <- strwidth(paste0("--", TX$gene_name), units = "inch", 209 | cex = cex.text) * diff(xlim) / par("pin")[1] 210 | TX$mean <- rowMeans(TX[, c('start', 'end')]) 211 | if (text_pos == 'top') { 212 | TX$tmin <- TX$mean - gw / 2 213 | TX$tmax <- TX$mean + gw / 2 214 | } else if (text_pos == 'left') { 215 | TX$tmin <- TX$start - gw - gap 216 | TX$tmax <- TX$end 217 | } else if (text_pos == 'none') { 218 | TX$tmax <- TX$tmin <- TX$mean 219 | } 220 | TX$min <- pmin(TX$start, TX$end, TX$tmin) - gap / 2 221 | TX$max <- pmax(TX$start, TX$end, TX$tmax) + gap / 2 222 | TX$row <- 0 223 | j <- 1 224 | while (any(TX$row == 0)) { 225 | xset <- which(TX$row == 0) 226 | for (i in xset) { 227 | # overlap detection 228 | if (!any(TX$min[i] < TX$max[TX$row == j] & 229 | TX$max[i] > TX$min[TX$row == j])) { 230 | TX$row[i] <- j 231 | } 232 | } 233 | j <- j + 1 234 | } 235 | TX 236 | } 237 | 238 | 239 | # highlight selected genes 240 | gene_colours <- function(TX, gene_col, exon_col, exon_border, showExons, 241 | highlight, highlight_col) { 242 | if (is.null(TX$gene_col)) TX$gene_col <- gene_col 243 | if (is.null(TX$exon_col)) TX$exon_col <- exon_col 244 | if (is.null(TX$exon_border)) TX$exon_border <- exon_border 245 | w <- match(highlight, TX$gene_name) 246 | w <- w[!is.na(w)] 247 | if (length(w) > 0) { 248 | TX$gene_col[w] <- highlight_col 249 | if (showExons) { 250 | TX$exon_col[w] <- highlight_col 251 | TX$exon_border[w] <- highlight_col 252 | } 253 | } 254 | TX 255 | } 256 | -------------------------------------------------------------------------------- /R/scatter_plot.R: -------------------------------------------------------------------------------- 1 | 2 | #' Locus scatter plot 3 | #' 4 | #' Produces a base graphics scatter plot from a 'locus' class object. This 5 | #' function is called by [locus_plot()] to generate the scatter plot portion. 6 | #' Can be used manually with [set_layers()]. 7 | #' 8 | #' @param loc Object of class 'locus' to use for plot. See [locus]. 9 | #' @param index_snp Specifies index SNP or a vector of SNPs to be shown in a 10 | #' different colour and symbol. Defaults to the SNP with the lowest p-value. 11 | #' Set to `NULL` to not show this. 12 | #' @param pcutoff Cut-off for p value significance. Defaults to p = 5e-08. Set 13 | #' to `NULL` to disable. 14 | #' @param scheme Vector of 3 colours if LD is not shown: 1st = normal points, 15 | #' 2nd = colour for significant points, 3rd = index SNP(s). 16 | #' @param cex Specifies size for points. 17 | #' @param cex.axis Specifies font size for axis numbering. 18 | #' @param cex.lab Specifies font size for axis titles. 19 | #' @param xlab x axis title. 20 | #' @param ylab y axis title. 21 | #' @param ylim y axis limits (y1, y2). 22 | #' @param ylim2 Secondary y axis limits for recombination line, if present. 23 | #' @param yzero Logical whether to force y axis limit to include y=0. 24 | #' @param xticks Logical whether x axis numbers and axis title are plotted. 25 | #' @param border Logical whether a bounding box is plotted around upper and 26 | #' lower plots. 27 | #' @param showLD Logical whether to show LD with colours 28 | #' @param LD_scheme Vector of colours for plotting LD. The first colour is for 29 | #' SNPs which lack LD information. The next 5 colours are for r2 or D' LD 30 | #' results ranging from 0 to 1 in intervals of 0.2. The final colour is for 31 | #' the index SNP. 32 | #' @param recomb_col Colour for recombination rate line if recombination rate 33 | #' data is present. Set to `NA` to hide the line. See [link_recomb()] to add 34 | #' recombination rate data. 35 | #' @param recomb_offset Offset from 0-1 which shifts the scatter plot up and 36 | #' recombination line plot down. Recommended value 0.1. 37 | #' @param legend_pos Position of legend. See [legend()]. Set to `NULL` to hide 38 | #' legend. 39 | #' @param labels Character vector of SNP or genomic feature IDs to label. The 40 | #' value "index" selects the highest point or index SNP as defined when 41 | #' [locus()] is called. Set to `NULL` to remove all labels. 42 | #' @param label_x Value or vector for position of label as percentage of x axis 43 | #' scale. 44 | #' @param label_y Value or vector for position of label as percentage of y axis 45 | #' scale. 46 | #' @param eqtl_gene Column name in `loc$data` for colouring eQTL genes. 47 | #' @param beta Optional column name for beta coefficient to display upward 48 | #' triangles for positive beta and downward triangles for negative beta 49 | #' (significant SNPs only). 50 | #' @param add Logical whether to add points to an existing plot or generate a 51 | #' new plot. 52 | #' @param align Logical whether to set [par()] to align the plot. 53 | #' @param ... Other arguments passed to [plot()] to control the scatter plot 54 | #' e.g. `main`, `ylim` etc. 55 | #' @return No return value. Produces a scatter plot using base graphics. 56 | #' @details 57 | #' Advanced users familiar with base graphics can customise every single point 58 | #' on the scatter plot, by adding columns named `bg`, `col`, `pch` or `cex` 59 | #' directly to the dataframe stored in `$data` element of the 'locus' object. 60 | #' Setting these will overrule any default settings. These columns refer to 61 | #' their respective base graphics arguments, see [graphics::points()]. 62 | #' 63 | #' @seealso [locus()] [set_layers()] 64 | #' @importFrom graphics par legend mtext 65 | #' @export 66 | #' 67 | scatter_plot <- function(loc, 68 | index_snp = loc$index_snp, 69 | pcutoff = 5e-08, 70 | scheme = c('grey', 'dodgerblue', 'red'), 71 | cex = 1, 72 | cex.axis = 0.9, 73 | cex.lab = 1, 74 | xlab = NULL, 75 | ylab = NULL, 76 | ylim = NULL, 77 | ylim2 = c(0, 100), 78 | yzero = (loc$yvar == "logP"), 79 | xticks = TRUE, 80 | border = FALSE, 81 | showLD = TRUE, 82 | LD_scheme = c('grey', 'royalblue', 'cyan2', 'green3', 83 | 'orange', 'red', 'purple'), 84 | recomb_col = "blue", 85 | recomb_offset = 0, 86 | legend_pos = 'topleft', 87 | labels = NULL, 88 | label_x = 4, label_y = 4, 89 | eqtl_gene = NULL, 90 | beta = NULL, 91 | add = FALSE, 92 | align = TRUE, ...) { 93 | if (!inherits(loc, "locus")) stop("Object of class 'locus' required") 94 | if (is.null(loc$data)) stop("No data points, only gene tracks") 95 | 96 | .call <- match.call() 97 | data <- loc$data 98 | if (is.null(xlab)) xlab <- paste("Chromosome", loc$seqname, "(Mb)") 99 | if (is.null(ylab)) { 100 | ylab <- if (loc$yvar == "logP") expression("-log"[10] ~ "P") else loc$yvar 101 | } 102 | hasLD <- "ld" %in% colnames(data) 103 | if (!"bg" %in% colnames(data)) { 104 | if (showLD & hasLD) { 105 | data$bg <- cut(data$ld, -1:6/5, labels = FALSE) 106 | data$bg[is.na(data$bg)] <- 1L 107 | data$bg[data[, loc$labs] %in% index_snp] <- 7L 108 | data <- data[order(data$bg), ] 109 | LD_scheme <- rep_len(LD_scheme, 7) 110 | data$bg <- LD_scheme[data$bg] 111 | } else if (!is.null(eqtl_gene)) { 112 | # eqtl gene colours 113 | bg <- data[, eqtl_gene] 114 | bg[data[, loc$p] > pcutoff] <- "ns" 115 | bg <- relevel(factor(bg, levels = unique(bg)), "ns") 116 | if (is.null(.call$scheme)) scheme <- eqtl_scheme(nlevels(bg)) 117 | data$bg <- scheme[bg] 118 | } else { 119 | # default colours 120 | data$bg <- 1L 121 | if (loc$yvar == "logP") data$bg[data[, loc$p] < pcutoff] <- 2L 122 | data$bg[data[, loc$labs] %in% index_snp] <- 3L 123 | data <- data[order(data$bg), ] 124 | data$bg <- scheme[data$bg] 125 | } 126 | } 127 | 128 | # scatter plot 129 | recomb <- !is.null(loc$recomb) & !is.na(recomb_col) 130 | if (align) { 131 | op <- par(mar = c(ifelse(xticks, 3, 0.1), 3.5, 2, 132 | ifelse(recomb, 3.5, 1.5))) 133 | on.exit(par(op)) 134 | } 135 | 136 | if (is.null(ylim)) { 137 | ylim <- range(data[, loc$yvar], na.rm = TRUE) 138 | if (yzero & is.null(ylim)) ylim[1] <- min(c(0, ylim[1])) 139 | if (!is.null(labels) & (border | recomb)) { 140 | ylim[2] <- ylim[2] + diff(ylim) * 0.08 141 | } 142 | } 143 | # offset y1 144 | yd <- diff(ylim) 145 | if (recomb && recomb_offset != 0) ylim[1] <- ylim[1] - yd * recomb_offset 146 | 147 | panel.first <- quote({ 148 | if (loc$yvar == "logP" & !is.null(pcutoff)) { 149 | abline(h = -log10(pcutoff), col = 'darkgrey', lty = 2) 150 | } 151 | if (recomb) { 152 | yd2 <- diff(ylim2) 153 | fy2 <- function(yy) (yy - ylim2[1]) / yd2 * yd + ylim[1] 154 | ry <- fy2(loc$recomb$value) 155 | lines(loc$recomb$start, ry, col = recomb_col) 156 | labs2 <- pretty(ylim2) 157 | at <- fy2(labs2) 158 | axis(4, at = at, labels = labs2, 159 | las = 1, tcl = plot.args$tcl, mgp = plot.args$mgp, 160 | cex.axis = cex.axis) 161 | mtext("Recombination rate (%)", 4, cex = cex.lab * par("cex"), 162 | line = plot.args$mgp[1], 163 | adj = max(c(0.5 - recomb_offset / 2, 0))) 164 | } 165 | }) 166 | 167 | # shapes 168 | pch <- rep(21L, nrow(data)) 169 | pch[data[, loc$labs] %in% index_snp] <- 23L 170 | if (!is.null(beta)) { 171 | sig <- data[, loc$p] < pcutoff 172 | pch[sig] <- 24 + (1 - sign(data[sig, beta])) / 2 173 | } 174 | if ("pch" %in% colnames(data)) pch <- data$pch 175 | col <- "black" 176 | if ("col" %in% colnames(data)) col <- data$col 177 | if ("cex" %in% colnames(data)) cex <- data$cex 178 | 179 | new.args <- list(...) 180 | if (add) { 181 | plot.args <- list(x = data[, loc$pos], y = data[, loc$yvar], 182 | pch = pch, bg = data$bg, cex = cex) 183 | if (length(new.args)) plot.args[names(new.args)] <- new.args 184 | return(do.call("points", plot.args)) 185 | } 186 | 187 | bty <- if (border | recomb) 'o' else 'l' 188 | plot.args <- list(x = data[, loc$pos], y = data[, loc$yvar], 189 | pch = pch, bg = data$bg, col = col, 190 | las = 1, font.main = 1, 191 | cex = cex, cex.axis = cex.axis, cex.lab = cex.lab, 192 | xlim = loc$xrange, 193 | ylim = ylim, 194 | xlab = if (xticks) xlab else "", 195 | ylab = ylab, 196 | bty = bty, 197 | xaxt = 'n', 198 | tcl = -0.3, 199 | mgp = c(1.7, 0.5, 0), 200 | panel.first = panel.first) 201 | if (recomb && recomb_offset != 0) { 202 | plot.args$ylab <- "" 203 | plot.args <- c(plot.args, yaxt = 'n') 204 | } 205 | if (length(new.args)) plot.args[names(new.args)] <- new.args 206 | do.call("plot", plot.args) 207 | 208 | # offset y1 axis ticks 209 | if (recomb && recomb_offset != 0) { 210 | ypretty <- pretty(c(min(data[, loc$yvar], na.rm = TRUE), ylim[2])) 211 | axis(2, at = ypretty, las = 1, mgp = plot.args$mgp, cex.axis = cex.axis, 212 | tcl = plot.args$tcl) 213 | mtext(ylab, 2, cex = cex.lab * par("cex"), line = plot.args$mgp[1], 214 | adj = min(c(0.5 + recomb_offset / 2.7, 1))) 215 | } 216 | 217 | # add labels 218 | if (!is.null(labels)) { 219 | i <- grep("index", labels, ignore.case = TRUE) 220 | if (length(i) > 0) { 221 | if (length(index_snp) == 1) { 222 | labels[i] <- index_snp 223 | } else { 224 | labels <- labels[-i] 225 | labels <- c(index_snp, labels) 226 | } 227 | } 228 | ind <- match(labels, data[, loc$labs]) 229 | if (any(is.na(ind))) { 230 | message("label ", paste(labels[is.na(ind)], collapse = ", "), 231 | " not found") 232 | } 233 | lx <- data[ind, loc$pos] 234 | ly <- data[ind, loc$yvar] 235 | labs <- data[ind, loc$labs] 236 | add_labels(lx, ly, labs, label_x, label_y, cex = cex.axis *0.95) 237 | } 238 | 239 | if (xticks) { 240 | axis(1, at = axTicks(1), labels = axTicks(1) / 1e6, cex.axis = cex.axis, 241 | mgp = c(1.7, 0.4, 0), tcl = plot.args$tcl) 242 | } else if (!border) { 243 | axis(1, at = axTicks(1), labels = FALSE, tcl = plot.args$tcl) 244 | } 245 | if (!is.null(legend_pos)) { 246 | leg <- pt.bg <- pch <- title <- NULL 247 | if (!is.null(eqtl_gene)) { 248 | leg <- levels(bg)[-1] 249 | pt.bg <- scheme[-1] 250 | pch <- c(rep(21, length(scheme) -1)) 251 | } else if (showLD & hasLD) { 252 | leg <- c("0.8 - 1.0", "0.6 - 0.8", "0.4 - 0.6", "0.2 - 0.4", 253 | "0.0 - 0.2") 254 | title <- expression({r^2}) 255 | pch <- rep(21, 5) 256 | pt.bg <- rev(LD_scheme[-c(1, 7)]) 257 | } 258 | if (!is.null(beta)) { 259 | leg <- c(leg, expression({beta > 0}), expression({beta < 0})) 260 | pch <- c(pch, 2, 6) 261 | pt.bg <- c(pt.bg, NA, NA) 262 | } 263 | if (!is.null(leg)) { 264 | legend(legend_pos, legend = leg, y.intersp = 0.96, title = title, 265 | pch = pch, pt.bg = pt.bg, col = 'black', bty = 'n', cex = 0.8) 266 | } 267 | } 268 | } 269 | 270 | 271 | add_labels <- function(lx, ly, labs, label_x, label_y, cex = 1) { 272 | label_x <- rep_len(label_x, length(lx)) 273 | label_y <- rep_len(label_y, length(ly)) 274 | dx <- diff(par("usr")[1:2]) * label_x /100 275 | dy <- diff(par("usr")[3:4]) * label_y /100 276 | dlines(lx, ly, dx, dy, xpd = NA) 277 | adj1 <- -sign(dx) *0.56+0.5 278 | adj2 <- -sign(dy) +0.5 279 | adj2[abs(label_x) > abs(label_y)] <- 0.5 280 | adj1[abs(label_x) < abs(label_y)] <- 0.5 281 | if (length(unique(adj1)) == 1 & length(unique(adj2)) == 1) { 282 | # unique adj 283 | adj <- c(adj1[1], adj2[1]) 284 | text(lx + dx, ly + dy, labs, 285 | adj = adj, cex = cex, xpd = NA) 286 | } else { 287 | # varying adj 288 | adj <- cbind(adj1, adj2) 289 | for (i in seq_along(labs)) { 290 | text(lx[i] + dx[i], ly[i] + dy[i], labs[i], 291 | adj = adj[i,], cex = cex, xpd = NA) 292 | } 293 | } 294 | } 295 | 296 | 297 | dlines <- function(x, y, dx, dy, ...) { 298 | mx <- cbind(x, x + dx, NA) 299 | my <- cbind(y, y + dy, NA) 300 | xs <- as.vector(t(mx)) 301 | ys <- as.vector(t(my)) 302 | lines(xs, ys, ...) 303 | } 304 | -------------------------------------------------------------------------------- /R/scatter_plotly.R: -------------------------------------------------------------------------------- 1 | 2 | #' Locus scatter plotly 3 | #' 4 | #' Produces a scatter plot from a 'locus' class object using plotly. 5 | #' 6 | #' @param loc Object of class 'locus' to use for plot. See [locus]. 7 | #' @param index_snp Specifies index SNP or a vector of SNPs to be shown in a 8 | #' different colour and symbol. Defaults to the SNP with the lowest p-value. 9 | #' Set to `NULL` to not show this. 10 | #' @param pcutoff Cut-off for p value significance. Defaults to p = 5e-08. Set 11 | #' to `NULL` to disable. 12 | #' @param scheme Vector of 3 colours if LD is not shown: 1st = normal points, 13 | #' 2nd = colour for significant points, 3rd = index SNP(s). 14 | #' @param xlab x axis title. 15 | #' @param ylab y axis title. 16 | #' @param yzero Logical whether to force y axis limit to include y=0. 17 | #' @param showLD Logical whether to show LD with colours 18 | #' @param LD_scheme Vector of colours for plotting LD. The first colour is for 19 | #' SNPs which lack LD information. The next 5 colours are for r^2 or D' LD 20 | #' results ranging from 0 to 1 in intervals of 0.2. The final colour is for 21 | #' the index SNP. 22 | #' @param marker_outline Specifies colour for outlining points. 23 | #' @param marker_size Value for size of markers in plotly units. 24 | #' @param recomb_col Colour for recombination rate line if recombination rate 25 | #' data is present. Set to `NA` to hide the line. See [link_recomb()] to add 26 | #' recombination rate data. 27 | #' @param eqtl_gene Column name in `loc$data` for eQTL genes. 28 | #' @param beta Optional column name for beta coefficient to display upward 29 | #' triangles for positive beta and downward triangles for negative beta 30 | #' (significant SNPs only). 31 | #' @param add_hover Optional vector of column names in `loc$data` to add to the 32 | #' plotly hover text for scatter points. 33 | #' @param showlegend Logical whether to show a legend for the scatter points. 34 | #' @param height Height in pixels (optional, defaults to automatic sizing). 35 | #' @param webGL Logical whether to use webGL or SVG for scatter plot. 36 | #' @return A `plotly` scatter plot. 37 | #' @seealso [locus()] [locus_plotly()] 38 | #' @importFrom plotly add_trace plotly_build 39 | #' @importFrom stats relevel 40 | #' @export 41 | #' 42 | scatter_plotly <- function(loc, 43 | index_snp = loc$index_snp, 44 | pcutoff = 5e-08, 45 | scheme = c('grey', 'dodgerblue', 'red'), 46 | xlab = NULL, 47 | ylab = NULL, 48 | yzero = (loc$yvar == "logP"), 49 | showLD = TRUE, 50 | LD_scheme = c('grey', 'royalblue', 'cyan2', 'green3', 51 | 'orange', 'red', 'purple'), 52 | marker_outline = "black", 53 | marker_size = 7, 54 | recomb_col = "blue", 55 | eqtl_gene = NULL, 56 | beta = NULL, 57 | add_hover = NULL, 58 | showlegend = TRUE, 59 | height = NULL, 60 | webGL = TRUE) { 61 | if (!inherits(loc, "locus")) stop("Object of class 'locus' required") 62 | if (is.null(loc$data)) stop("No SNPs/data points", call. = FALSE) 63 | 64 | .call <- match.call() 65 | data <- loc$data 66 | if (is.null(xlab)) xlab <- paste("Chromosome", loc$seqname, "(Mb)") 67 | if (is.null(ylab)) { 68 | ylab <- if (loc$yvar == "logP") "-log10 P" else loc$yvar 69 | } 70 | hasLD <- "ld" %in% colnames(data) 71 | leg <- list() 72 | if (!"bg" %in% colnames(data)) { 73 | if (showLD & hasLD) { 74 | data$bg <- cut(data$ld, -1:6/5, labels = FALSE) 75 | data$bg[is.na(data$bg)] <- 1L 76 | data$bg[data[, loc$labs] %in% index_snp] <- 7L 77 | data <- data[order(data$bg), ] 78 | scheme <- rep_len(LD_scheme, 7 - is.null(index_snp)) 79 | data$bg <- factor(data$bg, levels = 1:7, 80 | labels = c("unknown", "0.0 - 0.2", "0.2 - 0.4", 81 | "0.4 - 0.6", "0.6 - 0.8", "0.8 - 1.0", 82 | "index")) 83 | leg <- list(title = list(text = "Linkage r2")) 84 | } else if (!is.null(eqtl_gene)) { 85 | bg <- data[, eqtl_gene] 86 | bg[data[, loc$p] > pcutoff] <- "ns" 87 | data$bg <- relevel(factor(bg, levels = unique(bg)), "ns") 88 | if (is.null(.call$scheme)) scheme <- eqtl_scheme(nlevels(data$bg)) 89 | } else { 90 | # default colours 91 | showLD <- FALSE 92 | data$bg <- scheme[1] 93 | if (loc$yvar == "logP") data$bg[data[, loc$p] < pcutoff] <- scheme[2] 94 | data$bg[data[, loc$labs] %in% index_snp] <- scheme[3] 95 | data$bg <- factor(data$bg, levels = scheme, 96 | labels = c("ns", paste("P <", signif(pcutoff, 3)), "index")) 97 | } 98 | } 99 | if (!is.null(beta)) { 100 | # beta symbols 101 | data[, beta] <- signif(data[, beta], 3) 102 | symbol <- as.character(sign(data[, beta])) 103 | ind <- data[, loc$p] > pcutoff 104 | symbol[ind] <- "ns" 105 | data$symbol <- factor(symbol, levels = c("ns", "1", "-1"), 106 | labels = c(" ", "up", "down")) 107 | # labels = c(" ", "β > 0", "β < 0") 108 | symbols <- c(21L, 24L, 25L) 109 | data$size <- 1L 110 | data$size[!ind] <- 2L 111 | sizes <- if (sum(!ind) == 0) c(50, 50) else c(50, 100) 112 | if (!webGL) sizes <- sizes/2 113 | leg <- list(traceorder = "reversed") 114 | } else { 115 | if (is.null(eqtl_gene)) { 116 | # default plot 117 | data$symbol <- data$bg 118 | symbols <- c(rep("circle", length(scheme) -1), "diamond") 119 | } else { 120 | # eqtl gene only 121 | data$symbol <- 1L 122 | symbols <- "circle" 123 | } 124 | } 125 | 126 | # scatter plotly 127 | recomb <- !is.null(loc$recomb) & !is.na(recomb_col) 128 | 129 | xlim <- loc$xrange / 1e6 130 | xext <- diff(xlim) * 0.01 131 | xlim <- xlim + c(-xext, xext) 132 | 133 | ylim <- range(data[, loc$yvar], na.rm = TRUE) 134 | if (yzero) ylim[1] <- min(c(0, ylim[1])) 135 | ydiff <- diff(ylim) 136 | ylim[2] <- ylim[2] + ydiff * 0.05 137 | ylim[1] <- if (ylim[1] != 0) ylim[1] - ydiff *0.05 else ylim[1] - ydiff *0.02 138 | 139 | hovertext <- paste0(data[, loc$labs], "
Chr ", 140 | data[, loc$chrom], ": ", data[, loc$pos], 141 | "
P = ", signif(data[, loc$p], 3)) 142 | add_hover <- c(beta, eqtl_gene, add_hover) 143 | if (!is.null(add_hover)) { 144 | for (i in add_hover) { 145 | hovertext <- paste0(hovertext, "
", i, ": ", data[, i]) 146 | } 147 | } 148 | 149 | hline <- list(type = "line", 150 | line = list(width = 1, color = '#999999', dash = 'dash'), 151 | x0 = 0, x1 = 1, y0 = -log10(pcutoff), y1 = -log10(pcutoff), 152 | xref = "paper", layer = "below") 153 | type <- if (webGL) "scattergl" else "scatter" 154 | 155 | if (!recomb) { 156 | if (is.null(beta)) { 157 | # standard plotly 158 | p <- plot_ly(x = data[, loc$pos] / 1e6, y = data[, loc$yvar], 159 | color = data$bg, colors = scheme, 160 | symbol = data$symbol, symbols = symbols, 161 | marker = list(size = marker_size, opacity = 0.8, 162 | line = list(width = 1, color = marker_outline)), 163 | text = hovertext, hoverinfo = 'text', 164 | key = data[, loc$labs], 165 | showlegend = showlegend, 166 | source = "plotly_locus", height = height, 167 | type = type, mode = "markers") 168 | } else { 169 | # beta shapes 170 | p <- plot_ly(x = data[, loc$pos] / 1e6, y = data[, loc$yvar], 171 | color = data$bg, colors = scheme, 172 | symbol = data$symbol, symbols = symbols, 173 | size = data$size, sizes = sizes, 174 | marker = list(opacity = 0.8, 175 | line = list(width = 1, color = marker_outline)), 176 | text = hovertext, hoverinfo = 'text', 177 | key = data[, loc$labs], 178 | showlegend = showlegend, 179 | source = "plotly_locus", height = height, 180 | type = type, mode = "markers") 181 | } 182 | p <- p %>% 183 | plotly::layout(xaxis = list(title = xlab, 184 | ticks = "outside", 185 | zeroline = FALSE, showgrid = FALSE, 186 | range = as.list(xlim)), 187 | yaxis = list(title = ylab, 188 | ticks = "outside", 189 | fixedrange = TRUE, 190 | showline = TRUE, 191 | range = ylim), 192 | shapes = hline, legend = leg, dragmode = "pan") 193 | } else { 194 | # double y axis with recombination 195 | ylim2 <- c(-2, 102) 196 | if (is.null(beta)) { 197 | # standard plotly 198 | p <- plot_ly(source = "plotly_locus", height = height) %>% 199 | # recombination line 200 | add_trace(x = loc$recomb$start / 1e6, y = loc$recomb$value, 201 | hoverinfo = "none", colors = scheme, # colors must go here 202 | symbols = symbols, 203 | name = "recombination", yaxis = "y2", 204 | line = list(color = recomb_col, width = 1.5), 205 | mode = "lines", type = type, showlegend = FALSE) %>% 206 | # scatter plot 207 | add_trace(x = data[, loc$pos] / 1e6, y = data[, loc$yvar], 208 | color = data$bg, 209 | symbol = data$symbol, 210 | marker = list(size = marker_size, opacity = 0.8, 211 | line = list(width = 1, color = marker_outline)), 212 | text = hovertext, hoverinfo = 'text', key = data[, loc$labs], 213 | showlegend = showlegend, 214 | type = type, mode = "markers") 215 | } else { 216 | # beta shapes 217 | p <- plot_ly(source = "plotly_locus", height = height) %>% 218 | # recombination line 219 | add_trace(x = loc$recomb$start / 1e6, y = loc$recomb$value, 220 | hoverinfo = "none", colors = scheme, # colors must go here 221 | symbols = symbols, sizes = sizes, 222 | name = "recombination", yaxis = "y2", 223 | line = list(color = recomb_col, width = 1.5), 224 | mode = "lines", type = type, showlegend = FALSE) %>% 225 | # scatter plot 226 | add_trace(x = data[, loc$pos] / 1e6, y = data[, loc$yvar], 227 | color = data$bg, 228 | symbol = data$symbol, 229 | size = data$size, 230 | marker = list(opacity = 0.8, 231 | line = list(width = 1, color = marker_outline)), 232 | text = hovertext, hoverinfo = 'text', key = data[, loc$labs], 233 | showlegend = showlegend, 234 | type = type, mode = "markers") 235 | } 236 | p <- p %>% 237 | plotly::layout(xaxis = list(title = xlab, 238 | ticks = "outside", 239 | zeroline = FALSE, 240 | range = as.list(xlim)), 241 | yaxis = list(title = ylab, 242 | ticks = "outside", showgrid = FALSE, 243 | showline = TRUE, fixedrange = TRUE, 244 | range = ylim), 245 | yaxis2 = list(overlaying = "y", side = "right", 246 | title = "Recombination rate (%)", 247 | ticks = "outside", showgrid = FALSE, 248 | showline = TRUE, fixedrange = TRUE, 249 | zeroline = FALSE, range = ylim2), 250 | shapes = hline, 251 | legend = c(leg, x = 1.1, y = 1), showlegend = TRUE) 252 | } 253 | p <- p %>% 254 | plotly::config(displaylogo = FALSE, 255 | modeBarButtonsToRemove = c("select2d", "lasso2d", 256 | "autoScale2d", "resetScale2d", 257 | "hoverClosest", "hoverCompare")) 258 | 259 | if (hasLD) suppressWarnings(plotly_build(p)) else p 260 | } 261 | 262 | 263 | #' @importFrom grDevices rainbow 264 | eqtl_scheme <- function(n) { 265 | if (n < 8) { 266 | scheme <- c('grey', 'purple', 'green3', 'orange', 'royalblue', 'red', 267 | 'cyan')[1:n] 268 | } else { 269 | scheme <- c('grey', rainbow(n -1)) 270 | } 271 | scheme 272 | } 273 | -------------------------------------------------------------------------------- /R/locus.R: -------------------------------------------------------------------------------- 1 | 2 | #' Create locus object for plotting 3 | #' 4 | #' Creates object of class 'locus' for genomic locus plot similar to 5 | #' `locuszoom`. 6 | #' 7 | #' @details 8 | #' This is an R version of `locuszoom` (http://locuszoom.org) for generating 9 | #' publication ready Manhattan plots of gene loci. It references Ensembl 10 | #' databases using the `ensembldb` Bioconductor package framework for annotating 11 | #' genes and exons in the locus. 12 | #' 13 | #' @param data Dataset (data.frame or data.table) to use for plot. We recommend 14 | #' that tibbles are converted to a normal data.frame. If unspecified or 15 | #' `NULL`, gene track information alone is returned. 16 | #' @param gene Optional character value specifying which gene to view. Either 17 | #' `gene`, or `xrange` plus `seqname`, or `index_snp` must be specified. 18 | #' @param xrange Optional vector of genomic position range for the x axis. 19 | #' @param seqname Optional, specifies which chromosome to plot. 20 | #' @param flank Single value or vector with 2 values for how much flanking 21 | #' region left and right of the gene to show. Defaults to 100kb. 22 | #' @param fix_window Optional alternative to `flank`, which allows users to 23 | #' specify a fixed genomic window centred on the specified gene. Both `flank` 24 | #' and `fix_window` cannot be specified simultaneously. 25 | #' @param ens_db Either a character string which specifies which Ensembl 26 | #' database package (version 86 and earlier for Homo sapiens) to query for 27 | #' gene and exon positions (see `ensembldb` Bioconductor package). Or an 28 | #' `ensembldb` object which can be obtained from the AnnotationHub database. 29 | #' See the vignette and the `AnnotationHub` Bioconductor package for how to 30 | #' create this object. 31 | #' @param chrom Determines which column in `data` contains chromosome 32 | #' information. If `NULL` tries to autodetect the column. 33 | #' @param pos Determines which column in `data` contains position information. 34 | #' If `NULL` tries to autodetect the column. 35 | #' @param p Determines which column in `data` contains SNP p-values. 36 | #' If `NULL` tries to autodetect the column. 37 | #' @param yvar Specifies column in `data` for plotting on the y axis as an 38 | #' alternative to specifying p-values. Both `p` and `yvar` cannot be specified 39 | #' simultaneously. 40 | #' @param labs Determines which column in `data` contains SNP rs IDs. 41 | #' If `NULL` tries to autodetect the column. 42 | #' @param index_snp Specifies the index SNP. If not specified, the SNP with the 43 | #' lowest P value is selected. Can be used to specify locus region instead of 44 | #' specifying `gene`, or `seqname` and `xrange`. 45 | #' @param LD Optional character value to specify which column in `data` contains 46 | #' LD information. 47 | #' @param std_filter Logical, whether standard filters on chromosomes 1-22, X & 48 | #' Y, and filtering of genes to only those whose transcript ids start with 49 | #' "ENS" are applied. For users with novel genome assemblies, this probably 50 | #' needs to be set to `FALSE`. 51 | #' @return Returns a list object of class 'locus' ready for plotting, 52 | #' containing: 53 | #' \item{seqname}{chromosome value} 54 | #' \item{xrange}{vector of genomic position range} 55 | #' \item{gene}{gene name} 56 | #' \item{ens_db}{Ensembl or AnnotationHub database} 57 | #' \item{ens_version}{Ensembl database version} 58 | #' \item{organism}{Ensembl database organism} 59 | #' \item{genome}{Ensembl data genome build} 60 | #' \item{chrom}{column name in `data` containing chromosome information} 61 | #' \item{pos}{column name in `data` containing position} 62 | #' \item{p}{column name in `data` containing p-value} 63 | #' \item{yvar}{column name in `data` to be plotted on y axis as alternative to 64 | #' `p`} 65 | #' \item{labs}{column name in `data` containing SNP IDs} 66 | #' \item{index_snp}{id of the most significant SNP} 67 | #' \item{data}{the subset of GWAS data to be plotted} 68 | #' \item{TX}{dataframe of transcript annotations} 69 | #' \item{EX}{`GRanges` object of exon annotations} 70 | #' If `data` is `NULL` when `locus()` is called then gene track information 71 | #' alone is returned. 72 | #' @seealso [locus_plot()] [locus_ggplot()] [locus_plotly()] 73 | #' @examples 74 | #' ## Bioconductor package EnsDb.Hsapiens.v75 is needed for these examples 75 | #' if(require(EnsDb.Hsapiens.v75)) { 76 | #' data(SLE_gwas_sub) 77 | #' loc <- locus(SLE_gwas_sub, gene = 'UBE2L3', flank = 1e5, 78 | #' ens_db = "EnsDb.Hsapiens.v75") 79 | #' summary(loc) 80 | #' locus_plot(loc) 81 | #' loc2 <- locus(SLE_gwas_sub, gene = 'STAT4', flank = 1e5, 82 | #' ens_db = "EnsDb.Hsapiens.v75") 83 | #' locus_plot(loc2) 84 | #' } 85 | #' @importFrom ensembldb genes exons ensemblVersion organism 86 | #' @importFrom BiocGenerics start end 87 | #' @importFrom AnnotationFilter GeneNameFilter AnnotationFilterList 88 | #' SeqNameFilter GeneIdFilter TxStartFilter TxEndFilter ExonStartFilter 89 | #' ExonEndFilter 90 | #' @importFrom GenomeInfoDb seqlengths genome 91 | #' @importFrom memoise memoise 92 | #' @export 93 | 94 | locus <- function(data = NULL, 95 | gene = NULL, 96 | xrange = NULL, seqname = NULL, 97 | flank = NULL, fix_window = NULL, 98 | ens_db, 99 | chrom = NULL, pos = NULL, p = NULL, yvar = NULL, 100 | labs = NULL, 101 | index_snp = NULL, 102 | LD = NULL, 103 | std_filter = TRUE) { 104 | if (is.character(ens_db)) { 105 | if (!ens_db %in% (.packages())) { 106 | stop("Ensembl database not loaded. Try: library(", ens_db, ")", 107 | call. = FALSE) 108 | } 109 | edb <- get(ens_db) 110 | } else edb <- ens_db 111 | if (!is.null(flank) & !is.null(fix_window)) 112 | stop("both `flank` and `fix_window` cannot be specified at the same time") 113 | if (is.null(flank)) flank <- 1e5 114 | flank <- rep_len(flank, 2) 115 | seqfilt <- if (std_filter) SeqNameFilter(c(1:22, 'X', 'Y')) else NULL 116 | genefilt <- if (std_filter) GeneIdFilter("ENS", "startsWith") else NULL 117 | 118 | if (!is.null(gene)) { 119 | locus <- genes(edb, filter = AnnotationFilterList( 120 | GeneNameFilter(gene), seqfilt)) 121 | 122 | if (length(locus) == 0) stop("gene not found") 123 | if (length(locus) > 1) { 124 | message(sprintf('Identified %d genes matching name \'%s\', taking first', 125 | length(locus), gene)) 126 | locus <- locus[1] 127 | } 128 | seqname <- names(seqlengths(locus)) 129 | if (is.null(fix_window)) { 130 | xrange <- c(start(locus) - flank[1], end(locus) + flank[2]) 131 | } else { 132 | m <- mean(c(start(locus), end(locus))) 133 | xrange <- as.integer(c(m - fix_window/2, m + fix_window/2)) 134 | } 135 | xrange[xrange < 0] <- 0 136 | } 137 | 138 | if (!is.null(data)) { 139 | if (inherits(data, "tbl_df")) data <- as.data.frame(data) 140 | 141 | # autodetect headings 142 | dc <- detect_cols(data, chrom, pos, p, labs, yvar) 143 | chrom <- dc$chrom 144 | pos <- dc$pos 145 | p <- dc$p 146 | labs <- dc$labs 147 | 148 | if (!is.null(index_snp) & is.null(gene) & is.null(seqname) & is.null(xrange)) { 149 | # region based on index SNP 150 | if (!index_snp %in% data[, labs]) 151 | stop("SNP specified by `index_snp` not found") 152 | ind <- which(data[, labs] == index_snp) 153 | if (length(ind) > 1) message("SNP found more than once") 154 | seqname <- data[ind[1], chrom] 155 | snp_pos <- data[ind[1], pos] 156 | xrange <- if (is.null(fix_window)) { 157 | c(snp_pos - flank[1], snp_pos + flank[2]) 158 | } else { 159 | as.integer(c(snp_pos - fix_window/2, snp_pos + fix_window/2)) 160 | } 161 | xrange[xrange < 0] <- 0 162 | } 163 | } 164 | 165 | if (is.null(xrange) | is.null(seqname)) stop('No locus specified') 166 | msg <- paste0("chromosome ", seqname, ", position ", xrange[1], " to ", 167 | xrange[2]) 168 | if (!is.null(gene)) msg <- paste(gene, msg, sep = ", ") 169 | if (!is.null(index_snp)) msg <- paste(index_snp, msg, sep = ", ") 170 | message(msg) 171 | 172 | if (!is.null(data)) { 173 | data <- data[which(data[, chrom] == seqname), ] 174 | data <- data[which(data[, pos] > xrange[1] & data[, pos] < xrange[2]), ] 175 | # smallest floating point 176 | data[data[, p] < 5e-324, p] <- 5e-324 177 | if (is.null(yvar)) { 178 | data$logP <- -log10(data[, p]) 179 | yvar <- "logP" 180 | } 181 | data <- as.data.frame(data) 182 | 183 | if (nrow(data) == 0) { 184 | message("Locus contains no SNPs/datapoints") 185 | data <- NULL 186 | } else { 187 | message(nrow(data), " SNPs/datapoints") 188 | if (is.null(index_snp)) index_snp <- data[which.max(data[, yvar]), labs] 189 | if (is.character(LD)) { 190 | colnames(data)[which(colnames(data) == LD)] <- "ld" 191 | } 192 | } 193 | } 194 | 195 | seqname <- gsub("chr|[[:punct:]]", "", seqname, ignore.case = TRUE) 196 | if (!seqname %in% c(1:22, "X", "Y")) 197 | warning("`seqname` refers to a non-conventional chromosome") 198 | TX <- ensembldb::genes(edb, filter = AnnotationFilterList( 199 | SeqNameFilter(seqname), 200 | TxStartFilter(xrange[2], condition = "<"), 201 | TxEndFilter(xrange[1], condition = ">"), genefilt)) 202 | TX <- data.frame(TX) 203 | TX <- TX[! is.na(TX$start), ] 204 | TX <- TX[!duplicated(TX$gene_id), ] 205 | 206 | if (nrow(TX) == 0) { 207 | message("No gene transcripts") 208 | # Creating empty exons object here in suitable format 209 | EX <- ensembldb::exons(edb, filter = AnnotationFilterList( 210 | SeqNameFilter(seqname), 211 | ExonStartFilter(xrange[2], condition = "<"), 212 | ExonEndFilter(xrange[1], condition = ">"), genefilt)) 213 | } else { 214 | EX <- ensembldb::exons(edb, filter = GeneIdFilter(TX$gene_id)) 215 | } 216 | 217 | loc <- list(seqname = seqname, xrange = xrange, gene = gene, 218 | ens_db = ens_db, 219 | ens_version = ensemblVersion(edb), 220 | organism = organism(edb), 221 | genome = unname(genome(edb)[1]), 222 | chrom = chrom, pos = pos, p = p, yvar = yvar, labs = labs, 223 | index_snp = index_snp, 224 | data = data, TX = TX, EX = EX) 225 | class(loc) <- "locus" 226 | loc 227 | } 228 | 229 | 230 | #' @export 231 | summary.locus <- function(object, ...) { 232 | if (!is.null(object$gene)) { 233 | cat("Gene", object$gene, "\n") 234 | } else if (!is.null(object$index_snp)) { 235 | cat("Index SNP", object$index_snp, "\n") 236 | } 237 | cat(paste0("Chromosome ", object$seqname, ", position ", 238 | format(object$xrange[1], big.mark=","), " to ", 239 | format(object$xrange[2], big.mark=","), "\n")) 240 | nr <- nrow(object$data) 241 | if (is.null(nr)) nr <- 0 242 | cat(nr, "SNPs/datapoints\n") 243 | cat(nrow(object$TX), "gene transcripts\n") 244 | if (nrow(object$TX) > 0) { 245 | tb <- sort(c(table(object$TX$gene_biotype)), decreasing = TRUE) 246 | cat(paste(tb, names(tb), collapse = ", "), "\n") 247 | } 248 | if (!is.null(object$ens_version)) { 249 | cat("Ensembl version:", object$ens_version, "\n") 250 | cat("Organism:", object$organism, "\n") 251 | cat("Genome build:", object$genome, "\n") 252 | } 253 | } 254 | 255 | 256 | detect_cols <- function(data, chrom, pos, p, labs = NULL, yvar = NULL) { 257 | # autodetect headings 258 | if (is.null(chrom)) { 259 | w <- grep("chr", colnames(data), ignore.case = TRUE) 260 | if (length(w) == 1) { 261 | chrom <- colnames(data)[w] 262 | } else stop("unable to autodetect chromosome column") 263 | } 264 | if (is.null(pos)) { 265 | w <- grep("pos", colnames(data), ignore.case = TRUE) 266 | if (length(w) == 1) { 267 | pos <- colnames(data)[w] 268 | } else stop("unable to autodetect SNP position column") 269 | } 270 | if (!is.null(p) && !is.null(yvar)) stop("cannot specify both `p` and `yvar`") 271 | if (is.null(p) && is.null(yvar)) { 272 | if ("p" %in% colnames(data)) { 273 | p <- "p" 274 | } else { 275 | w <- grep("^p?val", colnames(data), ignore.case = TRUE) 276 | if (length(w) == 1) { 277 | p <- colnames(data)[w] 278 | } else stop("unable to autodetect p-value column") 279 | } 280 | } 281 | if (is.null(labs)) { 282 | w <- grep("rs?id", colnames(data), ignore.case = TRUE) 283 | if (length(w) > 1) stop("unable to autodetect SNP id column") 284 | if (length(w) == 0) { 285 | w <- grep("SNP", colnames(data), ignore.case = TRUE) 286 | } 287 | if (length(w) == 1) { 288 | labs <- colnames(data)[w] 289 | } else stop("unable to autodetect SNP id column") 290 | } 291 | 292 | # check headings 293 | if (!chrom %in% colnames(data)) { 294 | stop("Column specified by `chrom` not found in `data`")} 295 | if (!pos %in% colnames(data)) { 296 | stop("Column specified by `pos` not found in `data`")} 297 | if (is.null(yvar) && !p %in% colnames(data)) { 298 | stop("Column specified by `p` not found in `data`")} 299 | if (!labs %in% colnames(data)) { 300 | stop("Column specified by `labs` not found in `data`")} 301 | if (!is.null(yvar)) { 302 | if (!yvar %in% colnames(data)) { 303 | stop("Column specified by `yvar` not found in `data`") 304 | } 305 | } 306 | 307 | list(chrom = chrom, pos = pos, p = p, labs = labs) 308 | } 309 | -------------------------------------------------------------------------------- /R/gg_scatter.R: -------------------------------------------------------------------------------- 1 | 2 | #' Locus scatter plot using ggplot2 3 | #' 4 | #' Produces a scatter plot from a 'locus' class object (without gene tracks). 5 | #' 6 | #' @param loc Object of class 'locus' to use for plot. See [locus]. 7 | #' @param index_snp Specifies index SNP to be shown in a different colour and 8 | #' symbol. Defaults to the SNP with the lowest p-value. Set to `NULL` to not 9 | #' show this. 10 | #' @param pcutoff Cut-off for p value significance. Defaults to p = 5e-08. Set 11 | #' to `NULL` to disable. 12 | #' @param scheme Vector of 3 colours if LD is not shown: 1st = normal points, 13 | #' 2nd = colour for significant points, 3rd = index SNP. 14 | #' @param size Specifies size for points. 15 | #' @param cex.axis Specifies font size for axis numbering. 16 | #' @param cex.lab Specifies font size for axis titles. 17 | #' @param xlab x axis title. 18 | #' @param ylab y axis title. 19 | #' @param ylim y axis limits (y1, y2). 20 | #' @param ylim2 Secondary y axis limits for recombination line. 21 | #' @param yzero Logical whether to force y axis limit to include y=0. 22 | #' @param xticks Logical whether x axis numbers and axis title are plotted. 23 | #' @param border Logical whether a bounding box is plotted around the plot. 24 | #' @param showLD Logical whether to show LD with colours 25 | #' @param LD_scheme Vector of colours for plotting LD. The first colour is for SNPs 26 | #' which lack LD information. The next 5 colours are for r2 or D' LD results 27 | #' ranging from 0 to 1 in intervals of 0.2. The final colour is for the index 28 | #' SNP. 29 | #' @param recomb_col Colour for recombination rate line if recombination rate 30 | #' data is present. Set to NA to hide the line. See [link_recomb()] to add 31 | #' recombination rate data. 32 | #' @param recomb_offset Offset from 0-1 which shifts the scatter plot up and 33 | #' recombination line plot down. Recommended value 0.1. 34 | #' @param legend_pos Position of legend. Set to `NULL` to hide legend. 35 | #' @param labels Character vector of SNP or genomic feature IDs to label. The 36 | #' value "index" selects the highest point or index SNP as defined when 37 | #' [locus()] is called. Set to `NULL` to remove all labels. 38 | #' @param eqtl_gene Optional column name in `loc$data` for colouring eQTL genes. 39 | #' @param beta Optional column name for beta coefficient to display upward 40 | #' triangles for positive beta and downward triangles for negative beta 41 | #' (significant SNPs only). 42 | #' @param shape Optional column name in `loc$data` for controlling shapes. 43 | #' `beta` and `shape` cannot both be set. This column is expected to be a factor. 44 | #' @param shape_values Vector of shape values which match levels of the column 45 | #' specified by `shape`. This vector is passed to 46 | #' `ggplot2::scale_shape_manual()` as the argument `values`. See [points()] 47 | #' for a list of shapes and the numbers they map to. 48 | #' @param ... Optional arguments passed to `geom_text_repel()` to configure 49 | #' label drawing. 50 | #' @return Returns a ggplot2 plot. 51 | #' @details 52 | #' If recombination rate data is included in the locus object following a call 53 | #' to [link_recomb()], this is plotted as an additional line with a secondary y 54 | #' axis. In the base graphics version the line is placed under the scatter 55 | #' points, but this is not possible with ggplot2 as the secondary y axis data 56 | #' must be plotted on top of the primary scatter point data. 57 | #' 58 | #' @seealso [locus()] [gg_addgenes()] 59 | #' @examples 60 | #' if(require(EnsDb.Hsapiens.v75)) { 61 | #' data(SLE_gwas_sub) 62 | #' loc <- locus(SLE_gwas_sub, gene = 'IRF5', flank = c(7e4, 2e5), LD = "r2", 63 | #' ens_db = "EnsDb.Hsapiens.v75") 64 | #' gg_scatter(loc) 65 | #' } 66 | #' @importFrom ggplot2 ggplot geom_point xlim ylim labs theme_classic theme 67 | #' scale_fill_manual scale_color_manual aes guide_legend element_text 68 | #' element_blank element_rect unit geom_hline scale_y_continuous sec_axis 69 | #' geom_line scale_shape_manual guides 70 | #' @importFrom ggrepel geom_text_repel 71 | #' @importFrom dplyr bind_rows 72 | #' @importFrom rlang .data 73 | #' @importFrom zoo na.approx 74 | #' @export 75 | #' 76 | gg_scatter <- function(loc, 77 | index_snp = loc$index_snp, 78 | pcutoff = 5e-08, 79 | scheme = c('grey', 'dodgerblue', 'red'), 80 | size = 2, 81 | cex.axis = 1, 82 | cex.lab = 1, 83 | xlab = NULL, 84 | ylab = NULL, 85 | ylim = NULL, 86 | ylim2 = c(0, 100), 87 | yzero = (loc$yvar == "logP"), 88 | xticks = TRUE, 89 | border = FALSE, 90 | showLD = TRUE, 91 | LD_scheme = c('grey', 'royalblue', 'cyan2', 'green3', 92 | 'orange', 'red', 'purple'), 93 | recomb_col = "blue", 94 | recomb_offset = 0, 95 | legend_pos = 'topleft', 96 | labels = NULL, 97 | eqtl_gene = NULL, 98 | beta = NULL, 99 | shape = NULL, 100 | shape_values = c(21, 24, 25), ...) { 101 | if (!inherits(loc, "locus")) stop("Object of class 'locus' required") 102 | if (is.null(loc$data)) stop("No data points, only gene tracks") 103 | 104 | .call <- match.call() 105 | data <- loc$data 106 | if (is.null(xlab) & xticks) xlab <- paste("Chromosome", loc$seqname, "(Mb)") 107 | if (is.null(ylab)) { 108 | ylab <- if (loc$yvar == "logP") expression("-log"[10] ~ "P") else loc$yvar 109 | } 110 | hasLD <- "ld" %in% colnames(data) 111 | if (!"bg" %in% colnames(data)) { 112 | if (showLD & hasLD) { 113 | data$bg <- cut(data$ld, -1:6/5, labels = FALSE) 114 | data$bg[is.na(data$bg)] <- 1L 115 | data$bg[data[, loc$labs] %in% index_snp] <- 7L 116 | data$bg <- factor(data$bg, levels = 1:7) 117 | data <- data[order(data$bg), ] 118 | scheme <- rep_len(LD_scheme, 7) 119 | if (is.null(index_snp)) { 120 | scheme <- scheme[1:6] 121 | data$bg <- factor(data$bg, levels = 1:6) 122 | } 123 | } else if (!is.null(eqtl_gene)) { 124 | # eqtl gene colours 125 | bg <- data[, eqtl_gene] 126 | bg[data[, loc$p] > pcutoff] <- "ns" 127 | bg <- relevel(factor(bg, levels = unique(bg)), "ns") 128 | if (is.null(.call$scheme)) scheme <- eqtl_scheme(nlevels(bg)) 129 | data$bg <- bg 130 | } else { 131 | data$bg <- scheme[1] 132 | if (loc$yvar == "logP") data$bg[data[, loc$p] < pcutoff] <- scheme[2] 133 | data$bg[data[, loc$labs] %in% index_snp] <- scheme[3] 134 | data$bg <- factor(data$bg, levels = scheme) 135 | } 136 | } 137 | 138 | # scatter plot 139 | if (!"col" %in% colnames(data)) data$col <- "black" 140 | data$col <- as.factor(data$col) 141 | 142 | # shapes 143 | if (!is.null(shape)) { 144 | if (!is.null(beta)) stop("cannot set both `shape` and `beta`") 145 | if (!shape %in% colnames(data)) stop("incorrect column name for `shape`") 146 | shape_breaks <- shape_labels <- levels(data[, shape]) 147 | } 148 | if (!is.null(beta)) { 149 | # beta symbols 150 | data[, beta] <- signif(data[, beta], 3) 151 | symbol <- as.character(sign(data[, beta])) 152 | ind <- data[, loc$p] > pcutoff 153 | symbol[ind] <- "ns" 154 | data$.beta <- factor(symbol, levels = c("ns", "1", "-1"), 155 | labels = c("ns", "up", "down")) 156 | shape <- ".beta" 157 | shape_breaks <- c("ns", "up", "down") 158 | shape_labels <- c("ns", expression({beta > 0}), expression({beta < 0})) 159 | } 160 | 161 | # legend 162 | legend.justification <- NULL 163 | legend_labels <- legend_title <- NULL 164 | legend.position <- "none" 165 | if (!is.null(legend_pos)) { 166 | if (legend_pos == "topleft") { 167 | legend.justification <- c(0, 1) 168 | legend.position <- c(0.01, 0.99) 169 | } else if (legend_pos == "topright") { 170 | legend.justification <- c(1, 1) 171 | legend.position <- c(0.99, 0.99) 172 | } else { 173 | legend.position <- legend_pos 174 | } 175 | if (showLD & hasLD) { 176 | legend_title <- expression({r^2}) 177 | legend_labels <- rev(c("Index SNP", "0.8 - 1.0", "0.6 - 0.8", "0.4 - 0.6", 178 | "0.2 - 0.4", "0.0 - 0.2", "NA")) 179 | if (is.null(index_snp)) legend_labels <- legend_labels[1:6] 180 | } else if (!is.null(eqtl_gene)) { 181 | legend_labels <- levels(bg) 182 | } else if (is.null(beta) & is.null(shape)) legend.position <- "none" 183 | } 184 | 185 | yrange <- if (is.null(ylim)) range(data[, loc$yvar], na.rm = TRUE) else ylim 186 | if (is.null(ylim) && yzero) yrange[1] <- min(c(0, yrange[1])) 187 | ycut <- -log10(pcutoff) 188 | 189 | # recombination line 190 | recomb <- !is.null(loc$recomb) & !is.na(recomb_col) 191 | if (recomb) { 192 | df <- loc$recomb[, c("start", "value")] 193 | colnames(df) <- c(loc$pos, "recomb") 194 | data <- dplyr::bind_rows(data, df) 195 | data <- data[order(data[, loc$pos]), ] 196 | data$recomb <- zoo::na.approx(data$recomb, data[, loc$pos], na.rm = FALSE) 197 | ymult <- 100 / diff(yrange) 198 | yd <- diff(yrange) 199 | yd2 <- diff(ylim2) 200 | yrange0 <- yrange 201 | yrange[1] <- yrange[1] - yd * recomb_offset 202 | outside <- df$recomb < ylim2[1] | df$recomb > (ylim2[2] + yd2 * recomb_offset) 203 | if (any(outside)) 204 | nmessage(sum(outside), " recombination value(s) outside scale range (`ylim2`)") 205 | fy2 <- function(yy) (yy - ylim2[1]) / yd2 * yd + yrange[1] 206 | inv_fy2 <- function(yy) (yy - yrange[1]) / yd * yd2 + ylim2[1] 207 | } 208 | outside <- loc$data[, loc$yvar] < yrange[1] | loc$data[, loc$yvar] > yrange[2] 209 | if (any(outside)) 210 | nmessage(sum(outside), " value(s) outside scale range (`ylim`)") 211 | data[, loc$pos] <- data[, loc$pos] / 1e6 212 | 213 | # add labels 214 | if (!is.null(labels)) { 215 | i <- grep("index", labels, ignore.case = TRUE) 216 | if (length(i) > 0) { 217 | if (length(index_snp) == 1) { 218 | labels[i] <- index_snp 219 | } else { 220 | labels <- labels[-i] 221 | labels <- c(index_snp, labels) 222 | } 223 | } 224 | text_label_ind <- match(labels, data[, loc$labs]) 225 | if (any(is.na(text_label_ind))) { 226 | message("label ", paste(labels[is.na(text_label_ind)], collapse = ", "), 227 | " not found") 228 | } 229 | } 230 | ind <- data[, loc$labs] %in% index_snp 231 | 232 | if (!recomb) { 233 | if (is.null(shape)) { 234 | # standard plot 235 | p <- ggplot(data[!ind, ], aes(x = .data[[loc$pos]], y = .data[[loc$yvar]], 236 | color = .data$col, fill = .data$bg)) + 237 | (if (loc$yvar == "logP" & !is.null(pcutoff) & 238 | ycut >= yrange[1] & ycut <= yrange[2]) { 239 | geom_hline(yintercept = ycut, 240 | colour = "grey", linetype = "dashed") 241 | }) + 242 | geom_point(shape = 21, size = size) + 243 | # index SNP 244 | (if (any(ind)) { 245 | geom_point(data = data[ind, ], 246 | aes(y = .data[[loc$yvar]], color = .data$col, 247 | fill = .data$bg), 248 | shape = 23, size = size) 249 | }) 250 | } else { 251 | # shapes or beta triangles 252 | p <- ggplot(data, aes(x = .data[[loc$pos]], y = .data[[loc$yvar]], 253 | color = .data$col, fill = .data$bg, 254 | shape = .data[[shape]])) + 255 | (if (loc$yvar == "logP" & !is.null(pcutoff) & 256 | ycut >= yrange[1] & ycut <= yrange[2]) { 257 | geom_hline(yintercept = ycut, 258 | colour = "grey", linetype = "dashed") 259 | }) + 260 | geom_point(size = size) + 261 | scale_shape_manual(values = shape_values, name = NULL, 262 | breaks = shape_breaks, 263 | labels = shape_labels) + 264 | (if (showLD & hasLD) { 265 | guides(fill = guide_legend(override.aes = list(shape = 21), 266 | reverse = TRUE, order = 1)) 267 | } else { 268 | guides(fill = "none") 269 | }) 270 | } 271 | p <- p + 272 | scale_fill_manual(breaks = levels(data$bg), values = scheme, 273 | guide = guide_legend(reverse = TRUE), 274 | labels = legend_labels, name = legend_title) + 275 | scale_color_manual(breaks = levels(data$col), values = levels(data$col), 276 | guide = "none") + 277 | # scale_shape_manual(breaks = levels(data$pch), values = levels(data$pch)) + 278 | xlim(loc$xrange[1] / 1e6, loc$xrange[2] / 1e6) + ylim(yrange) + 279 | labs(x = xlab, y = ylab) + 280 | theme_classic() + 281 | theme(axis.text = element_text(colour = "black", size = 10 * cex.axis), 282 | axis.title = element_text(size = 10 * cex.lab), 283 | legend.justification = legend.justification, 284 | legend.position = legend.position, 285 | legend.title.align = 0.5, 286 | legend.text.align = 0, 287 | legend.key.size = unit(0.9, 'lines'), 288 | legend.spacing.y = unit(0, 'lines')) + 289 | if (!xticks) theme(axis.text.x=element_blank(), 290 | axis.ticks.x=element_blank()) 291 | } else { 292 | # recombination plot with dual y axis 293 | if (is.null(shape)) { 294 | # standard plot 295 | p <- ggplot(data[!ind, ], aes(x = .data[[loc$pos]])) + 296 | (if (loc$yvar == "logP" & !is.null(pcutoff) & 297 | ycut >= yrange[1] & ycut <= yrange[2]) { 298 | geom_hline(yintercept = ycut, 299 | colour = "grey", linetype = "dashed") 300 | }) + 301 | geom_point(aes(y = .data[[loc$yvar]], color = .data$col, 302 | fill = .data$bg), shape = 21, size = size, na.rm = TRUE) + 303 | # index SNP 304 | (if (any(ind)) { 305 | geom_point(data = data[ind, ], 306 | aes(y = .data[[loc$yvar]], color = .data$col, 307 | fill = .data$bg), shape = 23, size = size, na.rm = TRUE) 308 | }) 309 | } else { 310 | # shapes or beta triangles 311 | p <- ggplot(data, aes(x = .data[[loc$pos]])) + 312 | (if (loc$yvar == "logP" & !is.null(pcutoff) & 313 | ycut >= yrange[1] & ycut <= yrange[2]) { 314 | geom_hline(yintercept = ycut, 315 | colour = "grey", linetype = "dashed") 316 | }) + 317 | geom_point(aes(y = .data[[loc$yvar]], color = .data$col, fill = .data$bg, 318 | shape = .data[[shape]]), size = size, na.rm = TRUE) + 319 | scale_shape_manual(values = shape_values, name = NULL, 320 | breaks = shape_breaks, 321 | labels = shape_labels) + 322 | (if (showLD & hasLD) { 323 | guides(fill = guide_legend(override.aes = list(shape = 21), 324 | reverse = TRUE, order = 1)) 325 | } else { 326 | guides(fill = "none") 327 | }) 328 | } 329 | p <- p + 330 | scale_fill_manual(breaks = levels(data$bg), values = scheme, 331 | guide = guide_legend(reverse = TRUE), 332 | labels = legend_labels, name = legend_title) + 333 | scale_color_manual(breaks = levels(data$col), values = levels(data$col), 334 | guide = "none") + 335 | geom_line(aes(y = fy2(.data$recomb)), color = recomb_col, 336 | na.rm = TRUE) + 337 | scale_y_continuous(name = ylab, 338 | limits = yrange, breaks = pretty(yrange0), 339 | sec.axis = sec_axis(inv_fy2, 340 | name = "Recombination rate (%)", 341 | breaks = pretty(ylim2))) + 342 | xlim(loc$xrange[1] / 1e6, loc$xrange[2] / 1e6) + 343 | xlab(xlab) + 344 | theme_classic() + 345 | theme(axis.text = element_text(colour = "black", size = 10 * cex.axis), 346 | axis.title = element_text(size = 10 * cex.lab), 347 | axis.title.y.left = element_text( 348 | hjust = min(c(0.5 + recomb_offset /3, 0.9))), 349 | axis.title.y.right = element_text( 350 | hjust = min(c(0.5 + recomb_offset /2, 1))), 351 | legend.justification = legend.justification, 352 | legend.position = legend.position, 353 | legend.title.align = 0.5, 354 | legend.text.align = 0, 355 | legend.key.size = unit(0.9, 'lines'), 356 | legend.spacing.y = unit(0, 'lines')) + 357 | if (!xticks) theme(axis.text.x=element_blank(), 358 | axis.ticks.x=element_blank()) 359 | } 360 | 361 | if (!is.null(labels)) { 362 | p <- p + 363 | geom_text_repel(data = data[text_label_ind, ], 364 | mapping = aes(x = .data[[loc$pos]], y = .data[[loc$yvar]], 365 | label = .data[[loc$labs]]), 366 | point.size = size, ...) 367 | } 368 | 369 | if (border | recomb) { 370 | p <- p + theme(panel.border = element_rect(colour = "black", fill = NA)) 371 | } 372 | p 373 | } 374 | 375 | 376 | nmessage <- function(...) { 377 | argList <- list(...) 378 | n_arg <- which(sapply(argList, class) %in% c("numeric", "integer")) 379 | n <- argList[[n_arg]] 380 | if (n == 0) return() 381 | msg <- paste0(argList) 382 | msg <- if (n == 1) gsub("\\(s\\)", "", msg) else gsub("\\(s\\)", "s", msg) 383 | message(msg) 384 | } 385 | --------------------------------------------------------------------------------