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

#### Documented in mapXY

```#' mapXY
#' 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 x x coords
#' @param y y coords
#' @param yMod y coords modified because of squareness
#' @param yfactor y x factor
#' @param pts_1 points of squareness
#' @param pts_2 points of squareness
#' @param pts_3 points of squareness
#' @param pts_4 points of squareness
#'
#' @return list
#' @keywords internal

mapXY <- function(start, end, y, yMod, x, yfactor, r2, pts_1, pts_2, pts_3, pts_4, chrt = FALSE) {
roundedX <- roundedY <- list()

for (counter in start:end) {
r2backup <- r2

current_x <- x[[counter]]
current_y <- y[[counter]]
yMod_current <- yMod[[counter]]

diffx <- max(current_x) - min(current_x)
diffy <- max(current_y) - min(current_y)
ratexy <- diffx / diffy

ifelse((diffx / r2) * 2 < ratexy * 4, r2 <- diffx / (ratexy * 2), r2)

topBotline_x <- c(
min(current_x) + r2,
max(current_x) - r2
)

x2_1 <- min(current_x) + r2
x2_2 <- max(current_x) - r2

bottomline_y <- rep(min(yMod_current), 2)

topline_y <- rep(max(yMod_current), 2)

y2_1 <- max(current_y) - r2 * yfactor
y2_2 <- min(current_y) + r2 * yfactor

xy_1 <- cbind(x2_2 + r2 * sin(pts_2), y2_1 + (r2 * cos(pts_2) * yfactor))
xy_2 <- cbind(x2_1 + r2 * sin(pts_1), y2_1 + (r2 * cos(pts_1) * yfactor))

xy_3 <- cbind(x2_1 + r2 * sin(pts_4), y2_2 + (r2 * cos(pts_4) * yfactor)) # new
xy_4 <- cbind(x2_2 + r2 * sin(pts_3), y2_2 + (r2 * cos(pts_3) * yfactor)) # new

yMod_current[which(yMod_current == max(yMod_current))] <- yMod_current[which(yMod_current == max(yMod_current))] - r2 * yfactor
yMod_current[which(yMod_current == min(yMod_current))] <- yMod_current[which(yMod_current == min(yMod_current))] + r2 * yfactor

if (chrt == FALSE) {
roundedX[[counter]] <- c(
current_x[1:2], xy_4[, 1], topBotline_x, xy_3[, 1],
current_x[3:4], xy_2[, 1], topBotline_x, xy_1[, 1]
)

roundedY[[counter]] <- c(
yMod_current[1:2], xy_4[, 2], bottomline_y, xy_3[, 2],
yMod_current[3:4], xy_2[, 2], topline_y, xy_1[, 2]
)
} else {
roundedX[[counter]] <- c(
xy_4[, 1], xy_3[, 1],
xy_2[, 1], xy_1[, 1],
xy_4[, 1][1]
)

roundedY[[counter]] <- c(
xy_4[, 2], xy_3[, 2],
xy_2[, 2], xy_1[, 2],
xy_4[, 2][1]
)
}

attr(roundedY[[counter]], "rowIndex") <- attr(current_y, "rowIndex")
attr(roundedX[[counter]], "rowIndex") <- attr(current_x, "rowIndex")

attr(roundedY[[counter]], "chrName1") <- attr(current_y, "chrName1")
attr(roundedX[[counter]], "chrName1") <- attr(current_x, "chrName1")

r2 <- r2backup
}

roundXroundY <- list()
roundXroundY\$roundedX <- roundedX
roundXroundY\$roundedY <- roundedY
return(roundXroundY)
}

mapXYCen <- function(start, end, ycoordCentsS, xcoordCentsS, pts_1, pts_2, pts_3, pts_4, mimic = FALSE) {
roundedX <- roundedY <- xy_1 <- xy_2 <- xy_3 <- xy_4 <- list()

for (counter in start:end) {
chrRegion <- attr(ycoordCentsS[[counter]], "chrRegion")

minX <- min(xcoordCentsS[[counter]])
maxX <- max(xcoordCentsS[[counter]])
minY <- min(ycoordCentsS[[counter]])
maxY <- max(ycoordCentsS[[counter]])
diffx <- maxX - minX
diffy <- maxY - minY

if (is.null(chrRegion)) {
halfmaxY <- diffy / 2
} else if (chrRegion %in% c("qcen")) {
halfmaxY <- diffy
} else if (chrRegion %in% c("pcen")) {
halfmaxY <- diffy
minY <- minY - diffy
} else {
halfmaxY <- diffy / 2
}

halfmaxX <- diffx / 2

xy_1 <- cbind(
minX + halfmaxX + halfmaxX * sin(pts_1),
minY + halfmaxY * cos(pts_1)
)

xy_2 <- cbind(
minX + halfmaxX + halfmaxX * sin(pts_2),
minY + halfmaxY * cos(pts_2)
)

xy_3 <- cbind(
minX + halfmaxX + halfmaxX * sin(pts_3),
maxY + halfmaxY * cos(pts_3)
)

xy_4 <- cbind(
minX + halfmaxX + halfmaxX * sin(pts_4),
maxY + halfmaxY * cos(pts_4)
)

if (mimic == FALSE) {
roundedX[[counter]] <- c(
xy_4[, 1], minX, maxX, xy_3[, 1],
minX + halfmaxX, xy_2[, 1], maxX, minX, xy_1[, 1]
)

roundedY[[counter]] <- c(
xy_4[, 2], maxY, maxY, xy_3[, 2],
minY + halfmaxY, xy_2[, 2], minY, minY, xy_1[, 2]
)
} else {
roundedX[[counter]] <- c(
minX, xy_1[, 1], minX + halfmaxX, (xy_2[, 1]),
maxX, (xy_3[, 1]), minX + halfmaxX, xy_4[, 1]
) # opposite of cen.

roundedY[[counter]] <- c(
minY, xy_1[, 2], minY + halfmaxY, (xy_2[, 2]),
maxY, (xy_3[, 2]), minY + halfmaxY, xy_4[, 2]
)
}

len <- length(roundedX[[counter]])

chrRegion <- attr(ycoordCentsS[[counter]], "chrRegion")

if (!is.null(chrRegion)) {
start <- ifelse(chrRegion %in% c("cen", "pcen"), 1, (floor(len / 2) + 1))
end <- ifelse(chrRegion %in% c("cen", "qcen"), len, floor(len / 2))
} else {
start <- 1
end <- len
}

roundedX[[counter]] <- roundedX[[counter]][start:end]
roundedY[[counter]] <- roundedY[[counter]][start:end]

attr(roundedY[[counter]], "rowIndex") <- attr(ycoordCentsS[[counter]], "rowIndex")
attr(roundedY[[counter]], "chrRegion") <- chrRegion

attr(roundedX[[counter]], "rowIndex") <- attr(xcoordCentsS[[counter]], "rowIndex")
attr(roundedX[[counter]], "chrRegion") <- chrRegion
}

roundXroundY <- list()
roundXroundY\$roundedX <- roundedX
roundXroundY\$roundedY <- roundedY

return(roundXroundY)
}

mapXYCenLines <- function(start, end, ycoordCentsS, xcoordCentsS) {
X1 <- Y1 <- X2 <- Y2 <- list()

for (counter in start:end) {
diffx <- max(xcoordCentsS[[counter]]) - min(xcoordCentsS[[counter]])
diffy <- max(ycoordCentsS[[counter]]) - min(ycoordCentsS[[counter]])

halfmaxX <- diffx / 2
halfmaxY <- diffy / 2

minX <- min(xcoordCentsS[[counter]])
maxX <- max(xcoordCentsS[[counter]])
minY <- min(ycoordCentsS[[counter]])
maxY <- max(ycoordCentsS[[counter]])

xy_1 <- cbind(minX, minY)
xy_2 <- cbind(minX + halfmaxX, minY + halfmaxY)
xy_3 <- cbind(minX, maxY)

xy_4 <- cbind(maxX, minY)
xy_5 <- cbind(maxX - halfmaxX, maxY - halfmaxY)
xy_6 <- cbind(maxX, maxY)

X1[[counter]] <- c(xy_1[, 1], xy_2[, 1], xy_3[, 1])
Y1[[counter]] <- c(xy_1[, 2], xy_2[, 2], xy_3[, 2])

X2[[counter]] <- c(xy_4[, 1], xy_5[, 1], xy_6[, 1])
Y2[[counter]] <- c(xy_4[, 2], xy_5[, 2], xy_6[, 2])
} # for

XY <- list()
XY\$X1 <- X1
XY\$Y1 <- Y1
XY\$X2 <- X2
XY\$Y2 <- Y2

return(XY)
}

mapxyRoundCenLines <- function(start, end, ycoordCentsS, xcoordCentsS, pts_1, pts_2, pts_3, pts_4, mimic = FALSE) {
roundedX1 <- roundedY1 <- roundedX2 <- roundedY2 <- list()

for (counter in start:end) {
diffx <- max(xcoordCentsS[[counter]]) - min(xcoordCentsS[[counter]])
diffy <- max(ycoordCentsS[[counter]]) - min(ycoordCentsS[[counter]])

halfmaxX <- diffx / 2
halfmaxY <- diffy / 2

xy_1 <- cbind(min(xcoordCentsS[[counter]]) + halfmaxX + halfmaxX * sin(pts_1), min(ycoordCentsS[[counter]]) + halfmaxY * cos(pts_1))

xy_2 <- cbind(min(xcoordCentsS[[counter]]) + halfmaxX + halfmaxX * sin(pts_2), min(ycoordCentsS[[counter]]) + halfmaxY * cos(pts_2))

xy_3 <- cbind(min(xcoordCentsS[[counter]]) + halfmaxX + halfmaxX * sin(pts_3), max(ycoordCentsS[[counter]]) + halfmaxY * cos(pts_3))

xy_4 <- cbind(min(xcoordCentsS[[counter]]) + halfmaxX + halfmaxX * sin(pts_4), max(ycoordCentsS[[counter]]) + halfmaxY * cos(pts_4))

roundedX1[[counter]] <- c(
rev(xy_2[, 1])

, xy_4[, 1]
) # opposite of cen.

roundedY1[[counter]] <- c(
rev(xy_2[, 2])

, xy_4[, 2]
)

roundedX2[[counter]] <- c(
xy_1[, 1]

, rev(xy_3[, 1])

) # opposite of cen.

roundedY2[[counter]] <- c(
xy_1[, 2]

, rev(xy_3[, 2])

)

}

roundXroundY <- list()
roundXroundY\$roundedX1 <- roundedX1
roundXroundY\$roundedY1 <- roundedY1
roundXroundY\$roundedX2 <- roundedX2
roundXroundY\$roundedY2 <- roundedY2

return(roundXroundY)
}

mapXYchromatidLA <- function(start, end, y, x, xModifier = .1) {
longArmChrtx <- longArmChrty <- list()

for (counter in start:end) {
maxX <- minX <- halfX <- halfXModMinus <- halfXModPlus <- NULL

maxX <- max(x[[counter]])
minX <- min(x[[counter]])

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

halfX <- (maxX + minX) / 2
halfXModPlus <- halfX + xModifier
halfXModMinus <- halfX - xModifier

longArmChrtx[[counter]] <- c(maxX, maxX, halfXModPlus, halfXModPlus, halfXModMinus, halfXModMinus, minX, minX)

longArmChrty[[counter]] <- c(maxY, minY, minY, maxY, maxY, minY, minY, maxY)
} # for

chrtXchrtYLA <- list()
chrtXchrtYLA\$longArmChrtx <- longArmChrtx
chrtXchrtYLA\$longArmChrty <- longArmChrty
return(chrtXchrtYLA)
}

mapXYchromatidSA <- function(start, end, y, x, xModifier = .1) {
shortArmChrtx <- shortArmChrty <- list()

for (counter in start:end) {
maxX <- minX <- halfX <- halfXModMinus <- halfXModPlus <- NULL

maxX <- max(x[[counter]])
minX <- min(x[[counter]])

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

halfX <- (maxX + minX) / 2
halfXModPlus <- halfX + xModifier
halfXModMinus <- halfX - xModifier

shortArmChrtx[[counter]] <- c(maxX, maxX, minX, minX, halfXModMinus, halfXModMinus, halfXModPlus, halfXModPlus)
shortArmChrty[[counter]] <- c(maxY, minY, minY, maxY, maxY, minY, minY, maxY)
}

chrtXchrtYSA <- list()
chrtXchrtYSA\$shortArmChrtx <- shortArmChrtx
chrtXchrtYSA\$shortArmChrty <- shortArmChrty
return(chrtXchrtYSA)
}

mapXYchromatidHolo <- function(start, end, y, x, xModifier = .1) {
xCT1 <- yCT1 <- xCT2 <- yCT2 <- list()

for (counter in start:end) {
maxX <- minX <- halfX <- halfXModMinus <- halfXModPlus <- NULL

maxX <- max(x[[counter]])
minX <- min(x[[counter]])

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

halfX <- (maxX + minX) / 2
halfXModPlus <- halfX + xModifier
halfXModMinus <- halfX - xModifier

xCT1[[counter]] <- c(maxX, maxX, halfXModPlus, halfXModPlus)
yCT1[[counter]] <- c(maxY, minY, minY, maxY)

# left chrt holocen sq
xCT2[[counter]] <- c(halfXModMinus, halfXModMinus, minX, minX)
yCT2[[counter]] <- c(maxY, minY, minY, maxY)

attr(xCT1[[counter]], "arm") <-
attr(xCT2[[counter]], "arm") <-
attr(yCT1[[counter]], "arm") <- attr(yCT2[[counter]], "arm") <- attr(y[[counter]], "arm")
attr(xCT1[[counter]], "rowIndex") <-
attr(xCT2[[counter]], "rowIndex") <-
attr(yCT1[[counter]], "rowIndex") <- attr(yCT2[[counter]], "rowIndex") <- attr(y[[counter]], "rowIndex")
attr(xCT1[[counter]], "wholeArm") <-
attr(xCT2[[counter]], "wholeArm") <-
attr(yCT1[[counter]], "wholeArm") <- attr(yCT2[[counter]], "wholeArm") <- attr(y[[counter]], "wholeArm")
attr(xCT1[[counter]], "whichArm") <-
attr(xCT2[[counter]], "whichArm") <-
attr(yCT1[[counter]], "whichArm") <- attr(yCT2[[counter]], "whichArm") <- attr(y[[counter]], "whichArm")
attr(xCT1[[counter]], "squareSide") <-
attr(xCT2[[counter]], "squareSide") <-
attr(yCT1[[counter]], "squareSide") <- attr(yCT2[[counter]], "squareSide") <- attr(y[[counter]], "squareSide")
}

chrtXchrtYHolo <- list()
chrtXchrtYHolo\$xCT1 <- xCT1
chrtXchrtYHolo\$xCT2 <- xCT2
chrtXchrtYHolo\$yCT1 <- yCT1
chrtXchrtYHolo\$yCT2 <- yCT2
return(chrtXchrtYHolo)
}

mapXYchromatidSARo <- function(start, end, y, x, r2, xModifier, pts) {
RoundedSAChrtx <- RoundedSAChrty <- list()

for (counter in start:end) {
maxX <- minX <- halfX <- halfXModMinus <- halfXModPlus <- NULL

maxX <- max(x[[counter]])
minX <- min(x[[counter]])

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

halfX <- (maxX + minX) / 2
halfXModPlus <- halfX + xModifier
halfXModMinus <- halfX - xModifier

r2backup <- r2

diffx <- maxX - minX
diffy <- maxY - minY

ratexy <- diffx / diffy
ifelse((diffx / r2) * 2 < ratexy * 4, r2 <- diffx / (ratexy * 2), r2)

yMod <- y[[counter]]

yMod[which(yMod == max(yMod))] <- yMod[which(yMod == max(yMod))] - r2
yMod[which(yMod == min(yMod))] <- yMod[which(yMod == min(yMod))] + r2

topBotline_x <- c(minX + r2, maxX - r2)

topBotline_x2 <- c(halfXModPlus + r2, maxX - r2, halfXModMinus - r2, minX + r2)

bottomline_y <- rep(minY, 2)

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

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

xy_7 <- cbind((halfXModMinus - r2) + r2 * sin(ptsl[[2]]), (maxY - r2) + r2 * cos(ptsl[[2]]))
xy_8 <- cbind((halfXModPlus + r2) + r2 * sin(ptsl[[1]]), (maxY - r2) + r2 * cos(ptsl[[1]]))

xy_11 <- cbind((halfXModMinus + xModifier) + xModifier * sin(ptsl[[4]]), (minY + (xModifier * 2)) + xModifier * cos(ptsl[[4]]))
xy_12 <- cbind((halfXModPlus - xModifier) + xModifier * sin(ptsl[[3]]), (minY + (xModifier * 2)) + xModifier * cos(ptsl[[3]]))

RoundedSAChrtx[[counter]] <- c(
rep(maxX, 2),
xy_3[, 1],
topBotline_x[2:1],
xy_4[, 1],
rep(minX, 2),
xy_1[, 1], topBotline_x2[4:3] # 3 4 1
, xy_7[, 1], halfXModMinus, halfXModMinus # 7
, rev(xy_11[, 1]),
rev(xy_12[, 1]) # 11 12
, rep(halfXModPlus, 2),
xy_8[, 1],
topBotline_x2[1:2],
xy_2[, 1] # 8 2
)

RoundedSAChrty[[counter]] <- c(
yMod[1:2],
xy_3[, 2],
bottomline_y,
xy_4[, 2],
yMod[2:1],
xy_1[, 2],
rep(maxY, 2) # 3 4 1
, xy_7[, 2], yMod[1], minY + (xModifier * 2) # 7
, rev(xy_11[, 2]), rev(xy_12[, 2]) # 11 12
, c(minY + (xModifier * 2), yMod[1]),
xy_8[, 2], rep(maxY, 2), xy_2[, 2] # 8 2
# 5 6 9 10
)

RoundedSAChrty[[counter]][which(RoundedSAChrty[[counter]] > maxY)] <- maxY

r2 <- r2backup
}

chrtXchrtYSARo <- list()
chrtXchrtYSARo\$RoundedSAChrtx <- RoundedSAChrtx
chrtXchrtYSARo\$RoundedSAChrty <- RoundedSAChrty
return(chrtXchrtYSARo)
}

mapXYchromatidLARo <- function(start, end, y, x, r2, xModifier, pts) {
RoundedLAChrtx <- RoundedLAChrty <- list()

for (counter in start:end) {
maxX <- minX <- halfX <- halfXModMinus <- halfXModPlus <- NULL

maxX <- max(x[[counter]])
minX <- min(x[[counter]])

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

halfX <- (maxX + minX) / 2
halfXModPlus <- halfX + xModifier
halfXModMinus <- halfX - xModifier

r2backup <- r2

diffx <- maxX - minX
diffy <- maxY - minY
ratexy <- diffx / diffy
ifelse((diffx / r2) * 2 < ratexy * 4, r2 <- diffx / (ratexy * 2), r2)

yMod <- y[[counter]]

yMod[which(yMod == max(yMod))] <- yMod[which(yMod == max(yMod))] - r2
yMod[which(yMod == min(yMod))] <- yMod[which(yMod == min(yMod))] + r2

topBotline_x <- c(minX + r2, maxX - r2)

topBotline_x2 <- c(halfXModPlus + r2, maxX - r2, halfXModMinus - r2, minX + r2)

bottomline_y <- rep(minY, 2)

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

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

xy_5 <- cbind((halfXModPlus + r2) + r2 * sin(ptsl[[4]]), (minY + r2) + r2 * cos(ptsl[[4]]))
xy_6 <- cbind((halfXModMinus - r2) + r2 * sin(ptsl[[3]]), (minY + r2) + r2 * cos(ptsl[[3]]))

xy_9 <- cbind((halfXModPlus - xModifier) + xModifier * sin(ptsl[[2]]), (maxY - (xModifier * 2)) + xModifier * cos(ptsl[[2]]))
xy_10 <- cbind((halfXModMinus + xModifier) + xModifier * sin(ptsl[[1]]), (maxY - (xModifier * 2)) + xModifier * cos(ptsl[[1]]))

RoundedLAChrtx[[counter]] <- c(
rep(maxX, 2),
xy_3[, 1],
topBotline_x2[2:1],
xy_5[, 1],
halfXModPlus # 2 5
, rev(xy_9[, 1]), rev(xy_10[, 1]) # 9 10
, halfXModMinus,
halfXModMinus,
xy_6[, 1], topBotline_x2[3:4], xy_4[, 1], rep(minX, 2),
xy_1[, 1], topBotline_x, xy_2[, 1] # 6 4 1 2
)

RoundedLAChrty[[counter]] <- c(
yMod[1:2],
xy_3[, 2],
bottomline_y[1:2],
xy_5[, 2],
maxY - (xModifier * 2) # 3 5
, rev(xy_9[, 2]), rev(xy_10[, 2]) # 9 10
, maxY - (xModifier * 2),
yMod[2],
xy_6[, 2], rep(minY, 2), xy_4[, 2], yMod[2:1], xy_1[, 2], rep(maxY, 2), xy_2[, 2] # 6 4 1 2
)

RoundedLAChrty[[counter]][which(RoundedLAChrty[[counter]] < minY)] <- minY

r2 <- r2backup
}

chrtXchrtYLARo <- list()
chrtXchrtYLARo\$RoundedLAChrtx <- RoundedLAChrtx
chrtXchrtYLARo\$RoundedLAChrty <- RoundedLAChrty
return(chrtXchrtYLARo)
}

mapXYchromatidHoloRo <- function(start, end, y, x, r2, xModifier, pts) {
holoRightx <- holoLeftx <- holoRighty <- holoLefty <- list()

for (counter in start:end) {
maxX <- minX <- halfX <- halfXModMinus <- halfXModPlus <- NULL

maxX <- max(x[[counter]])
minX <- min(x[[counter]])

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

diffx <- maxX - minX
diffy <- maxY - minY
ratexy <- diffx / diffy
ifelse((diffx / r2) * 2 < ratexy * 4, r2 <- diffx / (ratexy * 2), r2)

yMod <- y[[counter]]

yMod[which(yMod == max(yMod))] <- yMod[which(yMod == max(yMod))] - r2
yMod[which(yMod == min(yMod))] <- yMod[which(yMod == min(yMod))] + r2

halfX <- (maxX + minX) / 2
halfXModPlus <- halfX + xModifier
halfXModMinus <- halfX - xModifier

topBotline_x2 <- c(halfXModPlus + r2, maxX - r2, halfXModMinus - r2, minX + r2)
bottomline_y <- rep(minY, 2)

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

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

xy_5 <- cbind((halfXModPlus + r2) + r2 * sin(ptsl[[4]]), (minY + r2) + r2 * cos(ptsl[[4]]))
xy_6 <- cbind((halfXModMinus - r2) + r2 * sin(ptsl[[3]]), (minY + r2) + r2 * cos(ptsl[[3]]))
xy_7 <- cbind((halfXModMinus - r2) + r2 * sin(ptsl[[2]]), (maxY - r2) + r2 * cos(ptsl[[2]]))
xy_8 <- cbind((halfXModPlus + r2) + r2 * sin(ptsl[[1]]), (maxY - r2) + r2 * cos(ptsl[[1]]))

holoRightx[[counter]] <- c(
rep(maxX, 2), xy_3[, 1], topBotline_x2[1:2], xy_5[, 1] # 3 5
, halfXModPlus, halfXModPlus,
xy_8[, 1], topBotline_x2[2:1], xy_2[, 1] # 8 2
)
holoRighty[[counter]] <- c(
yMod[1:2], xy_3[, 2], bottomline_y, xy_5[, 2] # 3 5
, yMod[3:4],
xy_8[, 2], rep(maxY, 2), xy_2[, 2] # 8 2
)
holoLeftx[[counter]] <- c(
rep(halfXModMinus, 2), xy_6[, 1], topBotline_x2[3:4], # 6
xy_4[, 1], rep(minX, 2), # 4
xy_1[, 1], topBotline_x2[4:3], xy_7[, 1] # 1 7
)
holoLefty[[counter]] <- c(
yMod[1:2], xy_6[, 2], bottomline_y, # 6
xy_4[, 2], yMod[3:4], # 4
xy_1[, 2], rep(maxY, 2), xy_7[, 2] # 1 7
)
}

chrtXchrtYHoloRo <- list()
chrtXchrtYHoloRo\$holoRightx <- holoRightx
chrtXchrtYHoloRo\$holoLeftx <- holoLeftx
chrtXchrtYHoloRo\$holoRighty <- holoRighty
chrtXchrtYHoloRo\$holoLefty <- holoLefty
return(chrtXchrtYHoloRo)
}

mapXYmarksRo <- function(start, end, y, x, r2, xModifier, pts) {
markRightx <- markLeftx <- markRighty <- markLefty <- list()

for (counter in start:end) {
if (attr(y[[counter]], "wholeArm") == "false") {
maxX <- minX <- halfX <- halfXModMinus <- halfXModPlus <- NULL

maxX <- max(x[[counter]])
minX <- min(x[[counter]])

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

r2backup <- r2

diffx <- maxX - minX
diffy <- maxY - minY

ratexy <- diffx / diffy

ifelse((diffx / r2) * 2 < ratexy * 4, r2 <- diffx / (ratexy * 2), r2)

yMod <- y[[counter]]

yMod[which(yMod == max(yMod))] <- yMod[which(yMod == max(yMod))] - r2
yMod[which(yMod == min(yMod))] <- yMod[which(yMod == min(yMod))] + r2

halfX <- (maxX + minX) / 2
halfXModPlus <- halfX + xModifier
halfXModMinus <- halfX - xModifier

topBotline_x2 <- c(halfXModPlus + r2, maxX - r2, halfXModMinus - r2, minX + r2)
bottomline_y <- rep(minY, 2)

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

xy_1 <- cbind((minX + r2) + r2 * sin(ptsl[[1]]), (maxY - r2) + r2 * cos(ptsl[[1]]))
xy_2 <- cbind((maxX - r2) + r2 * sin(ptsl[[2]]), (maxY - r2) + r2 * cos(ptsl[[2]]))

xy_3 <- cbind((maxX - r2) + r2 * sin(ptsl[[3]]), (minY + r2) + r2 * cos(ptsl[[3]]))
xy_4 <- cbind((minX + r2) + r2 * sin(ptsl[[4]]), (minY + r2) + r2 * cos(ptsl[[4]]))

xy_5 <- cbind((halfXModPlus + r2) + r2 * sin(ptsl[[4]]), (minY + r2) + r2 * cos(ptsl[[4]]))
xy_6 <- cbind((halfXModMinus - r2) + r2 * sin(ptsl[[3]]), (minY + r2) + r2 * cos(ptsl[[3]]))

xy_7 <- cbind((halfXModMinus - r2) + r2 * sin(ptsl[[2]]), (maxY - r2) + r2 * cos(ptsl[[2]]))
xy_8 <- cbind((halfXModPlus + r2) + r2 * sin(ptsl[[1]]), (maxY - r2) + r2 * cos(ptsl[[1]]))

markRightx[[counter]] <- c(
rep(maxX, 2), xy_3[, 1], topBotline_x2[1:2], xy_5[, 1] # 3 5
, halfXModPlus, halfXModPlus,
xy_8[, 1], topBotline_x2[2:1], xy_2[, 1] # 8 2
)
markRighty[[counter]] <- c(
yMod[1:2], xy_3[, 2], bottomline_y, xy_5[, 2] # 3 5
, yMod[3:4],
xy_8[, 2], rep(maxY, 2), xy_2[, 2] # 8 2
)
markLeftx[[counter]] <- c(
rep(halfXModMinus, 2), xy_6[, 1], topBotline_x2[3:4], # 6
xy_4[, 1], rep(minX, 2), # 4
xy_1[, 1], topBotline_x2[4:3], xy_7[, 1] # 1 7
)
markLefty[[counter]] <- c(
yMod[1:2], xy_6[, 2], bottomline_y, # 6
xy_4[, 2], yMod[3:4], # 4
xy_1[, 2], rep(maxY, 2), xy_7[, 2] # 1 7
)

r2 <- r2backup
} else { # whole arm False True

if (attr(y[[counter]], "whichArm") == "short") {
maxX <- minX <- halfX <- halfXModMinus <- halfXModPlus <- NULL

maxX <- max(x[[counter]])
minX <- min(x[[counter]])

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

halfX <- (maxX + minX) / 2
halfXModPlus <- halfX + xModifier
halfXModMinus <- halfX - xModifier

r2backup <- r2

diffx <- maxX - minX
diffy <- maxY - minY

ratexy <- diffx / diffy

ifelse((diffx / r2) * 2 < ratexy * 4, r2 <- diffx / (ratexy * 2), r2)

yMod <- y[[counter]]

yMod[which(yMod == max(yMod))] <- yMod[which(yMod == max(yMod))] - r2
yMod[which(yMod == min(yMod))] <- yMod[which(yMod == min(yMod))] + r2

topBotline_x <- c(minX + r2, maxX - r2)

topBotline_x2 <- c(halfXModPlus + r2, maxX - r2, halfXModMinus - r2, minX + r2)

bottomline_y <- rep(minY, 2)

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

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

xy_7 <- cbind((halfXModMinus - r2) + r2 * sin(ptsl[[2]]), (maxY - r2) + r2 * cos(ptsl[[2]]))
xy_8 <- cbind((halfXModPlus + r2) + r2 * sin(ptsl[[1]]), (maxY - r2) + r2 * cos(ptsl[[1]]))

xy_11 <- cbind((halfXModMinus + xModifier) + xModifier * sin(ptsl[[4]]), (minY + (xModifier * 2)) + xModifier * cos(ptsl[[4]]))
xy_12 <- cbind((halfXModPlus - xModifier) + xModifier * sin(ptsl[[3]]), (minY + (xModifier * 2)) + xModifier * cos(ptsl[[3]]))

# this is not only right but both chrtids

markRightx[[counter]] <- c(
rep(maxX, 2), xy_3[, 1], topBotline_x[2:1], xy_4[, 1], rep(minX, 2), xy_1[, 1], topBotline_x2[4:3] # 3 4 1
, xy_7[, 1], halfXModMinus, halfXModMinus # 7
, rev(xy_11[, 1]), rev(xy_12[, 1]) # 11 12
, rep(halfXModPlus, 2),
xy_8[, 1], topBotline_x2[2:1], xy_2[, 1] # 8 2
)

# this is not only right but both chrts

markRighty[[counter]] <- c(
yMod[1:2], xy_3[, 2], bottomline_y, xy_4[, 2], yMod[2:1], xy_1[, 2], rep(maxY, 2) # 3 4 1
, xy_7[, 2], yMod[1], minY + (xModifier * 2) # 7
, rev(xy_11[, 2]), rev(xy_12[, 2]) # 11 12
, c(minY + (xModifier * 2), yMod[1]),
xy_8[, 2], rep(maxY, 2), xy_2[, 2] # 8 2
# 5 6 9 10
)

markLeftx[[counter]] <- NA
markLefty[[counter]] <- NA

r2 <- r2backup
} else { # whichArm short else long

maxX <- minX <- halfX <- halfXModMinus <- halfXModPlus <- NULL

maxX <- max(x[[counter]])
minX <- min(x[[counter]])

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

halfX <- (maxX + minX) / 2
halfXModPlus <- halfX + xModifier
halfXModMinus <- halfX - xModifier

r2backup <- r2

diffx <- maxX - minX
diffy <- maxY - minY
ratexy <- diffx / diffy
ifelse((diffx / r2) * 2 < ratexy * 4, r2 <- diffx / (ratexy * 2), r2)

yMod <- y[[counter]]

yMod[which(yMod == max(yMod))] <- yMod[which(yMod == max(yMod))] - r2
yMod[which(yMod == min(yMod))] <- yMod[which(yMod == min(yMod))] + r2

topBotline_x <- c(minX + r2, maxX - r2)

topBotline_x2 <- c(halfXModPlus + r2, maxX - r2, halfXModMinus - r2, minX + r2)

bottomline_y <- rep(minY, 2)

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

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

xy_5 <- cbind((halfXModPlus + r2) + r2 * sin(ptsl[[4]]), (minY + r2) + r2 * cos(ptsl[[4]]))
xy_6 <- cbind((halfXModMinus - r2) + r2 * sin(ptsl[[3]]), (minY + r2) + r2 * cos(ptsl[[3]]))

xy_9 <- cbind((halfXModPlus - xModifier) + xModifier * sin(ptsl[[2]]), (maxY - (xModifier * 2)) + xModifier * cos(ptsl[[2]]))
xy_10 <- cbind((halfXModMinus + xModifier) + xModifier * sin(ptsl[[1]]), (maxY - (xModifier * 2)) + xModifier * cos(ptsl[[1]]))

# this is not only right but both chrtids

markRightx[[counter]] <- c(
rep(maxX, 2), xy_3[, 1], topBotline_x2[1:2], xy_5[, 1], halfXModPlus, # 2 5
rev(xy_9[, 1]), rev(xy_10[, 1]) # 9 10
, halfXModMinus, halfXModMinus,
xy_6[, 1], topBotline_x2[3:4], xy_4[, 1], rep(minX, 2), xy_1[, 1], topBotline_x, xy_2[, 1] # 6 4 1 2
)

# both:

markRighty[[counter]] <- c(
yMod[1:2], xy_3[, 2], bottomline_y[1:2], xy_5[, 2], maxY - (xModifier * 2), # 3 5
rev(xy_9[, 2]), rev(xy_10[, 2]) # 9 10
, maxY - (xModifier * 2), yMod[2],
xy_6[, 2], rep(minY, 2), xy_4[, 2], yMod[2:1], xy_1[, 2], rep(maxY, 2), xy_2[, 2] # 6 4 1 2
)
# 7 8 11 12

markLeftx[[counter]] <- NA
markLefty[[counter]] <- NA

r2 <- r2backup
}
}
attr(markLeftx[[counter]], "arm") <-
attr(markLefty[[counter]], "arm") <-
attr(markRightx[[counter]], "arm") <- attr(markRighty[[counter]], "arm") <- attr(y[[counter]], "arm")
attr(markLeftx[[counter]], "rowIndex") <-
attr(markLefty[[counter]], "rowIndex") <-
attr(markRightx[[counter]], "rowIndex") <- attr(markRighty[[counter]], "rowIndex") <- attr(y[[counter]], "rowIndex")
attr(markLeftx[[counter]], "wholeArm") <-
attr(markLefty[[counter]], "wholeArm") <-
attr(markRightx[[counter]], "wholeArm") <- attr(markRighty[[counter]], "wholeArm") <- attr(y[[counter]], "wholeArm")
attr(markLeftx[[counter]], "whichArm") <-
attr(markLefty[[counter]], "whichArm") <-
attr(markRightx[[counter]], "whichArm") <- attr(markRighty[[counter]], "whichArm") <- attr(y[[counter]], "whichArm")
attr(markLeftx[[counter]], "squareSide") <-
attr(markLefty[[counter]], "squareSide") <-
attr(markRightx[[counter]], "squareSide") <- attr(markRighty[[counter]], "squareSide") <- attr(y[[counter]], "squareSide")
}

chrtXchrtYmarkRo <- list()

chrtXchrtYmarkRo\$markRightx <- markRightx
chrtXchrtYmarkRo\$markRighty <- markRighty

chrtXchrtYmarkRo\$markLeftx <- markLeftx
chrtXchrtYmarkRo\$markLefty <- markLefty

return(chrtXchrtYmarkRo)
}

#' @keywords internal
#' @param n number of edges in rounded vertices
makeRoundCoordXY <- function(r2, yfactor, x, y, start, end, n, ptsl) {
xyCoords <- mapXY(
1, (length(y)),
y, y,
x,
yfactor, r2,
ptsl[[1]], ptsl[[2]], ptsl[[3]], ptsl[[4]]
)
return(xyCoords)
}
```

## 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.