R/makedfMarkColorMycolors.R

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

#' @name makedfMarkColorMycolors
#' @title FUNCTION to make a data.frame of Marks' characterisitcs
#'
#' @description This function reads character vector with marks names, a
#' character vector of
#' prohibited colors and a custom list of colors
#' to be associated with the mark names
#' @description It returns a data.frame with color and style for each mark
#'
#' @param markNames names of marks
#' @param colorstoremove character vector of colors to remove from mycolors. Default \code{NULL}
#' @param mycolors character vector of names of colors
#' @param defaultStyleMark character vector with default style \code{"square"}. Other options:  \code{"squareLeft"}, \code{"cM"}
#' \code{"cMLeft"}, \code{"dots"}, \code{"upArrow"}, \code{"downArrow"}, \code{"cenStyle"}
#'
#' @keywords mark create
#' @importFrom grDevices col2rgb
#' @export
#' @return data.frame
#'
makedfMarkColorMycolors<- function(markNames, mycolors, colorstoremove=NULL, defaultStyleMark="square"){

  dfMarkColor<-idiogramFISH::dfMarkColor

  message(crayon::green(paste("By default 5S are plotted as dots, to change this behavior make your own dfMarkColor data.frame") )
          ) # m

  tryCatch(dfMarkColor[which(dfMarkColor$style %in% "square"),]$style<-defaultStyleMark, error=function(e) "")

  mycolors<-mycolors[!mycolors %in% colorstoremove]

  mycolors<-mycolors[sapply(mycolors, function(X) {
    tryCatch(is.matrix(col2rgb(X)),
             error = function(e) {message(crayon::red(paste("Color",X,"invalid, removed from mycolors") ) ); return(FALSE) })
  } )]

  dfMarkColorNew<-data.frame(markName=markNames)
  dfMarkColorNew$markNameNP <- dfMarkColorNew$markName
  dfMarkColorNew$markNameNP <- gsub("^inProtein","",dfMarkColorNew$markNameNP)
  dfMarkColorNew$markColor <- NA

  vecNP<-unique(dfMarkColorNew$markNameNP)
  lenmandf<-length(vecNP)

  if(length(mycolors)<lenmandf){
    message(crayon::blue(paste("Not enough colors in mycolor parameter, will be recycled") ) )
    repF<-ceiling(lenmandf/length(mycolors) )
    mycolors<-rep(mycolors,repF)
  }

  mycolors <- mycolors[1:lenmandf]
  names(mycolors)<- vecNP

  dfMarkColorNew$markColor <- mycolors[ match( dfMarkColorNew$markNameNP,names(mycolors)  ) ]

  dfMarkColorNew$style<-dfMarkColor$style[match(toupper(dfMarkColorNew$markNameNP),toupper(dfMarkColor$markName) )]

  dfMarkColorNew$style[which(is.na(dfMarkColorNew$style))]<-defaultStyleMark

  tryCatch(dfMarkColorNew[which(dfMarkColorNew$markName %in%
                         grep("inProtein",dfMarkColorNew$markName,value=TRUE) ),]$style<-"inProtein"
           ,error=function(e){""} )
  dfMarkColorNew$markNameNP<-NULL
  return(dfMarkColorNew)
}