1 Programs as Systems

Consider a program meant to decrease adolescent vaping. The Theory of Change sets out the blueprint of why specific activities (peer mentoring, parental engagement, etc.) are expected to make a difference. Implementation is the process of putting those activities into action (i.e., hiring and training staff, ensuring session fidelity, adapting schedules to participants’ needs, and more). Finally, Evaluation measures outcomes, seeking evidence that the program actually achieved its stated goals.

When a prevention program is conceptualized as this interconnected system, a typical RCT that simply asks, “Does the program work?” can obscure which part of the system is actually influencing the observed outcomes. This can lead to confusing or contradictory findings, positive results might mask a faulty theory (if staff happened to do something else that helped), and negative or null results might disguise an essentially correct theory that was never implemented well.

2 Why Typical RCT Frameworks Can Be Limiting

1. Black-Box Design

Traditional RCTs treat the entire program as a black box. If we see a difference in outcomes, we infer that the program caused it. Yet we rarely dissect which portion of the program functioned well or poorly. If results are mediocre, we cannot easily pinpoint whether it was the theory that failed or the implementation.

These three components (T, I, E) can have different effects on the outcomes for example:

• If T is flawed (the theory is incorrect or incomplete), the intervention might accidentally help in other ways or might fail entirely.
• If I is compromised (poor training, inadequate resources, low fidelity), the intervention as delivered differs substantially from the intervention as theorized.
• If E is misaligned (measuring the wrong outcome or using unreliable methods), results can be misleading, even if the theory and the implementation were sound.

2. Confounded by Implementation

Consider an RCT run across multiple sites. Some sites deliver the program faithfully; others do not. If you average outcomes across all sites, the overall effect could appear modest, even though high-fidelity sites might have shown strong results. Hence, the classical RCT approach can mislead us into dismissing a promising program (or adopting one that only worked under special conditions).

3 Strengthening Causal Claims: A Systems View

By viewing prevention programs as systems, we can better diagnose why we see certain outcomes:

1. Disaggregate the Results Break down the program into T, I, and E. Evaluate fidelity, did staff deliver the planned activities (Implementation)? Did the underlying logic hold up in practice (Theory)? Did the measurement tools capture the actual changes (Evaluation)?

2. Assess Fidelity and Adaptation A high- or low-fidelity site comparison can reveal how much Implementation quality shapes outcomes. If only high-fidelity sites show significant improvements, the program’s fundamentals might be valid; the challenge is ensuring consistent delivery.

4 RCTs Are Still Useful—But We Need More

This is not to say that RCTs lack value. Random assignment remains a powerful way to rule out many external factors that might otherwise explain an effect. The point is that an RCT, on its own, cannot fully disentangle why a program succeeded or failed—particularly if we do not measure or account for the intricacies of T, I, and E. The RCT’s rigorous comparison can show whether a difference in outcome exists, but interpreting that difference requires a deeper system-level understanding.

5 Conclusion

Determining whether an observed effect is genuinely caused by a prevention program involves more than a simple yes/no answer from an RCT. When we treat these interventions as systems—each with a distinct theory, mode of implementation, and evaluation metric—our classical causal framework can become opaque, leading to confusion and misguided conclusions. Flaws in implementation might overshadow a perfectly valid theory; incorrect or narrow evaluation metrics can inflate or hide real changes.

Step-by-Step Guide

brew install duckdb

mkdir ~/bin

cd ~/bin
touch toduck

nano toduck

#!/bin/bash

convert_file() {
    local input_file="$1"
    local output_extension="$2"

    # Extracting the filename without extension
    local base_name=$(basename -- "$input_file")
    local name="${base_name%.*}"

    # Constructing the output filename
    local output_file="${name}.${output_extension}"

    # Performing the conversion
    duckdb -c "copy (select * from '${input_file}') to '${output_file}'"

    echo "Conversion complete: ${output_file}"
}

# Check if the number of arguments is less than 2
if [ "$#" -lt 2 ]; then
    echo "Usage: $0 <input_file> <output_extension>"
    echo "Example: $0 example.parquet csv"
    exit 1
fi

# Call the conversion function with the provided arguments
convert_file "$1" "$2"

chmod +x ~/bin/toduck

nano ~/.zshrc

nano ~/.bashrc

export PATH="$HOME/bin:$PATH"

source ~/.zshrc

source ~/.bashrc

How to Use Your New Script

Using the script is straightforward.

Navigate to the directory containing the file you want to convert and run the script with the desired output format. The syntax is:

