Skip to content

Commit

Permalink
refactor idotplot and iplotPXG
Browse files Browse the repository at this point in the history 
 - have idotplot be the main function
 - iplotPXG calls idotplot with particular chartOpts and group
  • Loading branch information
@kbroman
kbroman committed May 18, 2016
1 parent 83edc15 commit 0fd88c2
Show file tree
Hide file tree
Showing 21 changed files with 398 additions and 423 deletions.
42 changes: 28 additions & 14 deletions Makefile
View file
Expand Up @@ -18,15 +18,23 @@ doc:
#------------------------------------------------------------

# javascript for the chart functions
JSCHARTS = $(CHART_DIR)/iplotScanone_noeff.js $(CHART_DIR)/iplotScanone_pxg.js \
$(CHART_DIR)/iplotScanone_ci.js $(CHART_DIR)/iplotPXG.js \
$(CHART_DIR)/iplotCorr.js $(CHART_DIR)/iplotCorr_noscat.js \
JSCHARTS = $(CHART_DIR)/iplotScanone_noeff.js \
$(CHART_DIR)/iplotScanone_pxg.js \
$(CHART_DIR)/iplotScanone_ci.js \
$(CHART_DIR)/idotplot.js \
$(CHART_DIR)/iplotCorr.js \
$(CHART_DIR)/iplotCorr_noscat.js \
$(CHART_DIR)/iboxplot.js \
$(CHART_DIR)/iplotCurves.js $(CHART_DIR)/iplotMap.js \
$(CHART_DIR)/iplotRF.js $(CHART_DIR)/iplotMScanone_noeff.js \
$(CHART_DIR)/iplotMScanone_eff.js $(CHART_DIR)/iheatmap.js \
$(CHART_DIR)/iplot.js $(CHART_DIR)/iplotScantwo.js \
$(CHART_DIR)/scat2scat.js $(CHART_DIR)/itriplot.js
$(CHART_DIR)/iplotCurves.js \
$(CHART_DIR)/iplotMap.js \
$(CHART_DIR)/iplotRF.js \
$(CHART_DIR)/iplotMScanone_noeff.js \
$(CHART_DIR)/iplotMScanone_eff.js \
$(CHART_DIR)/iheatmap.js \
$(CHART_DIR)/iplot.js \
$(CHART_DIR)/iplotScantwo.js \
$(CHART_DIR)/scat2scat.js \
$(CHART_DIR)/itriplot.js
jscharts: $(JSCHARTS)

$(CHART_DIR)/%.js: $(CHART_DIR)/%.coffee
Expand All @@ -35,12 +43,18 @@ $(CHART_DIR)/%.js: $(CHART_DIR)/%.coffee
#------------------------------------------------------------

# javascript for the widgets called from R
JSWIDGETS = $(WIDGET_DIR)/iplot.js $(WIDGET_DIR)/iplotPXG.js \
$(WIDGET_DIR)/iplotMap.js $(WIDGET_DIR)/iheatmap.js \
$(WIDGET_DIR)/iboxplot.js $(WIDGET_DIR)/iplotCorr.js \
$(WIDGET_DIR)/iplotCurves.js $(WIDGET_DIR)/iplotRF.js \
$(WIDGET_DIR)/iplotScanone.js $(WIDGET_DIR)/iplotMScanone.js \
$(WIDGET_DIR)/iplotScantwo.js $(WIDGET_DIR)/scat2scat.js \
JSWIDGETS = $(WIDGET_DIR)/iplot.js \
$(WIDGET_DIR)/idotplot.js \
$(WIDGET_DIR)/iplotMap.js \
$(WIDGET_DIR)/iheatmap.js \
$(WIDGET_DIR)/iboxplot.js \
$(WIDGET_DIR)/iplotCorr.js \
$(WIDGET_DIR)/iplotCurves.js \
$(WIDGET_DIR)/iplotRF.js \
$(WIDGET_DIR)/iplotScanone.js \
$(WIDGET_DIR)/iplotMScanone.js \
$(WIDGET_DIR)/iplotScantwo.js \
$(WIDGET_DIR)/scat2scat.js \
$(WIDGET_DIR)/itriplot.js
jswidgets: $(JSWIDGETS)

