---
title: "Preliminary Statewide Geospatial Maps"
author: "<a href=https://justice.utah.gov//>By CCJJ</a>"
output: 
  flexdashboard::flex_dashboard:
    social: menu
    source: embed
    theme: yeti
---

```{r include = FALSE}
knitr::opts_chunk$set(echo = FALSE)
htmltools::tagList(rmarkdown::html_dependency_font_awesome())
knitr::opts_chunk$set(widgetframe_widgetsdir = 'widgets')
```


```{js logo-js, echo=FALSE}
$(document).ready(function() {
  $('#header').parent().prepend('<div id=\"logo\"><a href ="https://justice.utah.gov/"><img src=\"https://justice.utah.gov/wp-content/uploads/ccjjlogo1.png\" style=\"position:absolute; right:0; padding:0px; height:160px\"></div>');
  $('#header').css('margin-right', '320px')
});

```

  
```{r message = FALSE, warning =FALSE}
mainDir1 <- "/Volumes/DATA/Shared/Justice/Research/Juvenile Data & Reforms/Geospatial Studies"
setwd(mainDir1)

library("readxl")
library("dplyr")
library("aod")
library("ggplot2")
library("scales")
library("ggrepel")
library("ggthemes")
library("ggpubr")
library("knitr")
library("kableExtra")
library("flexdashboard")
library("echarts4r")
library("DT")
library("fontawesome")
library("plotly")
library("viridis")
library("data.table")
library("wesanderson")
library("tigris")
library("leaflet")
library("tidyverse")
library("stringr")
library("sf")
library("here")
library("widgetframe")
library("lattice")
library("leaflet.extras")
library("R.utils")
library("viridis")
library("psych")

```

Introduction
==================

<div Style="margin-right: 300px"> 
<div Style="margin-top: 20px"> 
<div Style="margin-left: 100px"> 

The Juvenile Justice Oversight Committee (JJOC) was created within the Commission on Criminal and Juvenile Justice and is statutorily responsible for overseeing the implementation of the juvenile reform efforts and for gathering and analyzing data that measures the impact of the policy changes. Reform policies elevated the use of evidence-based programs and practices in Utah's juvenile justice system.

The latest 2024 Juvenile Reform Annual Report indicates trends in Utah’s Juvenile Justice system are continuing to move in a direction that aligns with policy goals. This year’s findings indicate that there is a decrease in Court Referrals in FY 2024 paired with a continued high rate of successful completion of diversion interventions. Further, Utah sees a decrease in locked detention admissions and continues to see a low rate of Community Placement and Secure Care admissions. While the share of these trends at these various points have remained stable for both minority and nonminority youth in FY 2024, an area to continue keeping at the forefront is the overall disproportionate representation of minority youth in the juvenile justice system. Particularly at the front end, before a youth has contact with the system.

The challenge of juvenile justice lies at the intersection of public safety, racial and ethnic inequality, and public health where improving the outcomes and lives of the juvenile justice-involved population and their communities must occur with the full understanding of what underlies the risks and maladaptive outcomes that have led to their system involvement in the first place. Gaining a better understanding of the factors (neighborhood and community factors) that impacts system involvement will help inform policy makers to invest in areas where communities can benefit from prevention efforts and build protective factors that will deter youths from a pathway to offending.

</div>
</div>
</div>

Study Purpose
==================

<div Style="margin-right: 300px"> 
<div Style="margin-top: 20px"> 
<div Style="margin-left: 100px"> 

The Statewide Geospatial Study is Phase 2 from the Salt Lake County Geospatial Study. The Statewide study will focus on finding how juvenile offenses (court referrals) are spatially distributed across the state by race and ethnicity, what neighborhood risks are associated with rates of juvenile offenses (per census tract), and what neighborhood resources are associated with rates of juvenile offenses (per census tract). 

Results from the study shall be presented to JJOC and interested stakeholders.

The following preliminary maps shows descriptive information in the following areas: 

- Overall Episode Referral Rate
- Overall Episode Referral Rate by Unique Number of Kids
- Serious Offenses Referral Rate
- Serious Offenses Percentage Share
- Felony Episode Referral Rate
- Felony Episode Percentage Share
- Petitioned Rate
- Petitioned Percentage Share
- High and Moderate Risk Referral Rate
- High and Moderate Risk Percentage Share


</div>
</div>
</div>



ACS Census Survey
==================

<div Style="margin-right: 300px"> 
<div Style="margin-top: 20px"> 
<div Style="margin-left: 100px"> 

The acs5 survey in the tidycensus package refers to the 5-Year American Community Survey (ACS) estimates. The ACS is a program by the U.S. Census Bureau that provides detailed demographic, social, economic, and housing data. The 5-Year ACS provides estimates that are based on data collected over a five-year period, offering a more comprehensive view of characteristics at smaller geographic levels compared to the 1-Year ACS.

Key Points about ACS5

- Coverage Period: The ACS5 estimates are based on data collected over a five-year period. For example, the 2020 ACS5 data covers the years 2016 through 2020. This extended time frame helps to provide more reliable estimates, especially for smaller geographic areas or for variables with smaller populations.

- Geographic Detail: The 5-Year ACS data allows for estimates at a more granular geographic level compared to the 1-Year ACS, including census tracts, block groups, and places. This makes it useful for detailed local analyses.

- Data Reliability: Because it aggregates data over a longer period, the ACS5 estimates tend to have lower margins of error compared to the 1-Year estimates, particularly for less populous areas or for detailed topics.

- Variables: The ACS5 dataset includes a wide range of variables covering demographic, housing, social, and economic characteristics. You can request specific variables or tables when using the get_acs function.

