R/03_suita_woECG.R

In Jcvrisk: Risk Calculator for Cardiovascular Disease in Japan

# Suita score calculation without ECG for data frame
suita<- function(data) {
  required_cols <- c("age", "sex", "sbp", "dbp", "t2dm", "tc", "hdl", "ldl", "urineprotein", "smoking")

  # Check for required columns
  if (!all(required_cols %in% names(data))) {
    stop("Data frame must contain the following columns: ", paste(required_cols, collapse = ", "))
  }

  # Check for NA values
  if (any(is.na(data[required_cols]))) {
    warning("Data frame contains NA values in required columns.")
  }

  # Check for ages over 80
  if (any(data$age >= 80)) {
    warning("Some individuals are aged 80 or older.  Risk prediction may not correct")
  }

  # Check for ages under 30
  if (any(data$age < 30)) {
    warning("Some individuals are aged 30 or younger. Risk prediction may not correct")
  }
  # Convert columns to numeric
  data[required_cols] <- lapply(data[required_cols], as.numeric)

  nonhdl <- data$tc - data$hdl

  # Calculate scores
  data$sex_score <- ifelse(data$sex == 1, 4, 0)
  data$bp_score <- ifelse(data$sbp >= 160 | data$dbp >= 100, 6,
                        ifelse((data$sbp >= 140 & data$sbp < 160) | (data$dbp >= 90 & data$dbp < 100), 3,
                               ifelse((data$sbp >= 120 & data$sbp < 139) | (data$dbp >= 80 & data$dbp < 89), 0, -4)))
  data$hdl_score <- ifelse(data$hdl < 40, 0,
                         ifelse(data$hdl >= 40 & data$hdl < 60, -2, -4))
  data$cho_score <- ifelse((nonhdl < 170 & data$ldl < 140), 0, 2)
  data$urineprotein_score <- ifelse(data$urineprotein == 1, 2, 0)
  data$t2dm_score <- ifelse(data$t2dm == 1, 7, 0)
  data$smoking_score <- ifelse(data$smoking == 1, 4, 0)

  data$age_rank <- ifelse(data$age >= 30 & data$age < 40, 0,
                        ifelse(data$age >= 40 & data$age < 50, 8,
                               ifelse(data$age >= 50 & data$age < 60, 14,
                                      ifelse(data$age >= 60 & data$age < 65, 18,
                                             ifelse(data$age >= 65 & data$age < 70, 22,
                                                    ifelse(data$age >= 70 & data$age < 75, 26,
                                                           ifelse(data$age >= 75 & data$age < 80, 29, 29)))))))

  # Total score
  data$totalscore <- data$sex_score + data$bp_score + data$hdl_score + data$cho_score +
    data$urineprotein_score + data$t2dm_score + data$smoking_score + data$age_rank

  # Calculate 10-year risk
  data$ten_year_risk <- ifelse(data$totalscore <= 0, 1,
                             ifelse(data$totalscore >= 1 & data$totalscore <= 20, 2,
                                    ifelse(data$totalscore >= 21 & data$totalscore <= 25, 6,
                                           ifelse(data$totalscore >= 26 & data$totalscore <= 30, 9,
                                                  ifelse(data$totalscore >= 31 & data$totalscore <= 35, 14,
                                                         ifelse(data$totalscore >= 36, 25, NA))))))

  return(data$ten_year_risk)
}