Считывание табличных данных из сети
Я собираюсь покрасить каждую страну на карте в соответствии с численностью ее ВВС. Для этого нужен список воздушых судов по каждой стране. К счастью, Википедия всегда к нашим услугам, и там есть именно то, что нужно (здесь). Код ниже считывает данные и чистит их для представления в виде удобной таблицы.
library(httr)
library(XML)
# считать таблицу по URL
url <- "http://ift.tt/2jIVeuc"
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://ift.tt/2hJ71op?"
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 позволяет добавить элемент управления для переключения между текстовыми и графическими аннотациями и фоном. Вот ссылка на окончательную версию панели наблюдения и скриншот ниже.
Комментариев нет:
Отправить комментарий