From 24440d633f396b8e98798fb6142e8e54eefb4137 Mon Sep 17 00:00:00 2001 From: droglenc Date: Thu, 8 Oct 2015 16:49:50 -0500 Subject: [PATCH] Updates for CRAN submission --- DESCRIPTION | 2 +- NEWS.md | 36 +++++++++++++++++++++++ R/FSA-internals.R | 6 ++-- R/FSAUtils.R | 8 +++--- R/ageComparisons.R | 9 +++--- R/alkPlot.R | 2 +- R/alkSummaries.R | 4 +-- R/bootstrap.R | 10 +++---- R/capHistConvert.R | 2 +- R/catchCurve.R | 6 ++-- R/expandLenFreq.R | 2 +- R/extraTests.R | 10 +++---- R/knitUtil.R | 6 ++-- R/psdAdd.R | 2 +- R/psdVal.R | 2 +- R/removal.R | 71 ++++++++++++---------------------------------- R/residPlot.R | 6 ++-- R/vbStarts.R | 2 +- R/wrAdd.R | 2 +- R/wsVal.R | 2 +- cran-comments.md | 34 ++++++++++++++++++++-- man/ageBias.Rd | 14 ++++----- man/removal.Rd | 65 ++++++++++-------------------------------- 23 files changed, 150 insertions(+), 153 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2853e7b5..5fa40026 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: FSA Title: Functions for Simple Fisheries Stock Assessment Methods Version: 0.8.0 Date: 2015-10-05 -Description: Functions to peform a variety of simple fish stock assessment methods. +Description: Functions to perform a variety of simple fish stock assessment methods. Detailed vignettes are available on the fishR website listed below. Authors@R: person("Derek","Ogle",email="derek@derekogle.com",role=c("aut","cre")) URL: http://derekogle.com/fishR/, https://github.com/droglenc/FSA diff --git a/NEWS.md b/NEWS.md index e92afda2..5383fd66 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,42 @@ # FSA 0.8.0 ongoing +* Tried submitting to CRAN. * Added suggests for `dunn.test` for use in `dunnTest()` (see below). +* `agePrecision()`: Modified. Changed `combn()` to `utils::combn()` and `sd()` to `utils::sd()` (within an `apply()`). +* `catchCurve()`: Modified. Changed `na.exclude()` to `stats::na.exclude()`. * `dunnTest()`: Modified. Changed to more throughly use `dunn.test()` from `dunn.test`. Added the `two.sided=` argument to `dunnTest()` and `dunn.test.results=` to `print.dunnTest()`. +* `expandLenFreq()`: Modified. Changed `runif()` to `stats::runif()`. +* `extraSS()`: Modified. Changed `anova()` to `stats::anova()` in an `lapply()`. +* `fishR()`: Modified. Changed `browseURL()` to `utils::browseURL()`. +* `fsaNews()`: Modified. Changed `browseURL()` to `utils::browseURL()`. +* `headtail()`: Modified. Changed `head()` to `utils::head()` and `tail()` to `utils::tail()`. +* `hist.bootCase()`: Modified. Changed `hist()` to `hist.formula()`. +* `iAgeBiasPlot()`: Modified. Changed `grconvertY()` to `graphics::grconvertY()`. +* `iALKMean.QD()`: Modified. Changed `var()` to `stats::var()` (within `sumTable()`). +* `iBubblesAdd()`: Modified. Changed `rgb()` to `grdevices::rgb()`. +* `iChkComplexModel()`: Modified. Changed `df.residual()` to `stats::df.residual()`. +* `iCIboot()`: Modified. Changed `hist()` to `hist.formula()`. +* `iEvent2Indiv()`: Modified. Changed `unstack()` to `utils::unstack()`. +* `iGetAllDependencies()`: Modified. Changed `installed.packages()` to `utils::installed.packages()`. +* `iHistResids()`: Modified. Removed `graphics::hist()` and changed to `hist.formula()`. +* `iHndlFormula()`: Modified. Changed `terms()` to `stats::terms()`. +* `iHndlResidType()`: Modified. Changed `rstandard()` to `stats::rstandard()` and `rstudent()` to `stats::rstudent()`. +* `iHtestBoot()`: Modified. Removed `graphics::hist()` and changed to `hist.formula()`. +* `iMakeColor()`: Modified. Changed `rgb()` to `grdevices::rgb()`. +* `iMakeModelHeading()`: Modified. Changed `formula()` to `stats::formula()` (within an `lapply()`). +* `iMoran()`: Modified. Changed `optimize()` to `grdevices::optimize()`. +* `iProcessSessionInfo()`: Modified. Changed `sessioninfo()` to `utils::sessioninfo()`. +* `iSchnute()`: Modified. Changed `optimize()` to `grdevices::optimize()`. +* `iTypeoflm()`: Modified. Changed `formula()` to `stats::formula()`. +* `plot.AgeBias()`: Modified. Changed `rgb()` to `grdevices::rgb()`. +* `plot.CatchCurve()`: Modified. Changed `predict()` to `stats::predict()`. +* `print.extraTest()`: Modified. Changed `printCoefMat()` to `stats::printCoefMat()`. +* `psdAdd()`: Modified. Changed `data()` to `utils::data()`. +* `psdVal()`: Modified. Changed `data()` to `utils::data()`. +* `reproInfo()`: Modified. Changed `graphics.off()` to `grdevices::graphics.off()`. +* `removal()`: Modified. Removed some of the examples from the help page to reduce the elapsed time for CRAN. +* `vbStarts()`: Modified. Changed `rgb()` to `grdevices::rgb()`. +* `wrAdd()`: Modified. Changed `data()` to `utils::data()`. +* `wsVal()`: Modified. Changed `data()` to `utils::data()`. # FSA 0.7.11 Oct15 * Converted all `.txt` files to `.Rda` files. Original `.txt` files are in the `data-raw` directory which was added to `.Rbuildignore`. diff --git a/R/FSA-internals.R b/R/FSA-internals.R index ba56b840..b85fa941 100644 --- a/R/FSA-internals.R +++ b/R/FSA-internals.R @@ -148,7 +148,7 @@ iHndlFormula <- function(formula,data,expNumR=NULL, } else { # More than one variable in the formula. # Must identify if there is a LHS. - ifelse(attr(terms(formula),"response")==0,LHS <- FALSE, LHS <- TRUE) + ifelse(attr(stats::terms(formula),"response")==0,LHS <- FALSE, LHS <- TRUE) # See if more than one variable on LHS if (LHS) { fcLHS <- as.character(formula)[2] @@ -267,13 +267,13 @@ iMakeColor <- function(clr,transvalue) { if (transvalue <= 0) stop("'transvalue' must be greater than 0.",call.=FALSE) if (transvalue > 1) transvalue <- 1/transvalue clrprts <- grDevices::col2rgb(clr)/255 - rgb(clrprts[1,1],clrprts[2,1],clrprts[3,1],transvalue) + grDevices::rgb(clrprts[1,1],clrprts[2,1],clrprts[3,1],transvalue) } iTypeoflm <- function(mdl) { if (any(class(mdl)!="lm")) stop("'iTypeoflm' only works with objects from 'lm()'.",call.=FALSE) - tmp <- iHndlFormula(formula(mdl),stats::model.frame(mdl)) + tmp <- iHndlFormula(stats::formula(mdl),stats::model.frame(mdl)) if (tmp$Enum==0) stop("Object must have one response and at least one explanatory variable",call.=FALSE) if (!tmp$Rclass %in% c("numeric","integer")) stop("Response variable must be numeric",call.=FALSE) if (tmp$Etype=="factor") { #ANOVA diff --git a/R/FSAUtils.R b/R/FSAUtils.R index ac131aef..cc6808c1 100644 --- a/R/FSAUtils.R +++ b/R/FSAUtils.R @@ -213,7 +213,7 @@ fishR <- function(where=c("home","IFAR","general","books","AIFFD","posts","news" AIFFD= { tmp <- paste0(tmp,"aiffd2007") }, posts=,news= { tmp <- paste0(tmp,"fishR/blog") } ) - browseURL(tmp) + utils::browseURL(tmp) invisible(tmp) } @@ -242,7 +242,7 @@ fishR <- function(where=c("home","IFAR","general","books","AIFFD","posts","news" #' @rdname fsaNews #' @export fsaNews <- function () { - browseURL("https://github.com/droglenc/FSA/blob/master/NEWS.md") + utils::browseURL("https://github.com/droglenc/FSA/blob/master/NEWS.md") } #' @rdname fsaNews @@ -305,11 +305,11 @@ headtail <- function(x,n=3L,which=NULL,addrownums=TRUE,...) { n <- ifelse(n<0L,max(N+n,0L),min(n,N)) if (n>=N) tmp <- x else { - h <- head(x,n,...) + h <- utils::head(x,n,...) if (addrownums) { if (is.null(rownames(x))) rownames(h) <- paste0("[",1:n,",]") } else rownames(h) <- NULL - t <- tail(x,n,addrownums,...) + t <- utils::tail(x,n,addrownums,...) tmp <- rbind(h,t) } if (!is.null(which)) tmp <- tmp[,which] diff --git a/R/ageComparisons.R b/R/ageComparisons.R index 53bb367f..3d4b7417 100644 --- a/R/ageComparisons.R +++ b/R/ageComparisons.R @@ -384,7 +384,8 @@ iEvansHoenig <- function(obj) { plot.ageBias <- function(x,what=c("bias","sunflower","numbers"),difference=FALSE, xlab=x$ref.lab,ylab=x$nref.lab,show.n=TRUE,nYpos=1.03,cex.n=0.75, lwd=1, - show.pts=FALSE,pch.pts=19,col.pts=rgb(0,0,0,transparency),transparency=1/10, + show.pts=FALSE,pch.pts=19, + col.pts=grDevices::rgb(0,0,0,transparency),transparency=1/10, pch.mean=95,cex.mean=lwd, col.CI="black",col.CIsig="red",lwd.CI=lwd,sfrac=0, show.range=FALSE,col.range="gray",lwd.range=lwd, @@ -458,7 +459,7 @@ iAgeBiasPlot <- function(obj,difference,xlab,ylab,show.n,nYpos,cex.n, graphics::points(x=d[,1][!d$sig],y=d$mean[!d$sig],pch=pch.mean,cex=cex.mean) } # show the sample sizes at the top - if (show.n) graphics::text(d[,1],grconvertY(nYpos,"npc"),d$n,cex=cex.n,xpd=TRUE) + if (show.n) graphics::text(d[,1],graphics::grconvertY(nYpos,"npc"),d$n,cex=cex.n,xpd=TRUE) } #============================================================= @@ -661,7 +662,7 @@ agePrecision <- function(formula,data) { ## Precision alculations (APE and ACV) on each fish # Mean, SD of assigned ages age.avg <- apply(d,1,mean) - age.sd <- apply(d,1,sd) + age.sd <- apply(d,1,stats::sd) # Summed absolute deviation tmp.adevs <- abs(apply(d,2,'-',age.avg)) age.ad <- apply(tmp.adevs,1,sum) @@ -682,7 +683,7 @@ agePrecision <- function(formula,data) { ## Raw age agreement summaries # find all pairs of comparisons - prs <- t(combn(names(d),2)) + prs <- t(utils::combn(names(d),2)) # maximum possible difference is max age - min age ... use this to set the levels # for the agreement table. tmp <- max(d,na.rm=TRUE)-min(d,na.rm=TRUE) diff --git a/R/alkPlot.R b/R/alkPlot.R index 755ca0a8..fad86459 100644 --- a/R/alkPlot.R +++ b/R/alkPlot.R @@ -265,7 +265,7 @@ iBubbleFindIn <- function(alsum,buf) { iBubblesAdd <- function(key,alsum,buf,col) { tmp <- iBubbleUnmatKey(key,alsum) with(tmp,symbols(len,age,circles=sqrt(tmp$prop),inches=iBubbleFindIn(alsum,buf), - bg=col,fg=rgb(0,0,0,0.5),add=TRUE)) + bg=col,fg=grDevices::rgb(0,0,0,0.5),add=TRUE)) } iALKPlotBubble <- function(key,xlab,ylab,xlim,ylim,grid,buf,col,add,...) { diff --git a/R/alkSummaries.R b/R/alkSummaries.R index 8806444b..be2f6a3c 100644 --- a/R/alkSummaries.R +++ b/R/alkSummaries.R @@ -231,8 +231,8 @@ iALKMean.QD <- function(key,formula,data,N_i) { n_ij <- sumTable(formula,data,FUN=length) mn_ij <- sumTable(formula,data,FUN=mean) # Not sure from Q&D if this should be divided by sqrt(n) or not - var_ij <- sumTable(formula,data,FUN=var)/sqrt(sumTable(formula,data,FUN=length)) - #var_ij <- sumTable(formula,data,FUN=var)/sqrt(sumTable(formula,data,FUN=length)) + var_ij <- sumTable(formula,data,FUN=stats::var)/sqrt(sumTable(formula,data,FUN=length)) + #var_ij <- sumTable(formula,data,FUN=stats::var)/sqrt(sumTable(formula,data,FUN=length)) options(warn=0) ## See if key has a row that sums to zero, remove that row from ## the key, N_i, n_ij, mn_ij, and var_ij diff --git a/R/bootstrap.R b/R/bootstrap.R index 4812038e..095a3871 100644 --- a/R/bootstrap.R +++ b/R/bootstrap.R @@ -100,11 +100,11 @@ hist.bootCase <- function(x,same.ylim=TRUE,ymax=NULL, graphics::par(mfrow=c(rows,cols)) ## If not given ymax, then find highest count on all histograms if (is.null(ymax)) { - for (i in 1:ncol(x)) ymax[i] <- max(hist(~x[,i],plot=FALSE,warn.unused=FALSE,...)$counts) + for (i in 1:ncol(x)) ymax[i] <- max(hist.formula(~x[,i],plot=FALSE,warn.unused=FALSE,...)$counts) } if (same.ylim) ymax <- rep(max(ymax),length(ymax)) ## Make the plots - for(i in 1:ncol(x)) hist(~x[,i],xlab=colnames(x)[i],ylim=c(0,ymax[i]),...) + for(i in 1:ncol(x)) hist.formula(~x[,i],xlab=colnames(x)[i],ylim=c(0,ymax[i]),...) graphics::par(mfrow=op) } @@ -253,7 +253,7 @@ iCIBoot <- function(object,parm,conf.level,plot,err.col,err.lwd,rows,cols,...) { ## Plotting depends on whether one vector or not if (length(parm)==1) { ## one histogram - h <- hist(~object,xlab=parm,main="") + h <- hist.formula(~object,xlab=parm,main="") plotrix::plotCI(mean(object),y=0.95*max(h$counts),li=res[1],ui=res[2],err="x", pch=19,col=err.col,lwd=err.lwd,add=TRUE,...) } else { @@ -264,7 +264,7 @@ iCIBoot <- function(object,parm,conf.level,plot,err.col,err.lwd,rows,cols,...) { op <- graphics::par("mfrow") graphics::par(mfrow=c(rows,cols)) for (i in 1:np) { - h <- hist(~object[,i],xlab=colnames(object)[i],...) + h <- hist.formula(~object[,i],xlab=colnames(object)[i],...) plotrix::plotCI(mean(object[,i]),y=0.95*max(h$counts),li=res[i,1],ui=res[i,2],err="x", pch=19,col=err.col,lwd=err.lwd,add=TRUE) } @@ -328,7 +328,7 @@ iHTestBoot <- function(object,parm,bo,alt=c("two.sided","less","greater"),plot=F rownames(res) <- "" ## Make a plot if asked for if (plot) { - hist(~object,xlab=colnames(object),main="") + hist.formula(~object,xlab=colnames(object),main="") graphics::abline(v=bo,col="red",lwd=2,lty=2) } ## Return the result diff --git a/R/capHistConvert.R b/R/capHistConvert.R index ee1e459f..b5837711 100644 --- a/R/capHistConvert.R +++ b/R/capHistConvert.R @@ -374,7 +374,7 @@ iEvent2Indiv <- function(df,id,event.ord) { tmp <- as.data.frame(ch.tab) names(tmp) <- c("id","event","freq") # Unstack and add rownames to data.frame - tmp <- unstack(tmp,freq~event) + tmp <- utils::unstack(tmp,freq~event) tmp <- data.frame(rownames(ch.tab),tmp) names(tmp) <- c(ifelse(is.null(id),"id",id),levels(factor(df[,event]))) # force id to be a character (rather than a factor as from as.data.frame) diff --git a/R/catchCurve.R b/R/catchCurve.R index ec48ad30..a1d1deb9 100644 --- a/R/catchCurve.R +++ b/R/catchCurve.R @@ -126,7 +126,7 @@ catchCurve.default <- function(x,catch,ages2use=age,weighted=FALSE,...) { ## Fit the model to descending limb log.catch.e <- log(catch.e) - cclm <- stats::lm(log.catch.e~age.e,na.action=na.exclude) + cclm <- stats::lm(log.catch.e~age.e,na.action=stats::na.exclude) if (weighted) { # if asked to fit weighted regression then find weights as # the predicted values from the raw regression @@ -139,7 +139,7 @@ catchCurve.default <- function(x,catch,ages2use=age,weighted=FALSE,...) { W[tmp] <- min(W[which(W>0)]) } # and then fit the weighted regression - cclm <- stats::lm(log.catch.e~age.e,weights=W,na.action=na.exclude) + cclm <- stats::lm(log.catch.e~age.e,weights=W,na.action=stats::na.exclude) } else { # if not asked to fit weighted regression then fill weights # with NULL for return in the list below. @@ -230,7 +230,7 @@ plot.catchCurve <- function(x,pos.est="topright",cex.est=0.95, # Highlight descending limb portion graphics::points(x$age.e,x$log.catch.e,col=col.pt,pch=19) # Put model on descending limb - graphics::lines(x$age.e,predict(x$lm,data.frame(x$age.e)),lwd=lwd,lty=lty,col=col.mdl) + graphics::lines(x$age.e,stats::predict(x$lm,data.frame(x$age.e)),lwd=lwd,lty=lty,col=col.mdl) # Put mortality values on the plot if (!is.null(pos.est)) { Z <- -stats::coef(x$lm)[2] diff --git a/R/expandLenFreq.R b/R/expandLenFreq.R index d9d7578b..3e03db7a 100644 --- a/R/expandLenFreq.R +++ b/R/expandLenFreq.R @@ -96,7 +96,7 @@ expandLenFreq <- function(x,w,additional, new.lens <- c(nrand.lens,rand.lens) # make sure that a length can't cross out of length category maxval <- w-1/(10^decimals) - if (maxval>0) new.lens <- new.lens + runif(length(new.lens),min=0,max=maxval) + if (maxval>0) new.lens <- new.lens + stats::runif(length(new.lens),min=0,max=maxval) new.lens <- round(new.lens,decimals) # if asked, print some summary values of what happened if (show.summary) { diff --git a/R/extraTests.R b/R/extraTests.R index 4e8da77a..964b5c18 100644 --- a/R/extraTests.R +++ b/R/extraTests.R @@ -142,7 +142,7 @@ extraSS <- function(sim,...,com,sim.names=sim.name,sim.name=NULL,com.name=NULL) ## Check if complex model is actually more complex iChkComplexModel(sim,com) ## run anova for each sim and com pair - tmp <- lapply(sim,anova,com) + tmp <- lapply(sim,stats::anova,com) ## prepare a matrix to received the anova results res <- matrix(NA,nrow=n.sim,ncol=6+2) ## extract results from all anovas and put in results matrix @@ -173,7 +173,7 @@ extraSS <- function(sim,...,com,sim.names=sim.name,sim.name=NULL,com.name=NULL) print.extraTest <- function(x,...) { cat(attr(x,"heading"),"\n\n") nms <- names(x) - printCoefmat(x,cs.ind=c(2,4,6),tst.ind=7,zap.ind=6,has.Pvalue=TRUE,...) + stats::printCoefmat(x,cs.ind=c(2,4,6),tst.ind=7,zap.ind=6,has.Pvalue=TRUE,...) } # ============================================================ @@ -203,7 +203,7 @@ iMakeModelHeading <- function(sim,com,sim.names,com.name) { if (!is.null(sim.names)) { if (length(sim.names)!=length(sim)) stop("Length of 'sim.names' differs from number of simple models provided.",call.=FALSE) sim_hdg <- paste("Model ",1:length(sim),": ",sim.names,sep="",collapse="\n") - } else sim_hdg <- paste("Model ",1:length(sim),": ",lapply(sim,formula),sep="",collapse="\n") + } else sim_hdg <- paste("Model ",1:length(sim),": ",lapply(sim,stats::formula),sep="",collapse="\n") ## Handle the complex model names ... if none is given (i.e., ## com.name is NULL) then make from the formula of com if (!is.null(com.name)) { @@ -223,7 +223,7 @@ iMakeModelHeading <- function(sim,com,sim.names,com.name) { # something is sent in sim.names and com.name. # ============================================================ iChkComplexModel <- function(sim,com) { - simDF <- unlist(lapply(sim,df.residual)) - comDF <- df.residual(com) + simDF <- unlist(lapply(sim,stats::df.residual)) + comDF <- stats::df.residual(com) if (!all(comDF