Summary

This is a document for visualising the bushfire spread around my family home in Nowra, NSW, Australia.

The data was obtained from NASA - FIRMS Archive Downloads.The frozen copy of this data (accessed on the 3rd of Jan 2020, restricted to Australia, range from 1st Dec to 3rd of Jan 2020) that I obtained can be found here.

Parts of this code will not be reproducible due to the ggmap Google API. You might want to consult the manual of this package to obtain the instructions of setting up your laptop with the API.

Loading

Packages

library(tidyverse)
## ── Attaching packages ─────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.2.1     ✓ purrr   0.3.3
## ✓ tibble  2.1.3     ✓ dplyr   0.8.3
## ✓ tidyr   1.0.0     ✓ stringr 1.4.0
## ✓ readr   1.3.1     ✓ forcats 0.4.0
## ── Conflicts ────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(ggmap)
## Google's Terms of Service: https://cloud.google.com/maps-platform/terms/.
## Please cite ggmap if you use it! See citation("ggmap") for details.
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following object is masked from 'package:base':
## 
##     date
library(gganimate)

Loading data

raw = readr::read_csv("DL_FIRE_M6_94441/fire_nrt_M6_94441.csv")
## Parsed with column specification:
## cols(
##   latitude = col_double(),
##   longitude = col_double(),
##   brightness = col_double(),
##   scan = col_double(),
##   track = col_double(),
##   acq_date = col_date(format = ""),
##   acq_time = col_character(),
##   satellite = col_character(),
##   instrument = col_character(),
##   confidence = col_double(),
##   version = col_character(),
##   bright_t31 = col_double(),
##   frp = col_double(),
##   daynight = col_character()
## )
glimpse(raw)
## Observations: 90,241
## Variables: 14
## $ latitude   <dbl> -35.493, -33.992, -33.991, -33.985, -33.983, -33.980, -33.…
## $ longitude  <dbl> 149.639, 150.129, 150.118, 150.085, 150.074, 150.051, 150.…
## $ brightness <dbl> 379.8, 380.4, 406.0, 334.4, 335.3, 329.2, 330.7, 327.1, 34…
## $ scan       <dbl> 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.1, 1.0, 1.0, 1.0, 1.0…
## $ track      <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ acq_date   <date> 2019-12-01, 2019-12-01, 2019-12-01, 2019-12-01, 2019-12-0…
## $ acq_time   <chr> "0000", "0000", "0000", "0000", "0000", "0000", "0000", "0…
## $ satellite  <chr> "Terra", "Terra", "Terra", "Terra", "Terra", "Terra", "Ter…
## $ instrument <chr> "MODIS", "MODIS", "MODIS", "MODIS", "MODIS", "MODIS", "MOD…
## $ confidence <dbl> 94, 100, 100, 66, 67, 70, 75, 59, 94, 100, 86, 80, 51, 46,…
## $ version    <chr> "6.0NRT", "6.0NRT", "6.0NRT", "6.0NRT", "6.0NRT", "6.0NRT"…
## $ bright_t31 <dbl> 288.9, 305.2, 315.7, 299.8, 299.1, 298.9, 299.0, 298.1, 29…
## $ frp        <dbl> 156.0, 157.8, 300.1, 28.2, 30.0, 24.0, 26.1, 21.4, 55.2, 1…
## $ daynight   <chr> "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D"…
raw$acq_time %>% unique %>% sample(size = 50) ## Four digits time stamp
##  [1] "0405" "0050" "0600" "0535" "1400" "0240" "0515" "0130" "1500" "1320"
## [11] "1630" "0125" "0650" "0045" "0025" "0325" "1330" "1525" "0630" "0550"
## [21] "0435" "1435" "0255" "1620" "1455" "1520" "1735" "2330" "1350" "0205"
## [31] "0120" "1650" "1345" "1255" "0520" "0250" "0310" "0040" "1440" "0235"
## [41] "0530" "1530" "0010" "1535" "1715" "2350" "2340" "0635" "1310" "0440"

Basic data cleaning and variable selection

I am only selecting some variables of interest to me.

