diff --git a/Makefile b/Makefile index 396d336..492802f 100644 --- a/Makefile +++ b/Makefile @@ -23,7 +23,7 @@ build2: rd cd ..;\ R CMD build --no-build-vignettes $(PKGSRC) -install: build +install: build2 cd ..;\ R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz diff --git a/NAMESPACE b/NAMESPACE index 466833b..a750dee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -39,6 +39,7 @@ importFrom(ggfun,yrange) importFrom(ggplot2,aes) importFrom(ggplot2,annotation_custom) importFrom(ggplot2,coord_cartesian) +importFrom(ggplot2,coord_fixed) importFrom(ggplot2,element_blank) importFrom(ggplot2,element_text) importFrom(ggplot2,ggplot) diff --git a/R/aplot.R b/R/aplot.R index 5edcefc..23649d2 100644 --- a/R/aplot.R +++ b/R/aplot.R @@ -50,26 +50,35 @@ as.patchwork <- function(x, return(res) } - mp <- x$plotlist[[1]] + mp <- x[[1]] if ( length(x$plotlist) == 1) { return(ggplotGrob(mp)) } - + width <- x$width + height <- x$height if(align == "x" || align == "xy"){ - for (i in x$layout[, x$main_col]) { + for (ind in seq(length(x$layout[, x$main_col]))) { + i <- x$layout[,x$main_col][ind] if (is.na(i)) next if (i == 1) next - x$plotlist[[i]] <- suppressMessages(x$plotlist[[i]] + xlim2(mp)) + x[[i]] <- suppressMessages(x[[i]] + xlim2(mp)) + x <- adjust_coord(x, i, ind, type = "height") } } if(align == "y" || align == "xy"){ - for (i in x$layout[x$main_row,]) { + for (ind in seq(length(x$layout[x$main_row,]))) { + i <- x$layout[x$main_row,][ind] if(is.na(i)) next if (i == 1) next - x$plotlist[[i]] <- suppressMessages(x$plotlist[[i]] + ylim2(mp)) + x[[i]] <- suppressMessages(x[[i]] + ylim2(mp)) + x <- adjust_coord(x, i, ind, type = "width") } } + + if (is.coord_fixed(mp)){ + width <- height <- NULL + } idx <- as.vector(x$layout) idx[is.na(idx)] <- x$n + 1 @@ -104,8 +113,8 @@ as.patchwork <- function(x, pp + plot_layout(byrow=F, ncol=ncol(x$layout), - widths = x$width, - heights= x$height, + widths = width, + heights= height, guides = guides) } diff --git a/R/method-accessor.R b/R/method-accessor.R index e811f18..42f292a 100644 --- a/R/method-accessor.R +++ b/R/method-accessor.R @@ -1,22 +1,33 @@ ##' @method [[ aplot ##' @export `[[.aplot` <- function(x, i){ - x$plotlist[[i]] + if(inherits(i, "numeric")){ + return(x$plotlist[[i]]) + } + NextMethod() } ##' @method [ aplot ##' @export `[.aplot` <- function(x, i, j, ...){ - x[[x$layout[i, j]]] + if (inherits(i, "numeric") && inherits(i, "numeric")){ + return(x[[x$layout[i, j]]]) + } + NextMethod() } ##' @method [[<- aplot ##' @export `[[<-.aplot` <- function(x, i, value){ - if(!inherits(value, 'ggplot')){ - stop('The value should be a ggplot object.') + if (inherits(i, "numeric")){ + if(!inherits(value, 'ggplot')){ + stop('The value should be a ggplot object.') + } + + x$plotlist[[i]] <- value + return(x) } - x$plotlist[[i]] <- value + x <- NextMethod(value) return(x) } @@ -24,14 +35,18 @@ ##' @method [<- aplot ##' @export `[<-.aplot` <- function(x, i, j, value){ - if (!inherits(value, 'ggplot')){ - stop('The value should be a ggplot object.') - }else if (is.na(x$layout[i, j])){ - stop(paste0('The subplot which local in row ', i, - ' and col ', j, - ' is NULL, it can not be replaced.')) + if (inherits(i, "numeric") && inherits(i, "numeric")){ + if (!inherits(value, 'ggplot')){ + stop('The value should be a ggplot object.') + }else if (is.na(x$layout[i, j])){ + stop(paste0('The subplot which local in row ', i, + ' and col ', j, + ' is NULL, it can not be replaced.')) + } + x[[x$layout[i, j]]] <- value + return(x) } - x[[x$layout[i, j]]] <- value + x <- NextMethod(value) return(x) } diff --git a/R/utilities.R b/R/utilities.R index 90211bb..1ae17cf 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -19,3 +19,41 @@ is.coord_flip <- function(p) { inherits(p, "gg") && inherits(p$coordinates, "CoordFlip") } +is.coord_fixed <- function(p){ + inherits(p, "gg") && inherits(p$coordinates, "CoordFixed") +} + +#' @importFrom ggplot2 coord_fixed +adjust_coord <- function(x, i, ind, type='width'){ + coordfixed <- is.coord_fixed(x[[1]]) + coordfixed2 <- !is.coord_fixed(x[[i]]) + ratio <- 1 + if (coordfixed && coordfixed2){ + ajustcoord <- getOption("ajust_coord", default = TRUE) + if (ajustcoord) ratio <- .cal_ratio(x[[i]], x[[type]][ind], type) + x[[i]] <- suppressMessages(x[[i]] + coord_fixed(ratio = ratio)) + + } + return(x) +} + +.cal_ratio <- function(x, size, type='width'){ + xr <- .cal_limit_range(xlim2(x)$limits) + yr <- .cal_limit_range(ylim2(x)$limits) + val <- xr / yr + if (type == 'width'){ + val <- val / size + }else{ + val <- val * size + } + return(val) +} + +.cal_limit_range <- function(x){ + if (inherits(x, "character")){ + res <- length(x) + }else if(inherits(x, "numeric")){ + res <- diff(x) + } + return(res) +}