R/runExamplesWrapper.R

In runExamplesWrapper: Wrapper for 'run_examples()'

#' RunExamples
#'
#' @importFrom devtools run_examples load_all
#'
#' @description driver to automate run_examples() and retrieve the test results for each example
#'
#' @param pack character string containing the path name of the package directory
#' @param run_donttest parameter to be passed to run_examples()
#' @param run_dontrun parameter to be passed to run_examples()
#' @param out character string containing the path name of the run_examples() results output file
#' @param verbose Boolean if TRUE generate some diagnostic information
#'
#' @examples
#' \dontrun{
#' # replace dir and pack with your own versions!!
#' # run this example within the RStudio Console for the package 'pack'
#' dir1<-"~/personal/hearts/hearts_card_game_bayesian_inference/packages/"
#' dir2<-"inference_packages/inference_packages/"
#' dir<-sprintf("%s/%s",dir1,dir2)
#' pack<-sprintf("%s/%s",dir,"cardUtils")
#' v<-RunExamples(pack,verbose=FALSE)
#' }
#'
#' @return returns a character vector specifying each function example as either "GOOD", "BAD", or "MIA"
#'
#' @export
RunExamples<-
  function(pack,run_donttest=TRUE,run_dontrun=TRUE,out=sprintf("%s/%s",tempdir(),"runExamplesOut.txt"),verbose=FALSE) {
    load_all()
    li<-list()
    allNames<-unlist(strsplit(retrieveMan(pack),".Rd"))
    l<-retrieveExamplesFromMan(pack)

    xnames<-unlist(strsplit(sort(names(l$x)),".Rd"))

    lx<-length(xnames)
    v<-rep("GOOD",lx)
    names(v)<-xnames

    start<-xnames[1]

    if(verbose)
      message(c("out file: ",out))

    sink(out)
    on.exit(sink())
    n<-0
    while(TRUE) {
      sem<-getOption("show.error.messages")
      if(!verbose)
        options(show.error.messages = FALSE)
      on.exit(options(show.error.messages = sem))
      if(verbose)
        try(run_examples(pack,run_donttest=run_donttest,run_dontrun=run_dontrun,document=FALSE,start=start))
      else
        suppressMessages(suppressWarnings(try(run_examples(pack,run_donttest=run_donttest,run_dontrun=run_dontrun,document=FALSE,start=start))))
      options(show.error.messages = sem)

      # every time that try(run_examples()) detects an error in an example,
      # the output file test.txt will register "DETECTED A BAD EXAMPLE"
      n<-n+1

      l<-startExample(out,xnames)
      start<-l$start
      v[l$bad]<-"BAD"
      if(verbose)
        message(sprintf("DETECTED A BAD EXAMPLE NUMBER %d LINE NUMBER %d: %s",n,l$w,l$bad),quote=FALSE)
      if(l$w>=lx)
        break
    }
    x<-parseRunExamples(out)

    ss<-strsplit(x,"> ### Name: ")
    xnames<-ss[[1]][2]

    ul<-unlist(ss)
    w<-which(ul!="")
    MIA<-setdiff(names(v),ul[w])
    v[MIA]<-"MIA"

    missing<-setdiff(allNames,names(v))
    vmissing<-rep("MIA",length(missing))
    names(vmissing)<-missing

    vv<-c(v,vmissing)
    vv<-vv[order(names(vv))]

    save(vv,file=sprintf("%s/%s",dirname(out),"v.RData"))

    return(vv)
  }

#' startExample
#'
#' @description parse the output file produced by RunExamples() to determine the next example to start the list provided to run_examples()
#'
#' @param f character string containing the path name of the run_examples() results output file
#' @param xnames list of all the function names within the package
#'
#' @examples
#' \dontrun{
#' # replace dir and pack with your own versions!!
#' # run this example within the RStudio Console for the package 'pack'
#' dir1<-"~/personal/hearts/hearts_card_game_bayesian_inference/packages/"
#' dir2<-"inference_packages/inference_packages/"
#' dir<-sprintf("%s/%s",dir1,dir2)
#' load_all()
#' pack<-sprintf("%s/%s",dir,"cardUtils")
#' out<-sprintf("%s/%s",tempdir(),"runExamplesOut.txt")
#' l<-retrieveExamplesFromMan(pack)
#' xnames<-unlist(strsplit(sort(names(l$x)),".Rd"))
#' sink(out)
#' on.exit(sink())
#' suppressMessages(suppressWarnings(try(run_examples(pack))))
#' sink()
#' l1<-startExample(out,xnames)
#' }
#'
#' @return returns a list whose components are
#'
#' @export
startExample<-
  function(f,xnames) {
    l<-list()
    x<-parseRunExamples(f)

    # the last entry in x is the example where run_examples() bombed!
    ss<-strsplit(x[length(x)],"> ### Name: ")
    w<-which(xnames==ss[[1]][2])
    start<-xnames[w+1] # xnames[w] is the bad example, xnames[w+1] is the next place to start

    l$w<-w
    l$bad<-xnames[w]
    l$start<-start

    return(l)
  }

