Running examples in 'cutpointr-Ex.R' failed
The error most likely occurred in:

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: add_metric
> ### Title: Add metrics to a cutpointr or roc_cutpointr object
> ### Aliases: add_metric
> 
> ### ** Examples
> 
> library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

> library(cutpointr)
> cutpointr(suicide, dsi, suicide, gender) %>%
+   add_metric(list(ppv, npv)) %>%
+   select(optimal_cutpoint, subgroup, AUC, sum_sens_spec, ppv, npv)
Assuming the positive class is yes
Assuming the positive class has higher x values
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
cutpointr
 --- call from context --- 
sanitize_metric(m, m_name = metric_name, n = nrow(roccurve))
 --- call from argument --- 
if (dim(m)[2] == 1 & class(m) == "matrix") {
    res <- m
    if (is.null(colnames(res))) 
        colnames(res) <- m_name
} else {
    stop(paste("The metric function should return a numeric vector", 
        "or a one-column matrix or data.frame."))
}
 --- R stacktrace ---
where 1: sanitize_metric(m, m_name = metric_name, n = nrow(roccurve))
where 2: optimize_metric(data = data, x = x, class = class, metric_func = metric_func, 
    pos_class = pos_class, neg_class = neg_class, minmax = "max", 
    direction = direction, metric_name = metric_name, tol_metric = tol_metric, 
    use_midpoints = use_midpoints, ...)
where 3: method(data = d, x = predictor, class = outcome, metric_func = metric, 
    direction = direction, pos_class = pos_class, neg_class = neg_class, 
    tol_metric = tol_metric, use_midpoints = use_midpoints, ...)
where 4: .f(.l[[1L]][[i]], .l[[2L]][[i]], ...)
where 5: purrr::pmap(list(dat$subgroup, dat$data), function(g, d) {
    if (nrow(d) <= 1) 
        stop(paste("Subgroup", g, "has <= 1 observations"))
    optcut <- tibble::tibble(subgroup = g)
    method_result <- method(data = d, x = predictor, class = outcome, 
        metric_func = metric, direction = direction, pos_class = pos_class, 
        neg_class = neg_class, tol_metric = tol_metric, use_midpoints = use_midpoints, 
        ...)
    method_result <- check_method_cols(method_result)
    optcut <- dplyr::bind_cols(optcut, method_result)
    if (length(optcut[["optimal_cutpoint"]][[1]]) > 1) {
        message("Multiple optimal cutpoints found, applying break_ties.")
    }
    optcut <- apply_break_ties(optcut, break_ties)
    if (!(has_column(optcut, "roc_curve"))) {
        roc_curve <- roc(data = d, x = !!predictor, class = !!outcome, 
            pos_class = pos_class, neg_class = neg_class, direction = direction)
        roc_curve <- tidyr::nest(.data = roc_curve, roc_curve = dplyr::everything()) %>% 
            tibble::as_tibble()
        optcut <- dplyr::bind_cols(roc_curve, tibble::as_tibble(optcut))
    }
    else {
        check_roc_curve(optcut)
    }
    if (ncol(optcut) <= 3) {
        opt_ind <- get_opt_ind(optcut$roc_curve[[1]], oc = unlist(optcut$optimal_cutpoint), 
            direction = direction)
        m <- metric(tp = optcut$roc_curve[[1]]$tp[opt_ind], fp = optcut$roc_curve[[1]]$fp[opt_ind], 
            tn = optcut$roc_curve[[1]]$tn[opt_ind], fn = optcut$roc_curve[[1]]$fn[opt_ind], 
            ...)
        m <- check_metric_name(m)
        colnames(m) <- make.names(colnames(m))
        optcut <- dplyr::bind_cols(optcut, tibble::as_tibble(m))
    }
    optcut <- check_colnames(optcut)
    opt_ind <- get_opt_ind(optcut$roc_curve[[1]], oc = unlist(optcut$optimal_cutpoint), 
        direction = direction)
    m <- metric(tp = optcut$roc_curve[[1]]$tp[opt_ind], fp = optcut$roc_curve[[1]]$fp[opt_ind], 
        tn = optcut$roc_curve[[1]]$tn[opt_ind], fn = optcut$roc_curve[[1]]$fn[opt_ind], 
        ...)
    optcut <- add_list(optcut, as.numeric(m), optcut$metric_name)
    sesp <- sesp_from_oc(optcut$roc_curve[[1]], oc = optcut$optimal_cutpoint, 
        direction = direction)
    optcut <- add_list(optcut, sesp[, "sensitivity"], "sensitivity")
    optcut <- add_list(optcut, sesp[, "specificity"], "specificity")
    acc <- accuracy_from_oc(optcut$roc_curve[[1]], oc = optcut$optimal_cutpoint[[1]], 
        direction = direction)[, "accuracy"]
    optcut <- add_list(optcut, acc, "acc")
    return(optcut)
})
where 6: cutpointr_internal(x, class, subgroup, method, metric, pos_class, 
    neg_class, direction, boot_runs, boot_stratify, use_midpoints, 
    break_ties, na.rm, allowParallel, predictor, outcome, mod_name, 
    subgroup_var, tol_metric, ...)
where 7: cutpointr.default(suicide, dsi, suicide, gender)
where 8: cutpointr(suicide, dsi, suicide, gender)
where 9: eval(lhs, parent, parent)
where 10: eval(lhs, parent, parent)
where 11: cutpointr(suicide, dsi, suicide, gender) %>% add_metric(list(ppv, 
    npv)) %>% select(optimal_cutpoint, subgroup, AUC, sum_sens_spec, 
    ppv, npv)

 --- value of length: 2 type: logical ---
[1]  TRUE FALSE
 --- function from context --- 
function (m, m_name, n, silent = TRUE) 
{
    if ("data.frame" %in% class(m)) {
        m <- as.matrix(m)
    }
    if (!is.null(dim(m))) {
        if (dim(m)[2] == 1 & class(m) == "matrix") {
            res <- m
            if (is.null(colnames(res))) 
                colnames(res) <- m_name
        }
        else {
            stop(paste("The metric function should return a numeric vector", 
                "or a one-column matrix or data.frame."))
        }
    }
    else if (is.numeric(m)) {
        res <- matrix(m, ncol = 1, dimnames = list(NULL, m_name))
    }
    else {
        stop(paste("Can't process metric of type", class(m)))
    }
    finite_res <- is.finite(res)
    if (any(!finite_res)) {
        if (!silent) 
            message("Converting non-finite metric values to NA")
        res[!finite_res] <- NA
    }
    if (nrow(res) != n) {
        stop("Number of returned metric values not equal to n")
    }
    colnames(res) <- make.names(colnames(res))
    return(res)
}
<bytecode: 0xee0698>
<environment: namespace:cutpointr>
 --- function search by body ---
Function sanitize_metric in namespace cutpointr has this body.
 ----------- END OF FAILURE REPORT -------------- 
Error in if (dim(m)[2] == 1 & class(m) == "matrix") { : 
  the condition has length > 1
Calls: %>% ... <Anonymous> -> .f -> method -> optimize_metric -> sanitize_metric
Execution halted