Недавно мы загружены на http://hal.archives-ouvertes.fr/hal-00725090 пересмотренной версии нашей работы, с Ивна галльским (ака @ 3wen ) на Визуализируя пространственные процессы с использованием коррекции Рипли: применение к телесно-травме автомобильной аварии место расположения
В этой статье мы исследуем (и расширяем) метод окружности Рипли, чтобы исправить смещение оценки плотности краев (или границ) областей. Идея метода была теоретической и трудной для реализации. Мы предоставляем простую технику — основанную на свойствах гауссовых ядер — для эффективного вычисления весов для коррекции смещения границы на границах интересующей области с автоматическим выбором оптимального радиуса для метода. Обсуждается иллюстрация местоположения автомобильной аварии с телесными повреждениями (и горячих точек) в западной части Франции, где много несчастных случаев происходит вблизи крупных городов, рядом с морем .
Наброски кода R можно найти в статье, чтобы составить карты и описать влияние нашей граничной коррекции . Например, в Финистере распределение автомобильной аварии является следующим (со стандартным ядром слева и с исправлением справа), с 186 претензиями (включая телесные повреждения)
и в Морбиан с 180 претензиями, наблюдавшимися в конкретный год (насколько я помню, 2008),
Код такой же, как и в прошлом году , за исключением, возможно, построения графиков. Во-первых, необходимо определить цветовую шкалу и связанные с ней разрывы.
breaks <- seq( min( result $ZNA , na.rm = TRUE ) * 0.95 , max ( result$ZNA , na.rm = TRUE ) * 1.05 , length = 21) col <- rev( heat . colors (20) )
чтобы наконец построить оценку
image . plot ( result $X, result $Y, result $ZNA , xlim = range (pol[, 1]) , ylim = range (pol[, 2]) , breaks = breaks , col = col , xlab = "", ylab = "", xaxt = "n", yaxt = "n", bty = "n", zlim = range ( breaks ), horizontal = TRUE )
Можно добавить контур, наблюдения и границу многоугольника.
contour ( result $X, result $Y, result $ZNA , add = TRUE , col = "grey ") points (X[, 1], X[, 2], pch = 19, cex = 0.2 , col = " dodger blue") polygon (pol , lwd = 2)
Теперь, если кто-то хочет улучшить эстетику карты, добавив базовую карту Google Maps, первое, что нужно сделать — после загрузки пакета ggmap — это получить базовую карту
theMap <- get_map( location =c( left =min (pol [ ,1]) , bottom =min (pol[ ,2]) , right =max (pol [ ,1]) , top =max (pol [ ,2])), source =" google ", messaging =F, color ="bw")
Конечно, данные должны быть представлены в правильном формате
getMelt <- function ( smoothed ){
res <- melt ( smoothed $ZNA)
res [ ,1] <- smoothed $X[res [ ,1]]
res [ ,2] <- smoothed $Y[res [ ,2]]
names (res) <- list ("X","Y","ZNA")
return (res )
}
smCont <- getMelt ( result )
Перерывы и метки должны быть подготовлены
theLabels <- round (breaks ,2) indLabels <- floor (seq (1, length ( theLabels ),length .out =5)) indLabels [ length ( indLabels )] <- length ( theLabels ) theLabels <- as. character ( theLabels [ indLabels ]) theLabels [ theLabels =="0"] <- " 0.00 "
Теперь карта может быть построена
P <- ggmap ( theMap ) P <- P + geom _ point (aes(x=X, y=Y, col=ZNA), alpha =.3 , data = smCont [!is.na( smCont $ZNA ) ,], na.rm= TRUE )
Можно добавить контур
P <- P + geom _ contour ( data = smCont [!is.na( smCont $ZNA) ,] ,aes(x= X, y=Y, z=ZNA ), alpha =0.5 , colour =" white ")
и цвета должны быть обновлены
P <- P + scale _ colour _ gradient ( name ="", low=" yellow ", high =" red", breaks = breaks [ indLabels ], limits = range ( breaks ), labels = theLabels )
Чтобы убрать ось легенды и метки, тема должна быть обновлена
P <- P + theme ( panel . grid . minor = element _ line ( colour =NA), panel . grid . minor = element _ line ( colour =NA), panel . background = element _ rect ( fill =NA , colour =NA), axis . text .x= element _ blank() , axis . text .y= element _ blank () , axis . ticks .x= element _ blank() , axis . ticks .y= element _ blank () , axis . title = element _ blank() , rect = element _ blank ())
Последний шаг, чтобы нарисовать границу многоугольника
polDF <- data . frame (pol)
colnames ( polDF ) <- list ("lon","lat")
(P <- P + geom _ polygon ( data =polDF , mapping =( aes(x=lon , y=lat)), colour =" black ", fill =NA))
Затем мы применили эту методологию для оценки плотности дорожной сети в этих двух регионах, чтобы понять, означает ли высокая интенсивность, что это опасная зона, или просто потому, что там много трафика (больше трафика, больше несчастный случай),
Мы использовали набор данных, полученный на веб-сайте Geofabrik, который предоставляет данные Open-StreetMap. Каждое наблюдение представляет собой отрезок дороги и содержит несколько точек, идентифицированных по их географическим координатам, которые позволяют рисовать линии. Мы использовали эти точки для оценки показателя интенсивности дорожного движения, с весом от 10 (шоссе) до 1 (дороги общего пользования).
splitroad <- function ( listroad , h = 0.0025) {
pts = NULL
weights <- types . weights [ match ( unique ( listroad $ type ), types .
weights $ type ), " weight "]
for (i in 1:( length ( listroad ) - 1)) {
d = diag (as. matrix ( dist ( listroad [[i]]))[, 2: nrow ( listroad
[[i ]]) ]))
}}
return (pts )
}
См. Блог Ewen для получения более подробной информации о коде, http://editerna.free.fr/blog/… . Обратите внимание, что Юэн опубликовала постер (на французском языке) для конференции http://r2013-lyon.sciencesconf.org/ , которая будет организована в Лионе 27-28 июня, см.
— Подробнее на: http://freakonometrics.hypotheses.org/7129#sthash.8z857zql.dpuf