Merge pull request #43 from dataknut/master

Merging my updates so I can then split things back out

NAMESPACE

@@ -9,6 +9,8 @@ export(addVeDayDate)
 export(addVeDayDateTime)
 export(addWeekendRectsDate)
 export(addWeekendRectsDateTime)
+export(addWhitsunDate)
+export(addWhitsunDateTime)
 export(alignDates)
 export(cleanNZEmbEA)
 export(cleanNZGridEA)
@@ -36,7 +38,6 @@ export(loadNZEAYearlyEmbeddedGenData)
 export(loadNZEAYearlyGridGenData)
 export(loadUKESOYearlyGenData)
 export(makeNZYearlyData)
-export(makeUkGridESOYearlyData)
 export(makeWeekdayPlot)
 export(makeWeekdayTimePlot)
 export(nzCalculateCO2e)

R/addVeDayDate.R

@@ -1,14 +1,19 @@
-#' \code{addVeDayDate} adds label for VE day 2020 where x axis is a date. Should work in any time-zone
+#' \code{addVeDayDate} adds extended weekend shading and label for VE day 2020 where x axis is a date. Should work in any time-zone
 #'
 #' @param p the plot to add them to
+#' @param yLoc the reltative height of the label (so you can stagger them on a plot)
 #' @param yMin the smallest y value
 #' @param yMax the largest y value
 #' @author Ben Anderson, \email{b.anderson@@soton.ac.uk} (original)
 #' @export
 #'
