Skip to content

Commit

Permalink
Updates for CRAN submission
Browse files Browse the repository at this point in the history
  • Loading branch information
droglenc committed Oct 8, 2015
1 parent 98ea036 commit 24440d6
Show file tree
Hide file tree
Showing 23 changed files with 150 additions and 153 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
36 changes: 36 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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`.
Expand Down
6 changes: 3 additions & 3 deletions R/FSA-internals.R
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down Expand Up @@ -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
Expand Down
8 changes: 4 additions & 4 deletions R/FSAUtils.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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]
Expand Down
9 changes: 5 additions & 4 deletions R/ageComparisons.R
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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)
}

#=============================================================
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion R/alkPlot.R
Original file line number Diff line number Diff line change
Expand Up @@ -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,...) {
Expand Down
4 changes: 2 additions & 2 deletions R/alkSummaries.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions R/bootstrap.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}

Expand Down Expand Up @@ -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 {
Expand All @@ -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)
}
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion R/capHistConvert.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
6 changes: 3 additions & 3 deletions R/catchCurve.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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.
Expand Down Expand Up @@ -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]
Expand Down
2 changes: 1 addition & 1 deletion R/expandLenFreq.R
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand Down
10 changes: 5 additions & 5 deletions R/extraTests.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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,...)
}

# ============================================================
Expand Down Expand Up @@ -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)) {
Expand All @@ -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<simDF)) warning("'com' model does not appear to be more complex than all models in 'sim'.\n Check results carefully.",call.=FALSE)
}
6 changes: 3 additions & 3 deletions R/knitUtil.R
Original file line number Diff line number Diff line change
Expand Up @@ -176,7 +176,7 @@ reproInfo <- function(out=c("r","markdown","latex"),rqrdPkgs=NULL,elapsed=NULL,
if (out=="r") iReproInfoR(rqrdPkgs,ses,elapsed,compDate,compTime,width)
else if (out=="latex") iReproInfoLaTeX(rqrdPkgs,ses,elapsed,compDate,compTime,addTOC,newpage)
else iReproInfoMarkdown(rqrdPkgs,ses,elapsed,compDate,compTime,links)
if (closeGraphics) graphics.off()
if (closeGraphics) grDevices::graphics.off()
}


Expand All @@ -196,7 +196,7 @@ iMakeFilename <- function(file,extension,directory=NULL) {

iGetAllDependencies <- function(pkgs) {
# get a list of available packages ... this is needed for package.dependencies below
inst <- installed.packages()
inst <- utils::installed.packages()
# isolate to the supplied packages
inst <- inst[inst[,"Package"] %in% pkgs,]
deps <- NULL
Expand Down Expand Up @@ -230,7 +230,7 @@ iProcessSessionInfo <- function() {
pkg <- sapply(L[[n]], function(x) x[["Package"]])
paste(pkg, vers, sep = "_")
} # end internal mkLabel
ses <- sessionInfo()
ses <- utils::sessionInfo()
sys <- paste(Sys.info()["sysname"],", ",ses$platform,"\n",sep="")
vers <- paste(ses$R.version$version.string,"\n",sep="")
bpkgs <- sort(ses$basePkgs)
Expand Down
2 changes: 1 addition & 1 deletion R/psdAdd.R
Original file line number Diff line number Diff line change
Expand Up @@ -99,7 +99,7 @@ psdAdd.default <- function(len,spec,units=c("mm","cm","in"),use.names=TRUE,
}
## Prepare the PSD literature values data frame
# get is used to eliminate problem with rcmd check
PSDlit <- get(data("PSDlit", envir = environment()), envir = environment())
PSDlit <- get(utils::data("PSDlit", envir = environment()), envir = environment())

## Create data.frame with length, species, rownumbers, and PSD values (blank)
data <- data.frame(len,spec,rownums=1:length(len),PSD=rep(NA,length(len)))
Expand Down
2 changes: 1 addition & 1 deletion R/psdVal.R
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ psdVal <- function(species="List",units=c("mm","cm","in"),incl.zero=TRUE,
units <- match.arg(units)
# load RSDlit data frame into this function's environment
# the data/get combination are used to avoid the "no global binding" note at CHECK
PSDlit <- get(data("PSDlit", envir = environment()), envir = environment())
PSDlit <- get(utils::data("PSDlit", envir = environment()), envir = environment())
# continue if species name is correct
if (iPSDLitCheck(PSDlit,species <- capFirst(species))) {
# identify columns based on units
Expand Down

0 comments on commit 24440d6

Please sign in to comment.