change plotting settings

Author: davidruegamer

R/FDboostLSS.R

@@ -121,11 +121,12 @@
 #'   m_boost <- m_boost[mstop(cvr)] ## 832
 #'    
 #'   ## plot smooth effects of functional covariates for mu and sigma
-#'   par(mfrow = c(1,2))
+#'   oldpar <- par(mfrow = c(1,2))
 #'   plot(m_boost$mu, which = 2, ylim = c(0,5))
 #'   lines(s, sin(s*pi)*5, col = 3, lwd = 2)
 #'   plot(m_boost$sigma, which = 2, ylim = c(-2.5,2.5))
 #'   lines(s, -cos(s*pi)*2, col = 3, lwd = 2)
+#'   par(oldpar)
 #'  }
 #' }
 #' @export

R/baselearners.R

@@ -65,6 +65,7 @@
 #' xind2 <- xind + 0.5
 #' integrationWeightsLeft(X1, xind2, leftWeight = "zero")
 #'  
+#' @return Matrix with integration
 #' @export
 ################################# 
 # Trapezoidal integration weights for a functional variable X1 on grid xind
@@ -573,9 +574,8 @@ X_bsignal <- function(mf, vary, args) {
 #'                + bsignal(NIR, nir.lambda, knots = 40, df=4, check.ident = FALSE), 
 #'                timeformula = NULL, data = fuelSubset) 
 #' summary(mod2) 
-#' ## plot(mod2)
-#' 
 #' 
+#'  
 #' ###############################################
 #' ### data simulation like in manual of pffr::ff
 #' 
@@ -608,10 +608,11 @@ X_bsignal <- function(mf, vary, args) {
 #' m1_pffr <- pffr(Y ~ ff(X1, xind = s), yind = t, data = data1)
 #' 
 #' \donttest{
-#'   par(mfrow = c(2, 2))
+#'   oldpar <- par(mfrow = c(2, 2))
 #'   plot(m1, which = 1); plot(m1, which = 2) 
 #'   plot(m1_pffr, select = 1, shift = m1_pffr$coefficients["(Intercept)"]) 
 #'   plot(m1_pffr, select = 2)
+#'   par(oldpar)
 #' }
 #' 
 #' 
@@ -645,12 +646,12 @@ X_bsignal <- function(mf, vary, args) {
 #' m2_pffr <- pffr(Y ~ ff(X1, xind = s, limits = "s<=t"), yind = t, data = data2)
 #' 
 #' \donttest{
-#' par(mfrow = c(2, 2))
+#' oldpar <- par(mfrow = c(2, 2))
 #' plot(m2, which = 1); plot(m2, which = 2)
 #' ## plot of smooth intercept does not contain m1_pffr$coefficients["(Intercept)"]
 #' plot(m2_pffr, select = 1, shift = m2_pffr$coefficients["(Intercept)"]) 
 #' plot(m2_pffr, select = 2) 
-#' 
+#' par(oldpar)
 #' }
 #' 
 #' 

R/bootstrapCIs.R

@@ -490,7 +490,7 @@ bootstrapCI <- function(object, which = NULL,
 #' @details \code{plot.bootstrapCI} plots the bootstrapped coefficients.
 #' 
 #' @aliases print.bootstrapCI
-#' 
+#' @return No return value (plot method) or \code{x} itself (print method)
 #' @method plot bootstrapCI
 #' 
 #' @export

R/clr_functions.R

@@ -195,7 +195,7 @@ clr <- function(f, w = 1, inverse = FALSE) {
 #' # Plot densities
 #' year_col <- rainbow(70, start = 0.5, end = 1)
 #' year_lty <- c(1, 2, 4, 5)
-#' par(mfrow = c(1, 2))
+#' oldpar <- par(mfrow = c(1, 2))
 #' funplot(1:12, birthDistribution$birth_densities[1:70, ], ylab = "densities", xlab = "month", 
 #'         xaxp = c(1, 12, 11), pch = 20, col = year_col, lty = year_lty, main = "Male")
 #' funplot(1:12, birthDistribution$birth_densities[71:140, ], ylab = "densities", xlab = "month", 
@@ -237,5 +237,5 @@ clr <- function(f, w = 1, inverse = FALSE) {
 #'         xaxp = c(1, 12, 11), pch = 20, col = year_col, lty = year_lty, main = "Male")
 #' funplot(1:12, predictions[71:140, ], ylab = "predictions", xlab = "month", ylim = pred_ylim,
 #'         xaxp = c(1, 12, 11), pch = 20, col = year_col, lty = year_lty, main = "Female")
-#' par(mfrow = c(1, 1))
+#' par(oldpar)
 "birthDistribution"

R/constrainedX.R

@@ -683,7 +683,7 @@ bl_lin_matrix_a <- function(blg, Xfun, args) {
 #'                 
 #' ## compare estimated coefficients
 #' \donttest{
-#' par(mfrow=c(4, 2))
+#' oldpar <- par(mfrow=c(4, 2))
 #' plot(mod1, which = 1)
 #' plot(mod1a, which = 1)
 #' plot(mod1, which = 2)
@@ -692,6 +692,7 @@ bl_lin_matrix_a <- function(blg, Xfun, args) {
 #' plot(mod1a, which = 3)
 #' funplot(mod1$yind, predict(mod1, which=4))
 #' funplot(mod1$yind, predict(mod1a, which=4))
+#' par(oldpar)
 #' }
 #' 
 #' @name anisotropic_Kronecker

R/crossvalidation.R

@@ -143,9 +143,10 @@
 #' 
 #' \donttest{
 #'   ## plot the out-of-bag risk
-#'   par(mfrow = c(1,3))
+#'   oldpar <- par(mfrow = c(1,3))
 #'   plot(cvr); legend("topright", lty=2, paste(mstop(cvr)))
 #'   plot(cvr3); legend("topright", lty=2, paste(mstop(cvr3)))
+#'   par(oldpar)
 #' }
 #' 
 #'}
@@ -659,7 +660,7 @@ applyFolds <- function(object, folds = cv(rep(1, length(unique(object$id))), typ
 #'   cvr3 <- cvrisk(mod, folds = folds_bs_long, grid = 1:75)
 #' 
 #'   ## plot the out-of-bag risk
-#'   par(mfrow = c(1,3))
+#'   oldpar <- par(mfrow = c(1,3))
 #'   plot(cvr); legend("topright", lty=2, paste(mstop(cvr)))
 #'   plot(cvr2)
 #'   plot(cvr3); legend("topright", lty=2, paste(mstop(cvr3)))
@@ -678,6 +679,8 @@ applyFolds <- function(object, folds = cv(rep(1, length(unique(object$id))), typ
 #'   plotPredCoef(cvr_jackknife, which = 3) 
 #'   ## plot coefficients per fold for 2nd effect
 #'   plotPredCoef(cvr_jackknife, which = 2, terms = FALSE)
+#'   
+#'   par(oldpar)
 #' 
 #'}
 #'}
@@ -1200,6 +1203,8 @@ print.validateFDboost <- function(x, ...){
 #' coefficients that were estimated in the folds - only possible if the argument getCoefCV is \code{TRUE} in 
 #' the call to \code{validateFDboost}. 
 #' 
+#' @return No return value (plot method) or the object itself (print method)
+#' 
 #' @aliases mstop.validateFDboost
 #' 
 #' @method plot validateFDboost

R/factorize.R

@@ -47,6 +47,7 @@ factorize <- factorise <- function(x, ...) {
 #' or for the whole model simultaneously.
 #'
 #' @method factorize FDboost
+#' @return A factorized model
 #' @export 
 #' @rdname factorize
 factorize.FDboost <- function(x, newdata = NULL, newweights = 1, blwise = TRUE, ...) {
@@ -328,7 +329,8 @@ NULL
 #' @export
 #' @name predict.FDboost_fac
 #' @aliases plot.FDboost_fac
-#' 
+#' @return A matrix of predictions (for predict method) or no 
+#' return value (plot method)
 #' @seealso [factorize(), factorize.FDboost()]
 #'
 predict.FDboost_fac <- function(object, newdata = NULL, which = NULL, ...) {

R/hmatrix.R

@@ -66,6 +66,8 @@
 #' str(mydat)
 #' str(mydat[id1 %in% c(2, 3), ])
 #' str(myhmatrix[id1 %in% c(2, 3), ])
+#' 
+#' @return An matrix object of type \code{"hmatrix"}
 #'  
 #' @export
 hmatrix <- function(time, id, x, argvals=1:ncol(x), 
@@ -120,7 +122,7 @@ hmatrix <- function(time, id, x, argvals=1:ncol(x),
 #' @seealso \code{\link{hmatrix}} for the h.atrix class. 
 #' 
 #' @aliases getId getX getArgvals getTimeLab getIdLab getXLab getArgvalsLab
-#'
+#' @return properties of a hmatrix or fmatrix
 #' @export
 getTime <- function(object) { UseMethod("getTime", object) }
 
@@ -165,6 +167,7 @@ getArgvalsLab <- function(object) { UseMethod("getArgvalsLab", object) }
 #' \code{getIdLab}, \code{getXLab}, \code{getArgvalsLab} for an object of class \code{hmatrix}.  
 #' 
 #' @aliases getId.hmatrix getX.hmatrix getArgvals.hmatrix getTimeLab.hmatrix getXLab.hmatrix getArgvalsLab.hmatrix
+#' @return properties of a hmatrix
 #'
 #' @export
 getTime.hmatrix <- function(object) object[ , 1, drop=TRUE]
@@ -203,7 +206,7 @@ getArgvalsLab.hmatrix <- function(object) attr(object, "argvalsLab")
 #' 
 #' is.hmatrix tests if its argument is an object of class hmatrix.   
 #' @param object object of class hmatrix
-#'
+#' @return logical value
 #' @export
 is.hmatrix <- function(object){
   inherits(object, "hmatrix")
@@ -231,7 +234,7 @@ is.hmatrix <- function(object){
 #' From the functional covariate \code{x} rows are selected accordingly.
 #'  
 #' @seealso ?"["
-#'
+#' @return a \code{"hmatrix"} object
 #' @export 
 `[.hmatrix` <- function(x, i, j, ..., drop=FALSE) {
 
@@ -272,7 +275,7 @@ is.hmatrix <- function(object){
 #' repeated accordingly so that two vectors of the same length are returned. 
 #' @param time the observation points
 #' @param id the id for the curve 
-#'
+#' @return a list with \code{time} and \code{id}
 #' @export
 wide2long <- function(time, id){
   newtime <- rep(time, each=length(unique(id)))
@@ -303,6 +306,8 @@ wide2long <- function(time, id){
 #' try(resMat2 <- subset_hmatrix(resMat, index = index2))
 #' resMat <- subset_hmatrix(hmat, index = index1, compress = FALSE)
 #' try(resMat2 <- subset_hmatrix(resMat, index = index2))
+#' 
+#' @return a \code{hmatrix} object
 #'
 #' @export
 subset_hmatrix <- function(x, index, compress = TRUE)

R/methods.R

@@ -1373,7 +1373,7 @@ getColPersp <- function(z, col1 = "tomato", col2 = "lightblue"){
 #' 
 #' @seealso \code{\link{FDboost}} for the model fit and 
 #' \code{\link{coef.FDboost}} for the calculation of the coefficient functions. 
-#' 
+#' @return no return value (plot method)
 #' @method plot FDboost
 #' @export
 ### function to plot raw values or coefficient-functions/surfaces of a model 

R/utilityFunctions.R

@@ -8,7 +8,7 @@
 #' @param silent print error messages of model fit?
 #' @param cyclic defaults to FALSE, if TRUE cyclic splines are used
 #' @param knots arguments knots passed to \code{\link[mgcv]{gam}}
-#' 
+#' @return a list with controls
 #' @export 
 o_control <- function(k_min=20, rule=2, silent=TRUE, cyclic=FALSE, knots=NULL) { 
   RET <- list(k_min=k_min, rule=rule, silent=silent, cyclic=cyclic, knots=knots)
@@ -38,10 +38,11 @@ o_control <- function(k_min=20, rule=2, silent=TRUE, cyclic=FALSE, knots=NULL) {
 #'   datTr <- truncateTime(funVar=c("hgtm","hgtf"), time="age", newtime=1:16, data=dat)
 #'   
 #'   \donttest{
-#'   par(mfrow=c(1,2))
+#'   oldpar <- par(mfrow=c(1,2))
 #'   with(dat, funplot(age, hgtm, main="Original data"))
 #'   with(datTr, funplot(age, hgtm, main="Yearly data"))
 #'   par(mfrow=c(1,1))   
+#'   par(oldpar)
 #'   }
 #' }
 #' @export 
@@ -81,6 +82,7 @@ truncateTime <- function(funVar, time, newtime, data){
 #'   with(fda::growth, funplot(age, t(hgtm)))
 #' }
 #' }
+#' @return see \code{\link[graphics]{matplot}}
 #' @export
 funplot <- function(x, y, id=NULL, rug=TRUE, ...){