</div>
</div>
</div>

Unmatched Addresses
==================

<div Style="margin-right: 300px"> 
<div Style="margin-top: 20px"> 
<div Style="margin-left: 100px"> 

- Original data file with addresses had 42,980 rows. Initial geocoding produced 37,745 matches and 5,235 no matches

- We checked for bad addresses and made some major groupings

- There were 824 rows for DCFS, "DCFS|Division"

- There were 15 rows for JJYS, "JJS|JJYS|DHS|DJJ|DJJS|DJJYS"

- There were 997 rows for PO Boxes, "PO|P O BOX|Po Box|Po box|Post Office Box|HC|Box|box|POB|P.O.|RR|Rt|GuidePost"

- There were 276 rows for Unknown, "Bad Address|Unknown|unknown|BAD ADDRESS|UNKNOWN|UKNOWN|UKNOWN|Unknown|unable to disclose|no address|Return|RETURNED|RTN|Undisclosed"

- There were 60 rows general bad addresses, "BAD|Bad|Barrio|Calle|Cedro|Chrysalis|CONSENT|CINNAMON HILLS|Confidential|CONSENT|Copper Hills|Country|County Club Dr|CR|Davis|Demver|El Pederual|El Porvenir|EMAIL|Emerald Green Street|General Delivery|GuidePost|Honduras|ICYC|New Castle|Protected|Salvador|Service|Tegusigalpa|TELOS|Triumph|NA"

- There were 93 rows for Programming, "ABBA House|Academy|Agua Caliente El Porvenir|Alaska|Anderson Hall|Arizona DCS|Ashcreek Ranch Academy|Aspire Academy|Butte County Juvenile Center|Canyon Creek Womens Crisis Ctr|Califonia|Dept of Human Services Hawaii|Heritage Schools|Kaibab|Family Support Center|Human Services|Decker Lake Youth Center|Discovery|Group Home|Falcon Ridge|Family Support Center|Friends|friends|Heritage|High Desert|Horseshoe Mountain Academy|Jobcorp|Kadiri House Group Home|Kaibab Band of Paiute Indians|New Castle|Benchmark|Provo|Correctional|Quality Youth Services|Red Rock Canyon School|Jail|Sandstone|Sorensons Ranch|Southwest Utah Youth Center|Split Mountain Youth Center|Suites at Academy Square|Summit View Youth Correctional Center|Three Points Center|Developmental|Ute|Department of Children|Wilderness program|Willoughby House|Womens|Wyoming State|YHA|Youth Health|Zion Hills Academy"

- There were 9 rows for Homeless, "HOMELESS|transient|Plaza|Motel|hotel|KOA"

- These 2,275 total rows were removed from the 5,213 no matches group which left us with 2,961 rows. We ran the 2961 rows through geocode again and ended up with no matches

- Ended up with 37,745 successful matches from the original 42,980. We merged the cleaned and geo matched file with the primiary file

- After match, we removed addresses that were out of state of UT (2,168), left with 68,372 observations. Three additional rows were dropped after we matched with census file.

</div>
</div>
</div>
  
Preliminary Maps {.storyboard} 
====================================================

### **Overall Episode Referrals Rate per 100** {data-commentary-width=300}

```{r warning=FALSE, message=FALSE, error=FALSE, include=FALSE}


library("leaflet")
library("magrittr")
library("sf")
library("htmltools")
library("htmlwidgets")
library("stringi")
library("RColorBrewer")
library("remotes")

#read in data file
UT_statewide <- read_csv("/Volumes/DATA/Shared/Justice/Research/Juvenile Data & Reforms/Geospatial Studies/statewide_referrals_address_matcg.csv")


library("tidycensus")

ut.tracts <- get_acs(geography = "tract", 
                     year = 2020,
                     variables = c(civlf = "B23025_003", unemp = "B23025_005", 
                                   povtot = "B17001_001", pov = "B17001_002",
                                   patot = "B19057_001", pa = "B19057_002",
                                   tpop = "B03002_001", nhblk = "B03002_004",
                                   age1 = "B01001_003", age2 = "B01001_004", 
                                   age3 = "B01001_005", age4 = "B01001_006", 
                                   age5 = "B01001_027", age6 = "B01001_028",
                                   age7 = "B01001_029", age8 = "B01001_030",
                                   femhhtot = "B11001_001", femhh = "B11001_006"
                                   ),
                     state = "UT",
                     survey = "acs5",
                     output = "wide",
                     geometry = TRUE)

ut.tracts2 <- ut.tracts %>% 
  rename_with(~ sub("E$", "", .x), everything()) %>%
  mutate(punemp = (unemp/civlf)*100, ppov = (pov/povtot)*100, 
         pblk = (nhblk/tpop)*100, pfemhh = (femhh/femhhtot)*100,
         tot18below=(age1+age2+age3+age4+age5+age6+age7+age8),
         p18below = ((age1+age2+age3+age4+age5+age6+age7+age8)/tpop)*100,
         ppa = (pa/patot)*100 ) %>%
  select(c(GEOID, NAM, punemp, ppov, tot18below, p18below, ppa, pfemhh, pblk, tpop))  %>%
  filter(tpop != 0)


statewide_tracts <- merge(ut.tracts2,UT_statewide, by="GEOID")
#3 cases were dropped here

## Create Juvenile Episode Rate per Juvenile Population in each Tract
statewide_tracts1 <- statewide_tracts %>% group_by(GEOID) %>%
  mutate("Episodes" = n(),
         "Rate" = (Episodes/tot18below)*100)

# Create smaller dataframe grouped GEOID
ReferralRate <- statewide_tracts1 %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(Rate1 = round((Rate), 2),
         name = paste(City, Rate1, sep = ",")) %>% select(GEOID,Long, Lat, Episodes, Rate1, City) %>%
distinct(GEOID, .keep_all = TRUE)

ReferralRate <- sf::st_as_sf(ReferralRate)

# creating bins
bins <- c(0, 5, 10, 15, 20, 33,107)
color <- c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039", "#900C3F")
data_bins <- cut(ReferralRate$Rate1, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest", "Extreme"))
palette <- colorBin(palette = color, domain = ReferralRate$Rate1, bins = bins)

table(data_bins)

# Create text for popup

mytext <- paste("<b>Category: </b>", data_bins, "<br/>",
   "<b>Location: </b>", ReferralRate$City, "<br/>",
   "<b>Episodes: </b>", ReferralRate$Episodes, "<br/>",
   "<b>Referral Rate: </b>", ReferralRate$Rate1, "<br/>"
) %>%
  lapply(htmltools::HTML)


#map

map<- ReferralRate  %>% leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
    addPolygons(data = ReferralRate,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(Rate1),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~ReferralRate$Rate1, opacity=0.9, title = "Referral Episode Rate per 100 Youths", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity))

```



