Get me to the church on time with R spatial

Using Google location data to prove church attendance and get married.

Duncan Garmonsway
May 1, 2019
Tweet: “When my church asked for evidence of regular attendance, I bet they didn’t expect #rstats {sf} {ggcal} and Google location history.” Reply by @mattdray: “Ah, so you turned to script in liu of scripture.”
Tweet: “When my church asked for evidence of regular attendance, I bet they didn’t expect #rstats {sf} {ggcal} and Google location history.” Reply by @mattdray: “Ah, so you turned to script in liu of scripture.”

Churches have excellent transport connections, plenty of seating, a resident celebrant, are open on weekends, and are often pretty. In other words they are excellent wedding venues. But they can, and probably will, decline to marry couples that have no connection with the church, such as living in the parish, and/or worshipping there.

My fiancée and I applied to marry at a church where neither of us lives, but where I sing in the choir. The church responded with a form for us to circle my qualifying connection (regular worshipper for six months) and – the catch – provide documentary evidence.

Evidence?

So I downloaded my Google location data. It’s always on (God and Google know the inmost secrets of my heart), and like everyone else I keep my phone within arm’s reach 24/7. All I needed then was:

There are a couple of similar blog posts around, so I won’t dwell on the parts that worked.


library(jsonlite)
library(lubridate)
library(tidyverse)
library(sf)
library(ggmap)
library(ggcal) # devtools::install_github("jayjacobs/ggcal")
library(here)

Where is the church? Google knows.


church <-
  st_sf(name = "church", st_sfc(st_point(c(55.8735208,-4.2763132)))) %>%
  st_set_crs(4326) # WGS84 (GPS)

Where was I? Google knows. For this post I load it from an R data file because reading the JSON is slow.


# locationdata <- fromJSON(here("Location History.json"))
# saveRDS(locationdata, "locationdata.Rds")
locationdata <- readRDS(here("locationdata.Rds"))

This is the jankey bit. Google’s latitude and longitude are integers, so you have to divide them by ten million (fine) but the longitude is wrong by 69.4970 degrees or so. Perhaps it isn’t wrong for you. I also had to take the modulus because some points have wrapped around the earth to more than 360. I, um, Googled the problem but couldn’t locate an explanation. The final line calculates the distance of each point from the church, in meters or feet or seconds or something.


locs <-
  locationdata$locations %>%
  as_tibble() %>%
  select(latitudeE7, longitudeE7, `timestampMs`) %>%
  transmute(lat = latitudeE7 / 1E7,
            lon = (longitudeE7 / 1E7) %% 360 - 69.4970, # Google you had ONE JOB
            date = as.POSIXct(as.numeric(timestampMs)/1000, origin="1970-01-01"),
            day = as.Date(date)) %>%
  st_as_sf(coords = c("lat", "lon"), remove = FALSE) %>%
  st_set_crs(4326) %>% # WGS84 (GPS)
  mutate(dist_from_church = as.numeric(st_distance(geometry, church)))

To show you where the magic number 69.4970 came from, here’s a map of the points. I refined the magic number until they lined up with the roads.


register_google(key = read_file(here("google-api-key")))

m <- get_map(location = c(lat = 55.8735208, lon = -4.2763132), # church again
             source = "stamen",
             zoom = 15)

ggmap(m) +
  geom_point(aes(-4.2763132, 55.8735208)) +
  geom_point(aes(lon, lat),
             colour = "red",
             data = filter(locs, dist_from_church < 1000))

{ggcal} plots calendars as graphs. This is what went to the vicar. Not really, because I’m not getting married in Glasgow, hah tricked you, but I did used to sing there a while back so it makes a safe-ish example for this post, and I did send the real one to the parish office.


in_church <-
  locs %>%
  filter(dist_from_church <= 100) %>% # So what if I am in the tea shop?
  filter(date <= ymd("2017-02-28")) %>%
  distinct(day) %>%
  pull(day)

in_church_range <- range(in_church)
in_church_cal <- seq(in_church_range[1], in_church_range[2], by = "day")
in_church_today <- in_church_cal %in% in_church

ggcal(in_church_cal, in_church_today) +
  ggtitle("Days when Duncan Garmonsway was within 100 meters of church",
          subtitle = "Google location history")

Expand for session info


options(width = 100)
sessioninfo::session_info()

─ Session info ───────────────────────────────────────────────────────────────────────────────────
 setting  value                       
 version  R version 3.6.0 (2019-04-26)
 os       Arch Linux                  
 system   x86_64, linux-gnu           
 ui       X11                         
 language                             
 collate  en_NZ.UTF-8                 
 ctype    en_GB.UTF-8                 
 tz       Europe/London               
 date     2019-04-30                  

