Recidivism <- 
  read.socrata("https://data.ojp.usdoj.gov/Courts/NIJ-s-Recidivism-Challenge-Full-Dataset/ynf5-u8nk/") %>% 
  na.omit()  # Remove rows with missing values

Recidivism <- Recidivism %>%
  mutate(Recidivism_numeric = ifelse(recidivism_within_3years == "true", 1, 0))
glimpse(Recidivism)

Potential Predictors

Explore various variables of interest to examine the relationship between the possibility of recidivism and each variable individually.

1. Demographic Features

Recidivism %>%
    dplyr::select(recidivism_within_3years, gender,race, education_level, education_level, dependents, employment_exempt, residence_changes) %>%
    gather(Variable, value, -recidivism_within_3years) %>%
    count(Variable, value, recidivism_within_3years) %>%
      ggplot(., aes(value, n, fill = recidivism_within_3years)) +   
        geom_bar(position = "dodge", stat="identity") +
        facet_wrap(~Variable, scales="free", ncol = 3) +
        scale_fill_manual(values = palette2) +
        labs(x="recidivism_within_3years", y="Value",
             title = "Feature associations with the likelihood of recidivism within 3 years",
             subtitle = "Categorical features") +
        theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
      theme_minimal() + theme(legend.position = "none")

Individuals with no dependents appear to have a higher likelihood of reoffending within three years, with the trend showing a decrease in the rate of recidivism as the number of dependents increases. Educational attainment is inversely related to recidivism: those with higher education levels are less likely to commit crimes initially and subsequently have a lower probability of re-offending, while individuals with a high school diploma or less exhibit a higher potential for recidivism. The data indicates that the incidence of crime is lower among females than males, with males also showing a higher tendency to reoffend. Additionally, the records suggest that Black individuals have a higher rate of initial criminal activity and a greater likelihood of committing crimes again within a three-year span. Those who are not employment exempt are more likely to re-offend, suggesting that being in regular employment may be a factor in reducing the likelihood of recidivism. Also, those with fewer residence changes are less likely to re-offend, and an increase in residence changes correlates with a higher likelihood of re-offending

2. Drug Use and Employment Status

Recidivism %>%
    dplyr::select(recidivism_within_3years, jobs_per_year, percent_days_employed, supervision_risk_score_first, avg_days_per_drugtest, drugtests_thc_positive, drugtests_cocaine_positive, drugtests_meth_positive, drugtests_other_positive) %>%
    gather(Variable, value, -recidivism_within_3years) %>%
    ggplot() + 
    geom_density(aes(value, color=recidivism_within_3years), fill = "transparent") + 
    facet_wrap(~Variable, scales = "free", ncol = 4) +
    scale_colour_manual(values = palette2) +
    labs(x="Value", y="Density",
         title = "Feature Distribution with the likelihood of recidivism within 3 years",
         subtitle = "(continous outcomes)") +
      theme_minimal() + theme(legend.position = "none")

The chart illustrates a discernible correlation between drug use and the likelihood of recidivism within three years. Individuals who have tested positive for substances such as cocaine, methamphetamine, THC, and other drugs are shown to have a higher likelihood of re-offending. This suggests that drug use is a significant factor in recidivism, with positive drug tests acting as a potential indicator of future criminal behavior. The frequency of drug testing also seems to play a role; less frequent testing (or fewer average days between tests) is associated with a lower chance of recidivism, though this may also reflect supervision strategies and their effectiveness.

In contrast, the employment-related variables present a more complex picture. The data indicates that having more jobs per year unexpectedly correlates with a higher likelihood of recidivism, a finding that could suggest instability in employment. However, a higher percentage of days employed correlates with a lower likelihood of recidivism, emphasizing the stabilizing effect steady employment can have on reducing criminal behavior. Regarding supervision, the initial risk score is notably associated with recidivism probabilities; a higher supervision risk score at the outset indicates a stronger likelihood of re-offending. This could reflect the accuracy of risk assessments in predicting recidivism and underscores the importance of effective supervision in mitigating this risk.

Create Logistic Regression Model

set.seed(3456)
trainIndex <- createDataPartition(Recidivism$recidivism_within_3years, p = .50,
                                  list = FALSE,
                                  times = 1)