```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       map)))
```

***

- The entire dataset represents 68,369 episodes across Intake Fiscal Years 2018, 2019, 2020, 2021, 2022, and 2023.

- This map includes 701 unique GEOIDs

- According to our latest juvenile justice annual report, Utah's rate of overall court referral ranged from 4.57 - 3.34 per 100 youths between FY 2018 - 2023. Therefore we chose the cutoff bins as bins <- c(0, 5, 10, 15, 20, 30, 107). 

- <span style="color:#7393B3">**Lowest**:</span>, a rate of 0-5 per 100 youths, we had 232 GEOIDs;

- <span style="color:#2E9CCA">**Low**:</span>, a rate of 5-10 per 100 youths, we had 282 GEOIDs;

- <span style="color:#FFC300">**Moderate**:</span>, a rate of 10-15 per 100 youths, we had 120 GEOIDs;

- <span style="color:#FF5733">**High**:</span>, a rate of 15-20 per 100 youths, we had 49 GEOIDs;

- <span style="color:#C70039">**Highest**:</span>, a rate of 20-33 per 100 youths, we had 15 GEOIDs; and

- <span style="color: #900C3F">**Extreme**:</span>, a rate of 33-107, we had 3 GEOIDs.

### **Overall Episode Referrals Rate per 100 - Unique Kids** {data-commentary-width=300}

```{r warning=FALSE, message=FALSE, error=FALSE, include=FALSE}
## Create Juvenile Episode Rate per Juvenile Population in each Tract for unique kids
statewide_tractsUK <- statewide_tracts %>% distinct(casenumber, .keep_all = TRUE) %>% group_by(GEOID) %>%
  mutate("Episodes" = n(),
         "Rate" = (Episodes/tot18below)*100)

# Create smaller data frame grouped GEOID
ReferralRateUK <- statewide_tractsUK %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(Rate1 = round((Rate), 2),
         name = paste(City, Rate1, sep = ",")) %>% select(GEOID,Long, Lat, Episodes, Rate1, City) %>%
distinct(GEOID, .keep_all = TRUE)

ReferralRateUK <- sf::st_as_sf(ReferralRateUK)

# creating bins
bins <- c(0, 5, 10, 15, 20, 33)
color <- c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039")
data_bins <- cut(ReferralRateUK$Rate1, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest"))
palette <- colorBin(palette = color, domain = ReferralRateUK$Rate1, bins = bins)

table(data_bins)

# Create text for popup

mytext <- paste(data_bins,
   "<b>Location: </b>", ReferralRateUK$City, "<br/>",
   "<b>Episodes: </b>", ReferralRateUK$Episodes, "<br/>",
   "<b>Referral Rate: </b>", ReferralRateUK$Rate1, "<br/>"
) %>%
  lapply(htmltools::HTML)

#map

mapUK<- ReferralRateUK  %>% leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
    addPolygons(data = ReferralRateUK,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(Rate1),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~ReferralRateUK$Rate1, opacity=0.9, title = "Referral Episode Rate per 100 Youths", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity))

```

```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       mapUK)))
```

***

- The entire dataset represents 68,369 episodes across Intake Fiscal Years 2018, 2019, 2020, 2021, 2022, and 2023.

- According to our latest juvenile justice annual report, Utah's rate of overall court referral ranged from 4.57 - 3.34 per 100 youths between FY 2018 - 2023. Therefore we chose the cutoff bins as bins <- c(0, 5, 10, 15, 20, 33). 

- <span style="color:#7393B3">**Lowest**:</span>, a rate of 0-5 per 100 youths, we had 501 GEOIDs; 

- <span style="color:#2E9CCA">**Low**:</span>, a rate of 5-10 per 100 youths, we had 188 GEOIDs;

- <span style="color:#FFC300">**Moderate**:</span>, a rate of 10-15 per 100 youths, we had 10 GEOIDs;

- <span style="color:#FF5733">**High**:</span>, a rate of 15-20 per 100 youths, we had 0 GEOIDs; and

- <span style="color:#C70039">**Highest**:</span>, a rate of 20-33 per 100 youths, we had 2 GEOIDs.

- This map includes 36,380 unique kids

### **Serious Offense Episode Rate Per 100** {data-commentary-width=300}

