#' Compute man hours database
#'
#' Computes a man hours database throughout the year to be budgeted.
#'
#' @param empReq a \code{\link{data.frame}} similar to \code{empReq} in
#' \code{\link{initEmpReq}}
#' @param empPool a \code{data.frame} similar to \code{empPool} in
#' \code{\link{initEmpPool}}
#' @param sched a \code{data.frame} similar to \code{sched} in
#' \code{\link{initEmpReq}}
#' @param year an integer value representing the year to be budgeted
#' @param hol a \code{data.frame} similar to \code{\link{holidays}}
#' @param forecast logical value \cr
#' Compute cost for forecast?
#' @return a list containing the following:
#' \enumerate{
#' \item \code{data.frame} representing the man hours database of the
#' assigned employees
#'
#' This is composed of the following columns:
#' \describe{
#' \item{ID}{character string representing the unique identifier of the
#' real employee}
#' \item{reqID}{character string representing the unique identifier of the
#' real employee}
#' \item{mh}{integer value representing the man hours assigned}
#' \item{mhType}{character string representing the man hours type
#' assigned (see \code{\link{assignEmp}})}
#' \item{month}{integer value representing the month}
#' \item{np}{integer value representing the man hours with night premium
#' pay}
#' \item{costCenter}{character string representing the cost center
#' wherein the man hours is charged}
#' \item{equipment}{character string of the equipment type should the
#' required personnel is an operator}
#' }
#' \item list of \code{\link{Employee-class}} objects representing the
#' theoretical employees with un-assigned man hours
#' \item list of \code{\link{Employee-class}} objects representing the
#' real employees with un-assigned man hours
#' \item list of \code{\link{Employee-class}} objects representing the
#' theoretical employees with assigned man hours
#' \item list of \code{\link{Employee-class}} objects representing the
#' real employees with assigned man hours
#' \item \code{\link{data.frame}} containing un-assigned man hours of the
#' theoretical employees
#'
#' This is composed of the following columns:
#' \describe{
#' \item{month}{integer value representing the month}
#' \item{ID}{character string representing the employee requirement}
#' \item{mhType}{man hour type}
#' \item{mh}{integer value representing the unassigned man hours}
#' }
#' \item \code{\link{data.frame}} containing un-assigned man hours of the
#' real employees
#'
#' This is composed of the following columns:
#' \describe{
#' \item{month}{integer value representing the month}
#' \item{ID}{character string representing the employee requirement}
#' \item{mhType}{man hour type}
#' \item{mh}{integer value representing the unassigned man hours}
#' }
#' \item \code{data.frame} representing the man hours database of the
#' employees with discarded OT hours
#'
#' This is composed of the following columns:
#' \describe{
#' \item{ID}{character string representing the unique identifier of the
#' real employee}
#' \item{reqID}{character string representing the unique identifier of the
#' real employee}
#' \item{mh}{integer value representing the man hours assigned}
#' \item{mhType}{character string representing the man hours type
#' assigned (see \code{\link{assignEmp}})}
#' \item{month}{integer value representing the month}
#' \item{np}{integer value representing the man hours with night premium
#' pay}
#' \item{costCenter}{character string representing the cost center
#' wherein the man hours is charged}
#' }
#' }
#' @export getmhDB
#' @importFrom data.table rbindlist
#' @importFrom stringr str_detect
#' @importFrom tidyr gather
getmhDB <- function(empReq,
empPool,
sched,
year = NA,
hol = NA,
forecast = FALSE) {
# Define global variables
ID <-
mh <-
mhReq <- NULL
if (is.na(year)) {
year <- as.integer(format(Sys.Date() + 365, "%Y"))
message(sprintf("Using %d as year.", year))
}
if (any(is.na(hol[1]))) {
hol <- mansched::holidays
message("Using built-in holidays list.")
}
tempData <- initEmpPool(empPool = empPool,
hol = hol,
year = year,
forecast = forecast)
listR <- tempData[[1]]
listR.a <- listR
empPool <- tempData[[2]]
tempData <- initEmpReq(empReq = empReq, sched = sched, hol = hol, year = year)
listT <- tempData[[1]]
listT.a <- listT
empReq <- tempData[[2]]
# Assign only Employee-class objects that are present both in the pool and
# the requirement
classPool <- unique(empPool$personnelClass)
classReq <- unique(empReq$personnelClass)
personnelClass <- intersect(classPool, classReq)
indexPool <- which(empPool$personnelClass %in% personnelClass)
indexReq <- which(empReq$personnelClass %in% personnelClass)
# Separate Employee-class objects that cannot be assigned
u.listR <- listR[-indexPool]
u.listT <- listT[-indexReq]
empPool <- empPool[indexPool,]
empReq <- empReq[indexReq,]
listR <- listR[indexPool]
listT <- listT[indexReq]
personnelSet <- lapply(personnelClass, FUN = function(x) {
iP <- which(empPool$personnelClass == x)
iR <- which(empReq$personnelClass == x)
return(list(listT[iR], listR[iP]))
})
assignedData <- lapply(X = personnelSet, FUN = function(x) {
message(paste0("Assigning ", class(x[[1]][[1]]), "."))
assignPrio(listT = x[[1]], listR = x[[2]])
})
mhDB <- lapply(assignedData, FUN = function(x) {x[[1]]})
mhReq <- lapply(assignedData, FUN = function(x) {x[[4]]})
mhPool <- lapply(assignedData, FUN = function(x) {x[[5]]})
discarded <- lapply(assignedData, FUN = function(x) {x[[6]]})
mhDB <- as.data.frame(data.table::rbindlist(mhDB , use.names = TRUE))
mhReq <- as.data.frame(data.table::rbindlist(mhReq , use.names = TRUE))
mhPool <- as.data.frame(data.table::rbindlist(mhPool, use.names = TRUE))
discarded <- as.data.frame(data.table::rbindlist(discarded, use.names = TRUE))
if (nrow(mhDB) < 1)
mhDB <- NULL
if (nrow(mhReq) < 1)
mhReq <- NULL
if (nrow(mhPool) < 1)
mhPool <- NULL
listR <- unlist(lapply(assignedData, FUN = function(x) {x[[3]]}))
listT <- unlist(sapply(assignedData, FUN = function(x) {x[[2]]}))
if (length(u.listR) > 0) {
listTN <- u.listR
discarded <- lapply(listTN, FUN = normEmp) %>%
data.table::rbindlist(discarded)
u.mhPool <- lapply(listTN, FUN = function(x) {
mh <- as.data.frame(getHours(x))
mh$month <- 1:12
mh$ID <- x@ID
return(mh)
}) %>%
data.table::rbindlist() %>%
tidyr::gather(key = "mhType", value = mh, -month, -ID)
mhPool <- data.table::rbindlist(list(mhPool, u.mhPool), use.names = TRUE)
mhPool <- mhPool[mhPool$mh > 0,]
mhPool <- as.data.frame(mhPool)
if (nrow(u.mhPool) > 0) {
for (i in listTN) {
if (sum(getHours(i)) > 0) {
tempData <- assignEmp(empT = i, empR = i, selfAssign = FALSE)
tempData$np <- 0L
mhDB <- dfAppend(mhDB, tempData)
}
}
} else {
mhPool <- NULL
}
}
if (length(u.listT) > 0) {
u.mhReq <- lapply(u.listT, FUN = function(x) {
mh <- as.data.frame(getHours(x))
mh$month <- 1:12
mh$ID <- x@ID
return(mh)
})
u.mhReq <- data.table::rbindlist(u.mhReq, use.names = TRUE)
u.mhReq <- u.mhReq %>%
tidyr::gather(key = "mhType", value = mh, -month, -ID)
mhReq <- data.table::rbindlist(list(mhReq, u.mhReq), use.names = TRUE)
mhReq <- mhReq[mhReq$mh > 0, ]
mhReq <- as.data.frame(mhReq)
}
rowsWithSplitDCC <- stringr::str_detect(mhDB$costCenter, "0CCSPLIT0")
if (any(rowsWithSplitDCC)) {
mhDBClean <- mhDB[!rowsWithSplitDCC,]
mhDBForSplitting <- mhDB[rowsWithSplitDCC,]
mhDBSplit <- lapply(1:nrow(mhDBForSplitting), function(x) {
costCenters <- strsplit(mhDBForSplitting$costCenter[x], "0CCSPLIT0")[[1]]
mhSplit <- rep(as.integer(mhDBForSplitting$mh[x] / length(costCenters)),
times = length(costCenters))
while (sum(mhSplit) != mhDBForSplitting$mh[x]) {
increment <- 1L
mhDiff <- mhDBForSplitting$mh[x] - sum(mhSplit)
if (mhDiff < 0L)
increment <- -1L
if (mhDiff == 0L)
break
idx <- sample.int(length(mhSplit), abs(mhDiff))
mhSplit[idx] <- mhSplit[idx] + increment
}
data.frame(ID = mhDBForSplitting$ID[x],
reqID = mhDBForSplitting$reqID[x],
mh = mhSplit,
mhType = mhDBForSplitting$mhType[x],
month = mhDBForSplitting$month[x],
np = mhSplit * mhDBForSplitting$np[x] / sum(mhSplit),
costCenter = costCenters,
equipment = mhDBForSplitting$equipment[x])
}) %>%
data.table::rbindlist()
mhDB <- data.table::rbindlist(list(mhDBClean, mhDBSplit))
}
return(list(mhDB, listT.a, listR.a, listT, listR, mhReq, mhPool, discarded))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.