toduck <input_file> <output_extension>

Examples:

1. Convert a Parquet file to CSV:

toduck data.parquet csv

2. Convert a CSV file to Parquet:

toduck data.csv parquet

The script will: 1. Take your input file 2. Create a new file with the same name but different extension 3. Convert the data using DuckDB 4. Show you the path to the converted file

Supported Formats

DuckDB supports various file formats including: - CSV - Parquet - JSON - Excel (xlsx)

Common Use Cases

This script is particularly useful when you need to: - Convert large CSV files to Parquet for better compression and performance - Make Parquet files readable in spreadsheet software by converting to CSV - Quickly convert between different data formats for various tools and applications

That’s it! You now have a powerful tool for converting data files right from your terminal. If you have any questions or suggestions for improvements, feel free to leave a comment below.

Step-by-Step Guide

mkdir ~/bin

cd ~/bin
touch organize

nano organize

#!/bin/bash

# Enable nullglob to avoid errors when no files match a pattern
shopt -s nullglob

# Check if directory exists
if [ ! -d "$1" ]; then
    echo "Error: Directory '$1' does not exist"
    exit 1
fi

target_dir="$1"
echo "Organizing files in: $target_dir"

# Create directories if they don't exist
mkdir -p "$target_dir"/{Images,Videos,Pdf,PowerPoint,Text,Archives,Excel,Others}

# Change to target directory
cd "$target_dir" || exit 1

# Function to move files and handle duplicates
move_file() {
    local file="$1"
    local target_folder="$2"
    local filename=$(basename "$file")
    
    if [ -e "$target_folder/$filename" ]; then
        # If file with the same name exists, add "-duplicate" before the extension
        local name="${filename%.*}"
        local extension="${filename##*.}"
        local duplicate_name="${name}-duplicate.${extension}"
        
        # Check again in case a duplicate already exists
        while [ -e "$target_folder/$duplicate_name" ]; do
            name="${name}-duplicate"
            duplicate_name="${name}.${extension}"
        done
        
        mv -v "$file" "$target_folder/$duplicate_name"
    else
        mv -v "$file" "$target_folder/"
    fi
}

# Move files based on their extensions

# Images
for file in *.{jpg,jpeg,png,gif,HEIC}; do
    [ -e "$file" ] && move_file "$file" "Images"
done

# Videos
for file in *.{mp4,avi,mov}; do
    [ -e "$file" ] && move_file "$file" "Videos"
done

# PDF
for file in *.pdf; do
    [ -e "$file" ] && move_file "$file" "Pdf"
done

# PowerPoint
for file in *.pptx; do
    [ -e "$file" ] && move_file "$file" "PowerPoint"
done

# Text
for file in *.{docx,txt}; do
    [ -e "$file" ] && move_file "$file" "Text"
done

# Archives
for file in *.{zip,rar}; do
    [ -e "$file" ] && move_file "$file" "Archives"
done

# Excel
for file in *.{xlsx,csv}; do
    [ -e "$file" ] && move_file "$file" "Excel"
done

# Others (any remaining files)
for file in *; do
    [ -f "$file" ] && move_file "$file" "Others"
done

echo "File organization complete in $target_dir!"

chmod +x ~/bin/organize

nano ~/.zshrc

nano ~/.bashrc

export PATH="$HOME/bin:$PATH"

source ~/.zshrc

source ~/.bashrc

How to Use Your New Script

Using the script is straightforward. Simply type organize followed by the path to the directory you want to organize. For example:

organize ~/Downloads

This will: 1. Create organized folders in your specified directory 2. Move files to their appropriate folders based on their extensions 3. Show you what files are being moved

The script will create the following folders: - Images (for jpg, jpeg, png, gif, HEIC files) - Videos (for mp4, avi, mov files) - Pdf (for pdf files) - PowerPoint (for pptx files) - Documents (for docx, txt files) - Archives (for zip, rar files) - Excel (for xlsx, csv files)

Customization

You can easily customize this script by: - Adding new folders for different file types - Including additional file extensions - Modifying the folder names to match your preferences

Simply edit the script and add or modify the relevant lines in the code.

That’s it! You now have a powerful tool to keep your directories organized. No more messy folders! If you have any questions or suggestions for improvements, feel free to leave a comment below.

Conclusion

