[Перевод] Как построить географическую панель наблюдения с данными в реальном времени05.01.2018 16:03

В этом посте покажу, как построить интерактивную географическую панель наблюдения с Displayr, Plotly и R. Особенно интересно, что она отслеживает позицию военных самолетов в реальном времени. Для этого я собираюсь взять данные из двух разных источников (регионы на основании размера ВВС и отслеживание позиции самолетов в реальном времени). Панель наблюдения отображает динамические данные двумя способами: оттенок региона (чтобы показать численность ВВС в стране) и точки-маркеры (для позиций самолетов). Потом я построю карту, чтобы аккуратно и красиво отобразить все эти данные.

Считывание табличных данных из сети

Я собираюсь покрасить каждую страну на карте в соответствии с численностью ее ВВС. Для этого нужен список воздушых судов по каждой стране. К счастью, Википедия всегда к нашим услугам, и там есть именно то, что нужно (здесь). Код ниже считывает данные и чистит их для представления в виде удобной таблицы.

library(httr)
library(XML)
 
# считать таблицу по URL
url <- "https://en.wikipedia.org/wiki/List_of_countries_by_level_of_military_equipment#List"
r <- GET(url)
airforces <- readHTMLTable(doc = content(r, "text"))[[2]]
 
# почистить необходимые колонки
airforces <- airforces[-1, c("Country[note 1]", "Military aircraft[note 3]")]
colnames(airforces) <- c("Country", "MilitaryAircraft")
remove.bracket.content <- function(s) {
return(gsub("\\[.+\\]", "", s))
}
airforces <- data.frame(apply(airforces, 2, remove.bracket.content))
airforces$MilitaryAircraft <- as.numeric(gsub(",", "", airforces$MilitaryAircraft))
airforces

Пулинг данных в реальном времени со всей земли

По сравнению с тем, что выше, второй источник данных более динамический. Я использую ADS-B, которые представляют информацию о полетах в режиме реального времени по всей планете. Не все военные операции сверхсекретные. На самом деле, некоторые военные самолеты передают свою позицию в открытом доступе.

Для сопоставления этой информации я строю URL, чтобы получить JSON-объект с информацией о военном самолете (JSON — гибкий текстовый формат для обмена данными). Затем считываю JSON в data.frame.

library(jsonlite)</pre>
url <- "http://public-api.adsbexchange.com/VirtualRadar/AircraftList.json?"
url <- paste0(url, "fMilQ=TRUE")
 
positions <- fromJSON(url)$acList
 
if (length(positions) != 0) {
positions <- positions[positions$Type != "TEST", ]
positions <- positions[!is.na(positions$Lat), ]
}
positions

Раскрашивание стран на карте

Код ниже создает plotly-карту мира. Страны раскрашены сообразно численности ВВС, шкала показана в легенде. В терминологии plotly каждый слой карты называется trace.

library(plotly)
library(flipFormat)
 
# задать область карты и проекцию
g <- list(scope = "world",
showframe = FALSE, showcoastlines = TRUE,
projection = list(type = 'mercator'),
lonaxis = list(range = c(-140, 179)),
lataxis = list(range = c(-55, 70)),
resolution = 50) # разрешение повыше
 
# закрасить страны по размеру ВВС
p <- plot_geo(airforces) %>%
 
add_trace(data = airforces, name = "Airforce",
z = ~MilitaryAircraft, color = ~MilitaryAircraft,
colors = 'Blues', locations = ~Country,
marker = list(line = list(color = toRGB("grey"), width = 0.5)),
showscale = TRUE, locationmode = "country names",
colorbar = list(title = 'Airforce', separatethousands = TRUE)) %>%
config(displayModeBar = F) %>%
 
layout(geo = g,
margin = list(l=0, r=0, t=0, b=0, pad=0),
paper_bgcolor = 'transparent')

Добавление маркеров для самолетов

Наконец, добавим маркеры, показывающие позиции самолетов, как еще один trace. Я использую разные цвета для тех, у которых скорость меньше 200 узлов и высота меньше 610 метров. Больше информации о самолетах во всплывающих подсказках.

aircolors = rep("airborne", nrow(positions))  # создать вектор со статусом каждого самолета
aircolors[positions$Spd < 200 & positions$Alt < 2000] <- "ground/approach"
hovertext = paste0("Operator:", positions$Op, "\nModel:", positions$Mdl, 
"\nAltitide(ft):", sapply(positions$Alt, FormatAsReal))
hoverinfo = rep("all", nrow(positions))
 
p = add_trace(p, data = positions, x = positions$Long, y = positions$Lat, 
 color = aircolors, hovertext = hovertext, showlegend = FALSE)

Вот конечный результат.

Несколько завершающих штрихов

Хотя карта выше и показывает все, что нужно, ее легко сделать более удобной и красивой. Displayr позволяет добавить элемент управления для переключения между текстовыми и графическими аннотациями и фоном. Вот ссылка на окончательную версию панели наблюдения и скриншот ниже.

© Habrahabr.ru