R snippets

rsnippets.R

library(readr)
library(ggplot2)
library(dplyr)
library(tidyverse)


# Read the HtnData.csv file with specified column types
HtnData <- read_csv("HtnData.csv", col_types = cols(
  row.names = col_integer(),
  Patient_ID = col_integer(),
  Progress_Note_Date = col_date(),
  Age = col_integer(),
  Patient_Female = col_logical(),
  Patient_ATSI_Status = col_character(),
  Presentation_Symptoms = col_character(),
  Organisation_Name = col_integer(),
  Inclusion_Crit = col_logical(),
  HbA1c = col_logical(),
  Lipid = col_logical(),
  U_E = col_logical(),
  Dip_Urine = col_logical(),
  ACR_Urine = col_logical(),
  Lifestyle_Discussion = col_logical(),
  HTN_MGMT_PLN = col_logical(),
  c715_Check = col_logical(),
  c3_MO_FLWP_STBL = col_logical(),
  c6_MO_BP = col_logical(),
  c3_MO_RVW_LFSTL = col_logical(),
  c2_4_WK_RVW_ACE = col_logical(),
))



# cleans the data somewhat. If there are inexplicable rows of NA, they will be removed
HtnData <- HtnData[!is.na(HtnData$Patient_ID), ]

# Display the dataframe for perusal
print(HtnData)

# Show data outputs below

## Calculate the average age of patients
average_age <- mean(HtnData$Age)
print(paste("The average age of patients is:", round(average_age, 0)))


# Convert Inclusion_Crit to numeric if it's not already
HtnData$Inclusion_Crit <- as.numeric(HtnData$Inclusion_Crit)

# Calculate the percentage of patients that met the inclusion criteria
inclusion_percentage <- mean(HtnData$Inclusion_Crit) * 100
print(paste("The percentage of patients who met the inclusion criteria is:", round(inclusion_percentage, 2), "%"))

# everything below this point filters to Inclusion_Crit is equal to 1
HtnData <- HtnData[HtnData$Inclusion_Crit == 1, ]

## Calculate the average age of patients
average_age_included <- mean(HtnData$Age)
print(paste("The average age of patients is:", round(average_age_included, 0)))

## Create a histogram of the Age data

# Create a new column for age categories
HtnData$Age_Group <- cut(HtnData$Age, 
                         breaks = c(-Inf, 14, 24, 44, 64, 80, Inf), 
                         labels = c("1-14", "15-24", "25-44", "45-64", "65-80","80+" ),
                         include.lowest = TRUE, right = FALSE)

# Create a histogram of the Age data
ggplot(HtnData, aes(x = Age_Group)) +
  geom_bar(color = "black", fill = "lightblue") +
  scale_x_discrete(drop = FALSE) + 
  theme_minimal() +
  labs(title = "Age Distribution of Patients diagnosed with Hypertension between audited dates", 
       x = "Age Group", y = "Count")



### Male female ratio

# Create data frame with counts of males and females
gender_count <- data.frame(
  gender = c("Female", "Male"),
  count = c(sum(HtnData$Patient_Female, na.rm = TRUE), 
            sum(!HtnData$Patient_Female, na.rm = TRUE))
)

# Create pie chart
ggplot(gender_count, aes(x = "", y = count, fill = gender)) +
  geom_bar(width = 1, stat = "identity") +
  coord_polar("y", start = 0) +
  theme_void() +
  labs(title = "Gender Distribution") +
  geom_label(aes(label = round((count/sum(count))*100, 1)), 
             position = position_stack(vjust = 0.5)) +
  scale_fill_brewer(palette = "Set2")



#### checks if all investigations are done, then adds a column
# Create a new column `Investig_Met`
HtnData$Investig_Met <- HtnData$HbA1c & HtnData$Lipid & HtnData$U_E & HtnData$Dip_Urine & HtnData$ACR_Urine

#####

# Import previous audit results


HtnData$Old_audit_Std_1_Met <- 0.28

HtnData$Old_audit_Std_2_Met <- 0.28


# Check **OLD** standard 1 met

HtnData$Old_Std_1_Met <- HtnData$Investig_Met & (HtnData$c3_MO_RVW_LFSTL | HtnData$c2_4_WK_RVW_ACE ) & HtnData$Lifestyle_Discussion & HtnData$c3_MO_FLWP_STBL

# Check **OLD** standard 2 met

HtnData$Old_Std_2_Met <- HtnData$HTN_MGMT_PLN & HtnData$c715_Check & HtnData$c3_MO_FLWP_STBL & HtnData$c6_MO_BP


# Check ***NEW*** standard 1 met

HtnData$New_Std_1_Met <- HtnData$Investig_Met & HtnData$Lifestyle_Discussion & HtnData$c715_Check & HtnData$HTN_MGMT_PLN

# Check **NEW** standard 2 met

HtnData$New_Std_2_Met <- HtnData$c3_MO_FLWP_STBL & HtnData$c6_MO_BP & (HtnData$c3_MO_RVW_LFSTL | HtnData$c2_4_WK_RVW_ACE)


