R/boot_nanny.R

In corona: Coronavirus ('Rona') Data Exploration

# 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 29> - 
#' Basic setup of corona (Nanny Rona) R program 
#'
#'    Try ?corona for help. For most functions, saying pdf=TRUE will write a PDF to images/. 
#'    If you wish to print to PDF, you need to setwd() to a directory that contains an 
#'    images/ directory that can be written to, or this will fail. 
#'    Individual examples are also available. Try e.g. ?corona_rabbits or ?corona_country 
#'    The results of corona_life() will depend on how your system handles animated GIF files.
#' 
#' @keywords corona Nanny Rona 
#' @export 
#' @importFrom grDevices dev.off
#' @importFrom graphics frame 
#' @import gganimate 
#' @examples
#'\donttest{
#'     corona_rabbits ( )
#'     corona_monty ( )
#'     corona_country ('France') 
#'     corona_vienna ( ) 
#'     corona_totals ( ) 
#'     country_dead ( ) 
#'     corona_converge ( )
#'     corona_metabolism ( ) 
#'     corona_citymap ( ) 
#'     corona_dowjones ( )
#'}
#'
  # 
corona <- function ( )
{ pth = './images/'; 
if(! dir.exists(pth) )
  { print( paste("WARNING! Directory", pth, "not found, PDF writes will fail. Use setwd()") );
  }; 
  print(  paste( "Working directory is... ", getwd() )  ); 
  print( 'Try  ?corona  for help' ); 
}

# - <Section 30> - 
.onLoad <- function ( libname, pkgname ) 
{ 
  ## library(gganimate); 
    # hmm, implies: 
    # library(ggplot2); 
  # library(gridExtra); 
  # library(plyr); 
  # library(qicharts2); 
  # library(reshape2); 

  # hmm: 
  utils::globalVariables(c('owid','cntry','gt','lock','vienna','djia','stmf','citymap','life','allo'));
}

# - <Section 31> - 
corona_pdf <- function ( pdfname, w, h, pdf )
{ 
if( ! pdf )
  { return();
  }; 
  pdfname <- gsub( ' ', '_', pdfname);  # replace blanks 
  pth = './images/'; 
if(! dir.exists(pth) )
  { stop( paste("The directory", pth, "doesn't exist, can't write PDF") );
  }; 
  pathname = paste (pth, pdfname, sep=''); 
  pdf(file=pathname, width=w, height=h); 
} 

# - <Section 32> - 
country_name <- function ( cc )
{ return( cntry[ toupper(cntry$iso_code)==toupper(cc), 'location' ] ); 
} 

# - <Section 33> - 
country_code <- function ( cname, FRM )
{ cname <- gsub( '[ +_.,]+', ' ', cname); # note regex, clean up strange characters. 
if( nrow(cntry[ toupper(cntry$location)==toupper(cname), ]) < 1)
  { print("Country options are:"); 
    print(   paste ( lapply( unique(FRM$iso_code), country_name )  )   ); 
    stop('Use one of the above options'); 
  };
  return( cntry[ toupper(cntry$location)==toupper(cname), 'iso_code' ] ); 
} 

# - <Section 34> - 
corona_pdf_off <- function ( pdfname, pdf, waitline = FALSE )
{
if( ! pdf )
  { 
  if(waitline)
    { invisible(readline(prompt="Press [enter] to continue")); 
    }; 
    return();
  }
  dev.off();
  print( paste("Plotted to ", pdfname ) ); 
} 

# - <Section 35> - 
corona_print <- function ( myplot, 
                           titlesize=28, textsize=15, axistitlesize=21, striptextsize=18,
                           legendx=0.155, legendy=0.85 ,islegend=TRUE)
{ BOOKTHEME <- 
  theme(
         plot.title = element_text(family='sans', face='bold', colour='black', size=titlesize ), 
         axis.line = element_line(colour='black', size=2), # or 'gray40' 
         axis.text.x=element_text(size=textsize), 
         axis.text.y=element_text(size=textsize),
         axis.title.x=element_text(size=axistitlesize),
         axis.title.y=element_text(size=axistitlesize),
        panel.background = element_rect(fill = 'white', colour = 'white',
                                size = 2, linetype = 'solid'),
        panel.grid.major = element_line(size = 0.5, linetype = 'solid',
                                colour = 'gray90'), 
        panel.grid.minor = element_line(size = 0.25, linetype = 'dashed',
                                colour = 'gray65') # play with 'gray' ? 
        # ,  plot.background = element_rect(fill = '#EFEFEF')   
       ); 

  p <- myplot + BOOKTHEME; 
if(islegend)
  { p <- p + theme ( legend.position = c(legendx, legendy),
                     strip.text.x = element_text( margin = margin(0,0,0.2,0,'mm'),
                                                  size=striptextsize ) 
                   ); 
  }; 
  print(p); 
} 

