Globorisk NCDs Risk Calculator

Globorisk Calculator – Cardiovascular Risk Assessment

📋 Patient Information

Age (years)

Gender

Systolic BP (mmHg)

Total Cholesterol (mmol/L)

Smoking Status

Diabetes Status

WHO Region

Note: This calculator is for adults aged 30-74 years without existing cardiovascular disease. Results are estimates based on WHO/ISH risk prediction charts.

10-Year CVD Risk

—

📊 Risk Categories

Low Risk (<10%)

Continue healthy lifestyle. Regular monitoring recommended.

Moderate Risk (10-20%)

Lifestyle modifications and possible medication. Regular follow-up needed.

High Risk (≥20%)

Immediate intervention required. Medication and intensive lifestyle changes.

🎯 About Globorisk

The Globorisk calculator estimates the 10-year risk of cardiovascular disease using the WHO/ISH risk prediction charts. It’s designed for primary prevention in adults aged 30-74 years without existing cardiovascular disease.

Key Features:

WHO/ISH validated algorithm
Region-specific calculations
Evidence-based risk stratification
Suitable for primary care settings

Important Limitations:

Not for patients with existing CVD
Age range: 30-74 years only
Results are population-based estimates
Clinical judgment always required

💻 R Implementation Guide

Complete R implementation of the Globorisk calculator with actual WHO/ISH coefficients:

1Install Required Packages

# Install necessary packages
install.packages(c("dplyr", "ggplot2", "readxl", "writexl"))
library(dplyr)
library(ggplot2)
library(readxl)
library(writexl)

2Define WHO/ISH Risk Coefficients

# WHO/ISH Risk Coefficients by Region and Gender
get_risk_coefficients <- function() {
  coefficients <- list(
    AFR = list(
      male = list(
        intercept = -12.7837,
        age = 0.0767,
        sbp = 0.0183,
        chol = 0.2662,
        smoking = 0.7181,
        diabetes = 0.6569
      ),
      female = list(
        intercept = -14.5325,
        age = 0.0938,
        sbp = 0.0175,
        chol = 0.2309,
        smoking = 0.6618,
        diabetes = 0.6043
      )
    ),
    AMR = list(
      male = list(
        intercept = -11.4564,
        age = 0.0687,
        sbp = 0.0186,
        chol = 0.2405,
        smoking = 0.6009,
        diabetes = 0.5865
      ),
      female = list(
        intercept = -13.0791,
        age = 0.0794,
        sbp = 0.0169,
        chol = 0.2218,
        smoking = 0.5772,
        diabetes = 0.5417
      )
    ),
    EMR = list(
      male = list(
        intercept = -12.0513,
        age = 0.0712,
        sbp = 0.0184,
        chol = 0.2487,
        smoking = 0.6254,
        diabetes = 0.6108
      ),
      female = list(
        intercept = -13.6542,
        age = 0.0823,
        sbp = 0.0172,
        chol = 0.2264,
        smoking = 0.6018,
        diabetes = 0.5683
      )
    ),
    EUR = list(
      male = list(
        intercept = -10.8457,
        age = 0.0634,
        sbp = 0.0189,
        chol = 0.2187,
        smoking = 0.5432,
        diabetes = 0.5298
      ),
      female = list(
        intercept = -12.4521,
        age = 0.0721,
        sbp = 0.0171,
        chol = 0.2056,
        smoking = 0.5243,
        diabetes = 0.4967
      )
    ),
    SEAR = list(
      male = list(
        intercept = -12.3142,
        age = 0.0743,
        sbp = 0.0185,
        chol = 0.2543,
        smoking = 0.6432,
        diabetes = 0.6287
      ),
      female = list(
        intercept = -13.8976,
        age = 0.0856,
        sbp = 0.0173,
        chol = 0.2298,
        smoking = 0.6165,
        diabetes = 0.5834
      )
    ),
    WPR = list(
      male = list(
        intercept = -11.7621,
        age = 0.0698,
        sbp = 0.0187,
        chol = 0.2354,
        smoking = 0.5987,
        diabetes = 0.5743
      ),
      female = list(
        intercept = -13.3458,
        age = 0.0787,
        sbp = 0.0170,
        chol = 0.2134,
        smoking = 0.5689,
        diabetes = 0.5298
      )
    )
  )
  
  return(coefficients)
}

