R/inventory.r

In milumtextiles/itemsim: Simulate Linen Rental

#' Inject Inventory At Plant
#'
#' Inject new inventory at the plant with the given tagging ratio.
#' @param state current simulation state to modify
#' @param item item number to add inventory for
#' @param amount quantity of inventory to add
#' @param at_time time stamp to add the new inventory at
#' @param inject_percent tag the new inventory at this percentage
#' @param scan_prob probability of the tags being scanned
#' @importFrom dplyr data_frame
#' @export
add_inventory <- function(state, item, amount, at_time, inject_percent,
                         scan_prob=1){
    ### Add new inventory for an item ###

    # Injection quantities, partial tags are rounded up
    tagged_qty <- ceiling(amount * inject_percent)
    untagged_qty <- floor(amount * (1 - inject_percent))
    tags <- c(rep(TRUE, tagged_qty), rep(FALSE, untagged_qty))

    new_inventory <- data_frame(
        piece = seq(amount) + max_id(state, "population", "piece"),
        item = rep(item, amount),
        tagged = tags[rank(stats::runif(amount))],
        functional = rep(TRUE, amount)
    )

    starting_location <- data_frame(
        piece = new_inventory[["piece"]],
        datetime = at_time,
        location = rep(location_id(state, "Plant"), amount),
        clean = rep(TRUE, amount),
        # Scanned is TRUE only if the item is tagged
        # and it passes the scanning probability
        scanned = boolean_prob(amount, scan_prob) & new_inventory$tagged
    )

    # Update the simulation state
    state[["population"]] <- dplyr::bind_rows(
        state[["population"]],
        new_inventory
    )
    state[["movement"]] <- dplyr::bind_rows(
        state[["movement"]],
        starting_location
    )

    return(state)
}


#' Get Current inventory at a location
#'
#' Get the current inventory at a location
#' @param state current simulation state to modify
#' @param where location_id to get inventory for
#' @importFrom magrittr "%>%"
#' @importFrom dplyr filter_ group_by_ top_n ungroup
#' @export
current_inventory <- function(state, where){
    state[["movement"]] %>%
        filter_(~location == where) %>%
        group_by_(~piece) %>%
        top_n(-1, "datetime") %>%  #-n for`top_n` gets the bottom
        ungroup
}


#' Move Inventory from one place to another
#'
#' Move a random sample of pices from specified items from one location
#' to another.
#' @param state current simulation state to modify
#' @param order data_frame of \code{item}'s and \code{order_qty}'s
#' @param from location to move from
#' @param to location to move to
#' @param at_time time-stamp to associate with this move
#' @param limit_status limit to inventory in status
#' @param change_status specify state for inventory to be in on arrival
#' @param scan_prob probability of the tags being scanned
#' @importFrom dplyr data_frame inner_join mutate filter_ filter
#' @importFrom dplyr group_by_ top_n ungroup select summarize
#' @export
move_inventory <- function(state, order, from, to, at_time,
                           limit_status = NA, change_status = NA, scan_prob=1){
    assertive::assert_is_logical(change_status)
    assertive::assert_is_numeric(to)
    assertive::assert_is_numeric(from)
    assertive::assert_is_numeric(scan_prob)
    assertive::assert_is_scalar(to)
    assertive::assert_is_scalar(from)
    assertive::assert_is_scalar(at_time)
    assertive::assert_is_scalar(limit_status)
    assertive::assert_is_scalar(change_status)
    assertive::assert_is_scalar(scan_prob)
    assertive::assert_has_colnames(order)
    assertive::assert_all_are_true(names(order) == c("item", "order_qty"))

    inventory <- current_inventory(state, from) %>%
        inner_join(state[["population"]], by = "piece") %>%
        filter(item %in% items)

    if (!is.na(limit_status)){
        inventory <- inventory %>% filter_(~clean == limit_status)
    }

    # Check that we can fulfill the order
    for (i in seq_along(items)) {
        if (!(items[i] %in% inventory$item)){
            stop(paste0("No inventory of item ", items[i], "available"))
        } else {
            inventory_qty <- inventory %>% filter_(~item == items[i]) %>% nrow
            if (amounts[i] > inventory_qty){
                stop("Insufficiency quantity of item ", items[i], "to move ",
                     amounts[i], " available: ", inventory_qty)
            }
        }
    }

    inventory %>%
        group_by(item) %>%
        mutate(
            rand_order = rank(stats::runif(length(item)))
        ) %>%
        inner_join(order, by = "item") %>%
        ungroup %>%
        filter(rand_order <= order_qty) %>%
        select(-item, -rand_order, -order_qty) %>%
        mutate(
            location = to,
            datetime = at_time,
            clean = ifelse(is.na(change_status), clean, change_status),
            scanned = tagged & boolean_prob(n(), scan_prob)
        ) %>%
        select(-tagged) -> new_moves

    state[["movement"]] <- dplyr::bind_rows(state[["movement"]], new_moves)

    return(state)
}

#' Wash Inventory at Plant
#'
#' Wash all inventory at the plant, transitioning any pieces with Soil to Clean.
#' @param at_time time-stamp to associate with this move
#' @param change_status specify state for inventory to be in on arrival
#' @export
wash_inventory_at_plant <- function(state, at_time){
    current_inventory(PLANT, movement) %>%
        filter(!clean) %>%
        mutate(
            clean = TRUE,
            datetime = at_time,
            scanned = FALSE
        ) -> washed_pieces

    state[["movement"]] <- dplyr::bind_rows(state[["movement"]], washed_pieces)

    return(state)
}