Expand Down
4 changes: 2 additions & 2 deletions NAMESPACE
View file
Expand Up @@ -6,6 +6,8 @@ export(iboxplot)
export(iboxplot_output)
export(iboxplot_render)
export(idotplot)
export(idotplot_output)
export(idotplot_render)
export(iheatmap)
export(iheatmap_output)
export(iheatmap_render)
Expand All @@ -23,8 +25,6 @@ export(iplotMap)
export(iplotMap_output)
export(iplotMap_render)
export(iplotPXG)
export(iplotPXG_output)
export(iplotPXG_render)
export(iplotRF)
export(iplotRF_output)
export(iplotRF_render)
Expand Down
3 changes: 3 additions & 0 deletions NEWS.md
View file
Expand Up @@ -12,6 +12,9 @@
- Add a new chart, `itriplot`, for plotting trinomial probabilities,
represented as points in an equilateral triangle.

- Refactor `iplotPXG` and `idotplot` so that `idotplot` is the main
function, and `iplotPXG` calls it.

- Add some additional options, such as `horizontal` for `iplotMap`
and `iplotPXG`.

Expand Down
6 changes: 3 additions & 3 deletions R/convert_pxg.R
View file
Expand Up @@ -44,7 +44,7 @@ function(cross, pheno.col=1, fillgenoArgs=NULL)
genonames <- vector("list", length(uchrtype))
names(genonames) <- uchrtype
for(i in uchrtype)
genonames[[i]] <- qtl::getgenonames(class(cross)[1], i, "full", sexpgm, attributes(cross))
genonames[[i]] <- qtl::getgenonames(class(cross)[1], i, "standard", sexpgm, attributes(cross))

