ETC5521 Tutorial 9

Exploring data having a space and time context Part I

Author

Prof. Di Cook

🎯 Objectives

These exercise are to do some exploratory analysis with graphics and statistical models, focusing on temporal data analysis.

🔧 Preparation

install.packages(c("tidyverse", "here", "tsibble", "lubridate", "DAAG", "broom", "patchwork", "colorspace", "GGally", "tsibbledata", "forcats", "chron", "sugrrants", "brolgar"))
  • Open your RStudio Project for this unit, (the one you created in week 1, ETC5521). Create a .qmd document for this weeks activities.

📥 Exercises

Exercise 1: Australian rain

This exercise is based on one from Unwin (2015), and uses the bomregions data from the DAAG package. The data contains regional rainfall for the years 1900-2008. The regional rainfall numbers are area-weighted averages for the respective regions. Extract just the rainfall columns from the data, along with year.

  1. What do you think area-weighted averages are, and how would these be calculated?

The total rainfall is divided by geographic area to get the rainfall on a scale that can be compared aross different sized regions.

  1. Make line plots of the rainfall for each of the regions, the states and the Australian averages. What do you learn about rainfall patterns across the years and regions?

When viewed on independent scales, there are some small differences in rainfall patterns across regions. Regions sw, se, east, mdb and states tas, vic have some decline, but mostly in last few years of the data. Region north and states nt, wa appear to have some increasing rainfall, particularly in the last few years of this data.

data(bomregions)
trend_plots <- list()
for (i in 16:29) {
  p <- ggplot(bomregions, aes_string(x="Year", y=colnames(bomregions)[i])) +
  geom_point() + 
  geom_smooth(se=F) +
  theme(aspect.ratio = 0.8)
  trend_plots[[paste(i-15)]] <- p
}
wrap_plots(trend_plots, ncol = 5)

  1. It can be difficult to assess correlation between multiple series using line plots, and the best way to check correlation between multiple series is to make a scatterplot. Make a splom for this data, ignoring year. What regions have strong positive correlation between their rainfall averages?

It is mostly positive linear association. Some pairs - eastRain, seRain, mdbRain, qldRain, vicRain - are strongly correlated. There are a few outliers (high values) in several regions, particularly the north.

ggscatmat(bomregions[, c(16:29)])

  1. One of the consequences of climate change for Australia is that some regions are likely getting drier. Make a transformation of the data to compute the difference between rainfall average in the year, and the mean over all years. Using a bar for each year, make a barchart that examines the differences in the yearly rainfall over time. (Hint: you will need to pivot the data into tidy long form to make this easier.) Are there some regions who have negative differences in recent years? What else do you notice?

Subtracting the mean, and plotting the differences exaggerates the change in rainfall for each year. There are some regions that seem to have some increase and some with a decrease, particularly nt, north, wa, and in decline sw, vic, tas. Generally the pattern is a few wet years then a few dry years.

med_ctr <- function(x, na.rm = TRUE) {
  x-mean(x, na.rm = TRUE)
}
bomrain <- bomregions |> as_tibble() |>
  select(Year, contains("Rain")) |>
  mutate_at(vars(-Year), med_ctr) |>
  pivot_longer(cols = seRain:ausRain, 
               names_to = "area", 
               values_to = "rain")
ggplot(bomrain, aes(x=Year, y=rain)) +
  geom_col() +
  facet_wrap(~area, ncol=5, scales="free_y") +
  theme(aspect.ratio = 0.8)

Exercise 2: Imputing missings for pedestrian sensor using a model

Sometimes imputing by a simple method such as mean or moving average doesn’t work well with multiple seasonality in a time series. Here we will use a linear model to capture the seasonality and produce better imputations for the pedestrian sensor data (from the tsibble package). This data has counts for four sensors, for two years 2015-2016.

  1. What are the multiple seasons of the pedestrian sensor data, for QV Market-Elizabeth St (West)? (Hint: Make a plot to check. You might filter to a single month to make it easier to see seasonality. You might also want to check when Queen Victoria Market is open.)

There is a daily seasonality, and an open/closed market day seasonality (Tue, Thu, Fri, Sat, Sun), and there is even a summer winter seasonality (Wednesday night market, see the double-peak in Feb/Mar).

ped_QV <-  pedestrian |>
  mutate(year = year(Date),
         month = month(Date)) |>
  dplyr::filter(Sensor == "QV Market-Elizabeth St (West)",
                year == 2016, month %in% c(2:5))