RecidivismTrain <- Recidivism[ trainIndex,]
RecidivismTest  <- Recidivism[-trainIndex,]


RecidivismModel <- glm(Recidivism_numeric ~ .,
                  data=RecidivismTrain %>% 
                    dplyr::select(Recidivism_numeric,jobs_per_year,percent_days_employed, supervision_risk_score_first, prison_years, condition_cog_ed,condition_mh_sa, condition_other, gang_affiliated,prior_arrest_episodes_violent, prior_arrest_episodes_property, violations, violations_instruction, violations_failtoreport, violations_1, delinquency_reports,program_attendances, program_unexcusedabsences, residence_changes,  prior_arrest_episodes_drug,prior_arrest_episodes,prior_revocations_parole,prior_revocations_probation, avg_days_per_drugtest,drugtests_thc_positive,drugtests_cocaine_positive,drugtests_meth_positive,drugtests_other_positive,gender,race, age_at_release, residence_puma,education_level, dependents, prison_offense),
                  family="binomial" (link="logit"))

Recidivism_sum <- summary(RecidivismModel)

coefficients_table <- as.data.frame(Recidivism_sum$coefficients)

coefficients_table$significance <- ifelse(coefficients_table$`Pr(>|z|)` < 0.001, '***',
                                         ifelse(coefficients_table$`Pr(>|z|)` < 0.01, '**',
                                                ifelse(coefficients_table$`Pr(>|z|)` < 0.05, '*',
                                                       ifelse(coefficients_table$`Pr(>|z|)` < 0.1, '.', ''))))

coefficients_table$p_value <- paste0(round(coefficients_table$`Pr(>|z|)`, digits = 3), coefficients_table$significance)

coefficients_table %>%
  select(-significance, -`Pr(>|z|)`) %>% 
  kable(align = "r") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))  %>%
  footnote(general_title = "\n", general = "Table 1")