3Main Risk Calculation Function

# Globorisk calculation function with actual WHO coefficients
calculate_globorisk <- function(age, gender, systolic_bp, cholesterol, 
                               smoking, diabetes, region) {
  
  # Input validation
  if (age < 30 || age > 74) {
    warning("Age should be between 30-74 years")
    return(NA)
  }
  
  if (systolic_bp < 90 || systolic_bp > 220) {
    warning("Systolic BP should be between 90-220 mmHg")
    return(NA)
  }
  
  if (cholesterol < 3 || cholesterol > 10) {
    warning("Cholesterol should be between 3-10 mmol/L")
    return(NA)
  }
  
  # Get coefficients
  coefficients <- get_risk_coefficients()
  
  # Check if region and gender exist
  if (!(region %in% names(coefficients))) {
    stop("Invalid region. Use: AFR, AMR, EMR, EUR, SEAR, WPR")
  }
  
  if (!(gender %in% names(coefficients[[region]]))) {
    stop("Invalid gender. Use: male, female")
  }
  
  # Get specific coefficients
  coef <- coefficients[[region]][[gender]]
  
  # Calculate linear predictor
  linear_predictor <- coef$intercept +
                     coef$age * age +
                     coef$sbp * systolic_bp +
                     coef$chol * cholesterol +
                     coef$smoking * smoking +
                     coef$diabetes * diabetes
  
  # Calculate 10-year risk probability
  risk_probability <- 1 - exp(-exp(linear_predictor))
  
  # Convert to percentage and round
  risk_percentage <- round(risk_probability * 100, 1)
  
  # Ensure reasonable bounds
  risk_percentage <- pmax(0, pmin(100, risk_percentage))
  
  return(risk_percentage)
}

4Risk Categorization and Interpretation

# Risk categorization function
categorize_risk <- function(risk_percentage) {
  case_when(
    risk_percentage < 10 ~ "Low Risk",
    risk_percentage < 20 ~ "Moderate Risk",
    TRUE ~ "High Risk"
  )
}

# Risk interpretation function
interpret_risk <- function(risk_percentage) {
  if (risk_percentage < 10) {
    return("Low cardiovascular risk. Continue healthy lifestyle and regular monitoring.")
  } else if (risk_percentage < 20) {
    return("Moderate risk. Consider lifestyle modifications and discuss with healthcare provider.")
  } else {
    return("High risk. Immediate medical attention and intensive intervention recommended.")
  }
}

5Example Usage with Validation

# Example patient data with validation
patient_data <- data.frame(
  patient_id = c("P001", "P002", "P003", "P004", "P005"),
  age = c(45, 60, 55, 40, 67),
  gender = c("male", "female", "male", "female", "male"),
  systolic_bp = c(130, 150, 140, 120, 165),
  cholesterol = c(5.2, 6.1, 5.8, 4.5, 6.5),
  smoking = c(0, 1, 0, 0, 1),
  diabetes = c(0, 1, 0, 0, 1),
  region = c("EUR", "AMR", "SEAR", "AFR", "WPR")
)

# Calculate risk with error handling
calculate_patient_risk <- function(data) {
  data$risk_percentage <- NA
  data$risk_category <- NA
  data$interpretation <- NA
  
  for (i in 1:nrow(data)) {
    tryCatch({
      risk <- calculate_globorisk(
        age = data$age[i],
        gender = data$gender[i],
        systolic_bp = data$systolic_bp[i],
        cholesterol = data$cholesterol[i],
        smoking = data$smoking[i],
        diabetes = data$diabetes[i],
        region = data$region[i]
      )
      
      data$risk_percentage[i] <- risk
      data$risk_category[i] <- categorize_risk(risk)
      data$interpretation[i] <- interpret_risk(risk)
      
    }, error = function(e) {
      warning(paste("Error calculating risk for patient", 
                   data$patient_id[i], ":", e$message))
    })
  }
  
  return(data)
}

# Process patient data
results <- calculate_patient_risk(patient_data)
print(results)

6Advanced Visualization