```{r warning=FALSE, message=FALSE, error=FALSE,include=FALSE}

# Create new violent crime flag with violent crime excel sheet Zerina sent

violent_crime <- read_excel("/Volumes/DATA/Shared/Justice/Research/Juvenile Data & Reforms/Juvenile Justice Reform/HB_239_Annual_Reports/FY_2024/JC_FY24.xlsx", 
                           sheet = "SeriousOffenseStatuteID")


#rename variable
violent_crime1 <- violent_crime %>% mutate("violentcrime1" = violentcrime) %>% select(statuteid, violentcrime1)


# Create new firearm flag with violent crime excel sheet Zerina sent
firearm_crime <- read_excel("/Volumes/DATA/Shared/Justice/Research/Juvenile Data & Reforms/Geospatial Studies/Firearm Flag 072024 (1).xlsx")

#rename variable
firearm_crime1 <- firearm_crime %>% mutate("firearm1" = sglfirearm) %>% select(statuteid, firearm1)

#merge violent and firearm
viofire <- left_join(violent_crime1, firearm_crime1, by = "statuteid") %>% replace(., is.na(.), "N")


#merge with statewide tracts
statewide_tractsV <- left_join(statewide_tracts,viofire, by = "statuteid") %>% replace(., is.na(.), "N")


## See Serious Offense by Fiscal Year
statewide_tractsSO_byFY <- statewide_tractsV %>% filter(violentcrime1=="Y") %>% group_by(`Intake Fiscal Year`) %>% tally()


## Create Juvenile Episode Rate per Juvenile Population in each Tract
# Fix the rate so that it is grouped by census tracts and then calculate the rate
statewide_tractsSO <- statewide_tractsV %>% filter(weapon=="Y"|firearm1=="Y"|violentcrime1=="Y") %>% group_by(GEOID) %>% 
  mutate("Episodes" = n(),
         "Serious Offense Rate" = (Episodes/tot18below)*100) 

SOReferralRate <- statewide_tractsSO %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(Rate1 = round((`Serious Offense Rate`), 2),
         name = paste(City, Rate1, sep = ","))%>% select(GEOID,Long, Lat, Episodes, Rate1, City) %>%
distinct(GEOID, .keep_all = TRUE)

SOReferralRate <- sf::st_as_sf(SOReferralRate)

# creating bins
bins <- c(0, 5, 10, 15, 20, 30)
color = c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039")
data_bins <- cut(SOReferralRate$Rate1, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest"))
palette <- colorBin(palette = color, domain = SOReferralRate$Rate1, bins = bins)

table(data_bins)

# Create text for popup

mytext <- paste(data_bins,
   "<b>Location: </b>", SOReferralRate$City, "<br/>",
   "<b>Serious Offense Episodes: </b>", SOReferralRate$Episodes, "<br/>",
   "<b>Referral Rate: </b>", SOReferralRate$Rate1, "<br/>"
) %>%
  lapply(htmltools::HTML)

#map

map_SO_Offenses <- SOReferralRate  %>%
  leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(data = SOReferralRate,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(Rate1),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~SOReferralRate$Rate1, opacity=0.9, title = "Serious Offense Referral Rate per 100 Youths", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity)) 

```

```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       map_SO_Offenses)))
```

***
- Serious Offense includes an episode where there was an indication of a Violent, Weapon, or Firearm offense. This equated to 7,063 out of 68,369 episodes.

- According to our latest juvenile justice annual report data, we see serious offenses make up about less than 10% of all offenses.Therefore we chose the cutoff bins as <- c(0, 5, 10, 15, 20, 30).

- <span style="color:#7393B3">**Lowest**:</span>, a rate of 0-5 per 100 youths, we had 658 GEOIDs; 

- <span style="color:#2E9CCA">**Low**:</span>, a rate of 5-10 per 100 youths, we had 3 GEOIDs; 

- <span style="color:#FFC300">**Moderate**:</span>, a rate of 10-15 per 100 youths, we had 0 GEOIDs;

- <span style="color:#FF5733">**High**:</span>, a rate of 15-20 per 100 youths, we had 0 GEOIDs; and

- <span style="color:#C70039">**Highest**:</span>, a rate of 20-30 per 100 youths, we had 1 GEOID.

- This map includes a subset of the entire data (7,063 out of 68,369 episodes)

- This map includes 662 unique GEOIDs


### **Serious Offense Episode Percentage Share Map** {data-commentary-width=300}

```{r warning=FALSE, message=FALSE, error=FALSE, include=FALSE}


# create new serious variable and summarize for percent
statewide_tractsSOP <- statewide_tractsV %>% mutate("Serious" = ifelse(weapon=="Y"|firearm1=="Y"|violentcrime1=="Y",1,0)) %>% group_by(GEOID) %>% mutate(Episodes = sum(Serious), percent_serious = mean(Serious))


SOReferralP <- statewide_tractsSOP %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(Percent = round((percent_serious), 2),
         name = paste(City, Percent, sep = ",")) %>% select(GEOID,Long, Lat, Episodes, Percent, City) %>%
distinct(GEOID, .keep_all = TRUE)


SOReferralP <- sf::st_as_sf(SOReferralP)

# creating bins
bins <- c(0, .05, .10, .15, .20, .30)
color = c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039")
data_bins <- cut(SOReferralP$Percent, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest"))
palette <- colorBin(palette = color, domain = SOReferralP$Percent, bins = bins)

table(data_bins)


# Create text for popup

mytext <- paste(data_bins,
   "<b>Location: </b>", SOReferralP$City, "<br/>",
    "<b>Serious Offense Episodes: </b>", SOReferralP$Episodes, "<br/>",
   "<b>Percent Share: </b>", SOReferralP$Percent, "<br/>"
) %>%
  lapply(htmltools::HTML)

#map

map_SO_OffensesP <- SOReferralP %>% 
  leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(data = SOReferralP,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(Percent),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~SOReferralP$Percent, opacity=0.9, title = "Serious Offense Referral Percentage Share", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity)) 

```

