R/employee_fun_mergeEmp.R

In basilrabi/mansched2: Manpower Scheduler and Personnel Cost Calculator for Taganito Mine

#' Merge theoretical employee list
#'
#' Combines all man hour types of a list of theoretical employees.
#'   All man hours are stored in only one theoretical employee.
#'
#' @param x a list of \code{\link{Employee-class}} representing theoretical
#'   employees with the same class and the same costCenter slot
#'
#'   For \code{\link{Operator-class}}, the equipment slot must also be the same.
#' @return an \code{\link{Employee-class}} object
#' @export mergeEmp
mergeEmp <- function(x) {

  if(class(x) != "list")
    stop("Argument is not a list of Employee-class objects!")

  if (length(x) == 1L) {

    if (is(x[[1]], "Employee")) {

      x[[1]]@ID <- paste(class(x[[1]]), x[[1]]@costCenter, sep = "-")

      if (is(x[[1]], "Operator"))
        x[[1]]@ID <- paste(x[[1]]@ID, x[[1]]@equipment, sep = "-")

      return(x[[1]])
    } else {
      stop("Argument is not a list of Employee-class objects!")
    }

  }

  if (!is(x[[1]], "Employee"))
    stop("Argument is not a list of Employee-class objects!")

  tempEmp <- x[[1]]
  tempClass <- sapply(x, FUN = function(x) {class(x)})
  tempClass <- unique(tempClass)

  if (length(tempClass) > 1)
    stop("Incompatible Employee-class!")

  tempCostCenter <- sapply(x, FUN = function(x) {x@costCenter})
  tempCostCenter <- unique(tempCostCenter)

  if (length(tempCostCenter) > 1)
    stop("Incompatible cost center!")

  tempEmp@ID <- paste(tempClass, tempCostCenter, sep = "-")

  if (is(x[[1]], "Operator")) {

    tempEquip <- sapply(x, FUN = function(x) {x@equipment})
    tempEquip <- unique(tempEquip)

    if (length(tempEquip) > 1)
      stop("Incompatible equipment!")

    tempEmp@ID <- paste(tempEmp@ID, tempEquip, sep = "-")
    tempEmp@equipment <- paste(tempEquip, collapse = " ")
  }

  zero <- rep(0L, times = 12)

  reg <- sapply(x, FUN = function(y) {y@reg})
  reg <- apply(reg, MARGIN = 1, FUN = sum)
  tempEmp@reg <- reg

  if (is(tempEmp, "NonStaff")) {
    regOT <- sapply(x, FUN = function(y) {y@regOT})
    regOT <- apply(regOT, MARGIN = 1, FUN = sum)
    tempEmp@regOT <- regOT
  }

  if (is(tempEmp, "OperationPersonnel")) {
    sh <- sapply(x, FUN = function(y) {y@sh})
    lh <- sapply(x, FUN = function(y) {y@lh})
    nh <- sapply(x, FUN = function(y) {y@nh})
    shOT <- sapply(x, FUN = function(y) {y@shOT})
    lhOT <- sapply(x, FUN = function(y) {y@lhOT})
    nhOT <- sapply(x, FUN = function(y) {y@nhOT})
    sh <- apply(sh, MARGIN = 1, FUN = sum)
    lh <- apply(lh, MARGIN = 1, FUN = sum)
    nh <- apply(nh, MARGIN = 1, FUN = sum)
    shOT <- apply(shOT, MARGIN = 1, FUN = sum)
    lhOT <- apply(lhOT, MARGIN = 1, FUN = sum)
    nhOT <- apply(nhOT, MARGIN = 1, FUN = sum)
    tempEmp@sh <- sh
    tempEmp@lh <- lh
    tempEmp@nh <- nh
    tempEmp@shOT <- shOT
    tempEmp@lhOT <- lhOT
    tempEmp@nhOT <- nhOT
  }

  return(tempEmp)
}