https://github.com/cran/cutpointr
Tip revision: 7e56c827a694247d212e9a0167a119f917e1f31b authored by Christian Thiele on 31 August 2018, 15:50:10 UTC
version 0.7.4
version 0.7.4
Tip revision: 7e56c82
prep.R
assume_direction_pos_class <- function(x, class, pos_class, neg_class, direction,
na.rm, uc) {
# Handle NAs
if (na.rm) {
na_indx <- is.na(x)
na_indc <- is.na(class)
complete_ind <- !(na_indx + na_indc)
x <- x[complete_ind]
class <- class[complete_ind]
}
if (is.null(direction) & !is.null(pos_class)) {
if (stats::median(x[class != pos_class]) < stats::median(x[class == pos_class])) {
message("Assuming the positive class has higher x values")
direction <- ">="
} else {
message("Assuming the positive class has lower x values")
direction <- "<="
}
}
if (is.null(direction) & is.null(pos_class)) direction <- ">="
if (!is.null(direction) & is.null(pos_class)) {
if (direction == ">" | direction == ">=") {
if (stats::median(x[class == uc[1]]) > stats::median(x[class == uc[2]])) {
message(paste("Assuming the positive class is", uc[1]))
message("Assuming the positive class has higher x values")
pos_class <- uc[1]
} else {
message(paste("Assuming the positive class is", uc[2]))
message("Assuming the positive class has higher x values")
pos_class <- uc[2]
}
} else {
if (stats::median(x[class == uc[1]]) < stats::median(x[class == uc[2]])) {
message(paste("Assuming the positive class is", uc[1]))
message("Assuming the positive class has lower x values")
pos_class <- uc[1]
} else {
message(paste("Assuming the positive class is", uc[2]))
message("Assuming the positive class has lower x values")
pos_class <- uc[2]
}
}
}
if (!any(pos_class == class)) stop("Positive class not found in data")
if (is.null(neg_class)) {
neg_class <- unique(class)
neg_class <- neg_class[neg_class != pos_class]
}
return(list(direction = direction, pos_class = pos_class, neg_class = neg_class))
}