---
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)]
StadiaKey <- keys$key[match("Stadia", 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

<https://api.openweathermap.org/data/2.5/weather?q=Iowa+City,IA&mode=xml&appid=>_key_

or

<https://api.openweathermap.org/data/2.5/weather?lat=41.66&lon=-91.53&mode=xml&appid=>_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:

<https://forecast.weather.gov/zipcity.php?inputstring=Iowa+City,IA>

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.hadley.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:
  
  <https://forecast.weather.gov/MapClick.php?lat=41.7&lon=-91.5&FcstType=json>

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:

<!-- Originally from
http://www.sujee.net/tech/articles/geocoded/cities.csv.zip
-->

```{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](https://maps.stamen.com/),
[OpenStreatMap](https://www.openstreetmap.org/), and
[Stadia](https://stadiamaps.com/).

```{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")
```

Stamen maps are now hosted at Stadia Maps. An API key is required, but
no credit card is necessary to sign up and there is a free tier for
non-commercial use.

```{r, cache = TRUE, message = FALSE}
register_stadiamaps(StadiaKey, write = FALSE)
maptype <- "stamen_terrain"
maptype <- "stamen_toner"
map <- get_stadiamap(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
```