Estimate Std. Error z value p_value
(Intercept) -0.8784461 0.1890311 -4.6470989 0***
jobs_per_year 0.4623796 0.0392253 11.7877987 0***
percent_days_employed -1.9555342 0.0775564 -25.2143659 0***
supervision_risk_score_first 0.0336102 0.0130368 2.5781063 0.01**
prison_yearsGreater than 2 to 3 years -0.1800728 0.0722036 -2.4939600 0.013*
prison_yearsLess than 1 year 0.1599014 0.0669325 2.3889942 0.017*
prison_yearsMore than 3 years -0.0195576 0.0741412 -0.2637887 0.792
condition_cog_edtrue -0.0183859 0.0530013 -0.3468954 0.729
condition_mh_satrue 0.3588647 0.0566231 6.3377811 0***
condition_othertrue -0.0310762 0.0598448 -0.5192806 0.604
gang_affiliatedfalse 0.5651538 0.0754423 7.4912065 0***
gang_affiliatedtrue 1.3158422 0.1027182 12.8102178 0***
prior_arrest_episodes_violent1 0.0737675 0.0598217 1.2331224 0.218
prior_arrest_episodes_violent2 0.2675999 0.0779423 3.4333093 0.001***
prior_arrest_episodes_violent3 or more 0.2134832 0.0828295 2.5773807 0.01**
prior_arrest_episodes_property1 0.1966578 0.0713686 2.7555232 0.006**
prior_arrest_episodes_property2 0.4086290 0.0797314 5.1250697 0***
prior_arrest_episodes_property3 0.3720791 0.0924320 4.0254349 0***
prior_arrest_episodes_property4 0.4608734 0.1071962 4.2993428 0***
prior_arrest_episodes_property5 or more 0.7974360 0.0898633 8.8738806 0***
violationstrue 0.3955063 0.0932012 4.2435758 0***
violations_instructiontrue 0.1925954 0.0680219 2.8313752 0.005**
violations_failtoreporttrue 0.0501159 0.0941792 0.5321339 0.595
violations_1true -0.1683558 0.0777116 -2.1664182 0.03*
delinquency_reports1 0.5213898 0.1229419 4.2409457 0***
delinquency_reports2 -0.1407398 0.1107683 -1.2705779 0.204
delinquency_reports3 -0.3751349 0.1111540 -3.3749116 0.001***
delinquency_reports4 or more -0.5632829 0.0740423 -7.6075870 0***
program_attendances1 -0.1436903 0.1266184 -1.1348293 0.256
program_attendances10 or more -0.3775369 0.0834174 -4.5258748 0***
program_attendances2 -0.0596856 0.1357218 -0.4397640 0.66
program_attendances3 0.0042865 0.1501560 0.0285468 0.977
program_attendances4 -0.1218934 0.1382853 -0.8814635 0.378
program_attendances5 0.1743027 0.1112211 1.5671731 0.117
program_attendances6 -0.1434023 0.0762256 -1.8812877 0.06.
program_attendances7 -0.1351295 0.1299037 -1.0402281 0.298
program_attendances8 -0.0211937 0.1711855 -0.1238053 0.901
program_attendances9 -0.1498123 0.1726546 -0.8676992 0.386
program_unexcusedabsences1 0.1858447 0.0966956 1.9219568 0.055.
program_unexcusedabsences2 0.1653455 0.1181284 1.3997104 0.162
program_unexcusedabsences3 or more 0.1105294 0.0921730 1.1991513 0.23
residence_changes1 0.1158049 0.0585297 1.9785668 0.048*
residence_changes2 0.1232990 0.0729418 1.6903752 0.091.
residence_changes3 or more 0.3785775 0.0800881 4.7270157 0***
prior_arrest_episodes_drug1 0.0540949 0.0697180 0.7759096 0.438
prior_arrest_episodes_drug2 0.2197247 0.0786714 2.7929429 0.005**
prior_arrest_episodes_drug3 0.3162809 0.0921623 3.4317803 0.001***
prior_arrest_episodes_drug4 0.1943453 0.1055838 1.8406732 0.066.
prior_arrest_episodes_drug5 or more 0.2744439 0.0959939 2.8589727 0.004**
prior_arrest_episodes1 0.2282423 0.0757574 3.0128065 0.003**
prior_arrest_episodes2 0.4121426 0.0835732 4.9315139 0***
prior_arrest_episodes3 0.4568621 0.0907495 5.0343185 0***
prior_arrest_episodes4 0.6543624 0.0999763 6.5451779 0***
prior_arrest_episodes5 or more 0.7660882 0.0851203 9.0000597 0***
prior_revocations_paroletrue 0.4591914 0.0885278 5.1869726 0***
prior_revocations_probationtrue -0.1419800 0.0696072 -2.0397316 0.041*
avg_days_per_drugtest 0.0003659 0.0002158 1.6959089 0.09.
drugtests_thc_positive 0.9245708 0.2111671 4.3783858 0***
drugtests_cocaine_positive 0.1892071 0.3970664 0.4765124 0.634
drugtests_meth_positive 3.1605122 0.6077703 5.2001757 0***
drugtests_other_positive 1.4141523 0.6642662 2.1288941 0.033*
raceWHITE 0.1466630 0.0555534 2.6400349 0.008**
age_at_release23-27 -0.2120736 0.1021573 -2.0759511 0.038*
age_at_release28-32 -0.5169631 0.1089386 -4.7454519 0***
age_at_release33-37 -0.6842437 0.1167416 -5.8611811 0***
age_at_release38-42 -0.8624687 0.1273557 -6.7721259 0***
age_at_release43-47 -0.9273167 0.1334014 -6.9513269 0***
age_at_release48 or older -1.3359129 0.1346790 -9.9192379 0***
residence_puma 0.0104192 0.0033690 3.0926963 0.002**
education_levelHigh School Diploma 0.1679275 0.0674960 2.4879620 0.013*
education_levelLess than HS diploma 0.0147698 0.0704998 0.2095010 0.834
dependents1 0.1038193 0.0668149 1.5538342 0.12
dependents2 0.0696932 0.0711952 0.9789038 0.328
dependents3 or more 0.0967184 0.0626891 1.5428272 0.123
prison_offenseDrug 0.0083215 0.0858005 0.0969864 0.923
prison_offenseOther 0.1470066 0.0992806 1.4807188 0.139
prison_offenseProperty 0.0501837 0.0889608 0.5641098 0.573
prison_offenseViolent/Non-Sex 0.1116873 0.0989390 1.1288502 0.259
prison_offenseViolent/Sex -0.0801199 0.1629383 -0.4917194 0.623

