cyclocomp/0000755000176200001440000000000014473672646012265 5ustar liggesuserscyclocomp/NAMESPACE0000644000176200001440000000061714473620426013475 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(cyclocomp) export(cyclocomp_package) export(cyclocomp_package_dir) export(cyclocomp_q) importFrom(callr,r) importFrom(callr,rcmd_safe) importFrom(crayon,red) importFrom(crayon,underline) importFrom(crayon,yellow) importFrom(desc,desc_get) importFrom(remotes,install_local) importFrom(utils,head) importFrom(utils,tail) importFrom(withr,with_dir) cyclocomp/LICENSE0000644000176200001440000000010214473603422013245 0ustar liggesusersYEAR: 2023 COPYRIGHT HOLDER: Mango Solutions; Posit Software, PBC cyclocomp/README.md0000644000176200001440000000517514473623375013547 0ustar liggesusers # cyclocomp > Cyclomatic Complexity of R Code [![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active) [![](https://www.r-pkg.org/badges/version/cyclocomp)](https://www.r-pkg.org/pkg/cyclocomp) [![CRAN RStudio mirror downloads](https://cranlogs.r-pkg.org/badges/cyclocomp)](https://www.r-pkg.org/pkg/cyclocomp) [![Coverage Status](https://img.shields.io/codecov/c/github/Gaborcsardi/cyclocomp/main.svg)](https://app.codecov.io/github/Gaborcsardi/cyclocomp?branch=main) [![R-CMD-check](https://github.com/gaborcsardi/cyclocomp/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/gaborcsardi/cyclocomp/actions/workflows/R-CMD-check.yaml) Cyclomatic complexity is a software metric (measurement), used to indicate the complexity of a program. It is a quantitative measure of the number of linearly independent paths through a program’s source code. It was developed by Thomas J. McCabe, Sr. in 1976. ## Installation ``` r devtools::install_github("Gaborcsardi/cyclocomp") ``` ## Usage ``` r library(cyclocomp) ``` `cyclocomp` takes quoted R expressions or function objects, and returns a single integer, the cyclomatic complexity of the expression or function. ``` r cyclocomp(quote( if (condition) "foo" else "bar" )) ``` #> [1] 2 ``` r cyclocomp(quote( while (condition) { loop } )) ``` #> [1] 3 ``` r cyclocomp( function(arg) { calulate(this); and(that) } ) ``` #> [1] 1 ``` r cyclocomp(ls) ``` #> [1] 10 ``` r cyclocomp(cyclocomp) ``` #> [1] 1 Some more examples for the R control structures. A simple `if` first: ``` r cyclocomp(quote({ if (condition) this })) ``` #> [1] 2 An `if` with an `else` branch: ``` r cyclocomp(quote({ if (condition) this else that })) ``` #> [1] 2 Loops: ``` r cyclocomp(quote({ for (var in seq) expr })) ``` #> [1] 3 ``` r cyclocomp(quote({ while (cond) expr })) ``` #> [1] 3 ``` r cyclocomp(quote({ repeat expr })) ``` #> [1] 2 `break` and `next` statements add to the complexity: ``` r cyclocomp(quote({ for (var in seq) { this break that } })) ``` #> [1] 4 ``` r cyclocomp(quote({ for (var in seq) { this next that } })) ``` #> [1] 4 Multiple (explicit or implicit) `return` calls also add to the complexity: ``` r f <- function(arg) { if (arg) { return("this") } else { return("that") } "Otherwise return me" } cyclocomp(f) ``` #> [1] 4 ## License MIT © Mango Solutions; Posit Software, PBC cyclocomp/man/0000755000176200001440000000000014473620426013025 5ustar liggesuserscyclocomp/man/cyclocomp_package.Rd0000644000176200001440000000127114473623415016761 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cyclocomp.R \name{cyclocomp_package} \alias{cyclocomp_package} \title{Cyclomatic complexity of the objects in an installed package} \usage{ cyclocomp_package(package) } \arguments{ \item{package}{Package name, character scalar.} } \value{ Data frame with two columns: \code{name} and \code{cyclocomp}. } \description{ Note that the package must be installed. } \examples{ ## They might take a while to run \dontrun{ cyclocomp_package("grDevices") cyclocomp_package("methods") } } \seealso{ Other cyclomatic complexity: \code{\link{cyclocomp_package_dir}()}, \code{\link{cyclocomp}()} } \concept{cyclomatic complexity} cyclocomp/man/cyclocomp_package_dir.Rd0000644000176200001440000000114714473623415017621 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/package_dir.R \name{cyclocomp_package_dir} \alias{cyclocomp_package_dir} \title{Cyclomatic complexity of a local package} \usage{ cyclocomp_package_dir(path = ".") } \arguments{ \item{path}{Path to the root directory of the R package.} } \value{ Data frame with two columns: \code{name} and \code{cyclocomp}. } \description{ Automatically builds the package and installs it to a temporary directory. } \seealso{ Other cyclomatic complexity: \code{\link{cyclocomp_package}()}, \code{\link{cyclocomp}()} } \concept{cyclomatic complexity} cyclocomp/man/cyclocomp.Rd0000644000176200001440000000336314473633032015306 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cyclocomp.R \docType{package} \name{cyclocomp} \alias{cyclocomp} \alias{cyclocomp-package} \alias{cyclocomp_q} \title{Cyclomatic Complexity of R Code} \usage{ cyclocomp(expr) cyclocomp_q(expr) } \arguments{ \item{expr}{An R function or expression.} } \value{ Integer scalar, the cyclomatic complexity of the expression. } \description{ Cyclomatic complexity is a software metric (measurement), used to indicate the complexity of a program. It is a quantitative measure of the number of linearly independent paths through a program's source code. It was developed by Thomas J. McCabe, Sr. in 1976. Calculate the cyclomatic complexity of an R function or expression. } \examples{ ## Supply a function cyclocomp( function(arg) { calulate(this); and(that) } ) cyclocomp(ls) cyclocomp(cyclocomp) ## Or a quoted expression cyclocomp(quote( if (condition) "foo" else "bar" )) ## cyclocomp_q quotes the expression for you cyclocomp_q(while (condition) { loop }) ## Complexity of individual control flow constructs cyclocomp(quote({ if (condition) this })) cyclocomp(quote({ if (condition) this else that })) cyclocomp(quote({ for (var in seq) expr })) cyclocomp(quote({ while (cond) expr })) cyclocomp(quote({ repeat expr })) cyclocomp(quote({ for (var in seq) { this break that } })) cyclocomp(quote({ for (var in seq) { this next that } })) } \seealso{ Useful links: \itemize{ \item \url{https://github.com/gaborcsardi/cyclocomp} \item Report bugs at \url{https://github.com/gaborcsardi/cyclocomp/issues} } Other cyclomatic complexity: \code{\link{cyclocomp_package_dir}()}, \code{\link{cyclocomp_package}()} } \concept{cyclomatic complexity} cyclocomp/DESCRIPTION0000644000176200001440000000142614473672646013776 0ustar liggesusersPackage: cyclocomp Title: Cyclomatic Complexity of R Code Version: 1.1.1 Author: Gabor Csardi Maintainer: Gabor Csardi Description: Cyclomatic complexity is a software metric (measurement), used to indicate the complexity of a program. It is a quantitative measure of the number of linearly independent paths through a program's source code. It was developed by Thomas J. McCabe, Sr. in 1976. License: MIT + file LICENSE URL: https://github.com/gaborcsardi/cyclocomp BugReports: https://github.com/gaborcsardi/cyclocomp/issues Imports: callr, crayon, desc, remotes, withr Suggests: testthat RoxygenNote: 7.2.3 Encoding: UTF-8 NeedsCompilation: no Packaged: 2023-08-30 12:49:50 UTC; gaborcsardi Repository: CRAN Date/Publication: 2023-08-30 17:00:22 UTC cyclocomp/tests/0000755000176200001440000000000014473570672013423 5ustar liggesuserscyclocomp/tests/testthat/0000755000176200001440000000000014473672646015267 5ustar liggesuserscyclocomp/tests/testthat/test-andor.R0000644000176200001440000000035014473570672017464 0ustar liggesusers context("&& and ||") test_that("&& works well", { f <- function() { FALSE && TRUE } expect_equal(cyclocomp(f), 2) }) test_that("|| works well", { f <- function() { FALSE || TRUE } expect_equal(cyclocomp(f), 2) }) cyclocomp/tests/testthat/test-repeat.R0000644000176200001440000000017614473570672017647 0ustar liggesusers context("Repeat loops") test_that("simple repeat loops", { f <- function() repeat { } expect_equal(cyclocomp(f), 2) }) cyclocomp/tests/testthat/test-seq.R0000644000176200001440000000102314473570672017147 0ustar liggesusers context("Simple sequences") test_that("sequences are simple", { f <- function() { "foo"; "bar"; "foobar" } expect_equal(cyclocomp(f), 1) f <- function() { print("foo"); print("bar"); print("foobar") } expect_equal(cyclocomp(f), 1) f <- function() { } expect_equal(cyclocomp(f), 1) f <- function(foo) { } expect_equal(cyclocomp(f), 1) f <- function(foo = 1, bar = 2) { } expect_equal(cyclocomp(f), 1) f <- function(foo = 1, bar = 2) { bar; foo + 1; print(bar / 2) } expect_equal(cyclocomp(f), 1) }) cyclocomp/tests/testthat/test-if.R0000644000176200001440000000107414473570672016763 0ustar liggesusers context("If") test_that("simple if statements", { f <- function() { if (TRUE) "foo"; "bar"; "foobar" } expect_equal(cyclocomp(f), 2) f <- function() { "bar"; if (TRUE) "foo"; "bar"; "foobar" } expect_equal(cyclocomp(f), 2) f <- function() { if (TRUE) "foo" } expect_equal(cyclocomp(f), 2) f <- function() { if (TRUE) "foo" else "bar" } expect_equal(cyclocomp(f), 2) f <- function() { if (TRUE) "foo" else "bar"; "foobar" } expect_equal(cyclocomp(f), 2) f <- function() { "bar"; if (TRUE) "foo" else "bar" } expect_equal(cyclocomp(f), 2) }) cyclocomp/tests/testthat/test-next.R0000644000176200001440000000102214473570672017334 0ustar liggesusers context("next") test_that("next works", { f <- function() { for (i in 1:10) { 1; next; 2 } } expect_equal(cyclocomp(f), 4) f <- function() { for (i in 1:10) { 1; next } } expect_equal(cyclocomp(f), 3) f <- function() { while (TRUE) { 1; next; 2 } } expect_equal(cyclocomp(f), 4) f <- function() { while (TRUE) { 1; next } } expect_equal(cyclocomp(f), 3) f <- function() { repeat { 1; next; 2 } } expect_equal(cyclocomp(f), 3) f <- function() { repeat { 1; next } } expect_equal(cyclocomp(f), 2) }) cyclocomp/tests/testthat/test-return.R0000644000176200001440000000124514473570672017704 0ustar liggesusers context("Return") test_that("returns work well", { f <- function() { g <- function() { "foo" return() "bar" } } expect_equal(cyclocomp(f), 2) f <- function() { g <- function() { "foo" "bar" } } expect_equal(cyclocomp(f), 1) f <- function() { return() } expect_equal(cyclocomp(f), 1) f <- function() { g <- function() { "foo" "bar" } return() } expect_equal(cyclocomp(f), 1) f <- function() { g <- function() { "foo" "bar" return("ok") } } expect_equal(cyclocomp(f), 1) f <- function() { return(); 1; } expect_equal(cyclocomp(f), 2) }) cyclocomp/tests/testthat/test-break.R0000644000176200001440000000114414473570672017447 0ustar liggesusers context("Break in loops") test_that("break in simple loops", { f <- function() { for (i in 1:10) { 1; break; 2 } } expect_equal(cyclocomp(f), 4) f <- function() { for (i in 1:10) { 1; 2; break } } expect_equal(cyclocomp(f), 3) }) test_that("break in the loop condition", { f <- function() { for (i in 1:2) { for (j in { break; 1:10 }) { "foobar" } i } i } expect_equal(cyclocomp(f), 6) f <- function() { for (i in 1:2) { for (j in 1:10) { break "foobar" } i } i } expect_equal(cyclocomp(f), 6) }) cyclocomp/tests/testthat/test-stress.R0000644000176200001440000000141514473570672017707 0ustar liggesusers context("Stress test on base R functions") do_pkg <- function(pkg) { alln <- ls(asNamespace(pkg)) for (n in alln) { expect_silent( cyclocomp(get(n, asNamespace(pkg))), info = paste0(pkg, "::", n) ) } } expect_silent <- function(expr, info = NULL, label = NULL) { out <- tryCatch( evaluate_promise(expr), error = function(e) stop("info: ", info, ", label: ", label) ) expect_equal(out$output, "", info = info, label = label) expect_equal(length(out$warnings), 0, info = info, label = label) expect_equal(length(out$messages), 0, info = info, label = label) } test_that("some base packages", { skip("Takes too long to run currently") do_pkg("base") do_pkg("stats") do_pkg("utils") do_pkg("methods") do_pkg("graphics") }) cyclocomp/tests/testthat/test-cyclocomp-package.R0000644000176200001440000000036314473570672021746 0ustar liggesusers context("CC of a package") test_that("cyclocomp_package", { res <- cyclocomp_package("cyclocomp") expect_true(inherits(res, "data.frame")) expect_true("cyclocomp" %in% res$name) expect_equal(colnames(res), c("name", "cyclocomp")) }) cyclocomp/tests/testthat/test-calls.R0000644000176200001440000000020014473570672017451 0ustar liggesusers context("Function calls") test_that("function calls are OK", { f <- function() print() expect_equal(cyclocomp(f), 1) }) cyclocomp/tests/testthat/test-function.R0000644000176200001440000000031214473570672020204 0ustar liggesusers context("Functions") test_that("function definitions work", { f <- function() function() "foo" expect_equal(cyclocomp(f), 1) f <- function() function(ok) ok expect_equal(cyclocomp(f), 1) }) cyclocomp/tests/testthat/test-cyclocomp_q.R0000644000176200001440000000071614473570672020677 0ustar liggesusers context("cyclocomp_q") test_that("cyclocomp_q works the same as cyclocomp + quote", { expect_equal( cyclocomp_q(if (TRUE) "foo" else if(FALSE) "bar" else "baz"), cyclocomp(quote(if (TRUE) "foo" else if(FALSE) "bar" else "baz"))) expect_equal( cyclocomp_q(while(condition && another_condition) if(something) do_something else break), cyclocomp(quote(while(condition && another_condition) if(something) do_something else break))) }) cyclocomp/tests/testthat.R0000644000176200001440000000007614473570672015411 0ustar liggesuserslibrary(testthat) library(cyclocomp) test_check("cyclocomp") cyclocomp/R/0000755000176200001440000000000014473633027012454 5ustar liggesuserscyclocomp/R/utils.R0000644000176200001440000000104214473570672013742 0ustar liggesusers what_expr <- function(expr) { if (is.call(expr)) { paste0(as.character(expr[[1]])[1], "()") } else { typeof(expr) } } ## We need the tryCatch, because the string might contain invalid ## multi-byte characters. E.g. ## substring('\x93', 1, 10) and nchar('\x93') both fail what_atomic <- function(expr) { if (is.character(expr)) { tryCatch( paste0("\"", substring(expr[1], 1, 10), "\""), error = function(e) "\"\"" ) } else if (is.name(expr)) { as.character(expr) } else { "atomic" } } cyclocomp/R/package_dir.R0000644000176200001440000000404714473620652015035 0ustar liggesusers #' Cyclomatic complexity of a local package #' #' Automatically builds the package and installs it to a temporary #' directory. #' #' @param path Path to the root directory of the R package. #' @return Data frame with two columns: \code{name} and \code{cyclocomp}. #' #' @family cyclomatic complexity #' @importFrom remotes install_local #' @importFrom callr r #' @importFrom desc desc_get #' @export cyclocomp_package_dir <- function(path = ".") { tmp <- tempfile() dir.create(tmp) on.exit(unlink(tmp, recursive = TRUE), add = TRUE) pkgname <- desc_get("Package", file = file.path(path, "DESCRIPTION")) targz <- build_package(path) install_local(targz, lib = tmp, upgrade = "never") r(libpath = c(tmp, .libPaths()), function(pkg) { loadNamespace(pkg) cyclocomp::cyclocomp_package(pkg) }, args = list(pkgname) ) } #' @importFrom withr with_dir #' @importFrom callr rcmd_safe build_package <- function(path) { path <- normalizePath(path) tmpdir <- tempfile() dir.create(tmpdir) on.exit(unlink(tmpdir, recursive = TRUE)) file.copy(path, tmpdir, recursive = TRUE) ## If not a tar.gz, build it. Otherwise just leave it as it is. if (file.info(path)$isdir) { build_status <- with_dir( tmpdir, rcmd_safe("build", basename(path)) ) unlink(file.path(tmpdir, basename(path)), recursive = TRUE) } report_system_error("Build failed", build_status) ## replace previous handler, no need to clean up any more on.exit(NULL) file.path( tmpdir, list.files(tmpdir, pattern = "\\.tar\\.gz$") ) } #' @importFrom crayon yellow red underline report_system_error <- function(msg, status) { if (status$status == 0) return() if (status$stderr == "") { stop( msg, ", unknown error, standard output:\n", yellow(status$stdout), call. = FALSE ) } else { stop( underline(yellow(paste0("\n", msg, ", standard output:\n\n"))), yellow(status$stdout), "\n", underline(red("Standard error:\n\n")), red(status$stderr), call. = FALSE ) } } cyclocomp/R/cyclocomp.R0000644000176200001440000000457514473633027014602 0ustar liggesusers #' Cyclomatic Complexity of R Code #' #' Cyclomatic complexity is a software metric (measurement), used to indicate #' the complexity of a program. It is a quantitative measure of the number of #' linearly independent paths through a program's source code. It was developed #' by Thomas J. McCabe, Sr. in 1976. #' #' @docType package #' @name cyclocomp "_PACKAGE" #' Cyclomatic Complexity of R Code #' #' Calculate the cyclomatic complexity of an R function or expression. #' @param expr An R function or expression. #' @return Integer scalar, the cyclomatic complexity of the #' expression. #' @export #' @family cyclomatic complexity #' #' @examples #' ## Supply a function #' cyclocomp( #' function(arg) { calulate(this); and(that) } #' ) #' cyclocomp(ls) #' cyclocomp(cyclocomp) #' #' ## Or a quoted expression #' cyclocomp(quote( if (condition) "foo" else "bar" )) #' #' ## cyclocomp_q quotes the expression for you #' cyclocomp_q(while (condition) { loop }) #' #' ## Complexity of individual control flow constructs #' cyclocomp(quote({ #' if (condition) this #' })) #' #' cyclocomp(quote({ #' if (condition) this else that #' })) #' #' cyclocomp(quote({ #' for (var in seq) expr #' })) #' #' cyclocomp(quote({ #' while (cond) expr #' })) #' #' cyclocomp(quote({ #' repeat expr #' })) #' #' cyclocomp(quote({ #' for (var in seq) { #' this #' break #' that #' } #' })) #' #' cyclocomp(quote({ #' for (var in seq) { #' this #' next #' that #' } #' })) cyclocomp <- function(expr) { fg <- flowgraph(expr) nrow(fg$edges) - nrow(fg$nodes) + 2L } #' Cyclomatic complexity of the objects in an installed package #' #' Note that the package must be installed. #' #' @param package Package name, character scalar. #' @return Data frame with two columns: \code{name} and \code{cyclocomp}. #' #' @family cyclomatic complexity #' @export #' @examples #' ## They might take a while to run #' \dontrun{ #' cyclocomp_package("grDevices") #' cyclocomp_package("methods") #' } cyclocomp_package <- function(package) { names <- ls(asNamespace(package)) cc <- vapply(names, function(n) cyclocomp(get(n, asNamespace(package))), 1L) d <- data.frame( stringsAsFactors = FALSE, name = unname(names), cyclocomp = unname(cc) ) d[order(d$cyclocomp, decreasing = TRUE), ] } #' @rdname cyclocomp #' @export cyclocomp_q <- function(expr) { cyclocomp(substitute(expr)) } cyclocomp/R/flowgraph.R0000644000176200001440000001536714473603606014604 0ustar liggesusers #' @importFrom utils head tail flowgraph <- function(expr) { prealloc <- 4000 num_nodes <- 0 nodes <- list( id = rep("", prealloc), type = rep("", prealloc) ) nodeslast <- rep(list(character()), prealloc) ## The structure of the graph is stored here num_edges <- 0 edges <- list( from = rep("", prealloc), to = rep("", prealloc) ) add_node <- function(x, id, type, last = character()) { num_nodes <<- num_nodes + 1 nodes$id[num_nodes] <<- id nodes$type[num_nodes] <<- type nodeslast[[num_nodes]] <<- last } add_to_last <- function(elem, id) { w <- which(nodes$id == elem) nodeslast[[w]] <<- c(nodeslast[[w]], id) } add_edges <- function(...) { args <- unlist(list(...)) n <- length(args) - 1 if (n > 0) { edges$from[num_edges + (1:n)] <<- head(args, -1) edges$to[num_edges + (1:n)] <<- tail(args, -1) num_edges <<- num_edges + n } } add_node(NULL, "2", "exit") add_edges("1", "2") breaks <- character() breaks_push <- function(id) { breaks <<- c(breaks, id) } breaks_pop <- function() { breaks <<- head(breaks, -1) } breaks_tail <- function() { tail(breaks, 1) } nexts <- character() nexts_push <- function(id) { nexts <<- c(nexts, id) } nexts_pop <- function() { nexts <<- head(nexts, -1) } nexts_tail <- function() { tail(nexts, 1) } functions <- character() functions_push <- function(id) { functions <<- c(functions, id) } functions_pop <- function() { functions <<- head(functions, -1) } functions_tail <- function() { tail(functions, 1) } walk_lang <- function(x, id) { if (is.call(x) && identical(x[[1]], quote(return)) && is.primitive(eval(x[[1]]))) { walk_return(x, id) } else if (is.call(x) && identical(x[[1]], quote(`for`))) { walk_for(x, id) } else if (is.call(x) && identical(x[[1]], quote(`while`))) { walk_while(x, id) } else if (is.call(x) && identical(x[[1]], quote(`repeat`))) { walk_repeat(x, id) } else if (is.call(x) && identical(x[[1]], quote(`break`))) { walk_break(x, id) } else if (is.call(x) && identical(x[[1]], quote(`next`))) { walk_next(x, id) } else if (is.call(x) && identical(x[[1]], quote(`if`)) && length(x) == 3) { walk_if(x, id) } else if (is.call(x) && identical(x[[1]], quote(`if`)) && length(x) == 4) { walk_ifelse(x, id) } else if (is.call(x) && (identical(x[[1]], quote(`&&`)) || identical(x[[1]], quote(`||`)))) { walk_andor(x, id) } else if (is.function(x)) { walk_function(x, id) } else if (is.call(x) && identical(x[[1]], quote(`function`))) { walk_function_call(x, id) } else if (is.call(x) || is.pairlist(x) || is.expression(x) || is.list(x)) { walk_list(x, id) } else { add_node(x, id, what_atomic(x)) } } walk_return <- function(x, id) { add_to_last(functions_tail(), id) walk_list(x, id) } walk_for <- function(x, id) { add_node(x, id, "for", last = c(id.1(id), id.2(id))) add_edges(id, id.1(id), id.2(id), id.2(id)) ## Don't add the loop here because we might break ## in the vector expression. So only after that. walk_lang(x[[3]], id.1(id)) breaks_push(id) nexts_push(id.2(id)) walk_lang(x[[4]], id.2(id)) breaks_pop() nexts_pop() } walk_while <- function(x, id) { add_node(x, id, "while", last = c(id.1(id), id.2(id))) add_edges(id, id.1(id), id.2(id), id.1(id)) ## Don't add the loop here because we might break ## loop condition. So only after that. walk_lang(x[[2]], id.1(id)) breaks_push(id) nexts_push(id.1(id)) walk_lang(x[[3]], id.2(id)) breaks_pop() nexts_pop() } walk_repeat <- function(x, id) { add_node(x, id, "repeat", last = id.1(id)) add_edges(id, id.1(id), id.1(id)) breaks_push(id) nexts_push(id.1(id)) walk_lang(x[[2]], id.1(id)) breaks_pop() nexts_pop() } walk_break <- function(x, id) { add_node(x, id, "break") add_to_last(breaks_tail(), id) } walk_next <- function(x, id) { add_node(x, id, "next") add_edges(id, nexts_tail()) } walk_if <- function(x, id) { add_node(x, id, "if", last = c(id.1(id), id.2(id))) add_edges(id, id.1(id), id.2(id)) walk_lang(x[[2]], id.1(id)) walk_lang(x[[3]], id.2(id)) } walk_ifelse <- function(x, id) { add_node(x, id, "ifelse", last = c(id.2(id), id.3(id))) add_edges(id, id.1(id), id.2(id)) add_edges(id.1(id), id.3(id)) walk_lang(x[[2]], id.1(id)) walk_lang(x[[3]], id.2(id)) walk_lang(x[[4]], id.3(id)) } walk_andor <- function(x, id) { name <- as.character(x[[1]]) add_node(x, id, name, last = c(id.1(id), id.2(id))) add_edges(id, id.1(id), id.2(id)) walk_lang(x[[2]], id.1(id)) walk_lang(x[[3]], id.2(id)) } walk_function <- function(x, id) { ## Function without an argument if (is.null(formals(x))) { add_node(x, id, "function", last = id.1(id)) add_edges(id, id.1(id)) functions_push(id) walk_lang(body(x), id.1(id)) functions_pop() } else { ## Function with arguments add_node(x, id, "function", last = id.2(id)) add_edges(id, id.1(id), id.2(id)) walk_lang(formals(x), id.1(id)) functions_push(id) walk_lang(body(x), id.2(id)) functions_pop() } } walk_function_call <- function(x, id) { if (is.null(x[[2]])) { add_node(x, id, "function", last = id.1(id)) add_edges(id, id.1(id)) functions_push(id) walk_lang(x[[3]], id.1(id)) functions_pop() } else { ## Function with arguments add_node(x, id, "function", last = id.2(id)) add_edges(id, id.1(id), id.2(id)) walk_lang(x[[2]], id.1(id)) functions_push(id) walk_lang(x[[3]], id.2(id)) functions_pop() } } walk_list <- function(x, id) { what <- what_expr(x) x <- as.list(x) last <- if (length(x) == 0) character() else paste0(id, ".", length(x)) add_node(x, id, what, last = last) if (length(x) != 0) { add_edges(id, id.1(id)) for (i in seq_along(x)) { if (i != 1) add_edges(paste0(id, ".", i - 1), paste0(id, ".", i)) walk_lang(x[[i]], paste0(id, ".", i)) } } } walk_lang(expr, id = "1") nodes <- lapply(nodes, head, num_nodes) edges <- lapply(edges, head, num_edges) nodes <- as.data.frame(stringsAsFactors = FALSE, nodes) nodes$last <- head(nodeslast, num_nodes) edges <- as.data.frame(stringsAsFactors = FALSE, edges) edges <- post_process(nodes, edges) nodes <- nodes[, names(nodes) != "last"] list(nodes = nodes, edges = edges) } id.1 <- function(x) paste0(x, ".1") id.2 <- function(x) paste0(x, ".2") id.3 <- function(x) paste0(x, ".3") cyclocomp/R/post-process.R0000644000176200001440000000251414473570672015250 0ustar liggesusers ## If we have an edge that goes to another block (instead of ## going inside the same block), and the source block of the edge ## has a "last" subblock, then we rewire this edge, such that it ## leaves from the "last" subblock. ## ## The "last" subblock might be a list of ids, in this case we ## need to add extra edges. (This only really happens for ## if-else. ## ## Because we might extend edges as we go along, the loop is ## trciky, so we implement it manually instead of a 'for'. ## The potential new edges are added at the loop cursor, and ## are processed again. post_process <- function(nodes, edges) { e <- 1 while (e <= nrow(edges)) { from <- edges$from[e] to <- edges$to[e] rec <- nodes[ nodes$id == from, ] ## If there is no last sub-block, or the edge edge is going to ## a sub-block, then we are all good. Otherwise rewire. if (length(rec$last[[1]]) && ! is_child(to, from)) { edges$from[e] <- rec$last[[1]][1] for (l in rec$last[[1]][-1]) { new_edge <- data.frame( stringsAsFactors = FALSE, from = l, to = to ) edges <- rbind(edges[1:e,], new_edge, edges[-(1:e), ]) } } else { e <- e + 1 } } unique(edges) } is_child <- function(child, parent) { substring(child, 1, nchar(parent)) == parent && child != parent } cyclocomp/NEWS.md0000644000176200001440000000060414473635257013360 0ustar liggesusers# cyclocomp 1.1.1 * cyclocomp is now much faster on long linear code (@etiennebacher, #21). # cyclocomp 1.1.0 * New function `cyclocomp_package_dir` that works on a local package tree * `cyclocomp_package` returns results in decreasing order of complexity @richierocks * New function `cyclocomp_q` that quotes the expression, @richierocks # cyclocomp 1.0.0 First public release. cyclocomp/MD50000644000176200001440000000264514473672646012604 0ustar liggesusers1aef28ecb73219c15c6187f61df7879f *DESCRIPTION 21e3a7621ad0adb1225f87cf96639fc4 *LICENSE 92baef0b81432d76563d444c1d1649a1 *NAMESPACE 94330673ee5b7c3cf2a22f24fe2070c1 *NEWS.md fa74e0e4902ba104108b57438111a1fd *R/cyclocomp.R e12d6b7802ea08156cc132f77555956d *R/flowgraph.R 6ca3b74675aa1ec3e8461234f383483e *R/package_dir.R 0ea298edafb069c5968ff42dacf56f24 *R/post-process.R ca7351f81e48b9649fae264aff7ced15 *R/utils.R 7d3b7d5efcab052166a273d8a49cdb8a *README.md ddc3f9447f8032cf7ea5b6d73b4fd98e *man/cyclocomp.Rd 74f0d84321ce698b2a1c64f91fe78ede *man/cyclocomp_package.Rd d4666aa60a2bed4c211d2bb193bc76b5 *man/cyclocomp_package_dir.Rd 400c4e5a6233fbc8c109924d04d5998e *tests/testthat.R 4555841b06acd9e718e4868444ff4339 *tests/testthat/test-andor.R c510b460c5fa78bb6ef94813d242d888 *tests/testthat/test-break.R b3b6d9dc55eae612f6d367592c4bcb06 *tests/testthat/test-calls.R 0df6a457ffc4823e0aedb366e787b929 *tests/testthat/test-cyclocomp-package.R 86be224a9521525bd540425310711fd5 *tests/testthat/test-cyclocomp_q.R 1fef57d785bb29453b17e60c2f547293 *tests/testthat/test-function.R c7c54a2b28e8d1fa7a795f1c05443e36 *tests/testthat/test-if.R f1a8db3cd9fc93dd31ab65628530316c *tests/testthat/test-next.R 231863c8d3532fb7ac095e8343e92c6e *tests/testthat/test-repeat.R 98416c773f01fa74186d095a98e7d5b0 *tests/testthat/test-return.R e2060405ad6b3c91c5219a7b69d09f79 *tests/testthat/test-seq.R a44ee91f110efa87534a2cc85f308553 *tests/testthat/test-stress.R