In cbedwards/collinTemplates: Collin's standard template for Rmarkdown

knitr::opts_chunk$set(echo = TRUE)

Summary

Document purpose

What are we doing here?

Updates

Did we change something recently that's important to note?

Setup

For the sake of repeatability, we set the seed here, arbitrarily choosing 123 as our seed. Commenting this code out will mean that each time the script is re-run, random numbers will be different.

set.seed(123)

Libraries

library(viridis) #package for colors
library(here) #package for handling file paths easily
library(beepr) #package for making sound to let me know things are done. Not important for document compile, but useful for running time-consuming loops or tasks.

Function definitions

Standard Edwards' functions

## This is a function script for generating a template readme file for file descriptions in the current folder, labeled README-file.txt. 
## It will recursively look through all subfolders of the working directory, and generate a nested list of all folders and files, for easy listing of file descriptions. 
## If README-file.txt exists, it will update the README-file.txt with any changes to files or directories (adding or removing). 
## In doing so, it use ;\n as an ending sequence -
##    multi-line file descriptions are fine so long as they are inside the ;
## The first two lines of the readme file must be left alone.
## To create a clean readme file (not merge descriptions), give argument "overwrite=TRUE"
## The exclude argument uses regular expressions to identify types of filepaths to ignore when making the readme file.
##   By default it excludes Rmarkdown compiling folders. You can add more patterns to exclude.

## Usage example:
## setwd(C:/Dropbox/academia/currentproject)
## readme_maker()
## ** now go fill in the text file **

require(readtext)
require(stringr)

readme_maker=function(exclude=c(".*_files/",".*_cache/"), #Rmarkdown creates these folders, we don't want to list them all.
                      ## You can add your own patterns to exclude - uses regular expressions
                      overwrite=FALSE #if TRUE, will NOT merge with existing readme file
){
  #Make list of files, remove those that match "exclude" criterion
  fileslist=list.files(recursive=T)
  ind.ignore=NULL;
  for(cur.exclude in exclude){
    ind.ignore=c(ind.ignore, grep(cur.exclude, fileslist))
  }
  fileslist=fileslist[-ind.ignore]
  ## generate file path list plus header
  temp=c("## Usage: describe file between colon and semicolon. Multi-line descriptions okay. Duplicate files in different folders are distinguished with [a], [b], etc. ##",
         "",
         "Project Description",
         fileslist)

  ## set index, skipping header
  i=4
  ## generate obect to store current file path
  path.cur=NULL
  ## Loop through all
  for(count in 4:length(temp)){
    #Define current string
    test.sub=temp[i]
    #Walk down current file path
    path.new=NULL
    do.pathcheck=T #flag for walking down filepath
    i.path=1 #index for subfolder number
    depth=0 #to generate appropriate spacing
    ## Loop through current file path, use the part that fits new file.
    while(do.pathcheck & i.path<=length(path.cur)){
      ## is file in this iteration of subfolders?
      present=grepl(paste("^",
                          path.cur[i.path],
                          "/",
                          sep=""),
                    test.sub)
      if(present) { # if it is
        #update our new filepath
        path.new=c(path.new, path.cur[i.path])
        #update our depth counter
        depth=depth+1
        #eat this subfolder from the current file
        test.sub=gsub(paste("^",
                            path.cur[i.path],
                            "/", 
                            sep=""),
                      "",
                      test.sub)
        #update index for subfolder
        i.path=i.path+1
      }else{ #if not, stop this checking
        do.pathcheck=FALSE
      }
    }
    #set current path to our newly calculated one
    path.cur=path.new


    #Walk downward along our current file, adding subdirectories as needed  
    while(str_count(test.sub,"/")>0){ #if still has subfolders
      #find name of this subfolder
      fold=gsub("/.*", "", test.sub)
      #update depth count
      depth=depth+1
      #update vector of files to include subfolder
      temp=c(temp[1:(i-1)],
             paste(strrep("  ",depth),fold),
             temp[i:length(temp)])
      #update index of vector of files
      i=i+1
      #update current file path
      path.cur=c(path.cur, fold)
      #update current file to eat subfolder name
      test.sub=gsub(paste(fold, "/", sep=""),"", test.sub)
    }
    # when we're done eating subfolders
    # update the current file to be indented, no subfolders in name 
    temp[i]=paste(strrep("   ", depth+1),
                  test.sub,
                  sep="")
    #update index
    i=i+1
    # }
  }
  ## general filepath structure is now complete
  # add : and spaces to our filepath
  labs.nocolon=1:2 #lines to exclude: methods description
  labs=c(temp[labs.nocolon],sprintf("%s : ",temp[-labs.nocolon]))
  for(lab.cur in labs){
    ind=which(labs==lab.cur)
    if(length(ind)>1){
      labs[ind]= sprintf("%s[%s] : ",gsub(" : $","",labs[ind]),letters[1:length(ind)])
    }
  }


  ## Handle merging with existing file, if present.
  if(file.exists("README-files.txt") & !overwrite){
    #read in file
    t=readtext("README-files.txt")
    #remove header stuff
    tempstore=strsplit(t$text, "##\n\n")[[1]]
    #separate using ;\n to accomodate multi-line descriptions
    raw=strsplit(tempstore[2], ";\n")[[1]]
    rawtemp=labs
    #create vector from existing file that includes only parts that would match with our labs
    rawmatch=gsub(": .*",": ",raw)
    #for each line of existing file, replace base filepath with the existing one (including user descriptions)
    for(i in 1:length(rawmatch)){
      cur.line=rawmatch[i]
      rawtemp[rawtemp==cur.line]=raw[i]
    }
    #save file
    cat(rawtemp[labs.nocolon], file="README-files.txt", sep="\n")
    cat(rawtemp[-labs.nocolon], file="README-files.txt", sep=";\n", append = T)
  }else{
    #save file
    cat(labs[labs.nocolon], file="README-files.txt", sep="\n")
    cat(labs[-labs.nocolon], file="README-files.txt", sep=";\n", append = T)
  }
}