Table 1

From the above table we can tell that:

1. Gang Affiliated

Gang affiliation significantly increases the risk of reoffending.

2.Prison Years

Serving a prison sentence of more than 2 to 3 years is associated with a reduced risk of recidivism, while sentences of less than one year may lead to a higher risk.

3.Employment

Individuals who have more jobs in a year are more likely to engage in recidivism, possibly due to instability or low job quality.individuals who are employed for a higher percentage of days are less likely to engage in recidivism, implying that stable employment may be a protective factor against recidivism.

4.Programs

High attendance in rehabilitation or support programs may be positively correlated with lower recidivism rates, as it could indicate an individual’s commitment to rehabilitation. Unexcused absences might be negatively correlated with successful rehabilitation, potentially indicating a lack of engagement with the program, which could be a risk factor for re-offending.

5.Drug

Positive drug tests, especially for THC and methamphetamine, are associated with an increased likelihood of recidivism.It could reflect the severity of drug habits or other social and economic factors tied to drug use that influence the likelihood of re-engagement in criminal behavior.

Examine the Model Performance

pR2(RecidivismModel)

#Kable to show the result

fit_metrics <- pR2(RecidivismModel)
fit_metrics_df <- as.data.frame(t(fit_metrics))
kable(fit_metrics_df, caption = "Fit Metrics for Logistic Regression Model", align = 'r', digits = 4) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  footnote(general_title = "\n", general = "Table 2")
Fit Metrics for Logistic Regression Model
llh llhNull G2 McFadden r2ML r2CU
-5378.551 -6637.76 2518.417 0.1897 0.2278 0.3062

Table 2

McFadden’s pseudo-R-squared of approximately 0.1897, or 18.97%, indicates that the model explains a moderate proportion of the variance in recidivism. This value suggests that while the model has some explanatory power, there are other factors not included in the model that also affect the likelihood of recidivism.

Distribution of Predicted Probabilities

testProbs <- data.frame(Outcome = as.factor(RecidivismTest$Recidivism_numeric),
                        Probs = predict(RecidivismModel, RecidivismTest, type= "response"),
                        gender = RecidivismTest$gender,
                        race = RecidivismTest$race)

ggplot(testProbs, aes(x = Probs, fill = as.factor(Outcome))) + 
  geom_density() +
  facet_grid(Outcome ~ .) +
  scale_fill_manual(values = palette2) +
  labs(x = "Click", y = "Density of probabilities",
       title = "Distribution of predicted probabilities by observed outcome") +
  theme(strip.text.x = element_text(size = 18),
        legend.position = "none") +
      theme_minimal() + theme(legend.position = "none")

This chart shows a promising degree of discriminating power in the model, as evidenced by the presence of peaks suggesting a concentration of true positives (red area towards the right) and true negatives (purple area towards the left). Although there is some overlap between the predicted probabilities for the two classes, which suggests areas where the model’s predictions are less certain, the separation between the peaks indicates the model is capturing a meaningful difference between the outcomes.

Equity Examination

testProbs <- testProbs %>%
  mutate(
    predOutcome = as.factor(ifelse(Probs > 0.5, 1, 0)),
    error = ifelse(predOutcome == as.character(Outcome), 0, 1)
  )


race_difference <- testProbs %>% 
  group_by(race, gender) %>%
  summarize(total_error = sum(error),
            total_people = n()) %>%
  mutate(percent_error = total_error / total_people) 

race_difference %>% 
  kable(align = "r") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))  %>%
  footnote(general_title = "\n", general = "Table 3")
race gender total_error total_people percent_error
BLACK F 114 398 0.2864322
BLACK M 1515 5164 0.2933772
WHITE F 242 827 0.2926239
WHITE M 950 3349 0.2836668

Table 3

From the table, it appears that the error rates are relatively similar across all subgroups, ranging from approximately 28.4% to 29.4%. This suggests that there is not a substantial difference in error rates between the different groups based on race and gender alone, which could indicate that the model performs with relatively uniform accuracy across these subgroups.

Confusion Matrix

A “confusion matrix” for the threshold of 50% shows us the rate at which we got True Positives (aka Sensitivity), False Positives, True Negatives (aka Specificity) and False Negatives for that threshold.

