CRAN Package Check Results for Package ppclust

Last updated on 2020-01-27 00:48:13 CET.

Flavor Version Tinstall Tcheck Ttotal Status Flags
r-devel-linux-x86_64-debian-clang 0.1.3 8.55 82.97 91.52 ERROR
r-devel-linux-x86_64-debian-gcc 0.1.3 8.12 170.68 178.80 OK
r-devel-linux-x86_64-fedora-clang 0.1.3 287.25 OK
r-devel-linux-x86_64-fedora-gcc 0.1.3 293.75 OK
r-devel-windows-ix86+x86_64 0.1.3 23.00 341.00 364.00 OK
r-devel-windows-ix86+x86_64-gcc8 0.1.3 22.00 260.00 282.00 OK
r-patched-linux-x86_64 0.1.3 8.64 226.52 235.16 OK
r-patched-solaris-x86 0.1.3 310.80 NOTE
r-release-linux-x86_64 0.1.3 7.86 222.44 230.30 OK
r-release-windows-ix86+x86_64 0.1.3 13.00 211.00 224.00 OK
r-release-osx-x86_64 0.1.3 OK
r-oldrel-windows-ix86+x86_64 0.1.3 12.00 204.00 216.00 OK
r-oldrel-osx-x86_64 0.1.3 OK

Check Details