## function for turning DOY to month-day for visualization
doy_2md=function(i){
  ymd=as.Date(i-1, origin="2019-01-01")
  return(format(ymd, "%B %d"))
}
## example usage:
# #generate 30 observations from day of year 40 to 150
# doy=sample(40:150,30)
# #generate gaussian counts with noise
# count=exp(-(doy-100)^2/100)+(runif(30)-.5)*.1
# plot(doy,count)
# # now plot with day-month references
# plot(doy,count, xaxt="n")
# #Make sequence of days to label. Here, 5 days from day 40 to 150
# at=round(seq(40,150, length=5))
# axis(1,at=at, labels=doy_2md(at))

## Function for making color gradient in R
color_gradient <- function(x, colors=viridis(256), colsteps=100) {
  return( colorRampPalette(colors) (colsteps) [ findInterval(x, seq(min(x),max(x), length.out=colsteps)) ] )
}
## Example usage:
#x=runif(100)
#plot(x=x, y=1/x, pch=19,col=color_gradient(x),
#     cex.lab=1.6, main="Example of color gradient")

## function for making semi-transparent colors
t_col <- function(color, alpha = 1, name = NULL) {
  #   color = color name
  #   alpha = fraction of opacity
  #    name = an optional name for the color
  ## Get RGB values for named color
  rgb.val <- col2rgb(color)
  ## Make new color using input color as base and alpha set by transparency
  t.col <- rgb(rgb.val[1], rgb.val[2], rgb.val[3],
               max = 255,
               alpha = alpha*255,
               names = name)
  ## Save the color
  invisible(t.col)
}
## example usage:
# library(plotrix)
#plot(c(1,2),c(1,2),type='l')
#red.t = t_col(color="red", alpha=.5)
#draw.circle(x=1.5, y=1.5, radius=.2, col=red.t)

## Functions for making pair plots
panel.hist <- function(x, ...){
  # histogram function
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(usr[1:2], 0, 1.5) )
  h <- hist(x, plot = FALSE, breaks=20)
  breaks <- h$breaks; nB <- length(breaks)
  y <- h$counts; y <- y/max(y)
  rect(breaks[-nB], 0, breaks[-1], y, col = "cyan", ...)
}
panel.cor <- function(x, y,
                      digits = 2,
                      prefix = "",
                      cex.cor,
                      ...){
  # function to plot pairwise correlations
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- abs(cor(x, y, use="complete.obs"))
  rsigned=cor(x, y, use="complete.obs")
  p = cor.test(x, y, use="complate.obs")$p.value
  txt <- format(c(rsigned, 0.123456789), digits = digits)[1]
  txt <- paste0(prefix, txt)
  if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
  col="grey"
  if(p<.1){col="black"}
  if(p<.05){col="blue"}
  text(0.5, 0.5, txt, cex = cex.cor *(r+.2)/(r+1), col=col)
}
panel.cortest = function(x,y,
                         digits=2,
                         prefix="",
                         cex.cor,
                         ...){
  #function to plot p value of correlations
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  p <- signif(cor.test(x, y, use="complete.obs")$p.value,2)
  if(missing(cex.cor)) cex.cor <- 2
  col="grey"
  if(p<.1){col="black"}
  if(p<.05){col="blue"}
  text(.5, .5, p, cex=cex.cor, col=col)
}
## example usage:
# x=runif(100)
# dat=data.frame(x=x,y=x+.5+rnorm(100)*.1, z=x + rnorm(100))
# pairs(dat,
#       lower.panel=panel.cor,
#       diag.panel=panel.hist)
# pairs(dat,
#     lower.panel=panel.cortest,
#     diag.panel=panel.hist,
#     upper.panel=panel.cor)
## Function for taking a vector of strings in R and displaying it as bullets in Rmarkdown
## Note that the chunk needs to be given the argument of results='asis'