cm <- confusionMatrix(testProbs$predOutcome, testProbs$Outcome, positive = "1")

# Extract the table from the confusion matrix object
cm_table <- cm$table

# Extract the statistics from the confusion matrix object
cm_stats <- cm$byClass
overall_stats <- cm$overall
# Combine them into one data frame for kable
stats_df <- data.frame(Statistic = c(names(overall_stats), names(cm_stats)),
                       Value = c(overall_stats, cm_stats))
kable(stats_df, caption = "Statistics of the Model", align = 'r') %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  footnote(general_title = "\n", general = "Table 4")
Statistics of the Model
Statistic Value
Accuracy Accuracy 0.7103101
Kappa Kappa 0.3990854
AccuracyLower AccuracyLower 0.7011873
AccuracyUpper AccuracyUpper 0.7193071
AccuracyNull AccuracyNull 0.5761963
AccuracyPValue AccuracyPValue 0.0000000
McnemarPValue McnemarPValue 0.0000000
Sensitivity Sensitivity 0.7845304
Specificity Specificity 0.6094015
Pos Pred Value Pos Pred Value 0.7319588
Neg Pred Value Neg Pred Value 0.6753491
Precision Precision 0.7319588
Recall Recall 0.7845304
F1 F1 0.7573333
Prevalence Prevalence 0.5761963
Detection Rate Detection Rate 0.4520435
Detection Prevalence Detection Prevalence 0.6175806
Balanced Accuracy Balanced Accuracy 0.6969659

Table 4

The model correctly predicts the outcome 71.03% of the time and We can be 95% confident that the true accuracy of the model is between 70.12% and 71.93%. p value and kappa value also suggest that accuracy of the model is better than what would be achieved by always predicting the most frequent class.

Sensitivity measures the proportion of actual positive cases (recidivism) that the model correctly identifies. A sensitivity of 0.7845, or 78.45%, means that out of all the individuals who did recidivist, the model correctly identified approximately 78.45% of them. This is a fairly high rate, indicating the model’s strength in capturing those at risk of recidivism. Specificity measures the proportion of actual negative cases (non-recidivism) that the model correctly identifies. A specificity of 0.6094, or 60.94%, indicates that out of all the individuals who did not recidivist, the model correctly identified about 60.94% of them as not being at risk. The specificity is lower than the sensitivity, which suggests that the model is somewhat less adept at correctly identifying those who will not recidivist.

In conclusion, the model is effective at identifying individuals who will recidivate but could benefit from improvements in accurately identifying those who will not.

mosaicplot(cm$table, color=c("maroon","mistyrose"), main = "Mosaic Plot for Original Confusion Matrix",
           xlab = "Prediction", ylab = "Reference")

# Create the kable tables
kable(cm_table, caption = "Confusion Matrix") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Confusion Matrix
0 1
0 2515 1209
1 1612 4402

True Negatives (TN): 2515 - The model correctly predicted the negative class 2515 times. False Negatives (FN): 1209 - The model incorrectly predicted the negative class 1209 times when it was actually positive. False Positives (FP): 1612 - The model incorrectly predicted the positive class 1612 times when it was actually negative. True Positives (TP): 4402 - The model correctly predicted the positive class 4402 times.

ROC Curve

ggplot(testProbs, aes(d = as.numeric(Outcome), m = Probs)) +
  geom_roc(n.cuts = 50, labels = FALSE, colour = "maroon") +
  style_roc(theme = theme_grey) +
  geom_abline(slope = 1, intercept = 0, size = 1.5, color = 'grey') +
  labs(title = "ROC Curve - clickModel") +
      theme_minimal() + theme(legend.position = "none")

The curve rises steeply towards the upper-left corner of the plot, which shows that the model has a strong true positive rate before accruing false positives.

auc_value <- auc(testProbs$Outcome, testProbs$Probs)

# Create a data frame to hold the AUC value
auc_df <- data.frame(AUC = auc_value)

# Use kable to create a table of the AUC value
kable(auc_df, caption = "AUC for the Model", align = 'c') %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
AUC for the Model
AUC
0.774741

An AUC of 0.7747 means that there is a 77.47% chance that the model will be able to distinguish between a randomly chosen positive instance (one that actually did recidivate) and a negative instance (one that did not recidivate).

