R/mapXY.R

Defines functions makeRoundCoordXY mapXYmarksRo mapXYchromatidHoloRo mapXYchromatidLARo mapXYchromatidSARo mapXYchromatidHolo mapXYchromatidSA mapXYchromatidLA mapxyRoundCenLines mapXYCenLines mapXYCen mapXY

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 r2 radius
#' @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.