#' parseRunExamples
#'
#' @description retrieve the lines containing the function name within the run_examples() results output file
#'
#' @param f character string containing the path name of the run_examples() results output file
#'
#' @examples
#' \dontrun{
#' # replace dir and pack with your own versions!!
#' # run this example within the RStudio Console for the package 'pack'
#' dir1<-"~/personal/hearts/hearts_card_game_bayesian_inference/packages/"
#' dir2<-"inference_packages/inference_packages/"
#' dir<-sprintf("%s/%s",dir1,dir2)
#' pack<-sprintf("%s/%s",dir,"cardUtils")
#' out<-"~/test.txt"
#' sink(out)
#' on.exit(sink())
#' try(run_examples(pack,run_donttest=TRUE,run_dontrun=TRUE,document=FALSE))
#' sink()
#' x<-parseRunExamples(out)
#' }
#'
#' @return returns a list of the lines containing the function name
#'
#' @export
parseRunExamples<-
  function(f) {
    x<-readLines(f)
   pattern<-"### Name:[ ]"
    lines<-grep(pattern,x)

    return(x[lines])
  }

#' retrieveExamplesFromMan
#' @description retrieve the text of examples for man files
#'
#' @param package character string full pathname for the package folder
#'
#' @examples
#' \dontrun{
#' # replace package with your own version!!
#' dir1<-"~/personal/hearts/hearts_card_game_bayesian_inference/packages/"
#' dir2<-"inference_packages/inference_packages/"
#' dir<-sprintf("%s/%s",dir1,dir2)
#' pack<-"cardUtils"
#' package<-sprintf("%s/%s",dir,pack)
#' l<-retrieveExamplesFromMan(package)
#' }
#'
#' @return returns a list whose components are a list of examples text and a list of number of lines in each example text
#'
#' @export
retrieveExamplesFromMan<-
	function(package) {
		x<-list()
		nl<-list()
		l<-list()
		man<-sprintf("%s/%s",package,"man")
		mans<-list.files(man)
		for(m in mans) {
			f<-sprintf("%s/%s",man,m)
			v<-readLines(f)

			bc<-balanceCurly(v)
			x[[m]]<-bc
			nl[[m]]<-length(bc)

			#n<-grep("examples",v)


			#if(length(n)>0) {
			#	v<-v[n[1]:length(v)] # assumes that examples is last item in .Rd file
			#	x[[m]]<-v
			#	nl[[m]]<-length(v)
			#}
			#else {
			#	nl[[m]]<-0
			#}
		}
		l$x<-x
		l$nl<-nl
		return(l)
	}

#' retrieveMan
#' @description retrieve the names of all man files
#'
#' @param package character string full pathname for the package folder
#'
#' @examples
#' \dontrun{
#' # replace package with your own version!!
#' dir1<-"~/personal/hearts/hearts_card_game_bayesian_inference/packages/"
#' dir2<-"inference_packages/inference_packages/"
#' dir<-sprintf("%s/%s",dir1,dir2)
#' pack<-"cardUtils"
#' package<-sprintf("%s/%s",dir,pack)
#' l<-retrieveMan(package)
#' }
#'
#' @return returns a list of the names of all man files
#'
#' @export
retrieveMan<-
  function(package) {
    x<-list()
    nl<-list()
    l<-list()
    man<-sprintf("%s/%s",package,"man")
    mans<-list.files(man)
    return(mans)
  }

#' balanceCurly
#'
#' @description retrieve lines of text between '@examples' and matching curly braces
#'
#' @param v character vector
#'
#' @examples
#' v<-c("@examples{","xxx","}","{","{")
#' x<-balanceCurly(v)
#' cat(x,sep="\n")
#'
#' @return returns lines of text between '@examples' and matching curly braces
#'
#' @export
balanceCurly<-
  function(v) {
    lv<-length(v)
    n<-grep("examples",v)
    if(length(n)==0)
      return(NULL)

    #x<-vector("integer",100)
    tot<-0
    for(r in n:lv) {
      if(length(grep("\\{",v[r]))) {
        #x[r]<-"l"
        tot<-tot+1
      }
      if(length(grep("\\}",v[r]))) {
        #x[r]<-"r"
        tot<-tot-1
      }
      if(tot==0) {
        return(v[n:r])
      }
    } # for(r in n:lv)

    # fail to match curly brackets, return the remainder of the file
    return(v[n:lv])
  }