─ Packages ───────────────────────────────────────────────────────────────────────────────────────
 package     * version date       lib source                          
 assertthat    0.2.1   2019-03-21 [1] CRAN (R 3.6.0)                  
 backports     1.1.4   2019-04-10 [1] CRAN (R 3.6.0)                  
 bitops        1.0-6   2013-08-17 [1] CRAN (R 3.6.0)                  
 bookdown      0.9     2018-12-21 [1] CRAN (R 3.6.0)                  
 broom         0.5.2   2019-04-07 [1] CRAN (R 3.6.0)                  
 callr         3.2.0   2019-03-15 [1] CRAN (R 3.6.0)                  
 cellranger    1.1.0   2016-07-27 [1] CRAN (R 3.6.0)                  
 class         7.3-15  2019-01-01 [2] CRAN (R 3.6.0)                  
 classInt      0.3-3   2019-04-26 [1] CRAN (R 3.6.0)                  
 cli           1.1.0   2019-03-19 [1] CRAN (R 3.6.0)                  
 codetools     0.2-16  2018-12-24 [2] CRAN (R 3.6.0)                  
 colorout    * 1.2-1   2019-04-29 [1] local                           
 colorspace    1.4-1   2019-03-18 [1] CRAN (R 3.6.0)                  
 crayon        1.3.4   2017-09-16 [1] CRAN (R 3.6.0)                  
 curl          3.3     2019-01-10 [1] CRAN (R 3.6.0)                  
 DBI           1.0.0   2018-05-02 [1] CRAN (R 3.6.0)                  
 desc          1.2.0   2018-05-01 [1] CRAN (R 3.6.0)                  
 devtools    * 2.0.2   2019-04-08 [1] CRAN (R 3.6.0)                  
 digest        0.6.18  2018-10-10 [1] CRAN (R 3.6.0)                  
 dplyr       * 0.8.0.1 2019-02-15 [1] CRAN (R 3.6.0)                  
 e1071         1.7-1   2019-03-19 [1] CRAN (R 3.6.0)                  
 evaluate      0.13    2019-02-12 [1] CRAN (R 3.6.0)                  
 forcats     * 0.4.0   2019-02-17 [1] CRAN (R 3.6.0)                  
 fs            1.2.7   2019-03-19 [1] CRAN (R 3.6.0)                  
 generics      0.0.2   2018-11-29 [1] CRAN (R 3.6.0)                  
 ggcal       * 0.1.0   2019-04-30 [1] Github (jayjacobs/ggcal@ab1a85a)
 ggmap       * 3.0.0   2019-02-05 [1] CRAN (R 3.6.0)                  
 ggplot2     * 3.1.1   2019-04-07 [1] CRAN (R 3.6.0)                  
 glue          1.3.1   2019-03-12 [1] CRAN (R 3.6.0)                  
 gtable        0.3.0   2019-03-25 [1] CRAN (R 3.6.0)                  
 haven         2.1.0   2019-02-19 [1] CRAN (R 3.6.0)                  
 here        * 0.1     2017-05-28 [1] CRAN (R 3.6.0)                  
 hms           0.4.2   2018-03-10 [1] CRAN (R 3.6.0)                  
 htmltools     0.3.6   2017-04-28 [1] CRAN (R 3.6.0)                  
 httr          1.4.0   2018-12-11 [1] CRAN (R 3.6.0)                  
 jpeg          0.1-8   2014-01-23 [1] CRAN (R 3.6.0)                  
 jsonlite    * 1.6     2018-12-07 [1] CRAN (R 3.6.0)                  
 KernSmooth    2.23-15 2015-06-29 [2] CRAN (R 3.6.0)                  
 knitr         1.22    2019-03-08 [1] CRAN (R 3.6.0)                  
 labeling      0.3     2014-08-23 [1] CRAN (R 3.6.0)                  
 lattice       0.20-38 2018-11-04 [2] CRAN (R 3.6.0)                  
 lazyeval      0.2.2   2019-03-15 [1] CRAN (R 3.6.0)                  
 lubridate   * 1.7.4   2018-04-11 [1] CRAN (R 3.6.0)                  
 magrittr      1.5     2014-11-22 [1] CRAN (R 3.6.0)                  
 memoise       1.1.0   2017-04-21 [1] CRAN (R 3.6.0)                  
 mime          0.6     2018-10-05 [1] CRAN (R 3.6.0)                  
 modelr        0.1.4   2019-02-18 [1] CRAN (R 3.6.0)                  
 munsell       0.5.0   2018-06-12 [1] CRAN (R 3.6.0)                  
 nlme          3.1-139 2019-04-09 [2] CRAN (R 3.6.0)                  
 nvimcom     * 0.9-82  2019-04-26 [1] local                           
 pillar        1.3.1   2018-12-15 [1] CRAN (R 3.6.0)                  
 pkgbuild      1.0.3   2019-03-20 [1] CRAN (R 3.6.0)                  
 pkgconfig     2.0.2   2018-08-16 [1] CRAN (R 3.6.0)                  
 pkgload       1.0.2   2018-10-29 [1] CRAN (R 3.6.0)                  
 plyr          1.8.4   2016-06-08 [1] CRAN (R 3.6.0)                  
 png           0.1-7   2013-12-03 [1] CRAN (R 3.6.0)                  
 prettyunits   1.0.2   2015-07-13 [1] CRAN (R 3.6.0)                  
 processx      3.3.0   2019-03-10 [1] CRAN (R 3.6.0)                  
 ps            1.3.0   2018-12-21 [1] CRAN (R 3.6.0)                  
 purrr       * 0.3.2   2019-03-15 [1] CRAN (R 3.6.0)                  
 R6            2.4.0   2019-02-14 [1] CRAN (R 3.6.0)                  
 radix         0.6     2018-12-09 [1] CRAN (R 3.6.0)                  
 Rcpp          1.0.1   2019-03-17 [1] CRAN (R 3.6.0)                  
 readr       * 1.3.1   2018-12-21 [1] CRAN (R 3.6.0)                  
 readxl        1.3.1   2019-03-13 [1] CRAN (R 3.6.0)                  
 remotes       2.0.4   2019-04-10 [1] CRAN (R 3.6.0)                  
 RgoogleMaps   1.4.3   2018-11-07 [1] CRAN (R 3.6.0)                  
 rjson         0.2.20  2018-06-08 [1] CRAN (R 3.6.0)                  
 rlang         0.3.4   2019-04-07 [1] CRAN (R 3.6.0)                  
 rmarkdown   * 1.12    2019-03-14 [1] CRAN (R 3.6.0)                  
 rprojroot     1.3-2   2018-01-03 [1] CRAN (R 3.6.0)                  
 rstudioapi    0.10    2019-03-19 [1] CRAN (R 3.6.0)                  
 rvest         0.3.3   2019-04-11 [1] CRAN (R 3.6.0)                  
 scales        1.0.0   2018-08-09 [1] CRAN (R 3.6.0)                  
 sessioninfo   1.1.1   2018-11-05 [1] CRAN (R 3.6.0)                  
 sf          * 0.7-4   2019-04-25 [1] CRAN (R 3.6.0)                  
 stringi       1.4.3   2019-03-12 [1] CRAN (R 3.6.0)                  
 stringr     * 1.4.0   2019-02-10 [1] CRAN (R 3.6.0)                  
 testthat      2.1.1   2019-04-23 [1] CRAN (R 3.6.0)                  
 tibble      * 2.1.1   2019-03-16 [1] CRAN (R 3.6.0)                  
 tidyr       * 0.8.3   2019-03-01 [1] CRAN (R 3.6.0)                  
 tidyselect    0.2.5   2018-10-11 [1] CRAN (R 3.6.0)                  
 tidyverse   * 1.2.1   2017-11-14 [1] CRAN (R 3.6.0)                  
 units         0.6-2   2018-12-05 [1] CRAN (R 3.6.0)                  
 usethis     * 1.5.0   2019-04-07 [1] CRAN (R 3.6.0)                  
 withr         2.1.2   2018-03-15 [1] CRAN (R 3.6.0)                  
 xfun          0.6     2019-04-02 [1] CRAN (R 3.6.0)                  
 xml2          1.2.0   2018-01-24 [1] CRAN (R 3.6.0)                  
 yaml          2.2.0   2018-07-25 [1] CRAN (R 3.6.0)                  

[1] /home/nacnudus/R/x86_64-pc-linux-gnu-library/3.6
[2] /usr/lib/R/library

Corrections

If you see mistakes or want to suggest changes, please create an issue on the source repository.

Reuse

Text and figures are licensed under Creative Commons Attribution CC BY 4.0. Source code is available at https://github.com/nacnudus/duncangarmonsway, unless otherwise noted. The figures that have been reused from other sources don't fall under this license and can be recognized by a note in their caption: "Figure from ...".

Citation

For attribution, please cite this work as

Garmonsway (2019, May 1). Duncan Garmonsway: Get me to the church on time with R spatial. Retrieved from https://nacnudus.github.io/duncangarmonsway/posts/2019-04-22-get-me-to-the-church-on-time-with-r-spatial/

BibTeX citation

@misc{garmonsway2019get,
  author = {Garmonsway, Duncan},
  title = {Duncan Garmonsway: Get me to the church on time with R spatial},
  url = {https://nacnudus.github.io/duncangarmonsway/posts/2019-04-22-get-me-to-the-church-on-time-with-r-spatial/},
  year = {2019}
}