id <- qtl::getid(cross)
if(is.null(id)) id <- 1:qtl::nind(cross)
Expand Down Expand Up @@ -84,11 +84,11 @@ function(cross, fillgenoArgs=NULL, imputed_negative=TRUE)
sexpgm <- qtl::getsex(cross)
if(any(chrtype == "X")) {
for(i in chr[chrtype=="X"]) {
geno_X <- qtl::reviseXdata(class(cross)[1], "full", sexpgm, geno=qtl::pull.geno(cross, chr=i),
geno_X <- qtl::reviseXdata(class(cross)[1], "standard", sexpgm, geno=qtl::pull.geno(cross, chr=i),
cross.attr=attributes(cross))
geno[,colnames(geno_X)] <- geno_X

geno_imp_X <- qtl::reviseXdata(class(cross)[1], "full", sexpgm, geno=qtl::pull.geno(cross_filled, chr=i),
geno_imp_X <- qtl::reviseXdata(class(cross)[1], "standard", sexpgm, geno=qtl::pull.geno(cross_filled, chr=i),
cross.attr=attributes(cross))
geno_imp[,colnames(geno_imp_X)] <- geno_imp_X
}
Expand Down
2 changes: 1 addition & 1 deletion R/estQTLeffects.R
View file
Expand Up @@ -61,7 +61,7 @@ function(cross, pheno.col=1, what=c("means", "effects"))
for(i in 1:qtl::nchr(cross)) {
pr[[i]] <- cross$geno[[i]]$prob
if(chrtype[i] == "X")
pr[[i]] <- qtl::reviseXdata(crosstype, "full", qtl::getsex(cross),
pr[[i]] <- qtl::reviseXdata(crosstype, "standard", qtl::getsex(cross),
prob=pr[[i]], cross.attr=attributes(cross))
}

Expand Down
53 changes: 35 additions & 18 deletions R/idotplot.R
View file
Expand Up @@ -5,9 +5,10 @@
#'
#' Creates an interactive graph of phenotypes vs genotypes at a marker.
#'
#' @param group Vector of groups of individuals (e.g., a genotype)
#' @param x Vector of groups of individuals (e.g., a genotype)
#' @param y Numeric vector (e.g., a phenotype)
#' @param indID Optional vector of character strings, shown with tool tips
#' @param group Optional vector of categories for coloring points
#' @param chartOpts A list of options for configuring the chart. Each
#' element must be named using the corresponding option.
#' @param digits Round data to this number of significant digits
Expand All @@ -30,34 +31,37 @@
#'
#' @export
idotplot <-
function(group, y, indID=NULL, chartOpts=NULL, digits=5)
function(x, y, indID=NULL, group=NULL, chartOpts=NULL, digits=5)
{
stopifnot(length(group) == length(y))
stopifnot(length(x) == length(y))
if(is.null(group)) group <- rep(1, length(x))
stopifnot(length(group) == length(x))
group <- group2numeric(group)
if(is.null(indID))
indID <- get_indID(length(group), names(group), names(y))
stopifnot(length(indID) == length(group))
indID <- get_indID(length(x), names(x), names(y), names(group))
stopifnot(length(indID) == length(x))
indID <- as.character(indID)
group_levels <- sort(unique(group))
group <- group2numeric(group)
names(y) <- NULL # strip off the names
if(is.factor(x)) x_levels <- levels(x)
else x_levels <- sort(unique(x))
x <- group2numeric(x)

# strip off the names
names(x) <- NULL
names(y) <- NULL
names(indID) <- NULL
names(group) <- NULL

chartOpts <- add2chartOpts(chartOpts, ylab="y", title="", xlab="group")
chartOpts <- add2chartOpts(chartOpts, ylab="y", title="", xlab="group",
xcategories=seq(along=x_levels), xcatlabels=x_levels)

# a bit of contortion with the data, to reuse iplotPXG
x <- list(data=list(geno=matrix(group, nrow=1),
pheno=y,
chrByMarkers=list(group="un"),
indID=indID,
chrtype=list(un="A"),
genonames=list(A=group_levels)),
chartOpts=chartOpts)
x <- list(data=list(x=x, y=y, indID=indID, group=group), chartOpts=chartOpts)
if(!is.null(digits))
attr(x, "TOJSON_ARGS") <- list(digits=digits)

defaultAspect <- 1 # width/height
browsersize <- getPlotSize(defaultAspect)

htmlwidgets::createWidget("iplotPXG", x,
htmlwidgets::createWidget("idotplot", x,
width=chartOpts$width,
height=chartOpts$height,
sizingPolicy=htmlwidgets::sizingPolicy(
Expand All @@ -67,3 +71,16 @@ function(group, y, indID=NULL, chartOpts=NULL, digits=5)
knitr.defaultHeight=1000/defaultAspect),
package="qtlcharts")
}

#' @rdname qtlcharts-shiny
#' @export
idotplot_output <- function(outputId, width="100%", height="530") {
htmlwidgets::shinyWidgetOutput(outputId, "idotplot", width, height, package="qtlcharts")
}

#' @rdname qtlcharts-shiny
#' @export
idotplot_render <- function(expr, env=parent.frame(), quoted=FALSE) {
if(!quoted) { expr <- substitute(expr) } # force quoted
htmlwidgets::shinyRenderWidget(expr, idotplot_output, env, quoted=TRUE)
}
50 changes: 17 additions & 33 deletions R/iplotPXG.R
View file
Expand Up @@ -30,6 +30,9 @@
#' the input \code{cross} object, using the \code{\link[qtl]{getid}}
#' function in R/qtl.
#'
#' By default, points are colored blue and pink according to whether
#' the marker genotype is observed or inferred, respectively.
#'
#' @keywords hplot
#' @seealso \code{\link{idotplot}}, \code{\link{iplot}}, \code{\link{iplotScanone}},
#' \code{\link{iplotMap}}
Expand All @@ -39,7 +42,10 @@
#' data(hyper)
#' marker <- sample(markernames(hyper), 1)
#' \donttest{
#' iplotPXG(hyper, marker)}
#' iplotPXG(hyper, marker)
#'
#' # different colors
#' iplotPXG(hyper, marker, chartOpts=list(pointcolor=c("black", "gray")))}
#'
#' @export
iplotPXG <-
Expand All @@ -54,40 +60,18 @@ function(cross, marker, pheno.col=1,
warning('marker should have length 1; using "', marker, '"')
}

pxg_data <- convert_pxg(qtl::pull.markers(cross, marker), pheno.col, fillgenoArgs=fillgenoArgs)

# use phenotype name as y-axis label, unless ylab is already provided
# same for title (with marker name)
chartOpts <- add2chartOpts(chartOpts, ylab=getPhename(cross, pheno.col),
title=marker)

x <- list(data=convert_pxg(qtl::pull.markers(cross, marker), pheno.col, fillgenoArgs=fillgenoArgs),
chartOpts=chartOpts)
if(!is.null(digits))
attr(x, "TOJSON_ARGS") <- list(digits=digits)

defaultAspect <- 1 # width/height
browsersize <- getPlotSize(defaultAspect)
chartOpts <- add2chartOpts(chartOpts, ylab=getPhename(cross, pheno.col), xlab="Genotype",
title=marker, xcategories=seq(along=pxg_data$genonames[[1]]),
xcatlabels=pxg_data$genonames[[1]],
pointcolor=c("slateblue", "#ff851b")) # second color is orange

htmlwidgets::createWidget("iplotPXG", x,
width=chartOpts$width,
height=chartOpts$height,
sizingPolicy=htmlwidgets::sizingPolicy(
browser.defaultWidth=browsersize$width,
browser.defaultHeight=browsersize$height,
knitr.defaultWidth=1000,
knitr.defaultHeight=1000/defaultAspect
),
package="qtlcharts")
}
pxg_data$geno <- as.numeric(pxg_data$geno)
group <- pxg_data$geno < 0 + 1

#' @rdname qtlcharts-shiny
#' @export
iplotPXG_output <- function(outputId, width="100%", height="530") {
htmlwidgets::shinyWidgetOutput(outputId, "iplotPXG", width, height, package="qtlcharts")
}

#' @rdname qtlcharts-shiny
#' @export
iplotPXG_render <- function(expr, env=parent.frame(), quoted=FALSE) {
if(!quoted) { expr <- substitute(expr) } # force quoted
htmlwidgets::shinyRenderWidget(expr, iplotPXG_output, env, quoted=TRUE)
idotplot(abs(pxg_data$geno), pxg_data$pheno, pxg_data$indID, group,
chartOpts=chartOpts, digits=digits)
}
4 changes: 2 additions & 2 deletions R/iplotScantwo.R
View file
Expand Up @@ -265,7 +265,7 @@ cross4iplotScantwo <-
cross.attr <- attributes(cross)
if(crosstype %in% c("f2", "bc", "bcsft") && any(chrtype=="X")) {
for(i in which(chrtype=="X")) {
cross$geno[[i]]$draws <- qtl::reviseXdata(crosstype, "full", sexpgm,
cross$geno[[i]]$draws <- qtl::reviseXdata(crosstype, "standard", sexpgm,
draws=cross$geno[[i]]$draws,
cross.attr=cross.attr)
}
Expand All @@ -286,7 +286,7 @@ cross4iplotScantwo <-
names(genonames) <- names(cross$geno)
for(i in seq(along=genonames))
genonames[[i]] <- qtl::getgenonames(crosstype, class(cross$geno[[i]]),
"full", sexpgm, cross.attr)
"standard", sexpgm, cross.attr)

# chr for each marker
chr <- as.character(map$chr)
Expand Down

0 comments on commit 0fd88c2

Please sign in to comment.