``` {r printer} printer=function(x){ ## x needs to be a vector of strings. com=as.character(x) com=com[com!=""] com=gsub("\n","",com) cat(paste('-', com), sep = '\n') }

example usage:

```r

printer(1:3)

```

```r
## Function for making figs with metadata. Note: you will want to change figfold and scriptname default values to be appropriate for this document.
fig_starter=function(filename, #name of figure file to save as WITHOUT SUFFIX
                     description, #vector of strings, each will be put in its own line of meta file
                     ##  Note: generating file is defined in the function, date and time is automatically added.
                     ##default figure info:
                     width=12,
                     height=8,
                     units="in",
                     res=300,
                     figfold="5_figs",
                     scriptname="BCB_analysis_v1.0.Rmd"
){
  #function to automate making a jpeg figure (can change code here to make png)
  #and also add meta text
  #NOTE: still have to use dev.off() at the end of plot-making

  ## save meta file
  cat(c(description,
        "",##easy way to add an extra line to separate description for basic data.
        paste("from",scriptname),
        as.character(Sys.time())),
      sep="\n",
      file=here(figfold, paste(filename,"_meta.txt", sep=""))
  )

  ## open jpeg device
  jpeg(file=here(figfold,paste(filename,".jpg", sep="")),
       width=width, 
       height=height, 
       units=units, 
       res=res)
}
## Example usage:
# fig_starter(filename="testfig", description=c("This figure was made as an example.","We can add endless lines of description."))
# plot(1:10,1:10, pch=1:10)
# dev.off()
## Note: in this case the example will not work for you unless you give it the correct location for "figfold" - the relative file path to the folder for your figures.

# function for saving ggplot figures and metadata. As fig_starter (which is for base graphics), except that saving ggfigures is inherently cleaner, as you are not feeding commands to an open graphics device

gfig_saver=function(gfig, #object to be saved
                    filename, #name of figure file to save as WITHOUT SUFFIX
                    description, #vector of strings, each will be put in its own line of meta file
                    ##  Note: generating file is defined in the function, date and time is automatically added.
                    ##default figure info:
                    width=12,
                    height=8,
                    units="in",
                    figfold="5_figs",
                    scriptname="BCB_analysis_v1.2.Rmd"
){
  ## save meta file
  cat(c(description,
        "",##easy way to add an extra line to separate description for basic data.
        paste("from",scriptname),
        as.character(Sys.time())),
      sep="\n",
      file=here(figfold, paste(filename,"_meta.txt", sep=""))
  )
  ggsave(filename=here(figfold, paste(filename,".jpg", sep="")),
         plot=gfig,
         device="jpeg",
         width=width, height=height, units=units
  )
}

Document-specific functions

Readme files

By default, my Rmarkdown files live one folder down from my project directory. The following code creates a skeleton readme file one folder up from the current one (or updates it if it already exists). Cut out all but the readme_maker() lines to create a readme in the current working directory instead of one folder up.

old.wd=getwd()# save current directory
setwd("..") #move one folder up
readme_maker() #make readme file
setwd(old.wd) #move back to previous directory

[something something main document sections]

Reminder: you can have sub-sections tabs using the {.tabset} argument, and can choose which one is on top by default with {.active}:

Example of tabsetting{.tabset}

Analysis for Site 1

Maybe here we do some analysis on Site 1. Example plot follows

x=runif(30)
y=x+rnorm(30)
plot(x,y, main="example plot")
out=lm(y~x)
abline(out)

Analysis for Site 2

Maybe here we do some analysis on Site 2. A different plot follows

x=runif(30)
y=3-x+rnorm(30)
plot(x,y, main="example plot")
out=lm(y~x)
abline(out)

Summary of analyses {.active}

Something something insightful comments.

cbedwards/collinTemplates documentation built on May 28, 2020, 11:30 a.m.