```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       map_SO_OffensesP)))
```

***

- Serious Offense includes an episode where there was an indication of a Violent, Weapon, or Firearm offense. This equated to 7,063 out of 68,369 episodes.

- According to our latest juvenile justice annual report data, we see serious offenses make up about less than 10% of all offenses.Therefore we chose the cutoff bins as <- c(0, .05, .10, .15, .20, .30). 

- <span style="color:#7393B3">**Lowest**:</span>, a percentage of 0-5%, we had 102 GEOIDs; 

- <span style="color:#2E9CCA">**Low**:</span>, a percentage of 5-10%, we had 282 GEOIDs; 

- <span style="color:#FFC300">**Moderate**:</span>, a percentage of 10-15%, we had 174 GEOIDs;

- <span style="color:#FF5733">**High**:</span>, a percentage of 15-20%, we had 72 GEOIDs; and 

- <span style="color:#C70039">**Highest**:</span>, a percentage of 20-30%, we had 25 GEOIDs.

- This map represents percentage share of serious offenses out of all episodes by census tract.

- This map includes 701 unique GEOIDs.

### **Felony Offense Episode Rate Per 100** {data-commentary-width=300}

```{r warning=FALSE, message=FALSE, error=FALSE,include=FALSE}

## Create Juvenile Episode Rate per Juvenile Population in each Tract
# Fix the rate so that it is grouped by census tracts and then calculate the rate
statewide_tractsFel <- statewide_tracts %>% filter(`Case Type`=="Felony") %>% group_by(GEOID) %>% 
  mutate("Episodes" = n(),
         "Felony Offense Rate" = (Episodes/tot18below)*100) 

FelReferralRate <- statewide_tractsFel %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(Rate1 = round((`Felony Offense Rate`), 2),
         name = paste(City, Rate1, sep = ","))%>% select(GEOID,Long, Lat, Episodes, Rate1, City) %>%
distinct(GEOID, .keep_all = TRUE)

FelReferralRate <- sf::st_as_sf(FelReferralRate)

# creating bins
bins <- c(0, 3, 8, 10, 15, 20)
color = c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039")
data_bins <- cut(FelReferralRate$Rate1, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest"))
palette <- colorBin(palette = color, domain = FelReferralRate$Rate1, bins = bins)

table(data_bins)

# Create text for popup

mytext <- paste(data_bins,
   "<b>Location: </b>", FelReferralRate$City, "<br/>",
   "<b>Felony Offense Episodes: </b>", FelReferralRate$Episodes, "<br/>",
   "<b>Referral Rate: </b>", FelReferralRate$Rate1, "<br/>"
) %>%
  lapply(htmltools::HTML)

#map

map_Fel_Offenses <- FelReferralRate  %>%
  leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(data = FelReferralRate,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(Rate1),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~FelReferralRate$Rate1, opacity=0.9, title = "Felony Offense Referral Rate per 100 Youths", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity)) 

```

```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       map_Fel_Offenses)))
```

***
- Felony Offense includes an episode where there was an indication of a Felony offense. This equated to 9,336 out of 68,369 episodes (about 13% of all offenses). Therefore we chose the cutoff bins as <- c(0, 3, 8, 10, 15, 20).

- <span style="color:#7393B3">**Lowest**:</span>, a rate of 0-3 per 100 youths, we had 628 GEOIDs; 

- <span style="color:#2E9CCA">**Low**:</span>, a rate of 3-8 per 100 youths, we had 34 GEOIDs; 

- <span style="color:#FFC300">**Moderate**:</span>, a rate of 8-10 per 100 youths, we had 1 GEOIDs;

- <span style="color:#FF5733">**High**:</span>, a rate of 10-15 per 100 youths, we had 1 GEOIDs; and

- <span style="color:#C70039">**Highest**:</span>, a rate of 15-20 per 100 youths, we had 0 GEOID.

- This map includes a subset of the entire data (9,336 out of 68,369 episodes)

- This map includes 665 unique GEOIDs

### **Felony Offense Episode Percentage Share Map** {data-commentary-width=300}

```{r warning=FALSE, message=FALSE, error=FALSE, include=FALSE}


# create new felony variable and summarize for percent
statewide_tractsFelP <- statewide_tracts %>% mutate("Felony" = ifelse(`Case Type`=="Felony",1,0)) %>% group_by(GEOID) %>% mutate(Episodes = sum(Felony), percent_felony = mean(Felony))


FelReferralP <- statewide_tractsFelP %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(Percent = round((percent_felony), 2),
         name = paste(City, Percent, sep = ",")) %>% select(GEOID,Long, Lat, Episodes, Percent, City) %>%
distinct(GEOID, .keep_all = TRUE)


FelReferralP <- sf::st_as_sf(FelReferralP)

# creating bins
bins <- c(0, .20, .30, .40, .50, .70)
color = c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039")
data_bins <- cut(FelReferralP$Percent, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest"))
palette <- colorBin(palette = color, domain = FelReferralP$Percent, bins = bins)

table(data_bins)


# Create text for popup

mytext <- paste(data_bins,
   "<b>Location: </b>", FelReferralP$City, "<br/>",
    "<b>Felony Offense Episodes: </b>", FelReferralP$Episodes, "<br/>",
   "<b>Percent Share: </b>", FelReferralP$Percent, "<br/>"
) %>%
  lapply(htmltools::HTML)

#map

map_Fel_OffensesP <- FelReferralP %>% 
  leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(data = FelReferralP,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(Percent),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~FelReferralP$Percent, opacity=0.9, title = "Felony Offense Referral Percentage Share", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity)) 

```