# - <Section 36> - 
corona_unlabelled <- function ( p )
{ return( p + 
     theme( axis.text.x=element_blank(), axis.text.y=element_blank(),
            axis.ticks=element_blank(),
            axis.title.x=element_blank(), axis.title.y=element_blank(),
            panel.background=element_blank(),panel.border=element_blank(),
            panel.grid.major=element_blank(), panel.grid.minor=element_blank(),
            plot.background=element_blank() 
        ) ); 
}

# - <Section 37> - 
corona_benford <- function ( DAT, base=10 )
{ base <- as.integer(base); 
  # if no data, give standard:
if( missing(DAT) )
  { Digit <- 1:(base-1); 
    Freq <- log( (Digit+1)/Digit, base=base ); 
    return( data.frame(Digit, Freq) ); 
  }; 
  # otherwise
  n <- length(DAT); 
  FRQ <- as.data.frame(   table(  as.integer( DAT/(base^as.integer(log(DAT, base=base))) )  )  );
  names(FRQ)[1] <- 'Digit';
  FRQ$Freq <- FRQ$Freq/n; 
  return(FRQ); 
}

# - <Section 38> - 
corona_annotate <- function ( plot, FRM, top, right, xmin=0.1, ymin=0.1, xmax=0.9, ymax=0.9 )
{ # here might warn if FRM ridiculously sized; might also check for strange parameter values 
  plot <- plot + 
     annotation_custom( FRM, 
                      ymin=ymin*top, ymax=ymax*top,
                      xmax=xmax*right, xmin=xmin*right ); 
  return(plot); 
}

# - <Section 39> - 
#########################################
#' Generate all Figures 
#' 
#' For the book 'Rona' (printing to PDF)
#'  work through and generate PDFs for all examples. 
#' 
#' @keywords corona Nanny Rona book print PDF Figures 
#' @export 
#' @importFrom utils flush.console 
#'

corona_all <- function ( )
{ corona_rabbits (pdf=TRUE);
  flush.console();
  corona_country ('United States', pdf=TRUE);
  corona_country ('United Kingdom', pdf=TRUE);
  corona_country ('Germany', pdf=TRUE);
  corona_country ('Italy', pdf=TRUE);
  corona_country ('Spain', pdf=TRUE);
  corona_country ('Taiwan', pdf=TRUE);
  corona_country ('Vietnam', pdf=TRUE);
  corona_country ('South Korea', pdf=TRUE);
  corona_country ('Australia', pdf=TRUE);
  corona_country ('Austria', pdf=TRUE);
  corona_country ('China', pdf=TRUE);
  corona_country ('Thailand', pdf=TRUE);
  corona_country ('Bangladesh', pdf=TRUE);
  corona_country ('Colombia', pdf=TRUE);
  corona_country ('Russia', pdf=TRUE);
  corona_country ('United Arab Emirates', pdf=TRUE);
  corona_country ('Niger', pdf=TRUE);
  corona_country ('New Zealand', pdf=TRUE);
  corona_country ('Singapore', pdf=TRUE);
  corona_country ('Italy', smooth=FALSE, deaths=FALSE, pdf=TRUE); 
  corona_country ('Japan', pdf=TRUE);
  corona_country ('Sweden', pdf=TRUE);
  corona_country ('Belarus', pdf=TRUE);
  corona_country ('Chile', pdf=TRUE);
  flush.console();

  corona_dowjones (pdf=TRUE);
  corona_lockdown (pdf=TRUE); 
  corona_vienna (pdf=TRUE);
  flush.console();

  corona_totals (pdf=TRUE);  # defaults to Italy
  corona_totals (pdf=TRUE, log=TRUE, smooth=TRUE);  
  corona_totals (pdf=TRUE, log=TRUE, dayend=90, smooth=TRUE, prefix='extended');
  flush.console();

  country_dead (pdf=TRUE);
  country_dead ('New Zealand', pdf=TRUE); 
  corona_trends (pdf=TRUE); 
  flush.console(); 

  corona_converge(n=1000000, pdf=TRUE);
  corona_converge(n=1000000, pdf=TRUE, method='multiply', bins=128, xscale=0.3); 
  corona_metabolism( pdf=TRUE ); 
  flush.console();

  corona_citymap (pdf=TRUE);
  corona_life (side=25, steps=100, density=0.2);  
}
# -END OF FILE-