Cross validation

ctrl <- trainControl(method = "cv", number = 100, classProbs=TRUE, summaryFunction=twoClassSummary)

cvFit <- train(recidivism_within_3years ~ .,
                  data=Recidivism %>% 
                  dplyr::select(recidivism_within_3years,jobs_per_year,percent_days_employed, supervision_risk_score_first, prison_years, condition_cog_ed,condition_mh_sa, condition_other, gang_affiliated,prior_arrest_episodes_violent, prior_arrest_episodes_property, violations, violations_instruction, violations_failtoreport, violations_1, delinquency_reports,program_attendances, program_unexcusedabsences, residence_changes,  prior_arrest_episodes_drug,prior_arrest_episodes,prior_revocations_parole,prior_revocations_probation, avg_days_per_drugtest,drugtests_thc_positive,drugtests_cocaine_positive,drugtests_meth_positive,drugtests_other_positive,gender,race, age_at_release, residence_puma,education_level, dependents, prison_offense), 
                method="glm", family="binomial",
                metric="ROC", trControl = ctrl)

cvFit
cv_results_df <- data.frame(
  Metric = c("ROC", "Sensitivity", "Specificity"),
  Value = c(0.7755273, 0.6070555, 0.7949881)
)

# Use kable to create a formatted table of the results
kable(cv_results_df, caption = "Cross-Validation Metrics", align = 'c') %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Cross-Validation Metrics
Metric Value
ROC 0.7755273
Sensitivity 0.6070555
Specificity 0.7949881

The AUC from the cross-validated model is 0.7751, which is slightly higher than the previously mentioned AUC of 0.7747. This suggests that the model’s ability to discriminate between the positive and negative classes is consistent and robust across different subsets of the data.

The cross-validated sensitivity is lower than the previously mentioned sensitivity of 0.7845. This indicates that, across various folds, the model’s ability to correctly identify true positives (actual cases of recidivism) is somewhat less than what was observed in the initial result. The specificity is higher than the initially mentioned specificity of 0.6094. This implies that the model has a better ability to correctly identify true negatives (actual cases of non-recidivism) when evaluated under the cross-validation process.

Comparatively, the cross-validated results provide a more reliable estimate of the model’s performance since cross-validation reduces bias from any potential overfitting to a single test set. The differences in the cross-validated sensitivity and specificity compared to the initial results suggest that the model may be more conservative in predicting positive cases (recidivism) but is quite robust in correctly identifying negative cases (non-recidivism) across different subsamples of the dataset.

The trade-off between sensitivity and specificity

Sensitivity (also known as the true positive rate or recall) refers to the model’s ability to correctly identify repeat offenders. Specificity (also known as the true negative rate) refers to the model’s ability to correctly identify non-repeat offenders. In the criminal justice system, prioritizing sensitivity means we are more likely to identify potential repeat offenders, but this can also lead to more false positives (i.e., incorrectly labeling someone as likely to reoffend). Prioritizing specificity, on the other hand, reduces the number of false positives but increases the risk of false negatives (i.e., failing to identify someone who will actually reoffend).

The costs and consequences of prioritizing sensitivity

This could lead to more people being unfairly monitored or retained in prison, not only affecting individual freedom but also increasing social and economic costs, especially for lower socioeconomic and marginalized groups.

The costs and consequences of prioritizing specificity

This could lead to more individuals with a risk of reoffending being released, increasing the risk of societal recidivism, but it also reduces unfair treatment of individuals and social costs.

dplyr::select(cvFit$resample, -Resample) %>%
  gather(metric, value) %>%
  left_join(gather(cvFit$results[2:4], metric, mean)) %>%
  ggplot(aes(value)) + 
    geom_histogram(bins=35, fill = "mistyrose2") +
    facet_wrap(~metric) +
    geom_vline(aes(xintercept = mean), colour = "maroon", linetype = 2, size = 0.9) +
    scale_x_continuous(limits = c(0, 1)) +
    labs(x="Goodness of Fit", y="Count", title="CV Goodness of Fit Metrics",
         subtitle = "Across-fold mean reprented as dotted lines") +
      theme_minimal() + theme(legend.position = "none")