########### Bar Graph for each standard


# Unite the necessary columns into one dataframe
standards <- HtnData %>%
  select(Old_Std_1_Met, Old_Std_2_Met, Old_audit_Std_1_Met, Old_audit_Std_2_Met) %>% 
  pivot_longer(cols = everything(), names_to = "Standard", values_to = "Met") %>%
  mutate(Met = as.numeric(Met)) %>%
  group_by(Standard) %>%
  summarise(Percentage = mean(Met, na.rm = TRUE) * 100)

# Make "Condition" and "Standard_No" columns for better visualization
standards$Condition <- ifelse(grepl("Old_audit", standards$Standard), "2020", "2022")
standards$Standard_No <- ifelse(grepl("1", standards$Standard), "Standard 1", "Standard 2")

# Create the bar plot
ggplot(standards, aes(x = Standard_No, y = Percentage, fill = Condition)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_hline(yintercept = 60, linetype = "dashed", color = "black") +
  scale_fill_manual(values = c("2022" = "#CC0000", "2020" = "#FFFF00")) +
  labs(x = "Standards", y = "Percentage (%)",
       fill = "Condition",
       title = "Comparison of previous and present audit based on previous standards") +
  theme_minimal() +
  ylim(0,100)






## Pie charts for each standard

generate_pie_chart <- function(data, column) {
    # Count TRUE and FALSE instances
    counts <- table(data[[column]])
  
    # Name counts for plotting
    df <- data.frame(labels = names(counts), counts = as.vector(counts))
    df$labels <- ifelse(df$labels == "TRUE", "Standard Met", "Standard Not Met")

    # Calculate percentages for labeling
    df$perc <- round((df$counts/sum(df$counts))*100, 1)

    # Generate pie chart
    p <- ggplot(df, aes(x = "", y = counts, fill = labels)) +
        geom_bar(width = 1, stat = "identity", colour = 'black') +
        coord_polar("y", start = 0) +
        scale_fill_manual(values = c("Standard Not Met" = "#CC0000", "Standard Met" = "#FFFF00")) +
        labs(fill = "") +
        geom_text(data = subset(df, labels == "Standard Met"), aes(label = paste0("Standard Met: ", perc, "%")),
            position = position_stack(vjust = 0.5), color = "black") +
        ggtitle(paste("Percent of old standard 2 met")) +
        theme_minimal() +
        theme(axis.title.x=element_blank(),
            axis.title.y=element_blank(),
            panel.border = element_blank(),
            panel.grid=element_blank(),
            axis.ticks = element_blank(),
            plot.title=element_text(hjust=0.5),
            axis.text = element_blank())
        
    print(p)
}

generate_pie_chart(HtnData, "Old_Std_2_Met")





# Generate pie chart for each of these columns

#generate_pie_chart(HtnData, "Old_Std_1_Met")
#generate_pie_chart(HtnData, "New_Std_1_Met")
#generate_pie_chart(HtnData, "New_Std_2_Met")


### calculate adherence to investigations ####

# Define the columns to iterate
columns_to_run <- c("HbA1c" = "HbA1c", "Lipid" = "Lipids", "U_E" = "U&Es", "Dip_Urine" = "Urine Dipstick", "ACR_Urine" = "Urine ACR")

# Initialize an empty data frame to store the results
adherence_inv_perc <- data.frame()

# Calculate adherence percentages for each column
for(column in names(columns_to_run)) {
    counts <- table(HtnData[[column]])
    df <- data.frame(label = column, adherence = sum(counts["TRUE"]) / sum(counts) * 100, 
                     pretty_label = columns_to_run[[column]])
    adherence_inv_perc <- rbind(adherence_inv_perc, df)
}

# Make the bar chart
ggplot(adherence_inv_perc, aes(x = pretty_label, y = adherence)) +
    geom_bar(stat = "identity", fill = "steelblue") +
    geom_hline(yintercept = 60, linetype = "dashed", color = "red") +
    geom_text(aes(label = round(adherence, 1)), vjust = -0.3, color = "black") +
    labs(x = "Categories", y = "Adherence Percentage (%)",
         title = "Adherence to standard for baseline investigations") +
    theme_minimal()


################


# Calculate adherence to followup
HtnData$initial_flwp <- (HtnData$c3_MO_RVW_LFSTL | HtnData$c2_4_WK_RVW_ACE)

columns_to_run <- c("initial_flwp" = "Initial Followup", 
                    "c3_MO_FLWP_STBL" = "Three Month Followup", 
                    "c6_MO_BP" = "Six Month BP")

adherence_flwp_perc <- data.frame()

for(column in names(columns_to_run)) {
    counts <- table(HtnData[[column]])
    df <- data.frame(label = column, adherence = sum(counts["TRUE"]) / sum(counts) * 100,
                     pretty_label = columns_to_run[[column]])
    adherence_flwp_perc <- rbind(adherence_flwp_perc, df)
}

# Change the pretty_label column into a factor and specify the order of levels
adherence_flwp_perc$pretty_label <- factor(adherence_flwp_perc$pretty_label, 
                                           levels = c("Initial Followup", 
                                                      "Three Month Followup", 
                                                      "Six Month BP"))

# Make the bar chart
ggplot(adherence_flwp_perc, aes(x = pretty_label, y = adherence)) +
    geom_bar(stat = "identity", fill = "steelblue", width = 0.5) +
    geom_hline(yintercept = 60, linetype = "dashed", color = "red") +
    geom_hline(yintercept = 0, color = "black", size = 1.0) +
    geom_text(aes(label = round(adherence, 1)), vjust = -0.3, color = "black") +
    labs(x = "Categories", y = "Adherence Percentage (%)", title = "Adherence to standard for followup") +
    theme_minimal()

### Complete followup

# create new column for all followup
HtnData$initial_flwp <- (HtnData$c3_MO_RVW_LFSTL | HtnData$c2_4_WK_RVW_ACE)
HtnData$complete_followup_adherence <- HtnData$initial_flwp & HtnData$c3_MO_FLWP_STBL & HtnData$c6_MO_BP

counts <- table(HtnData$complete_followup_adherence)
percentage_adherence <- sum(counts["TRUE"]) / sum(counts) * 100
# Create a data frame for the chart
df <- data.frame(label = "Complete Followup", adherence = percentage_adherence)

# Single Horizontal Bar Chart
p <- ggplot(df, aes(x = "", y = adherence)) +
  geom_bar(stat = "identity", width = 0.2, fill = "steelblue") +
  coord_flip() +
  geom_hline(yintercept = 60, linetype = "dashed", color = "red",
             aes(label = "60% standard")) +
  geom_hline(yintercept = 0, color = "black", size = 1.0) +
  geom_text(data = df, aes(label = paste0(round(adherence, 1), "%")), vjust = -1.5, color = "black") +
  labs(x = "", y = "Adherence Percentage (%)",
       title = "Percentage of patients completeley followed up") +
  theme_minimal() +
  ylim(0,100)

print(p)


###### Single bar chart for 715

# Calculate adherence for the 715 check
counts <- table(HtnData$c715_Check)
percentage_adherence <- sum(counts["TRUE"]) / sum(counts) * 100

# Create a data frame for the chart
df <- data.frame(label = "715 Check", adherence = percentage_adherence)

# Single Horizontal Bar Chart
p <- ggplot(df, aes(x = "", y = adherence)) +
  geom_bar(stat = "identity", width = 0.2, fill = "steelblue") +
  coord_flip() +
  geom_hline(yintercept = 60, linetype = "dashed", color = "red",
             aes(label = "60% standard")) +
  geom_hline(yintercept = 0, color = "black", size = 1.0) +
  geom_text(data = df, aes(label = paste0(round(adherence, 1), "%")), vjust = -1.5, color = "black") +
  labs(x = "", y = "Adherence Percentage (%)",
       title = "Adherence to 715 Check Standard") +
  theme_minimal() +
  ylim(0,100)

print(p)

###### Single bar chart for lifestyle discussion

# Calculate adherence for the 715 check
counts <- table(HtnData$Lifestyle_Discussion)
percentage_adherence <- sum(counts["TRUE"]) / sum(counts) * 100

# Create a data frame for the chart
df <- data.frame(label = "Lifestyle Discussion", adherence = percentage_adherence)

# Single Horizontal Bar Chart
p <- ggplot(df, aes(x = "", y = adherence)) +
  geom_bar(stat = "identity", width = 0.2, fill = "steelblue") +
  coord_flip() +
  geom_hline(yintercept = 60, linetype = "dashed", color = "red",
             aes(label = "60% standard")) +
  geom_hline(yintercept = 0, color = "black", size = 1.0) +
  geom_text(data = df, aes(label = paste0(round(adherence, 1), "%")), vjust = -1.5, color = "black") +
  labs(x = "", y = "Adherence Percentage (%)",
       title = "Adherence to Lifestyle Discussion Standard") +
  theme_minimal() +
  ylim(0,100)

print(p)

#### single bar chart for htn mgmt plan

###### Single bar chart for lifestyle discussion

# Calculate adherence for the 715 check
counts <- table(HtnData$HTN_MGMT_PLN)
percentage_adherence <- sum(counts["TRUE"]) / sum(counts) * 100

# Create a data frame for the chart
df <- data.frame(label = "Hypertension Management Plan", adherence = percentage_adherence)

# Single Horizontal Bar Chart
p <- ggplot(df, aes(x = "", y = adherence)) +
  geom_bar(stat = "identity", width = 0.2, fill = "steelblue") +
  coord_flip() +
  geom_hline(yintercept = 60, linetype = "dashed", color = "red",
             aes(label = "60% standard")) +
  geom_hline(yintercept = 0, color = "black", size = 1.0) +
  geom_text(data = df, aes(label = paste0(round(adherence, 1), "%")), vjust = -1.5, color = "black") +
  labs(x = "", y = "Adherence Percentage (%)",
       title = "Adherence to Hypertension Management Plan Standard") +
  theme_minimal() +
  ylim(0,100)

print(p)