Version: 0.1.3
Check: examples
Result: ERROR
    Running examples in 'ppclust-Ex.R' failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: comp.omega
    > ### Title: Compute the possibilistic penalty argument for PCM
    > ### Aliases: comp.omega
    > ### Keywords: cluster
    >
    > ### ** Examples
    >
    > data(iris)
    > x <- iris[,-5]
    >
    > # Run FCM
    > res.fcm <- fcm(x=x, centers=3)
    >
    > # Compute the mobilization scale values using the results from FCM
    > vomg1 <- comp.omega(pco=res.fcm)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    ppclust
     --- call from context ---
    comp.omega(pco = res.fcm)
     --- call from argument ---
    if (class(u) == "data.frame") u <- as.matrix(u)
     --- R stacktrace ---
    where 1: comp.omega(pco = res.fcm)
    
     --- value of length: 2 type: logical ---
    [1] FALSE FALSE
     --- function from context ---
    function (d, u, m = 2, pco = NULL, K = 1)
    {
     if (!missing(pco)) {
     if (pco$algorithm == "PCM")
     u <- pco$t
     if (pco$algorithm == "FCM")
     u <- pco$u
     d <- pco$d
     m <- pco$m
     }
     if (missing(u))
     stop("Missing typicality matrix")
     if (is.null(u))
     stop("Memberships matrix contains no data")
     if (class(u) == "data.frame")
     u <- as.matrix(u)
     if (class(u) != "matrix")
     stop("Memberships data must be numeric data frame or matrix")
     if (any(is.na(u)))
     stop("Memberships data should not contain NA values")
     if (!is.numeric(u))
     stop("Memberships data must be a numeric data frame or matrix")
     if (missing(d))
     stop("Missing distance matrix")
     if (is.null(d))
     stop("Distance matrix contains no data")
     if (class(d) == "data.frame")
     d <- as.matrix(d)
     if (class(d) != "matrix")
     stop("Distance data must be numeric data frame or matrix")
     if (any(is.na(d)))
     stop("Distance data should not contain NA values")
     if (!is.numeric(m))
     stop("Argument 'm' must be a numeric value")
     if (!is.numeric(K))
     stop("Argument 'K' must be a numeric value")
     omega <- numeric(ncol(u))
     for (i in 1:ncol(u)) omega[i] <- K * ((u[, i]^m) %*% d[,
     i])/sum(u[, i]^m)
     return(omega)
    }
    <bytecode: 0x5664d58>
    <environment: namespace:ppclust>
     --- function search by body ---
    Function comp.omega in namespace ppclust has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (class(u) == "data.frame") u <- as.matrix(u) :
     the condition has length > 1
    Calls: comp.omega
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 0.1.3
Check: re-building of vignette outputs
Result: WARN
    Error(s) in re-building vignettes:
     ...
    --- re-building 'fcm.Rmd' using rmarkdown
    Loading required package: ggplot2
    Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    ppclust
     --- call from context ---
    fcm(x, centers = 3, memberships = u0)
     --- call from argument ---
    if (class(memberships) == "data.frame") memberships <- as.matrix(memberships)
     --- R stacktrace ---
    where 1: fcm(x, centers = 3, memberships = u0)
    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(),
     output_dir = getwd(), ...)
    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("fcm.Rmd", "/home/hornik/tmp/R.check/r-devel-clang/Work/PKGS/ppclust.Rcheck/vign_test/ppclust",
     TRUE, FALSE, "fcm", "latin1", "/tmp/RtmpsxTsFh/file31094491ec38.rds")
    
     --- value of length: 2 type: logical ---
    [1] FALSE FALSE
     --- function from context ---
    function (x, centers, memberships, m = 2, dmetric = "sqeuclidean",
     pw = 2, alginitv = "kmpp", alginitu = "imembrand", nstart = 1,
     iter.max = 1000, con.val = 1e-09, fixcent = FALSE, fixmemb = FALSE,
     stand = FALSE, numseed)
    {
     if (missing(x))
     stop("Missing data set")
     if (is.null(x))
     stop("Data set is null")
     if ((is.data.frame(x)) || (is.vector(x)))
     x <- as.matrix(x)
     if (!is.matrix(x))
     stop("Data set must be a vector, data frame or matrix")
     if (any(is.na(x)))
     stop("Data set should not contain NA values. Remove NAs and try again")
     if (!is.numeric(x))
     stop("Data set must be a numeric vector, data frame or matrix")
     n <- nrow(x)
     p <- ncol(x)
     if (missing(centers))
     stop("Missing argument 'centers'")
     if (is.data.frame(centers))
     centers <- as.matrix(centers)
     if (is.matrix(centers)) {
     if (is.null(centers))
     stop("Centers contains no data")
     if (any(is.na(centers)))
     stop("Centers should not contain NA values")
     if (!is.numeric(centers))
     stop("Centers should be numeric")
     else k <- nrow(centers)
     }
     else {
     if (!is.numeric(centers))
     stop("Centers should be an integer for the number of clusters or a numeric prototypes matrix")
     k <- ceiling(centers)
     }
     if ((k < 1) || (k > n))
     stop(paste("k, number of clusters should be between 1 and",
     n, ". Check the value of 'centers' argument"))
     if (!missing(numseed)) {
     if (!is.numeric(numseed))
     stop("Argument numseed should be a number")
     else set.seed(numseed)
     }
     alginitv <- match.arg(alginitv, inaparc::get.algorithms("prototype"))
     compv <- parse(text = paste0("inaparc::", alginitv, "(x,",
     k, ")$v"))
     algsinitu <- match.arg(alginitu, inaparc::get.algorithms("membership"))
     alginitu <- match.arg(alginitu, algsinitu)
     if (alginitu == "imembrand")
     compu <- parse(text = paste0("inaparc::", alginitu, "(n,",
     k, ")$u"))
     else compu <- parse(text = paste0("inaparc::", alginitu,
     "(x,", k, ")$u"))
     compd <- parse(text = paste0(".compdist(x[i,], v[j,], dmetric='",
     dmetric, "', p=", pw, ")"))
     dt <- .get.dtype(dmetric, pw = pw)
     if (!is.matrix(centers))
     centers <- matrix(nrow = k, ncol = p, eval(compv))
     if (!missing(memberships)) {
     if (class(memberships) == "data.frame")
     memberships <- as.matrix(memberships)
     if (class(memberships) != "matrix")
     stop("The initial membership degrees matrix is not a numeric data.frame or matrix")
     }
     else {
     memberships <- matrix(nrow = n, ncol = k, eval(compu))
     }
     if (is.null(memberships))
     stop("The initial membership matrix cannot be empty")
     if (any(!is.numeric(memberships)))
     stop("The initial membership matrix is not a numeric data.frame or matrix")
     if (any(is.na(memberships)))
     stop("The initial membership matrix should not contain NAs")
     if (n != nrow(memberships))
     stop("The number of rows of initial membership matrix is different from that of data set")
     if (k != ncol(memberships))
     stop("The number of columns of initial membership matrix is not equal to k, number of clusters")
     if (sum(memberships) != n)
     memberships <- memberships/apply(memberships, 1, sum)
     if (!is.numeric(m))
     stop("The fuzziness exponent (m) should be a number")
     if (m < 1)
     stop("The fuzziness exponent (m) should be a number equals to or greater than 1")
     if (!is.numeric(nstart))
     stop("Number of starts must be integer")
     if (nstart < 1)
     stop("Number of starts cannot be less than 1")
     if (nstart%%ceiling(nstart) > 0)
     nstart <- ceiling(nstart)
     if (!is.numeric(con.val))
     stop("Convergence value must be a number")
     if (con.val <= 0)
     stop("Convergence value can not be 0 or a negatif value")
     if (!is.numeric(iter.max))
     stop("Maximum number of iteration must be a positive integer")
     else iter.max <- ceiling(iter.max)
     if (iter.max <= 1)
     stop("Maximum number of iterations must be equal to or greater than 1")
     if (!is.logical(fixcent))
     stop("Argument 'fixcent' should be a TRUE or FALSE")
     if (!is.logical(fixmemb))
     stop("Argument 'fixmemb' should be a TRUE or FALSE")
     if (fixcent && fixmemb)
     stop("Arguments 'fixcent' and 'fixmemb' should not be a TRUE at the same time")
     if (!is.logical(stand))
     stop("Value of argument 'stand' should be TRUE or FALSE")
     if (stand) {
     x <- scale(x, center = TRUE, scale = TRUE)[, ]
     centers <- scale(centers, center = TRUE, scale = TRUE)[,
     ]
     }
     func.val <- numeric(nstart)
     comp.time <- numeric(nstart)
     iter.num <- numeric(nstart)
     best.func <- Inf
     for (start.idx in 1:nstart) {
     if (start.idx > 1) {
     set.seed(as.integer(Sys.time()) + start.idx)
     if (!fixcent)
     centers <- eval(compv)
     if (!fixmemb)
     memberships <- eval(compu)
     if (stand)
     centers <- scale(centers, center = TRUE, scale = TRUE)[,
     ]
     if (!missing(numseed))
     set.seed(numseed)
     }
     v0 <- v <- centers
     u <- memberships
     d <- matrix(nrow = n, ncol = k, 0)
     prevv <- v + 2 * con.val
     iter <- 0
     cputime <- system.time(while ((iter < iter.max) && (sum(abs(prevv -
     v)) > con.val)) {
     iter <- iter + 1
     prevv <- v
     for (j in 1:k) for (i in 1:n) d[i, j] <- eval(compd)
     for (j in 1:k) for (i in 1:n) if (any(d[i, ] == 0))
     u[i, ] <- rep(1/k, k)
     else u[i, j] <- 1/(sum((d[i, j]/d[i, ])^((2/dt)/(m -
     1))))
     v <- t(u^m) %*% x/colSums(u^m)
     })
     comp.time[start.idx] <- cputime[1]
     iter.num[start.idx] <- iter
     obj.func <- sum(d * (u^m))
     func.val[start.idx] <- obj.func
     if (obj.func < best.func) {
     best.func <- obj.func
     best.u <- u
     best.v <- v
     best.d <- d
     best.start <- start.idx
     }
     }
     clabels <- crisp(best.u)
     csize <- numeric(k)
     for (i in 1:k) csize[i] <- sum(clabels == i)
     csumsqrs <- .sumsqr(x, best.v, clabels)
     if (is.null(rownames(x)))
     rnames <- paste(1:n)
     else rnames <- rownames(x)
     if (is.null(colnames(x)))
     cnames <- paste("p", 1:p, sep = "-")
     else cnames <- colnames(x)
     rownames(x) <- rnames
     colnames(x) <- cnames
     rownames(best.v) <- paste("Cluster", 1:k, sep = " ")
     colnames(best.v) <- cnames
     colnames(v0) <- colnames(best.v)
     rownames(v0) <- rownames(best.v)
     rownames(best.u) <- rnames
     colnames(best.u) <- rownames(best.v)
     rownames(best.d) <- rnames
     colnames(best.d) <- rownames(best.v)
     names(clabels) <- paste(1:n, sep = " ")
     names(csize) <- paste(c(1:k), sep = " ")
     result = list()
     result$u <- best.u
     result$t <- NULL
     result$v <- best.v
     result$v0 <- v0
     result$d <- best.d
     result$f <- NULL
     result$x <- x
     result$cluster <- clabels
     result$csize <- csize
     result$sumsqrs <- csumsqrs
     result$k <- k
     result$m <- m
     result$eta <- NULL
     result$a <- NULL
     result$b <- NULL
     result$beta <- NULL
     result$delta <- NULL
     result$gamma <- NULL
     result$omega <- NULL
     result$ent <- NULL
     result$iter <- iter.num
     result$best.start <- best.start
     result$func.val <- func.val
     result$comp.time <- comp.time
     result$inpargs <- list()
     result$inpargs[1] <- as.integer(iter.max)
     result$inpargs[2] <- con.val
     result$inpargs[3] <- dmetric
     result$inpargs[4] <- alginitv
     result$inpargs[5] <- alginitu
     result$inpargs[6] <- fixcent
     result$inpargs[7] <- fixmemb
     result$inpargs[8] <- stand
     names(result$inpargs) <- c("iter.max", "con.val", "dmetric",
     "alginitv", "alginitu", "fixcent", "fixmemb", "stand")
     result$algorithm <- "FCM"
     result$call <- match.call()
     class(result) <- c("ppclust")
     return(result)
    }
    <bytecode: 0x3ee4800>
    <environment: namespace:ppclust>
     --- function search by body ---
    Function fcm in namespace ppclust has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 103-105 (fcm.Rmd)
    Error: processing vignette 'fcm.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building 'fcm.Rmd'
    
    --- re-building 'pcm.Rmd' using rmarkdown
    Loading required package: ggplot2
    Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    ppclust
     --- call from context ---
    comp.omega(d = res.fcm$d, u = res.fcm$u, m = eta, K = K)
     --- call from argument ---
    if (class(u) == "data.frame") u <- as.matrix(u)
     --- R stacktrace ---
    where 1: comp.omega(d = res.fcm$d, u = res.fcm$u, m = eta, K = K)
    where 2: pcm(x, centers = 3)
    where 3: eval(expr, envir, enclos)
    where 4: eval(expr, envir, enclos)
    where 5: withVisible(eval(expr, envir, enclos))
    where 6: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler,
     error = eHandler, message = mHandler)
    where 7: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir,
     enclos)), warning = wHandler, error = eHandler, message = mHandler))
    where 8: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr,
     envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
    where 9: 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 10: evaluate::evaluate(...)
    where 11: 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: 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 13: block_exec(params)
    where 14: call_block(x)
    where 15: process_group.block(group)
    where 16: process_group(group)
    where 17: 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 18: process_file(text, output)
    where 19: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
    where 20: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(),
     output_dir = getwd(), ...)
    where 21: vweave_rmarkdown(...)
    where 22: engine$weave(file, quiet = quiet, encoding = enc)
    where 23: doTryCatch(return(expr), name, parentenv, handler)
    where 24: tryCatchOne(expr, names, parentenv, handlers[[1L]])
    where 25: tryCatchList(expr, classes, parentenv, handlers)
    where 26: 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 27: tools:::.buildOneVignette("pcm.Rmd", "/home/hornik/tmp/R.check/r-devel-clang/Work/PKGS/ppclust.Rcheck/vign_test/ppclust",
     TRUE, FALSE, "pcm", "latin1", "/tmp/RtmpsxTsFh/file310966cdd8dc.rds")
    
     --- value of length: 2 type: logical ---
    [1] FALSE FALSE
     --- function from context ---
    function (d, u, m = 2, pco = NULL, K = 1)
    {
     if (!missing(pco)) {
     if (pco$algorithm == "PCM")
     u <- pco$t
     if (pco$algorithm == "FCM")
     u <- pco$u
     d <- pco$d
     m <- pco$m
     }
     if (missing(u))
     stop("Missing typicality matrix")
     if (is.null(u))
     stop("Memberships matrix contains no data")
     if (class(u) == "data.frame")
     u <- as.matrix(u)
     if (class(u) != "matrix")
     stop("Memberships data must be numeric data frame or matrix")
     if (any(is.na(u)))
     stop("Memberships data should not contain NA values")
     if (!is.numeric(u))
     stop("Memberships data must be a numeric data frame or matrix")
     if (missing(d))
     stop("Missing distance matrix")
     if (is.null(d))
     stop("Distance matrix contains no data")
     if (class(d) == "data.frame")
     d <- as.matrix(d)
     if (class(d) != "matrix")
     stop("Distance data must be numeric data frame or matrix")
     if (any(is.na(d)))
     stop("Distance data should not contain NA values")
     if (!is.numeric(m))
     stop("Argument 'm' must be a numeric value")
     if (!is.numeric(K))
     stop("Argument 'K' must be a numeric value")
     omega <- numeric(ncol(u))
     for (i in 1:ncol(u)) omega[i] <- K * ((u[, i]^m) %*% d[,
     i])/sum(u[, i]^m)
     return(omega)
    }
    <bytecode: 0x49b40f0>
    <environment: namespace:ppclust>
     --- function search by body ---
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 77-78 (pcm.Rmd)
    Error: processing vignette 'pcm.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building 'pcm.Rmd'
    
    --- re-building 'upfc.Rmd' using rmarkdown
    Loading required package: ggplot2
    Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    ppclust
     --- call from context ---
    upfc(x, centers = 3, memberships = u0)
     --- call from argument ---
    if (class(memberships) == "data.frame") memberships <- as.matrix(memberships)
     --- R stacktrace ---
    where 1: upfc(x, centers = 3, memberships = u0)
    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(),
     output_dir = getwd(), ...)
    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("upfc.Rmd", "/home/hornik/tmp/R.check/r-devel-clang/Work/PKGS/ppclust.Rcheck/vign_test/ppclust",
     TRUE, FALSE, "upfc", "latin1", "/tmp/RtmpsxTsFh/file31094a965ea1.rds")
    
     --- value of length: 2 type: logical ---
    [1] FALSE FALSE
     --- function from context ---
    function (x, centers, memberships, m = 2, eta = 2, a, b, dmetric = "sqeuclidean",
     pw = 2, alginitv = "kmpp", alginitu = "imembrand", nstart = 1,
     iter.max = 1000, con.val = 1e-09, fixcent = FALSE, fixmemb = FALSE,
     stand = FALSE, numseed)
    {
     if (missing(x))
     stop("Missing data set")
     if (is.null(x))
     stop("Data set is null")
     if ((is.data.frame(x)) || (is.vector(x)))
     x <- as.matrix(x)
     if (!is.matrix(x))
     stop("Data set must be a vector, data frame or matrix")
     if (any(is.na(x)))
     stop("Data set should not contain NA values. Remove NAs and try again")
     if (!is.numeric(x))
     stop("Data set must be a numeric vector, data frame or matrix")
     n <- nrow(x)
     p <- ncol(x)
     if (missing(centers))
     stop("Missing argument 'centers'")
     if (is.data.frame(centers))
     centers <- as.matrix(centers)
     if (is.matrix(centers)) {
     if (is.null(centers))
     stop("Centers contains no data")
     if (any(is.na(centers)))
     stop("Centers should not contain NA values")
     if (!is.numeric(centers))
     stop("Centers should be numeric")
     else k <- nrow(centers)
     }
     else {
     if (!is.numeric(centers))
     stop("Centers should be an integer for the number of clusters or a numeric prototypes matrix")
     k <- ceiling(centers)
     }
     if ((k < 1) || (k > n))
     stop(paste("k, number of clusters should be between 1 and",
     n, ". Check the value of 'centers' argument"))
     if (!missing(numseed)) {
     if (!is.numeric(numseed))
     stop("Argument numseed should be a number")
     else set.seed(numseed)
     }
     alginitv <- match.arg(alginitv, inaparc::get.algorithms("prototype"))
     compv <- parse(text = paste0("inaparc::", alginitv, "(x,",
     k, ")$v"))
     algsinitu <- match.arg(alginitu, inaparc::get.algorithms("membership"))
     alginitu <- match.arg(alginitu, algsinitu)
     if (alginitu == "imembrand")
     compu <- parse(text = paste0("inaparc::", alginitu, "(n,",
     k, ")$u"))
     else compu <- parse(text = paste0("inaparc::", alginitu,
     "(x,", k, ")$u"))
     compd <- parse(text = paste0(".compdist(x[i,], v[j,], dmetric='",
     dmetric, "', p=", pw, ")"))
     compd1 <- parse(text = paste0(".compdist(x[i,], v[l,], dmetric='",
     dmetric, "', p=", pw, ")"))
     if (!is.matrix(centers))
     centers <- matrix(nrow = k, ncol = p, eval(compv))
     if (!missing(memberships)) {
     if (class(memberships) == "data.frame")
     memberships <- as.matrix(memberships)
     if (class(memberships) != "matrix")
     stop("The initial membership degrees matrix is not a numeric data.frame or matrix")
     }
     else {
     memberships <- matrix(nrow = n, ncol = k, eval(compu))
     }
     if (is.null(memberships))
     stop("The initial membership matrix cannot be empty")
     if (any(!is.numeric(memberships)))
     stop("The initial membership matrix is not a numeric data.frame or matrix")
     if (any(is.na(memberships)))
     stop("The initial membership matrix should not contain NAs")
     if (n != nrow(memberships))
     stop("The number of rows of initial membership matrix is different from that of data set")
     if (k != ncol(memberships))
     stop("The number of columns of initial membership matrix is not equal to k, number of clusters")
     if (sum(memberships) != n)
     memberships = memberships/apply(memberships, 1, sum)
     if (!is.numeric(m))
     stop("The fuzziness exponent (m) should be a number")
     if (m < 1)
     stop("The fuzziness exponent (m) should be a number greater than 1")
     if (!is.numeric(eta))
     stop("The typicality exponent (eta) should be a number")
     if (eta < 1)
     stop("The typicality exponent (eta) should be a number greater than 1")
     if (missing(a) && missing(b)) {
     a <- 1
     b <- 1
     }
     if ((missing(a)) && (!missing(b)))
     a <- 1
     if ((!missing(a)) && (missing(b)))
     b <- 1
     if (!is.numeric(a))
     stop("The coefficient 'a' should be a number")
     if (a < 0)
     stop("The coefficient 'a' should be a number greater than 0")
     if (!is.numeric(b))
     stop("The coefficient 'b' should be a number")
     if (b < 0)
     stop("The coefficient 'b' should be a number greater than 0")
     if (!is.numeric(nstart))
     stop("Number of starts must be integer")
     if (nstart < 1)
     stop("Number of starts cannot be less than 1")
     if (nstart%%ceiling(nstart) > 0)
     nstart <- ceiling(nstart)
     if (!is.numeric(con.val))
     stop("Convergence value must be a number")
     if (con.val <= 0)
     stop("Convergence value can not be 0 or a negatif value")
     if (!is.numeric(iter.max))
     stop("Maximum number of iteration must be a positive integer")
     else iter.max <- ceiling(iter.max)
     if (iter.max <= 1)
     stop("Maximum number of iterations must be equal to or greater than 1")
     if (!is.logical(fixcent))
     stop("Argument 'fixcent' should be a TRUE or FALSE")
     if (!is.logical(fixmemb))
     stop("Argument 'fixmemb' should be a TRUE or FALSE")
     if (fixcent && fixmemb)
     stop("Arguments 'fixcent' and 'fixmemb' should not be a TRUE at the same time")
     if (stand) {
     x <- scale(x, center = TRUE, scale = TRUE)[, ]
     centers <- scale(centers, center = TRUE, scale = TRUE)[,
     ]
     }
     xcmean <- colMeans(x)
     ssq <- 0
     for (i in 1:n) ssq <- ssq + (t(x[i, ] - xcmean) %*% (x[i,
     ] - xcmean))
     beta <- as.double(ssq/n)
     func.val <- numeric(nstart)
     comp.time <- numeric(nstart)
     iter.num <- numeric(nstart)
     best.func <- Inf
     for (start.idx in 1:nstart) {
     if (start.idx > 1) {
     set.seed(as.integer(Sys.time()) + start.idx)
     if (!fixcent)
     centers <- eval(compv)
     if (!fixmemb)
     memberships <- eval(compu)
     if (stand)
     centers <- scale(centers, center = TRUE, scale = TRUE)[,
     ]
     if (!missing(numseed))
     set.seed(numseed)
     }
     v0 <- v <- centers
     u <- memberships
     d <- t <- matrix(nrow = n, ncol = k, 0)
     prevv <- v + 2 * con.val
     iter <- 0
     cputime <- system.time(while ((iter < iter.max) && (sum(abs(prevv -
     v)) > con.val)) {
     iter <- iter + 1
     prevv <- v
     for (i in 1:n) for (j in 1:k) d[i, j] <- eval(compd)
     for (i in 1:n) {
     for (j in 1:k) {
     if (min(d[i, ]) == 0) {
     u[i, ] <- t[i, ] <- rep(0, k)
     u[i, j] <- t[i, j] <- 1
     }
     else {
     u[i, j] <- ((1/d[i, j])^(1/(m - 1)))/sum(((1/d[i,
     ])^(1/(m - 1))))
     t[i, j] <- exp(-((b * eta * sqrt(k) * d[i,
     j])/beta))
     }
     }
     }
     v <- t(a * u^m + b * t^eta) %*% x/colSums(a * u^m +
     b * t^eta)
     })
     comp.time[start.idx] <- round(cputime[1], 9)
     iter.num[start.idx] <- iter
     tot1 <- tot2 <- 0
     for (i in 1:n) {
     for (j in 1:k) {
     tot1 <- tot1 + (a * u[i, j]^m + b * t[i, j]^eta) *
     (d[i, j])
     if (t[i, j] != 0)
     tot2 <- tot2 + (beta/eta^2 * sqrt(k)) * (t[i,
     j]^eta * log(t[i, j]^eta, exp(1)) - t[i,
     j]^eta)
     }
     }
     obj.func = tot1 + tot2
     func.val[start.idx] <- obj.func
     if (obj.func < best.func) {
     best.func <- obj.func
     best.u <- u
     best.t <- t
     best.v <- v
     best.d <- d
     best.start <- start.idx
     }
     }
     clabels <- crisp(best.t)
     csize <- numeric(k)
     for (i in 1:k) csize[i] <- sum(clabels == i)
     csumsqrs <- .sumsqr(x, best.v, clabels)
     if (is.null(rownames(x)))
     rnames <- paste(1:n)
     else rnames <- rownames(x)
     if (is.null(colnames(x)))
     cnames <- paste("p", 1:p, sep = "-")
     else cnames <- colnames(x)
     rownames(x) <- rnames
     colnames(x) <- cnames
     rownames(best.v) <- paste("Cluster", 1:k, sep = " ")
     colnames(best.v) <- cnames
     colnames(v0) <- colnames(best.v)
     rownames(v0) <- rownames(best.v)
     rownames(best.u) <- rnames
     colnames(best.u) <- rownames(best.v)
     rownames(best.t) <- rnames
     colnames(best.t) <- rownames(best.v)
     rownames(best.d) <- rnames
     colnames(best.d) <- rownames(best.v)
     names(clabels) <- paste(1:n, sep = " ")
     names(csize) <- paste(c(1:k), sep = " ")
     result = list()
     result$u <- best.u
     result$t <- best.t
     result$v <- best.v
     result$v0 <- v0
     result$d <- best.d
     result$f <- NULL
     result$x <- x
     result$cluster <- clabels
     result$csize <- csize
     result$sumsqrs <- csumsqrs
     result$k <- k
     result$m <- m
     result$eta <- eta
     result$a <- a
     result$b <- b
     result$beta <- beta
     result$delta <- NULL
     result$gamma <- NULL
     result$omega <- NULL
     result$ent <- NULL
     result$iter <- iter.num
     result$best.start <- best.start
     result$func.val <- func.val
     result$comp.time <- comp.time
     result$inpargs <- list()
     result$inpargs[1] <- as.integer(iter.max)
     result$inpargs[2] <- con.val
     result$inpargs[3] <- dmetric
     result$inpargs[4] <- alginitv
     result$inpargs[5] <- alginitu
     result$inpargs[6] <- fixcent
     result$inpargs[7] <- fixmemb
     result$inpargs[8] <- stand
     names(result$inpargs) <- c("iter.max", "con.val", "dmetric",
     "alginitv", "alginitu", "fixcent", "fixmemb", "stand")
     result$algorithm <- "UPFC"
     result$call <- match.call()
     class(result) <- c("ppclust")
     return(result)
    }
    <bytecode: 0x47eced0>
    <environment: namespace:ppclust>
     --- function search by body ---
    Function upfc in namespace ppclust has this body.
     ----------- END OF FAILURE REPORT --------------
    Quitting from lines 102-104 (upfc.Rmd)
    Error: processing vignette 'upfc.Rmd' failed with diagnostics:
    the condition has length > 1
    --- failed re-building 'upfc.Rmd'
    
    SUMMARY: processing the following files failed:
     'fcm.Rmd' 'pcm.Rmd' 'upfc.Rmd'
    
    Error: Vignette re-building failed.
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 0.1.3
Check: installed package size
Result: NOTE
     installed size is 5.2Mb
     sub-directories of 1Mb or more:
     doc 4.6Mb
Flavor: r-patched-solaris-x86