This simulation app shows how varying levels of dishonesty among students impact the reliability of self-reported data on drug use. Whether dishonesty is minimal, high, or mixed, the accuracy of survey results is affected, underscoring the importance of addressing reporting biases in adolescent drug use research. By understanding the potential effects of underreporting and overreporting, researchers can develop more accurate data collection methods and analytical strategies, leading to more reliable findings. These insights are crucial for informing interventions aimed at addressing drug use among adolescents.

Some Recommendations for Measuring Drug Use

1. Include a Fictitious Drug in the Report: Adding a fictitious drug to the questionnaire can help identify and exclude responses from students who overreport (braggers).

2. Guarantee Anonymity: Ensure students’ anonymity to encourage honest reporting. For example, do not collect data in the presence of familiar adults, which can create pressure and lead to dishonest answers.

3. Educate on the Importance of Honesty: Explain the benefits of honest reporting to students. Emphasize how accurate data can help create better policies and interventions that benefit their community.

4. Compare with Other Reports: Cross-check your prevalence data with other studies and reports. This can help identify discrepancies and validate the accuracy of your findings.

5. Conduct Consistency Analysis: Analyze the consistency of responses to ensure coherence. For example, lifetime prevalence should be consistent with last month’s prevalence; it is illogical for someone to report drug use in the past month but not in their lifetime.

6. Randomized Response Techniques: Use randomized response techniques to increase the likelihood of truthful responses. This method allows respondents to answer sensitive questions while maintaining privacy, reducing the fear of disclosure.

7. Use Validated Questionnaires: Employ well-validated and standardized questionnaires that have been proven to minimize bias and elicit more accurate responses.

8. Provide Confidential Environments: Create a confidential and comfortable environment for survey administration. Ensure that students feel safe and that their responses will not be traced back to them.

9. Implement Follow-Up Questions: Include follow-up questions that cross-validate initial responses. Inconsistencies in follow-up responses can highlight potential dishonesty.

10. Train Data Collectors: Train those administering the surveys to build rapport with students and encourage honesty. Skilled data collectors can significantly impact the quality of the data collected.

11. Pilot Testing: Conduct pilot testing of the survey to identify potential issues and biases before the full-scale implementation. This allows for adjustments to improve accuracy.

12. Longitudinal Studies: Where possible, use longitudinal studies to track changes over time, which can help validate self-reported data through consistency checks over multiple points in time.

Step-by-Step Guide

mkdir ~/bin

cd ~/bin

touch getref

nano getref

#!/bin/bash
# Check if an argument is provided
if [ "$#" -ne 1 ]; then
    echo "Usage: $0 <DOI or DOI URL>"
    exit 1
fi