The ROC metric on the chart indicates the model’s ability to discriminate between the positive and negative classes. With the dotted line representing an across-fold mean ROC of approximately 0.775, the model demonstrates a reasonable level of discriminative power. This means that, on average, the model has a 77.5% chance of correctly distinguishing between a positive and a negative outcome. The concentration of histogram bars near this dotted line also suggests a consistent performance across different folds of the cross-validation process.

In terms of sensitivity, the model exhibits an average true positive rate of around 0.61, as depicted by the dotted line on the histogram. This indicates that the model correctly identifies 61% of actual positive instances. While the majority of the histogram bars are skewed towards the higher end, indicating a tendency to correctly detect positive instances, there is a visible variance across the folds, which could imply room for improvement in capturing true positives consistently.

Specificity measures the model’s accuracy in predicting negative instances. The histogram and its dotted line average at approximately 0.795 suggest that the model successfully identifies negative cases about 79.5% of the time. This skew towards higher specificity values reveals that the model is generally effective at recognizing true negatives, which is particularly important in scenarios where false positives carry a high cost.

Cost-Benefit Calculation

States spent an average of $45771 per prisoner for the year. https://usafacts.org/articles/how-much-do-states-spend-on-prisons/

https://csgjusticecenter.org/publications/the-cost-of-recidivism/ 8000000000/193000 = 41450.78

cost_benefit_table <-
   testProbs %>%
      count(predOutcome, Outcome) %>%
      summarize(True_Negative = sum(n[predOutcome==0 & Outcome==0]),
                True_Positive = sum(n[predOutcome==1 & Outcome==1]),
                False_Negative = sum(n[predOutcome==0 & Outcome==1]),
                False_Positive = sum(n[predOutcome==1 & Outcome==0])) %>%
       gather(Variable, Count) %>%
       mutate(Revenue =
               ifelse(Variable == "True_Negative", Count * 0,
               ifelse(Variable == "True_Positive",((45771) * Count),
               ifelse(Variable == "False_Negative", (41450.78) * Count,
               ifelse(Variable == "False_Positive", (-45771) * Count, 0))))) %>%
    bind_cols(data.frame(Description = c(
              "We correctly predicted no recidivism",
              "We correctly predicted recidivism",
              "We predicted no recidivism but get recidivism",
              "We predicted recidivism but get no recidivism")))

kable(cost_benefit_table,
       caption = "Cost/Benefit Table") %>% kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
Cost/Benefit Table
Variable Count Revenue Description
True_Negative 2515 0 We correctly predicted no recidivism
True_Positive 4402 201483942 We correctly predicted recidivism
False_Negative 1209 50113993 We predicted no recidivism but get recidivism
False_Positive 1612 -73782852 We predicted recidivism but get no recidivism

True Positives (TP): The model correctly predicted recidivism 4,402 times, with an associated benefit of 20,148,394 per instance. This benefit likely represents the economic savings from preventing further crimes, such as the costs of potential law enforcement, legal proceedings, victim damages, and societal impacts that would result from those crimes. True Negatives (TN): There were 2,515 instances where the model correctly predicted no recidivism, which carries no direct economic impact in this analysis since it’s the expected and desired outcome without any further costs or benefits associated. False Negatives (FN): The model failed to predict recidivism 1,209 times, resulting in costs of 50,113,993 per instance. These costs are probably attributable to the actual crimes committed due to not detaining the individual, subsequent legal and incarceration costs, and the broader societal costs of those crimes. False Positives (FP): The model incorrectly predicted recidivism 1,612 times, which resulted in a significant cost of -73,782,852 per instance. These costs might include the unjust loss of freedom for the individual, the economic cost of unnecessary incarceration, and possibly the indirect social costs associated with a false prediction.

From an economic standpoint, the model’s predictive inaccuracies, especially the false positives, are a significant liability. It implies that if parole decisions were made solely based on this model’s predictions, the economic burden due to the cost of false positives would outweigh the benefits of correctly predicting true positives.

For improving decision-making, it would be crucial to adjust the predictive threshold to balance the economic trade-offs between false positives and false negatives. Ideally, the threshold would minimize the total combined cost of false predictions. It’s important to note that such an analysis is purely economic and doesn’t consider the moral, ethical, and legal dimensions of criminal justice decisions, which are paramount when dealing with human lives and freedoms.

