From 7f758b97d4e2bcc4386323c8ee82db0f464c8061 Mon Sep 17 00:00:00 2001 From: Tim-Gunnar Hensel Date: Tue, 9 Feb 2021 10:33:44 +0100 Subject: [PATCH] - Output 'model_estimation' of `mcs_delay_()` now is named with 'delay_distribution' (to be in accordance with `mcs_mileage_()`. (#95) - Inserted `call. = FALSE` in MCS functions and `reliability_data`. (#197) --- R/delay_distributions.R | 44 +++++++++++++++++++++++++++--------- R/mcs_data.R | 48 ++++++++++++++++++++++++++-------------- R/mcs_delay.R | 10 +++++---- R/mcs_mileage.R | 2 +- R/mileage_distribution.R | 13 +++++++---- R/reliability_data.R | 8 +++---- 6 files changed, 86 insertions(+), 39 deletions(-) diff --git a/R/delay_distributions.R b/R/delay_distributions.R index b66f11a..37a0c11 100644 --- a/R/delay_distributions.R +++ b/R/delay_distributions.R @@ -216,12 +216,18 @@ dist_delay.default <- function(..., ## Compare length of date_1 and distribution: if (!(length(distribution) == length(date_1) || length(distribution) == 1L)) { - stop("'distribution' must be either length one or 'length(date_1)'") + stop( + "'distribution' must be either length one or 'length(date_1)'", + call. = FALSE + ) } ## Check for different length in date_1 and date_2: if (length(unique(lengths(c(date_1, date_2)))) != 1L) { - stop("All elements of 'date_1' and 'date_2' must have the same length!") + stop( + "All elements of 'date_1' and 'date_2' must have the same length!", + call. = FALSE + ) } # Do dist_delay_() with respect to the number of delays: @@ -431,16 +437,25 @@ dist_delay_register <- function(date_prod, # test for delays: all NA and smaller or equal to 0. # all NA: if (all(is.na(t_regist))) { - stop("All differences are NA. No parameters can be estimated!") + stop( + "All differences are NA. No parameters can be estimated!", + call. = FALSE + ) } # all smaller or equal to zero: if (all(t_regist <= 0, na.rm = TRUE)) { - stop("All differences are smaller or equal to 0. No parameters can be estimated!") + stop( + "All differences are smaller or equal to 0. No parameters can be estimated!", + call. = FALSE + ) } # any smaller or equal to zero: if (!all(t_regist <= 0, na.rm = TRUE) && any(t_regist <= 0, na.rm = TRUE)) { - warning("At least one of the time differences is smaller or equal to 0 and is", - " ignored for the estimation step!") + warning( + "At least one of the time differences is smaller or equal to 0 and is", + " ignored for the estimation step!", + call. = FALSE + ) t_regist <- t_regist[t_regist > 0] } @@ -525,16 +540,25 @@ dist_delay_report <- function(date_repair, # test for delays: all NA and smaller or equal to 0. # all NA: if (all(is.na(t_report))) { - stop("All differences are NA. No parameters can be estimated!") + stop( + "All differences are NA. No parameters can be estimated!", + call. = FALSE + ) } # all smaller or equal to zero: if (all(t_report <= 0, na.rm = TRUE)) { - stop("All differences are smaller or equal to 0. No parameters can be estimated!") + stop( + "All differences are smaller or equal to 0. No parameters can be estimated!", + call. = FALSE + ) } # any smaller or equal to zero: if (!all(t_report <= 0, na.rm = TRUE) && any(t_report <= 0, na.rm = TRUE)) { - warning("At least one of the time differences is smaller or equal to 0 and is", - " ignored for the estimation step!") + warning( + "At least one of the time differences is smaller or equal to 0 and is", + " ignored for the estimation step!", + call. = FALSE + ) t_report <- t_report[t_report > 0] } diff --git a/R/mcs_data.R b/R/mcs_data.R index 49b83f9..193068d 100644 --- a/R/mcs_data.R +++ b/R/mcs_data.R @@ -135,7 +135,7 @@ mcs_delay_data <- function(data = NULL, if (purrr::is_null(data)) { # Vector based approach ---------------------------------------------------- if (!is_characteristic(time)) { - stop("'time' must be numeric!") + stop("'time' must be numeric!", call. = FALSE) } if (purrr::is_null(id)) { @@ -153,15 +153,24 @@ mcs_delay_data <- function(data = NULL, function(e1, e2) { ### Check for different length in date_1 and date_2: if (length(e1) != length(e2)) { - stop("Elements of 'date_1' and 'date_2' differ in length!") + stop( + "Elements of 'date_1' and 'date_2' differ in length!", + call. = FALSE + ) } ### Check for class of date_1: if (!(class(e1) %in% c("Date", "character"))) { - stop("'date_1' must be of class 'Date' or 'character'!") + stop( + "'date_1' must be of class 'Date' or 'character'!", + call. = FALSE + ) } ### Check for class date_2: if (!(class(e2) %in% c("Date", "character"))) { - stop("'date_2' must be of class 'Date' or 'character'!") + stop( + "'date_2' must be of class 'Date' or 'character'!", + call. = FALSE + ) } } ) @@ -171,7 +180,10 @@ mcs_delay_data <- function(data = NULL, names_dates_list <- names(dates_list) if (any(trimws(names_dates_list) == "")) { - stop("Either all or no elements of 'date_1' and 'date_2' must have names!") + stop( + "Either all or no elements of 'date_1' and 'date_2' must have names!", + call. = FALSE + ) } if (purrr::is_null(names_dates_list)) { @@ -188,7 +200,7 @@ mcs_delay_data <- function(data = NULL, if (!purrr::is_null(status)) { if (!is_status(status)) { - stop("'status' must be numeric with elements 0 or 1!") + stop("'status' must be numeric with elements 0 or 1!", call. = FALSE) } tbl_list <- c(dates_list, list(time, status, id)) names(tbl_list) <- c(names_dates_list, "time", "status", "id") @@ -208,7 +220,7 @@ mcs_delay_data <- function(data = NULL, # Data based approach ------------------------------------------------------ ## Checks: if (!is_characteristic(dplyr::select(data, {{time}})[[1]])) { - stop("'time' must be numeric!") + stop("'time' must be numeric!", call. = FALSE) } purrr::walk( @@ -216,7 +228,8 @@ mcs_delay_data <- function(data = NULL, ~ if (!(class(.) %in% c("Date", "character"))) { stop( "Columns specified in 'date_1' and 'date_2' must be of class", - " 'Date' or 'character'!" + " 'Date' or 'character'!", + call. = FALSE ) } ) @@ -227,7 +240,10 @@ mcs_delay_data <- function(data = NULL, ## Check for same length in 'date_1' and 'date_2': if (length(characteristic_1) != length(characteristic_2)) { - stop("The same number of columns must be specified in 'date_1' and 'date_2'!") + stop( + "The same number of columns must be specified in 'date_1' and 'date_2'!", + call. = FALSE + ) } data <- tibble::as_tibble(data) @@ -257,7 +273,7 @@ mcs_delay_data <- function(data = NULL, if ("status" %in% names(tbl)) { if (!is_status(tbl$status)) { - stop("'status' must be numeric with elements 0 or 1!") + stop("'status' must be numeric with elements 0 or 1!", call. = FALSE) } } @@ -367,11 +383,11 @@ mcs_mileage_data <- function(data = NULL, if (purrr::is_null(data)) { # Vector based approach ---------------------------------------------------- if (!is_characteristic(mileage)) { - stop("'mileage' must be numeric!") + stop("'mileage' must be numeric!", call. = FALSE) } if (!is_characteristic(time)) { - stop("'time' must be numeric!") + stop("'time' must be numeric!", call. = FALSE) } if (purrr::is_null(id)) { @@ -380,7 +396,7 @@ mcs_mileage_data <- function(data = NULL, if (!purrr::is_null(status)) { if (!is_status(status)) { - stop("'status' must be numeric with elements 0 or 1!") + stop("'status' must be numeric with elements 0 or 1!", call. = FALSE) } tbl <- tibble::tibble( mileage = mileage, @@ -399,11 +415,11 @@ mcs_mileage_data <- function(data = NULL, } else { # Data based approach ------------------------------------------------------ if (!is_characteristic(dplyr::select(data, {{mileage}})[[1]])) { - stop("'mileage' must be numeric!") + stop("'mileage' must be numeric!", call. = FALSE) } if (!is_characteristic(dplyr::select(data, {{time}})[[1]])) { - stop("'time' must be numeric!") + stop("'time' must be numeric!", call. = FALSE) } data <- tibble::as_tibble(data) @@ -432,7 +448,7 @@ mcs_mileage_data <- function(data = NULL, if ("status" %in% names(tbl)) { if (!is_status(tbl$status)) { - stop("'status' must be numeric with elements 0 or 1!") + stop("'status' must be numeric with elements 0 or 1!", call. = FALSE) } tbl <- dplyr::relocate(tbl, "mileage", "time", "status", "id") diff --git a/R/mcs_delay.R b/R/mcs_delay.R index 0c460a4..4458635 100644 --- a/R/mcs_delay.R +++ b/R/mcs_delay.R @@ -340,7 +340,9 @@ mcs_delay_ <- function(data = NULL, mcs_output <- list( data = data_tbl, sim_data = tibble::as_tibble(sim_list), - model_estimation = par_list + model_estimation = list( + delay_distribution = par_list + ) ) class(mcs_output) <- c("wt_mcs_delay", class(mcs_output)) @@ -489,7 +491,7 @@ mcs_delay_register <- function(date_prod, x_sim <- stats::rlnorm(n = n_rand, meanlog = params[[1]], sdlog = params[[2]]) } else { - stop("No valid distribution!") + stop("No valid distribution!", call. = FALSE) } time[is.na(date_register)] <- time[is.na(date_register)] - x_sim @@ -605,7 +607,7 @@ mcs_delay_report <- function(date_repair, x_sim <- stats::rlnorm(n = n_rand, meanlog = params[[1]], sdlog = params[[2]]) } else { - stop("No valid distribution!") + stop("No valid distribution!", call. = FALSE) } time[status == 0] <- time[status == 0] - x_sim @@ -761,7 +763,7 @@ mcs_delays <- function(date_prod, x_sim_report <- stats::rlnorm(n = n_rand_report, meanlog = params_report[[1]], sdlog = params_report[[2]]) } else { - stop("No valid distribution!") + stop("No valid distribution!", call. = FALSE) } time[is.na(date_register)] <- time[is.na(date_register)] - x_sim_regist diff --git a/R/mcs_mileage.R b/R/mcs_mileage.R index 419c798..a8ba625 100644 --- a/R/mcs_mileage.R +++ b/R/mcs_mileage.R @@ -158,7 +158,7 @@ mcs_mileage.default <- function(x, ## Check for different length in time and x: if (length(x) != length(time)) { - stop("Elements of 'x' and 'time' differ in length!") + stop("Elements of 'x' and 'time' differ in length!", call. = FALSE) } mcs_mileage_( diff --git a/R/mileage_distribution.R b/R/mileage_distribution.R index a27fb5d..19c2844 100644 --- a/R/mileage_distribution.R +++ b/R/mileage_distribution.R @@ -134,7 +134,8 @@ dist_mileage.default <- function(x, ## Check for negative mileage, stop if TRUE: if (any(x < 0, na.rm = TRUE)) { stop( - "Elements with negative distances are not meaningful and must be removed!" + "Elements with negative distances are not meaningful and must be removed!", + call. = FALSE ) } @@ -164,6 +165,7 @@ dist_mileage_ <- function(x, warning( "At least one computed annual distance is infinite and is ignored ", "for the estimation step!", + call. = FALSE ) miles_annual <- miles_annual[!is.infinite(miles_annual)] @@ -172,7 +174,8 @@ dist_mileage_ <- function(x, ## all NA: if (all(is.na(miles_annual))) { stop( - "All computed annual distances are 'NA'. No parameters can be estimated!" + "All computed annual distances are 'NA'. No parameters can be estimated!", + call. = FALSE ) } @@ -183,13 +186,15 @@ dist_mileage_ <- function(x, ### all: stop( "All computed annual distances are smaller or equal to 0. ", - "No parameters can be estimated!" + "No parameters can be estimated!", + call. = FALSE ) } else { ### any: warning( "At least one computed annual distance is smaller or equal to 0 ", - "and is ignored for the estimation step!" + "and is ignored for the estimation step!", + call. = FALSE ) miles_annual <- miles_annual[miles_annual > 0] diff --git a/R/reliability_data.R b/R/reliability_data.R index 893d539..90436aa 100644 --- a/R/reliability_data.R +++ b/R/reliability_data.R @@ -76,11 +76,11 @@ reliability_data <- function(data = NULL, if (purrr::is_null(data)) { # Vector based approach ---------------------------------------------------- if (!is_characteristic(x)) { - stop("'x' must be numeric!") + stop("'x' must be numeric!", call. = FALSE) } if (!is_status(status)) { - stop("'status' must be numeric with elements 0 or 1!") + stop("'status' must be numeric with elements 0 or 1!", call. = FALSE) } if (purrr::is_null(id)) { @@ -93,11 +93,11 @@ reliability_data <- function(data = NULL, } else { # Data based approach ----------------------------------------------------- if (!is_characteristic(dplyr::select(data, x = {{x}})[[1]])) { - stop("'x' must be numeric!") + stop("'x' must be numeric!", call. = FALSE) } if (!is_status(dplyr::select(data, status = {{status}})[[1]])) { - stop("'status' must be numeric with elements 0 or 1!") + stop("'status' must be numeric with elements 0 or 1!", call. = FALSE) } x_def <- dplyr::enexpr(x)