```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       map_Fel_OffensesP)))
```

***

- Felony Offense includes an episode where there was an indication of a Felony offense. This equated to 9,336 out of 68,369 episodes (about 13% of all offenses). Therefore we chose the cutoff bins as <- c(0, .20, .30, .40, .50, .70).

- <span style="color:#7393B3">**Lowest**:</span>, a percentage of 0-20%, we had 575 GEOIDs; 

- <span style="color:#2E9CCA">**Low**:</span>, a percentage of 20-30%, we had 78 GEOIDs; 

- <span style="color:#FFC300">**Moderate**:</span>, a percentage of 30-40%, we had 9 GEOIDs;

- <span style="color:#FF5733">**High**:</span>, a percentage of 40-50%, we had 2 GEOIDs; and 

- <span style="color:#C70039">**Highest**:</span>, a percentage of 50-70%, we had 2 GEOIDs.

- This map represents percentage share of felony offenses out of all episodes by census tract.

- This map includes 701 unique GEOIDs.

### **Petitioned Episode Rate Per 100** {data-commentary-width=300}

```{r warning=FALSE, message=FALSE, error=FALSE,include=FALSE}

## Create Juvenile Episode Rate per Juvenile Population in each Tract
# Fix the rate so that it is grouped by census tracts and then calculate the rate
statewide_tractsPet <- statewide_tracts %>% filter(intakedecision=="PET") %>% group_by(GEOID) %>% 
  mutate("Episodes" = n(),
         "Petitioned Rate" = (Episodes/tot18below)*100) 

PetRate <- statewide_tractsPet %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(Rate1 = round((`Petitioned Rate`), 2),
         name = paste(City, Rate1, sep = ","))%>% select(GEOID,Long, Lat, Episodes, Rate1, City) %>%
distinct(GEOID, .keep_all = TRUE)

PetRate <- sf::st_as_sf(PetRate)

# creating bins
bins <- c(0, 10, 20, 30, 40, 70)
color = c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039")
data_bins <- cut(PetRate$Rate1, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest"))
palette <- colorBin(palette = color, domain = PetRate$Rate1, bins = bins)

table(data_bins)

# Create text for popup

mytext <- paste(data_bins,
   "<b>Location: </b>", PetRate$City, "<br/>",
   "<b>Petitioned Episodes: </b>", PetRate$Episodes, "<br/>",
   "<b>Petitioned Rate: </b>", PetRate$Rate1, "<br/>"
) %>%
  lapply(htmltools::HTML)

#map

map_Pet_Offenses <- PetRate  %>%
  leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(data = PetRate,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(Rate1),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~PetRate$Rate1, opacity=0.9, title = "Petitioned Rate per 100 Youths", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity)) 

```

```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       map_Pet_Offenses)))
```

***
- Formally charged (petitioned) delinquency cases are those that appear on a court calendar in response to the filing of a petition, complaint, or other legal instrument requesting the court to adjudicate a youth as a delinquent or status offender, or to waive jurisdiction and transfer a youth to criminal court. Petitioning occurs when a juvenile court intake officer, prosecutor, or other official determines that a case should be handled formally. This equated to 22,247 episodes that were petitioned out of 68,369 episodes.

- According to our latest juvenile justice annual report data, the percent of episodes that were petitioned were between 33-29% between FY 2020 - 2023. Therefore we chose the cutoff bins as <- c(0, 10, 20, 30, 40, 70).

- <span style="color:#7393B3">**Lowest**:</span>, a rate of 0-10 per 100 youths, we had 679 GEOIDs; 

- <span style="color:#2E9CCA">**Low**:</span>, a rate of 10-20 per 100 youths, we had 8 GEOIDs; 

- <span style="color:#FFC300">**Moderate**:</span>, a rate of 20-30 per 100 youths, we had 2 GEOIDs;

- <span style="color:#FF5733">**High**:</span>, a rate of 30-40 per 100 youths, we had 0 GEOIDs; and

- <span style="color:#C70039">**Highest**:</span>, a rate of 40-70 per 100 youths, we had 1 GEOID.

- This map includes a subset of the entire data (22,247 out of 68,369 episodes)

- This map includes 690 unique GEOIDs

### **Petitioned Episode Percentage Share Map** {data-commentary-width=300}

```{r warning=FALSE, message=FALSE, error=FALSE, include=FALSE}


# create new felony variable and summarize for percent
statewide_tractsPetP <- statewide_tracts %>% mutate("Petitioned" = ifelse(`intakedecision`=="PET",1,0)) %>% group_by(GEOID) %>% mutate(Episodes = sum(Petitioned), percent_pet = mean(Petitioned))


PetReferralP <- statewide_tractsPetP %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(Percent = round((percent_pet), 2),
         name = paste(City, Percent, sep = ",")) %>% select(GEOID,Long, Lat, Episodes, Percent, City) %>%
distinct(GEOID, .keep_all = TRUE)


PetReferralP <- sf::st_as_sf(PetReferralP)

# creating bins
bins <- c(0, .30, .40, .50, .60, .80)
color = c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039")
data_bins <- cut(PetReferralP$Percent, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest"))
palette <- colorBin(palette = color, domain = PetReferralP$Percent, bins = bins)

table(data_bins)


# Create text for popup

mytext <- paste(data_bins,
   "<b>Location: </b>", PetReferralP$City, "<br/>",
    "<b>Petitioned Episodes: </b>", PetReferralP$Episodes, "<br/>",
   "<b>Percent Share: </b>", PetReferralP$Percent, "<br/>"
) %>%
  lapply(htmltools::HTML)

#map

map_Pet_OffensesP <- PetReferralP %>% 
  leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(data = PetReferralP,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(Percent),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~PetReferralP$Percent, opacity=0.9, title = "Petitioned Percentage Share", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity)) 

```

