R/iief.R

In nrkoehler/qscorer: Procedures for Scoring Health-related Questionnaires

#' @title {Internaltional Index of Erectile Function, short form (IIEF-5)}
#' @description {\emph{An abridged five-item version of the 15-item
#' International Index of Erectile Function (IIEF) was developed (IIEF-5)
#' to diagnose the presence and severity of erectile dysfunction (ED).} (Rosen et al. 2000)}
#' @details
#' \itemize{
#' \item \code{Number of items:} {5}
#' \item \code{Item range:} {1 to 5}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {1 to 25}
#' \item \code{Cut-off-values:} {1-7 = 'Severe ED'; 8-11 = 'Moderate ED'; 12-16 = 'Mild-moderate ED';
#' 17-21 = 'Mild ED'; 22-25 = 'No ED'}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:} {No missing values allowed for score calculation}
#' }
#' @references
#' Link to questionnaire (\url{http://www.croesoffice.org/Portals/0/Short_IIEF.pdf})
#'
#' Rosen RC, Cappelleri JC (2000) (\url{https://doi.org/10.1038/sj.ijir.3900472})
#' @return The function returns 3 variables:
#' \itemize{
#'  \item \code{nvalid.iief5:} Number of valid values (MAX=5)
#'  \item \code{score.iief5:} IIEF-5 Score
#'  \item \code{cutoff.iief5:} IIEF-5 Cut-Off
##' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' items.iief5 <- paste0("IIEF_", seq(1, 5, 1))
#' scoring_iief5(mydata, items = items.iief5)
#' }
#' @param data a \code{\link{data.frame}} containing the IIEF-5 items
#' orderd from 1 to 5
#' @param items A character vector with the IIEF-5 item names ordered from 1 to 5,
#' or a numeric vector indicating the column numbers of the IIEF-5 items in \code{data}.
#' @param keep Logical, whether to keep the single items and  whether to return variables containing
#' the number of non-missing items on each scale for each respondent. The default is TRUE.
#' @param nvalid A numeric value indicating the number of non-missing items required for score
#' calculations. The default is 5.
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @export
scoring_iief5 <- function(data, items = 1:5, keep = TRUE, nvalid = 5, digits = NULL) {
  library(dplyr, warn.conflicts = FALSE)
  if (min(data[, items], na.rm = T) < 1) {
    stop("Minimum possible value for IIEF-5 items is 1")
  } else if (max(data[, items], na.rm = T) > 5) {
    stop("Maximum possible value for IIEF-5 items is 5")
  }
  # check for number of specified items
  if (length(items) != 5) {
    stop("Number of items must be 5!")
  }
  input <- data %>%
    mutate(id.temp = as.character(row_number()))
  data <- input %>%
    mutate(
      nvalid.iief5 = rowSums(!is.na(select(., items))),
      mean.temp = rowSums(select(., items), na.rm = TRUE) / nvalid.iief5) %>%
    mutate_at(
      vars(items),
      list(~ifelse(is.na(.), mean.temp, .))
    ) %>%
    mutate(
      score.temp = rowSums(select(., items), na.rm = TRUE),
      score.iief5 = ifelse(nvalid.iief5 >= nvalid, score.temp, NA),
      cutoff.iief5 = case_when(
        score.iief5 >= 22 ~ "No ED",
        score.iief5 >= 17 ~ "Mild ED",
        score.iief5 >= 12 ~ "Mild-moderate ED",
        score.iief5 > 7 ~ "Moderate ED",
        score.iief5 <= 7 ~ "Severe ED",
        TRUE ~ as.character(NA)
      )
    ) %>%
    select(id.temp, nvalid.iief5, score.iief5, cutoff.iief5)
  data <- input %>% inner_join(data, by = 'id.temp') %>% select(-id.temp)
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -nvalid.iief5)
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(vars(score.iief5), list(~ round(., digits)))
  } else {
    data <- data
  }
 data
}
NULL