# R/mapXYCenMimic.R In idiogramFISH: Shiny App. Idiograms with Marks and Karyotype Indices

#### Documented in mapXYCenMimic

#' mapXYCenMimic
#' This is an internal function that creates coords for chr. or arms or marks
#'
#' @keywords internal
#'
#' @param start 1st index
#' @param end last index
#' @param y y coords
#' @param yfactor y x factor
#' @param r2 r2ius
#' @param pts points of squareness
#' @param cenFormat boolean
#'
#' @return list

mapXYCenMimic <- function(start, end, y, x, yfactor, r2, pts, cenFormat = "triangle") {
x2_1 <- x2_2 <- list()

xy_1 <- xy_2 <- list()

xy_3 <- xy_4 <- list()

roundedX <- roundedY <- list()

for (counter in start:end) {
r2backup <- r2
diffx <- max(x[[counter]]) - min(x[[counter]])
diffy <- max(y[[counter]]) - min(y[[counter]])
ratexy <- diffx / diffy
ifelse((diffx / r2) * 2 < ratexy * 4, r2 <- diffx / (ratexy * 2), r2)

ptsl <- split(pts, sort(rep(1:4, each = length(pts) / 4, len = length(pts))))

x2_1 <- min(x[[counter]]) + r2
x2_2 <- max(x[[counter]]) - r2

minY <- min(y[[counter]])
maxY <- max(y[[counter]])

xy_1 <- cbind(x2_1 + r2 * sin(ptsl[[1]]), minY + r2 * cos(ptsl[[1]]))
xy_2 <- cbind(x2_2 + r2 * sin(ptsl[[2]]), minY + r2 * cos(ptsl[[2]]) * yfactor)
xy_3 <- cbind(x2_2 + r2 * sin(ptsl[[3]]), maxY + r2 * cos(ptsl[[3]]))
xy_4 <- cbind(x2_1 + r2 * sin(ptsl[[4]]), maxY + r2 * cos(ptsl[[4]]))

if (cenFormat == "triangle") {
roundedX[[counter]] <- c(rev(xy_3[, 1]), rev(xy_2[, 1]), xy_4[, 1], xy_1[, 1])
roundedY[[counter]] <- c(rev(xy_3[, 2]), rev(xy_2[, 2]), xy_4[, 2], xy_1[, 2])
} else {
maxXmod <- max(x[[counter]]) - r2
minXmod <- min(x[[counter]]) + r2

maxYmod <- max(y[[counter]]) - r2
minYmod <- min(y[[counter]]) + r2

diffxMod <- maxXmod - minXmod
diffyMod <- maxYmod - minYmod

halfmaxXMod <- diffxMod / 2
halfmaxYMod <- diffyMod / 2

xy_1b <- cbind(minXmod + halfmaxXMod + halfmaxXMod * sin(ptsl[[1]]), minYmod + halfmaxYMod * cos(ptsl[[1]]))

xy_2b <- cbind(minXmod + halfmaxXMod + halfmaxXMod * sin(ptsl[[2]]), minYmod + halfmaxYMod * cos(ptsl[[2]]))

xy_3b <- cbind(minXmod + halfmaxXMod + halfmaxXMod * sin(ptsl[[3]]), maxYmod + halfmaxYMod * cos(ptsl[[3]]))

xy_4b <- cbind(minXmod + halfmaxXMod + halfmaxXMod * sin(ptsl[[4]]), maxYmod + halfmaxYMod * cos(ptsl[[4]]))

roundedX[[counter]] <- c(xy_1[, 1], minXmod, xy_1b[, 1], (xy_2b[, 1]), xy_2[, 1],
(xy_3[, 1]), (xy_3b[, 1]), minXmod + halfmaxXMod, xy_4b[, 1], xy_4[, 1]) # opposite of cen.
roundedY[[counter]] <- c(xy_1[, 2], minYmod, xy_1b[, 2], (xy_2b[, 2]), xy_2[, 2],
(xy_3[, 2]), (xy_3b[, 2]), minYmod + halfmaxYMod, xy_4b[, 2], xy_4[, 2])
}

attr(roundedY[[counter]], "rowIndex") <- attr(y[[counter]], "rowIndex")
attr(roundedX[[counter]], "rowIndex") <- attr(x[[counter]], "rowIndex")
attr(roundedY[[counter]], "chrName1") <- attr(y[[counter]], "chrName1")
attr(roundedX[[counter]], "chrName1") <- attr(x[[counter]], "chrName1")

r2 <- r2backup
}

roundXroundY <- list()

roundXroundY\$roundedX <- roundedX
roundXroundY\$roundedY <- roundedY

return(roundXroundY)
}

