Nothing
#' @name mapGGChr
#' @title FUNCTIONS mapGGChr and mapGGChrMark (for ggplot)
#' @aliases mapGGChrMark
#' @description Currently works for holocentrics when only one OTU. See vignette.
#' @description mapGGChr: reads a data.frame and produces coordinates for ggplot of chr.
#' @description mapGGChrMark: reads data.frames and produces data.frames for ggplot of chr. and marks
#'
#' @param dfChrSize character, name of data.frame with columns: chrSize
#' @param chrSpacing numeric, \code{1 - chrSpacing} will be the width of chr.
#' @param dfMarkPos (\code{mapGGChrMark}) name of data.frame of marks
#' @param squareness numeric, squareness
#' @param n numeric, vertices number for rounded portions
#'
#' @keywords data.frame size arm
#'
#' @return list
#' @rdname mapGGChr
#' @importFrom tidyr pivot_longer
#' @export
#'
mapGGChr <- function(dfChrSize, chrSpacing = 0.5, squareness = 4, n = 50) {
pts <- seq(-pi / 2, pi * 1.5, length.out = n * 4)
ptsl <- split(pts, sort(rep(1:4, each = length(pts) / 4, len = length(pts))))
starts_with <- NULL
if (chrSpacing > 0.95) {
message(crayon::green("Use < 0.95 in chrSpacing"))
chrSpacing <- 0.95
}
chrWidth <- 1 - chrSpacing
chromosome_ns <- nrow(dfChrSize)
chromRepVector <- rep(1, chromosome_ns)
croytop <- list()
for (i in seq_along(chromRepVector)) {
croytop[i] <- list(c(
((dfChrSize[, "chrSize"])[i]),
rep(0, 2),
((dfChrSize[, "chrSize"])[i])
))
}
xm <- matrix(rep(NA, length(chromRepVector) * 4), ncol = 4, nrow = length(chromRepVector))
for (i in seq_along(chromRepVector)) {
xm[i, ] <- c(
rep(((chrSpacing * i + (i * chrWidth)) + chrWidth), 2),
rep(((chrSpacing * i + (i * chrWidth))), 2)
) - chrWidth / 2
}
x <- base::split(xm, row(xm))
ym <- t(sapply(croytop, function(x) {
length(x)
return(x)
}))
y <- base::split(ym, row(ym))
xbind <- as.data.frame(do.call(rbind, x))
xbind$Chr <- seq_along(xbind$V1)
xDat <- tidyr::pivot_longer(xbind, names_to = "variable.x", values_to = "x", cols = starts_with("V"))
ybind <- as.data.frame(do.call(rbind, croytop))
ybind$id.y <- seq_along(ybind$V1)
yDat <- tidyr::pivot_longer(ybind, names_to = "variable.y", values_to = "y", cols = starts_with("V"))
dataChr <- cbind(xDat, yDat)
dataChr <- dataChr[, c("Chr", "x", "y")]
mapChrL <- list()
mapChrL$dataChr <- dataChr
mapChrL$xm <- xm
mapChrL$ym <- ym
mapChrL$chrWidth <- chrWidth
if (squareness < 20) {
r2 <- chrWidth / (squareness * 2)
yfactor <- max(dfChrSize$chrSize) / chromosome_ns
xyCoords <- makeRoundCoordXY(r2, yfactor, x, y, 1, length(y), n, ptsl)
xbind <- as.data.frame(do.call(rbind, xyCoords$roundedX))
xbind$Chr <- seq_along(xbind$V1)
ybind <- as.data.frame(do.call(rbind, xyCoords$roundedY))
ybind$id.y <- seq_along(ybind$V1)
xDat <- tidyr::pivot_longer(xbind, names_to = "variable.x", values_to = "x", cols = starts_with("V"))
yDat <- tidyr::pivot_longer(ybind, names_to = "variable.y", values_to = "y", cols = starts_with("V"))
dataChr <- cbind(xDat, yDat)
dataChr <- dataChr[, c("Chr", "x", "y")]
mapChrL$dataChr <- dataChr
mapChrL$rounded <- TRUE
return(mapChrL)
} else {
return(mapChrL)
}
}
#'
#' @rdname mapGGChr
#' @return list
#' @export
#'
mapGGChrMark <- function(dfChrSize, dfMarkPos, chrSpacing = 0.5, squareness = 4, n = 50) {
pts <- seq(-pi / 2, pi * 1.5, length.out = n * 4)
ptsl <- split(pts, sort(rep(1:4, each = length(pts) / 4, len = length(pts))))
starts_with <- NULL
mapChrL <- mapGGChr(dfChrSize, chrSpacing, squareness, n)
if (requireNamespace("tidyr") == FALSE) {
message(crayon::red("You need to install tidyr"))
return(NULL)
} else {
requireNamespace("tidyr")
}
yMark1 <- xMark1 <- xMark2 <- NULL
markNames <- character()
for (m in seq_len(nrow(dfMarkPos))) {
rowIndex <- dfMarkPos[, "chrName"][m]
markName <- dfMarkPos[, "markName"][m]
chrStart <- mapChrL$ym[rowIndex, 2]
yinf <- chrStart + dfMarkPos[m, "markPos"]
ysup <- chrStart + sum(dfMarkPos[m, "markPos"], dfMarkPos[m, "markSize"], na.rm = TRUE)
yMark1[[m]] <- c(ysup, yinf, yinf, ysup)
xMark1[[m]] <- mapChrL$xm[dfMarkPos[, "chrName"][m], ]
xMark2[[m]] <- c(xMark1[[m]], markName)
markNames <- c(markNames, markName)
}
xMarkSqDF <- as.data.frame(do.call(rbind, xMark2))
colnames(xMarkSqDF)[5] <- "markName"
xMarkSqDF$id <- seq_along(xMarkSqDF$V1)
xDatMark <- tidyr::pivot_longer(xMarkSqDF, names_to = "variable", values_to = "x", cols = starts_with("V"))
xDatMark$x <- as.numeric(xDatMark$x)
yMark1DF <- as.data.frame(do.call(rbind, yMark1))
yMark1DF$id.y <- seq_along(yMark1DF$V1)
yDatMark <- tidyr::pivot_longer(yMark1DF, names_to = "variable.y", values_to = "y", cols = starts_with("V"))
dataMark <- cbind(xDatMark, yDatMark)
dataMark <- dataMark[, c("id", "markName", "x", "y")]
mapChrL$dataMark <- dataMark
if (squareness < 20) {
chromosome_ns <- nrow(dfChrSize)
r2 <- mapChrL$chrWidth / (squareness * 2)
yfactor <- max(dfChrSize$chrSize) / chromosome_ns
xyCoords <- makeRoundCoordXY(r2, yfactor, xMark1, yMark1, 1, length(yMark1), n, ptsl)
xMarkSqDF <- as.data.frame(do.call(rbind, xyCoords$roundedX))
xMarkSqDF$markName <- markNames
xMarkSqDF$id <- seq_along(xMarkSqDF$V1)
xDatMark <- tidyr::pivot_longer(xMarkSqDF, names_to = "variable", values_to = "x", cols = starts_with("V"))
yMark1DF <- as.data.frame(do.call(rbind, xyCoords$roundedY))
yMark1DF$id.y <- seq_along(yMark1DF$V1)
yDatMark <- tidyr::pivot_longer(yMark1DF, names_to = "variable.y", values_to = "y", cols = starts_with("V"))
dataMark <- cbind(xDatMark, yDatMark)
dataMark <- dataMark[, c("id", "markName", "x", "y")]
mapChrL$dataMark <- dataMark
return(mapChrL)
} else {
return(mapChrL)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.