R/armRatioCI.R

In idiogramFISH: Shiny App. Idiograms with Marks and Karyotype Indices

#' @name armRatioCI
#' @aliases swapChrRegionDfSizeAndMarks
#' @title FUNCTIONS armRatioCI and swapChrRegionDfSizeAndMarks.
#' @description armRatioCI: reads a data.frame and produces AR (arm ratio), CI
#' (centromeric index) , Guerra and Levan classifications.
#' @description swapChrRegionDfSizeAndMarks: reads data.frames to swap arms
#'
#' @param dfChrSize name of data.frame with columns: shortArmSize, longArmSize
#' @param dfMarkPos name of data.frame of marks
#' @param rnumeric boolean, returns only numeric AR, CI
#' @param chrNamesToSwap name of chr. names to swap arms
#'
#' @keywords data.frame size arm
#' @examples
#' armRatioCI(dfOfChrSize)
#' armRatioCI(bigdfOfChrSize)
#'
#' @seealso \code{\link{chrbasicdatamono}}
#' @references LEVAN A, FREDGA K, SANDBERG AA (1964) NOMENCLATURE FOR
#' CENTROMERIC POSITION ON CHROMOSOMES. Hereditas 52:201-220.
#' @references Guerra. 1986. Reviewing the chromosome nomenclature of Levan et
#' al. Braz. Jour. Gen. Vol IX, 4, 741-743
#'
#' @return data.frame (armRatioCI)
#' @rdname armRatioCI
#' @export
#'
armRatioCI <- function(dfChrSize, rnumeric = FALSE) {
  dfChrSize <- as.data.frame(dfChrSize)
  # message("\nCalculating chromosome indexes\n")
  if (!"shortArmSize" %in% colnames(dfChrSize)) {
    message("\nSorry, shortArmSize column, mandatory\n")
    return(data.frame())
  }
  if (!"longArmSize" %in% colnames(dfChrSize)) {
    message("\nSorry, longArmSize column, mandatory\n")
    return(data.frame())
  }

  dfChrSize$smallest <- pmin(dfChrSize$shortArmSize, dfChrSize$longArmSize)
  dfChrSize$largest <- pmax(dfChrSize$shortArmSize, dfChrSize$longArmSize)
  dfChrSize$chrSize <- dfChrSize$smallest + dfChrSize$largest
  dfChrSize <- dfChrSize[which(!is.na(dfChrSize$chrSize)), ]

  if (!identical(dfChrSize$smallest, dfChrSize$shortArmSize)) {
    dfChrSize$diffSmallShort <- dfChrSize$shortArmSize - dfChrSize$smallest
    message(crayon::red("\nERROR in short/long arm classif. It will not be fixed\nChr. (cen) indexes will not be calculated"))
    attr(dfChrSize, "indexStatus") <- "failure"
    return(dfChrSize)
  }

  if ("OTU" %in% colnames(dfChrSize)) {
    message(paste("\nCalculating chromosome indexes in", unique(dfChrSize$OTU)))
  }

  dfChrSize$AR <- format(round(dfChrSize$largest / dfChrSize$smallest, 1), nsmall = 1)
  dfChrSize$CI <- format(round(dfChrSize$smallest * 100 / (dfChrSize$longArmSize + dfChrSize$shortArmSize), 1), nsmall = 1)
  dfChrSize$ARnum <- as.numeric(dfChrSize$AR)
  dfChrSize$CInum <- as.numeric(dfChrSize$CI)

  dfChrSize$Guerra <- ifelse(dfChrSize$ARnum <= 1.49999999999, "M",
    ifelse(dfChrSize$ARnum >= 1.5 & dfChrSize$ARnum <= 2.999999999, "SM",
      ifelse(dfChrSize$ARnum >= 3, "A", "")
    )
  )
  dfChrSize$Levan <- ifelse(dfChrSize$ARnum == 1, "M",
    ifelse(dfChrSize$ARnum > 1 & dfChrSize$ARnum < 1.7, "m",
      ifelse(dfChrSize$ARnum == 1.7, "m-sm",
        ifelse(dfChrSize$ARnum > 1.7 & dfChrSize$ARnum < 3, "sm",
          ifelse(dfChrSize$ARnum == 3, "sm-st",
            ifelse(dfChrSize$ARnum > 3 & dfChrSize$ARnum < 7, "st",
              ifelse(dfChrSize$ARnum == 7, "st-t",
                ifelse(dfChrSize$ARnum > 7, "t", "")
              )
            )
          )
        )
      )
    )
  )

  if (rnumeric) {
    dfChrSize$CI <- dfChrSize$CInum
    dfChrSize$CInum <- NULL
    dfChrSize$AR <- dfChrSize$ARnum
    dfChrSize$ARnum <- NULL
  }
  attr(dfChrSize, "indexStatus") <- "success"
  return(dfChrSize)
}
#'
#' @rdname armRatioCI
#' @return list of data.frames (swapChrRegionDfSizeAndMarks)
#' @examples
#' swapChrRegionDfSizeAndMarks(dfOfChrSize, dfOfMarks, "1")
#' @export
swapChrRegionDfSizeAndMarks <- function(dfChrSize, dfMarkPos, chrNamesToSwap) {
  dfChrSize$chrName <- as.character(dfChrSize$chrName)
  dfMarkPos$chrName <- as.character(dfMarkPos$chrName)

  for (c in chrNamesToSwap) {
    index <- NULL
    markIndex <- NULL
    index <- which(dfChrSize$chrName %in% c)
    if (length(index) > 0) {
      dfChrSize$shortArmSize2 <- dfChrSize$longArmSize
      dfChrSize[index, ]$longArmSize <- dfChrSize[index, ]$shortArmSize
      dfChrSize[index, ]$shortArmSize <- dfChrSize[index, ]$shortArmSize2
      dfChrSize$shortArmSize2 <- NULL
    }
    if (!missing(dfMarkPos)) {
      markIndex <- which(dfMarkPos$chrName %in% c)
      if (length(markIndex) > 0) {
        dfMarkPos$chrRegion2 <- dfMarkPos$chrRegion
        dfMarkPos[markIndex, ]$chrRegion2[dfMarkPos[markIndex, ]$chrRegion %in% "p"] <- "q"
        dfMarkPos[markIndex, ]$chrRegion2[dfMarkPos[markIndex, ]$chrRegion %in% "q"] <- "p"
        dfMarkPos[markIndex, ]$chrRegion <- dfMarkPos[markIndex, ]$chrRegion2
        dfMarkPos$chrRegion2 <- NULL
      }
    }
  }
  mylist <- list(dfChrSize, dfMarkPos)
  names(mylist) <- c("dfChrSize", "dfMarkPos")
  return(mylist)
}