clean = raw %>% 
  dplyr::transmute(
    latitude,
    longitude,
    brightness,
    confidence,
    bright_t31,
    frp,
    daynight,
    my_time = paste0(acq_date, " ", acq_time) %>% 
      lubridate::ymd_hm(), ## Aftering pasting the hours and minites, we use lubridate to clean this 
    confidence,
    conf_cat = cut(
      confidence, 
      c(-1, 50, 101), 
      labels = c("low", "high")) %>% as.factor,
    brightness,
    bright_cat = cut(
      brightness, 
      c(300, 350, 400, Inf), 
      labels = c("low", "med", "high")) %>% as.factor
  )

glimpse(clean)
## Observations: 90,241
## Variables: 10
## $ latitude   <dbl> -35.493, -33.992, -33.991, -33.985, -33.983, -33.980, -33.…
## $ longitude  <dbl> 149.639, 150.129, 150.118, 150.085, 150.074, 150.051, 150.…
## $ brightness <dbl> 379.8, 380.4, 406.0, 334.4, 335.3, 329.2, 330.7, 327.1, 34…
## $ confidence <dbl> 94, 100, 100, 66, 67, 70, 75, 59, 94, 100, 86, 80, 51, 46,…
## $ bright_t31 <dbl> 288.9, 305.2, 315.7, 299.8, 299.1, 298.9, 299.0, 298.1, 29…
## $ frp        <dbl> 156.0, 157.8, 300.1, 28.2, 30.0, 24.0, 26.1, 21.4, 55.2, 1…
## $ daynight   <chr> "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D"…
## $ my_time    <dttm> 2019-12-01, 2019-12-01, 2019-12-01, 2019-12-01, 2019-12-0…
## $ conf_cat   <fct> high, high, high, high, high, high, high, high, high, high…
## $ bright_cat <fct> med, med, high, low, low, low, low, low, low, med, low, lo…

Google Maps

This code is not reproducible unless you have the correct Google Maps API.

nowra_map <- get_map("Nowra Hill, NSW", zoom = 10)
## Source : https://maps.googleapis.com/maps/api/staticmap?center=Nowra%20Hill,%20NSW&zoom=10&size=640x640&scale=2&maptype=terrain&language=en-EN&key=xxx
## Source : https://maps.googleapis.com/maps/api/geocode/json?address=Nowra+Hill,+NSW&key=xxx
str(nowra_map)
##  'ggmap' chr [1:1280, 1:1280] "#BABAB6" "#D6D6CA" "#EAEADE" "#EAEAE2" ...
##  - attr(*, "source")= chr "google"
##  - attr(*, "maptype")= chr "terrain"
##  - attr(*, "zoom")= num 10
##  - attr(*, "bb")=Classes 'tbl_df', 'tbl' and 'data.frame':   1 obs. of  4 variables:
##   ..$ ll.lat: num -35.3
##   ..$ ll.lon: num 150
##   ..$ ur.lat: num -34.6
##   ..$ ur.lon: num 151
map_bounds = attr(nowra_map, "bb")

Subsetting the fire data to only those in the map

nowra_data = clean %>% 
  dplyr::filter(
    latitude >= map_bounds$ll.lat,
    latitude <= map_bounds$ur.lat,
    longitude >= map_bounds$ll.lon,
    longitude <= map_bounds$ur.lon)

nowra_data %>% glimpse
## Observations: 1,630
## Variables: 10
## $ latitude   <dbl> -35.285, -35.284, -35.290, -35.286, -34.964, -34.963, -34.…
## $ longitude  <dbl> 150.246, 150.235, 150.171, 150.209, 150.639, 150.627, 150.…
## $ brightness <dbl> 326.3, 335.0, 337.7, 314.1, 323.6, 311.1, 311.6, 319.1, 33…
## $ confidence <dbl> 43, 83, 100, 50, 100, 82, 83, 98, 76, 70, 63, 100, 100, 10…
## $ bright_t31 <dbl> 296.4, 295.3, 290.2, 288.5, 287.4, 285.9, 286.7, 287.0, 30…
## $ frp        <dbl> 20.0, 31.8, 44.5, 14.1, 28.1, 15.1, 14.7, 22.3, 95.0, 7.3,…
## $ daynight   <chr> "D", "D", "N", "N", "N", "N", "N", "N", "D", "N", "N", "N"…
## $ my_time    <dttm> 2019-12-17 00:00:00, 2019-12-17 00:00:00, 2019-12-17 15:1…
## $ conf_cat   <fct> low, high, high, low, high, high, high, high, high, high, …
## $ bright_cat <fct> low, low, low, low, low, low, low, low, low, low, low, med…
p1 = ggmap(nowra_map) +
  geom_point(data = nowra_data, 
             aes(x = longitude,
                 y = latitude,
                 colour = brightness)) +
  geom_point(x = 150.5934431,
             y = -34.8432388,
             colour = "blue", size = 2) + ## A location near my home
  scale_colour_distiller(palette = "Reds", direction = 1) +
  transition_states(my_time) +
  labs(title = "Time: {closest_state}") +
    shadow_trail(distance = 0.05, colour = "black", alpha = 1)