```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       map_Pet_OffensesP)))
```

***

- Formally charged (petitioned) delinquency cases are those that appear on a court calendar in response to the filing of a petition, complaint, or other legal instrument requesting the court to adjudicate a youth as a delinquent or status offender, or to waive jurisdiction and transfer a youth to criminal court. Petitioning occurs when a juvenile court intake officer, prosecutor, or other official determines that a case should be handled formally. This equated to 22,247 episodes that were petitioned out of 68,369 episodes.

- According to our latest juvenile justice annual report data, the percent of episodes that were petitioned were between 33-29% between FY 2020 - 2023. Therefore we chose the cutoff bins as <- c(0, .30, .40, .50, .60, .80).

- <span style="color:#7393B3">**Lowest**:</span>, a percentage of 0-30%, we had 333 GEOIDs; 

- <span style="color:#2E9CCA">**Low**:</span>, a percentage of 30-40%, we had 169 GEOIDs; 

- <span style="color:#FFC300">**Moderate**:</span>, a percentage of 40-50%, we had 79 GEOIDs;

- <span style="color:#FF5733">**High**:</span>, a percentage of 50-60%, we had 18 GEOIDs; and 

- <span style="color:#C70039">**Highest**:</span>, a percentage of 60-80%, we had 8 GEOIDs.

- This map represents percentage share of petitioned episodes out of all episodes by census tract.

- This map includes 701 unique GEOIDs.

### **High and Moderate Risk Episode Rate Per 100** {data-commentary-width=300}
 
```{r warning=FALSE, message=FALSE, error=FALSE, include = FALSE}

df_risk <- read_excel("/Volumes/DATA/Shared/Justice/Research/Juvenile Data & Reforms/Geospatial Studies/Geospatial Study Statewide Final12132023.xlsx", 
                           sheet = "Risk Level")

statewide_tracts2 <- 
  left_join(statewide_tracts1, df_risk, by = "casenumber") %>%
  mutate(date_diff = abs(difftime(intakedate, assessmentdate, units = "days"))) %>% #here we are creating a new date difference variable between the intakedate and riskassessment day
  group_by(casenumber, intakedate) %>% #this shows that we jumped from 68,369 observations to 172802 observations because of multiple risk assessments
  filter(date_diff == min(date_diff)) %>% #to reduce the sample to only pulling the closest assessment date to intake date
  select(-date_diff)


statewide_tractsRR <- statewide_tracts2 %>% filter(risklevel=="HIGH"|risklevel=="MODERATE") %>% group_by(GEOID) %>% 
  mutate("Episodes" = n(),
         "High Moderate Risk Offense Rate" = (Episodes/tot18below)*100) 


SOReferralRateRisk <- statewide_tractsRR %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(Rate1 = round((`High Moderate Risk Offense Rate`), 2),
         name = paste(City, Rate1, sep = ","))%>% select(GEOID,Long, Lat, Episodes, Rate1, City) %>%
distinct(GEOID, .keep_all = TRUE)

SOReferralRateRisk <- sf::st_as_sf(SOReferralRateRisk)

# creating bins
bins <- c(0, 10, 15, 20, 25, 30, 50)
color <- c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039", "#900C3F")
data_bins <- cut(SOReferralRateRisk$Rate1, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest", "Extreme"))
palette <- colorBin(palette = color, domain = SOReferralRateRisk$Rate1, bins = bins)

table(data_bins)

# Create text for popup

mytext <- paste(data_bins,
   "<b>Location: </b>", SOReferralRateRisk$City, "<br/>",
    "<b>High Moderate Risk Episodes: </b>", SOReferralRateRisk$Episodes, "<br/>",
   "<b>High Moderate Risk Referral Rate: </b>", SOReferralRateRisk$Rate1, "<br/>"
) %>%
  lapply(htmltools::HTML)

#map

map_SO_OffensesRiskRate <- SOReferralRateRisk %>% 
  leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(data = SOReferralRateRisk,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(Rate1),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~SOReferralRateRisk$Rate1, opacity=0.9, title = "High Moderate Risk Referral Rate per 100 Youths", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity)) 

```

```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       map_SO_OffensesRiskRate)))
```

***

According to our latest juvenile justice annual report, the share of youth who were assessed as high or moderate risk for all court referrals was 24-26% between FY 2020 - 2023. Therefore we chose the cutoff bins as bins <- c(0, 10, 15, 20, 25, 30, 50).

- <span style="color:#7393B3">**Lowest**:</span>, a rate of 0-10 per 100 youths, we had 648 GEOIDs; 

- <span style="color:#2E9CCA">**Low**:</span>, a rate of 10-15 per 100 youths, we had 15 GEOIDs; 

- <span style="color:#FFC300">**Moderate**:</span>, a rate of 15-20 per 100 youths, we had 2 GEOIDs;

- <span style="color:#FF5733">**High**:</span>, a rate of 20-25 per 100 youths, we had 0 GEOIDs; and

- <span style="color:#C70039">**Highest**:</span>, a rate of 25-30 per 100 youths, we had 0 GEOID.

