Мне было очень весело изучать данные о преступности в городах США через их порталы открытых данных, потому что данные о преступности в Торонто просто не были доступны.
Однако летом этого года Полиция Торонто запустила портал данных по общественной безопасности, чтобы повысить прозрачность между общественностью и офицерами. Соответственно, у меня была возможность исследовать преступления Торонто через Портал данных общественной безопасности полицейской службы Торонто. Меня особенно интересует Показатели серьезных преступлений (MCI) 2016, которые содержат табличный список из 32 612 отчетов за 2016 год (единственный год, когда данные были доступны).
Давайте посмотрим на данные с помощью R и посмотрим, есть ли что-нибудь интересное.
Данные
library(ggplot2) library(ggthemes) library(dplyr) library(viridis) library(tidyr) library(cluster) library(ggmap) library(maps)
После небольшого исследования я обнаружил, что было много дублирования (event_unique_id), поэтому давайте удалим это из наших данных.
toronto <- read.csv('toronto_crime.csv')
toronto <- subset(toronto, !duplicated(toronto$event_unique_id))
unique(toronto$occurrenceyear)
unique(toronto$reportedyear)
Нашли что-нибудь интересное? Год возникновения варьировался с 2000 по 2016 год, но отчетным годом для всех преступлений всегда является 2016 год. Это означает, что в 2016 году люди сообщали в полицию об инцидентах, которые произошли в предыдущие годы. Давайте посмотрим, сколько инцидентов, о которых было сообщено с опозданием, содержится в наших данных.
year_group <- group_by(toronto, occurrenceyear)
crime_by_year <- summarise(year_group,
n = n())
crime_by_year
2 инцидента произошли в 2000 году, 2 произошли в 2001 году и так далее. Однако подавляющее большинство событий произошло в 2016 году, поэтому мы будем использовать только инциденты 2016 года. И я также удаляю все столбцы, которые нам не нужны, а также четыре строки с пропущенными значениями.
drops <- c("X", "Y", "Index_", "ucr_code", "ucr_ext", "reporteddate", "reportedmonth", "reportedday", "reporteddayofyear", "reporteddayofweek", "reportedhour", "occurrencedayofyear", "reportedyear", "Division", "Hood_ID", "FID")
toronto <- toronto[, !(names(toronto) %in% drops)]
toronto <- toronto[toronto$occurrenceyear == 2016, ]
toronto <- toronto[complete.cases(toronto), ]
Исследовать
Какие основные преступления были совершены в 2016 году?
indicator_group <- group_by(toronto, MCI)
crime_by_indicator <- summarise(indicator_group, n=n())
crime_by_indicator <- crime_by_indicator[order(crime_by_indicator$n, decreasing = TRUE),]
ggplot(aes(x = reorder(MCI, n), y = n), data = crime_by_indicator) +
geom_bar(stat = 'identity', width = 0.5) +
geom_text(aes(label = n), stat = 'identity', data = crime_by_indicator, hjust = -0.1, size = 3.5) +
coord_flip() +
xlab('Major Crime Indicators') +
ylab('Number of Occurrences') +
ggtitle('Major Crime Indicators Toronto 2016') +
theme_bw() +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
Нападение - самая распространенная форма насильственных преступлений в Торонто. Что такое нападение? В уголовном и гражданском праве нападение - это попытка начать вредный или оскорбительный контакт с человеком или угроза этого.
Какие бывают типы нападений? Какой тип худший?
assault <- toronto[toronto$MCI == 'Assault', ]
assault_group <- group_by(assault, offence)
assault_by_offence <- summarise(assault_group, n=n())
assault_by_offence <- assault_by_offence[order(assault_by_offence$n, decreasing = TRUE), ]
ggplot(aes(x = reorder(offence, n), y = n), data = assault_by_offence) +
geom_bar(stat = 'identity', width = 0.6) +
geom_text(aes(label = n), stat = 'identity', data = assault_by_offence, hjust = -0.1, size = 3) +
coord_flip() +
xlab('Types of Assault') +
ylab('Number of Occurrences') +
ggtitle('Assault Crime Toronto 2016') +
theme_bw() +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
Здесь не так много информации, так как наиболее часто встречающаяся категория нападения - это… нападение. Со временем я узнал о различных типах нападений через Attorneys.com.
Тогда давайте посмотрим на самые распространенные нарушения
offence_group <- group_by(toronto, offence)
crime_by_offence <- summarise(offence_group, n=n())
crime_by_offence <- crime_by_offence[order(crime_by_offence$n, decreasing = TRUE), ]
ggplot(aes(x = reorder(offence, n), y = n), data = crime_by_offence) +
geom_bar(stat = 'identity', width = 0.7) +
geom_text(aes(label = n), stat = 'identity', data = crime_by_offence, hjust = -0.1, size = 2) +
coord_flip() +
xlab('Types of Offence') +
ylab('Number of Occurrences') +
ggtitle('Offence Types Toronto 2016') +
theme_bw() +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
Нападение - наиболее распространенное нарушение, за ним следуют взлом и ввод. Согласно Викиучебнику, наиболее типичной формой взлома является проникновение в коммерческую недвижимость или частный дом с целью кражи собственности. Это указывает на то, что взлом и вход наиболее вероятны, когда никого нет дома или в офисе.
Как насчет преступлений по времени суток?
hour_group <- group_by(toronto, occurrencehour)
crime_hour <- summarise(hour_group, n=n())
ggplot(aes(x=occurrencehour, y=n), data = crime_hour) + geom_line(size = 2.5, alpha = 0.7, color = "mediumseagreen", group=1) +
geom_point(size = 0.5) +
ggtitle('Total Crimes by Hour of Day in Toronto 2016') +
ylab('Number of Occurrences') +
xlab('Hour(24-hour clock)') +
theme_bw() +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
Худший час - около полуночи, еще один пик - около полудня, а затем около 20:00.
Хорошо, но какие виды преступлений наиболее часты в каждый час дня?
hour_crime_group <- group_by(toronto, occurrencehour, MCI)
hour_crime <- summarise(hour_crime_group, n=n())
ggplot(aes(x=occurrencehour, y=n, color=MCI), data = hour_crime) +
geom_line(size=1.5) +
ggtitle('Crime Types by Hour of Day in Toronto 2016') +
ylab('Number of Occurrences') +
xlab('Hour(24-hour clock)') +
theme_bw() +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
Хотя нападения являются наиболее распространенными преступлениями в течение дня, они происходят чаще между поздним утром и ночью, чем ранним утром. С другой стороны, преступления с перерывом и вступлением чаще случаются по утрам и около полуночи (когда никого не было дома или в офисе). Ограбления и кражи автомобилей чаще происходили поздними вечерами. Все эти закономерности имеют смысл.
Где в Торонто были наиболее вероятны эти преступления?
location_group <- group_by(toronto, Neighbourhood)
crime_by_location <- summarise(location_group, n=n())
crime_by_location <- crime_by_location[order(crime_by_location$n, decreasing = TRUE), ]
crime_by_location_top20 <- head(crime_by_location, 20)
ggplot(aes(x = reorder(Neighbourhood, n), y = n), data = crime_by_location_top20) +
geom_bar(stat = 'identity', width = 0.6) +
geom_text(aes(label = n), stat = 'identity', data = crime_by_location_top20, hjust = -0.1, size = 3) +
coord_flip() +
xlab('Neighbourhoods') +
ylab('Number of Occurrences') +
ggtitle('Neighbourhoods with Most Crimes - Top 20') +
theme_bw() +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
Самый опасный район - это… Набережная. Этот обширный комплекс в центре города включает не только густонаселенные кварталы кондоминиумов, но и сверхактивный район развлечений. Результат: ошеломляющее количество насильственных преступлений и поджогов .
Второй по опасности район - коридор Черч-Йонге. Он пользуется популярностью среди студентов, поскольку находится недалеко от университета Райерсона и является домом на одной стороне гей-деревни Торонто. Тем не менее, в этом районе есть свои проблемы с преступностью, что немного удивительно, учитывая, насколько близко он находится к центру города.
Где самые безопасные районы?
tail(crime_by_location, 5)
Думаете о переезде в Торонто? Мы подобрали для вас ваш новый дом! Форест-Хилл-Саут - это безопасный, великолепный и богатый район в Торонто, который может похвастаться множеством красивых домов, таких как этот особняк.
Давайте сравним районы с наиболее распространенными типами правонарушений.
offence_location_group <- group_by(toronto, Neighbourhood, offence)
offence_type_by_location <- summarise(offence_location_group, n=n())
offence_type_by_location <- offence_type_by_location[order(offence_type_by_location$n, decreasing = TRUE), ]
offence_type_by_location_top20 <- head(offence_type_by_location, 20)
ggplot(aes(x = Neighbourhood, y=n, fill = offence), data=offence_type_by_location_top20) +
geom_bar(stat = 'identity', position = position_dodge(), width = 0.8) +
xlab('Neighbourhood') +
ylab('Number of Occurrence') +
ggtitle('Offence Type vs. Neighbourhood Toronto 2016') + theme_bw() +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = .4))
Я не ожидал чего-то подобного. Это некрасиво. Тем не менее, он сообщил нам, что помимо нападений, в Коридоре Черч-Йонге и набережной было больше всего преступлений, связанных с прорывом и въездом (не двигайтесь туда!), А в Западном Хамбер-Клервилле было больше всего преступлений, связанных с угоном транспортных средств (не парковайте свою машину там!).
Давай попробуем что-нибудь другое
crime_count <- toronto %>% group_by(occurrencemonth, MCI) %>% summarise(Total = n())
crime_count$occurrencemonth <- ordered(crime_count$occurrencemonth, levels = c('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December'))
ggplot(crime_count, aes(occurrencemonth, MCI, fill = Total)) +
geom_tile(size = 1, color = "white") +
scale_fill_viridis() +
geom_text(aes(label=Total), color='white') +
ggtitle("Major Crime Indicators by Month 2016") +
xlab('Month') +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
Намного лучше!
Нападение - самый распространенный вид преступления в любой месяц года без исключения. Похоже, что в мае произошло на несколько нападений больше, чем за все другие месяцы прошлого года.
day_count <- toronto %>% group_by(occurrencedayofweek, MCI) %>% summarise(Total = n())
ggplot(day_count, aes(occurrencedayofweek, MCI, fill = Total)) +
geom_tile(size = 1, color = "white") +
scale_fill_viridis() +
geom_text(aes(label=Total), color='white') +
ggtitle("Major Crime Indicators by Day of Week 2016") +
xlab('Day of Week') +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
В субботу и воскресенье было больше нападений, чем в любой другой день недели, и было меньше краж, чем в любые другие дни. Автоугонщики заняты практически каждый день недели.
Я ожидал обнаружить некоторые сезонные закономерности преступности, такие как перепады температуры и дневное время, могут быть связаны с преступностью в течение года, или начало и конец учебного года связаны с колебаниями преступности в течение года. Но данных за год недостаточно, чтобы развеять мои опасения. Я надеюсь, что в ближайшем будущем полицейские службы Торонто опубликуют больше данных через свой портал открытых данных.
Убийство
homicide <- read.csv('homicide.csv', stringsAsFactors = F)
homicide$Occurrence_Date <- as.Date(homicide$Occurrence_Date)
year_group <- group_by(homicide, Occurrence_year, Homicide_Type)
homicide_by_year <- summarise(year_group, n=n())
ggplot(aes(x = Occurrence_year, y=n, fill = Homicide_Type), data=homicide_by_year) +
geom_bar(stat = 'identity', position = position_dodge(), width = 0.8) +
xlab('Year') +
ylab('Number of Homicides') +
ggtitle('Homicide 2004-2016') + theme_bw() +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
2005 год был известен как Год оружия Торонто. Одиннадцать лет спустя, в 2016 году, в Торонто произошел очередной всплеск убийств с применением огнестрельного оружия.
homicide$month <- format(as.Date(homicide$Occurrence_Date) , "%B")
homicide_count <- homicide %>% group_by(Occurrence_year, month) %>% summarise(Total = n())
homicide_count$month <- ordered(homicide_count$month, levels = c('January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December'))
ggplot(homicide_count, aes(Occurrence_year, month, fill = Total)) +
geom_tile(size = 1, color = "white") +
scale_fill_viridis() +
geom_text(aes(label=Total), color='white') +
ggtitle("Homicides in Toronto (2004-2016)") +
xlab('Year') +
theme(plot.title = element_text(size = 16),
axis.title = element_text(size = 12, face = "bold"))
Вызывает беспокойство тот факт, что общее количество убийств в Торонто в 2016 году значительно увеличилось по сравнению с 2015 годом. Я надеюсь, что 2017 год будет лучше. Однако, когда я прочитал, что Торонто был признан самым безопасным городом на севере America by the Economist , я чувствовал себя намного безопаснее.
Кластеризация K-средних
K-Means - один из самых популярных алгоритмов «кластеризации». Это процесс разделения групп точек данных на небольшое количество кластеров. Используя наши данные о преступности, когда мы измеряем количество нападений и другие показатели, районы с большим количеством нападений будут сгруппированы вместе. Цель кластеризации K-средних - назначить кластер каждой точке данных (окрестности). Сначала мы разделяем точки данных (окрестности) на k кластеров, в которых каждое соседство принадлежит кластеру с ближайшим средним значением (служащим прототипом кластера).
В качестве одного из алгоритмов обучения без учителя мы используем K-Mean для построения моделей, которые помогают нам лучше понимать наши данные. Это позволяет нам группировать немаркированные точки данных.
Для проведения кластерного анализа наши данные должны выглядеть следующим образом:
by_groups <- group_by(toronto, MCI, Neighbourhood)
groups <- summarise(by_groups, n=n())
groups <- groups[c("Neighbourhood", "MCI", "n")]
groups_wide <- spread(groups, key = MCI, value = n)
Первый столбец - качественные данные следует удалить из анализа
z <- groups_wide[, -c(1,1)]
В данных не может быть пропущенных значений
z <- z[complete.cases(z), ]
Данные необходимо масштабировать для сравнения
m <- apply(z, 2, mean) s <- apply(z, 2, sd) z <- scale(z, m, s)
Определите количество кластеров
wss <- (nrow(z)-1) * sum(apply(z, 2, var)) for (i in 2:20) wss[i] <- sum(kmeans(z, centers=i)$withiness) plot(1:20, wss, type='b', xlab='Number of Clusters', ylab='Within groups sum of squares')
Поскольку этот график показывает очень сильный изгиб, на основе графика мы можем с уверенностью сказать, что нам не нужно более двух кластеров (центроидов).
Примерка модели
kc <- kmeans(z, 2) kc
Устный перевод:
- Первый кластер состоит из 121 района, а второй кластер - из 10 районов.
- Кластерный означает: если диапазоны этих чисел кажутся странными, это потому, что мы стандартизировали данные перед выполнением кластерного анализа. Отрицательные значения означают «ниже большинства», а положительные значения - «выше большинства». Таким образом, в кластере 1 есть районы с низким уровнем нападений, низким уровнем угона автомобилей, низким уровнем проникновения и въезда, низким уровнем грабежей и низким уровнем воровства. В кластере 2 есть районы с высоким уровнем нападения, высоким уровнем угонов автомобилей, высоким уровнем взлома и въезда, высоким уровнем грабежей и высоким уровнем краж. Хорошо, что эти две группы имеют значительную дисперсию по каждой переменной, поскольку это указывает на то, что каждая переменная играет значительную роль в классификации кластеров.
- Вектор кластеризации: первая, вторая и третья окрестности должны принадлежать кластеру 1, четвертая окрестность должна принадлежать кластеру 2 и так далее.
- Более относительным измерением будет внутреннее и промежуточное значения.
Внутреннее измерение сообщает нам сумму квадратов расстояния от каждой точки данных до центра кластера. Ниже - лучше. Betweenss сообщает нам сумму квадратов расстояния между центрами кластеров. В идеале мы хотим, чтобы центры кластеров были далеко друг от друга. - Доступные компоненты говорят сами за себя.
Построение результатов k-средних
z1 <- data.frame(z, kc$cluster) clusplot(z1, kc$cluster, color=TRUE, shade=F, labels=0, lines=0, main='k-Means Cluster Analysis')
Похоже, что наш выбор количества кластеров удачный, и у нас мало шума.
Иерархическая кластеризация
Для методов иерархической кластеризации дендрограмма является основным графическим инструментом для понимания кластерного решения.
z2 <- data.frame(z) distance <- dist(z2) hc <- hclust(distance)
Теперь, когда у нас есть кластерное решение. Посмотрим на результаты.
plot(hc, labels = groups_wide$Neighbourhood, main='Cluster Dendrogram', cex=0.65)
Если мы выберем любую высоту по оси Y дендрограммы и переместимся по дендрограмме, подсчитывая количество пересекаемых нами линий, каждая линия представляет собой кластер. Например, если мы посмотрим на высоту 10 и переместимся по оси x на этой высоте, мы пересечем две линии. Это определяет двухкластерное решение; проследив линию вниз по всем ее ветвям, мы сможем увидеть названия районов, которые входят в эти два кластера. Глядя на дендрограмму данных о преступлениях в Торонто, мы видим, что наши точки данных очень несбалансированы. С вершины дерева есть две отдельные группы; одна группа состоит из ветвей с ветвями и нескольких ветвей, в то время как другая группа состоит только из нескольких районов (мы видим, что эти районы являются наиболее опасными районами Торонто). Однако я хочу попробовать сразу несколько разных группировок, чтобы начать расследование.
counts = sapply(2:6,function(ncl)table(cutree(hc,ncl))) names(counts) = 2:6 counts
Интерпретация:
- При решении с 2 кластерами у нас 128 окрестностей в кластере 1 и 3 района в кластере 2.
- В решении с 3 кластерами у нас есть 128 окрестностей в кластере 1, 2 района в кластере 2 и 1 соседство в кластере 3. И так далее, пока мы не перейдем к решению с 6 кластерами.
На практике нам нужно решение, в котором не так много кластеров с небольшим количеством наблюдений, потому что это может затруднить интерпретацию наших результатов. В этом упражнении я остановлюсь на трехкластерном решении и посмотрю, какие результаты я получу.
member <- cutree(hc, 3) aggregate(z, list(member), mean)
В кластере 1 все показатели преступности находятся на отрицательной стороне. Кластер 1 также имеет значительные различия по каждой переменной по сравнению с кластером 2 и кластером 3. Кластер 2 выше по большинству показателей преступности, чем кластер 3, за исключением Auto Theft.
plot(silhouette(cutree(hc, 3), distance))
Значение ширины силуэта для кластера 3 равно нулю, а график силуэта показывает, что нам действительно не нужен третий кластер. Подавляющее большинство окрестностей принадлежит первому кластеру, и нашим решением будет 2-кластер.
Составление карты преступлений Торонто
В R. есть много пакетов для построения и обработки пространственных данных. Я собираюсь использовать ggmap для создания простой и удобной карты преступлений Торонто.
lat <- toronto$Lat
lon <- toronto$Long
crimes <- toronto$MCI
to_map <- data.frame(crimes, lat, lon)
colnames(to_map) <- c('crimes', 'lat', 'lon')
sbbox <- make_bbox(lon = toronto$Long, lat = toronto$Lat, f = 0.01)
my_map <- get_map(location = sbbox, maptype = "roadmap", scale = 2, color="bw", zoom = 10)
ggmap(my_map) +
geom_point(data=to_map, aes(x = lon, y = lat, color = "#27AE60"),
size = 0.5, alpha = 0.03) +
xlab('Longitude') +
ylab('Latitude') +
ggtitle('Location of Major Crime Indicators Toronto 2016') +
guides(color=FALSE)
На карте ясно видно, где происходят самые крупные преступления в городе. Большая концентрация в районе набережной и к югу от Северного Йорка более мирна, чем в любых других районах. Однако наложение точек бесполезно при сравнении областей с высокой плотностью, поэтому давайте оптимизируем эту визуализацию.
ggmap(my_map) +
geom_point(data=to_map, aes(x = lon, y = lat, color = "#27AE60"),
size = 0.5, alpha = 0.05) +
xlab('Longitude') +
ylab('Latitude') +
ggtitle('Location of Major Crime Indicators Toronto 2016') +
guides(color=FALSE) +
facet_wrap(~ crimes, nrow = 2)
Это, конечно, интереснее и информативнее. Некоторые преступления, такие как Нападения и Взлом и проникновение, происходят по всему городу, с концентрацией в районах Набережной. Другие преступления, такие как Auto Theft, имеют больше очков на западной стороне, чем на восточной стороне. Ограбление и кража в основном происходят в прибрежных зонах.
Резюме
На многие другие вопросы можно ответить, взглянув на данные Индикатора серьезных преступлений в Торонто. Но это нормально. Конечно, есть и другие интересные вещи, которые можно сделать с этими данными (например, создать информационную панель в MicroStrategy).
Как всегда, весь код можно найти на Github. Я был бы рад получить отзывы или вопросы по любому из вышеперечисленного.
