CRAN Package Check Results for Package TropFishR

Last updated on 2020-01-20 01:50:38 CET.

Check Details

Version: 1.6.1
Check: examples
Result: ERROR
    Running examples in 'TropFishR-Ex.R' failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: Z_BevertonHolt
    > ### Title: Beverton & Holt's Z-Equations
    > ### Aliases: Z_BevertonHolt
    > ### Keywords: Z function mortality
    >
    > ### ** Examples
    >
    > # based on length-frequency data
    > data(synLFQ2)
    > Z_BevertonHolt(synLFQ2, catch_columns = 2, Lprime_tprime = 47.5)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    TropFishR
     --- call from context ---
    Z_BevertonHolt(synLFQ2, catch_columns = 2, Lprime_tprime = 47.5)
     --- call from argument ---
    if (class(catch) == "data.frame" | class(catch) == "matrix") {
     if (is.na(catch_columns[1]))
     stop("Please provide numbers indicating which column of the catch matrix should be analysed!")
     catchmat <- res$catch[, (catch_columns)]
     if (length(catch_columns) > 1) {
     catch <- rowSums(catchmat, na.rm = TRUE)
     }
     else catch <- catchmat
    }
     --- R stacktrace ---
    where 1: Z_BevertonHolt(synLFQ2, catch_columns = 2, Lprime_tprime = 47.5)
    
     --- value of length: 2 type: logical ---
    [1] TRUE FALSE
     --- function from context ---
    function (param, catch_columns = NA, Lprime_tprime)
    {
     res <- param
     catch <- res$catch
     if (class(catch) == "data.frame" | class(catch) == "matrix") {
     if (is.na(catch_columns[1]))
     stop("Please provide numbers indicating which column of the catch matrix should be analysed!")
     catchmat <- res$catch[, (catch_columns)]
     if (length(catch_columns) > 1) {
     catch <- rowSums(catchmat, na.rm = TRUE)
     }
     else catch <- catchmat
     }
     if ("midLengths" %in% names(res)) {
     classes <- as.character(res$midLengths)
     classes.num <- do.call(rbind, strsplit(classes, split = "\\+"))
     classes.num <- as.numeric(classes.num[, 1])
     Lprime_tprime_ind <- which.min(abs(classes.num - Lprime_tprime))
     Linf <- res$Linf
     K <- res$K
     if (class(catch) == "numeric") {
     if (length(classes) != length(catch))
     stop("Ages and catch do not have the same length!")
     }
     interval <- (classes.num[2] - classes.num[1])/2
     Lprime_tprime <- Lprime_tprime - interval
     c_midlength <- catch * classes.num
     c_midlength_for_Lmean <- c_midlength[Lprime_tprime_ind:length(c_midlength)]
     catch_for_Lmean <- catch[Lprime_tprime_ind:length(catch)]
     Lmean <- sum(c_midlength_for_Lmean, na.rm = TRUE)/sum(catch_for_Lmean,
     na.rm = TRUE)
     Z <- K * (Linf - Lmean)/(Lmean - Lprime_tprime)
     ret <- c(res, list(Lmean = Lmean, Lprime = Lprime_tprime,
     Z = Z))
     return(ret)
     }
     if ("midAge" %in% names(res) | "age" %in% names(res)) {
     if ("midAge" %in% names(res))
     classes <- as.character(res$midAge)
     if ("age" %in% names(res))
     classes <- as.character(res$age)
     classes.num <- do.call(rbind, strsplit(classes, split = "\\+"))
     classes.num <- as.numeric(classes.num[, 1])
     Lprime_tprime_ind <- which.min(abs(classes.num - Lprime_tprime))
     if (class(catch) == "numeric") {
     if (length(classes) != length(catch))
     stop("Ages and catch do not have the same length!")
     }
     interval <- (classes.num[2] - classes.num[1])/2
     Lprime_tprime <- Lprime_tprime - interval
     catch_for_tprime <- catch[Lprime_tprime_ind:length(catch)]
     classes.num_for_tprime <- classes.num[Lprime_tprime_ind:length(classes.num)]
     sample.size <- sum(catch_for_tprime, na.rm = TRUE)
     sum.age.number <- sum((catch_for_tprime * classes.num_for_tprime),
     na.rm = TRUE)
     tmean <- sum.age.number/sample.size
     Z.BH <- 1/(tmean - Lprime_tprime)
     ret <- c(res, list(tmean = tmean, tprime = Lprime_tprime,
     Z = Z.BH))
     return(ret)
     }
    }
    <bytecode: 0x7b99dd0>
    <environment: namespace:TropFishR>
     --- function search by body ---
    Function Z_BevertonHolt in namespace TropFishR has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (class(catch) == "data.frame" | class(catch) == "matrix") { :
     the condition has length > 1
    Calls: Z_BevertonHolt
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 1.6.1
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
     ...
    --- re-building 'Using_TropFishR_ELEFAN_functions.Rmd' using rmarkdown
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    TropFishR
     --- call from context ---
    powell_wetherall(alba, catch_columns = 1:7, reg_int = c(2, 9))
     --- call from argument ---
    if (class(catch) == "data.frame" | class(catch) == "matrix") {
     if (is.na(catch_columns[1])) {
     writeLines("By default the whole catch matrix is considered for this analysis. Please be aware that this \n method requires catches representing one year. You can choose separate columns of the catch \n matrix with 'catch_columns'.")
     }
     else {
     catchmat <- catch[, (catch_columns)]
     if (length(catch_columns) > 1) {
     catch <- rowSums(catchmat, na.rm = TRUE)
     }
     else catch <- catchmat
     }
    }
     --- R stacktrace ---
    where 1: powell_wetherall(alba, catch_columns = 1:7, reg_int = c(2, 9))
    where 2: eval(expr, envir, enclos)
    where 3: eval(expr, envir, enclos)
    where 4: withVisible(eval(expr, envir, enclos))
    where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
     debug = debug, last = i == length(out), use_try = stop_on_error !=
     2L, keep_warning = keep_warning, keep_message = keep_message,
     output_handler = output_handler, include_timing = include_timing)
    where 9: evaluate::evaluate(...)
    where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
     keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
     options$include) 0L else 2L, output_handler = knit_handlers(options$render,
     options))
    where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
     keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
     stop_on_error = if (options$error && options$include) 0L else 2L,
     output_handler = knit_handlers(options$render, options)))
    where 12: block_exec(params)
    where 13: call_block(x)
    where 14: process_group.block(group)
    where 15: process_group(group)
    where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
     error = function(e) {
     setwd(wd)
     cat(res, sep = "\n", file = output %n% "")
     message("Quitting from lines ", paste(current_lines(i),
     collapse = "-"), " (", knit_concord$get("infile"),
     ") ")
     })
    where 17: process_file(text, output)
    where 18: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
    where 19: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(),
     ...)
    where 20: vweave_rmarkdown(...)
    where 21: engine$weave(file, quiet = quiet, encoding = enc)
    where 22: doTryCatch(return(expr), name, parentenv, handler)
    where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 24: tryCatchList(expr, classes, parentenv, handlers)
    where 25: tryCatch({
     engine$weave(file, quiet = quiet, encoding = enc)
     setwd(startdir)
     output <- find_vignette_product(name, by = "weave", engine = engine)
     if (!have.makefile && vignette_is_tex(output)) {
     texi2pdf(file = output, clean = FALSE, quiet = quiet)
     output <- find_vignette_product(name, by = "texi2pdf",
     engine = engine)
     }
    }, error = function(e) {
     OK <<- FALSE
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 26: tools:::.buildOneVignette("Using_TropFishR_ELEFAN_functions.Rmd",
     "/home/hornik/tmp/R.check/r-devel-clang/Work/PKGS/TropFishR.Rcheck/vign_test/TropFishR",
     TRUE, FALSE, "Using_TropFishR_ELEFAN_functions", "UTF-8",
     "/tmp/RtmpeGpBGN/file62d7b115528.rds")
    
     --- value of length: 2 type: logical ---
    [1] TRUE FALSE
     --- function from context ---
    function (param, catch_columns = NA, savePlots = FALSE, reg_int = NULL,
     main = "Powell-Wetherall plot")
    {
     res <- param
     catch <- res$catch
     if (class(catch) == "data.frame" | class(catch) == "matrix") {
     if (is.na(catch_columns[1])) {
     writeLines("By default the whole catch matrix is considered for this analysis. Please be aware that this \n method requires catches representing one year. You can choose separate columns of the catch \n matrix with 'catch_columns'.")
     }
     else {
     catchmat <- catch[, (catch_columns)]
     if (length(catch_columns) > 1) {
     catch <- rowSums(catchmat, na.rm = TRUE)
     }
     else catch <- catchmat
     }
     }
     if ("midLengths" %in% names(res)) {
     classes <- as.character(res$midLengths)
     classes.num <- do.call(rbind, strsplit(classes, split = "\\+"))
     classes.num <- as.numeric(classes.num[, 1])
     Linf <- res$Linf
     K <- res$K
     if (class(catch) == "matrix" | class(catch) == "data.frame") {
     if (length(classes) != length(catch[, 1]))
     stop("Ages and catch do not have the same length!")
     }
     else if (class(catch) == "numeric") {
     if (length(classes) != length(catch))
     stop("Ages and catch do not have the same length!")
     }
     cumCatch <- rev(cumsum(rev(catch)))
     c_midlength <- catch * classes.num
     interval <- (classes.num[2] - classes.num[1])/2
     Lprime <- classes.num - interval
     sum_midL_c <- rep(NA, length(classes.num))
     Lmean <- rep(NA, length(classes.num))
     for (i in 1:length(c_midlength)) {
     sum_midL_c[i] <- sum(c_midlength[i:length(c_midlength)])
     Lmean[i] <- sum(c_midlength[i:length(c_midlength)])/sum(catch[i:length(catch)])
     }
     Lmean_Lprime <- Lmean - Lprime
     if (is.null(reg_int)) {
     repeat {
     writeLines("Please choose the minimum and maximum point in the \ngraph to include for the regression line!")
     flush.console()
     dev.new()
     plot(x = Lprime, y = Lmean_Lprime, xlab = "Lprime",
     ylab = "Lmean - Lprime")
     text(Lprime + 0.5, Lmean_Lprime + 0.5, labels = as.character(order(Lprime)),
     cex = 0.7)
     mtext(side = 3, "Click on two points. Escape to Quit.",
     xpd = NA, cex = 1.25)
     cutter <- identify(x = Lprime, y = Lmean_Lprime,
     labels = order(Lprime), n = 2)
     if (length(cutter) == 0) {
     stop(noquote("You did not choose any points! Please run the function again \nand choose points to include into the estimation of Z."))
     }
     length.cutter <- length(cutter[1]:cutter[2])
     if (length.cutter < 3) {
     writeLines("Your selection is not possible. You have to choose two \npoints which include at least one other point. At least \nthree points are required for a regression line. Please choose again!")
     flush.console()
     }
     if (length.cutter >= 3) {
     break
     }
     }
     }
     if (!is.null(reg_int)) {
     cutter <- reg_int
     }
     if (length(cutter) != 2)
     stop("You have to provide 2 numbers in reg_int.")
     df.BH <- as.data.frame(cbind(classes.num, Lmean_Lprime,
     Lprime))
     df.BH.cut <- df.BH[cutter[1]:cutter[2], ]
     lm1 <- lm(Lmean_Lprime ~ Lprime, data = df.BH.cut)
     sum_lm1 <- summary(lm1)
     r_lm1 <- sum_lm1$r.squared
     intercept_lm1 <- sum_lm1$coefficients[1]
     slope_lm1 <- sum_lm1$coefficients[2]
     se_slope_lm1 <- sum_lm1$coefficients[4]
     se_intercept_lm1 <- sum_lm1$coefficients[3]
     lm1.fit <- sum_lm1$r.squared
     SE_slope <- abs(se_slope_lm1)
     confi_slope <- abs(se_slope_lm1) * qt(0.975, sum_lm1$df[2])
     conf_slope <- slope_lm1 + c(-confi_slope, confi_slope)
     SE_intercept <- abs(se_intercept_lm1)
     confi_intercept <- abs(se_intercept_lm1) * qt(0.975,
     sum_lm1$df[1])
     conf_intercept <- intercept_lm1 + c(-confi_intercept,
     confi_intercept)
     Linf.BH <- (-intercept_lm1/slope_lm1)
     se_Linf.BH <- (abs(SE_intercept)/abs(intercept_lm1) +
     abs(SE_slope)/abs(slope_lm1)) * (abs(intercept_lm1)/abs(slope_lm1))
     confi_Linf <- (abs(SE_intercept)/abs(intercept_lm1) +
     abs(SE_slope)/abs(slope_lm1)) * (abs(intercept_lm1)/abs(slope_lm1)) *
     qt(0.975, sum_lm1$df[2])
     conf_Linf.BH <- Linf.BH + c(-confi_Linf, confi_Linf)
     ZK.BH <- (-(1 + slope_lm1)/slope_lm1)
     se_ZK.BH <- abs(SE_slope)
     confi_ZK <- se_ZK.BH * qt(0.975, sum_lm1$df[2])
     conf_ZK.BH <- ZK.BH + c(-confi_ZK, confi_ZK)
     plot(x = Lprime, y = Lmean_Lprime, xlab = "Lprime", ylab = "Lmean - Lprime",
     cex = 1.5, main = main)
     par(new = T)
     points(x = df.BH.cut$Lprime, y = df.BH.cut$Lmean_Lprime,
     pch = 19, col = "blue", cex = 1.5)
     abline(a = intercept_lm1, b = slope_lm1, col = "blue",
     lwd = 1.7)
     if (savePlots == TRUE) {
     ploti <- recordPlot()
     }
     else ploti = NA
     ret <- c(res, list(Lmean_Lprime = Lmean_Lprime, Lprime = Lprime,
     Linf_est = Linf.BH, se_Linf = se_Linf.BH, confidenceInt_Linf = conf_Linf.BH,
     ZK = ZK.BH, se_ZK = se_ZK.BH, confidenceInt_ZK = conf_ZK.BH,
     plot = ploti))
     return(ret)
     }
    }
    <bytecode: 0x8ab1568>
    <environment: namespace:TropFishR>
     --- function search by body ---
    Function powell_wetherall in namespace TropFishR has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 148-151 (Using_TropFishR_ELEFAN_functions.Rmd)
    Error: processing vignette 'Using_TropFishR_ELEFAN_functions.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building 'Using_TropFishR_ELEFAN_functions.Rmd'
    
    --- re-building 'lfqData.Rmd' using rmarkdown
    --- finished re-building 'lfqData.Rmd'
    
    --- re-building 'tutorial.Rmd' using rmarkdown
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    TropFishR
     --- call from context ---
    lfqModify(synLFQ7, bin_size = 4)
     --- call from argument ---
    if (class(lfq$catch) == "numeric") {
     catch <- as.numeric(catch)
    }
     --- R stacktrace ---
    where 1: lfqModify(synLFQ7, bin_size = 4)
    where 2: eval(expr, envir, enclos)
    where 3: eval(expr, envir, enclos)
    where 4: withVisible(eval(expr, envir, enclos))
    where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos,
     debug = debug, last = i == length(out), use_try = stop_on_error !=
     2L, keep_warning = keep_warning, keep_message = keep_message,
     output_handler = output_handler, include_timing = include_timing)
    where 9: evaluate::evaluate(...)
    where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning),
     keep_message = !isFALSE(options$message), stop_on_error = if (options$error &&
     options$include) 0L else 2L, output_handler = knit_handlers(options$render,
     options))
    where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE,
     keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message),
     stop_on_error = if (options$error && options$include) 0L else 2L,
     output_handler = knit_handlers(options$render, options)))
    where 12: block_exec(params)
    where 13: call_block(x)
    where 14: process_group.block(group)
    where 15: process_group(group)
    where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),
     error = function(e) {
     setwd(wd)
     cat(res, sep = "\n", file = output %n% "")
     message("Quitting from lines ", paste(current_lines(i),
     collapse = "-"), " (", knit_concord$get("infile"),
     ") ")
     })
    where 17: process_file(text, output)
    where 18: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
    where 19: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(),
     ...)
    where 20: vweave_rmarkdown(...)
    where 21: engine$weave(file, quiet = quiet, encoding = enc)
    where 22: doTryCatch(return(expr), name, parentenv, handler)
    where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 24: tryCatchList(expr, classes, parentenv, handlers)
    where 25: tryCatch({
     engine$weave(file, quiet = quiet, encoding = enc)
     setwd(startdir)
     output <- find_vignette_product(name, by = "weave", engine = engine)
     if (!have.makefile && vignette_is_tex(output)) {
     texi2pdf(file = output, clean = FALSE, quiet = quiet)
     output <- find_vignette_product(name, by = "texi2pdf",
     engine = engine)
     }
    }, error = function(e) {
     OK <<- FALSE
     message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
     file, conditionMessage(e)))
    })
    where 26: tools:::.buildOneVignette("tutorial.Rmd", "/home/hornik/tmp/R.check/r-devel-clang/Work/PKGS/TropFishR.Rcheck/vign_test/TropFishR",
     TRUE, FALSE, "tutorial", "UTF-8", "/tmp/RtmpeGpBGN/file62d724f5e188.rds")
    
     --- value of length: 2 type: logical ---
    [1] FALSE FALSE
     --- function from context ---
    function (lfq, par = NULL, bin_size = NA, aggregate = NA, vectorise_catch = FALSE,
     plus_group = FALSE, minDate = NA, maxDate = NA, years = NA,
     Lmin = NA, Lmax = NA, lfq2 = NA)
    {
     if (class(lfq) != "lfq")
     stop("Your lfq data set has to have class 'lfq'!")
     dates <- lfq$dates
     midLengths <- lfq$midLengths
     catch <- lfq$catch
     if (!is.null(par)) {
     linf <- par$Linf
     }
     else {
     if ("Linf" %in% names(lfq)) {
     linf <- lfq$Linf
     }
     else if ("par" %in% names(lfq)) {
     linf <- lfq$par$Linf
     }
     else {
     linf <- NA
     }
     }
     catch[which(is.na(catch))] <- 0
     if (!is.na(minDate)) {
     catch <- lfq$catch[, which(dates >= minDate)]
     dates <- lfq$dates[which(dates >= minDate)]
     }
     if (!is.na(maxDate)) {
     catch <- catch[, which(dates <= maxDate)]
     dates <- dates[which(dates <= maxDate)]
     }
     if (!is.na(years[1])) {
     catch <- catch[, which(format(dates, "%Y") %in% years)]
     dates <- dates[which(format(dates, "%Y") %in% years)]
     }
     if (!is.na(Lmin)) {
     catch <- catch[which(midLengths >= Lmin), ]
     midLengths <- midLengths[which(midLengths >= Lmin)]
     }
     if (!is.na(Lmax)) {
     catch <- catch[which(midLengths <= Lmax), ]
     midLengths <- midLengths[which(midLengths <= Lmax)]
     }
     if (!any(is.na(lfq2))) {
     if (class(lfq2) != "lfq")
     stop("Your lfq2 data set has to have class 'lfq'!")
     dates2 <- lfq2$dates
     midLengths2 <- lfq2$midLengths
     catch2 <- lfq2$catch
     if (diff(midLengths)[1] != diff(midLengths2)[1])
     stop("The bin sizes do not fit eachother")
     if (any(!dates2 %in% dates))
     warning("At least one sampling date of lfq2 does not match with the dates \nin lfq, not matching dates will be added!")
     mergi <- merge(data.frame(dates = dates, x = dates),
     data.frame(dates = dates2, y = dates2), by = "dates",
     all = TRUE)
     mergi2 <- merge(data.frame(midLengths = midLengths, x = midLengths),
     data.frame(midLengths = midLengths2, y = midLengths2),
     by = "midLengths", all = TRUE)
     indY <- which(is.na(mergi2$y) & mergi2$midLengths > max(midLengths2))
     matY <- matrix(0, nrow = length(indY), ncol = ncol(catch2))
     catch2 <- rbind(catch2, matY)
     indY <- which(is.na(mergi2$y) & mergi2$midLengths < min(midLengths2))
     matY <- matrix(0, nrow = length(indY), ncol = ncol(catch2))
     catch2 <- rbind(matY, catch2)
     ind <- which(is.na(mergi2$x) & mergi2$midLengths > max(midLengths))
     mat <- matrix(0, nrow = length(ind), ncol = ncol(catch))
     catch <- rbind(catch, mat)
     ind <- which(is.na(mergi2$x) & mergi2$midLengths < min(midLengths))
     mat <- matrix(0, nrow = length(ind), ncol = ncol(catch))
     catch <- rbind(mat, catch)
     designMat <- matrix(0, ncol = length(mergi$dates), nrow = length(mergi2$midLengths))
     temp <- designMat
     ind = 1
     for (i in which(!is.na(mergi$x))) {
     temp[, i] <- catch[, ind]
     ind <- ind + 1
     }
     catch <- temp
     temp <- designMat
     ind = 1
     for (i in which(!is.na(mergi$y))) {
     temp[, i] <- catch2[, ind]
     ind <- ind + 1
     }
     catch2 <- temp
     for (i in 1:dim(designMat)[2]) {
     temp1 <- data.frame(midLengths = mergi2$midLengths,
     catch1 = catch[, i])
     temp2 <- data.frame(midLengths = mergi2$midLengths,
     catch2 = catch2[, i])
     temp3 <- merge(temp1, temp2, by = "midLengths", all = TRUE)
     designMat[, i] <- rowSums(temp3[, c(2, 3)])
     }
     dates <- mergi$dates
     midLengths <- mergi2$midLengths
     catch <- designMat
     }
     if (!is.na(bin_size)) {
     if (bin_size < midLengths[2] - midLengths[1])
     stop("The specified bin_size is smaller than the bin size \nin your data. This is not possible!")
     bin.breaks <- seq(0, max(midLengths) + bin_size, by = bin_size)
     midLengthsNEW <- bin.breaks + bin_size/2
     listi <- vector("list", length(unique(dates)))
     LF_dat <- data.frame(bin = bin.breaks)
     for (i in 1:length(unique(dates))) {
     sampli <- unique(dates)[i]
     lengthi <- as.numeric(midLengths)
     if (length(unique(dates)) > 1) {
     freqi <- as.numeric(catch[, dates == sampli])
     }
     else {
     freqi <- as.numeric(catch[dates == sampli])
     }
     bin.breaks2 <- rep(NA, length(bin.breaks))
     for (ii in 1:length(bin.breaks)) {
     if (ii == length(bin.breaks)) {
     bin.breaks2[ii] <- length(which(lengthi >=
     bin.breaks[ii]))
     }
     else {
     bin.breaks2[ii] <- length(which(lengthi >=
     bin.breaks[ii] & lengthi < bin.breaks[ii +
     1]))
     }
     }
     bin.breaks3 <- rep(bin.breaks, bin.breaks2)
     dati <- aggregate(list(freq = freqi), by = list(bin = bin.breaks3),
     sum)
     listi[[i]] <- merge(LF_dat, dati, by.x = "bin", all.x = TRUE)[,
     2]
     }
     catch_mat <- do.call(cbind, listi)
     catch_mat[is.na(catch_mat)] <- 0
     catch <- catch_mat
     midLengths <- midLengthsNEW
     if (any(catch != 0)) {
     lowRow <- 0
     resi <- TRUE
     while (resi == TRUE) {
     lowRow <- lowRow + 1
     resi <- rowSums(catch, na.rm = TRUE)[lowRow] ==
     0
     }
     upRow <- nrow(catch)
     resi <- TRUE
     while (resi == TRUE) {
     resi <- rowSums(catch, na.rm = TRUE)[upRow] ==
     0
     upRow <- upRow - 1
     }
     upRow <- upRow + 1
     catch <- catch[lowRow:upRow, ]
     midLengths <- midLengths[lowRow:upRow]
     }
     if (class(lfq$catch) == "numeric") {
     catch <- as.numeric(catch)
     }
     }
     if (vectorise_catch & !is.matrix(catch)) {
     stop(paste0("Catch is ", class(catch), ". To vectorise catch, it has to be a matrix."))
     }
     if (vectorise_catch)
     aggregate = "year"
     if (!is.na(aggregate) & is.matrix(catch)) {
     if (aggregate == "year") {
     c_sum <- by(t(catch), format(dates, "%Y"), FUN = colSums)
     c_list <- lapply(as.list(c_sum), c)
     c_dat <- as.data.frame(c_list)
     if (any(c_dat != 0)) {
     lowRow <- 0
     resi <- TRUE
     while (resi == TRUE) {
     lowRow <- lowRow + 1
     resi <- rowSums(c_dat, na.rm = TRUE)[lowRow] ==
     0
     }
     upRow <- nrow(c_dat)
     resi <- TRUE
     while (resi == TRUE) {
     resi <- rowSums(c_dat, na.rm = TRUE)[upRow] ==
     0
     upRow <- upRow - 1
     }
     upRow <- upRow + 1
     catch <- c_dat[lowRow:upRow, ]
     midLengths <- midLengths[lowRow:upRow]
     }
     else {
     catch <- c_dat
     }
     dates <- unique(as.Date(paste0(format(dates, "%Y"),
     "-01-01")))
     }
     else if (aggregate == "quarter") {
     months <- format(dates, "%m")
     seasons <- rep(NA, length(months))
     seasons[months == "01"] <- 2
     seasons[months == "02"] <- 2
     seasons[months == "03"] <- 2
     seasons[months == "04"] <- 5
     seasons[months == "05"] <- 5
     seasons[months == "06"] <- 5
     seasons[months == "07"] <- 8
     seasons[months == "08"] <- 8
     seasons[months == "09"] <- 8
     seasons[months == "10"] <- 11
     seasons[months == "11"] <- 11
     seasons[months == "12"] <- 11
     dateFac <- as.Date(paste0(format(dates, "%Y"), "-",
     seasons, "-15"))
     c_sum <- by(t(catch), dateFac, FUN = colSums)
     c_list <- lapply(as.list(c_sum), c)
     c_dat <- as.data.frame(c_list)
     if (any(c_dat != 0)) {
     lowRow <- 0
     resi <- TRUE
     while (resi == TRUE) {
     lowRow <- lowRow + 1
     resi <- rowSums(c_dat, na.rm = TRUE)[lowRow] ==
     0
     }
     upRow <- nrow(c_dat)
     resi <- TRUE
     while (resi == TRUE) {
     resi <- rowSums(c_dat, na.rm = TRUE)[upRow] ==
     0
     upRow <- upRow - 1
     }
     upRow <- upRow + 1
     catch <- c_dat[lowRow:upRow, ]
     midLengths <- midLengths[lowRow:upRow]
     }
     else {
     catch <- c_dat
     }
     dates <- unique(dateFac)
     }
     else if (aggregate == "month") {
     c_sum <- by(t(catch), format(dates, "%Y-%m"), FUN = colSums)
     c_list <- lapply(as.list(c_sum), c)
     c_dat <- as.data.frame(c_list)
     if (any(c_dat != 0)) {
     lowRow <- 0
     resi <- TRUE
     while (resi == TRUE) {
     lowRow <- lowRow + 1
     resi <- rowSums(c_dat, na.rm = TRUE)[lowRow] ==
     0
     }
     upRow <- nrow(c_dat)
     resi <- TRUE
     while (resi == TRUE) {
     resi <- rowSums(c_dat, na.rm = TRUE)[upRow] ==
     0
     upRow <- upRow - 1
     }
     upRow <- upRow + 1
     catch <- c_dat[lowRow:upRow, ]
     midLengths <- midLengths[lowRow:upRow]
     }
     else {
     catch <- c_dat
     }
     dates <- unique(as.Date(paste0(format(dates, "%Y-%m"),
     "-15")))
     }
     else {
     stop("aggregate has to be either NA, \"year\", \"quarter\", or \"month\"")
     }
     }
     if (isTRUE(plus_group) | is.numeric(plus_group) | plus_group ==
     "Linf") {
     if (isTRUE(plus_group)) {
     if (is.vector(catch)) {
     print(data.frame(midLengths = midLengths, frequency = catch))
     }
     else if (length(unique(format(lfq$dates, "%Y"))) ==
     1) {
     print(data.frame(midLengths = midLengths, frequency = rowSums(catch)))
     }
     else {
     c_sum <- by(t(catch), format(dates, "%Y"), FUN = colSums)
     c_list <- lapply(as.list(c_sum), c)
     c_dat <- as.data.frame(c_list)
     tmp <- data.frame(midLengths = midLengths)
     tmp <- cbind(tmp, c_dat)
     print(tmp)
     }
     writeLines(paste0("Linf = ", round(linf, 2), ". Check the table above and insert the length of the plus group (Esc to cancel)."))
     pg = -1
     while (pg > max(midLengths) | pg < min(midLengths)) {
     pg <- readline(paste0("Enter a length group between ",
     min(midLengths), " and ", max(midLengths),
     ":"))
     pg = as.numeric(as.character(pg))
     if (!(pg %in% midLengths)) {
     writeLines(paste0(pg, " is not an element of midLengths (see table)."))
     pg = -1
     if (is.na(pg)) {
     break
     }
     }
     }
     }
     else if (is.numeric(plus_group)) {
     pg = as.numeric(as.character(plus_group))
     }
     else if (plus_group == "Linf") {
     interval <- midLengths[2] - midLengths[1]
     upperLength <- midLengths + (interval/2)
     if (!is.na(linf)) {
     pg <- midLengths[which.min(abs(upperLength -
     floor(linf)))]
     }
     else {
     writeLines("Please provide Linf in par or lfq!")
     }
     }
     if (!(pg %in% midLengths)) {
     stop(paste0(pg, " is not an element of midLengths. Set 'plus_group' TRUE and pick a length class \n or check the vector 'midLengths' in your data."))
     }
     midLengths <- midLengths[1:which(midLengths == pg)]
     if (is.vector(catch)) {
     if (which(midLengths == pg) < (length(catch) - 1)) {
     addplus <- sum(catch[((which(midLengths == pg) +
     1):length(catch))])
     }
     else if (which(midLengths == pg) == (length(catch) -
     1)) {
     addplus <- catch[(which(midLengths == pg) + 1)]
     }
     else if (which(midLengths == pg) == (length(catch))) {
     addplus <- 0
     }
     catch <- catch[1:which(midLengths == pg)]
     catch[which(midLengths == pg)] <- catch[which(midLengths ==
     pg)] + addplus
     }
     else {
     if (which(midLengths == pg) < (nrow(catch) - 1)) {
     addplus <- colSums(catch[((which(midLengths ==
     pg) + 1):nrow(catch)), ])
     }
     else if (which(midLengths == pg) == (nrow(catch) -
     1)) {
     addplus <- catch[(which(midLengths == pg) + 1),
     ]
     }
     else if (which(midLengths == pg) == (nrow(catch))) {
     addplus <- 0
     }
     catch <- catch[1:which(midLengths == pg), ]
     catch[which(midLengths == pg), ] <- catch[which(midLengths ==
     pg), ] + addplus
     }
     }
     if (is.vector(catch)) {
     catches <- as.vector(catch)
     }
     else catches <- as.matrix(catch)
     res <- list()
     if ("species" %in% names(lfq))
     res$species <- lfq$species
     if ("stock" %in% names(lfq))
     res$stock <- lfq$stock
     res$dates = dates
     res$midLengths = midLengths
     res$catch = catches
     if ("comment" %in% names(lfq))
     res$comment <- lfq$comment
     if ("par" %in% names(lfq)) {
     if (class(lfq$par) == "list") {
     res$par <- lfq$par
     }
     else {
     res$par <- as.list(lfq$par)
     }
     }
     if (!is.null(par)) {
     if (class(par) == "list") {
     res$par <- par
     }
     else {
     res$par <- as.list(par)
     }
     }
     idx <- names(lfq)[which(!(names(lfq) %in% names(res)))]
     tmpList <- lfq[which(names(lfq) %in% idx)]
     res <- c(res, tmpList)
     if (class(res) != "lfq") {
     class(res) <- "lfq"
     }
     return(res)
    }
    <bytecode: 0x909c0b8>
    <environment: namespace:TropFishR>
     --- function search by body ---
    Function lfqModify in namespace TropFishR has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 71-83 (tutorial.Rmd)
    Error: processing vignette 'tutorial.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building 'tutorial.Rmd'
    
    SUMMARY: processing the following files failed:
     'Using_TropFishR_ELEFAN_functions.Rmd' 'tutorial.Rmd'
    
    Error: Vignette re-building failed.
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 1.6.1
Check: dependencies in R code
Result: NOTE
    Namespace in Imports field not imported from: ‘Hmisc’
     All declared Imports should be used.
Flavors: r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc, r-patched-solaris-x86, r-release-osx-x86_64, r-oldrel-osx-x86_64

Version: 1.6.1
Check: re-building of vignette outputs
Result: FAIL
Flavor: r-release-osx-x86_64