R/fnAssort.r

In TapeS: Tree Taper Curves and Sorting Based on 'TapeR'

#' optimise fixed length assortment with 2 or more possible assortment length
#'
#' @param actl actual remaining length of stem for assortment
#' @param fixN maximum number of fixed length assortments
#' @param fixM vector of multiple fixed assortment length's
#' @param fixA fixed length assortment add-on
#'
#' @returns a vector with optimal fixed assortment length
#' @importFrom utils combn
#' @export
#'
#' @examples
#' actl <- 15
#' fixN <- 3
#' fixM <- c(5, 3)
#' fixA <- 0.1
#' fnMultipleFixL(actl, fixN, fixM, fixA)
#'

fnMultipleFixL <- function(actl, fixN, fixM, fixA){

  m <- min(actl %/% min(fixM), fixN) # maximum number of pieces
  if(m <= 0){
    lfx=numeric(0)
  } else {
    cmbs <- unique(as.data.frame(t(combn(x = rep(c(fixM, 0), each=m), m=m))))
    cmbs$s <- rowSums(cmbs) + (m-1)*fixA # add-on *not* for last piece (actl refers to without add-on)
    cmbs$d <- cmbs$s - actl
    cmbs <- cmbs[cmbs$d < 0,]
    if(nrow(cmbs) <= 0){
      lfx <- numeric(0) # assortment length
    } else {
      idx <- which.max(cmbs$d) # takes the first occurence only
      lfx <- cmbs[idx, paste0("V", 1:m)]
      lfx <- lfx[lfx > 0] # assortment length
    }
  }
  return(lfx)
}