p2 = animate(p1, nframes = 100)

p2

sessionInfo()
## R version 3.6.1 (2019-07-05)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS Mojave 10.14.6
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_AU.UTF-8/en_AU.UTF-8/en_AU.UTF-8/C/en_AU.UTF-8/en_AU.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] gganimate_1.0.4 lubridate_1.7.4 ggmap_3.0.0     forcats_0.4.0  
##  [5] stringr_1.4.0   dplyr_0.8.3     purrr_0.3.3     readr_1.3.1    
##  [9] tidyr_1.0.0     tibble_2.1.3    ggplot2_3.2.1   tidyverse_1.3.0
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.3         lattice_0.20-38    prettyunits_1.0.2  png_0.1-7         
##  [5] utf8_1.1.4         assertthat_0.2.1   zeallot_0.1.0      digest_0.6.23     
##  [9] R6_2.4.1           cellranger_1.1.0   plyr_1.8.5         backports_1.1.5   
## [13] reprex_0.3.0       evaluate_0.14      httr_1.4.1         pillar_1.4.2      
## [17] RgoogleMaps_1.4.4  rlang_0.4.2        progress_1.2.2     curl_4.3          
## [21] lazyeval_0.2.2     readxl_1.3.1       gifski_0.8.6       rstudioapi_0.10   
## [25] rmarkdown_2.0      labeling_0.3       munsell_0.5.0      broom_0.5.2       
## [29] compiler_3.6.1     modelr_0.1.5       xfun_0.11          pkgconfig_2.0.3   
## [33] base64enc_0.1-3    htmltools_0.4.0    tidyselect_0.2.5   fansi_0.4.0       
## [37] crayon_1.3.4       dbplyr_1.4.2       withr_2.1.2        bitops_1.0-6      
## [41] grid_3.6.1         nlme_3.1-142       jsonlite_1.6       gtable_0.3.0      
## [45] lifecycle_0.1.0    DBI_1.0.0          magrittr_1.5       scales_1.1.0      
## [49] cli_2.0.0          stringi_1.4.3      farver_2.0.1       fs_1.3.1          
## [53] xml2_1.2.2         generics_0.0.2     vctrs_0.2.0        RColorBrewer_1.1-2
## [57] rjson_0.2.20       tools_3.6.1        glue_1.3.1         tweenr_1.0.1      
## [61] hms_0.5.2          jpeg_0.1-8.1       yaml_2.2.0         colorspace_1.4-1  
## [65] rvest_0.3.5        knitr_1.26         haven_2.2.0
LS0tCnRpdGxlOiAiTkFTQSAtIEZJUk1TIGZpcmUgc3ByZWFkIGFyb3VuZCBOb3dyYSIKYXV0aG9yOiAiS2V2aW4gV2FuZyIKZGF0ZTogIjMgSmFuIDIwMjAiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIGNvZGVfZG93bmxvYWQ6IHRydWUKICAgIHRvYzogdHJ1ZQogICAgdGhlbWU6IHBhcGVyCi0tLQoKIyBTdW1tYXJ5CgpUaGlzIGlzIGEgZG9jdW1lbnQgZm9yIHZpc3VhbGlzaW5nIHRoZSBidXNoZmlyZSBzcHJlYWQgYXJvdW5kIG15IGZhbWlseSBob21lIGluIE5vd3JhLCBOU1csIEF1c3RyYWxpYS4gCgpUaGUgZGF0YSB3YXMgb2J0YWluZWQgZnJvbSBbTkFTQSAtIEZJUk1TIEFyY2hpdmUgRG93bmxvYWRzXShodHRwczovL2Zpcm1zLm1vZGFwcy5lb3NkaXMubmFzYS5nb3YvZG93bmxvYWQvKS5UaGUgZnJvemVuIGNvcHkgb2YgdGhpcyBkYXRhIChhY2Nlc3NlZCBvbiB0aGUgM3JkIG9mIEphbiAyMDIwLCByZXN0cmljdGVkIHRvIEF1c3RyYWxpYSwgcmFuZ2UgZnJvbSAxc3QgRGVjIHRvIDNyZCBvZiBKYW4gMjAyMCkgdGhhdCBJIG9idGFpbmVkIGNhbiBiZSBmb3VuZCBbaGVyZV0oaHR0cHM6Ly9rZXZpbndhbmcwOS5naXRodWIuaW8vdGlkeXR1ZXNkYXkvYnVzaGZpcmUvRExfRklSRV9NNl85NDQ0MS9maXJlX25ydF9NNl85NDQ0MS5jc3YpLgoKUGFydHMgb2YgdGhpcyBjb2RlIHdpbGwgbm90IGJlIHJlcHJvZHVjaWJsZSBkdWUgdG8gdGhlIGBnZ21hcGAgR29vZ2xlIEFQSS4gWW91IG1pZ2h0IHdhbnQgdG8gY29uc3VsdCB0aGUgbWFudWFsIG9mIHRoaXMgcGFja2FnZSB0byBvYnRhaW4gdGhlIGluc3RydWN0aW9ucyBvZiBzZXR0aW5nIHVwIHlvdXIgbGFwdG9wIHdpdGggdGhlIEFQSS4gIAoKCiMgTG9hZGluZyAKCiMjIFBhY2thZ2VzCmBgYHtyLCBtYXNzYWdlID0gRkFMU0V9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KGdnbWFwKQpsaWJyYXJ5KGx1YnJpZGF0ZSkKbGlicmFyeShnZ2FuaW1hdGUpCmBgYAoKCiMjIExvYWRpbmcgZGF0YQoKYGBge3J9CnJhdyA9IHJlYWRyOjpyZWFkX2NzdigiRExfRklSRV9NNl85NDQ0MS9maXJlX25ydF9NNl85NDQ0MS5jc3YiKQoKZ2xpbXBzZShyYXcpCgpyYXckYWNxX3RpbWUgJT4lIHVuaXF1ZSAlPiUgc2FtcGxlKHNpemUgPSA1MCkgIyMgRm91ciBkaWdpdHMgdGltZSBzdGFtcApgYGAKCiMgQmFzaWMgZGF0YSBjbGVhbmluZyBhbmQgdmFyaWFibGUgc2VsZWN0aW9uCgpJIGFtIG9ubHkgc2VsZWN0aW5nIHNvbWUgdmFyaWFibGVzIG9mIGludGVyZXN0IHRvIG1lLiAKCmBgYHtyfQpjbGVhbiA9IHJhdyAlPiUgCiAgZHBseXI6OnRyYW5zbXV0ZSgKICAgIGxhdGl0dWRlLAogICAgbG9uZ2l0dWRlLAogICAgYnJpZ2h0bmVzcywKICAgIGNvbmZpZGVuY2UsCiAgICBicmlnaHRfdDMxLAogICAgZnJwLAogICAgZGF5bmlnaHQsCiAgICBteV90aW1lID0gcGFzdGUwKGFjcV9kYXRlLCAiICIsIGFjcV90aW1lKSAlPiUgCiAgICAgIGx1YnJpZGF0ZTo6eW1kX2htKCksICMjIEFmdGVyaW5nIHBhc3RpbmcgdGhlIGhvdXJzIGFuZCBtaW5pdGVzLCB3ZSB1c2UgbHVicmlkYXRlIHRvIGNsZWFuIHRoaXMgCiAgICBjb25maWRlbmNlLAogICAgY29uZl9jYXQgPSBjdXQoCiAgICAgIGNvbmZpZGVuY2UsIAogICAgICBjKC0xLCA1MCwgMTAxKSwgCiAgICAgIGxhYmVscyA9IGMoImxvdyIsICJoaWdoIikpICU+JSBhcy5mYWN0b3IsCiAgICBicmlnaHRuZXNzLAogICAgYnJpZ2h0X2NhdCA9IGN1dCgKICAgICAgYnJpZ2h0bmVzcywgCiAgICAgIGMoMzAwLCAzNTAsIDQwMCwgSW5mKSwgCiAgICAgIGxhYmVscyA9IGMoImxvdyIsICJtZWQiLCAiaGlnaCIpKSAlPiUgYXMuZmFjdG9yCiAgKQoKZ2xpbXBzZShjbGVhbikKYGBgCgoKIyBHb29nbGUgTWFwcwoKVGhpcyBjb2RlIGlzIG5vdCByZXByb2R1Y2libGUgdW5sZXNzIHlvdSBoYXZlIHRoZSBjb3JyZWN0IEdvb2dsZSBNYXBzIEFQSS4gCgpgYGB7cn0Kbm93cmFfbWFwIDwtIGdldF9tYXAoIk5vd3JhIEhpbGwsIE5TVyIsIHpvb20gPSAxMCkKc3RyKG5vd3JhX21hcCkKbWFwX2JvdW5kcyA9IGF0dHIobm93cmFfbWFwLCAiYmIiKQpgYGAKCgojIyBTdWJzZXR0aW5nIHRoZSBmaXJlIGRhdGEgdG8gb25seSB0aG9zZSBpbiB0aGUgbWFwCmBgYHtyfQpub3dyYV9kYXRhID0gY2xlYW4gJT4lIAogIGRwbHlyOjpmaWx0ZXIoCiAgICBsYXRpdHVkZSA+PSBtYXBfYm91bmRzJGxsLmxhdCwKICAgIGxhdGl0dWRlIDw9IG1hcF9ib3VuZHMkdXIubGF0LAogICAgbG9uZ2l0dWRlID49IG1hcF9ib3VuZHMkbGwubG9uLAogICAgbG9uZ2l0dWRlIDw9IG1hcF9ib3VuZHMkdXIubG9uKQoKbm93cmFfZGF0YSAlPiUgZ2xpbXBzZQpgYGAKCgpgYGB7cn0KcDEgPSBnZ21hcChub3dyYV9tYXApICsKICBnZW9tX3BvaW50KGRhdGEgPSBub3dyYV9kYXRhLCAKICAgICAgICAgICAgIGFlcyh4ID0gbG9uZ2l0dWRlLAogICAgICAgICAgICAgICAgIHkgPSBsYXRpdHVkZSwKICAgICAgICAgICAgICAgICBjb2xvdXIgPSBicmlnaHRuZXNzKSkgKwogIGdlb21fcG9pbnQoeCA9IDE1MC41OTM0NDMxLAogICAgICAgICAgICAgeSA9IC0zNC44NDMyMzg4LAogICAgICAgICAgICAgY29sb3VyID0gImJsdWUiLCBzaXplID0gMikgKyAjIyBBIGxvY2F0aW9uIG5lYXIgbXkgaG9tZQogIHNjYWxlX2NvbG91cl9kaXN0aWxsZXIocGFsZXR0ZSA9ICJSZWRzIiwgZGlyZWN0aW9uID0gMSkgKwogIHRyYW5zaXRpb25fc3RhdGVzKG15X3RpbWUpICsKICBsYWJzKHRpdGxlID0gIlRpbWU6IHtjbG9zZXN0X3N0YXRlfSIpICsKICAgIHNoYWRvd190cmFpbChkaXN0YW5jZSA9IDAuMDUsIGNvbG91ciA9ICJibGFjayIsIGFscGhhID0gMSkKCnAyID0gYW5pbWF0ZShwMSwgbmZyYW1lcyA9IDEwMCkKCnAyCmBgYAoKCmBgYHtyLCBlY2hvID0gRkFMU0V9CmFuaW1fc2F2ZShmaWxlbmFtZSA9ICIuL05vd3JhX2ZpcmUuZ2lmIiwgCiAgICAgICAgICBhbmltYXRpb24gPSBwMikKYGBgCgoKPGltZyBzcmM9Ik5vd3JhX2ZpcmUuZ2lmIiB3aWR0aD0iNDAwIiBoZWlnaHQ9IjMwMCIgLz4KCgpgYGB7cn0Kc2Vzc2lvbkluZm8oKQpgYGAKCg==