Optimize Thresholds

iterateThresholds <- function(data) {
  x = .01
  all_prediction <- data.frame()
  while (x <= 1) {
  
  this_prediction <-
      testProbs %>%
      mutate(predOutcome = ifelse(Probs > x, 1, 0)) %>%
      count(predOutcome, Outcome) %>%
      summarize(True_Negative = sum(n[predOutcome==0 & Outcome==0]),
                True_Positive = sum(n[predOutcome==1 & Outcome==1]),
                False_Negative = sum(n[predOutcome==0 & Outcome==1]),
                False_Positive = sum(n[predOutcome==1 & Outcome==0])) %>%
     gather(Variable, Count) %>%
     mutate(Revenue =
               ifelse(Variable == "True_Negative", Count * 0,
               ifelse(Variable == "True_Positive",((.35 - .1) * Count),
               ifelse(Variable == "False_Negative", (-0.35) * Count,
               ifelse(Variable == "False_Positive", (-0.1) * Count, 0)))),
            Threshold = x)
  
  all_prediction <- rbind(all_prediction, this_prediction)
  x <- x + .01
  }
return(all_prediction)
}

whichThreshold <- iterateThresholds(testProbs2)

whichThreshold_revenue <- 
whichThreshold %>% 
    group_by(Threshold) %>% 
    summarize(Revenue = sum(Revenue))

  ggplot(whichThreshold_revenue)+
  geom_line(aes(x = Threshold, y = Revenue))+
  geom_vline(xintercept =  pull(arrange(whichThreshold_revenue, -Revenue)[1,1]))+
    labs(title = "Model Revenues By Threshold For Test Sample",
         subtitle = "Vertical Line Denotes Optimal Threshold") +
      theme_minimal()

The vertical line, which represents the optimal threshold, appears to be just over the 0.2 mark on the x-axis. This is the point at which the economic outcome of the model’s predictions is maximized.

To the left of the vertical line, the revenue is positive, indicating a net economic benefit. However, as the threshold increases past the optimal point, the revenue begins to decline, eventually turning negative, suggesting that the model’s predictions become less economically viable.The curve shows that as the threshold for predicting recidivism increases, the net economic revenue initially increases but then starts to decrease sharply after crossing the optimal threshold. This indicates that setting the threshold either too low or too high results in diminishing returns.

Lower thresholds result in the model predicting more individuals as recidivists, which could lead to higher costs due to more false positives. Higher thresholds, conversely, mean fewer recidivism predictions, potentially resulting in more false negatives and missed opportunities to prevent the costs associated with recidivism. The optimal threshold strikes a balance, minimizing both types of errors in terms of their economic consequences.

Memo

Target Intervention Programs:

Focus on individuals with gang affiliations by developing specialized intervention programs that address the unique challenges and circumstances faced by these individuals.

Adjust Sentencing Guidelines:

Review and possibly revise sentencing guidelines to consider the duration of sentences, as serving a prison sentence of more than 2 to 3 years is associated with a reduced risk of recidivism.

Promote Stable Employment:

Encourage policies that foster job stability, as stable employment has been identified as a protective factor against recidivism. Support initiatives that provide job training and placement services tailored to individuals at risk of recidivism.

Rehabilitation and Support:

Ensure that rehabilitation programs have high engagement rates and address unexcused absences proactively. Consider mandating participation in such programs for parolees or providing incentives for attendance.

Substance Abuse Treatment:

Implement or bolster drug treatment programs, especially those targeting THC and methamphetamine use, given the association between positive drug tests for these substances and increased recidivism rates.

Data-Driven Parole Decisions:

Use the model as a supportive tool in parole decision-making, integrating it with a comprehensive review process that includes both quantitative and qualitative assessments.

Continuous Model Evaluation:

Regularly review and update the predictive model to reflect current data and trends, ensuring its accuracy and relevance in policy decisions. Ethical Considerations: Balance the model’s economic implications with ethical consider

Adjust the Prediction Threshold:

Set the threshold at the identified optimal level to maximize the economic benefit while minimizing potential harm. The vertical line on the revenue chart suggests the best balance between reducing the costs associated with false predictions and maximizing true positive outcomes.