R/operations.R

In bblodfon/xxxfun: Miscellaneous Functions by John

#' get the common `names` from two vectors and print an appropriate message
#' `vector.names.str` tell us what `names(vec)` actually is, to put it on
#' the print message
#' @export
get.common.names = function(vec1, vec2, vector.names.str = "nodes",
                            with.gt = TRUE) {
  common.names = intersect(names(vec1), names(vec2))
  common.names.number = length(common.names)

  if (common.names.number == 0) {
    str = paste0("No common ", vector.names.str)
    pretty.print.string(str, with.gt = with.gt)
    return(FALSE)
  }
  else {
    pretty.print.vector.values(common.names, with.gt = with.gt)
    return(common.names)
  }
}

#' get the common values from two vectors and print an appropriate message
#' `vector.values.str` tell us what the `vec` values are, to put it on
#' the print message
#' @export
get.common.values = function(vec1, vec2, vector.values.str = "nodes",
                             with.gt = TRUE) {
  common.values = intersect(vec1, vec2)
  common.values.number = length(common.values)

  if (common.values.number == 0) {
    str = paste0("No common ", vector.values.str)
    pretty.print.string(str, with.gt = with.gt)
    return(NULL)
  }
  else {
    pretty.print.vector.values(common.values, with.gt = with.gt)
    return(common.values)
  }
}

#' Input: two vectors with same column names
#' Output: a data frame with 2 vectors:
#'   1) the first input vector only pruned to its unique values
#'   2) a second vector with the average values for each unique
#'       value of the first (the matching is done by column name)
#' @export
get.average.over.unique.values = function(vec1, vec2) {
  stopifnot(names(vec1) == names(vec2))

  vec1.sorted = sort(vec1)
  vec1.sorted.unique = sort(unique(vec1))
  vec2.avg.values = numeric(length = length(vec1.sorted.unique))
  sd.values = numeric(length = length(vec1.sorted.unique))

  index = 0
  for (value in vec1.sorted.unique) {
    index = index + 1
    vec2.avg.values[index] = mean(vec2[
      (names(vec1.sorted[vec1.sorted == value]))
    ])
    sd.values[index] = sd(vec2[
      (names(vec1.sorted[vec1.sorted == value]))
    ])
  }

  # In case of NA elements in sd calculation
  # (one element vectors), replace with 0
  sd.values[is.na(sd.values)] = 0

  res = cbind(vec1.sorted.unique, vec2.avg.values, sd.values)
  colnames(res) = c(deparse(substitute(vec1)), deparse(substitute(vec2)), "sd")

  return(res)
}

#' input are vectors with 1 and 0's with same `names` attribute
#' @export
get.percentage.of.matches = function(num.vec.1, num.vec.2) {
  stopifnot(names(num.vec.1) == names(num.vec.2))

  total = length(num.vec.1)
  diff = num.vec.1 - num.vec.2
  matches = sum(diff == 0)
  matches.percentage = matches / total

  return(matches.percentage)
}

#' checks if `value` is in [low.thres,high.thres) (standard behaviour) or [a,b]
#' @export
is.between = function(value, low.thres, high.thres, include.high.value = FALSE) {
  if (include.high.value) return(value >= low.thres & value <= high.thres)
  else return(value >= low.thres & value < high.thres)
}

#' The opposite of `intersect` function {base}
#' @export
outersect = function(x, y) {
  sort(c(setdiff(x, y), setdiff(y, x)))
}

#' @export
is.empty = function(obj) {
  if (length(obj)) return(FALSE) else return(TRUE)
}

#' prune columns from a data.frame if all elements
#' of a column have the same integer `value`
#' @export
prune.columns.from.df = function(df, value) {
  if (length(df) == 0) return(df)
  return(df[, colSums(df != value) > 0])
}

#' prune rows from a data.frame if all elements
#' of a row have the same integer `value`
#' @export
prune.rows.from.df = function(df, value) {
  if (length(df) == 0) return(df)
  return(df[rowSums(df != value) > 0, ])
}

#' `df` is (n x 2) dimensions
#' @export
add.vector.to.data.frame = function(df, vec) {
  if (length(vec) == 0) return(df)
  for (i in 1:length(vec)) {
    value = vec[i]
    name = names(vec)[i]
    df = rbind(df, c(name, value))
  }
  return(df)
}

#' @export
mat.equal = function(x, y) {
  is.matrix(x) && is.matrix(y) && dim(x) == dim(y) && all(x == y)
}