R/lockdown.R

# Generated by LaTeX DogWagger Version 4.0.5 from file <NCTLL_904.tex>
# Date: [2020-9-17 13:16:5] 
# Do NOT edit this file. Edit the LaTeX source!!

# - <Section 11> - 
#' Draw multiple smoothed graphs of new daily cases, with lockdown date, if present 
#'
#'    By default limited to countries with population > 4M, and over 200 cases. 
#'    This may take over 5s to run, depending on your hardware. 
#' 
#' @param pdf FALSE By default will not print to PDF
#' @param minpeople Minimum population for the country
#' @param mincases Minimum number of COVID-19 cases
#' @param cols Number of columns to display, default = 7
#' @param striptextsize size of text in country names
#' @param pdf print to PDF 
#' @param textsize Size of text header
#' @param legendx X position of legend
#' @param legendy Y position of legend 
#' @keywords corona lockdown smoothed 
#' @export 
#' @import ggplot2 
#' @importFrom plyr ddply
#' @importFrom stats loess 
#' @importFrom stats aggregate
#' @importFrom stats na.pass
#' @importFrom graphics frame 
#' @examples
#'\dontrun{
#' corona_lockdown( cols=14 )  
#'}


corona_lockdown <- function ( pdf=FALSE, minpeople=4000000, mincases=200, cols=7,
   striptextsize=10, textsize=10, legendx=0.94, legendy=0.02)
{ # private function: uses loess to smooth data supplied as x. 
  corona_smooth_fx <- function ( x )
  { FOO <- loess(x$new_cases ~ as.numeric(x$date), span=0.2); # don't use a value < 0.1 
    smoother <- FOO$fitted; 
    data.frame(smoother); 
  };
if(pdf)
  { striptextsize=22; 
    textsize=15; 
  };  

  # isolate relevant countries: 
  REFCO <- cntry[ ! is.na(cntry$population), ];
  REFCO <- REFCO[ REFCO$population > minpeople, ]; 
  LOWID <- owid[order(owid$iso_code),]
  # ^ WE *must* do this owing to the manipulations below being based on sort order! #
  LOWID <- LOWID[ ! is.na(LOWID$new_cases), ]; 
  LOWID <- LOWID[ LOWID$iso_code %in% REFCO$iso_code, ]; 
  LOWID$location <- REFCO[ match(LOWID$iso_code, REFCO$iso_code), c('alias')]; # (shorter)

  ## limit to those countries with > mincases: 
  totals <- aggregate(LOWID$new_cases, by=list(LOWID$iso_code), sum);
  names(totals)[1] <- 'iso_code';
  names(totals)[2] <- 'total'; 
  LOWID$tot <- totals[match(LOWID$iso_code, totals$iso_code), 2];
  LOWID <- LOWID[ LOWID$tot > mincases, ];

  SMOO <- ddply(LOWID, c('iso_code'), corona_smooth_fx ); # [ .(iso_code) fails check ]
  ## there is a frame shift if we didn't sort, and say
  LOWID$smoothed <-SMOO$smoother; 
  maxcases <- aggregate(LOWID$smoothed, by=list(LOWID$iso_code), max); 
  names(maxcases)[1] <- 'iso_code'; 
  names(maxcases)[2] <- 'max_rate';
  LOWID$max <- maxcases[match(LOWID$iso_code, maxcases$iso_code),2]
  LOWID$scaled <- 100.0 * LOWID$smoothed / LOWID$max; 
  allmain <- "All Cases";
  LOWID$lock <- lock[match(LOWID$iso_code, lock$iso_code), c('Lockdown')];

  PdfFilename <- 'owid_lockdown.pdf'; 
  corona_pdf(PdfFilename, 21, 30, pdf); 
  LOCKED <- 'red';
  bas <- c(LOCKED); 
  myplot <- ggplot(LOWID, aes(x=date, y=.data$scaled)) + 
                    # or use smoothed ^
       scale_color_identity(guide = 'legend', name=' ', 
               breaks=bas, labels=c('lockdown')) + 
       geom_line() + 
       labs(title=allmain, x='Date', y='Cases/Maximum cases') + 
       coord_cartesian( ylim = c(0, 100)) + 
       facet_wrap(vars(.data$location), ncol=cols ) + 
       scale_x_date(breaks='2 month', date_labels = "%b") + 
       geom_vline( data=LOWID, aes(xintercept=lock, colour=LOCKED) ); 
  corona_print(myplot, striptextsize=striptextsize, textsize=textsize, 
               legendx=legendx, legendy=legendy); 
  corona_pdf_off(PdfFilename, pdf); 
} 
# -END OF FILE- 

Try the corona package in your browser

Any scripts or data that you put into this service are public.

corona documentation built on Oct. 23, 2020, 7:15 p.m.