R/sample.nones.R

In oacar/pgsNetwork: This package is used for ref

#' this randomly samples nodes considering degree dist, experimental array design and number of experiments
#' @param pgs_
#' @param nones.exp.data
#' @param colname
#' @param dist
#' @param array
#' @param bin
#'
#' @return random gene name
sample.nones <- function(pgs_, nones.exp.data, colname, dist = F, array = T, bin = T) {
  # colname should be Systematic.gene.name or Allele/Gene.name
  s <- c()
  count <- c()
  if (dist) {
    for (i in 1:length(pgs_)) {
      # print(pgs_[i])
      t <- 0
      pg.name <- pgs_[i]
      cat <- ifelse(array, unique(nones.exp.data$cat[nones.exp.data[[colname]] == pg.name]), NA)
      bin <- ifelse(bin, unique(nones.exp.data$bin[nones.exp.data[[colname]] == pg.name]), NA)
      deg <- unique(nones.exp.data$deg[nones.exp.data[[colname]] == pg.name])
      if (is.na(cat) == F && is.na(bin) == F) {
        sample.space.df <- nones.exp.data[nones.exp.data$cat == cat & nones.exp.data$bin == bin & (nones.exp.data$deg >= (deg - t) & nones.exp.data$deg <= (deg + t)), ]
      } else if (is.na(cat) == F && is.na(bin)) {
        sample.space.df <- nones.exp.data[nones.exp.data$cat == cat & (nones.exp.data$deg >= (deg - t) & nones.exp.data$deg <= (deg + t)), ]
      } else if (is.na(cat) && is.na(bin) == F) {
        sample.space.df <- nones.exp.data[nones.exp.data$bin == bin & (nones.exp.data$deg >= (deg - t) & nones.exp.data$deg <= (deg + t)), ]
      } else {
        sample.space.df <- nones.exp.data[(nones.exp.data$deg >= (deg - t) & nones.exp.data$deg <= (deg + t)), ]
      }
      sample.space <- sample.space.df[[colname]] %>%
        unique() %>%
        setdiff(union(s, pgs_))
      # print(paste(pg.name, length(sample.space)))
      count <- append(count, length(sample.space))
      while (length(sample.space) == 0) {
        t <- t + 1
        if (is.na(cat) == F && is.na(bin) == F) {
          sample.space.df <- nones.exp.data[nones.exp.data$cat == cat & nones.exp.data$bin == bin & (nones.exp.data$deg >= (deg - t) & nones.exp.data$deg <= (deg + t)), ]
        } else if (is.na(cat) == F && is.na(bin)) {
          sample.space.df <- nones.exp.data[nones.exp.data$cat == cat & (nones.exp.data$deg >= (deg - t) & nones.exp.data$deg <= (deg + t)), ]
        } else if (is.na(cat) && is.na(bin) == F) {
          sample.space.df <- nones.exp.data[nones.exp.data$bin == bin & (nones.exp.data$deg >= (deg - t) & nones.exp.data$deg <= (deg + t)), ]
        } else {
          sample.space.df <- nones.exp.data[(nones.exp.data$deg >= (deg - t) & nones.exp.data$deg <= (deg + t)), ]
        }
        sample.space <- sample.space.df[[colname]] %>%
          unique() %>%
          setdiff(union(s, pgs_))
        # print(paste(t, length(sample.space),deg,pg.name))
        if (t > 30) {
          t=0
          if(is.na(bin)) break else bin=NA
        }
      }
      s <- append(s, ifelse(length(sample.space) == 0, NA, sample(sample.space, 1))) # sample(sample.space,1))#
    }
  } else {
    for (i in 1:length(pgs_)) {
      pg.name <- pgs_[i]
      cat <- ifelse(array, unique(nones.exp.data$cat[nones.exp.data[[colname]] == pg.name]), NA)
      bin <- ifelse(bin, unique(nones.exp.data$bin[nones.exp.data[[colname]] == pg.name]), NA)
      if (is.na(cat) == F && is.na(bin) == F) {
        sample.space.df <- nones.exp.data[nones.exp.data$cat == cat & nones.exp.data$bin == bin, ] # &nones.exp.data$deg<max(nones.exp.data$deg[nones.exp.data[[colname]]%in%pgs_]),]
      } else if (is.na(cat) == F && is.na(bin)) {
        sample.space.df <- nones.exp.data[nones.exp.data$cat == cat, ] # &nones.exp.data$deg<max(nones.exp.data$deg[nones.exp.data[[colname]]%in%pgs_]),]
      } else if (is.na(cat) && is.na(bin) == F) {
        sample.space.df <- nones.exp.data[nones.exp.data$bin == bin, ] # & nones.exp.data$deg<max(nones.exp.data$deg[nones.exp.data[[colname]]%in%pgs_]),]
      } else {
        sample.space.df <- nones.exp.data # [nones.exp.data$deg<max(nones.exp.data$deg[nones.exp.data[[colname]]%in%pgs]),]
      }
      sample.space <- sample.space.df[[colname]] %>%
        unique() %>%
        setdiff(union(s, pgs_))
      if (length(sample.space) == 0) {
        sample.space.df <- if(is.na(cat)) nones.exp.data else nones.exp.data[nones.exp.data$cat == cat, ]
        sample.space <- sample.space.df[[colname]] %>%
          unique() %>%
          setdiff(union(s, pgs_))
      }
      # print(paste(pg.name, length(sample.space)))
      count <- append(count, length(sample.space))

      s <- append(s, ifelse(length(sample.space) == 0, NA, sample(sample.space, 1)))
    }
  }
  s <- s[is.na(s) == F]
  # list(s=s,count=count)
  s
}