## Data from the Porland Police Bureau- https://public.tableau.com/app/profile/portlandpolicebureau/viz/New_Monthly_Neighborhood/MonthlyOffenseTotals
## Metadata: https://www.portland.gov/police/open-data/crime-statistics#toc-metadata-for-offense-open-data
crime<- read.csv("https://raw.githubusercontent.com/karolo89/Raw_Data/main/CrimeData-2023.csv")%>%select(-Address)
head(crime)
## CaseNumber CrimeAgainst Neighborhood OccurDate OccurTime
## 1 23-X5791168 Person Arbor Lodge 1/1/2023 246
## 2 23-X5791169 Person Old Town/Chinatown 1/1/2023 209
## 3 23-X5791250 Person Creston-Kenilworth 1/1/2023 649
## 4 23-X5791315 Person Pearl 1/1/2023 100
## 5 23-X5791338 Person Centennial 1/1/2023 1225
## 6 23-X5791342 Person Wilkes 1/1/2023 1738
## OffenseCategory OffenseType OpenDataLat OpenDataLon OpenDataX
## 1 Assault Offenses Simple Assault NA NA NA
## 2 Assault Offenses Simple Assault NA NA NA
## 3 Assault Offenses Aggravated Assault NA NA NA
## 4 Kidnapping/Abduction Kidnapping/Abduction NA NA NA
## 5 Assault Offenses Simple Assault NA NA NA
## 6 Assault Offenses Aggravated Assault NA NA NA
## OpenDataY ReportDate OffenseCount
## 1 NA 1/1/2023 1
## 2 NA 1/1/2023 1
## 3 NA 1/1/2023 1
## 4 NA 1/1/2023 1
## 5 NA 1/1/2023 1
## 6 NA 1/1/2023 2
crime$Year <- format(as.Date(crime$OccurDate, format="%m/%d/%Y"),"%Y")
crime$Month <- format(as.Date(crime$OccurDate, format="%m/%d/%Y"),"%m")
crime$weekday <- weekdays(as.Date(crime$OccurDate))
crime$weekdaynum <- recode(crime$weekday,
"Sunday"="0",
"Monday"= "1",
"Tuesday"= "2",
"Wednesday"="3",
"Thursday"= "4",
"Friday"="5",
"Saturday"="6")
crime <- crime %>%
select(-c("OpenDataLat", "OpenDataLon", "OpenDataX", "OpenDataY", "ReportDate"))
## Convert string to time format
crime$OccurTime<- format(substr(as.POSIXct(sprintf("%04.0f",crime$OccurTime), format='%H%M'), 12, 16))
crime$time <- as.numeric( sub("\\D*(\\d+).*", "\\1", crime$OccurTime))
head(crime)
## CaseNumber CrimeAgainst Neighborhood OccurDate OccurTime
## 1 23-X5791168 Person Arbor Lodge 1/1/2023 02:46
## 2 23-X5791169 Person Old Town/Chinatown 1/1/2023 02:09
## 3 23-X5791250 Person Creston-Kenilworth 1/1/2023 06:49
## 4 23-X5791315 Person Pearl 1/1/2023 01:00
## 5 23-X5791338 Person Centennial 1/1/2023 12:25
## 6 23-X5791342 Person Wilkes 1/1/2023 17:38
## OffenseCategory OffenseType OffenseCount Year Month weekday
## 1 Assault Offenses Simple Assault 1 2023 01 Saturday
## 2 Assault Offenses Simple Assault 1 2023 01 Saturday
## 3 Assault Offenses Aggravated Assault 1 2023 01 Saturday
## 4 Kidnapping/Abduction Kidnapping/Abduction 1 2023 01 Saturday
## 5 Assault Offenses Simple Assault 1 2023 01 Saturday
## 6 Assault Offenses Aggravated Assault 2 2023 01 Saturday
## weekdaynum time
## 1 6 2
## 2 6 2
## 3 6 6
## 4 6 1
## 5 6 12
## 6 6 17
## Prepare data
day_week <- crime %>%
filter(Year== 2023)%>%
mutate(weekday= as.factor(weekdaynum))%>%
mutate(OccurTime= as.factor(time))%>%
group_by(time, weekday)%>%
summarise(count = n()) %>%
arrange(desc(count))%>%
na.omit()
## `summarise()` has grouped output by 'time'. You can override using the
## `.groups` argument.
## Graph- Year selection
day_weekp <- ggplot(day_week) +
aes(x = weekday, y = time) +
geom_tile(aes(fill=count), colour = "white") +
scale_fill_viridis(name="# Offenses", trans = 'reverse')+
## scale_fill_distiller(name= "# Offenses", palette = "YlGnBu", direction = 1) +
scale_x_discrete(breaks = 0:6,
label = c("Sunday", "Monday", "Tuesday", "Wednesday","Thursday", "Friday", "Saturday"), expand=c(0,0))+
labs(title="Offenses Reported in Portland, OR",
subtitle = "During January and February 2023",
x="",
y="Hour",
caption = "Karol Orozco | Data: Portland Police Bureau")+
theme_classic()+
theme(
axis.line=element_blank(),
axis.ticks=element_line(size=0.4),
axis.text = element_text(size= 10, color= "#1e1b25"),
axis.line.x = element_line(color= "#1e1b25" ),
plot.margin = unit(c(0.5, 1, 0.5, 0.5), unit = "cm"),
plot.title = element_text(family = "cherry", hjust = 0.5, size = 20, face = "bold",
margin = margin(t = 10, b = 10)),
plot.subtitle = element_text(family = "redhat", hjust = 0.5, size = 12,
margin = margin(b = 10)),
plot.caption = element_text(family = "redhat", hjust = 0.5, size = 10),
panel.grid = element_blank(),
legend.position = "bottom",
legend.text = element_text(family = "redhat", hjust = 0.5, size = 10),
legend.title = element_text(family = "redhat", hjust = 0.5, size = 12),
legend.margin=margin(grid::unit(0,"cm")),
legend.key.width=grid::unit(2,"cm"),
legend.key.height=grid::unit(0.2,"cm"),
panel.background = element_rect(colour = "#fdf8ec", fill = "#fdf8ec"),
plot.background = element_rect(colour = "#fdf8ec", fill = "#fdf8ec"),
legend.background = element_rect(colour = "#fdf8ec", fill = "#fdf8ec"))+
coord_flip()
## Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
day_weekp
##Dispatched Calls for Service by Portland Police Bureau
## https://public.tableau.com/app/profile/portlandpolicebureau/viz/DispatchedCallsforService/DispatchedCalls
dispatch_calls2023 <- read.csv("https://raw.githubusercontent.com/karolo89/Raw_Data/main/dispatchedcalls_opendata_2023_1.csv")%>%
select(-ReportDateTime)%>%
mutate(Priority = as.factor(Priority))%>%
mutate(FinalCallCategory = as.factor(FinalCallCategory)) %>%
mutate(FinalCallGroup = as.factor(FinalCallGroup))%>%
mutate(Neighborhood = as.factor(Neighborhood))%>%
mutate(ReportMonthYear = mdy(ReportMonthYear))%>%
mutate_if(is.character, as.double)%>%
separate("ReportMonthYear", c("Year", "Month", "Day"), sep = "-")%>%
select(-Day)%>%
mutate(date= as.yearmon(paste(Year, Month), "%Y %m"))
## Warning: There were 7 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `TimeInQueue_sec = .Primitive("as.double")(TimeInQueue_sec)`.
## Caused by warning:
## ! NAs introduced by coercion
## ℹ Run ]8;;ide:run:dplyr::last_dplyr_warnings()dplyr::last_dplyr_warnings()]8;; to see the 6 remaining warnings.
dispatch_calls2022 <-read.csv("https://raw.githubusercontent.com/karolo89/Raw_Data/main/dispatchedcalls_opendata_2022_0.csv")%>%
mutate(Priority = as.factor(Priority))%>%
mutate(FinalCallCategory = as.factor(FinalCallCategory)) %>%
mutate(FinalCallGroup = as.factor(FinalCallGroup))%>%
mutate(Neighborhood = as.factor(Neighborhood))%>%
mutate(ReportMonthYear = mdy(ReportMonthYear))%>%
mutate_if(is.character, as.double)%>%
separate("ReportMonthYear", c("Year", "Month", "Day"), sep = "-")%>%
select(-Day)%>%
mutate(date= as.yearmon(paste(Year, Month), "%Y %m"))
## Warning: There were 7 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `TimeInQueue_sec = .Primitive("as.double")(TimeInQueue_sec)`.
## Caused by warning:
## ! NAs introduced by coercion
## ℹ Run ]8;;ide:run:dplyr::last_dplyr_warnings()dplyr::last_dplyr_warnings()]8;; to see the 6 remaining warnings.
calls <- rbind(dispatch_calls2022, dispatch_calls2023)
month_call <- calls %>%
group_by(date, Year, FinalCallGroup)%>%
filter(FinalCallGroup!= "NULL") %>%
summarise(count = n()) %>%
arrange(desc(count))%>%
na.omit()
## `summarise()` has grouped output by 'date', 'Year'. You can override using the
## `.groups` argument.
head(month_call)
## # A tibble: 6 × 4
## # Groups: date, Year [6]
## date Year FinalCallGroup count
## <yearmon> <chr> <fct> <int>
## 1 Jul 2022 2022 Disorder 9220
## 2 Mar 2022 2022 Disorder 8911
## 3 Jun 2022 2022 Disorder 8823
## 4 May 2022 2022 Disorder 8646
## 5 Aug 2022 2022 Disorder 8541
## 6 Jan 2022 2022 Disorder 8442
p1_calls <- month_call%>%
ggplot(aes(x= fct_rev(fct_reorder(FinalCallGroup, count)), y= count))+
geom_bar(stat = 'identity', aes(color=FinalCallGroup, fill= FinalCallGroup))+
scale_y_continuous(labels = scales::number_format(scale = .001, suffix = "K"))+
scale_color_viridis_d()+
scale_fill_viridis_d()+
labs(title= "Total Calls by Group, 2022-23",
x="",
y= "")+
theme_minimal()+
theme(plot.margin = unit(c(0.5, 1, 0.5, 0.5), unit = "cm"),
legend.position = "none",
plot.title = element_text(family = "cherry", hjust = 0.5, size = 20, face = "bold",
margin = margin(t = 10, b = 10)),
panel.background = element_rect(colour = "#fdf8ec", fill = "#fdf8ec"),
plot.background = element_rect(colour = "#fdf8ec", fill = "#fdf8ec"),
legend.background = element_rect(colour = "#fdf8ec", fill = "#fdf8ec"))
p1_calls
font_add_google(name = "Bungee Shade", family = "bungee")
font_add_google(name = "Dosis", family = "dosis")
showtext_auto()
text_calls <- glue::glue("Most of the dispatched calls for service in the last year <br>
are related to disturbances or other problems that requiere a police response
to assess and resolve the situation")
group_month <- calls%>%
group_by(date, FinalCallGroup)%>%
summarise(num= n())%>%
mutate(date= as.Date(date))%>%
arrange(desc(num))%>%
top_n(5)
## `summarise()` has grouped output by 'date'. You can override using the
## `.groups` argument.
## Selecting by num
ggplot(group_month, aes(date, num, colour= FinalCallGroup, group= FinalCallGroup))+
geom_line(aes(linetype=FinalCallGroup)) +
geom_point(size = 2) +
scale_color_viridis_d()+
scale_y_continuous(limits = c(0, 10000), labels = scales::number_format(scale = .001, suffix = "K"))+
coord_cartesian(expand = F) +
labs(title= "Total Calls by Group, 2022-23",
x="",
y= "")+
theme(
legend.title = element_blank(),
legend.position = "bottom",
panel.background = element_rect(fill = "#FAFAFA", colour = "#FAFAFA"),
plot.background = element_rect(fill = "#FAFAFA", colour = "#FAFAFA"),
legend.background = element_rect(fill = "transparent", colour = "transparent"),
legend.key = element_rect(fill = "transparent", colour = "transparent"),
plot.title = element_text(family = "cherry", hjust = 0.5, size = 14, face = "bold",
margin = margin(t = 10, b = 10)),
axis.text = element_text(family = "dosis"),
plot.margin = unit(c(0.5, 0.8, 0.5, 0.5), "cm"),
panel.grid.major = element_line(colour = "#DEDEDE"),
panel.grid.minor = element_blank())