- <span style="color: #900C3F">**Extreme**:</span>, a rate of 30-50 per 100 youths, we had 1 GEOID.

- This map includes a subset of the entire data set (21,727 episodes out of 68,369)

- This map includes 667 unique GEOIDs

We created risk level variable by first: 

- Creating date difference variable between the intakedate and riskassessment day.

- We saw our data jumped from 68,369 observations to 172,802 observations because of multiple risk assessments.

- To reduce the sample, we only pulled the closest assessment date to intake date and used that as our risk level variable.

- In the end, we were able to match 64,558 risk levels to the original 68,369 observations.

- For High or Moderate Risk, this equated to 21,727 out of 68,369 episodes.

### **High and Moderate Risk Percentage Share** {data-commentary-width=300}
 
```{r warning=FALSE, message=FALSE, error=FALSE, include = FALSE}

# create new serious variable and summarize for percent
statewide_tractsRisk <- statewide_tracts2 %>% na.omit(statewide_tracts2$risklevel) %>% #Had to remove 6 observations where there was a NA for risk level
  mutate("High_modrisk" = ifelse(risklevel=="HIGH"|risklevel=="MODERATE",1,0), "Low_risk" = ifelse(risklevel=="LOW",1,0)) %>% group_by(GEOID) %>%
  mutate(Episodes = sum(High_modrisk),
         percent_highmod = mean(High_modrisk),
percent_low = mean(Low_risk))


SOReferralRisk <- statewide_tractsRisk %>% 
  rename(Lat = cxy_lat,
         Long = cxy_lon) %>%
  mutate(
         HighModRiskPercent = round((percent_highmod), 2),
         LowRiskPercent = round((percent_low), 2),
         name = paste(City, HighModRiskPercent, sep = ",")) %>% select(GEOID,Long, Lat, Episodes, HighModRiskPercent, City) %>%
distinct(GEOID, .keep_all = TRUE)

SOReferralRisk <- sf::st_as_sf(SOReferralRisk)


bins <- c(.0,.30, .40, .50, .60, .70, .90)
color <- c("#7393B3", "#2E9CCA","#FFC300", "#FF5733", "#C70039", "#900C3F")
data_bins <- cut(SOReferralRisk$HighModRiskPercent, bins, labels = c("Lowest", "Low", "Moderate", "High", "Highest", "Extreme"))
palette <- colorBin(palette = color, domain = SOReferralRisk$HighModRiskPercent, bins = bins)

table(data_bins)

# Create text for popup

mytext <- paste(data_bins,
   "<b>Location: </b>", SOReferralRisk$City, "<br/>",
    "<b>High Moderate Risk Episodes: </b>", SOReferralRisk$Episodes, "<br/>",
   "<b>High Moderate Risk Percent Share: </b>", SOReferralRisk$HighModRiskPercent, "<br/>"
) %>%
  lapply(htmltools::HTML)

#map

map_SO_OffensesRisk <- SOReferralRisk %>% 
  leaflet() %>% addTiles() %>% 
        setView(-111.950684, 39.419220, zoom = 6) %>% 
      fitBounds(~min(Long), ~min(Lat), ~max(Long), ~max(Lat)) %>%
      addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
  addPolygons(data = SOReferralRisk,
                weight=1, opacity = 1.0,color = 'white',
              fillOpacity = 0.9, smoothFactor = 0.5,
              fillColor = ~palette(HighModRiskPercent),
                  layerId = ~GEOID,
                  label = mytext
                ) %>%
  addLegend(pal=palette, values=~SOReferralRisk$HighModRiskPercent, opacity=0.9, title = "High and Moderate Risk Percentage Share", position = "topright", labFormat = labelFormat(prefix = '', suffix = '', between = ' &ndash; ', digits = 3, big.mark = ',', transform = identity)) 

```

```{r}
  browsable(
   tagList(
      list(
         tags$head(
            tags$style(
               ".leaflet .legend {
                 line-height: 30px;
                 font-size: 10px;
                 }",
              ".leaflet .legend i{
                width: 30px;
                height: 30px;
                 }"
            )
         ),
       map_SO_OffensesRisk)))
```

***

According to our latest juvenile justice annual report, the share of youth who were assessed as high or moderate risk for all court referrals was 24-26% between FY 2020 - 2023. Therefore we chose the cutoff bins as bins <- c(.0,.30, .40, .50, .60, .70, .90).

- <span style="color:#7393B3">**Lowest**:</span>, a percentage of 0-30%, we had 346 GEOIDs; 

- <span style="color:#2E9CCA">**Low**:</span>, a percentage of 30-40%, we had 174 GEOIDs; 

- <span style="color:#FFC300">**Moderate**:</span>, a percentage of 40-50%, we had 100 GEOIDs; 

- <span style="color:#FF5733">**High**:</span>, a percentage of 50-60%, we had 36 GEOIDs; and 

- <span style="color:#C70039">**Highest**:</span>, a percentage of 60-70%, we had 2 GEOIDs.

- <span style="color: #900C3F">**Extreme**:</span>, a percentage of 70-90%, we had 7 GEOIDs.

- This map breaks down percentage share of episodes assessed as high or moderate risk by GEOIDs.

We created risk level variable by first: 

- Creating date difference variable between the intakedate and riskassessment day.

- We saw our data jumped from 68,369 observations to 172,802 observations because of multiple risk assessments.

- To reduce the sample, we only pulled the closest assessment date to intake date and used that as our risk level variable.

- In the end, we were able to match 64,558 risk levels to the original 68,369 observations.

- For High or Moderate Risk, this equated to 21,727 out of 68,369 episodes.