mapXYCenMimicInside <- function(start, end, y, x, yfactor, r2, pts,
cenFormat = "triangle") {
x2_1 <- x2_2 <- list()

xy_1 <- xy_2 <- list()

xy_3 <- xy_4 <- list()

roundedX <- roundedY <- list()

for (counter in start:end) {
r2backup <- r2
diffx <- max(x[[counter]]) - min(x[[counter]])
diffy <- max(y[[counter]]) - min(y[[counter]])
ratexy <- diffx / diffy
ifelse((diffx / r2) * 2 < ratexy * 4, r2 <- diffx / (ratexy * 2), r2)

ptsl <- split(pts, sort(rep(1:4, each = length(pts) / 4, len = length(pts))))

x2_1 <- min(x[[counter]]) + r2
x2_2 <- max(x[[counter]]) - r2

minY <- min(y[[counter]])
maxY <- max(y[[counter]])
maxX <- max(x[[counter]])

xy_1 <- cbind(x2_1 + r2 * sin(ptsl[[1]]), minY + r2 * cos(ptsl[[1]]))
xy_2 <- cbind(x2_2 + r2 * sin(ptsl[[2]]), minY + r2 * cos(ptsl[[2]]))
xy_3 <- cbind(x2_2 + r2 * sin(ptsl[[3]]), maxY + r2 * cos(ptsl[[3]]))
xy_4 <- cbind(x2_1 + r2 * sin(ptsl[[4]]), maxY + r2 * cos(ptsl[[4]]))

if (cenFormat == "triangle") {
roundedX[[counter]] <- c(
rev(xy_3[, 1]) # up right
, maxX,
rev(xy_4[, 1]) # up left
, xy_2[, 1] # down
, maxX,
xy_1[, 1]
)
roundedY[[counter]] <- c(
rev(xy_3[, 2])
, maxY,
rev(xy_4[, 2])
, xy_2[, 2]
, minY,
xy_1[, 2]
)
} else {
maxXmod <- max(x[[counter]]) - r2
minXmod <- min(x[[counter]]) + r2

maxYmod <- max(y[[counter]]) - r2
minYmod <- min(y[[counter]]) + r2

diffxMod <- maxXmod - minXmod
diffyMod <- maxYmod - minYmod

halfmaxXMod <- diffxMod / 2
halfmaxYMod <- diffyMod / 2

xy_1b <- cbind(minXmod + halfmaxXMod + halfmaxXMod * sin(ptsl[[1]]), minYmod + halfmaxYMod * cos(ptsl[[1]]))

xy_2b <- cbind(minXmod + halfmaxXMod + halfmaxXMod * sin(ptsl[[2]]), minYmod + halfmaxYMod * cos(ptsl[[2]]))

xy_3b <- cbind(minXmod + halfmaxXMod + halfmaxXMod * sin(ptsl[[3]]), maxYmod + halfmaxYMod * cos(ptsl[[3]]))

xy_4b <- cbind(minXmod + halfmaxXMod + halfmaxXMod * sin(ptsl[[4]]), maxYmod + halfmaxYMod * cos(ptsl[[4]]))

roundedX[[counter]] <- c(
maxX, (xy_3[, 1]), (xy_3b[, 1]),
rev(xy_1b[, 1]) # ,minXmod
, rev(xy_1[, 1]) # down left
, maxX,
rev(xy_2[, 1]), rev(xy_2b[, 1]) # down right
, xy_4b[, 1], xy_4[, 1] # top left
) # opposite of cen.
roundedY[[counter]] <- c(
maxY, (xy_3[, 2]), (xy_3b[, 2]),
rev(xy_1b[, 2]) # ,minYmod
, rev(xy_1[, 2]),
minY,
rev(xy_2[, 2]), rev(xy_2b[, 2]) # down right
, xy_4b[, 2], xy_4[, 2]
)
}

attr(roundedY[[counter]], "rowIndex") <- attr(y[[counter]], "rowIndex")
attr(roundedX[[counter]], "rowIndex") <- attr(x[[counter]], "rowIndex")
attr(roundedY[[counter]], "chrName1") <- attr(y[[counter]], "chrName1")
attr(roundedX[[counter]], "chrName1") <- attr(x[[counter]], "chrName1")

r2 <- r2backup
}

roundXroundY <- list()

roundXroundY\$roundedX <- roundedX
roundXroundY\$roundedY <- roundedY

return(roundXroundY)
}

## Try the idiogramFISH package in your browser

Any scripts or data that you put into this service are public.

idiogramFISH documentation built on Aug. 22, 2023, 5:08 p.m.