# 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 n number of edges in rounded vertices
#' @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

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
} # for

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

} # for

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

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

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(#minX,xy_1[[counter]][,1],minX+halfmaxX,
rev(xy_2[,1] )
# maxX, (xy_3[[counter]][,1] ),minX+halfmaxX,
,xy_4[,1]
) # opposite of cen.

roundedY1[[counter]]<-c(#minY,xy_1[[counter]][,2],minY+halfmaxY,
rev(xy_2[,2])
#maxY, (xy_3[[counter]][,2] ),minY+halfmaxY,
,xy_4[,2]
)

roundedX2[[counter]]<-c(#minX,
xy_1[,1]
#,minX+halfmaxX,(xy_2[[counter]][,1]),
#maxX,
,rev(xy_3[,1] )
#,minX+halfmaxX,xy_4[[counter]][,1]
) # opposite of cen.

roundedY2[[counter]]<-c(#minY,
xy_1[,2]
#,minY+halfmaxY,(xy_2[[counter]][,2]),
#maxY,
,rev(xy_3[,2] )
#,minY+halfmaxY,xy_4[[counter]][,2]
)
# }
} # for

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)

} # for

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(yMarkPer[[s]][[m]],"rowIndex")<-name

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")

} # for counter

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)

# pts<- seq(-pi/2, pi*1.5, length.out = ver*4)
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
} # for

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)

# pts<- seq(-pi/2, pi*1.5, length.out = ver*4)
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
} # for

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
)
} # for

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)

# pts<- seq(-pi/2, pi*1.5, length.out = ver*4)
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")
} # for counter

chrtXchrtYmarkRo<-list()

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

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

return(chrtXchrtYmarkRo)
}

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 Sept. 16, 2022, 5:07 p.m.