ggplot(ped_QV) +   
    geom_line(aes(x=Time, y=Count)) +
    facet_calendar(~Date) +
  theme(axis.title = element_blank(),
        axis.text.y = element_blank(),
        aspect.ratio = 0.5) 

  1. Check temporal gaps for all the pedestrian sensor data. Subset to just the QV market sensor for the two years. Where are the missing values? Fill these with NA. (Note that fill_gaps doesn’t fill in the additional variables, Date, Time, and year, month so these will need to be computed after filling.)
has_gaps(pedestrian, .full = TRUE)
# A tibble: 4 × 2
  Sensor                        .gaps
  <chr>                         <lgl>
1 Birrarung Marr                TRUE 
2 Bourke Street Mall (North)    TRUE 
3 QV Market-Elizabeth St (West) TRUE 
4 Southern Cross Station        TRUE 
ped_gaps <- pedestrian |> 
  dplyr::filter(Sensor == "QV Market-Elizabeth St (West)") |>
  count_gaps(.full = TRUE)
ped_gaps
# A tibble: 3 × 4
  Sensor                        .from               .to                    .n
  <chr>                         <dttm>              <dttm>              <int>
1 QV Market-Elizabeth St (West) 2015-04-05 02:00:00 2015-04-05 02:00:00     1
2 QV Market-Elizabeth St (West) 2015-12-31 00:00:00 2015-12-31 23:00:00    24
3 QV Market-Elizabeth St (West) 2016-04-03 02:00:00 2016-04-03 02:00:00     1
ped_qvm_filled <- pedestrian |> 
  dplyr::filter(Sensor == "QV Market-Elizabeth St (West)") |>
  fill_gaps(.full = TRUE) |>
  mutate(Date = as.Date(Date_Time, tz="Australia/Melbourne"),
         Time = hour(Date_Time)) |>
  mutate(year = year(Date),
    month = month(Date)) 

There is a block of missing values on the last day of 2015. The other two missings correspond to an hour in April, when the clocks change from summer to regular time.

  1. Create a new variable to indicate if a day is a non-working day, called hol. We need this to accurately model the differences between pedestrian patterns on working vs not working days. Make hour a factor - this helps to make a simple model for a non-standard daily pattern.
hol <- holiday_aus(2015:2016, state = "VIC")
ped_qvm_filled <- ped_qvm_filled |> 
  mutate(hol = is.weekend(Date)) |>
  mutate(hol = if_else(Date %in% hol, TRUE, hol)) |>
  mutate(Time = factor(Time))
  1. Fit a linear model with Count as the response on predictors Time and hol interacted.
ped_qvm_lm <- lm(Count~Time*hol, data=ped_qvm_filled)
  1. Predict the count for all the data at the sensor.
ped_qvm_filled <- ped_qvm_filled |>
  mutate(pCount = predict(ped_qvm_lm, ped_qvm_filled))
  1. Make a line plot focusing on the last two weeks in 2015, where there was a day of missings, where the missing counts are substituted by the model predictions. Do you think that these imputed values match the rest of the series, nicely?

This makes a much better imputed value. There’s still room for improvement but its better than a nearest neighbour, or mean or moving average imputation.

ped_qvm_sub <- ped_qvm_filled |>
  filter(Date > ymd("2015-12-17"), Date < ymd("2016-01-01")) 
ggplot(ped_qvm_sub) +   
    geom_line(aes(x=Date_Time, y=Count)) +
    geom_line(data=filter(ped_qvm_sub, is.na(Count)), 
                      aes(x=Date_Time, 
                          y=pCount), 
                      colour="seagreen3") +
  scale_x_datetime("", date_breaks = "1 day", 
                   date_labels = "%a %d") +
  theme(aspect.ratio = 0.15)

Check the daily pattern, also.

#| fig-width: 5 #| fig-height: 5 #| out-width: 50% ggplot() +
geom_line(data=filter(ped_qvm_sub), aes(x=Time, y=Count, group=Date)) + geom_line(data=filter(ped_qvm_sub, is.na(Count)), aes(x=Time, y=pCount, group=Date), colour=“seagreen3”, linewidth=2) + facet_wrap(~hol) + theme(aspect.ratio = 1)

👌 Finishing up

Make sure you say thanks and good-bye to your tutor. This is a time to also report what you enjoyed and what you found difficult.