-addVeDayDate <- function(p, yMin, yMax){
-  p <- p + annotate("text", x = as.Date("2020-05-08"),
-             y = yMax*gcParams$labelPos,
+addVeDayDate <- function(p, yLoc, yMin, yMax){
+  p <- p + annotate("rect", xmin = as.Date("2020-05-08"),
+           xmax = as.Date("2020-05-09"), # 3 day weekend starting Friday (in UK)
+           ymin = yMin, ymax = yMax,
+           alpha = 0.5, fill = gcParams$weFill) + #gcParams$weAlpha
+    annotate("text", x = as.Date("2020-05-08"),
+             y = yLoc * yMax,
              label = "VE Day 2020")
   return(p)
 }

R/addVeDayDateTime.R

@@ -1,14 +1,20 @@
-#' \code{addVeDayDateTime} adds label for VE day 2020 where x axis is a dateTime. Should work in any time-zone.
+#' \code{addVeDayDateTime} adds extended weekend shading and label for VE day 2020 where x axis is a dateTime. 
+#' Should work in any time-zone.
 #'
 #' @param p the plot to add them to
+#' @param yLoc the relative location of the label (% of max plot height)
 #' @param yMin the smallest y value
 #' @param yMax the largest y value
 #' @author Ben Anderson, \email{b.anderson@@soton.ac.uk} (original)
 #' @export
 #'
-addVeDayDateTime <- function(p, yMin, yMax){
-  p <- p + annotate("text", x = lubridate::as_datetime("2020-05-08 12:00:00"),
-             y = yMax*gcParams$labelPos,
+addVeDayDateTime <- function(p, yLoc, yMin, yMax){
+  p <- p + annotate("rect", xmin = lubridate::as_datetime("2020-05-08 00:00:00"),
+                    xmax = lubridate::as_datetime("2020-05-10 23:59:59"), # 3 day weekend starting Friday (in the UK)
+                    ymin = yMin, ymax = yMax,
+                    alpha = gcParams$weAlpha, fill = gcParams$weFill) + # VE Day
+    annotate("text", x = lubridate::as_datetime("2020-05-08 12:00:00"),
+             y = yLoc * yMax,
              label = "VE Day 2020")
   return(p)
 }

R/addWeekendRectsDate.R

@@ -47,10 +47,10 @@ addWeekendRectsDate <- function(p, yMin, yMax){
              xmax = as.Date("2020-05-04"),
              ymin = yMin, ymax = yMax,
              alpha = gcParams$weAlpha, fill = gcParams$weFill) +
-    annotate("rect", xmin = as.Date("2020-05-08"),
+    annotate("rect", xmin = as.Date("2020-05-09"),
              xmax = as.Date("2020-05-11"),
              ymin = yMin, ymax = yMax,
-             alpha = gcParams$weAlpha, fill = gcParams$weFill) + # VE Day
+             alpha = gcParams$weAlpha, fill = gcParams$weFill) +
     annotate("rect", xmin = as.Date("2020-05-16"),
              xmax = as.Date("2020-05-18"),
              ymin = yMin, ymax = yMax,

R/addWeekendRectsDateTime.R

@@ -47,7 +47,7 @@ addWeekendRectsDateTime <- function(p, yMin, yMax){
              xmax = lubridate::as_datetime("2020-05-03 23:59:59"),
              ymin = yMin, ymax = yMax,
              alpha = gcParams$weAlpha, fill = gcParams$weFill) +
-    annotate("rect", xmin = lubridate::as_datetime("2020-05-08 00:00:00"),
+    annotate("rect", xmin = lubridate::as_datetime("2020-05-09 00:00:00"),
              xmax = lubridate::as_datetime("2020-05-10 23:59:59"),
              ymin = yMin, ymax = yMax,
              alpha = gcParams$weAlpha, fill = gcParams$weFill) + # VE Day

R/addWhitsunDate.R

@@ -0,0 +1,19 @@
+#' \code{addWhitsunDate} adds extended weekend shading and label for UK Whit Sunday (late spring bank holiday) where x axis is a date. Should work in any time-zone
+#'
+#' @param p the plot to add them to
+#' @param yLoc the reltative height of the label (so you can stagger them on a plot)
+#' @param yMin the smallest y value
+#' @param yMax the largest y value
+#' @author Ben Anderson, \email{b.anderson@@soton.ac.uk} (original)
+#' @export
+#'
+addWhitsunDate <- function(p, yLoc, yMin, yMax){
+  p <- p + annotate("rect", xmin = as.Date("2020-05-25"),
+           xmax = as.Date("2020-05-26"), # 3 day weekend starting Saturday (in UK)
+           ymin = yMin, ymax = yMax,
+           alpha = 0.5, fill = gcParams$weFill) +
+    annotate("text", x = as.Date("2020-05-25"),
+             y = yLoc * yMax,
+             label = "Whitsun 2020")
+  return(p)
+}

R/addWhitsunDateTime.R

@@ -0,0 +1,20 @@
+#' \code{addWhitsunDate} adds extended weekend shading and label for UK Whit Sunday (late spring bank holiday) 
+#' where x axis is a dateTime. Should work in any time-zone
+#'
+#' @param p the plot to add them to
+#' @param yLoc the reltative height of the label (so you can stagger them on a plot)
+#' @param yMin the smallest y value
+#' @param yMax the largest y value
+#' @author Ben Anderson, \email{b.anderson@@soton.ac.uk} (original)
+#' @export
+#'
+addWhitsunDateTime <- function(p, yLoc, yMin, yMax){
+  p <- p + annotate("rect", xmin = lubridate::as_datetime("2020-05-25 00:00:00"),
+           xmax = lubridate::as_datetime("2020-05-25 23:59:59"), # 3 day weekend starting Saturday (in UK)
+           ymin = yMin, ymax = yMax,
+           alpha = 0.5, fill = gcParams$weFill) +
+    annotate("text", x = lubridate::as_datetime("2020-05-25 12:00:00"),
+             y = yLoc * yMax,
+             label = "Whitsun 2020")
+  return(p)
+}

R/cleanUkEmbeddedESO.R

@@ -1,4 +1,5 @@
-#' \code{cleanUkEmbeddedESO} cleans up UK embedded ESO data adding lates update to the historical data
+#' \code{cleanUkEmbeddedESO} cleans up UK embedded ESO data adding latest the update to the historical data we
+#' previously manually downloaded. Not ideal. Hopefully NG_ESO will fix the data discontinuity at some point.
 #' 
 #'  - adds proper dateTime 
 #'  - keeps just solar & wind power
@@ -12,34 +13,38 @@
 #' @author Ben Anderson, \email{b.anderson@@soton.ac.uk} (original)
 #' @export
 #' @family data
+#' @family embedded
+#' @family uk
 #'
-cleanUkEmbeddedESO <- function(dt, rawPath){
-  # get the old data
-  # rawPath <- localParams$rawUkEmbeddedGenPath
-  oldFiles <- list.files(rawPath, full.names = TRUE) 
+cleanUkEmbeddedESO <- function(dt, path){
+  # get the old data & any we just added
+  #path <- gcParams$ukData
+  oldFiles <- list.files(paste0(path, "/embeddedGen/raw/"), pattern = "DemandData", # manually downloaded
+                         full.names = TRUE) 
   l <- lapply(oldFiles, data.table::fread) # very fast data loading :-)
   oldDT <- data.table::rbindlist(l, fill = TRUE) # rbind them
   oldDT[, rDate := lubridate::dmy(SETTLEMENT_DATE)] # why dmy people? And why as a string?
   dt[, rDate := lubridate::dmy(SETTLEMENT_DATE)] # why dmy people? And why as a string?
   # add the update we just got
   all <- rbind(oldDT, 
                dt, 
-               fill = TRUE) # fill just in case, let's hope the varnames stayed the same
+               fill = TRUE) # fill just in case, let's hope the varnames stayed the same, bet they don't
 
   # keep only Actuals
   #table(dt$FORECAST_ACTUAL_INDICATOR)
   #EMBEDDED_WIND_GENERATION EMBEDDED_WIND_CAPACITY EMBEDDED_SOLAR_GENERATION EMBEDDED_SOLAR_CAPACITY
   # anything else?
   keep <- all[, 
-              .(rDate, SETTLEMENT_PERIOD,FORECAST_ACTUAL_INDICATOR,
+              .(rDate, SETTLEMENT_DATE, SETTLEMENT_PERIOD,FORECAST_ACTUAL_INDICATOR,
                   EMBEDDED_WIND_GENERATION,EMBEDDED_WIND_CAPACITY,
                   EMBEDDED_SOLAR_GENERATION,EMBEDDED_SOLAR_CAPACITY)
               ]
   keep[, mins := ifelse(as.numeric(SETTLEMENT_PERIOD)%%2 == 0, "30", "00")] # set to half hours to match gridGen
   keep[, hours := floor((as.numeric(SETTLEMENT_PERIOD)+1)/2) - 1]
   keep[, strTime := paste0(hours, ":", mins, ":00")]
-  keep[, hms := hms::as_hms(strTime)] # this breaks on TP49 and TP50 as it creates 24:15 and 24:45 which are
+  keep[, hms := hms::as_hms(strTime)] # this breaks on TP49 and TP50 as it creates 24:15 and 24:45 which do not exist
   keep[, rDateTime := lubridate::ymd_hms(paste0(rDate, strTime))]
+  keep[, rDateTimeUTC := lubridate::force_tz(rDateTime, tzone = "UTC")]
   # NA = times that do not exist. But we won't remove them yet
   # head(dt)
   keep <- keep[, c("mins","hours", "strTime") := NULL]  #remove these now we're happy

R/cleanUkGridESO.R

@@ -6,6 +6,8 @@
 #' @author Ben Anderson, \email{b.anderson@@soton.ac.uk} (original)
 #' @export
 #' @family data
+#' @family grid
+#' @family uk
 #'
 cleanUkGridESO <- function(dt){
   # cleans & returns a dt

R/createDailyMeanComparePlot.R

@@ -8,6 +8,7 @@
 #' @param dt the data, assumed to be the aligned data (use alignDates() to do this)
 #' @param yVar the variable you want to plot
 #' @param yCap the caption for the y axis
+#' @param form do you want a "line" = geom_line() or a "step" = geom_step()? Step is the default
 #' @param yDiv the value you want to divide yVar by to make the y axis more sensible. Default = 1
 #' @param lockDownStart date for start of lockdown rectangle annotation
 #' @param lockDownEnd date for end of lockdown rectangle annotation
@@ -18,7 +19,7 @@
 #' @export
 #' @family plot
 #'
-createDailyMeanComparePlot <- function(dt, yVar, yCap, yDiv = 1, lockDownStart, lockDownEnd){
+createDailyMeanComparePlot <- function(dt, yVar, yCap, form = "step", yDiv = 1, lockDownStart, lockDownEnd){
   # assumes the dateFixed half-hourly data
   # assumes we want mean of half-hourly obs
   plotDT <- dt[dateFixed <= lubridate::today() & 
@@ -37,12 +38,9 @@ createDailyMeanComparePlot <- function(dt, yVar, yCap, yDiv = 1, lockDownStart,
                                    shape = weekDay,
                                    colour = compareYear)) +
     geom_point() +
-    geom_line(aes(shape = NULL), linetype = "dashed") + # joint the dots within compareYear
     scale_x_date(date_breaks = "7 day", date_labels =  "%a %d %b")  +
     theme(axis.text.x=element_text(angle=90, hjust=1)) +
-    labs(caption = paste0(localParams$lockdownCap, localParams$weekendCap,
-                          "\n", localParams$loessCap),
-         x = "Date",
+    labs(x = "Date",
          y = yCap
     ) +
     theme(legend.position = "bottom") + 
@@ -51,7 +49,14 @@ createDailyMeanComparePlot <- function(dt, yVar, yCap, yDiv = 1, lockDownStart,
     scale_shape_discrete(name = "Weekday") +
     guides(colour=guide_legend(nrow=2)) +
     guides(shape=guide_legend(nrow=2))
-
+  if(form == "line"){
+    p <- p + geom_line(aes(shape = NULL), 
+                       linetype = "dashed") # join the dots within compareYear
+  }
+  if(form == "step"){
+    p <- p + geom_step(aes(shape = NULL), 
+                       linetype = "dashed") # join the dots within compareYear
+  }
   p <- addLockdownRect(p, 
                        from = lockDownStart, 
                        to = lockDownEnd,

R/getUkEmbeddedESO.R

@@ -1,10 +1,14 @@
 #' \code{getUkEmbeddedESO} gets the latest embedded generation update file from the UK Grid ESO data website. This is a modelled forecast
-#' since the ESO has no visibility of these. It is embedded in a demand data file for some reason...
+#' since the ESO has no visibility of these. It is embedded in a demand data file for some reason... We then need to add it to the 'old'
+#' embedded data that we have downloaded manually. We do this when we clean it. Yes, at the time of writing it's a bit of a mess.
 #'
 #' @param f the file to get (as a url suitable for data.table::fread())
+#' @param update force an update
 #' @author Ben Anderson, \email{b.anderson@@soton.ac.uk} (original)
 #' @export
 #' @family data
+#' @family embedded
+#' @family uk
 #' 
 getUkEmbeddedESO <- function(f, update){
   # we don't do anything with update - if we change it in any way, drake updates :-)

R/loadEmbeddedGenData.R

@@ -15,8 +15,8 @@ loadEmbeddedGenData <- function(path, fromYear, toDate, update){
   # update = dummy used to force re-load
   # lists files within a folder (path) & loads
   # should be only 1 file so just load it
-  # path <- localParams$embeddedDataLoc
-  filesToGet <- list.files(path, ".csv.gz", full.names = TRUE) # get list of files already downloaded & converted to long form
+  # path <- gcParams$ukData
+  filesToGet <- list.files(paste0(path, "/embeddedGen/processed/yearly/"), ".csv.gz", full.names = TRUE) # get list of files already downloaded & converted to long form
   l <- lapply(filesToGet, data.table::fread) # very fast data loading :-)
   dt <- data.table::rbindlist(l, fill = TRUE) # rbind them
 

R/loadUKESOYearlyGenData.R

@@ -14,11 +14,13 @@
 loadUKESOYearlyGenData <- function(path, fromYear, toDate, update){
   # update = dummy used to force re-load
   # lists files within a folder (path) & loads fromYear
-  filesToDateDT <- data.table::as.data.table(list.files(path, ".csv.gz")) # get list of files already downloaded & converted to long form
+  dataLoc <- paste0(path,"/gridGen/processed/yearly/")
+  filesToDateDT <- data.table::as.data.table(list.files(dataLoc,
+                                                        ".csv.gz")) # get list of files already downloaded & converted to long form
   filesToDateDT[, file := V1]
   filesToDateDT[, c("year", "name") := data.table::tstrsplit(file, split = "_")]
   filesToDateDT[, year := as.numeric(year)]
-  filesToDateDT[, fullPath := paste0(path, file)]
+  filesToDateDT[, fullPath := paste0(dataLoc, file)]
   filesToGet <- filesToDateDT[year >= fromYear, # to reduce files loaded
                               fullPath]
   message("Loading files >= ", fromYear)

R/makeWeekdayTimePlot.R

@@ -6,6 +6,7 @@
 #'
 #' @param dt the data
 #' @param yVar the variable you want to plot
+#' @param yForm whether you want an abs(olute) (default) or a prop(ortional) plot
 #' @param yLab the label for the y axis
 #' @param yDiv the value you want to divide yVar by to make the y axis more sensible. Default = `1`
 #' 
@@ -16,26 +17,49 @@
 #' @export
 #' @family plot
 #'
-makeWeekdayTimePlot <- function(dt, yVar, yLab, yDiv){
+makeWeekdayTimePlot <- function(dt, yVar, yForm = "abs", yLab = "y Lab", yDiv = 1){
   # by weekday and hour
-  # use proportion to show relative shifts
-  # wkdayFixed = obs (they are the same - that was the whole idea!)
-  dt <- dt[, .(yVals = mean(get(yVar))/yDiv), keyby = .(hms, plotPeriod, compareYear, wkdayFixed)]
-  sums <- dt[, .(sum = sum(yVals)), keyby = .(compareYear, plotPeriod, wkdayFixed)]
-  setkey(sums, compareYear, plotPeriod, wkdayFixed)
-  setkey(dt, compareYear, plotPeriod, wkdayFixed)
-  mDT <- sums[dt]
-  mDT[, pVal := (yVals/sum)*100]
-  p <- ggplot2::ggplot(mDT, aes(x = hms, y = pVal, 
-                                colour = compareYear)) + 
-    #geom_line() +
-    geom_point() +
-    scale_x_time(labels = NULL) +
-    #scale_x_datetime(breaks=date_breaks('4 hour'),labels=date_format('%H:%M')) +
-    theme(legend.position="bottom") +
-    scale_color_discrete(name="Year") +
-    facet_grid(plotPeriod ~ wkdayFixed ) +
-    labs( y = yLab,
-          x = "Time")
-  return(p)
+  if(yForm == "prop"){
+    # use proportion to show relative shifts
+    # wkdayFixed = obs (they are the same - that was the whole idea!)
+    # use month as the facet to link to other plots
+    dt[, month := lubridate::month(dateFixed, label = TRUE)]
+    dt <- dt[, .(pVals = mean(get(yVar))/yDiv), 
+             keyby = .(hms, month, compareYear, wkdayFixed)]
+    sums <- dt[, .(sum = sum(pVals)), keyby = .(compareYear, month, wkdayFixed)]
+    setkey(sums, compareYear, month, wkdayFixed)
+    setkey(dt, compareYear, month, wkdayFixed)
+    plotDT <- sums[dt]
+    plotDT[, yVal := (pVals/sum)*100]
+    ok <- TRUE
+  }
+  if(yForm == "abs"){
+    #message("abs")
+    dt[, month := lubridate::month(dateFixed, label = TRUE)]
+    plotDT <- dt[, .(yVal = mean(get(yVar))/yDiv), 
+              keyby = .(hms, month, compareYear, wkdayFixed)]
+    ok <- TRUE
+  }
+  if(yForm != "abs" & yForm != "prop"){# be explicit
+    # neither
+    e <- "yForm not recognised - function understands 'abs' or 'prop"
+    return(e)
+  }
+  if(ok){
+    #message("Building plot with ", yForm)
+    p <- ggplot2::ggplot(plotDT, aes(x = hms, y = yVal, 
+                                  colour = compareYear)) + 
+      geom_step() +
+      #geom_point(size = 1, stroke = 1, shape = 16) +
+      #scale_x_time(labels = NULL) +
+      #scale_x_time(date_format('%H:%M'))
+      #scale_x_datetime(breaks=date_breaks('4 hour'),labels=date_format('%H:%M')) +
+      theme(axis.text.x=element_text(angle=90, hjust=1)) +
+      theme(legend.position="bottom") +
+      scale_color_discrete(name="Year") +
+      facet_grid(month ~ wkdayFixed ) +
+      labs( y = yLab,
+            x = "Time")
+    return(p)
+  }
 }