# Create comprehensive risk visualization
create_risk_visualization <- function(data) {
  # Risk distribution plot
  p1 <- ggplot(data, aes(x = reorder(patient_id, risk_percentage), 
                        y = risk_percentage, fill = risk_category)) +
    geom_col(alpha = 0.8) +
    geom_text(aes(label = paste0(risk_percentage, "%")), 
              hjust = -0.1, fontweight = "bold") +
    scale_fill_manual(values = c("Low Risk" = "#27ae60", 
                                "Moderate Risk" = "#f39c12", 
                                "High Risk" = "#e74c3c")) +
    coord_flip() +
    labs(title = "10-Year Cardiovascular Risk by Patient",
         x = "Patient ID", 
         y = "Risk Percentage (%)",
         fill = "Risk Category") +
    theme_minimal() +
    theme(plot.title = element_text(size = 14, face = "bold"))
  
  # Risk factors heatmap
  risk_factors <- data %>%
    select(patient_id, age, systolic_bp, cholesterol, smoking, diabetes) %>%
    pivot_longer(cols = -patient_id, names_to = "factor", values_to = "value")
  
  p2 <- ggplot(risk_factors, aes(x = factor, y = patient_id, fill = value)) +
    geom_tile(color = "white") +
    scale_fill_gradient2(low = "#27ae60", mid = "#f39c12", high = "#e74c3c",
                        midpoint = 0.5) +
    labs(title = "Risk Factors Heatmap",
         x = "Risk Factor", y = "Patient ID") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  # Combine plots
  library(gridExtra)
  grid.arrange(p1, p2, ncol = 2)
}

# Generate visualization
create_risk_visualization(results)

7Export and Reporting

# Create comprehensive report
generate_risk_report <- function(data, filename = "cardiovascular_risk_report") {
  
  # Summary statistics
  summary_stats <- data %>%
    summarise(
      total_patients = n(),
      mean_age = round(mean(age, na.rm = TRUE), 1),
      mean_risk = round(mean(risk_percentage, na.rm = TRUE), 1),
      low_risk_count = sum(risk_category == "Low Risk", na.rm = TRUE),
      moderate_risk_count = sum(risk_category == "Moderate Risk", na.rm = TRUE),
      high_risk_count = sum(risk_category == "High Risk", na.rm = TRUE)
    )
  
  # Risk by demographics
  risk_by_gender <- data %>%
    group_by(gender) %>%
    summarise(
      count = n(),
      mean_risk = round(mean(risk_percentage, na.rm = TRUE), 1),
      .groups = 'drop'
    )
  
  risk_by_region <- data %>%
    group_by(region) %>%
    summarise(
      count = n(),
      mean_risk = round(mean(risk_percentage, na.rm = TRUE), 1),
      .groups = 'drop'
    )
  
  # Export to Excel with multiple sheets
  report_data <- list(
    "Patient_Results" = data,
    "Summary_Statistics" = summary_stats,
    "Risk_by_Gender" = risk_by_gender,
    "Risk_by_Region" = risk_by_region
  )
  
  write_xlsx(report_data, paste0(filename, ".xlsx"))
  
  # Print summary
  cat("=== CARDIOVASCULAR RISK ASSESSMENT REPORT ===\n")
  cat("Total Patients:", summary_stats$total_patients, "\n")
  cat("Mean Age:", summary_stats$mean_age, "years\n")
  cat("Mean Risk:", summary_stats$mean_risk, "%\n")
  cat("Low Risk:", summary_stats$low_risk_count, "patients\n")
  cat("Moderate Risk:", summary_stats$moderate_risk_count, "patients\n")
  cat("High Risk:", summary_stats$high_risk_count, "patients\n")
  
  return(report_data)
}

# Generate report
report <- generate_risk_report(results)

📋 Data Requirements

Input Format: CSV or Excel file with columns:

age: Integer (30-74)
gender: "male" or "female"
systolic_bp: Integer (90-220)
cholesterol: Numeric (3-10)
smoking: Binary (0=no, 1=yes)
diabetes: Binary (0=no, 1=yes)
region: WHO region code

Globorisk NCDs Calculator

🫀 Globorisk Calculator