--- title: "Creating a Current Temperature Map" output: html_document: toc: yes code_download: true code_folding: "hide" date: "`r format(Sys.time(), '%d %B, %Y %H:%M')`" --- ```{r global_options, include = FALSE} knitr::opts_chunk$set(collapse = TRUE, class.source = "fold-show", fig.align = "center") ``` ## Finding the Current Temperature ### Open Weather Map ```{r, include = FALSE} ## keys are stored in the parent directory keys <- as.data.frame(read.dcf("../APIKEYS")) OWMkey <- keys$key[match("OWM", keys$name)] ``` [Open Weather Map](https://openweathermap.org/) provides an [API](https://openweathermap.org/api) for returning weather information in JSON or XML format. A query requesting the current temperature in Iowa City format is XML format would would use a URL of the form _key_ or _key_ with _key_ replaced by your API key (free, but requires registration). Here is a simple function to obtain the current temperature for from Open Weather Map based on latitude and longitude: ```{r} library(xml2) findTempOWM <- function(lat, lon) { base <- "https://api.openweathermap.org/data/2.5/weather" url <- sprintf("%s?lat=%f&lon=%f&mode=xml&units=Imperial&appid=%s", base, lat, lon, OWMkey) page <- read_xml(url) as.numeric(xml_text(xml_find_first(page, "//temperature/@value"))) } ``` For Iowa City you would use ```{r, eval = FALSE} findTempOWM(41.7, -91.5) ``` This function should be robust since the format of the response is documented and should not change. Using commercial web services should be done with care as there are typically limitations and license terms to be considered. They may also come and go: Google’s API was shut down in 2012. ### National Weather Service The National Weather Service provides a site that produces forecasts in a web page for a URL like this: This function uses the National Weather Service site to find the current temperature by parsing the HTML data in the response: ```{r} findTempGov <- function(citystate) { url <- paste("https://forecast.weather.gov/zipcity.php?inputstring", url_escape(citystate), sep = "=") page <- read_html(url) xpath <- "//p[@class=\"myforecast-current-lrg\"]" tempNode <- xml_find_first(page, xpath) nodeText <- xml_text(tempNode) as.numeric(sub("([-+]?[[:digit:]]+).*", "\\1", nodeText)) } ``` For Iowa City you can use ```{r, eval = FALSE} findTempGov("Iowa City, IA") ``` This will need to be revised whenever the format of the page changes, as happened sometime in 2012. Murrell’s Data Technologies book discusses XML, XPATH queries, regular expressions, and how to work with these in R. Some other resources for regular expressions: * [Regular-Expressions.info](https://www.regular-expressions.info/) * [_R for Data Science_](https://r4ds.had.co.nz/) Recently the server has either been overloaded or modified to reject requests from the same address that are too close together so it is not currently useful for collecting temperatures at multile locations. The National Weather Service also provides several APIs, including a REST API that returns JSON (XML may be available but didn't seem to work right for me) that use a url like this: You can read the temperature from this API using the `fromJSON` function from the `jsonlite` package: ```{r, eval= FALSE} library(jsonlite) icurl <- "http://forecast.weather.gov/MapClick.php?lat=41.7&lon=-91.5&FcstType=json" icjson <- fromJSON(icurl) icjson$currentobservation$Temp ``` Uncortunately this also seems unreliable at the moment. ## Temperatures and Locations for Some Iowa Cities A small selection of Iowa cities: ```{r} places <- c("Ames", "Burlington", "Cedar Rapids", "Clinton", "Council Bluffs", "Des Moines", "Dubuque", "Fort Dodge", "Iowa City", "Keokuk", "Marshalltown", "Mason City", "Newton", "Ottumwa", "Sioux City", "Waterloo") ``` Currently the OWM API seems most reliable. To look up temperatures with that API, and to plot them on a map, we need to find the locations of these cities. We can obtain a file of geocoded cities and read it into R: ```{r} if (! file.exists("cities.csv")) { download.file("http://www.stat.uiowa.edu/~luke/data/cities.csv.zip", "cities.csv.zip") unzip("cities.csv.zip") } cities <- read.csv("cities.csv", header = FALSE) names(cities) <- c("City", "State", "Lat", "Lon") head(cities) ``` Select the cities we want and find their temperatures: ```{r, message = FALSE} library(dplyr) ``` ```{r} temploc <- filter(cities, City %in% toupper(places), State == "IA") %>% mutate(temp = mapply(findTempOWM, Lat, Lon)) head(temploc) ``` Remove any rows with missing temeratures: ```{r} temploc <- filter(temploc, ! is.na(temp)) ``` ## Creating the Map We can use the `borders` function from `ggplot2` along with `geom_text` to show the results: ```{r} library(ggplot2) library(ggthemes) tpoints <- geom_text(aes(x = Lon, y = Lat, label = round(temp)), color = "red", fontface = "bold", data = temploc) p <- ggplot() + borders("county", "iowa") + tpoints + coord_map() + theme_map() p ``` To add contours we can use `interp` from the `interp` package and the `geom_contour` function: ```{r} library(interp) surface <- with(temploc, interp(Lon, Lat, temp, linear = FALSE)) srfc <- expand.grid(Lon = surface$x, Lat = surface$y) srfc$temp <- as.vector(surface$z) tconts <- geom_contour(aes(x = Lon, y = Lat, z = temp), data = srfc, na.rm = TRUE, bins = 6) p + tconts + tpoints ``` The `ggmap` package provides further map support, including background maps from [Google](http://maps.google.com), [Stamen](http://maps.stamen.com), and [OpenStreatMap](https://www.openstreetmap.org/). ```{r} library(ggmap) ``` Using Google maps now requires an API key. ```{r, include = FALSE, eval = FALSE} map <- get_googlemap(c(-93.3, 41.7), zoom = 7, maptype = "terrain") ``` Downloading a Stamen map: ```{r, cache = TRUE, message = FALSE} maptype <- "terrain" maptype <- "toner" map <- get_stamenmap(c(-97.2, 40.4, -89.9, 43.6), zoom = 8, maptype = maptype) ``` `ggmap` creates a `ggplot` object, sets the coordinate system, and makes some theme adjustments: ```{r} ggmap(map) ``` Add the county borders, contours, and temperatures. ```{r} ggmap(map) + borders("county", "iowa") + tconts + tpoints ```