# Determine if the input is a DOI URL or just a DOI number
if [[ "$1" =~ ^https:// ]]; then
    # Extract the DOI number from the URL
    DOI=$(echo "$1" | sed 's|https://doi.org/||')
else
    # Assume the input is just a DOI number
    DOI="$1"
fi

# Extract and print the reference
curl -LH "Accept: application/x-bibtex" "https://doi.org/$DOI"

chmod +x ~/bin/getref

nano ~/.zshrc

export PATH="$HOME/bin:$PATH"

source ~/.zshrc

source ~/.bashrc

How to Use Your New Script

To use your script, simply type getref in your termina followed by a DOI or a DOI URL. For example:

getref 10.1080/09687637.2023.2167649

or

getref https://doi.org/10.1080/09687637.2023.2167649

The script will fetch and display the bibliographic information in BibTeX format.

Done! This is a handy tool that simplifies the process of fetching bibliographic data. I hope you enjoy it. If you have any questions or suggestions, feel free to leave a comment below.

Rubin to the Rescue… Or Not?

Let’s turn the spotlight onto a different perspective. Picture yourself in an examination hall, faced with a challenging test. In a moment of desperation, you decide to copy answers from the student next to you. However, you have no evidence they’re the top student. So, you start sizing them up. Glasses? Check. Philosophical expressions? Check. Or maybe they’re a math wiz because, obviously, that’s the universal sign of genius, right?

As your anxiety mounts, something extraordinary happens: a fairy godmother appears, not with a magic wand, but with important message: she whispers your neighbor’s grade. Bingo! With newfound confidence, you embark on your note-transcribing quest.

This little adventure parallels adjusting your data based on observed outcomes. Before the fairy godmother’s revelation, you’re in the dark, much like when we lack insight into the observed outcomes. You might make assumptions (glasses mean brains, right?), but that’s shaky ground and we might just be copying the wrong answers, mistaking luck for wisdom.

And that’s where Rubin’s thinking comes in. It’s not like the fairy godmother, it is much like venturing into an enchanted forest where paths diverge and outcomes remain uncertain.

The Rubin causal model, also known as the potential outcomes framework, is a way to think about cause and effect in a systematic manner. Imagine every time you make a decision, there are two parallel universes: one where you made one choice and another where you made a different one. The Rubin model compares what happens in these two universes to understand the true impact of that choice. It’s like having a twin who makes different decisions, and by looking at both your lives, you can see the effects of those decisions. In practice, since we can’t see parallel universes, this model uses statistics to estimate what would have happened in the alternate scenario, helping to isolate the cause of an outcome from all the noise. In this context, balancing data is contrary to observing divergence outcomes across parallel universes; it artificially aligns one universe to resemble the other, potentially obscuring causal relationships rather than revealing them.

But wait, as in fairy tales, there’s a twist! Machine learning loves predictions like cats love cardboard boxes. And in this arena, confounders could be seen as those annoying but sometimes helpful pieces of furniture. Sure, they make your model look cluttered, but they might just help it predict better, and we have the tools to deal with the ‘cluttering’: ’In the force of data, too much bias, the clarity it clouds; too much variance, the truth it obscures.

In essence, while machine learning and causal reasoning might seem like strange bedfellows, they both aim to make sense of our chaotic, data-driven world. Perhaps it’s time we invite them both to the party, have them shake hands, and work together. After all, the best parties are those where everyone gets along, right?

Python Code to Compute the Total Number of Grains

Imagine you have a bag of grains, and you want to fill a chessboard with them. You start with one grain on the first square, then double the number of grains on each subsequent square until you reach the 64th square. You can think of this process like a snowball rolling down a hill, getting bigger and bigger as it goes.

In Python, we can use something called a while loop to replicate this process. It’s like having a robot that puts the grains on the squares for you, following your exact instructions: “Start with one grain, then double the number, and keep going until you fill all 64 squares.”

Now, let’s think about a different way to approach the task using what’s called a for loop. Imagine instead that you have 64 small containers, each representing a square on the chessboard, and you know exactly how many grains should go in each one. Starting with the first container, you fill it with one grain, then move to the next one and fill it with double the grains of the previous container, and so on, until you reach the 64th container.

While Loop in python

Lets to compute that number of grains using the while loop.

# Initialize variables
square_number = 1  # The number of the current square
grains_on_square = 1  # The number of grains on the current square
total_grains = 0  # The total number of grains so far

# Loop through each square on the chessboard
while square_number <= 64:
    # Add the number of grains on the current square to the total
    total_grains += grains_on_square
    # Double the number of grains on the current square for the next square
    grains_on_square *= 2
    # Move to the next square
    square_number += 1

print(f"The total number of grains on the chessboard is: \n {total_grains:,}")

The total number of grains on the chessboard is: 
 18,446,744,073,709,551,615

So, it’s a big number. Here are some interesting facts about this number:

# Total number of grains as computed earlier
total_grains = 18446744073709551615

# Weight of a single grain in grams
weight_per_grain = 0.05

# Compute the total weight in grams
total_weight_grams = total_grains * weight_per_grain

# Convert to kilograms
total_weight_kilograms = total_weight_grams / 1000

# Convert to metric tons
total_weight_metric_tons = total_weight_kilograms / 1000

print(f"The total weight of the rice in grams is {total_weight_grams:.2f} grams")
print(f"The total weight of the rice in kilograms is {total_weight_kilograms:.2f} kilograms")
print(f"The total weight of the rice in metric tons is {total_weight_metric_tons:.2f} metric tons")

The total weight of the rice in grams is 922337203685477632.00 grams
The total weight of the rice in kilograms is 922337203685477.62 kilograms
The total weight of the rice in metric tons is 922337203685.48 metric tons

Let’s finish this post by comparing the while loop with the for loop.

Dataset

First, let’s recreate the confusion matrix from the previous post.

library(tidyverse)  # Load tidyverse package
library(gt)         # Load gt package
library(gtsummary)  # Load gtsummary package

# Create a tibble with the confusion matrix data
confusion_matrix_long <- tibble(
  'Predicted Class' = c('1', '1', '0', '0'),
  'True Class' = c('True 1', 'True 0', 'True 1', 'True 0'),
  'Count' = c(40, 15, 10, 35)
)

confusion_matrix_long |> gt()

The tbl_cross() function is useful for computing these metrics after a bit of data wrangling.

# Duplicate each row of the tibble based on the value in the Count column
confusion_matrix_long |>
  uncount(Count) |>
  tbl_cross(percent = "col")  

The sensitivity of our model is 80%, and the specificity is 70% - pretty good values!

Computing Sensitivity and Specificity Using collect_metrics

In machine learning, sensitivity and specificity are important metrics used to evaluate and improve model performance. When we tune model parameters across different datasets, it’s useful to compute these metrics for each dataset. This gives us useful data to make decisions on enhancing model performance. We can calculate these metrics efficiently using the collect_metrics() function from the tidymodels package.

We’ll use fit_resamples() to estimate the model many times. This uses different samples from our training data. Then, we’ll use collect_metrics() to compute the sensitivity and specificity for each dataset.

Cross-Validation Folds

We’ll start by using vfold_cv() from tidymodels to create 10 folds of data. To get a better estimate of the sensitivity and specificity, we’ll use the repeats argument to repeat the sampling process 10 times. This gives us 100 folds of data in total.

# Load packages
library(tidymodels) # Load tidymodels package
tidymodels::tidymodels_prefer() # Set tidymodels as the default modeling framework

set.seed(1906) # Set seed for reproducibility

# Create a tibble with the data
df <- confusion_matrix_long |>
  uncount(Count)  |> 
  rename(
    x = `Predicted Class`, 
    y = `True Class`
  )

# Create 10 folds of the data
folds <- vfold_cv(df, v = 10, repeats = 10)

Model Specification

Having the folds ready, we can now specify the model.

# Define a logistic regression model specification
model_spec <- logistic_reg() |>
  set_engine("glm") |>
  set_mode("classification")

# Create a recipe for preprocessing the data
recipe_glm <- recipe(y ~ x, data = df) |>
  # Convert all nominal variables to dummy variables
  step_dummy(all_nominal(), -all_outcomes()) 

# Define a workflow for fitting the logistic regression model
wr_glm <- workflow() |>
  # Add the recipe to the workflow
  add_recipe(recipe_glm) |>
  # Add the model specification to the workflow
  add_model(model_spec)

Perfect! Now we are ready to estimate the model.

Estimating the Model

# Estimate the model 100 times
model_resamples <- fit_resamples(
  wr_glm, 
  folds, 
  control = control_resamples(save_pred = TRUE)
)

Notice that we used the save_pred argument in control_resample() because we want to save the predictions of the model for each fold. This allows us to compute the sensitivity and specificity for each fold, which is the goal of this post.

Let’s take a look at one of the results.

# Extract the metrics for the first resample
model_resamples |>
  # Select the first resample
  slice(1) |>
  # Unnest the metrics data
  unnest(.metrics)  |> 
  select(.metric, .estimate) |>
  gt()  |> 
  fmt_number(decimals = 3)

By default, we obtain accuracy and roc_auc metrics for classification models. However, we want a specific metric set (sensitivy and specificity). To achieve this, we can use metric_set() function from the yardstick package.

Computing Sensitivity and Specificity

# Define the metrics to use
my_metrics <- metric_set(sens, spec)

# Fit the logistic regression model using resampling
model_resamples <- fit_resamples(
  wr_glm, 
  folds, 
  metrics = my_metrics,
  control = control_resamples(
    # Save the predicted values for each resample
    save_pred = TRUE,
    # Set the event level to "second"
    event_level = "second"
  )
)

Now, let’s dive into the results. For a start, we’ll focus on the first resample. Although this may provide an imperfect estimation of our “true” values, theory assures us that as we increase the number of resamples, the average of the metrics will move closer to these “true” values. Let’s see this in action!

# Extract the metrics for the first resample
model_resamples %>%
  # Select the first resample
  slice(1) %>%
  # Unnest the metrics data
  unnest(.metrics) %>%
  # Select the metric and estimate columns
  select(.metric, .estimate) %>%
  # Create a gt table
  gt() %>%
  # Format the estimate column to 3 decimal places
  fmt_number(decimals = 3)

Good, we have achieved a sensitivity of 100% and specificity of 57.1%, which, frankly, isn’t an ideal representation of our true values. But, let’s keep in mind, this is just a single estimate out of our 100 trials. Now, let’s take it to the next level and summarize these values across all our estimates.

# Collect and summarise the metrics for all resamples
model_resamples %>%
  # Collect the metrics and summarise them
  collect_metrics(summarise = TRUE) %>%
  # Create a gt table
  gt() %>%
  # Format the table to 3 decimal places
  fmt_number(decimals = 3)

Great job! Our model’s estimated sensitivity is at 81.0% and specificity stands at 70.3%, quite near to our actual values.

With all this valuable data at hand, it’s tempting to visualize it. So, let’s move on to plotting the observed distribution for both sensitivity and specificity values to get a better understanding of our model’s performance.

model_resamples  |> 
  unnest(.metrics)  |> 
  ggplot(aes(x = .estimate, fill = .metric)) +
  geom_density() +
  facet_wrap(~.metric) +
  theme_minimal() +
  scale_fill_manual(values = c("#00AFBB", "#E7B800"))

Next time, we’ll look more closely at these values. We’ll work out which ones are bigger than 0.5 and see how spread out they are. But, we need to be careful because these numbers are connected; they all come from the same data. Don’t miss it!

Summary

In this blog post, we discussed the use of the tidymodels package to compute the sensitivity and specificity of a model - two important measures for evaluating model performance. We started with the recreation of a confusion matrix, then used the tbl_cross() function to perform some data wrangling.

Next, we leveraged fit_resamples() from the tidymodels package to estimate our model multiple times, using cross-validation with 10 repeated folds to create 100 datasets in total.

We set up a logistic regression model, fit it to our data, and estimated the model multiple times using the created folds. The saved predictions allowed us to compute sensitivity and specificity for each fold.

We defined a custom set of metrics - roc_auc, sensitivity, and specificity - using the metric_set() function from the yardstick package. Finally, we used collect_metrics() to compute the average of these metrics for all the folds, and visualized the distribution of the sensitivity and specificity values.

Future posts will delve into calculating confidence intervals and evaluating the variability of these values across resamples.

Modeling with tidymodels

Let’s now assume that we have a dataset comprising Y and X values, and we aim to create a model that predicts Y based on X. We’ll use the same dataset we created earlier.

df <- confusion_matrix_long |>
    uncount(Count) |>
    rename(y = `True Class`, x = `Predicted Class`) # Rename the columns to shorter names

First, we’ll load the tidymodels library and specify our model.

# Load the tidymodels package
library(tidymodels)

# Define a logistic regression model specification
model_spec <- logistic_reg() |>
    set_engine("glm") |>
    set_mode("classification")

# Define a recipe for preprocessing the data
recipe_glm <-
    recipe(y ~ x, data = df) |>
    # Convert all nominal variables to dummy variables
    step_dummy(all_nominal(), -all_outcomes())

Let’s examine the dataset we’ve created.

# Preprocess the data using the recipe
# This includes converting nominal variables to dummy variables
recipe_glm |>
    prep() |>
    # Apply the recipe to new data
    bake(new_data = df) |>
    # View the first few rows of the preprocessed data
    skimr::skim()

Remeber that our outcome is a binary variable with values True 0 and True 1.

Next, we can create a workflow that combines our recipe and the model specification, and fit the model.

# Define a workflow for fitting the logistic regression model
wr_glm <- workflow() |>
    add_recipe(recipe_glm) |>
    add_model(model_spec)

# Fit the logistic regression model to the preprocessed data
model <- wr_glm |>
    fit(data = df)

# Extract the model coefficients and create a summary table
model |>
    extract_fit_parsnip() |>
    tbl_regression()

So, we’ve established that the model predicts the Y values based on the X values. But how do we calculate the sensitivity and specificity using the model results?

First, we need to generate predictions. The augment() function from the dplyr package is an excellent choice for this task.

# Load the reactable package
library(reactable)
library(knitr)

# Use the augment() function to add predicted values to the data frame
the_predictions <- model |>
    augment(df) |>
    # Rename the "y" column to "Observed"
    rename("Observed" = "y")


# Create an interactive table using the reactable::reactable() function
the_predictions |>
    reactable(
        groupBy = "Observed",
        columns = list(
            x = colDef(aggregate = "unique"),
            .pred_class = colDef(aggregate = "unique"),
            `.pred_True 0` = colDef(aggregate = "mean", format = colFormat(digits = 2)),
            `.pred_True 1` = colDef(aggregate = "mean", format = colFormat(digits = 2))
        )
    )

At this point, we have both the predicted class and the observed class. We could use the same method we employed in the earlier demonstration (tbl_cross()), or we can make use of the sensitivity() and specificity() functions from the yardstick package. Let’s look at how this works.

Computing sensitivity and specificity using a cross table

the_predictions |>
    tbl_cross(.pred_class, Observed, percent = "column")

This yields the same results as before.

Computing sensitivity and specificity using the yardstick package

Finally! we can use the sensitivity() and specificity() functions from the yardstick package to calculate the sensitivity and specificity of our model.

sens <- the_predictions |>
    mutate(Observed = as.factor(Observed)) |>
    sensitivity(Observed, .pred_class)

spec <- the_predictions |>
    mutate(Observed = as.factor(Observed)) |>
    specificity(Observed, .pred_class)

bind_rows(sens, spec) |>
    gt()

Oops! That doesn’t look right. Why is that?

In the context of logistic regression, R’s default behavior is to take the first level of a factor as the reference category when using the glm function. This behavior becomes particularly important when we’re dealing with binary outcomes, often coded as 0 (absence of the event) and 1 (presence of the event). By default, R will take 0 as the reference level and compare it against 1, due to 0 coming before 1 in numerical order.

However, when we’re working with factors, the order in which they’re arranged is somewhat arbitrary and it doesn’t necessarily make sense to always treat 0 as the absence of an event and 1 as the presence of an event (Kuhn and Silge 2022).

The yardstick package interprets this setup a bit differently. It views the first factor as the most important, leading it to switch the factor levels in the process. This change in order may affect our sensitivity and specificity measures.

To maintain consistency with our earlier computations, it’s necessary to explicitly set the reference level in the sensitivity() and specificity() functions from the yardstick functions, using the event_level = “second” argument. This ensures that the factor levels are interpreted in a way that aligns with our initial demonstration.

sens_y <- the_predictions |>
    mutate(Observed = as.factor(Observed)) |>
    sensitivity(Observed, .pred_class, event_level = "second")

spec_y <- the_predictions |>
    mutate(Observed = as.factor(Observed)) |>
    specificity(Observed, .pred_class, event_level = "second")

bind_rows(sens_y, spec_y) |>
    gt()

Now we’ve restored our original results. 😎

Summary

In this blog post, we’ve walked through the process of computing sensitivity and specificity using the tidymodels package in R, demonstrating it with a simulated dataset. These metrics are indispensable for evaluating the performance of binary classification models. Don’t forget: for the most accurate and realistic results, always evaluate your models using separate test data.

Notes

Distribution of ELO

data("players")

First, let’s visualize the ELO distribution of the players.

It is important to filter out players with an ELO rating of zero from the analysis, as these players have not yet been rated and do not have a known skill level.

players |>
    filter(rtg != 0) |>
    ggplot(aes(rtg)) +
    geom_histogram(bins = 90, fill = "gray90", alpha = 0.85, color = "gray95") +
    scale_x_continuous(breaks = seq(1000, 2900, 150)) +
    theme_minimal() +
    theme(
        axis.text.y = element_blank(),
        panel.grid = element_blank()
    ) +
    labs(
        x = "Elo Rating System (Higher values indicate greater player strength)",
        y = "",
        title = "Elo Rating System of players in Chess Olympiad, 2022. Chennai, India ",
        caption = "Magnus Carlsen has the highest Elo rating in the tournament: 2864"
    ) +
    geom_text(
        data = players %>%
            filter(rtg > 2800),
        aes(
            x = 2550,
            y = 4.5,
            label = "Magnus Carlsen"
        ),
        size = 3,
        color = "black"
    ) +
    geom_curve(
        data = players %>% filter(rtg > 2800),
        aes(
            x = 2700,
            y = 4.4, xend = 2864.8,
            yend = 1
        ),
        arrow = arrow(length = unit(0.3, "cm")),
        color = "red",
        linewidth = 0.5,
        curvature = -0.5
    )

It may be interesting to plot the ELO ratings of players by federation, as the Chess Olympiad is played by national teams. By examining the ELO ratings of players within each federation, we can get a sense of the overall strength of the teams participating in the event. This analysis could potentially provide insight into the results of the Chess Olympiad and help predict the outcomes of matches.

players |>
    filter(rtg > 2600) |>
    ggplot(aes(reorder(fed, rtg), rtg)) +
    theme_minimal() +
    geom_boxplot() +
    coord_flip() +
    theme(panel.grid = element_blank()) +
    labs(x = "", y = "ELO")

According to ELO ratings, the United States fielded the strongest team in the tournament.

data("results")

Differences in ELO by round

The Chess Olympiad followed a Swiss-style tournament, meaning that players are paired with opponents with similar scores in each round. Specifically, in the first round, the highest-ranked player is matched against the median-ranked player, followed by the second-highest ranked player against the next below median, and so forth.

A visual representation of the differences in ELO by round are presented in the following graph.

results |>
    filter(
        elo_difference >= -1000,
        elo_difference <= 1000,
        !is.na(elo_white), !is.na(elo_black), elo_white != 0, elo_black != 0
    ) |>
    ggplot(aes(as.numeric(elo_white), elo_difference,
        fill = factor(result_white),
        color = factor(result_white)
    )) +
    geom_point(
        shape = 21, alpha = 0.85,
        size = 3, stroke = 0.5
    ) +
    theme_minimal() +
    scale_fill_manual(values = c("Lost" = "black", "Draw" = "gray50", "Won" = "white")) +
    scale_color_manual(values = c("Lost" = "black", "Draw" = "black", "Won" = "black")) +
    labs(
        fill = "Result", color = "Result",
        x = "Player Elo",
        y = "Elo difference",
        caption = "Difference greater than zero indicates stronger player
       44th Chess Olympiad. Chennai, 2022 Open"
    ) +
    facet_wrap(~round)

Model the winning chances for players with the white pieces based on ELO difference

Now, let’s try to identify the optimal divisions in ELO rating differences that could potentially classify the outcomes of chess games. For this, I will be using the tidymodels package to estimate a Classification and Regression Trees (CART) model.

cart_spec <-
    decision_tree() |>
    set_engine("rpart") |>
    set_mode("classification")

I will add two steps in the recipe. One to filter the data set by round, and the other to convert results in a factor variable. I also will limit my analysis to players with more than 1600 in ELO.

results <- results |>
    filter(as.numeric(elo_white) > 1600) |>
    filter(as.numeric(elo_black) > 1600)

recipe <- recipe(
    result_white ~ elo_difference + round_number,
    data = results
) |>
    step_filter(round_number == round)

wrkfl <- workflow() |>
    add_model(cart_spec) |>
    add_recipe(recipe)

Let’s estimate the model for the round 1.

round <- 1

cart_fit <- wrkfl |>
    fit(data = results) |>
    extract_fit_parsnip()

cart_fit <- repair_call(cart_fit, data = round)

cart_tree_fit <- cart_fit$fit

rpart.plot::rpart.plot(cart_tree_fit, roundint = FALSE)

Model the last round

Now, let’s apply the model to the final round, which featured matches between the most formidable opponents.

I will add a the tree_depth parameter to my model. The depth of the tree refers to the number of levels the tree has.

cart_spec <-
    decision_tree(tree_depth = 4) |>
    set_engine("rpart") |>
    set_mode("classification")

wrkfl <- workflow() |>
    add_model(cart_spec) |>
    add_recipe(recipe)

round <- 11

cart_fit <- wrkfl |>
    fit(data = results)

cart_fit <- wrkfl |>
    fit(data = results) |>
    extract_fit_parsnip()

cart_fit <- repair_call(cart_fit, data = round)

cart_tree_fit <- cart_fit$fit

rpart.plot::rpart.plot(cart_tree_fit, roundint = FALSE)

rpart.rules(cart_tree_fit, cover = TRUE)

  ..y  Dra Los Won                                       cover
 Draw [.45 .30 .25] when elo_difference is -176 to  85     51%
 Draw [.55 .09 .36] when elo_difference >=         333      4%
 Draw [.69 .15 .15] when elo_difference is   95 to 115      4%
 Lost [.29 .61 .10] when elo_difference <  -176            20%
  Won [.10 .30 .60] when elo_difference is   85 to  95      3%
  Won [.17 .20 .63] when elo_difference is  115 to 333     18%

The color-coding of the decision tree leaves suggests that differences in ELO ratings remain a critical factor, even in the final round of the chess tournament. It seems that the model is particularly adept at predicting outcomes when the ELO differences are substantial. For example, if you have more than 333 points in ELO, the model predicts 63% wining chances for you. However, if the ELO difference is less than 333 (but more than 115), the model predicts 55% of draw.

When the ELO difference is less than 115, the model’s predictions become more interesting. If a player has 176 points less than their opponent, the model is more likely to classify them as a loser (61%). However, if the ELO difference is less than 85 points, the player still has a good chance of winning the game. This could be seen as an indicator of the performance of some players with lower ELO ratings who are having a strong tournament. On the other hand, if the ELO difference is greater than 85 points, most of the chances are for a draw.

This serves as a quick demonstration of how the ChessOlympiad package can be utilized in predictive modeling.

Visit the app here